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