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