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