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
64 =cns11643-1 =cns11643-2 =cns11643-3
65 =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
75 =zinbun-oracle =>zinbun-oracle
80 =+>ucs@iso =+>ucs@unicode
86 =>jis-x0208 =>jis-x0213-1
93 =>ucs@jis =>ucs@cns =>ucs@ks
96 =>>ucs@iso =>>ucs@unicode
97 =>>ucs@jis =>>ucs@cns =>>ucs@ks
115 ==cns11643-1 ==cns11643-2 ==cns11643-3
116 ==cns11643-4 ==cns11643-5 ==cns11643-6 ==cns11643-7
126 =>>jis-x0208 =>>jis-x0213-1 =>>jis-x0213-2
127 =+>jis-x0208 =+>jis-x0213-1 =+>jis-x0213-2
133 =jis-x0208@1983 =jis-x0208@1978
162 (defvar chise-turtle-ccs-prefix-alist nil)
164 (defun charset-code-point-format-spec (ccs)
165 (cond ((memq ccs '(=ucs))
168 (let ((ccs-name (symbol-name ccs)))
171 "\\(shinjigen\\|daikanwa/ho\\|=>iwds-1\\)"
175 "\\(gt\\|daikanwa\\|adobe-japan1\\|cbeta\\|zinbun-oracle\\|hng\\)"
178 ((string-match "\\(hanyo-denshi/ks\\|koseki\\|mj\\)" ccs-name)
180 ((string-match "hanyo-denshi/tk" ccs-name)
185 (defun chise-turtle-uri-decode-feature-name (uri-feature)
186 (cond ((string= "a.ucs" uri-feature)
188 ((string= "a.big5" uri-feature)
191 (www-uri-decode-feature-name uri-feature))))
193 (defun chise-turtle-uri-encode-ccs-name (feature-name)
195 ((eq '=ucs feature-name)
197 ((eq '=big5 feature-name)
199 ((eq '==>ucs@bucs feature-name)
202 (mapconcat (lambda (c)
211 (char-to-string c))))
212 (www-uri-encode-feature-name feature-name)
215 (defun chise-turtle-uri-encode-feature-name (feature-name)
217 ((eq '->subsumptive feature-name)
219 ((eq '<-denotational feature-name)
221 ((eq '<-formed feature-name)
223 ((eq 'hanyu-dazidian feature-name)
224 "ideo:hanyu-dazidian")
226 (concat ":" (chise-turtle-uri-encode-ccs-name feature-name)))))
228 (defun chise-turtle-format-ccs-code-point (ccs code-point)
229 (let ((ccs-uri (chise-turtle-uri-encode-ccs-name ccs)))
230 (unless (assoc ccs-uri chise-turtle-ccs-prefix-alist)
231 (setq chise-turtle-ccs-prefix-alist
232 (cons (cons ccs-uri ccs)
233 chise-turtle-ccs-prefix-alist)))
236 (format (charset-code-point-format-spec ccs)
239 (defun chise-turtle-encode-char (object)
240 (let ((ccs-list est-coded-charset-priority-list)
242 (if (setq ret (encode-char object '=ucs))
243 (chise-turtle-format-ccs-code-point '=ucs ret)
245 (setq ccs (pop ccs-list))
246 (not (setq ret (encode-char object ccs 'defined-only)))))
248 (chise-turtle-format-ccs-code-point ccs ret)
250 ((and (setq ccs (car (split-char object)))
251 (setq ret (encode-char object ccs)))
252 (chise-turtle-format-ccs-code-point ccs ret)
254 ((setq ret (get-char-attribute object 'ideographic-combination))
255 (format "ideocomb:%s"
256 (mapconcat (lambda (cell)
257 (cond ((characterp cell)
258 (char-to-string cell)
260 ((setq ret2 (find-char cell))
261 (char-to-string ret2)
269 (format (if est-hide-cgi-mode
270 "system-char-id=0x%X"
271 "system-char-id:0x%X")
272 (encode-char object 'system-char-id))
275 (defun chise-split-feature-name (feature-name)
276 (let (base domain number meta)
277 (setq feature-name (symbol-name feature-name))
278 (if (string-match ".\\*." feature-name)
280 (format ":%s" (substring feature-name (1- (match-end 0)))))
281 feature-name (substring feature-name 0 (1+ (match-beginning 0)))))
282 (if (string-match "\\$_\\([0-9]+\\)$" feature-name)
283 (setq number (car (read-from-string (match-string 1 feature-name)))
284 feature-name (substring feature-name 0 (match-beginning 0))))
285 (if (string-match "@" feature-name)
286 (setq domain (car (read-from-string (substring feature-name (match-end 0))))
287 base (intern (substring feature-name 0 (match-beginning 0))))
288 (setq base (intern feature-name)))
289 (list base domain number meta)))
291 (defun chise-compose-feature-name (base domain number meta)
292 (let ((name (if domain
293 (format "%s@%s" base domain)
294 (symbol-name base))))
296 (setq name (format "%s$_%d" name number)))
298 (setq name (format "%s*%s" name
299 (substring (symbol-name meta) 1))))
302 (defvar chise-feature-name-base-metadata-alist nil)
304 (defun chise-update-feature-name-base-metadata-alist ()
306 (let (base domain number metadata
307 bcell dcell ncell ret)
308 (setq chise-feature-name-base-metadata-alist nil)
309 (dolist (fname (sort (char-attribute-list)
310 #'char-attribute-name<))
311 (setq ret (chise-split-feature-name fname)
315 metadata (nth 3 ret))
317 (if (setq bcell (assq base chise-feature-name-base-metadata-alist))
318 (if (setq dcell (assq domain (cdr bcell)))
319 (if (setq ncell (assq number (cdr dcell)))
320 (unless (memq metadata (cdr ncell))
321 (setcdr ncell (nconc (cdr ncell)
323 (setcdr dcell (cons (list number metadata)
325 (setcdr bcell (cons (list domain (list number metadata))
327 (setq chise-feature-name-base-metadata-alist
328 (cons (list base (list domain (list number metadata)))
329 chise-feature-name-base-metadata-alist))
332 (chise-update-feature-name-base-metadata-alist)
334 (defun chise-get-char-attribute-with-metadata (character feature-name-base domain)
335 (let ((value (get-char-attribute
337 (chise-compose-feature-name feature-name-base domain nil nil)
338 '*feature-value-is-empty*))
340 base-metadata metadata
342 (unless (eq value '*feature-value-is-empty*)
344 ((and (setq ret (assq feature-name-base
345 chise-feature-name-base-metadata-alist))
346 (setq dcell (assq domain (cdr ret))))
347 (if (setq ret (assq nil (cdr dcell)))
348 (dolist (bmn (cdr ret))
349 (when (setq m (get-char-attribute
351 (chise-compose-feature-name
352 feature-name-base domain nil bmn)))
354 (list* bmn m base-metadata)))))
360 ((setq ret (assq i (cdr dcell)))
362 (dolist (mn (cdr ret))
363 (when (setq m (get-char-attribute
365 (chise-compose-feature-name
366 feature-name-base domain i mn)))
367 (setq metadata (list* mn m metadata))))
369 (list* :target (car rest) metadata)
376 (list (nconc (nreverse dest) rest)
379 (t (list value nil)))
382 (defun chise-split-ccs-name (ccs)
383 (cond ((eq ccs '=ucs)
384 '(ucs abstract-character nil)
387 '(big5 abstract-character nil)
390 (setq ccs (symbol-name ccs))
392 (if (string-match "^\\(=[=+>]*\\)\\([^=>@*]+\\)@?" ccs)
393 (list (intern (match-string 2 ccs))
394 (chise-decode-ccs-prefix (match-string 1 ccs))
395 (if (string= (setq ret (substring ccs (match-end 0))) "")
400 (defun chise-decode-ccs-prefix (ccs)
401 (or (cdr (assoc ccs '(("==>" . super-abstract-character)
402 ("=>" . abstract-character)
403 ("=+>" . unified-glyph)
404 ("=" . abstract-glyph)
405 ("=>>" . detailed-glyph)
406 ("==" . abstract-glyph-form)
407 ("===" . glyph-image))))
410 (defun chise-turtle-uri-split-ccs (uri-ccs)
412 ((string-match "^a2\\." uri-ccs)
413 (cons ":super-abstract-character"
414 (substring uri-ccs (match-end 0)))
416 ((string-match "^a\\." uri-ccs)
417 (cons ":abstract-character"
418 (substring uri-ccs (match-end 0)))
420 ((string-match "^o\\." uri-ccs)
421 (cons ":unified-glyph"
422 (substring uri-ccs (match-end 0)))
424 ((string-match "^rep\\." uri-ccs)
425 (cons ":abstract-glyph"
426 (substring uri-ccs (match-end 0)))
428 ((string-match "^g\\." uri-ccs)
429 (cons ":detailed-glyph"
430 (substring uri-ccs (match-end 0)))
432 ((string-match "^g2\\." uri-ccs)
433 (cons ":abstract-glyph-form"
434 (substring uri-ccs (match-end 0)))
436 ((string-match "^gi\\." uri-ccs)
437 (cons ":abstract-glyph-form"
438 (substring uri-ccs (match-end 0)))
440 ((string-match "^repi\\." uri-ccs)
442 (substring uri-ccs (match-end 0)))
444 (t (cons ":character" uri-ccs))))
446 (defun char-db-turtle-insert-relation-feature (char name value line-breaking
448 (insert (format " %s%s "
449 (chise-turtle-uri-encode-feature-name name)
451 (char-db-turtle-insert-relations value readable)
455 (defun char-db-turtle-insert-metadata (name value)
457 (insert (format "%-7s " name))
459 ((or (eq name :sources)
461 (setq col (current-column))
462 (setq indent (make-string col ?\ ))
463 (insert (format "chisebib:%s"
464 (chise-turtle-uri-encode-ccs-name (car value))))
465 (dolist (source (cdr value))
466 (insert (format " ,\n%schisebib:%s" indent
467 (chise-turtle-uri-encode-ccs-name source))))
470 (insert (format "%S" value))
473 (defun char-db-turtle-insert-radical (radical-number)
474 (insert (format " %3d ; # %c"
476 (ideographic-radical radical-number)))
479 (defun char-db-turtle-insert-list (value &optional readable)
480 (let (lbs separator rest cell al cal key ret)
482 (setq lbs (concat "\n" (make-string (current-column) ?\ ))
485 (setq cell (car value))
486 (if (and (consp cell)
488 (setq ret (condition-case nil
496 (setq key (car (car rest)))
497 (if (find-charset key)
498 (setq cal (cons key cal))
499 (setq al (cons key al)))
500 (setq rest (cdr rest)))
503 (char-db-turtle-insert-char-features ret
507 (setq separator lbs))
508 (setq ret (prin1-to-string cell))
510 (if (< (+ (current-column)
517 (setq separator " "))
518 (setq value (cdr value)))
522 (defun char-db-turtle-insert-source-list (value &optional readable)
523 (let (lbs separator rest cell al cal key ret)
524 (setq lbs (concat " ,\n" (make-string (current-column) ?\ ))
527 (setq cell (car value))
528 (if (and (consp cell)
530 (setq ret (condition-case nil
538 (setq key (car (car rest)))
539 (if (find-charset key)
540 (setq cal (cons key cal))
541 (setq al (cons key al)))
542 (setq rest (cdr rest)))
545 (char-db-turtle-insert-char-features ret
549 (setq separator lbs))
550 (setq ret (prin1-to-string cell))
552 (if (< (+ (current-column)
558 (if (string-match "=" ret)
559 (insert (format "%s:%s"
560 (substring ret 0 (match-beginning 0))
561 (substring ret (match-end 0))))
562 (insert (format "chisebib:%s" ret)))
563 (setq separator " , "))
564 (setq value (cdr value)))
568 (defun char-db-turtle-insert-relations (value &optional readable)
569 (let ((lbs (concat "\n" (make-string (current-column) ?\ )))
571 (if (characterp value)
572 (setq value (list value)))
574 (setq cell (car value))
576 (setq cell (decode-char '=ucs cell)))
579 (setq separator (format " ,%s" lbs)))
580 (if (characterp cell)
581 (insert (format "%-20s" (chise-turtle-encode-char cell)))
582 (char-db-turtle-insert-char-ref cell '<-formed))
583 (setq value (cdr value)))
586 (defun char-db-turtle-insert-target-value (value feature-name-base &optional readable)
587 (cond ((eq feature-name-base 'ideographic-radical)
588 (char-db-turtle-insert-radical value)
590 ((or (eq feature-name-base 'ideographic-combination)
591 (eq feature-name-base '=decomposition)
592 (eq feature-name-base '<-formed)
593 (string-match "^\\(->\\|<-\\)[^*]*$" (symbol-name feature-name-base)))
594 (char-db-turtle-insert-relations value readable)
596 ((eq feature-name-base 'comment)
597 (insert (format "%S" value))
599 ((eq feature-name-base 'sources)
600 (char-db-turtle-insert-source-list value readable)
603 (char-db-turtle-insert-list value readable)
606 (insert (format " %-14s" value))
609 (defun char-db-turtle-insert-feature-value (value metadata domain feature-name-base)
610 (let (indent0 indent rest mdname mdval lb)
612 ((or metadata domain)
613 (setq indent0 (make-string (current-column) ?\ ))
615 (setq indent (make-string (current-column) ?\ ))
617 (insert (format ":context domain:%-7s ;"
618 (chise-turtle-uri-encode-ccs-name domain)))
622 (setq mdname (pop rest)
625 (insert (format "\n%s" indent))
627 (unless (char-db-turtle-insert-metadata mdname mdval)
630 (insert (format "\n%s" indent)))
632 (if (char-db-turtle-insert-target-value value feature-name-base)
633 (insert (format "\n%s] ;" indent0))
637 (char-db-turtle-insert-target-value value feature-name-base)
640 (defun char-db-turtle-insert-char-ref (char-ref feature-name-base)
641 (let (indent0 indent rest mdname mdval lb last-sep)
642 (setq indent0 (make-string (current-column) ?\ ))
644 (setq indent (make-string (current-column) ?\ ))
647 (setq mdname (pop rest)
650 (insert (format "%s\n%s"
657 (cond ((eq mdname :target)
659 (char-db-turtle-insert-target-value mdval feature-name-base)
662 (char-db-turtle-insert-metadata mdname mdval)))))
664 (insert (format "\n%s]" indent0))
668 (defun char-db-turtle-insert-char-features (char
669 &optional readable attributes column
672 (setq column (current-column)))
673 (let ((est-coded-charset-priority-list est-coded-charset-priority-list)
674 (est-view-url-prefix "http://chise.org/est/view")
675 id obj-id type domain
677 name-base name-domain
679 (line-breaking (concat "\n" (make-string column ?\ )))
683 dest-ccss ; sources required-features
685 uri-ccs uri-cpos ccs-base children child-ccs-list col indent)
689 (if (consp attributes)
691 (dolist (name attributes)
692 (unless (or (memq name char-db-ignored-attributes)
693 (string-match "\\*" (symbol-name name)))
694 (if (find-charset name)
698 (dolist (name (char-attribute-list))
699 (unless (or (memq name char-db-ignored-attributes)
700 (string-match "\\*" (symbol-name name)))
701 (if (find-charset name)
705 #'char-attribute-name<)))
706 (setq line-separator line-breaking)
707 (setq id (chise-turtle-encode-char char))
708 (setq obj-id (file-name-nondirectory id))
709 (string-match ":" obj-id)
710 (setq uri-ccs (substring obj-id 0 (match-beginning 0))
711 uri-cpos (substring obj-id (match-end 0)))
712 (insert (format "%s" obj-id))
713 (setq ret (assoc uri-ccs chise-turtle-ccs-prefix-alist))
714 (setq dest-ccss (list (cdr ret)))
715 (setq ret (chise-split-ccs-name (cdr ret)))
716 (setq ccs-base (car ret)
719 (insert (format "%s a chisegg:%s ;" line-separator type))
720 (insert (format "%s :%s-of" line-breaking type))
722 (insert (format " %s:%s ;"
723 (chise-turtle-uri-encode-ccs-name ccs-base) uri-cpos))
725 (setq col (current-column))
726 (insert (format ":context domain:%-7s ;\n%s:target %7s:%-7s ] ;"
727 (chise-turtle-uri-encode-ccs-name domain)
728 (make-string col ?\ )
729 (chise-turtle-uri-encode-ccs-name ccs-base) uri-cpos)))
730 (when (memq '<-subsumptive attributes)
731 (when (or readable (not for-sub-node))
732 (when (setq value (get-char-attribute char '<-subsumptive))
733 (insert line-separator)
734 (char-db-turtle-insert-relation-feature char '<-subsumptive value
738 (setq attributes (delq '<-subsumptive attributes))
740 (when (and (memq '<-denotational attributes)
741 (setq value (get-char-attribute char '<-denotational)))
742 (insert line-separator)
743 (char-db-turtle-insert-relation-feature char '<-denotational value
746 (setq attributes (delq '<-denotational attributes)))
747 (when (and (memq '<-denotational@component attributes)
749 (get-char-attribute char '<-denotational@component)))
750 (insert line-separator)
751 (char-db-turtle-insert-relation-feature
752 char '<-denotational@component value
755 (setq attributes (delq '<-denotational@component attributes)))
756 (when (and (memq 'name attributes)
757 (setq value (get-char-attribute char 'name)))
758 (insert (format "%s " line-separator))
760 (if (> (+ (current-column) (length value)) 48)
764 (setq attributes (delq 'name attributes))
766 (when (and (memq 'name* attributes)
767 (setq value (get-char-attribute char 'name*)))
768 (insert line-separator)
770 (if (> (+ (current-column) (length value)) 48)
774 (setq attributes (delq 'name* attributes))
776 (when (and (memq 'script attributes)
777 (setq value (get-char-attribute char 'script)))
778 (insert (format "%s :script\t\t ( %s ) ;"
780 (mapconcat (lambda (cell)
781 (format "script:%s" cell))
783 (setq attributes (delq 'script attributes))
785 ;; (dolist (name '(=>ucs =>ucs*))
786 ;; (when (and (memq name attributes)
787 ;; (setq value (get-char-attribute char name)))
788 ;; (insert line-separator)
789 ;; (insert (format " \"%-20s\": #x%04X,\t\"_comment\": \"%c\""
790 ;; name value (decode-char '=ucs value)))
791 ;; (setq attributes (delq name attributes))))
792 (when (and (memq '=>ucs attributes)
793 (setq value (get-char-attribute char '=>ucs)))
794 (insert (format "%s :to.ucs\t\t a.ucs:0x%04X ; # %c"
795 line-separator value (decode-char '=ucs value)))
796 (setq attributes (delq '=>ucs attributes))
798 (when (setq value (get-char-attribute char '=>ucs*))
799 (insert (format "%s :to.canonical-ucs\ta.ucs:0x%04X ; # %c"
800 line-separator value (decode-char '=ucs value)))
801 (setq attributes (delq '=>ucs* attributes))
803 (dolist (name '(=>ucs@gb =>ucs@big5))
804 (when (and (memq name attributes)
805 (setq value (get-char-attribute char name)))
806 (insert line-separator)
807 (insert (format " \"%-20s\": #x%04X,\t\"_comment\": \"%c\"%s"
812 (symbol-name name) 2)))
815 (setq attributes (delq name attributes))
817 (when (and (memq 'general-category attributes)
818 (setq value (get-char-attribute char 'general-category)))
819 (insert (format "%s :general-category \"%s\" ; # %s"
821 (cond ((rassoc value unidata-normative-category-alist)
822 "Normative Category")
823 ((rassoc value unidata-informative-category-alist)
824 "Informative Category")
826 "Unknown Category"))))
827 (setq attributes (delq 'general-category attributes))
829 (when (and (memq 'bidi-category attributes)
830 (setq value (get-char-attribute char 'bidi-category)))
831 (insert (format "%s :bidi-category %S ;"
834 (setq attributes (delq 'bidi-category attributes))
836 (unless (or (not (memq 'mirrored attributes))
837 (eq (setq value (get-char-attribute char 'mirrored 'empty))
839 (insert (format "%s :mirrored \"%s\" ;"
842 (setq attributes (delq 'mirrored attributes))
845 ((and (memq 'decimal-digit-value attributes)
846 (setq value (get-char-attribute char 'decimal-digit-value)))
847 (insert (format "%s :decimal-digit-value %2d ;"
848 line-separator value))
849 (setq attributes (delq 'decimal-digit-value attributes))
850 (when (and (memq 'digit-value attributes)
851 (setq value (get-char-attribute char 'digit-value)))
852 (insert (format "%s :digit-value\t %2d ;"
853 line-separator value))
854 (setq attributes (delq 'digit-value attributes))
856 (when (and (memq 'numeric-value attributes)
857 (setq value (get-char-attribute char 'numeric-value)))
858 (insert (format "%s :numeric-value\t %2d ;"
859 line-separator value))
860 (setq attributes (delq 'numeric-value attributes))
864 (when (and (memq 'digit-value attributes)
865 (setq value (get-char-attribute char 'digit-value)))
866 (insert line-separator)
867 (insert (format "%s :digit-value\t %2d ;"
868 line-separator value))
869 (setq attributes (delq 'digit-value attributes))
871 (when (and (memq 'numeric-value attributes)
872 (setq value (get-char-attribute char 'numeric-value)))
873 (insert line-separator)
874 (insert (format "%s :numeric-value\t %2d ;"
875 line-separator value))
876 (setq attributes (delq 'numeric-value attributes))
878 (when (and (memq 'iso-10646-comment attributes)
879 (setq value (get-char-attribute char 'iso-10646-comment)))
880 (insert line-separator)
881 (insert (format "{\"iso-10646-comment\":\t %S}%s"
884 (setq attributes (delq 'iso-10646-comment attributes))
886 (when (and (memq 'morohashi-daikanwa attributes)
887 (setq value (get-char-attribute char 'morohashi-daikanwa)))
888 (insert line-separator)
889 (insert (format "%s :morohashi-daikanwa\t %S ;"
890 line-separator value))
891 (setq attributes (delq 'morohashi-daikanwa attributes))
895 (when (and (memq 'ideographic-radical attributes)
896 (setq value (get-char-attribute char 'ideographic-radical)))
898 (insert (format "%s ideo:radical %3d ; # %c "
901 (ideographic-radical radical)
903 (setq attributes (delq 'ideographic-radical attributes))
905 (when (and (memq 'shuowen-radical attributes)
906 (setq value (get-char-attribute char 'shuowen-radical)))
907 (insert line-separator)
908 (insert (format " \"shuowen-radical\":\t %S,\t\"_comment\": \"%c\""
910 (shuowen-radical value)))
911 (setq attributes (delq 'shuowen-radical attributes))
916 char-db-feature-domains
918 (dolist (feature (char-attribute-list))
919 (setq feature (symbol-name feature))
921 "\\(radical\\|strokes\\)@\\([^@*]+\\)\\(\\*\\|$\\)"
923 (setq domain (intern (match-string 2 feature)))
924 (unless (memq domain dest)
925 (setq dest (cons domain dest)))))
926 (sort dest #'string<))))
927 (setq key (intern (format "%s@%s" 'ideographic-radical domain)))
928 (when (and (memq key attributes)
929 (setq value (get-char-attribute char key)))
931 (insert (format "%s ideo:radical "
933 (char-db-turtle-insert-feature-value value nil domain 'ideographic-radical)
934 (setq attributes (delq key attributes))
936 (setq key (intern (format "%s@%s" 'ideographic-strokes domain)))
937 (when (and (memq key attributes)
938 (setq value (get-char-attribute char key)))
940 (insert (format "%s ideo:strokes [ "
942 (setq col (current-column))
943 (setq indent (make-string col ?\ ))
944 (insert (format ":context domain:%-7s ;\n%s:target %S"
945 (chise-turtle-uri-encode-ccs-name domain)
947 (setq attributes (delq key attributes))
948 (setq skey (intern (format "%s*sources" key)))
949 (when (and (memq skey attributes)
950 (setq value (get-char-attribute char skey)))
951 (insert (format " ;\n%s:sources (" indent))
952 (setq col (current-column))
953 (setq indent (make-string col ?\ ))
954 (insert (format " chisebib:%s" (car value)))
955 (dolist (cell (cdr value))
956 (insert (format "\n%s chisebib:%s" indent cell)))
958 (setq attributes (delq skey attributes))
961 (setq key (intern (format "%s@%s" 'total-strokes domain)))
962 (when (and (memq key attributes)
963 (setq value (get-char-attribute char key)))
964 (insert (format "%s ideo:total-strokes [ "
966 (setq col (current-column))
967 (insert (format ":context domain:%-7s ;\n%s:target %S"
968 (chise-turtle-uri-encode-ccs-name domain)
969 (make-string col ?\ )
971 (setq attributes (delq key attributes))
972 (setq skey (intern (format "%s*sources" key)))
975 (dolist (feature '(ideographic-radical
978 (setq key (intern (format "%s@%s*sources" feature domain)))
979 (when (and (memq key attributes)
980 (setq value (get-char-attribute char key)))
981 (insert line-separator)
982 (insert (format " \"%s\":%s" key line-breaking))
984 (insert (format " %s" cell)))
985 (setq attributes (delq key attributes))
988 (when (and (memq 'ideographic-strokes attributes)
989 (setq value (get-char-attribute char 'ideographic-strokes)))
991 (insert (format "%s ideo:strokes %2d ;"
992 line-separator strokes))
993 (setq attributes (delq 'ideographic-strokes attributes))
995 (when (and (memq 'kangxi-radical attributes)
996 (setq value (get-char-attribute char 'kangxi-radical)))
997 (unless (eq value radical)
998 (insert line-separator)
999 (insert (format "{\"kangxi-radical\":\t%S},\t\"_comment\": \"%c\"%s"
1001 (ideographic-radical value)
1004 (setq radical value)))
1005 (setq attributes (delq 'kangxi-radical attributes))
1007 (when (and (memq 'kangxi-strokes attributes)
1008 (setq value (get-char-attribute char 'kangxi-strokes)))
1009 (unless (eq value strokes)
1010 (insert line-separator)
1011 (insert (format "{\"kangxi-strokes\":\t%S}%s"
1015 (setq strokes value)))
1016 (setq attributes (delq 'kangxi-strokes attributes))
1018 (when (and (memq 'japanese-strokes attributes)
1019 (setq value (get-char-attribute char 'japanese-strokes)))
1020 (unless (eq value strokes)
1021 (insert line-separator)
1022 (insert (format "{\"japanese-strokes\":\t%S}%s"
1026 (setq strokes value)))
1027 (setq attributes (delq 'japanese-strokes attributes))
1029 (when (and (memq 'cns-radical attributes)
1030 (setq value (get-char-attribute char 'cns-radical)))
1031 (insert line-separator)
1032 (insert (format "{\"cns-radical\":\t%S},\t\"_comment\": \"%c\"%s"
1034 (ideographic-radical value)
1036 (setq attributes (delq 'cns-radical attributes))
1038 (when (and (memq 'cns-strokes attributes)
1039 (setq value (get-char-attribute char 'cns-strokes)))
1040 (unless (eq value strokes)
1041 (insert line-separator)
1042 (insert (format "{\"cns-strokes\":\t%S}%s"
1046 (setq strokes value)))
1047 (setq attributes (delq 'cns-strokes attributes))
1049 (when (and (memq 'total-strokes attributes)
1050 (setq value (get-char-attribute char 'total-strokes)))
1051 (insert (format "%s ideo:total-strokes %2d ;"
1052 line-separator value))
1053 (setq attributes (delq 'total-strokes attributes))
1055 (if (equal (get-char-attribute char '->titlecase)
1056 (get-char-attribute char '->uppercase))
1057 (setq attributes (delq '->titlecase attributes)))
1059 (dolist (ignored '(composition
1060 ->denotational <-subsumptive ->ucs-unified
1061 ->ideographic-component-forms))
1062 (setq attributes (delq ignored attributes))))
1064 (setq name (car attributes))
1065 (setq ret (chise-split-feature-name name))
1066 (setq name-base (car ret)
1067 name-domain (nth 1 ret))
1068 (when (setq value (chise-get-char-attribute-with-metadata
1069 char name-base name-domain))
1070 (setq metadata (nth 1 value)
1072 (cond ((setq ret (find-charset name))
1073 (setq name (charset-name ret))
1074 (when (not (memq name dest-ccss))
1075 (setq dest-ccss (cons name dest-ccss))
1077 (insert (format "%s :%-25s rdf:nil ;" line-separator
1078 (chise-turtle-uri-encode-ccs-name name)))
1079 (setq ret (chise-turtle-format-ccs-code-point name value))
1080 (insert (format "%s :eq %-25s ; # %c" line-separator
1082 (char-db-decode-isolated-char name value)))
1083 (setq eq-cpos-list (cons (list ret name value) eq-cpos-list))))
1085 (setq ret (if (eq name '=ucs)
1086 (if (< value #x10000)
1089 (intern (format "=%s" name)))))
1090 (setq child-ccs-list (cons ret child-ccs-list)))
1094 (not (eq name '->subsumptive))
1095 (not (eq name '->uppercase))
1096 (not (eq name '->lowercase))
1097 (not (eq name '->titlecase))
1098 (not (eq name '->canonical))
1099 (not (eq name '->Bopomofo))
1100 (not (eq name '->mistakable))
1101 (not (eq name '->ideographic-variants))
1102 (or (eq name '<-identical)
1103 (eq name '<-uppercase)
1104 (eq name '<-lowercase)
1105 (eq name '<-titlecase)
1106 (eq name '<-canonical)
1107 (eq name '<-ideographic-variants)
1108 ;; (eq name '<-synonyms)
1109 (string-match "^<-synonyms" (symbol-name name))
1110 (eq name '<-mistakable)
1111 (when (string-match "^->" (symbol-name name))
1113 ((string-match "^->fullwidth" (symbol-name name))
1114 (not (and (consp value)
1115 (characterp (car value))
1117 (car value) '=ucs 'defined-only)))
1122 ((eq name 'ideographic-structure)
1123 (insert (isd-turtle-format-char nil nil value (/ column 4)
1124 'isd 'without-head-char))
1127 ((eq name '->subsumptive)
1128 (insert line-separator)
1129 (char-db-turtle-insert-relation-feature char name value
1132 (setq children value)
1135 (insert (format "%s %-20s "
1137 (chise-turtle-uri-encode-feature-name name-base)))
1138 (unless (char-db-turtle-insert-feature-value
1139 value metadata name-domain name-base)
1143 (setq attributes (cdr attributes)))
1144 (insert (format "%s ." line-breaking))
1145 (dolist (eq-cpos (nreverse eq-cpos-list))
1146 (setq ret (chise-split-ccs-name (nth 1 eq-cpos)))
1147 (insert (format "%s %s" line-breaking
1149 (insert (format "%s %25s" line-breaking
1150 (format ":%s-of" (nth 1 ret))))
1151 (if (null (nth 2 ret))
1152 (insert (format " %14s:%-7s ."
1153 (chise-turtle-uri-encode-ccs-name (car ret))
1154 (nth 1 (split-string (car eq-cpos) ":"))))
1156 (setq col (current-column))
1157 (insert (format ":context domain:%-7s ;\n%s:target %7s:%-7s ] ."
1158 (chise-turtle-uri-encode-ccs-name (nth 2 ret))
1159 (make-string col ?\ )
1160 (chise-turtle-uri-encode-ccs-name (car ret))
1161 (nth 1 (split-string (car eq-cpos) ":"))))))
1162 (setq est-coded-charset-priority-list
1163 (append est-coded-charset-priority-list
1164 (nreverse child-ccs-list)))
1166 (dolist (child children)
1167 (insert (format "%s " line-breaking))
1168 (char-db-turtle-insert-char-features child nil nil nil 'for-sub-node)))
1171 (defun char-db-turtle-insert-char-data (char &optional readable attributes)
1173 (narrow-to-region (point)(point))
1174 (char-db-turtle-insert-char-features char readable attributes)
1178 (defun char-db-turtle-insert-prefix ()
1179 (let (base-ccs-list ret)
1180 (insert "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> .
1181 @prefix : <http://rdf.chise.org/rdf/property/character/main/> .
1182 @prefix ideo: <http://rdf.chise.org/rdf/property/character/ideo/> .
1183 @prefix isd: <http://rdf.chise.org/rdf/property/character/isd/> .
1184 @prefix idc: <http://rdf.chise.org/rdf/type/character/idc/> .
1185 @prefix chisegg: <http://rdf.chise.org/rdf/type/character/ggg/> .
1186 @prefix domain: <http://rdf.chise.org/data/domain/> .
1187 @prefix script: <http://rdf.chise.org/data/script/> .
1188 @prefix ideocomb: <http://rdf.chise.org/data/character/ideo/combination/> .
1189 @prefix chisebib: <http://rdf.chise.org/data/bibliography/> .
1190 @prefix ruimoku: <http://www.chise.org/est/view/article@ruimoku/rep.id=/> .
1191 @prefix zob1959: <http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/> .
1194 (dolist (cell (sort chise-turtle-ccs-prefix-alist
1196 (char-attribute-name< (cdr a)(cdr b)))))
1197 (insert (format "@prefix %s: <%s/%s=> .\n"
1199 "http://www.chise.org/est/view/character"
1200 (www-uri-encode-feature-name (cdr cell))))
1201 (setq ret (chise-split-ccs-name (cdr cell)))
1202 (unless (memq (car ret) base-ccs-list)
1203 (setq base-ccs-list (cons (car ret) base-ccs-list))))
1205 (dolist (base-ccs (nreverse base-ccs-list))
1206 (insert (format "@prefix %s: <%s/%s/code-point/> .\n"
1207 (chise-turtle-uri-encode-ccs-name base-ccs)
1208 "http://rdf.chise.org/data/ccs"
1209 (www-uri-encode-feature-name base-ccs))))))
1211 (defun char-db-turtle-insert-ideograph-radical-char-data (radical)
1213 (sort (copy-list (aref ideograph-radical-chars-vector radical))
1215 (ideograph-char< a b radical))))
1217 (dolist (name (char-attribute-list))
1218 (unless (memq name char-db-ignored-attributes)
1219 (push name attributes)
1221 (setq attributes (sort attributes #'char-attribute-name<))
1222 (aset ideograph-radical-chars-vector radical chars)
1223 (dolist (char chars)
1224 (when (not (some (lambda (atr)
1225 (get-char-attribute char atr))
1226 char-db-ignored-attributes))
1227 (char-db-turtle-insert-char-data char nil attributes)))
1230 (defun char-db-turtle-write-ideograph-radical-char-data (radical file)
1231 (if (file-directory-p file)
1232 (let ((name (char-feature (decode-char 'ucs (+ #x2EFF radical))
1234 (if (string-match "KANGXI RADICAL " name)
1235 (setq name (capitalize (substring name (match-end 0)))))
1236 (setq name (mapconcat (lambda (char)
1239 (char-to-string char))) name ""))
1242 (format "Ideograph-R%03d-%s.ttl" radical name)
1244 (let (chise-turtle-ccs-prefix-alist)
1246 (char-db-turtle-insert-ideograph-radical-char-data radical)
1247 (goto-char (point-min))
1248 (char-db-turtle-insert-prefix)
1250 (goto-char (point-min))
1251 (insert (format "# -*- coding: %s -*-\n"
1252 char-db-file-coding-system))
1253 (let ((coding-system-for-write char-db-file-coding-system))
1254 (write-region (point-min)(point-max) file)))))
1260 (provide 'char-db-turtle)
1262 ;;; char-db-turtle.el ends here