concord-turtle-dump.el

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