char-db-turtle.el

   1 ;;; char-db-turtle.el --- Character Database utility -*- coding: utf-8-er; -*-
   2
   3 ;; Copyright (C) 2017 MORIOKA Tomohiko.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
   6 ;; Keywords: CHISE, Character Database, RDF, Turtle, ISO/IEC 10646, UCS, Unicode, MULE.
   7
   8 ;; This file is part of CHISET (CHISE/Turtle).
   9
  10 ;; XEmacs CHISE is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; XEmacs CHISE is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with XEmacs CHISE; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (require 'char-db-util)
  28 (require 'cwiki-common)
  29 (require 'isd-turtle)
  30 (require 'ideograph-util)
  31
  32 (setq est-coded-charset-priority-list
  33   '(; =ucs
  34     =mj
  35     =adobe-japan1-0
  36     =adobe-japan1-1
  37     =adobe-japan1-2
  38     =adobe-japan1-3
  39     =adobe-japan1-4
  40     =adobe-japan1-5
  41     =adobe-japan1-6
  42     =ucs@iso
  43     =jis-x0208 =jis-x0208@1990
  44     =jis-x0213-1
  45     =jis-x0213-1@2000 =jis-x0213-1@2004
  46     =jis-x0213-2
  47     =jis-x0212
  48     =gt
  49     =hanyo-denshi/ks
  50     =hanyo-denshi/tk
  51     =ucs-itaiji-001
  52     =ucs-itaiji-002
  53     =ucs-itaiji-003
  54     =ucs-itaiji-004
  55     =ucs-itaiji-005
  56     =ucs-itaiji-006
  57     =ucs-itaiji-009
  58     =ucs-itaiji-084
  59     =ucs-var-001
  60     =ucs-var-002
  61     =ucs-var-003
  62     =ucs-var-004
  63     =cns11643-1 =cns11643-2 =cns11643-3
  64     =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
  65     =gb2312
  66     =big5-cdp
  67     =ks-x1001
  68     =gt-k
  69     =ucs@unicode
  70     =ucs@JP/hanazono
  71     =gb12345
  72     =ucs@cns
  73     =ucs@gb
  74     =zinbun-oracle =>zinbun-oracle
  75     =daikanwa
  76     =ruimoku-v6
  77     =cbeta =jef-china3
  78     =+>ucs@iso =+>ucs@unicode
  79     =+>ucs@jis
  80     =+>ucs@cns
  81     =+>ucs@ks
  82     =+>ucs@jis/1990
  83     =>mj
  84     =>jis-x0208 =>jis-x0213-1
  85     =>jis-x0208@1997
  86     =>ucs@iwds-1
  87     =>ucs@component
  88     =>iwds-1
  89     =>ucs@iso
  90     =>ucs@unicode
  91     =>ucs@jis =>ucs@cns =>ucs@ks
  92     =>gt
  93     =>gt-k
  94     =>>ucs@iso =>>ucs@unicode
  95     =>>ucs@jis =>>ucs@cns =>>ucs@ks
  96     =>>gt-k
  97     =>>hanyo-denshi/ks
  98     ==mj
  99     ==ucs@iso
 100     ==ucs@unicode
 101     ==adobe-japan1-0
 102     ==adobe-japan1-1
 103     ==adobe-japan1-2
 104     ==adobe-japan1-3
 105     ==adobe-japan1-4
 106     ==adobe-japan1-5
 107     ==adobe-japan1-6
 108     ==ks-x1001
 109     ==hanyo-denshi/ks
 110     ==hanyo-denshi/tk
 111     ==ucs@jis
 112     ==gt
 113     ==cns11643-1 ==cns11643-2 ==cns11643-3
 114     ==cns11643-4 ==cns11643-5 ==cns11643-6 ==cns11643-7
 115     ==jis-x0212
 116     ==ucs@cns
 117     ==koseki
 118     ==daikanwa
 119     ==gt-k
 120     ==ucs@gb
 121     ==ucs-itaiji-003
 122     ==ucs@JP/hanazono
 123     =>>jis-x0208 =>>jis-x0213-1 =>>jis-x0213-2
 124     =+>jis-x0208 =+>jis-x0213-1 =+>jis-x0213-2
 125     =+>hanyo-denshi/jt
 126     =+>jis-x0208@1978
 127     =>>gt
 128     =+>adobe-japan1
 129     =>>adobe-japan1
 130     =jis-x0208@1983 =jis-x0208@1978
 131     =>ucs-itaiji-001
 132     =>ucs-itaiji-002
 133     =>ucs-itaiji-005
 134     ==>ucs@bucs
 135     =big5
 136     =>cbeta
 137     ===mj
 138     ===ucs@iso
 139     ===ucs@unicode
 140     ===hanyo-denshi/ks
 141     ===ks-x1001
 142     ===gt
 143     ===gt-k
 144     ===ucs@ks
 145     ===ucs@gb
 146     =shinjigen
 147     =shinjigen@rev
 148     =shinjigen@1ed
 149     =shinjigen/+p@rev
 150     ==shinjigen
 151     ==shinjigen@rev
 152     ==daikanwa/+p
 153     ==shinjigen@1ed
 154     ===daikanwa/+p
 155     =>daikanwa/ho
 156     ===daikanwa/ho
 157     ))
 158
 159 (defvar chise-turtle-ccs-prefix-alist nil)
 160
 161 (defun charset-code-point-format-spec (ccs)
 162   (cond ((memq ccs '(=ucs))
 163          "0x%04X")
 164         (t
 165          (let ((ccs-name (symbol-name ccs)))
 166            (cond
 167             ((string-match
 168               "\\(shinjigen\\|daikanwa/ho\\|=>iwds-1\\)"
 169               ccs-name)
 170              "%04d")
 171             ((string-match
 172               "\\(gt\\|daikanwa\\|adobe-japan1\\|cbeta\\|zinbun-oracle\\|hng\\)"
 173               ccs-name)
 174              "%05d")
 175             ((string-match "\\(hanyo-denshi/ks\\|koseki\\|mj\\)" ccs-name)
 176              "%06d")
 177             ((string-match "hanyo-denshi/tk" ccs-name)
 178              "%08d")
 179             (t
 180              "0x%X"))))))
 181
 182 (defun chise-turtle-uri-decode-feature-name (uri-feature)
 183   (cond ((string= "a.ucs" uri-feature)
 184          '=ucs)
 185         ((string= "a.big5" uri-feature)
 186          '=big5)
 187         (t
 188          (www-uri-decode-feature-name uri-feature))))
 189
 190 (defun chise-turtle-uri-encode-ccs-name (feature-name)
 191   (cond
 192    ((eq '=ucs feature-name)
 193     "a.ucs")
 194    ((eq '=big5 feature-name)
 195     "a.big5")
 196    ((eq '==>ucs@bucs feature-name)
 197     "bucs")
 198    (t
 199     (mapconcat (lambda (c)
 200                  (cond
 201                   ((eq c ?@)
 202                    "_")
 203                   ((eq c ?+)
 204                    "._.")
 205                   ((eq c ?=)
 206                    ".:.")
 207                   (t
 208                    (char-to-string c))))
 209                (www-uri-encode-feature-name feature-name)
 210                ""))))
 211
 212 (defun chise-turtle-uri-encode-feature-name (feature-name)
 213   (cond
 214    ((eq '->subsumptive feature-name)
 215     ":subsume")
 216    ((eq '<-denotational feature-name)
 217     ":denotation-of")
 218    ((eq '<-formed feature-name)
 219     ":form-of")
 220    ((eq 'hanyu-dazidian feature-name)
 221     "ideo:hanyu-dazidian")
 222    (t
 223     (concat ":" (chise-turtle-uri-encode-ccs-name feature-name)))))
 224
 225 (defun chise-turtle-format-ccs-code-point (ccs code-point)
 226   (let ((ccs-uri (chise-turtle-uri-encode-ccs-name ccs)))
 227     (unless (assoc ccs-uri chise-turtle-ccs-prefix-alist)
 228       (setq chise-turtle-ccs-prefix-alist
 229             (cons (cons ccs-uri ccs)
 230                   chise-turtle-ccs-prefix-alist)))
 231     (format "%s:%s"
 232             ccs-uri
 233             (format (charset-code-point-format-spec ccs)
 234                     code-point))))
 235
 236 (defun chise-turtle-encode-char (object)
 237   (let ((ccs-list est-coded-charset-priority-list)
 238         ccs ret ret2)
 239     (if (setq ret (encode-char object '=ucs))
 240         (chise-turtle-format-ccs-code-point '=ucs ret)
 241       (while (and ccs-list
 242                   (setq ccs (pop ccs-list))
 243                   (not (setq ret (encode-char object ccs 'defined-only)))))
 244       (cond (ret
 245              (chise-turtle-format-ccs-code-point ccs ret)
 246              )
 247             ((and (setq ccs (car (split-char object)))
 248                   (setq ret (encode-char object ccs)))
 249              (chise-turtle-format-ccs-code-point ccs ret)
 250              )
 251             ((setq ret (get-char-attribute object 'ideographic-combination))
 252              (format "ideocomb:%s"
 253                      (mapconcat (lambda (cell)
 254                                   (cond ((characterp cell)
 255                                          (char-to-string cell)
 256                                          )
 257                                         ((setq ret2 (find-char cell))
 258                                          (char-to-string ret2)
 259                                          )
 260                                         (t
 261                                          (format "%S" cell)
 262                                          )))
 263                                 ret ""))
 264              )
 265             (t
 266              (format (if est-hide-cgi-mode
 267                          "system-char-id=0x%X"
 268                        "system-char-id:0x%X")
 269                      (encode-char object 'system-char-id))
 270              )))))
 271
 272 (defun chise-split-feature-name (feature-name)
 273   (let (base domain number meta)
 274     (setq feature-name (symbol-name feature-name))
 275     (if (string-match ".\\*." feature-name)
 276         (setq meta (intern
 277                     (format ":%s" (substring feature-name (1- (match-end 0)))))
 278               feature-name (substring feature-name 0 (1+ (match-beginning 0)))))
 279     (if (string-match "\\$_\\([0-9]+\\)$" feature-name)
 280         (setq number (car (read-from-string (match-string 1 feature-name)))
 281               feature-name (substring feature-name 0 (match-beginning 0))))
 282     (if (string-match "@" feature-name)
 283         (setq domain (car (read-from-string (substring feature-name (match-end 0))))
 284               base (intern (substring feature-name 0 (match-beginning 0))))
 285       (setq base (intern feature-name)))
 286     (list base domain number meta)))
 287
 288 (defun chise-compose-feature-name (base domain number meta)
 289   (let ((name (if domain
 290                   (format "%s@%s" base domain)
 291                 (symbol-name base))))
 292     (if number
 293         (setq name (format "%s$_%d" name number)))
 294     (if meta
 295         (setq name (format "%s*%s" name
 296                            (substring (symbol-name meta) 1))))
 297     (intern name)))
 298
 299 (defvar chise-feature-name-base-metadata-alist nil)
 300
 301 (defun chise-update-feature-name-base-metadata-alist ()
 302   (interactive)
 303   (let (base domain number metadata
 304              bcell dcell ncell ret)
 305     (setq chise-feature-name-base-metadata-alist nil)
 306     (dolist (fname (sort (char-attribute-list)
 307                          #'char-attribute-name<))
 308       (setq ret (chise-split-feature-name fname)
 309             base (car ret)
 310             domain (nth 1 ret)
 311             number (nth 2 ret)
 312             metadata (nth 3 ret))
 313       (when metadata
 314         (if (setq bcell (assq base chise-feature-name-base-metadata-alist))
 315             (if (setq dcell (assq domain (cdr bcell)))
 316                 (if (setq ncell (assq number (cdr dcell)))
 317                     (unless (memq metadata (cdr ncell))
 318                       (setcdr ncell (nconc (cdr ncell)
 319                                            (list metadata))))
 320                   (setcdr dcell (cons (list number metadata)
 321                                       (cdr dcell))))
 322               (setcdr bcell (cons (list domain (list number metadata))
 323                                   (cdr bcell))))
 324           (setq chise-feature-name-base-metadata-alist
 325                 (cons (list base (list domain (list number metadata)))
 326                       chise-feature-name-base-metadata-alist))
 327           )))))
 328
 329 (chise-update-feature-name-base-metadata-alist)
 330
 331 (defun chise-get-char-attribute-with-metadata (character feature-name-base domain)
 332   (let ((value (get-char-attribute
 333                 character
 334                 (chise-compose-feature-name feature-name-base domain nil nil)
 335                 '*feature-value-is-empty*))
 336         dcell
 337         base-metadata metadata
 338         ret m i rest dest)
 339     (unless (eq value '*feature-value-is-empty*)
 340       (cond
 341        ((and (setq ret (assq feature-name-base
 342                              chise-feature-name-base-metadata-alist))
 343              (setq dcell (assq domain (cdr ret))))
 344         (if (setq ret (assq nil (cdr dcell)))
 345             (dolist (bmn (cdr ret))
 346               (when (setq m (get-char-attribute
 347                              character
 348                              (chise-compose-feature-name
 349                               feature-name-base domain nil bmn)))
 350                 (setq base-metadata
 351                       (list* bmn m base-metadata)))))
 352         (setq i 1
 353               rest value)
 354         (while (consp rest)
 355           (setq dest
 356                 (cons (cond
 357                        ((setq ret (assq i (cdr dcell)))
 358                         (setq metadata nil)
 359                         (dolist (mn (cdr ret))
 360                           (when (setq m (get-char-attribute
 361                                          character
 362                                          (chise-compose-feature-name
 363                                           feature-name-base domain i mn)))
 364                             (setq metadata (list* mn m metadata))))
 365                         (if metadata
 366                             (list* :target (car rest) metadata)
 367                           (car rest))
 368                         )
 369                        (t (car rest)))
 370                       dest))
 371           (setq i (1+ i)
 372                 rest (cdr rest)))
 373         (list (nconc (nreverse dest) rest)
 374               base-metadata)
 375         )
 376        (t (list value nil)))
 377       )))
 378
 379 (defun chise-split-ccs-name (ccs)
 380   (cond ((eq ccs '=ucs)
 381          '(ucs abstract-character nil)
 382          )
 383         ((eq ccs '=big5)
 384          '(big5 abstract-character nil)
 385          )
 386         (t
 387          (setq ccs (symbol-name ccs))
 388          (let (ret)
 389            (if (string-match "^\\(=[=+>]*\\)\\([^=>@*]+\\)@?" ccs)
 390                (list (intern (match-string 2 ccs))
 391                      (chise-decode-ccs-prefix (match-string 1 ccs))
 392                      (if (string= (setq ret (substring ccs (match-end 0))) "")
 393                          nil
 394                        (intern ret))))
 395            ))))
 396
 397 (defun chise-decode-ccs-prefix (ccs)
 398   (or (cdr (assoc ccs '(("==>" . super-abstract-character)
 399                         ("=>"  . abstract-character)
 400                         ("=+>" . unified-glyph)
 401                         ("="   . abstract-glyph)
 402                         ("=>>" . detailed-glyph)
 403                         ("=="  . abstract-glyph-form)
 404                         ("===" . glyph-image))))
 405       'character))
 406
 407 (defun chise-turtle-uri-split-ccs (uri-ccs)
 408   (cond
 409    ((string-match "^a2\\." uri-ccs)
 410     (cons ":super-abstract-character"
 411           (substring uri-ccs (match-end 0)))
 412     )
 413    ((string-match "^a\\." uri-ccs)
 414     (cons ":abstract-character"
 415           (substring uri-ccs (match-end 0)))
 416     )
 417    ((string-match "^o\\." uri-ccs)
 418     (cons ":unified-glyph"
 419           (substring uri-ccs (match-end 0)))
 420     )
 421    ((string-match "^rep\\." uri-ccs)
 422     (cons ":abstract-glyph"
 423           (substring uri-ccs (match-end 0)))
 424     )
 425    ((string-match "^g\\." uri-ccs)
 426     (cons ":detailed-glyph"
 427           (substring uri-ccs (match-end 0)))
 428     )
 429    ((string-match "^g2\\." uri-ccs)
 430     (cons ":abstract-glyph-form"
 431           (substring uri-ccs (match-end 0)))
 432     )
 433    ((string-match "^gi\\." uri-ccs)
 434     (cons ":abstract-glyph-form"
 435           (substring uri-ccs (match-end 0)))
 436     )
 437    ((string-match "^repi\\." uri-ccs)
 438     (cons ":glyph-image"
 439           (substring uri-ccs (match-end 0)))
 440     )
 441    (t (cons ":character" uri-ccs))))
 442
 443 (defun char-db-turtle-insert-relation-feature (char name value line-breaking
 444                                                     ccss readable)
 445   (insert (format "    %s%s        "
 446                   (chise-turtle-uri-encode-feature-name name)
 447                   line-breaking))
 448   (char-db-turtle-insert-relations value readable)
 449   (insert " ;")
 450   )
 451
 452 (defun char-db-turtle-insert-metadata (name value)
 453   (let (col indent)
 454     (insert (format "%-7s " name))
 455     (cond
 456      ((or (eq name :sources)
 457           (eq name :denied))
 458       (setq col (current-column))
 459       (setq indent (make-string col ?\ ))
 460       (insert (format "chisebib:%s"
 461                       (chise-turtle-uri-encode-ccs-name (car value))))
 462       (dolist (source (cdr value))
 463         (insert (format " ,\n%schisebib:%s" indent
 464                         (chise-turtle-uri-encode-ccs-name source))))
 465       nil)
 466      (t
 467       (insert (format "%S" value))
 468       nil))))
 469
 470 (defun char-db-turtle-insert-radical (radical-number)
 471   (insert (format "        %3d ; # %c"
 472                   radical-number
 473                   (ideographic-radical radical-number)))
 474   'with-separator)
 475
 476 (defun char-db-turtle-insert-list (value &optional readable)
 477   (let (lbs separator rest cell al cal key ret)
 478     (insert "( ")
 479     (setq lbs (concat "\n" (make-string (current-column) ?\ ))
 480           separator nil)
 481     (while (consp value)
 482       (setq cell (car value))
 483       (if (and (consp cell)
 484                (consp (car cell))
 485                (setq ret (condition-case nil
 486                              (find-char cell)
 487                            (error nil))))
 488           (progn
 489             (setq rest cell
 490                   al nil
 491                   cal nil)
 492             (while rest
 493               (setq key (car (car rest)))
 494               (if (find-charset key)
 495                   (setq cal (cons key cal))
 496                 (setq al (cons key al)))
 497               (setq rest (cdr rest)))
 498             (if separator
 499                 (insert lbs))
 500             (char-db-turtle-insert-char-features ret
 501                                                  readable
 502                                                  al
 503                                                  nil 'for-sub-node)
 504             (setq separator lbs))
 505         (setq ret (prin1-to-string cell))
 506         (if separator
 507             (if (< (+ (current-column)
 508                       (length ret)
 509                       (length separator))
 510                    76)
 511                 (insert separator)
 512               (insert lbs)))
 513         (insert ret)
 514         (setq separator " "))
 515       (setq value (cdr value)))
 516     (insert " ) ;")
 517     'with-separator))
 518
 519 (defun char-db-turtle-insert-source-list (value &optional readable)
 520   (let (lbs separator rest cell al cal key ret)
 521     (setq lbs (concat " ,\n" (make-string (current-column) ?\ ))
 522           separator nil)
 523     (while (consp value)
 524       (setq cell (car value))
 525       (if (and (consp cell)
 526                (consp (car cell))
 527                (setq ret (condition-case nil
 528                              (find-char cell)
 529                            (error nil))))
 530           (progn
 531             (setq rest cell
 532                   al nil
 533                   cal nil)
 534             (while rest
 535               (setq key (car (car rest)))
 536               (if (find-charset key)
 537                   (setq cal (cons key cal))
 538                 (setq al (cons key al)))
 539               (setq rest (cdr rest)))
 540             (if separator
 541                 (insert lbs))
 542             (char-db-turtle-insert-char-features ret
 543                                                  readable
 544                                                  al
 545                                                  nil 'for-sub-node)
 546             (setq separator lbs))
 547         (setq ret (prin1-to-string cell))
 548         (if separator
 549             (if (< (+ (current-column)
 550                       (length ret)
 551                       (length separator))
 552                    76)
 553                 (insert separator)
 554               (insert lbs)))
 555         (if (string-match "=" ret)
 556             (insert (format "%s:%s"
 557                             (substring ret 0 (match-beginning 0))
 558                             (substring ret (match-end 0))))
 559           (insert (format "chisebib:%s" ret)))
 560         (setq separator " , "))
 561       (setq value (cdr value)))
 562     (insert " ;")
 563     'with-separator))
 564
 565 (defun char-db-turtle-insert-relations (value &optional readable)
 566   (let ((lbs (concat "\n" (make-string (current-column) ?\ )))
 567         separator cell)
 568     (if (characterp value)
 569         (setq value (list value)))
 570     (while (consp value)
 571       (setq cell (car value))
 572       (if (integerp cell)
 573           (setq cell (decode-char '=ucs cell)))
 574       (if separator
 575           (insert separator)
 576         (setq separator (format " ,%s" lbs)))
 577       (if (characterp cell)
 578           (insert (format "%-20s" (chise-turtle-encode-char cell)))
 579         (char-db-turtle-insert-char-ref cell '<-formed))
 580       (setq value (cdr value)))
 581     nil))
 582
 583 (defun char-db-turtle-insert-target-value (value feature-name-base &optional readable)
 584   (cond ((eq feature-name-base 'ideographic-radical)
 585          (char-db-turtle-insert-radical value)
 586          )
 587         ((or (eq feature-name-base 'ideographic-combination)
 588              (eq feature-name-base '=decomposition)
 589              (eq feature-name-base '<-formed)
 590              (string-match "^\\(->\\|<-\\)[^*]*$" (symbol-name feature-name-base)))
 591          (char-db-turtle-insert-relations value readable)
 592          )
 593         ((eq feature-name-base 'comment)
 594          (insert (format "%S" value))
 595          nil)
 596         ((eq feature-name-base 'sources)
 597          (char-db-turtle-insert-source-list value readable)
 598          )
 599         ((consp value)
 600          (char-db-turtle-insert-list value readable)
 601          )
 602         (t
 603          (insert (format " %-14s" value))
 604          nil)))
 605
 606 (defun char-db-turtle-insert-feature-value (value metadata domain feature-name-base)
 607   (let (indent0 indent rest mdname mdval lb)
 608     (cond
 609      ((or metadata domain)
 610       (setq indent0 (make-string (current-column) ?\ ))
 611       (insert "[ ")
 612       (setq indent (make-string (current-column) ?\ ))
 613       (when domain
 614         (insert (format ":context domain:%-7s ;"
 615                         (chise-turtle-uri-encode-ccs-name domain)))
 616         (setq lb t))
 617       (setq rest metadata)
 618       (while rest
 619         (setq mdname (pop rest)
 620               mdval  (pop rest))
 621         (if lb
 622             (insert (format "\n%s" indent))
 623           (setq lb t))
 624         (unless (char-db-turtle-insert-metadata mdname mdval)
 625           (insert " ;")))
 626       (if lb
 627           (insert (format "\n%s" indent)))
 628       (insert ":target  ")
 629       (if (char-db-turtle-insert-target-value value feature-name-base)
 630           (insert (format "\n%s] ;" indent0))
 631         (insert " ] ;"))
 632       'with-separator)
 633      (t
 634       (char-db-turtle-insert-target-value value feature-name-base)
 635       ))))
 636
 637 (defun char-db-turtle-insert-char-ref (char-ref feature-name-base)
 638   (let (indent0 indent rest mdname mdval lb last-sep)
 639     (setq indent0 (make-string (current-column) ?\ ))
 640     (insert "[ ")
 641     (setq indent (make-string (current-column) ?\ ))
 642     (setq rest char-ref)
 643     (while rest
 644       (setq mdname (pop rest)
 645             mdval  (pop rest))
 646       (if lb
 647           (insert (format "%s\n%s"
 648                           (if last-sep
 649                               ""
 650                             " ;")
 651                           indent))
 652         (setq lb t))
 653       (setq last-sep
 654             (cond ((eq mdname :target)
 655                    (insert ":target  ")
 656                    (char-db-turtle-insert-target-value mdval feature-name-base)
 657                      )
 658                   (t
 659                    (char-db-turtle-insert-metadata mdname mdval)))))
 660     (if last-sep
 661         (insert (format "\n%s]" indent0))
 662       (insert " ]"))
 663     nil))
 664
 665 (defun char-db-turtle-insert-char-features (char
 666                                             &optional readable attributes column
 667                                             for-sub-node)
 668   (unless column
 669     (setq column (current-column)))
 670   (let ((est-coded-charset-priority-list est-coded-charset-priority-list)
 671         (est-view-url-prefix "http://chise.org/est/view")
 672         id obj-id type domain
 673         name value metadata
 674         name-base name-domain
 675         radical strokes
 676         (line-breaking (concat "\n" (make-string column ?\ )))
 677         line-separator
 678         ret
 679         skey
 680         dest-ccss ; sources required-features
 681         ccss eq-cpos-list
 682         uri-ccs uri-cpos ccs-base children child-ccs-list col indent)
 683     (let (atr-d)
 684       (setq attributes
 685             (sort (if attributes
 686                       (if (consp attributes)
 687                           (progn
 688                             (dolist (name attributes)
 689                               (unless (or (memq name char-db-ignored-attributes)
 690                                           (string-match "\\*" (symbol-name name)))
 691                                 (if (find-charset name)
 692                                     (push name ccss))
 693                                 (push name atr-d)))
 694                             atr-d))
 695                     (dolist (name (char-attribute-list))
 696                       (unless (or (memq name char-db-ignored-attributes)
 697                                   (string-match "\\*" (symbol-name name)))
 698                         (if (find-charset name)
 699                             (push name ccss))
 700                         (push name atr-d)))
 701                     atr-d)
 702                   #'char-attribute-name<)))
 703     (setq line-separator line-breaking)
 704     (setq id (chise-turtle-encode-char char))
 705     (setq obj-id (file-name-nondirectory id))
 706     (string-match ":" obj-id)
 707     (setq uri-ccs (substring obj-id 0 (match-beginning 0))
 708           uri-cpos (substring obj-id (match-end 0)))
 709     (insert (format "%s" obj-id))
 710     (setq ret (assoc uri-ccs chise-turtle-ccs-prefix-alist))
 711     (setq dest-ccss (list (cdr ret)))
 712     (setq ret (chise-split-ccs-name (cdr ret)))
 713     (setq ccs-base (car ret)
 714           type (nth 1 ret)
 715           domain (nth 2 ret))
 716     (insert (format "%s    a chisegg:%s ;" line-separator type))
 717     (insert (format "%s    :%s-of" line-breaking type))
 718     (if (null domain)
 719         (insert (format " %s:%s ;"
 720                         (chise-turtle-uri-encode-ccs-name ccs-base) uri-cpos))
 721       (insert " [ ")
 722       (setq col (current-column))
 723       (insert (format ":context domain:%-7s ;\n%s:target %7s:%-7s ] ;"
 724                       (chise-turtle-uri-encode-ccs-name domain)
 725                       (make-string col ?\ )
 726                       (chise-turtle-uri-encode-ccs-name ccs-base) uri-cpos)))
 727     (when (memq '<-subsumptive attributes)
 728       (when (or readable (not for-sub-node))
 729         (when (setq value (get-char-attribute char '<-subsumptive))
 730           (insert line-separator)
 731           (char-db-turtle-insert-relation-feature char '<-subsumptive value
 732                                                   line-breaking
 733                                                   ccss readable)
 734           ))
 735       (setq attributes (delq '<-subsumptive attributes))
 736       )
 737     (when (and (memq '<-denotational attributes)
 738                (setq value (get-char-attribute char '<-denotational)))
 739       (insert line-separator)
 740       (char-db-turtle-insert-relation-feature char '<-denotational value
 741                                             line-breaking
 742                                             ccss readable)
 743       (setq attributes (delq '<-denotational attributes)))
 744     (when (and (memq '<-denotational@component attributes)
 745                (setq value
 746                      (get-char-attribute char '<-denotational@component)))
 747       (insert line-separator)
 748       (char-db-turtle-insert-relation-feature
 749        char '<-denotational@component value
 750        line-breaking
 751        ccss readable)
 752       (setq attributes (delq '<-denotational@component attributes)))
 753     (when (and (memq 'name attributes)
 754                (setq value (get-char-attribute char 'name)))
 755       (insert (format "%s    " line-separator))
 756       (insert (format
 757                (if (> (+ (current-column) (length value)) 48)
 758                    ":name %S ;"
 759                  ":name                 %S ;")
 760                value))
 761       (setq attributes (delq 'name attributes))
 762       )
 763     (when (and (memq 'name* attributes)
 764                (setq value (get-char-attribute char 'name*)))
 765       (insert line-separator)
 766       (insert (format
 767                (if (> (+ (current-column) (length value)) 48)
 768                    " \"name*\": %S"
 769                  " \"name*\":                 %S")
 770                value))
 771       (setq attributes (delq 'name* attributes))
 772       )
 773     (when (and (memq 'script attributes)
 774                (setq value (get-char-attribute char 'script)))
 775       (insert (format "%s    :script\t\t  ( %s ) ;"
 776                       line-separator
 777                       (mapconcat (lambda (cell)
 778                                    (format "script:%s" cell))
 779                                  value " ")))
 780       (setq attributes (delq 'script attributes))
 781       )
 782     ;; (dolist (name '(=>ucs =>ucs*))
 783     ;;   (when (and (memq name attributes)
 784     ;;              (setq value (get-char-attribute char name)))
 785     ;;     (insert line-separator)
 786     ;;     (insert (format " \"%-20s\":  #x%04X,\t\"_comment\": \"%c\""
 787     ;;                     name value (decode-char '=ucs value)))
 788     ;;     (setq attributes (delq name attributes))))
 789     (when (and (memq '=>ucs attributes)
 790                (setq value (get-char-attribute char '=>ucs)))
 791       (insert (format "%s    :to.ucs\t\t  a.ucs:0x%04X ; # %c"
 792                       line-separator value (decode-char '=ucs value)))
 793       (setq attributes (delq '=>ucs attributes))
 794       )
 795     (when (setq value (get-char-attribute char '=>ucs*))
 796       (insert (format "%s    :to.canonical-ucs\ta.ucs:0x%04X ; # %c"
 797                       line-separator value (decode-char '=ucs value)))
 798       (setq attributes (delq '=>ucs* attributes))
 799       )
 800     (dolist (name '(=>ucs@gb =>ucs@big5))
 801       (when (and (memq name attributes)
 802                  (setq value (get-char-attribute char name)))
 803         (insert line-separator)
 804         (insert (format " \"%-20s\":  #x%04X,\t\"_comment\": \"%c\"%s"
 805                         name value
 806                         (decode-char (intern
 807                                       (concat "="
 808                                               (substring
 809                                                (symbol-name name) 2)))
 810                                      value)
 811                         line-breaking))
 812         (setq attributes (delq name attributes))
 813         ))
 814     (when (and (memq 'general-category attributes)
 815                (setq value (get-char-attribute char 'general-category)))
 816       (insert (format "%s    :general-category     \"%s\" ; # %s"
 817                       line-separator value
 818                       (cond ((rassoc value unidata-normative-category-alist)
 819                              "Normative Category")
 820                             ((rassoc value unidata-informative-category-alist)
 821                              "Informative Category")
 822                             (t
 823                              "Unknown Category"))))
 824       (setq attributes (delq 'general-category attributes))
 825       )
 826     (when (and (memq 'bidi-category attributes)
 827                (setq value (get-char-attribute char 'bidi-category)))
 828       (insert (format "%s    :bidi-category        %S ;"
 829                       line-separator
 830                       value))
 831       (setq attributes (delq 'bidi-category attributes))
 832       )
 833     (unless (or (not (memq 'mirrored attributes))
 834                 (eq (setq value (get-char-attribute char 'mirrored 'empty))
 835                     'empty))
 836       (insert (format "%s    :mirrored             \"%s\" ;"
 837                       line-separator
 838                       value))
 839       (setq attributes (delq 'mirrored attributes))
 840       )
 841     (cond
 842      ((and (memq 'decimal-digit-value attributes)
 843            (setq value (get-char-attribute char 'decimal-digit-value)))
 844       (insert (format "%s    :decimal-digit-value  %2d ;"
 845                       line-separator value))
 846       (setq attributes (delq 'decimal-digit-value attributes))
 847       (when (and (memq 'digit-value attributes)
 848                  (setq value (get-char-attribute char 'digit-value)))
 849         (insert (format "%s    :digit-value\t  %2d ;"
 850                         line-separator value))
 851         (setq attributes (delq 'digit-value attributes))
 852         )
 853       (when (and (memq 'numeric-value attributes)
 854                  (setq value (get-char-attribute char 'numeric-value)))
 855         (insert (format "%s    :numeric-value\t  %2d ;"
 856                         line-separator value))
 857         (setq attributes (delq 'numeric-value attributes))
 858         )
 859       )
 860      (t
 861       (when (and (memq 'digit-value attributes)
 862                  (setq value (get-char-attribute char 'digit-value)))
 863         (insert line-separator)
 864         (insert (format "%s    :digit-value\t  %2d ;"
 865                         line-separator value))
 866         (setq attributes (delq 'digit-value attributes))
 867         )
 868       (when (and (memq 'numeric-value attributes)
 869                  (setq value (get-char-attribute char 'numeric-value)))
 870         (insert line-separator)
 871         (insert (format "%s    :numeric-value\t  %2d ;"
 872                         line-separator value))
 873         (setq attributes (delq 'numeric-value attributes))
 874         )))
 875     (when (and (memq 'iso-10646-comment attributes)
 876                (setq value (get-char-attribute char 'iso-10646-comment)))
 877       (insert line-separator)
 878       (insert (format "{\"iso-10646-comment\":\t %S}%s"
 879                       value
 880                       line-breaking))
 881       (setq attributes (delq 'iso-10646-comment attributes))
 882       )
 883     (when (and (memq 'morohashi-daikanwa attributes)
 884                (setq value (get-char-attribute char 'morohashi-daikanwa)))
 885       (insert line-separator)
 886       (insert (format "%s    :morohashi-daikanwa\t  %S ;"
 887                       line-separator value))
 888       (setq attributes (delq 'morohashi-daikanwa attributes))
 889       )
 890     (setq radical nil
 891           strokes nil)
 892     (when (and (memq 'ideographic-radical attributes)
 893                (setq value (get-char-attribute char 'ideographic-radical)))
 894       (setq radical value)
 895       (insert (format "%s    ideo:radical         %3d ; # %c "
 896                       line-separator
 897                       radical
 898                       (ideographic-radical radical)
 899                       ))
 900       (setq attributes (delq 'ideographic-radical attributes))
 901       )
 902     (when (and (memq 'shuowen-radical attributes)
 903                (setq value (get-char-attribute char 'shuowen-radical)))
 904       (insert line-separator)
 905       (insert (format " \"shuowen-radical\":\t %S,\t\"_comment\": \"%c\""
 906                       value
 907                       (shuowen-radical value)))
 908       (setq attributes (delq 'shuowen-radical attributes))
 909       )
 910     (let (key)
 911       (dolist (domain
 912                (append
 913                 char-db-feature-domains
 914                 (let (dest domain)
 915                   (dolist (feature (char-attribute-list))
 916                     (setq feature (symbol-name feature))
 917                     (when (string-match
 918                            "\\(radical\\|strokes\\)@\\([^@*]+\\)\\(\\*\\|$\\)"
 919                            feature)
 920                       (setq domain (intern (match-string 2 feature)))
 921                      (unless (memq domain dest)
 922                        (setq dest (cons domain dest)))))
 923                   (sort dest #'string<))))
 924         (setq key (intern (format "%s@%s" 'ideographic-radical domain)))
 925         (when (and (memq key attributes)
 926                    (setq value (get-char-attribute char key)))
 927           (setq radical value)
 928           (insert (format "%s    ideo:radical           "
 929                           line-separator))
 930           (char-db-turtle-insert-feature-value value nil domain 'ideographic-radical)
 931           (setq attributes (delq key attributes))
 932           )
 933         (setq key (intern (format "%s@%s" 'ideographic-strokes domain)))
 934         (when (and (memq key attributes)
 935                    (setq value (get-char-attribute char key)))
 936           (setq strokes value)
 937           (insert (format "%s    ideo:strokes           [ "
 938                           line-separator))
 939           (setq col (current-column))
 940           (setq indent (make-string col ?\ ))
 941           (insert (format ":context domain:%-7s ;\n%s:target  %S"
 942                           (chise-turtle-uri-encode-ccs-name domain)
 943                           indent strokes))
 944           (setq attributes (delq key attributes))
 945           (setq skey (intern (format "%s*sources" key)))
 946           (when (and (memq skey attributes)
 947                      (setq value (get-char-attribute char skey)))
 948             (insert (format " ;\n%s:sources (" indent))
 949             (setq col (current-column))
 950             (setq indent (make-string col ?\ ))
 951             (insert (format " chisebib:%s" (car value)))
 952             (dolist (cell (cdr value))
 953               (insert (format "\n%s chisebib:%s" indent cell)))
 954             (insert " )"))
 955           (setq attributes (delq skey attributes))
 956           (insert " ] ;")
 957           )
 958         (setq key (intern (format "%s@%s" 'total-strokes domain)))
 959         (when (and (memq key attributes)
 960                    (setq value (get-char-attribute char key)))
 961           (insert (format "%s    ideo:total-strokes     [ "
 962                           line-separator))
 963           (setq col (current-column))
 964           (insert (format ":context domain:%-7s ;\n%s:target  %S"
 965                           (chise-turtle-uri-encode-ccs-name domain)
 966                           (make-string col ?\ )
 967                           value))
 968           (setq attributes (delq key attributes))
 969           (setq skey (intern (format "%s*sources" key)))
 970           (insert " ] ;")
 971           )
 972         (dolist (feature '(ideographic-radical
 973                            ideographic-strokes
 974                            total-strokes))
 975           (setq key (intern (format "%s@%s*sources" feature domain)))
 976           (when (and (memq key attributes)
 977                      (setq value (get-char-attribute char key)))
 978             (insert line-separator)
 979             (insert (format " \"%s\":%s" key line-breaking))
 980             (dolist (cell value)
 981               (insert (format " %s" cell)))
 982             (setq attributes (delq key attributes))
 983             ))
 984         ))
 985     (when (and (memq 'ideographic-strokes attributes)
 986                (setq value (get-char-attribute char 'ideographic-strokes)))
 987       (setq strokes value)
 988       (insert (format "%s    ideo:strokes          %2d ;"
 989                       line-separator strokes))
 990       (setq attributes (delq 'ideographic-strokes attributes))
 991       )
 992     (when (and (memq 'kangxi-radical attributes)
 993                (setq value (get-char-attribute char 'kangxi-radical)))
 994       (unless (eq value radical)
 995         (insert line-separator)
 996         (insert (format "{\"kangxi-radical\":\t%S},\t\"_comment\": \"%c\"%s"
 997                         value
 998                         (ideographic-radical value)
 999                         line-breaking))
1000         (or radical
1001             (setq radical value)))
1002       (setq attributes (delq 'kangxi-radical attributes))
1003       )
1004     (when (and (memq 'kangxi-strokes attributes)
1005                (setq value (get-char-attribute char 'kangxi-strokes)))
1006       (unless (eq value strokes)
1007         (insert line-separator)
1008         (insert (format "{\"kangxi-strokes\":\t%S}%s"
1009                         value
1010                         line-breaking))
1011         (or strokes
1012             (setq strokes value)))
1013       (setq attributes (delq 'kangxi-strokes attributes))
1014       )
1015     (when (and (memq 'japanese-strokes attributes)
1016                (setq value (get-char-attribute char 'japanese-strokes)))
1017       (unless (eq value strokes)
1018         (insert line-separator)
1019         (insert (format "{\"japanese-strokes\":\t%S}%s"
1020                         value
1021                         line-breaking))
1022         (or strokes
1023             (setq strokes value)))
1024       (setq attributes (delq 'japanese-strokes attributes))
1025       )
1026     (when (and (memq 'cns-radical attributes)
1027                (setq value (get-char-attribute char 'cns-radical)))
1028       (insert line-separator)
1029       (insert (format "{\"cns-radical\":\t%S},\t\"_comment\": \"%c\"%s"
1030                       value
1031                       (ideographic-radical value)
1032                       line-breaking))
1033       (setq attributes (delq 'cns-radical attributes))
1034       )
1035     (when (and (memq 'cns-strokes attributes)
1036                (setq value (get-char-attribute char 'cns-strokes)))
1037       (unless (eq value strokes)
1038         (insert line-separator)
1039         (insert (format "{\"cns-strokes\":\t%S}%s"
1040                         value
1041                         line-breaking))
1042         (or strokes
1043             (setq strokes value)))
1044       (setq attributes (delq 'cns-strokes attributes))
1045       )
1046     (when (and (memq 'total-strokes attributes)
1047                (setq value (get-char-attribute char 'total-strokes)))
1048       (insert (format "%s    ideo:total-strokes    %2d ;"
1049                       line-separator value))
1050       (setq attributes (delq 'total-strokes attributes))
1051       )
1052     (if (equal (get-char-attribute char '->titlecase)
1053                (get-char-attribute char '->uppercase))
1054         (setq attributes (delq '->titlecase attributes)))
1055     (unless readable
1056       (dolist (ignored '(composition
1057                          ->denotational <-subsumptive ->ucs-unified
1058                          ->ideographic-component-forms))
1059         (setq attributes (delq ignored attributes))))
1060     (while attributes
1061       (setq name (car attributes))
1062       (setq ret (chise-split-feature-name name))
1063       (setq name-base (car ret)
1064             name-domain (nth 1 ret))
1065       (when (setq value (chise-get-char-attribute-with-metadata
1066                          char name-base name-domain))
1067         (setq metadata (nth 1 value)
1068               value (car value))
1069         (cond ((setq ret (find-charset name))
1070                (setq name (charset-name ret))
1071                (when (not (memq name dest-ccss))
1072                  (setq dest-ccss (cons name dest-ccss))
1073                  (if (null value)
1074                      (insert (format "%s    :%-25s rdf:nil ;" line-separator
1075                                      (chise-turtle-uri-encode-ccs-name name)))
1076                    (setq ret (chise-turtle-format-ccs-code-point name value))
1077                    (insert (format "%s    :eq %-25s ; # %c" line-separator
1078                                    ret
1079                                    (char-db-decode-isolated-char name value)))
1080                    (setq eq-cpos-list (cons (list ret name value) eq-cpos-list))))
1081                (if (find-charset
1082                     (setq ret (if (eq name '=ucs)
1083                                   (if (< value #x10000)
1084                                       '==ucs@unicode
1085                                     '==ucs@iso)
1086                                 (intern (format "=%s" name)))))
1087                    (setq child-ccs-list (cons ret child-ccs-list)))
1088                )
1089               ((and
1090                 (not readable)
1091                 (not (eq name '->subsumptive))
1092                 (not (eq name '->uppercase))
1093                 (not (eq name '->lowercase))
1094                 (not (eq name '->titlecase))
1095                 (not (eq name '->canonical))
1096                 (not (eq name '->Bopomofo))
1097                 (not (eq name '->mistakable))
1098                 (not (eq name '->ideographic-variants))
1099                 (or (eq name '<-identical)
1100                     (eq name '<-uppercase)
1101                     (eq name '<-lowercase)
1102                     (eq name '<-titlecase)
1103                     (eq name '<-canonical)
1104                     (eq name '<-ideographic-variants)
1105                     ;; (eq name '<-synonyms)
1106                     (string-match "^<-synonyms" (symbol-name name))
1107                     (eq name '<-mistakable)
1108                     (when (string-match "^->" (symbol-name name))
1109                       (cond
1110                        ((string-match "^->fullwidth" (symbol-name name))
1111                         (not (and (consp value)
1112                                   (characterp (car value))
1113                                   (encode-char
1114                                    (car value) '=ucs 'defined-only)))
1115                         )
1116                        (t)))
1117                     ))
1118                )
1119               ((eq name 'ideographic-structure)
1120                (insert (isd-turtle-format-char nil nil value nil
1121                                                'isd 'without-head-char))
1122                (insert " ;")
1123                )
1124               ((eq name '->subsumptive)
1125                (insert line-separator)
1126                (char-db-turtle-insert-relation-feature char name value
1127                                                        line-breaking
1128                                                        ccss readable)
1129                (setq children value)
1130                )
1131               (t
1132                (insert (format "%s    %-20s "
1133                                line-separator
1134                                (chise-turtle-uri-encode-feature-name name-base)))
1135                (unless (char-db-turtle-insert-feature-value
1136                         value metadata name-domain name-base)
1137                  (insert " ;"))
1138                )
1139               ))
1140       (setq attributes (cdr attributes)))
1141     (insert (format "%s    ." line-breaking))
1142     (dolist (eq-cpos (nreverse eq-cpos-list))
1143       (setq ret (chise-split-ccs-name (nth 1 eq-cpos)))
1144       (insert (format "%s    %s" line-breaking
1145                       (car eq-cpos)))
1146       (insert (format "%s        %25s" line-breaking
1147                       (format ":%s-of" (nth 1 ret))))
1148       (if (null (nth 2 ret))
1149           (insert (format " %14s:%-7s ."
1150                           (chise-turtle-uri-encode-ccs-name (car ret))
1151                           (nth 1 (split-string (car eq-cpos) ":"))))
1152         (insert " [ ")
1153         (setq col (current-column))
1154         (insert (format ":context domain:%-7s ;\n%s:target %7s:%-7s ] ."
1155                         (chise-turtle-uri-encode-ccs-name (nth 2 ret))
1156                         (make-string col ?\ )
1157                         (chise-turtle-uri-encode-ccs-name (car ret))
1158                         (nth 1 (split-string (car eq-cpos) ":"))))))
1159     (setq est-coded-charset-priority-list
1160           (append est-coded-charset-priority-list
1161                   (nreverse child-ccs-list)))
1162     (when children
1163       (dolist (child children)
1164         (insert (format "%s    " line-breaking))
1165         (char-db-turtle-insert-char-features child nil nil nil 'for-sub-node)))
1166     ))
1167
1168 (defun char-db-turtle-insert-char-data (char &optional readable attributes)
1169   (save-restriction
1170     (narrow-to-region (point)(point))
1171     (char-db-turtle-insert-char-features char readable attributes)
1172     (insert "\n\n")
1173     ))
1174
1175 (defun char-db-turtle-insert-prefix ()
1176   (let (base-ccs-list ret)
1177     (insert "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> .
1178 @prefix : <http://rdf.chise.org/rdf/property/character/main/> .
1179 @prefix ideo: <http://rdf.chise.org/rdf/property/character/ideo/> .
1180 @prefix isd: <http://rdf.chise.org/rdf/property/character/isd/> .
1181 @prefix idc: <http://rdf.chise.org/rdf/type/character/idc/> .
1182 @prefix chisegg: <http://rdf.chise.org/rdf/type/character/ggg/> .
1183 @prefix domain: <http://rdf.chise.org/data/domain/> .
1184 @prefix script: <http://rdf.chise.org/data/script/> .
1185 @prefix ideocomb: <http://rdf.chise.org/data/character/ideo/combination/> .
1186 @prefix chisebib: <http://rdf.chise.org/data/bibliography/> .
1187 @prefix ruimoku: <http://www.chise.org/est/view/article@ruimoku/rep.id=/> .
1188 @prefix zob1959: <http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/> .
1189
1190 ")
1191     (dolist (cell (sort chise-turtle-ccs-prefix-alist
1192                         (lambda (a b)
1193                           (char-attribute-name< (cdr a)(cdr b)))))
1194       (insert (format "@prefix %s: <%s/%s=> .\n"
1195                       (car cell)
1196                       "http://www.chise.org/est/view/character"
1197                       (www-uri-encode-feature-name (cdr cell))))
1198       (setq ret (chise-split-ccs-name (cdr cell)))
1199       (unless (memq (car ret) base-ccs-list)
1200         (setq base-ccs-list (cons (car ret) base-ccs-list))))
1201     (insert "\n")
1202     (dolist (base-ccs (nreverse base-ccs-list))
1203       (insert (format "@prefix %s: <%s/%s/code-point/> .\n"
1204                       (chise-turtle-uri-encode-ccs-name base-ccs)
1205                       "http://rdf.chise.org/data/ccs"
1206                       (www-uri-encode-feature-name base-ccs))))))
1207
1208 (defun char-db-turtle-insert-ideograph-radical-char-data (radical)
1209   (let ((chars
1210          (sort (copy-list (aref ideograph-radical-chars-vector radical))
1211                (lambda (a b)
1212                  (ideograph-char< a b radical))))
1213         attributes)
1214     (dolist (name (char-attribute-list))
1215       (unless (memq name char-db-ignored-attributes)
1216         (push name attributes)
1217         ))
1218     (setq attributes (sort attributes #'char-attribute-name<))
1219     (aset ideograph-radical-chars-vector radical chars)
1220     (dolist (char chars)
1221       (when (not (some (lambda (atr)
1222                          (get-char-attribute char atr))
1223                        char-db-ignored-attributes))
1224         (char-db-turtle-insert-char-data char nil attributes)))
1225     ))
1226
1227 (defun char-db-turtle-write-ideograph-radical-char-data (radical file)
1228   (if (file-directory-p file)
1229       (let ((name (char-feature (decode-char 'ucs (+ #x2EFF radical))
1230                                 'name)))
1231         (if (string-match "KANGXI RADICAL " name)
1232             (setq name (capitalize (substring name (match-end 0)))))
1233         (setq name (mapconcat (lambda (char)
1234                                 (if (eq char ? )
1235                                     "-"
1236                                   (char-to-string char))) name ""))
1237         (setq file
1238               (expand-file-name
1239                (format "Ideograph-R%03d-%s.ttl" radical name)
1240                file))))
1241   (let (chise-turtle-ccs-prefix-alist)
1242     (with-temp-buffer
1243       (char-db-turtle-insert-ideograph-radical-char-data radical)
1244       (goto-char (point-min))
1245       (char-db-turtle-insert-prefix)
1246       (insert "\n")
1247       (goto-char (point-min))
1248       (insert (format "# -*- coding: %s -*-\n"
1249                       char-db-file-coding-system))
1250       (let ((coding-system-for-write char-db-file-coding-system))
1251         (write-region (point-min)(point-max) file)))))
1252
1253
1254 ;;; @ end
1255 ;;;
1256
1257 (provide 'char-db-turtle)
1258
1259 ;;; char-db-turtle.el ends here