concord-turtle-dump.el

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