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