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