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