char-db-turtle.el

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