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