char-db-turtle.el

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