1 ;;; char-db-turtle.el --- Character Database utility -*- coding: utf-8-er; -*-
3 ;; Copyright (C) 2017 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 'cwiki-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
65 =cns11643-1 =cns11643-2 =cns11643-3
66 =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
76 =zinbun-oracle =>zinbun-oracle
81 =+>ucs@iso =+>ucs@unicode
87 =>jis-x0208 =>jis-x0213-1
94 =>ucs@jis =>ucs@cns =>ucs@ks
97 =>>ucs@iso =>>ucs@unicode
98 =>>ucs@jis =>>ucs@cns =>>ucs@ks
116 ==cns11643-1 ==cns11643-2 ==cns11643-3
117 ==cns11643-4 ==cns11643-5 ==cns11643-6 ==cns11643-7
128 =>>jis-x0208 =>>jis-x0213-1 =>>jis-x0213-2
129 =+>jis-x0208 =+>jis-x0213-1 =+>jis-x0213-2
135 =jis-x0208@1983 =jis-x0208@1978
165 (defvar chise-turtle-ccs-prefix-alist nil)
167 (defun charset-code-point-format-spec (ccs)
168 (cond ((memq ccs '(=ucs))
171 (let ((ccs-name (symbol-name ccs)))
174 "\\(shinjigen\\|daikanwa/ho\\|=>iwds-1\\)"
178 "\\(gt\\|daikanwa\\|adobe-japan1\\|cbeta\\|zinbun-oracle\\|hng\\)"
181 ((string-match "\\(hanyo-denshi/ks\\|koseki\\|mj\\)" ccs-name)
183 ((string-match "hanyo-denshi/tk" ccs-name)
188 (defun chise-turtle-uri-decode-feature-name (uri-feature)
189 (cond ((string= "a.ucs" uri-feature)
191 ((string= "a.big5" uri-feature)
194 (www-uri-decode-feature-name uri-feature))))
196 (defun chise-turtle-uri-encode-ccs-name (feature-name)
198 ((eq '=ucs feature-name)
200 ((eq '=big5 feature-name)
202 ((eq '==>ucs@bucs feature-name)
205 (mapconcat (lambda (c)
214 (char-to-string c))))
215 (www-uri-encode-feature-name feature-name)
218 (defun chise-turtle-uri-encode-feature-name (feature-name)
220 ((eq '->subsumptive feature-name)
222 ((eq '<-denotational feature-name)
224 ((eq '<-formed feature-name)
226 ((eq '<-same feature-name)
228 ((eq '<-simplified feature-name)
229 "ideo:simplified-form-of")
230 ((eq '<-vulgar feature-name)
231 "ideo:vulgar-form-of")
232 ((eq '<-wrong feature-name)
233 "ideo:wrong-form-of")
234 ((eq '<-original feature-name)
235 "ideo:original-form-of")
236 ((eq '<-ancient feature-name)
237 "ideo:ancient-form-of")
238 ((eq '<-Small-Seal feature-name)
239 "ideo:Small-Seal-of")
240 ((eq '<-interchangeable feature-name)
241 "ideo:interchangeable-form-of")
242 ((eq '->interchangeable feature-name)
243 "ideo:interchangeable")
244 ((eq '->mistakable feature-name)
246 ((eq 'hanyu-dazidian feature-name)
247 "ideo:hanyu-dazidian")
249 (concat ":" (chise-turtle-uri-encode-ccs-name feature-name)))))
251 (defun chise-turtle-format-ccs-code-point (ccs code-point)
252 (let ((ccs-uri (chise-turtle-uri-encode-ccs-name ccs)))
253 (unless (assoc ccs-uri chise-turtle-ccs-prefix-alist)
254 (setq chise-turtle-ccs-prefix-alist
255 (cons (cons ccs-uri ccs)
256 chise-turtle-ccs-prefix-alist)))
259 (format (charset-code-point-format-spec ccs)
262 (defun chise-turtle-encode-char (object)
263 (let ((ccs-list est-coded-charset-priority-list)
265 (if (setq ret (encode-char object '=ucs))
266 (chise-turtle-format-ccs-code-point '=ucs ret)
268 (setq ccs (pop ccs-list))
269 (not (setq ret (encode-char object ccs 'defined-only)))))
271 (chise-turtle-format-ccs-code-point ccs ret)
273 ((and (setq ccs (car (split-char object)))
274 (setq ret (encode-char object ccs)))
275 (chise-turtle-format-ccs-code-point ccs ret)
277 ((setq ret (get-char-attribute object 'ideographic-combination))
278 (format "ideocomb:%s"
279 (mapconcat (lambda (cell)
280 (cond ((characterp cell)
281 (char-to-string cell)
283 ((setq ret2 (find-char cell))
284 (char-to-string ret2)
292 (format (if est-hide-cgi-mode
293 "system-char-id=0x%X"
294 "system-char-id:0x%X")
295 (encode-char object 'system-char-id))
298 (defun chise-split-feature-name (feature-name)
299 (let (base domain number meta)
300 (setq feature-name (symbol-name feature-name))
301 (if (string-match ".\\*." feature-name)
303 (format ":%s" (substring feature-name (1- (match-end 0)))))
304 feature-name (substring feature-name 0 (1+ (match-beginning 0)))))
305 (if (string-match "\\$_\\([0-9]+\\)$" feature-name)
306 (setq number (car (read-from-string (match-string 1 feature-name)))
307 feature-name (substring feature-name 0 (match-beginning 0))))
308 (if (string-match "@" feature-name)
309 (setq domain (car (read-from-string (substring feature-name (match-end 0))))
310 base (intern (substring feature-name 0 (match-beginning 0))))
311 (setq base (intern feature-name)))
312 (list base domain number meta)))
314 (defun chise-compose-feature-name (base domain number meta)
315 (let ((name (if domain
316 (format "%s@%s" base domain)
317 (symbol-name base))))
319 (setq name (format "%s$_%d" name number)))
321 (setq name (format "%s*%s" name
322 (substring (symbol-name meta) 1))))
325 (defvar chise-feature-name-base-metadata-alist nil)
327 (defun chise-update-feature-name-base-metadata-alist ()
329 (let (base domain number metadata
330 bcell dcell ncell ret)
331 (setq chise-feature-name-base-metadata-alist nil)
332 (dolist (fname (sort (char-attribute-list)
333 #'char-attribute-name<))
334 (setq ret (chise-split-feature-name fname)
338 metadata (nth 3 ret))
340 (if (setq bcell (assq base chise-feature-name-base-metadata-alist))
341 (if (setq dcell (assq domain (cdr bcell)))
342 (if (setq ncell (assq number (cdr dcell)))
343 (unless (memq metadata (cdr ncell))
344 (setcdr ncell (nconc (cdr ncell)
346 (setcdr dcell (cons (list number metadata)
348 (setcdr bcell (cons (list domain (list number metadata))
350 (setq chise-feature-name-base-metadata-alist
351 (cons (list base (list domain (list number metadata)))
352 chise-feature-name-base-metadata-alist))
355 (chise-update-feature-name-base-metadata-alist)
357 (defun chise-get-char-attribute-with-metadata (character feature-name-base domain)
358 (let ((value (get-char-attribute
360 (chise-compose-feature-name feature-name-base domain nil nil)
361 '*feature-value-is-empty*))
363 base-metadata metadata
365 (unless (eq value '*feature-value-is-empty*)
367 ((and (setq ret (assq feature-name-base
368 chise-feature-name-base-metadata-alist))
369 (setq dcell (assq domain (cdr ret))))
370 (if (setq ret (assq nil (cdr dcell)))
371 (dolist (bmn (cdr ret))
372 (when (setq m (get-char-attribute
374 (chise-compose-feature-name
375 feature-name-base domain nil bmn)))
377 (list* bmn m base-metadata)))))
383 ((setq ret (assq i (cdr dcell)))
385 (dolist (mn (cdr ret))
386 (when (setq m (get-char-attribute
388 (chise-compose-feature-name
389 feature-name-base domain i mn)))
390 (setq metadata (list* mn m metadata))))
392 (list* :target (car rest) metadata)
399 (list (nconc (nreverse dest) rest)
402 (t (list value nil)))
405 (defun chise-split-ccs-name (ccs)
406 (cond ((eq ccs '=ucs)
407 '(ucs abstract-character nil)
410 '(big5 abstract-character nil)
413 (setq ccs (symbol-name ccs))
415 (if (string-match "^\\(=[=+>]*\\)\\([^=>@*]+\\)@?" ccs)
416 (list (intern (match-string 2 ccs))
417 (chise-decode-ccs-prefix (match-string 1 ccs))
418 (if (string= (setq ret (substring ccs (match-end 0))) "")
423 (defun chise-decode-ccs-prefix (ccs)
424 (or (cdr (assoc ccs '(("==>" . super-abstract-character)
425 ("=>" . abstract-character)
426 ("=+>" . unified-glyph)
427 ("=" . abstract-glyph)
428 ("=>>" . detailed-glyph)
429 ("==" . abstract-glyph-form)
430 ("===" . glyph-image))))
433 (defun chise-turtle-uri-split-ccs (uri-ccs)
435 ((string-match "^a2\\." uri-ccs)
436 (cons ":super-abstract-character"
437 (substring uri-ccs (match-end 0)))
439 ((string-match "^a\\." uri-ccs)
440 (cons ":abstract-character"
441 (substring uri-ccs (match-end 0)))
443 ((string-match "^o\\." uri-ccs)
444 (cons ":unified-glyph"
445 (substring uri-ccs (match-end 0)))
447 ((string-match "^rep\\." uri-ccs)
448 (cons ":abstract-glyph"
449 (substring uri-ccs (match-end 0)))
451 ((string-match "^g\\." uri-ccs)
452 (cons ":detailed-glyph"
453 (substring uri-ccs (match-end 0)))
455 ((string-match "^g2\\." uri-ccs)
456 (cons ":abstract-glyph-form"
457 (substring uri-ccs (match-end 0)))
459 ((string-match "^gi\\." uri-ccs)
460 (cons ":abstract-glyph-form"
461 (substring uri-ccs (match-end 0)))
463 ((string-match "^repi\\." uri-ccs)
465 (substring uri-ccs (match-end 0)))
467 (t (cons ":character" uri-ccs))))
469 (defun char-db-turtle-insert-relation-feature (char name value line-breaking
471 (insert (format " %s%s "
472 (chise-turtle-uri-encode-feature-name name)
474 (char-db-turtle-insert-relations value readable)
478 (defun char-db-turtle-insert-metadata (name value)
480 (insert (format "%-7s " name))
482 ((or (eq name :sources)
484 (setq col (current-column))
485 (setq indent (make-string col ?\ ))
486 (insert (format "chisebib:%s"
487 (chise-turtle-uri-encode-ccs-name (car value))))
488 (dolist (source (cdr value))
489 (insert (format " ,\n%schisebib:%s" indent
490 (chise-turtle-uri-encode-ccs-name source))))
493 (insert (format "%S" value))
496 (defun char-db-turtle-insert-radical (radical-number)
497 (insert (format " %3d ; # %c"
499 (ideographic-radical radical-number)))
502 (defun char-db-turtle-insert-list (value &optional readable)
503 (let (lbs separator rest cell al cal key ret)
505 (setq lbs (concat "\n" (make-string (current-column) ?\ ))
508 (setq cell (car value))
509 (if (and (consp cell)
511 (setq ret (condition-case nil
519 (setq key (car (car rest)))
520 (if (find-charset key)
521 (setq cal (cons key cal))
522 (setq al (cons key al)))
523 (setq rest (cdr rest)))
526 (char-db-turtle-insert-char-features ret
530 (setq separator lbs))
531 (setq ret (prin1-to-string cell))
533 (if (< (+ (current-column)
540 (setq separator " "))
541 (setq value (cdr value)))
545 (defun char-db-turtle-insert-source-list (value &optional readable)
546 (let (lbs separator rest cell al cal key ret)
547 (setq lbs (concat " ,\n" (make-string (current-column) ?\ ))
550 (setq cell (car value))
551 (if (and (consp cell)
553 (setq ret (condition-case nil
561 (setq key (car (car rest)))
562 (if (find-charset key)
563 (setq cal (cons key cal))
564 (setq al (cons key al)))
565 (setq rest (cdr rest)))
568 (char-db-turtle-insert-char-features ret
572 (setq separator lbs))
573 (setq ret (prin1-to-string cell))
575 (if (< (+ (current-column)
581 (if (string-match "=" ret)
582 (insert (format "%s:%s"
583 (substring ret 0 (match-beginning 0))
584 (substring ret (match-end 0))))
585 (insert (format "chisebib:%s" ret)))
586 (setq separator " , "))
587 (setq value (cdr value)))
591 (defun char-db-turtle-insert-relations (value &optional readable)
592 (let ((lbs (concat "\n" (make-string (current-column) ?\ )))
594 (if (characterp value)
595 (setq value (list value)))
597 (setq cell (car value))
599 (setq cell (decode-char '=ucs cell)))
602 (setq separator (format " ,%s" lbs)))
603 (if (characterp cell)
604 (insert (format "%-20s" (chise-turtle-encode-char cell)))
605 (char-db-turtle-insert-char-ref cell '<-formed))
606 (setq value (cdr value)))
609 (defun char-db-turtle-insert-target-value (value feature-name-base &optional readable)
610 (cond ((eq feature-name-base 'ideographic-radical)
611 (char-db-turtle-insert-radical value)
613 ((or (eq feature-name-base 'ideographic-combination)
614 (eq feature-name-base '=decomposition)
615 (eq feature-name-base '<-formed)
616 (string-match "^\\(->\\|<-\\)[^*]*$" (symbol-name feature-name-base)))
617 (char-db-turtle-insert-relations value readable)
619 ((eq feature-name-base 'comment)
620 (insert (format "%S" value))
622 ((eq feature-name-base 'sources)
623 (char-db-turtle-insert-source-list value readable)
626 (char-db-turtle-insert-list value readable)
629 (insert (format " %-14s" value))
632 (defun char-db-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)))
645 (setq mdname (pop rest)
648 (insert (format "\n%s" indent))
650 (unless (char-db-turtle-insert-metadata mdname mdval)
653 (insert (format "\n%s" indent)))
655 (if (char-db-turtle-insert-target-value value feature-name-base)
656 (insert (format "\n%s] ;" indent0))
660 (char-db-turtle-insert-target-value value feature-name-base)
663 (defun char-db-turtle-insert-char-ref (char-ref feature-name-base)
664 (let (indent0 indent rest mdname mdval lb last-sep)
665 (setq indent0 (make-string (current-column) ?\ ))
667 (setq indent (make-string (current-column) ?\ ))
670 (setq mdname (pop rest)
673 (insert (format "%s\n%s"
680 (cond ((eq mdname :target)
682 (char-db-turtle-insert-target-value mdval feature-name-base)
685 (char-db-turtle-insert-metadata mdname mdval)))))
687 (insert (format "\n%s]" indent0))
691 (defun char-db-turtle-insert-char-features (char
692 &optional readable attributes column
695 (setq column (current-column)))
696 (let ((est-coded-charset-priority-list est-coded-charset-priority-list)
697 (est-view-url-prefix "http://chise.org/est/view")
698 id obj-id type domain
700 name-base name-domain
702 (line-breaking (concat "\n" (make-string column ?\ )))
706 dest-ccss ; sources required-features
708 uri-ccs uri-cpos ccs-base children child-ccs-list col indent)
712 (if (consp attributes)
714 (dolist (name attributes)
715 (unless (or (memq name char-db-ignored-attributes)
716 (string-match "\\*" (symbol-name name)))
717 (if (find-charset name)
721 (dolist (name (char-attribute-list))
722 (unless (or (memq name char-db-ignored-attributes)
723 (string-match "\\*" (symbol-name name)))
724 (if (find-charset name)
728 #'char-attribute-name<)))
729 (setq line-separator line-breaking)
730 (setq id (chise-turtle-encode-char char))
731 (setq obj-id (file-name-nondirectory id))
732 (string-match ":" obj-id)
733 (setq uri-ccs (substring obj-id 0 (match-beginning 0))
734 uri-cpos (substring obj-id (match-end 0)))
735 (insert (format "%s" obj-id))
736 (setq ret (assoc uri-ccs chise-turtle-ccs-prefix-alist))
737 (setq dest-ccss (list (cdr ret)))
738 (setq ret (chise-split-ccs-name (cdr ret)))
739 (setq ccs-base (car ret)
742 (insert (format "%s a chisegg:%s ;" line-separator type))
743 (insert (format "%s :%s-of" line-breaking type))
745 (insert (format " %s:%s ;"
746 (chise-turtle-uri-encode-ccs-name ccs-base) uri-cpos))
748 (setq col (current-column))
749 (insert (format ":context domain:%-7s ;\n%s:target %7s:%-7s ] ;"
750 (chise-turtle-uri-encode-ccs-name domain)
751 (make-string col ?\ )
752 (chise-turtle-uri-encode-ccs-name ccs-base) uri-cpos)))
753 (when (memq '<-subsumptive attributes)
754 (when (or readable (not for-sub-node))
755 (when (setq value (get-char-attribute char '<-subsumptive))
756 (insert line-separator)
757 (char-db-turtle-insert-relation-feature char '<-subsumptive value
761 (setq attributes (delq '<-subsumptive attributes))
763 (when (and (memq '<-denotational attributes)
764 (setq value (get-char-attribute char '<-denotational)))
765 (insert line-separator)
766 (char-db-turtle-insert-relation-feature char '<-denotational value
769 (setq attributes (delq '<-denotational attributes)))
770 (when (and (memq '<-denotational@component attributes)
772 (get-char-attribute char '<-denotational@component)))
773 (insert line-separator)
774 (char-db-turtle-insert-relation-feature
775 char '<-denotational@component value
778 (setq attributes (delq '<-denotational@component attributes)))
779 (when (and (memq 'name attributes)
780 (setq value (get-char-attribute char 'name)))
781 (insert (format "%s " line-separator))
783 (if (> (+ (current-column) (length value)) 48)
787 (setq attributes (delq 'name attributes))
789 (when (and (memq 'name* attributes)
790 (setq value (get-char-attribute char 'name*)))
791 (insert line-separator)
793 (if (> (+ (current-column) (length value)) 48)
797 (setq attributes (delq 'name* attributes))
799 (when (and (memq 'script attributes)
800 (setq value (get-char-attribute char 'script)))
801 (insert (format "%s :script\t\t ( %s ) ;"
803 (mapconcat (lambda (cell)
804 (format "script:%s" cell))
806 (setq attributes (delq 'script attributes))
808 ;; (dolist (name '(=>ucs =>ucs*))
809 ;; (when (and (memq name attributes)
810 ;; (setq value (get-char-attribute char name)))
811 ;; (insert line-separator)
812 ;; (insert (format " \"%-20s\": #x%04X,\t\"_comment\": \"%c\""
813 ;; name value (decode-char '=ucs value)))
814 ;; (setq attributes (delq name attributes))))
815 (when (and (memq '=>ucs attributes)
816 (setq value (get-char-attribute char '=>ucs)))
817 (insert (format "%s :to.ucs\t\t a.ucs:0x%04X ; # %c"
818 line-separator value (decode-char '=ucs value)))
819 (setq attributes (delq '=>ucs attributes))
821 (when (setq value (get-char-attribute char '=>ucs*))
822 (insert (format "%s :to.canonical-ucs\ta.ucs:0x%04X ; # %c"
823 line-separator value (decode-char '=ucs value)))
824 (setq attributes (delq '=>ucs* attributes))
826 (dolist (name '(=>ucs@gb =>ucs@big5))
827 (when (and (memq name attributes)
828 (setq value (get-char-attribute char name)))
829 (insert line-separator)
830 (insert (format " \"%-20s\": #x%04X,\t\"_comment\": \"%c\"%s"
835 (symbol-name name) 2)))
838 (setq attributes (delq name attributes))
840 (when (and (memq 'general-category attributes)
841 (setq value (get-char-attribute char 'general-category)))
842 (insert (format "%s :general-category \"%s\" ; # %s"
844 (cond ((rassoc value unidata-normative-category-alist)
845 "Normative Category")
846 ((rassoc value unidata-informative-category-alist)
847 "Informative Category")
849 "Unknown Category"))))
850 (setq attributes (delq 'general-category attributes))
852 (when (and (memq 'bidi-category attributes)
853 (setq value (get-char-attribute char 'bidi-category)))
854 (insert (format "%s :bidi-category %S ;"
857 (setq attributes (delq 'bidi-category attributes))
859 (unless (or (not (memq 'mirrored attributes))
860 (eq (setq value (get-char-attribute char 'mirrored 'empty))
862 (insert (format "%s :mirrored \"%s\" ;"
865 (setq attributes (delq 'mirrored attributes))
868 ((and (memq 'decimal-digit-value attributes)
869 (setq value (get-char-attribute char 'decimal-digit-value)))
870 (insert (format "%s :decimal-digit-value %2d ;"
871 line-separator value))
872 (setq attributes (delq 'decimal-digit-value attributes))
873 (when (and (memq 'digit-value attributes)
874 (setq value (get-char-attribute char 'digit-value)))
875 (insert (format "%s :digit-value\t %2d ;"
876 line-separator value))
877 (setq attributes (delq 'digit-value attributes))
879 (when (and (memq 'numeric-value attributes)
880 (setq value (get-char-attribute char 'numeric-value)))
881 (insert (format "%s :numeric-value\t %2d ;"
882 line-separator value))
883 (setq attributes (delq 'numeric-value attributes))
887 (when (and (memq 'digit-value attributes)
888 (setq value (get-char-attribute char 'digit-value)))
889 (insert line-separator)
890 (insert (format "%s :digit-value\t %2d ;"
891 line-separator value))
892 (setq attributes (delq 'digit-value attributes))
894 (when (and (memq 'numeric-value attributes)
895 (setq value (get-char-attribute char 'numeric-value)))
896 (insert line-separator)
897 (insert (format "%s :numeric-value\t %2d ;"
898 line-separator value))
899 (setq attributes (delq 'numeric-value attributes))
901 (when (and (memq 'iso-10646-comment attributes)
902 (setq value (get-char-attribute char 'iso-10646-comment)))
903 (insert line-separator)
904 (insert (format "{\"iso-10646-comment\":\t %S}%s"
907 (setq attributes (delq 'iso-10646-comment attributes))
909 (when (and (memq 'morohashi-daikanwa attributes)
910 (setq value (get-char-attribute char 'morohashi-daikanwa)))
911 (insert line-separator)
912 (insert (format "%s :morohashi-daikanwa\t %S ;"
913 line-separator value))
914 (setq attributes (delq 'morohashi-daikanwa attributes))
918 (when (and (memq 'ideographic-radical attributes)
919 (setq value (get-char-attribute char 'ideographic-radical)))
921 (insert (format "%s ideo:radical %3d ; # %c "
924 (ideographic-radical radical)
926 (setq attributes (delq 'ideographic-radical attributes))
928 (when (and (memq 'shuowen-radical attributes)
929 (setq value (get-char-attribute char 'shuowen-radical)))
930 (insert line-separator)
931 (insert (format " \"shuowen-radical\":\t %S,\t\"_comment\": \"%c\""
933 (shuowen-radical value)))
934 (setq attributes (delq 'shuowen-radical attributes))
939 char-db-feature-domains
941 (dolist (feature (char-attribute-list))
942 (setq feature (symbol-name feature))
944 "\\(radical\\|strokes\\)@\\([^@*]+\\)\\(\\*\\|$\\)"
946 (setq domain (intern (match-string 2 feature)))
947 (unless (memq domain dest)
948 (setq dest (cons domain dest)))))
949 (sort dest #'string<))))
950 (setq key (intern (format "%s@%s" 'ideographic-radical domain)))
951 (when (and (memq key attributes)
952 (setq value (get-char-attribute char key)))
954 (insert (format "%s ideo:radical "
956 (char-db-turtle-insert-feature-value value nil domain 'ideographic-radical)
957 (setq attributes (delq key attributes))
959 (setq key (intern (format "%s@%s" 'ideographic-strokes domain)))
960 (when (and (memq key attributes)
961 (setq value (get-char-attribute char key)))
963 (insert (format "%s ideo:strokes [ "
965 (setq col (current-column))
966 (setq indent (make-string col ?\ ))
967 (insert (format ":context domain:%-7s ;\n%s:target %S"
968 (chise-turtle-uri-encode-ccs-name domain)
970 (setq attributes (delq key attributes))
971 (setq skey (intern (format "%s*sources" key)))
972 (when (and (memq skey attributes)
973 (setq value (get-char-attribute char skey)))
974 (insert (format " ;\n%s:sources (" indent))
975 (setq col (current-column))
976 (setq indent (make-string col ?\ ))
977 (insert (format " chisebib:%s" (car value)))
978 (dolist (cell (cdr value))
979 (insert (format "\n%s chisebib:%s" indent cell)))
981 (setq attributes (delq skey attributes))
984 (setq key (intern (format "%s@%s" 'total-strokes domain)))
985 (when (and (memq key attributes)
986 (setq value (get-char-attribute char key)))
987 (insert (format "%s ideo:total-strokes [ "
989 (setq col (current-column))
990 (insert (format ":context domain:%-7s ;\n%s:target %S"
991 (chise-turtle-uri-encode-ccs-name domain)
992 (make-string col ?\ )
994 (setq attributes (delq key attributes))
995 (setq skey (intern (format "%s*sources" key)))
998 (dolist (feature '(ideographic-radical
1001 (setq key (intern (format "%s@%s*sources" feature domain)))
1002 (when (and (memq key attributes)
1003 (setq value (get-char-attribute char key)))
1004 (insert line-separator)
1005 (insert (format " \"%s\":%s" key line-breaking))
1006 (dolist (cell value)
1007 (insert (format " %s" cell)))
1008 (setq attributes (delq key attributes))
1011 (when (and (memq 'ideographic-strokes attributes)
1012 (setq value (get-char-attribute char 'ideographic-strokes)))
1013 (setq strokes value)
1014 (insert (format "%s ideo:strokes %2d ;"
1015 line-separator strokes))
1016 (setq attributes (delq 'ideographic-strokes attributes))
1018 (when (and (memq 'kangxi-radical attributes)
1019 (setq value (get-char-attribute char 'kangxi-radical)))
1020 (unless (eq value radical)
1021 (insert line-separator)
1022 (insert (format "{\"kangxi-radical\":\t%S},\t\"_comment\": \"%c\"%s"
1024 (ideographic-radical value)
1027 (setq radical value)))
1028 (setq attributes (delq 'kangxi-radical attributes))
1030 (when (and (memq 'kangxi-strokes attributes)
1031 (setq value (get-char-attribute char 'kangxi-strokes)))
1032 (unless (eq value strokes)
1033 (insert line-separator)
1034 (insert (format "{\"kangxi-strokes\":\t%S}%s"
1038 (setq strokes value)))
1039 (setq attributes (delq 'kangxi-strokes attributes))
1041 (when (and (memq 'japanese-strokes attributes)
1042 (setq value (get-char-attribute char 'japanese-strokes)))
1043 (unless (eq value strokes)
1044 (insert line-separator)
1045 (insert (format "{\"japanese-strokes\":\t%S}%s"
1049 (setq strokes value)))
1050 (setq attributes (delq 'japanese-strokes attributes))
1052 (when (and (memq 'cns-radical attributes)
1053 (setq value (get-char-attribute char 'cns-radical)))
1054 (insert line-separator)
1055 (insert (format "{\"cns-radical\":\t%S},\t\"_comment\": \"%c\"%s"
1057 (ideographic-radical value)
1059 (setq attributes (delq 'cns-radical attributes))
1061 (when (and (memq 'cns-strokes attributes)
1062 (setq value (get-char-attribute char 'cns-strokes)))
1063 (unless (eq value strokes)
1064 (insert line-separator)
1065 (insert (format "{\"cns-strokes\":\t%S}%s"
1069 (setq strokes value)))
1070 (setq attributes (delq 'cns-strokes attributes))
1072 (when (and (memq 'total-strokes attributes)
1073 (setq value (get-char-attribute char 'total-strokes)))
1074 (insert (format "%s ideo:total-strokes %2d ;"
1075 line-separator value))
1076 (setq attributes (delq 'total-strokes attributes))
1078 (if (equal (get-char-attribute char '->titlecase)
1079 (get-char-attribute char '->uppercase))
1080 (setq attributes (delq '->titlecase attributes)))
1082 (dolist (ignored '(composition
1083 ->denotational <-subsumptive ->ucs-unified
1084 ->ideographic-component-forms))
1085 (setq attributes (delq ignored attributes))))
1087 (setq name (car attributes))
1088 (setq ret (chise-split-feature-name name))
1089 (setq name-base (car ret)
1090 name-domain (nth 1 ret))
1091 (when (setq value (chise-get-char-attribute-with-metadata
1092 char name-base name-domain))
1093 (setq metadata (nth 1 value)
1095 (cond ((setq ret (find-charset name))
1096 (setq name (charset-name ret))
1097 (when (not (memq name dest-ccss))
1098 (setq dest-ccss (cons name dest-ccss))
1100 (insert (format "%s :%-25s rdf:nil ;" line-separator
1101 (chise-turtle-uri-encode-ccs-name name)))
1102 (setq ret (chise-turtle-format-ccs-code-point name value))
1103 (insert (format "%s :eq %-25s ; # %c" line-separator
1105 (char-db-decode-isolated-char name value)))
1106 (setq eq-cpos-list (cons (list ret name value) eq-cpos-list))))
1108 (setq ret (if (eq name '=ucs)
1109 (if (< value #x10000)
1112 (intern (format "=%s" name)))))
1113 (setq child-ccs-list (cons ret child-ccs-list)))
1117 (not (eq name '->subsumptive))
1118 (not (eq name '->uppercase))
1119 (not (eq name '->lowercase))
1120 (not (eq name '->titlecase))
1121 (not (eq name '->canonical))
1122 (not (eq name '->Bopomofo))
1123 (not (eq name '->mistakable))
1124 (not (eq name '->ideographic-variants))
1125 (or (eq name '<-identical)
1126 (eq name '<-uppercase)
1127 (eq name '<-lowercase)
1128 (eq name '<-titlecase)
1129 (eq name '<-canonical)
1130 (eq name '<-ideographic-variants)
1131 ;; (eq name '<-synonyms)
1132 (string-match "^<-synonyms" (symbol-name name))
1133 (eq name '<-mistakable)
1134 (when (string-match "^->" (symbol-name name))
1136 ((string-match "^->fullwidth" (symbol-name name))
1137 (not (and (consp value)
1138 (characterp (car value))
1140 (car value) '=ucs 'defined-only)))
1145 ((eq name 'ideographic-structure)
1146 (insert (isd-turtle-format-char nil nil value (/ column 4)
1147 'isd 'without-head-char))
1150 ((eq name '->subsumptive)
1151 (insert line-separator)
1152 (char-db-turtle-insert-relation-feature char name value
1155 (setq children value)
1158 (insert (format "%s %-20s "
1160 (chise-turtle-uri-encode-feature-name name-base)))
1161 (unless (char-db-turtle-insert-feature-value
1162 value metadata name-domain name-base)
1166 (setq attributes (cdr attributes)))
1167 (insert (format "%s ." line-breaking))
1168 (dolist (eq-cpos (nreverse eq-cpos-list))
1169 (setq ret (chise-split-ccs-name (nth 1 eq-cpos)))
1170 (insert (format "%s %s" line-breaking
1172 (insert (format "%s %25s" line-breaking
1173 (format ":%s-of" (nth 1 ret))))
1174 (if (null (nth 2 ret))
1175 (insert (format " %14s:%-7s ."
1176 (chise-turtle-uri-encode-ccs-name (car ret))
1177 (nth 1 (split-string (car eq-cpos) ":"))))
1179 (setq col (current-column))
1180 (insert (format ":context domain:%-7s ;\n%s:target %7s:%-7s ] ."
1181 (chise-turtle-uri-encode-ccs-name (nth 2 ret))
1182 (make-string col ?\ )
1183 (chise-turtle-uri-encode-ccs-name (car ret))
1184 (nth 1 (split-string (car eq-cpos) ":"))))))
1185 (setq est-coded-charset-priority-list
1186 (append est-coded-charset-priority-list
1187 (nreverse child-ccs-list)))
1189 (dolist (child children)
1190 (insert (format "%s " line-breaking))
1191 (char-db-turtle-insert-char-features child nil nil nil 'for-sub-node)))
1194 (defun char-db-turtle-insert-char-data (char &optional readable attributes)
1196 (narrow-to-region (point)(point))
1197 (char-db-turtle-insert-char-features char readable attributes)
1201 (defun char-db-turtle-insert-prefix ()
1202 (let (base-ccs-list ret)
1203 (insert "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> .
1204 @prefix : <http://rdf.chise.org/rdf/property/character/main/> .
1205 @prefix ideo: <http://rdf.chise.org/rdf/property/character/ideo/> .
1206 @prefix isd: <http://rdf.chise.org/rdf/property/character/isd/> .
1207 @prefix idc: <http://rdf.chise.org/rdf/type/character/idc/> .
1208 @prefix chisegg: <http://rdf.chise.org/rdf/type/character/ggg/> .
1209 @prefix domain: <http://rdf.chise.org/data/domain/> .
1210 @prefix script: <http://rdf.chise.org/data/script/> .
1211 @prefix ideocomb: <http://rdf.chise.org/data/character/ideo/combination/> .
1212 @prefix chisebib: <http://rdf.chise.org/data/bibliography/> .
1213 @prefix ruimoku: <http://www.chise.org/est/view/article@ruimoku/rep.id=/> .
1214 @prefix zob1959: <http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/> .
1217 (dolist (cell (sort chise-turtle-ccs-prefix-alist
1219 (char-attribute-name< (cdr a)(cdr b)))))
1220 (insert (format "@prefix %s: <%s/%s=> .\n"
1222 "http://www.chise.org/est/view/character"
1223 (www-uri-encode-feature-name (cdr cell))))
1224 (setq ret (chise-split-ccs-name (cdr cell)))
1225 (unless (memq (car ret) base-ccs-list)
1226 (setq base-ccs-list (cons (car ret) base-ccs-list))))
1228 (dolist (base-ccs (nreverse base-ccs-list))
1229 (insert (format "@prefix %s: <%s/%s/code-point/> .\n"
1230 (chise-turtle-uri-encode-ccs-name base-ccs)
1231 "http://rdf.chise.org/data/ccs"
1232 (www-uri-encode-feature-name base-ccs))))))
1234 (defun char-db-turtle-insert-ideograph-radical-char-data (radical)
1236 (sort (copy-list (aref ideograph-radical-chars-vector radical))
1238 (ideograph-char< a b radical))))
1240 (dolist (name (char-attribute-list))
1241 (unless (memq name char-db-ignored-attributes)
1242 (push name attributes)
1244 (setq attributes (sort attributes #'char-attribute-name<))
1245 (aset ideograph-radical-chars-vector radical chars)
1246 (dolist (char chars)
1247 (when (not (some (lambda (atr)
1248 (get-char-attribute char atr))
1249 char-db-ignored-attributes))
1250 (char-db-turtle-insert-char-data char nil attributes)))
1253 (defun char-db-turtle-write-ideograph-radical-char-data (radical file)
1254 (if (file-directory-p file)
1255 (let ((name (char-feature (decode-char 'ucs (+ #x2EFF radical))
1257 (if (string-match "KANGXI RADICAL " name)
1258 (setq name (capitalize (substring name (match-end 0)))))
1259 (setq name (mapconcat (lambda (char)
1262 (char-to-string char))) name ""))
1265 (format "Ideograph-R%03d-%s.ttl" radical name)
1267 (let (chise-turtle-ccs-prefix-alist)
1269 (char-db-turtle-insert-ideograph-radical-char-data radical)
1270 (goto-char (point-min))
1271 (char-db-turtle-insert-prefix)
1273 (goto-char (point-min))
1274 (insert (format "# -*- coding: %s -*-\n"
1275 char-db-file-coding-system))
1276 (let ((coding-system-for-write char-db-file-coding-system))
1277 (write-region (point-min)(point-max) file)))))
1283 (provide 'char-db-turtle)
1285 ;;; char-db-turtle.el ends here