char-db-turtle.el

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