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