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