char-db-turtle.el

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