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