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