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