1 ;;; concord-turtle-dump.el --- Character Database utility -*- coding: utf-8-er; -*-
3 ;; Copyright (C) 2017,2018,2019 MORIOKA Tomohiko.
5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
6 ;; Keywords: CHISE, Character Database, RDF, Turtle, ISO/IEC 10646, UCS, Unicode, MULE.
8 ;; This file is part of CHISET (CHISE/Turtle).
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.
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.
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.
27 (require 'char-db-util)
28 (require 'chiset-common)
30 (require 'ideograph-util)
32 (setq est-coded-charset-priority-list
43 =jis-x0208 =jis-x0208@1990
45 =jis-x0213-1@2000 =jis-x0213-1@2004
71 =cns11643-1 =cns11643-2 =cns11643-3
72 =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
82 =zinbun-oracle =>zinbun-oracle
87 =+>ucs@iso =+>ucs@unicode
93 =>jis-x0208 =>jis-x0213-1
101 =>ucs@jis =>ucs@cns =>ucs@ks
104 =>>ucs@iso =>>ucs@unicode
105 =>>ucs@jis =>>ucs@cns =>>ucs@ks
123 ==cns11643-1 ==cns11643-2 ==cns11643-3
124 ==cns11643-4 ==cns11643-5 ==cns11643-6 ==cns11643-7
138 =>>jis-x0208 =>>jis-x0213-1 =>>jis-x0213-2
139 =+>jis-x0208 =+>jis-x0213-1 =+>jis-x0213-2
145 =jis-x0208@1983 =jis-x0208@1978
178 (defvar chise-turtle-feature-domains)
179 (setq chise-turtle-feature-domains
180 (append char-db-feature-domains
182 (dolist (feature (char-attribute-list))
183 (setq feature (symbol-name feature))
185 "\\(radical\\|strokes\\)@\\([^@*]+\\)\\(\\*\\|$\\)"
187 (setq domain (intern (match-string 2 feature)))
188 (unless (memq domain dest)
189 (setq dest (cons domain dest)))))
190 (sort dest #'string<))))
192 (defun chise-turtle-uri-encode-feature-name (feature-name)
194 ((eq '->subsumptive feature-name)
196 ((eq '<-subsumptive feature-name)
198 ((eq '->denotational feature-name)
200 ((eq '<-denotational feature-name)
202 ((eq '->formed feature-name)
204 ((eq '<-formed feature-name)
206 ((eq '->same feature-name)
208 ((eq '<-same feature-name)
210 ((eq '->simplified feature-name)
211 "ideo:simplified-form")
212 ((eq '<-simplified feature-name)
213 "ideo:simplified-form-of")
214 ((eq '->vulgar feature-name)
216 ((eq '<-vulgar feature-name)
217 "ideo:vulgar-form-of")
218 ((eq '->wrong feature-name)
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)
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)
250 ((eq '*references feature-name)
252 ((eq '*instance feature-name)
254 ((eq '*source-file feature-name)
257 (concat ":" (chise-turtle-uri-encode-ccs-name feature-name)))))
259 (defun concord-turtle-encode-object (obj)
260 (cond ((characterp obj)
261 (chise-turtle-encode-char obj)
263 ((concord-object-p obj)
264 (let ((genre (est-object-genre obj))
265 (url-object (www-uri-encode-object obj)))
267 "http://www.chise.org/est/view"
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)
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)))
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))))
292 (setq name (format "%s$_%d" name number)))
294 (setq name (format "%s*%s" name
295 (substring (symbol-name meta) 1))))
298 (defvar chise-feature-name-base-metadata-alist nil)
300 (defun chise-update-feature-name-base-metadata-alist ()
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)
311 metadata (nth 3 ret))
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)
319 (setcdr dcell (cons (list number metadata)
321 (setcdr bcell (cons (list domain (list number metadata))
323 (setq chise-feature-name-base-metadata-alist
324 (cons (list base (list domain (list number metadata)))
325 chise-feature-name-base-metadata-alist))
328 (chise-update-feature-name-base-metadata-alist)
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)
336 base-metadata metadata
339 (setq value (cdr feature-pair))
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)
351 (list* bmn m base-metadata)))))
357 ((setq ret (assq i (cdr dcell)))
359 (dolist (mn (cdr ret))
360 (when (setq m (assq (chise-compose-feature-name
361 feature-name-base domain i mn)
364 (setq metadata (list* mn m metadata))))
366 (list* :value (car rest) metadata)
373 (list (nconc (nreverse dest) rest)
376 (t (list value nil)))
379 (defun chise-split-ccs-name (ccs)
380 (cond ((eq ccs '=ucs)
381 '(ucs abstract-character nil)
384 '(big5 abstract-character nil)
387 (setq ccs (symbol-name ccs))
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))) "")
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))))
407 (defun chise-turtle-uri-split-ccs (uri-ccs)
409 ((string-match "^a2\\." uri-ccs)
410 (cons ":super-abstract-character"
411 (substring uri-ccs (match-end 0)))
413 ((string-match "^a\\." uri-ccs)
414 (cons ":abstract-character"
415 (substring uri-ccs (match-end 0)))
417 ((string-match "^o\\." uri-ccs)
418 (cons ":unified-glyph"
419 (substring uri-ccs (match-end 0)))
421 ((string-match "^rep\\." uri-ccs)
422 (cons ":abstract-glyph"
423 (substring uri-ccs (match-end 0)))
425 ((string-match "^g\\." uri-ccs)
426 (cons ":detailed-glyph"
427 (substring uri-ccs (match-end 0)))
429 ((string-match "^g2\\." uri-ccs)
430 (cons ":abstract-glyph-form"
431 (substring uri-ccs (match-end 0)))
433 ((string-match "^gi\\." uri-ccs)
434 (cons ":abstract-glyph-form"
435 (substring uri-ccs (match-end 0)))
437 ((string-match "^repi\\." uri-ccs)
439 (substring uri-ccs (match-end 0)))
441 (t (cons ":character" uri-ccs))))
443 (defun concord-turtle-insert-relation-feature (char name value line-breaking
445 (if (and (consp value)
447 (insert (format " %s%s "
448 (chise-turtle-uri-encode-feature-name name)
450 (insert (format " %-20s "
451 (chise-turtle-uri-encode-feature-name name))))
452 (concord-turtle-insert-relations value readable)
456 (defun concord-turtle-insert-metadata (name value)
458 (insert (format "%-7s " name))
460 ((or (eq name :sources)
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))))
470 ((eq name :references)
471 (concord-turtle-insert-references value)
474 (insert (format "%S" value))
477 (defun concord-turtle-insert-radical (radical-number)
478 (insert (format " %3d ; # %c"
480 (ideographic-radical radical-number)))
483 (defun concord-turtle-insert-list (value &optional readable)
484 (let (lbs separator rest cell al cal key ret)
486 (setq lbs (concat "\n" (make-string (current-column) ?\ ))
489 (setq cell (car value))
490 (if (and (consp cell)
492 (setq ret (condition-case nil
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)))
507 (concord-turtle-insert-object-features ret
511 (setq separator lbs))
512 (setq ret (if (concord-object-p cell)
513 (concord-turtle-encode-object cell)
514 (prin1-to-string cell)))
516 (if (< (+ (current-column)
523 (setq separator " "))
524 (setq value (cdr value)))
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) ?\ ))
533 (setq cell (car value))
534 (if (and (consp cell)
536 (setq ret (condition-case nil
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)))
551 (concord-turtle-insert-object-features ret
555 (setq separator lbs))
556 (setq ret (prin1-to-string cell))
558 (if (< (+ (current-column)
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)))
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)))))
585 (defun concord-turtle-insert-object (cell &optional readable)
587 (setq cell (decode-char '=ucs cell)))
590 (insert (format "%-20s" (chise-turtle-encode-char cell)))
592 ((concord-object-p cell)
593 (insert (format "%-20s" (concord-turtle-encode-object cell)))
596 (concord-turtle-insert-char-ref cell '<-formed)
599 (defun concord-turtle-insert-decomposition (value &optional readable)
600 (let ((lbs (concat "\n" (make-string (current-column) ?\ )))
602 (if (characterp value)
603 (setq value (list value)))
604 (if (setq base (pop value))
605 (cond ((setq vs (pop value))
607 (setq lb (concord-turtle-insert-object base readable))
611 (setq lb (concord-turtle-insert-object vs readable))
616 (setq lb (concord-turtle-insert-object base readable))
620 (defun concord-turtle-insert-relations (value &optional readable)
621 (let ((lbs (concat "\n" (make-string (current-column) ?\ )))
623 (if (characterp value)
624 (setq value (list value)))
626 (setq cell (car value))
627 ;; (if (integerp cell)
628 ;; (setq cell (decode-char '=ucs cell)))
631 (setq separator (format " ,%s" lbs)))
633 ;; ((characterp cell)
634 ;; (insert (format "%-20s" (chise-turtle-encode-char cell)))
636 ;; ((concord-object-p cell)
637 ;; (insert (format "%-20s" (concord-turtle-encode-object cell)))
640 ;; (concord-turtle-insert-char-ref cell '<-formed)))
641 (concord-turtle-insert-object cell readable)
642 (setq value (cdr value)))
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)
649 ((eq feature-name-base '=decomposition)
650 (concord-turtle-insert-decomposition value readable)
652 ((eq feature-name-base '*references)
653 (concord-turtle-insert-references value readable)
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)
662 ((eq feature-name-base 'comment)
663 (insert (format "%S" value))
665 ((eq feature-name-base 'sources)
666 (concord-turtle-insert-source-list value readable)
669 (concord-turtle-insert-list value readable)
672 (char-or-string-p value))
673 (insert (format " %-14s" (format "\"%s\"" value)))
676 (insert (format " %-14s" value))
679 (defun concord-turtle-insert-feature-value (value metadata domain feature-name-base)
680 (let (indent0 indent rest mdname mdval lb)
682 ((or metadata domain)
683 (setq indent0 (make-string (current-column) ?\ ))
685 (setq indent (make-string (current-column) ?\ ))
687 (insert (format ":context domain:%-7s ;"
688 (chise-turtle-uri-encode-ccs-name domain)))
691 (insert (format "\n%s" indent)))
692 (insert "rdf:value ")
693 (setq lb (concord-turtle-insert-target-value value feature-name-base))
696 (setq mdname (pop rest)
698 (insert (format " ;\n%s" indent))
699 (setq lb (concord-turtle-insert-metadata mdname mdval)))
701 (insert (format "\n%s] ;" indent0))
705 (concord-turtle-insert-target-value value feature-name-base)
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) ?\ ))
712 (setq indent (make-string (current-column) ?\ ))
715 (setq mdname (pop rest)
718 (insert (format "%s\n%s"
725 (cond ((eq mdname :value)
726 (insert "rdf:value ")
727 (concord-turtle-insert-target-value mdval feature-name-base)
730 (insert "rdfs:comment ")
731 (insert (format "%S" mdval))
734 (concord-turtle-insert-metadata mdname mdval)))))
736 (insert (format "\n%s]" indent0))
740 (defun concord-turtle-insert-object-features (object
741 &optional readable attributes 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)))
752 (char-attribute-name< (car a)(car b)))))
754 id obj-id type domain
756 name-base name-domain
758 (line-breaking (concat "\n" (make-string column ?\ )))
762 dest-ccss ; sources required-features
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))
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)
780 (insert (format "%s a chisegg:%s ;" line-separator type))
781 (insert (format "%s :%s-of" line-breaking type))
783 (insert (format " %s:%s ;"
784 (chise-turtle-uri-encode-ccs-name ccs-base) uri-cpos))
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)))
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
800 (setq obj-spec (delete feature-pair obj-spec))
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
808 (setq obj-spec (delete feature-pair obj-spec))
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
817 ;; (setq obj-spec (delete feature-pair obj-spec))
819 (when (and (setq feature-pair (assq 'name obj-spec))
820 (setq value (cdr feature-pair)))
821 (insert (format "%s " line-separator))
823 (if (> (+ (current-column) (length value)) 48)
827 (setq obj-spec (delete feature-pair obj-spec))
829 (when (and (setq feature-pair (assq 'name* obj-spec))
830 (setq value (cdr feature-pair)))
831 (insert (format "%s " line-separator))
833 (if (> (+ (current-column) (length value)) 48)
837 (setq obj-spec (delete feature-pair obj-spec))
839 (when (and (setq feature-pair (assq 'script obj-spec))
840 (setq value (cdr feature-pair)))
841 (insert (format "%s :script\t\t ( %s ) ;"
843 (mapconcat (lambda (cell)
844 (format "script:%s" cell))
846 (setq obj-spec (delete feature-pair obj-spec))
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))
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))
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"
869 (symbol-name name) 2)))
872 (setq obj-spec (delete feature-pair obj-spec))
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"
878 (cond ((rassoc value unidata-normative-category-alist)
879 "Normative Category")
880 ((rassoc value unidata-informative-category-alist)
881 "Informative Category")
883 "Unknown Category"))))
884 (setq obj-spec (delete feature-pair obj-spec))
886 (when (and (setq feature-pair (assq 'bidi-category obj-spec))
887 (setq value (cdr feature-pair)))
888 (insert (format "%s :bidi-category %S ;"
891 (setq obj-spec (delete feature-pair obj-spec))
893 (when (and (setq feature-pair (assq 'mirrored obj-spec))
894 (setq value (cdr feature-pair)))
895 (insert (format "%s :mirrored \"%s\" ;"
898 (setq obj-spec (delete feature-pair obj-spec))
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))
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))
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))
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))
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"
940 (setq obj-spec (delete feature-pair obj-spec))
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))
951 (when (and (setq feature-pair (assq 'ideographic-radical obj-spec))
952 (setq value (cdr feature-pair)))
954 (insert (format "%s ideo:radical %3d ; # %c "
957 (ideographic-radical radical)
959 (setq obj-spec (delete feature-pair obj-spec))
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\""
966 (shuowen-radical value)))
967 (setq obj-spec (delete feature-pair obj-spec))
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)))
975 (insert (format "%s ideo:radical [ "
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)
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)))
997 (setq obj-spec (delete feature-pair obj-spec))
999 (insert (format "\n%s] ;" (make-string (- col 2) ?\ )))
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 [ "
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)
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)))
1027 (setq obj-spec (delete feature-pair obj-spec))
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 [ "
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)
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)))
1053 (setq obj-spec (delete feature-pair obj-spec))
1056 ;; (dolist (feature '(ideographic-radical
1057 ;; ideographic-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))
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))
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))
1082 ;; (if (equal (get-char-attribute char '->titlecase)
1083 ;; (get-char-attribute char '->uppercase))
1084 ;; (setq attributes (delq '->titlecase attributes)))
1086 ;; (dolist (ignored '(composition
1087 ;; ->denotational <-subsumptive ->ucs-unified
1088 ;; ->ideographic-component-forms))
1089 ;; (setq attributes (delq ignored attributes))))
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)
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))
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
1109 (char-db-decode-isolated-char name value)))
1110 (setq eq-cpos-list (cons (list ret name value) eq-cpos-list))))
1112 (setq ret (if (eq name '=ucs)
1113 (if (< value #x10000)
1116 (intern (format "=%s" name)))))
1117 (setq child-ccs-list (cons ret child-ccs-list)))
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))
1140 ;; ((string-match "^->fullwidth" (symbol-name name))
1141 ;; (not (and (consp value)
1142 ;; (characterp (car value))
1144 ;; (car value) '=ucs 'defined-only)))
1149 ((eq name 'ideographic-structure)
1150 (insert (isd-turtle-format-char nil nil value (/ column 4)
1151 'isd 'without-head-char))
1154 ((eq name '->subsumptive)
1155 (insert line-separator)
1156 (concord-turtle-insert-relation-feature object name value
1159 (setq children value)
1161 ((eq name 'character)
1162 (insert line-separator)
1163 (concord-turtle-insert-relation-feature object name value
1166 ;; (setq children value)
1169 (insert (format "%s %-20s "
1171 (chise-turtle-uri-encode-feature-name name-base)))
1172 (unless (concord-turtle-insert-feature-value
1173 value metadata name-domain name-base)
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
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) ":"))))
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)))
1200 (dolist (child children)
1201 (insert (format "%s " line-breaking))
1202 (concord-turtle-insert-object-features child nil nil nil 'for-sub-node)))
1205 (defun concord-turtle-insert-char-data (char &optional readable attributes)
1207 (narrow-to-region (point)(point))
1208 (concord-turtle-insert-object-features char readable attributes)
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/> .
1229 (dolist (cell (sort chise-turtle-ccs-prefix-alist
1231 (char-attribute-name< (cdr a)(cdr b)))))
1232 (insert (format "@prefix %s: <%s/%s=> .\n"
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))))
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))))))
1246 (defun concord-turtle-insert-ideograph-radical-char-data (radical)
1248 (sort (copy-list (aref ideograph-radical-chars-vector radical))
1250 (ideograph-char< a b radical))))
1252 (dolist (name (char-attribute-list))
1253 (unless (memq name char-db-ignored-attributes)
1254 (push name attributes)
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)))
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))
1270 (if (string-match "KANGXI RADICAL " name)
1271 (setq name (capitalize (substring name (match-end 0)))))
1272 (setq name (mapconcat (lambda (char)
1275 (char-to-string char))) name ""))
1278 (format "Ideograph-R%03d-%s.ttl" radical name)
1280 (let (chise-turtle-ccs-prefix-alist)
1282 (concord-turtle-insert-ideograph-radical-char-data radical)
1283 (goto-char (point-min))
1284 (concord-turtle-insert-prefix)
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)))))
1296 (provide 'concord-turtle-dump)
1298 ;;; concord-turtle-dump.el ends here