1 ;;; concord-turtle-dump.el --- Character Database utility -*- coding: utf-8-er; -*-
3 ;; Copyright (C) 2017,2018 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 '<-denotational feature-name)
198 ((eq '<-formed feature-name)
200 ((eq '<-same feature-name)
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)
220 ((eq 'hanyu-dazidian feature-name)
221 "ideo:hanyu-dazidian")
222 ((eq '*note feature-name)
225 (concat ":" (chise-turtle-uri-encode-ccs-name feature-name)))))
227 (defun concord-turtle-encode-object (obj)
228 (cond ((characterp obj)
229 (chise-turtle-encode-char obj)
231 ((concord-object-p obj)
232 (let ((genre (est-object-genre obj))
233 (url-object (www-uri-encode-object obj)))
235 "http://www.chise.org/est/view"
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)
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)))
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))))
260 (setq name (format "%s$_%d" name number)))
262 (setq name (format "%s*%s" name
263 (substring (symbol-name meta) 1))))
266 (defvar chise-feature-name-base-metadata-alist nil)
268 (defun chise-update-feature-name-base-metadata-alist ()
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)
279 metadata (nth 3 ret))
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)
287 (setcdr dcell (cons (list number metadata)
289 (setcdr bcell (cons (list domain (list number metadata))
291 (setq chise-feature-name-base-metadata-alist
292 (cons (list base (list domain (list number metadata)))
293 chise-feature-name-base-metadata-alist))
296 (chise-update-feature-name-base-metadata-alist)
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)
304 base-metadata metadata
307 (setq value (cdr feature-pair))
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)
319 (list* bmn m base-metadata)))))
325 ((setq ret (assq i (cdr dcell)))
327 (dolist (mn (cdr ret))
328 (when (setq m (assq (chise-compose-feature-name
329 feature-name-base domain i mn)
332 (setq metadata (list* mn m metadata))))
334 (list* :value (car rest) metadata)
341 (list (nconc (nreverse dest) rest)
344 (t (list value nil)))
347 (defun chise-split-ccs-name (ccs)
348 (cond ((eq ccs '=ucs)
349 '(ucs abstract-character nil)
352 '(big5 abstract-character nil)
355 (setq ccs (symbol-name ccs))
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))) "")
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))))
375 (defun chise-turtle-uri-split-ccs (uri-ccs)
377 ((string-match "^a2\\." uri-ccs)
378 (cons ":super-abstract-character"
379 (substring uri-ccs (match-end 0)))
381 ((string-match "^a\\." uri-ccs)
382 (cons ":abstract-character"
383 (substring uri-ccs (match-end 0)))
385 ((string-match "^o\\." uri-ccs)
386 (cons ":unified-glyph"
387 (substring uri-ccs (match-end 0)))
389 ((string-match "^rep\\." uri-ccs)
390 (cons ":abstract-glyph"
391 (substring uri-ccs (match-end 0)))
393 ((string-match "^g\\." uri-ccs)
394 (cons ":detailed-glyph"
395 (substring uri-ccs (match-end 0)))
397 ((string-match "^g2\\." uri-ccs)
398 (cons ":abstract-glyph-form"
399 (substring uri-ccs (match-end 0)))
401 ((string-match "^gi\\." uri-ccs)
402 (cons ":abstract-glyph-form"
403 (substring uri-ccs (match-end 0)))
405 ((string-match "^repi\\." uri-ccs)
407 (substring uri-ccs (match-end 0)))
409 (t (cons ":character" uri-ccs))))
411 (defun concord-turtle-insert-relation-feature (char name value line-breaking
413 (insert (format " %s%s "
414 (chise-turtle-uri-encode-feature-name name)
416 (concord-turtle-insert-relations value readable)
420 (defun concord-turtle-insert-metadata (name value)
421 (let (col indent ret)
422 (insert (format "%-7s " name))
424 ((or (eq name :sources)
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))))
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)))
445 (insert (format "%S" value))
448 (defun concord-turtle-insert-radical (radical-number)
449 (insert (format " %3d ; # %c"
451 (ideographic-radical radical-number)))
454 (defun concord-turtle-insert-list (value &optional readable)
455 (let (lbs separator rest cell al cal key ret)
457 (setq lbs (concat "\n" (make-string (current-column) ?\ ))
460 (setq cell (car value))
461 (if (and (consp cell)
463 (setq ret (condition-case nil
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)))
478 (concord-turtle-insert-object-features ret
482 (setq separator lbs))
483 (setq ret (prin1-to-string cell))
485 (if (< (+ (current-column)
492 (setq separator " "))
493 (setq value (cdr value)))
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) ?\ ))
502 (setq cell (car value))
503 (if (and (consp cell)
505 (setq ret (condition-case nil
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)))
520 (concord-turtle-insert-object-features ret
524 (setq separator lbs))
525 (setq ret (prin1-to-string cell))
527 (if (< (+ (current-column)
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)))
543 (defun concord-turtle-insert-object (cell &optional readable)
545 (setq cell (decode-char '=ucs cell)))
548 (insert (format "%-20s" (chise-turtle-encode-char cell)))
550 ((concord-object-p cell)
551 (insert (format "%-20s" (concord-turtle-encode-object cell)))
554 (concord-turtle-insert-char-ref cell '<-formed)
557 (defun concord-turtle-insert-decomposition (value &optional readable)
558 (let ((lbs (concat "\n" (make-string (current-column) ?\ )))
560 (if (characterp value)
561 (setq value (list value)))
562 (if (setq base (pop value))
563 (cond ((setq vs (pop value))
565 (setq lb (concord-turtle-insert-object base readable))
569 (setq lb (concord-turtle-insert-object vs readable))
574 (setq lb (concord-turtle-insert-object base readable))
578 (defun concord-turtle-insert-relations (value &optional readable)
579 (let ((lbs (concat "\n" (make-string (current-column) ?\ )))
581 (if (characterp value)
582 (setq value (list value)))
584 (setq cell (car value))
585 ;; (if (integerp cell)
586 ;; (setq cell (decode-char '=ucs cell)))
589 (setq separator (format " ,%s" lbs)))
591 ;; ((characterp cell)
592 ;; (insert (format "%-20s" (chise-turtle-encode-char cell)))
594 ;; ((concord-object-p cell)
595 ;; (insert (format "%-20s" (concord-turtle-encode-object cell)))
598 ;; (concord-turtle-insert-char-ref cell '<-formed)))
599 (concord-turtle-insert-object cell readable)
600 (setq value (cdr value)))
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)
607 ((eq feature-name-base '=decomposition)
608 (concord-turtle-insert-decomposition value readable)
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)
615 ((eq feature-name-base 'comment)
616 (insert (format "%S" value))
618 ((eq feature-name-base 'sources)
619 (concord-turtle-insert-source-list value readable)
622 (concord-turtle-insert-list value readable)
625 (char-or-string-p value))
626 (insert (format " %-14s" (format "\"%s\"" value)))
629 (insert (format " %-14s" value))
632 (defun concord-turtle-insert-feature-value (value metadata domain feature-name-base)
633 (let (indent0 indent rest mdname mdval lb)
635 ((or metadata domain)
636 (setq indent0 (make-string (current-column) ?\ ))
638 (setq indent (make-string (current-column) ?\ ))
640 (insert (format ":context domain:%-7s ;"
641 (chise-turtle-uri-encode-ccs-name domain)))
644 (insert (format "\n%s" indent)))
645 (insert "rdf:value ")
646 (setq lb (concord-turtle-insert-target-value value feature-name-base))
649 (setq mdname (pop rest)
651 (insert (format " ;\n%s" indent))
652 (setq lb (concord-turtle-insert-metadata mdname mdval)))
654 (insert (format "\n%s] ;" indent0))
658 (concord-turtle-insert-target-value value feature-name-base)
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) ?\ ))
665 (setq indent (make-string (current-column) ?\ ))
668 (setq mdname (pop rest)
671 (insert (format "%s\n%s"
678 (cond ((eq mdname :value)
679 (insert "rdf:value ")
680 (concord-turtle-insert-target-value mdval feature-name-base)
683 (concord-turtle-insert-metadata mdname mdval)))))
685 (insert (format "\n%s]" indent0))
689 (defun concord-turtle-insert-object-features (object
690 &optional readable attributes 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)))
701 (char-attribute-name< (car a)(car b)))))
703 id obj-id type domain
705 name-base name-domain
707 (line-breaking (concat "\n" (make-string column ?\ )))
711 dest-ccss ; sources required-features
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))
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)
729 (insert (format "%s a chisegg:%s ;" line-separator type))
730 (insert (format "%s :%s-of" line-breaking type))
732 (insert (format " %s:%s ;"
733 (chise-turtle-uri-encode-ccs-name ccs-base) uri-cpos))
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)))
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
749 (setq obj-spec (delete feature-pair obj-spec))
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
757 (setq obj-spec (delete feature-pair obj-spec))
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
766 (setq obj-spec (delete feature-pair obj-spec))
768 (when (and (setq feature-pair (assq 'name obj-spec))
769 (setq value (cdr feature-pair)))
770 (insert (format "%s " line-separator))
772 (if (> (+ (current-column) (length value)) 48)
776 (setq obj-spec (delete feature-pair obj-spec))
778 (when (and (setq feature-pair (assq 'name* obj-spec))
779 (setq value (cdr feature-pair)))
780 (insert (format "%s " line-separator))
782 (if (> (+ (current-column) (length value)) 48)
786 (setq obj-spec (delete feature-pair obj-spec))
788 (when (and (setq feature-pair (assq 'script obj-spec))
789 (setq value (cdr feature-pair)))
790 (insert (format "%s :script\t\t ( %s ) ;"
792 (mapconcat (lambda (cell)
793 (format "script:%s" cell))
795 (setq obj-spec (delete feature-pair obj-spec))
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))
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))
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"
818 (symbol-name name) 2)))
821 (setq obj-spec (delete feature-pair obj-spec))
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"
827 (cond ((rassoc value unidata-normative-category-alist)
828 "Normative Category")
829 ((rassoc value unidata-informative-category-alist)
830 "Informative Category")
832 "Unknown Category"))))
833 (setq obj-spec (delete feature-pair obj-spec))
835 (when (and (setq feature-pair (assq 'bidi-category obj-spec))
836 (setq value (cdr feature-pair)))
837 (insert (format "%s :bidi-category %S ;"
840 (setq obj-spec (delete feature-pair obj-spec))
842 (when (and (setq feature-pair (assq 'mirrored obj-spec))
843 (setq value (cdr feature-pair)))
844 (insert (format "%s :mirrored \"%s\" ;"
847 (setq obj-spec (delete feature-pair obj-spec))
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))
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))
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))
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))
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"
889 (setq obj-spec (delete feature-pair obj-spec))
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))
900 (when (and (setq feature-pair (assq 'ideographic-radical obj-spec))
901 (setq value (cdr feature-pair)))
903 (insert (format "%s ideo:radical %3d ; # %c "
906 (ideographic-radical radical)
908 (setq obj-spec (delete feature-pair obj-spec))
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\""
915 (shuowen-radical value)))
916 (setq obj-spec (delete feature-pair obj-spec))
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)))
924 (insert (format "%s ideo:radical [ "
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)
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)))
946 (setq obj-spec (delete feature-pair obj-spec))
948 (insert (format "\n%s] ;" (make-string (- col 2) ?\ )))
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)))
955 (insert (format "%s ideo:strokes [ "
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)
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)))
976 (setq obj-spec (delete feature-pair obj-spec))
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 [ "
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 ?\ )
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)))
1003 (setq obj-spec (delete feature-pair obj-spec))
1006 ;; (dolist (feature '(ideographic-radical
1007 ;; ideographic-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))
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))
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))
1032 ;; (if (equal (get-char-attribute char '->titlecase)
1033 ;; (get-char-attribute char '->uppercase))
1034 ;; (setq attributes (delq '->titlecase attributes)))
1036 ;; (dolist (ignored '(composition
1037 ;; ->denotational <-subsumptive ->ucs-unified
1038 ;; ->ideographic-component-forms))
1039 ;; (setq attributes (delq ignored attributes))))
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)
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))
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
1059 (char-db-decode-isolated-char name value)))
1060 (setq eq-cpos-list (cons (list ret name value) eq-cpos-list))))
1062 (setq ret (if (eq name '=ucs)
1063 (if (< value #x10000)
1066 (intern (format "=%s" name)))))
1067 (setq child-ccs-list (cons ret child-ccs-list)))
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))
1090 ((string-match "^->fullwidth" (symbol-name name))
1091 (not (and (consp value)
1092 (characterp (car value))
1094 (car value) '=ucs 'defined-only)))
1099 ((eq name 'ideographic-structure)
1100 (insert (isd-turtle-format-char nil nil value (/ column 4)
1101 'isd 'without-head-char))
1104 ((eq name '->subsumptive)
1105 (insert line-separator)
1106 (concord-turtle-insert-relation-feature object name value
1109 (setq children value)
1111 ((eq name 'character)
1112 (insert line-separator)
1113 (concord-turtle-insert-relation-feature object name value
1116 ;; (setq children value)
1119 (insert (format "%s %-20s "
1121 (chise-turtle-uri-encode-feature-name name-base)))
1122 (unless (concord-turtle-insert-feature-value
1123 value metadata name-domain name-base)
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
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) ":"))))
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)))
1150 (dolist (child children)
1151 (insert (format "%s " line-breaking))
1152 (concord-turtle-insert-object-features child nil nil nil 'for-sub-node)))
1155 (defun concord-turtle-insert-char-data (char &optional readable attributes)
1157 (narrow-to-region (point)(point))
1158 (concord-turtle-insert-object-features char readable attributes)
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/> .
1179 (dolist (cell (sort chise-turtle-ccs-prefix-alist
1181 (char-attribute-name< (cdr a)(cdr b)))))
1182 (insert (format "@prefix %s: <%s/%s=> .\n"
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))))
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))))))
1196 (defun concord-turtle-insert-ideograph-radical-char-data (radical)
1198 (sort (copy-list (aref ideograph-radical-chars-vector radical))
1200 (ideograph-char< a b radical))))
1202 (dolist (name (char-attribute-list))
1203 (unless (memq name char-db-ignored-attributes)
1204 (push name attributes)
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)))
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))
1219 (if (string-match "KANGXI RADICAL " name)
1220 (setq name (capitalize (substring name (match-end 0)))))
1221 (setq name (mapconcat (lambda (char)
1224 (char-to-string char))) name ""))
1227 (format "Ideograph-R%03d-%s.ttl" radical name)
1229 (let (chise-turtle-ccs-prefix-alist)
1231 (concord-turtle-insert-ideograph-radical-char-data radical)
1232 (goto-char (point-min))
1233 (concord-turtle-insert-prefix)
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)))))
1245 (provide 'concord-turtle-dump)
1247 ;;; concord-turtle-dump.el ends here