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