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