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