update.
[chise/chiset.git] / char-db-turtle.el
1 ;;; char-db-turtle.el --- Character Database utility -*- coding: utf-8-er; -*-
2
3 ;; Copyright (C) 2017 MORIOKA Tomohiko.
4
5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
6 ;; Keywords: CHISE, Character Database, RDF, Turtle, ISO/IEC 10646, UCS, Unicode, MULE.
7
8 ;; This file is part of CHISET (CHISE/Turtle).
9
10 ;; XEmacs CHISE is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
14
15 ;; XEmacs CHISE is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
18 ;; General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs CHISE; see the file COPYING.  If not, write to
22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Code:
26
27 (require 'char-db-util)
28 (require 'cwiki-common)
29 (require 'isd-turtle)
30 (require 'ideograph-util)
31
32 (setq est-coded-charset-priority-list
33   '(; =ucs
34     =mj
35     =adobe-japan1-0
36     =adobe-japan1-1
37     =adobe-japan1-2
38     =adobe-japan1-3
39     =adobe-japan1-4
40     =adobe-japan1-5
41     =adobe-japan1-6
42     =ucs@iso
43     =jis-x0208 =jis-x0208@1990
44     =jis-x0213-1
45     =jis-x0213-1@2000 =jis-x0213-1@2004
46     =jis-x0213-2
47     =jis-x0212
48     =gt
49     =hanyo-denshi/ks
50     =hanyo-denshi/tk
51     =ucs-itaiji-001
52     =ucs-itaiji-002
53     =ucs-itaiji-003
54     =ucs-itaiji-004
55     =ucs-itaiji-005
56     =ucs-itaiji-006
57     =ucs-itaiji-007
58     =ucs-itaiji-009
59     =ucs-itaiji-011
60     =ucs-itaiji-084
61     =ucs-var-001
62     =ucs-var-002
63     =ucs-var-003
64     =ucs-var-004
65     =cns11643-1 =cns11643-2 =cns11643-3
66     =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
67     =gb2312
68     =big5-cdp
69     =ks-x1001
70     =gt-k
71     =ucs@unicode
72     =ucs@JP/hanazono
73     =gb12345
74     =ucs@cns
75     =ucs@gb
76     =zinbun-oracle =>zinbun-oracle
77     =daikanwa
78     =ruimoku-v6
79     =cbeta =jef-china3
80     =daikanwa/+2p
81     =+>ucs@iso =+>ucs@unicode
82     =+>ucs@jis
83     =+>ucs@cns
84     =+>ucs@ks
85     =+>ucs@jis/1990
86     =>mj
87     =>jis-x0208 =>jis-x0213-1
88     =>jis-x0208@1997
89     =>ucs@iwds-1
90     =>ucs@component
91     =>iwds-1
92     =>ucs@iso
93     =>ucs@unicode
94     =>ucs@jis =>ucs@cns =>ucs@ks
95     =>gt
96     =>gt-k
97     =>>ucs@iso =>>ucs@unicode
98     =>>ucs@jis =>>ucs@cns =>>ucs@ks
99     =>>gt-k
100     =>>hanyo-denshi/ks
101     ==mj
102     ==ucs@iso
103     ==ucs@unicode
104     ==adobe-japan1-0
105     ==adobe-japan1-1
106     ==adobe-japan1-2
107     ==adobe-japan1-3
108     ==adobe-japan1-4
109     ==adobe-japan1-5
110     ==adobe-japan1-6
111     ==ks-x1001
112     ==hanyo-denshi/ks
113     ==hanyo-denshi/tk
114     ==ucs@jis
115     ==gt
116     ==cns11643-1 ==cns11643-2 ==cns11643-3
117     ==cns11643-4 ==cns11643-5 ==cns11643-6 ==cns11643-7
118     ==jis-x0212
119     ==ucs@cns
120     ==koseki
121     ==daikanwa
122     ==gt-k
123     ==ucs@gb
124     ==ucs-itaiji-003
125     ==ucs@JP/hanazono
126     ==daikanwa/+2p
127     =>>jis-x0208 =>>jis-x0213-1 =>>jis-x0213-2
128     =+>jis-x0208 =+>jis-x0213-1 =+>jis-x0213-2
129     =+>hanyo-denshi/jt
130     =+>jis-x0208@1978
131     =>>gt
132     =+>adobe-japan1
133     =>>adobe-japan1
134     =jis-x0208@1983 =jis-x0208@1978
135     =>ucs-itaiji-001
136     =>ucs-itaiji-002
137     =>ucs-itaiji-005
138     =>ucs-itaiji-007
139     ==>ucs@bucs
140     =big5
141     =>cbeta
142     ===mj
143     ===ucs@iso
144     ===ucs@unicode
145     ===hanyo-denshi/ks
146     ===ks-x1001
147     ===gt
148     ===gt-k
149     ===ucs@ks
150     ===ucs@gb
151     =shinjigen
152     =shinjigen@rev
153     =shinjigen@1ed
154     =shinjigen/+p@rev
155     ==shinjigen
156     ==shinjigen@rev
157     ==daikanwa/+p
158     ==shinjigen@1ed
159     ===daikanwa/+p
160     =>daikanwa/ho
161     ===daikanwa/ho
162     ))
163
164 (defvar chise-turtle-ccs-prefix-alist nil)
165
166 (defun charset-code-point-format-spec (ccs)
167   (cond ((memq ccs '(=ucs))
168          "0x%04X")
169         (t
170          (let ((ccs-name (symbol-name ccs)))
171            (cond
172             ((string-match
173               "\\(shinjigen\\|daikanwa/ho\\|=>iwds-1\\)"
174               ccs-name)
175              "%04d")
176             ((string-match
177               "\\(gt\\|daikanwa\\|adobe-japan1\\|cbeta\\|zinbun-oracle\\|hng\\)"
178               ccs-name)
179              "%05d")
180             ((string-match "\\(hanyo-denshi/ks\\|koseki\\|mj\\)" ccs-name)
181              "%06d")
182             ((string-match "hanyo-denshi/tk" ccs-name)
183              "%08d")
184             (t
185              "0x%X"))))))
186
187 (defun chise-turtle-uri-decode-feature-name (uri-feature)
188   (cond ((string= "a.ucs" uri-feature)
189          '=ucs)
190         ((string= "a.big5" uri-feature)
191          '=big5)
192         (t
193          (www-uri-decode-feature-name uri-feature))))
194
195 (defun chise-turtle-uri-encode-ccs-name (feature-name)
196   (cond
197    ((eq '=ucs feature-name)
198     "a.ucs")
199    ((eq '=big5 feature-name)
200     "a.big5")
201    ((eq '==>ucs@bucs feature-name)
202     "bucs")
203    (t
204     (mapconcat (lambda (c)
205                  (cond
206                   ((eq c ?@)
207                    "_")
208                   ((eq c ?+)
209                    "._.")
210                   ((eq c ?=)
211                    ".:.")
212                   (t
213                    (char-to-string c))))
214                (www-uri-encode-feature-name feature-name)
215                ""))))
216
217 (defun chise-turtle-uri-encode-feature-name (feature-name)
218   (cond
219    ((eq '->subsumptive feature-name)
220     ":subsume")
221    ((eq '<-denotational feature-name)
222     ":denotation-of")
223    ((eq '<-formed feature-name)
224     ":form-of")
225    ((eq '<-same feature-name)
226     "ideo:same-as")
227    ((eq '<-simplified feature-name)
228     "ideo:simplified-form-of")
229    ((eq '<-vulgar feature-name)
230     "ideo:vulgar-form-of")
231    ((eq '<-wrong feature-name)
232     "ideo:wrong-form-of")
233    ((eq '<-original feature-name)
234     "ideo:original-form-of")
235    ((eq '<-ancient feature-name)
236     "ideo:ancient-form-of")
237    ((eq '<-Small-Seal feature-name)
238     "ideo:Small-Seal-of")
239    ((eq '<-interchangeable feature-name)
240     "ideo:interchangeable-form-of")
241    ((eq '->interchangeable feature-name)
242     "ideo:interchangeable")
243    ((eq '->mistakable feature-name)
244     "ideo:mistakable")
245    ((eq 'hanyu-dazidian feature-name)
246     "ideo:hanyu-dazidian")
247    (t
248     (concat ":" (chise-turtle-uri-encode-ccs-name feature-name)))))
249
250 (defun chise-turtle-format-ccs-code-point (ccs code-point)
251   (let ((ccs-uri (chise-turtle-uri-encode-ccs-name ccs)))
252     (unless (assoc ccs-uri chise-turtle-ccs-prefix-alist)
253       (setq chise-turtle-ccs-prefix-alist
254             (cons (cons ccs-uri ccs)
255                   chise-turtle-ccs-prefix-alist)))
256     (format "%s:%s"
257             ccs-uri
258             (format (charset-code-point-format-spec ccs)
259                     code-point))))
260
261 (defun chise-turtle-encode-char (object)
262   (let ((ccs-list est-coded-charset-priority-list)
263         ccs ret ret2)
264     (if (setq ret (encode-char object '=ucs))
265         (chise-turtle-format-ccs-code-point '=ucs ret)
266       (while (and ccs-list
267                   (setq ccs (pop ccs-list))
268                   (not (setq ret (encode-char object ccs 'defined-only)))))
269       (cond (ret
270              (chise-turtle-format-ccs-code-point ccs ret)
271              )
272             ((and (setq ccs (car (split-char object)))
273                   (setq ret (encode-char object ccs)))
274              (chise-turtle-format-ccs-code-point ccs ret)
275              )
276             ((setq ret (get-char-attribute object 'ideographic-combination))
277              (format "ideocomb:%s"
278                      (mapconcat (lambda (cell)
279                                   (cond ((characterp cell)
280                                          (char-to-string cell)
281                                          )
282                                         ((setq ret2 (find-char cell))
283                                          (char-to-string ret2)
284                                          )
285                                         (t
286                                          (format "%S" cell)
287                                          )))
288                                 ret ""))
289              )
290             (t
291              (format (if est-hide-cgi-mode
292                          "system-char-id=0x%X"
293                        "system-char-id:0x%X")
294                      (encode-char object 'system-char-id))
295              )))))
296
297 (defun chise-split-feature-name (feature-name)
298   (let (base domain number meta)
299     (setq feature-name (symbol-name feature-name))
300     (if (string-match ".\\*." feature-name)
301         (setq meta (intern
302                     (format ":%s" (substring feature-name (1- (match-end 0)))))
303               feature-name (substring feature-name 0 (1+ (match-beginning 0)))))
304     (if (string-match "\\$_\\([0-9]+\\)$" feature-name)
305         (setq number (car (read-from-string (match-string 1 feature-name)))
306               feature-name (substring feature-name 0 (match-beginning 0))))
307     (if (string-match "@" feature-name)
308         (setq domain (car (read-from-string (substring feature-name (match-end 0))))
309               base (intern (substring feature-name 0 (match-beginning 0))))
310       (setq base (intern feature-name)))
311     (list base domain number meta)))
312
313 (defun chise-compose-feature-name (base domain number meta)
314   (let ((name (if domain
315                   (format "%s@%s" base domain)
316                 (symbol-name base))))
317     (if number
318         (setq name (format "%s$_%d" name number)))
319     (if meta
320         (setq name (format "%s*%s" name
321                            (substring (symbol-name meta) 1))))
322     (intern name)))
323
324 (defvar chise-feature-name-base-metadata-alist nil)
325
326 (defun chise-update-feature-name-base-metadata-alist ()
327   (interactive)
328   (let (base domain number metadata
329              bcell dcell ncell ret)
330     (setq chise-feature-name-base-metadata-alist nil)
331     (dolist (fname (sort (char-attribute-list)
332                          #'char-attribute-name<))
333       (setq ret (chise-split-feature-name fname)
334             base (car ret)
335             domain (nth 1 ret)
336             number (nth 2 ret)
337             metadata (nth 3 ret))
338       (when metadata
339         (if (setq bcell (assq base chise-feature-name-base-metadata-alist))
340             (if (setq dcell (assq domain (cdr bcell)))
341                 (if (setq ncell (assq number (cdr dcell)))
342                     (unless (memq metadata (cdr ncell))
343                       (setcdr ncell (nconc (cdr ncell)
344                                            (list metadata))))
345                   (setcdr dcell (cons (list number metadata)
346                                       (cdr dcell))))
347               (setcdr bcell (cons (list domain (list number metadata))
348                                   (cdr bcell))))
349           (setq chise-feature-name-base-metadata-alist
350                 (cons (list base (list domain (list number metadata)))
351                       chise-feature-name-base-metadata-alist))
352           )))))
353
354 (chise-update-feature-name-base-metadata-alist)
355
356 (defun chise-get-char-attribute-with-metadata (character feature-name-base domain)
357   (let ((value (get-char-attribute
358                 character
359                 (chise-compose-feature-name feature-name-base domain nil nil)
360                 '*feature-value-is-empty*))
361         dcell
362         base-metadata metadata
363         ret m i rest dest)
364     (unless (eq value '*feature-value-is-empty*)
365       (cond
366        ((and (setq ret (assq feature-name-base
367                              chise-feature-name-base-metadata-alist))
368              (setq dcell (assq domain (cdr ret))))
369         (if (setq ret (assq nil (cdr dcell)))
370             (dolist (bmn (cdr ret))
371               (when (setq m (get-char-attribute
372                              character
373                              (chise-compose-feature-name
374                               feature-name-base domain nil bmn)))
375                 (setq base-metadata
376                       (list* bmn m base-metadata)))))
377         (setq i 1
378               rest value)
379         (while (consp rest)
380           (setq dest
381                 (cons (cond
382                        ((setq ret (assq i (cdr dcell)))
383                         (setq metadata nil)
384                         (dolist (mn (cdr ret))
385                           (when (setq m (get-char-attribute
386                                          character
387                                          (chise-compose-feature-name
388                                           feature-name-base domain i mn)))
389                             (setq metadata (list* mn m metadata))))
390                         (if metadata
391                             (list* :target (car rest) metadata)
392                           (car rest))
393                         )
394                        (t (car rest)))
395                       dest))
396           (setq i (1+ i)
397                 rest (cdr rest)))
398         (list (nconc (nreverse dest) rest)
399               base-metadata)
400         )
401        (t (list value nil)))
402       )))
403           
404 (defun chise-split-ccs-name (ccs)
405   (cond ((eq ccs '=ucs)
406          '(ucs abstract-character nil)
407          )
408         ((eq ccs '=big5)
409          '(big5 abstract-character nil)
410          )
411         (t
412          (setq ccs (symbol-name ccs))
413          (let (ret)
414            (if (string-match "^\\(=[=+>]*\\)\\([^=>@*]+\\)@?" ccs)
415                (list (intern (match-string 2 ccs))
416                      (chise-decode-ccs-prefix (match-string 1 ccs))
417                      (if (string= (setq ret (substring ccs (match-end 0))) "")
418                          nil
419                        (intern ret))))
420            ))))
421
422 (defun chise-decode-ccs-prefix (ccs)
423   (or (cdr (assoc ccs '(("==>" . super-abstract-character)
424                         ("=>"  . abstract-character)
425                         ("=+>" . unified-glyph)
426                         ("="   . abstract-glyph)
427                         ("=>>" . detailed-glyph)
428                         ("=="  . abstract-glyph-form)
429                         ("===" . glyph-image))))
430       'character))
431
432 (defun chise-turtle-uri-split-ccs (uri-ccs)
433   (cond
434    ((string-match "^a2\\." uri-ccs)
435     (cons ":super-abstract-character"
436           (substring uri-ccs (match-end 0)))
437     )
438    ((string-match "^a\\." uri-ccs)
439     (cons ":abstract-character"
440           (substring uri-ccs (match-end 0)))
441     )
442    ((string-match "^o\\." uri-ccs)
443     (cons ":unified-glyph"
444           (substring uri-ccs (match-end 0)))
445     )
446    ((string-match "^rep\\." uri-ccs)
447     (cons ":abstract-glyph"
448           (substring uri-ccs (match-end 0)))
449     )
450    ((string-match "^g\\." uri-ccs)
451     (cons ":detailed-glyph"
452           (substring uri-ccs (match-end 0)))
453     )
454    ((string-match "^g2\\." uri-ccs)
455     (cons ":abstract-glyph-form"
456           (substring uri-ccs (match-end 0)))
457     )
458    ((string-match "^gi\\." uri-ccs)
459     (cons ":abstract-glyph-form"
460           (substring uri-ccs (match-end 0)))
461     )
462    ((string-match "^repi\\." uri-ccs)
463     (cons ":glyph-image"
464           (substring uri-ccs (match-end 0)))
465     )
466    (t (cons ":character" uri-ccs))))
467
468 (defun char-db-turtle-insert-relation-feature (char name value line-breaking
469                                                     ccss readable)
470   (insert (format "    %s%s        "
471                   (chise-turtle-uri-encode-feature-name name)
472                   line-breaking))
473   (char-db-turtle-insert-relations value readable)
474   (insert " ;")
475   )
476
477 (defun char-db-turtle-insert-metadata (name value)
478   (let (col indent)
479     (insert (format "%-7s " name))
480     (cond
481      ((or (eq name :sources)
482           (eq name :denied))
483       (setq col (current-column))
484       (setq indent (make-string col ?\ ))
485       (insert (format "chisebib:%s"
486                       (chise-turtle-uri-encode-ccs-name (car value))))
487       (dolist (source (cdr value))
488         (insert (format " ,\n%schisebib:%s" indent
489                         (chise-turtle-uri-encode-ccs-name source))))
490       nil)
491      (t
492       (insert (format "%S" value))
493       nil))))
494
495 (defun char-db-turtle-insert-radical (radical-number)
496   (insert (format "        %3d ; # %c"
497                   radical-number
498                   (ideographic-radical radical-number)))
499   'with-separator)
500
501 (defun char-db-turtle-insert-list (value &optional readable)
502   (let (lbs separator rest cell al cal key ret)
503     (insert "( ")
504     (setq lbs (concat "\n" (make-string (current-column) ?\ ))
505           separator nil)
506     (while (consp value)
507       (setq cell (car value))
508       (if (and (consp cell)
509                (consp (car cell))
510                (setq ret (condition-case nil
511                              (find-char cell)
512                            (error nil))))
513           (progn
514             (setq rest cell
515                   al nil
516                   cal nil)
517             (while rest
518               (setq key (car (car rest)))
519               (if (find-charset key)
520                   (setq cal (cons key cal))
521                 (setq al (cons key al)))
522               (setq rest (cdr rest)))
523             (if separator
524                 (insert lbs))
525             (char-db-turtle-insert-char-features ret
526                                                  readable
527                                                  al
528                                                  nil 'for-sub-node)
529             (setq separator lbs))
530         (setq ret (prin1-to-string cell))
531         (if separator
532             (if (< (+ (current-column)
533                       (length ret)
534                       (length separator))
535                    76)
536                 (insert separator)
537               (insert lbs)))
538         (insert ret)
539         (setq separator " "))
540       (setq value (cdr value)))
541     (insert " ) ;")
542     'with-separator))
543
544 (defun char-db-turtle-insert-source-list (value &optional readable)
545   (let (lbs separator rest cell al cal key ret)
546     (setq lbs (concat " ,\n" (make-string (current-column) ?\ ))
547           separator nil)
548     (while (consp value)
549       (setq cell (car value))
550       (if (and (consp cell)
551                (consp (car cell))
552                (setq ret (condition-case nil
553                              (find-char cell)
554                            (error nil))))
555           (progn
556             (setq rest cell
557                   al nil
558                   cal nil)
559             (while rest
560               (setq key (car (car rest)))
561               (if (find-charset key)
562                   (setq cal (cons key cal))
563                 (setq al (cons key al)))
564               (setq rest (cdr rest)))
565             (if separator
566                 (insert lbs))
567             (char-db-turtle-insert-char-features ret
568                                                  readable
569                                                  al
570                                                  nil 'for-sub-node)
571             (setq separator lbs))
572         (setq ret (prin1-to-string cell))
573         (if separator
574             (if (< (+ (current-column)
575                       (length ret)
576                       (length separator))
577                    76)
578                 (insert separator)
579               (insert lbs)))
580         (if (string-match "=" ret)
581             (insert (format "%s:%s"
582                             (substring ret 0 (match-beginning 0))
583                             (substring ret (match-end 0))))
584           (insert (format "chisebib:%s" ret)))
585         (setq separator " , "))
586       (setq value (cdr value)))
587     (insert " ;")
588     'with-separator))
589
590 (defun char-db-turtle-insert-relations (value &optional readable)
591   (let ((lbs (concat "\n" (make-string (current-column) ?\ )))
592         separator cell)
593     (if (characterp value)
594         (setq value (list value)))
595     (while (consp value)
596       (setq cell (car value))
597       (if (integerp cell)
598           (setq cell (decode-char '=ucs cell)))
599       (if separator
600           (insert separator)
601         (setq separator (format " ,%s" lbs)))
602       (if (characterp cell)
603           (insert (format "%-20s" (chise-turtle-encode-char cell)))
604         (char-db-turtle-insert-char-ref cell '<-formed))
605       (setq value (cdr value)))
606     nil))
607
608 (defun char-db-turtle-insert-target-value (value feature-name-base &optional readable)
609   (cond ((eq feature-name-base 'ideographic-radical)
610          (char-db-turtle-insert-radical value)
611          )
612         ((or (eq feature-name-base 'ideographic-combination)
613              (eq feature-name-base '=decomposition)
614              (eq feature-name-base '<-formed)
615              (string-match "^\\(->\\|<-\\)[^*]*$" (symbol-name feature-name-base)))
616          (char-db-turtle-insert-relations value readable)
617          )
618         ((eq feature-name-base 'comment)
619          (insert (format "%S" value))
620          nil)
621         ((eq feature-name-base 'sources)
622          (char-db-turtle-insert-source-list value readable)
623          )
624         ((consp value)
625          (char-db-turtle-insert-list value readable)
626          )
627         (t
628          (insert (format " %-14s" value))
629          nil)))
630
631 (defun char-db-turtle-insert-feature-value (value metadata domain feature-name-base)
632   (let (indent0 indent rest mdname mdval lb)
633     (cond
634      ((or metadata domain)
635       (setq indent0 (make-string (current-column) ?\ ))
636       (insert "[ ")
637       (setq indent (make-string (current-column) ?\ ))
638       (when domain
639         (insert (format ":context domain:%-7s ;"
640                         (chise-turtle-uri-encode-ccs-name domain)))
641         (setq lb t))
642       (setq rest metadata)
643       (while rest
644         (setq mdname (pop rest)
645               mdval  (pop rest))
646         (if lb
647             (insert (format "\n%s" indent))
648           (setq lb t))
649         (unless (char-db-turtle-insert-metadata mdname mdval)
650           (insert " ;")))
651       (if lb
652           (insert (format "\n%s" indent)))
653       (insert ":target  ")
654       (if (char-db-turtle-insert-target-value value feature-name-base)
655           (insert (format "\n%s] ;" indent0))
656         (insert " ] ;"))
657       'with-separator)
658      (t
659       (char-db-turtle-insert-target-value value feature-name-base)
660       ))))
661
662 (defun char-db-turtle-insert-char-ref (char-ref feature-name-base)
663   (let (indent0 indent rest mdname mdval lb last-sep)
664     (setq indent0 (make-string (current-column) ?\ ))
665     (insert "[ ")
666     (setq indent (make-string (current-column) ?\ ))
667     (setq rest char-ref)
668     (while rest
669       (setq mdname (pop rest)
670             mdval  (pop rest))
671       (if lb
672           (insert (format "%s\n%s"
673                           (if last-sep
674                               ""
675                             " ;")
676                           indent))
677         (setq lb t))
678       (setq last-sep
679             (cond ((eq mdname :target)
680                    (insert ":target  ")
681                    (char-db-turtle-insert-target-value mdval feature-name-base)
682                      )
683                   (t
684                    (char-db-turtle-insert-metadata mdname mdval)))))
685     (if last-sep
686         (insert (format "\n%s]" indent0))
687       (insert " ]"))
688     nil))
689   
690 (defun char-db-turtle-insert-char-features (char
691                                             &optional readable attributes column
692                                             for-sub-node)
693   (unless column
694     (setq column (current-column)))
695   (let ((est-coded-charset-priority-list est-coded-charset-priority-list)
696         (est-view-url-prefix "http://chise.org/est/view")
697         id obj-id type domain
698         name value metadata
699         name-base name-domain
700         radical strokes
701         (line-breaking (concat "\n" (make-string column ?\ )))
702         line-separator
703         ret
704         skey
705         dest-ccss ; sources required-features
706         ccss eq-cpos-list
707         uri-ccs uri-cpos ccs-base children child-ccs-list col indent)
708     (let (atr-d)
709       (setq attributes
710             (sort (if attributes
711                       (if (consp attributes)
712                           (progn
713                             (dolist (name attributes)
714                               (unless (or (memq name char-db-ignored-attributes)
715                                           (string-match "\\*" (symbol-name name)))
716                                 (if (find-charset name)
717                                     (push name ccss))
718                                 (push name atr-d)))
719                             atr-d))
720                     (dolist (name (char-attribute-list))
721                       (unless (or (memq name char-db-ignored-attributes)
722                                   (string-match "\\*" (symbol-name name)))
723                         (if (find-charset name)
724                             (push name ccss))
725                         (push name atr-d)))
726                     atr-d)
727                   #'char-attribute-name<)))
728     (setq line-separator line-breaking)
729     (setq id (chise-turtle-encode-char char))
730     (setq obj-id (file-name-nondirectory id))
731     (string-match ":" obj-id)
732     (setq uri-ccs (substring obj-id 0 (match-beginning 0))
733           uri-cpos (substring obj-id (match-end 0)))
734     (insert (format "%s" obj-id))
735     (setq ret (assoc uri-ccs chise-turtle-ccs-prefix-alist))
736     (setq dest-ccss (list (cdr ret)))
737     (setq ret (chise-split-ccs-name (cdr ret)))
738     (setq ccs-base (car ret)
739           type (nth 1 ret)
740           domain (nth 2 ret))
741     (insert (format "%s    a chisegg:%s ;" line-separator type))
742     (insert (format "%s    :%s-of" line-breaking type))
743     (if (null domain)
744         (insert (format " %s:%s ;"
745                         (chise-turtle-uri-encode-ccs-name ccs-base) uri-cpos))
746       (insert " [ ")
747       (setq col (current-column))
748       (insert (format ":context domain:%-7s ;\n%s:target %7s:%-7s ] ;"
749                       (chise-turtle-uri-encode-ccs-name domain)
750                       (make-string col ?\ )
751                       (chise-turtle-uri-encode-ccs-name ccs-base) uri-cpos)))
752     (when (memq '<-subsumptive attributes)
753       (when (or readable (not for-sub-node))
754         (when (setq value (get-char-attribute char '<-subsumptive))
755           (insert line-separator)
756           (char-db-turtle-insert-relation-feature char '<-subsumptive value
757                                                   line-breaking
758                                                   ccss readable)
759           ))
760       (setq attributes (delq '<-subsumptive attributes))
761       )
762     (when (and (memq '<-denotational attributes)
763                (setq value (get-char-attribute char '<-denotational)))
764       (insert line-separator)
765       (char-db-turtle-insert-relation-feature char '<-denotational value
766                                             line-breaking
767                                             ccss readable)
768       (setq attributes (delq '<-denotational attributes)))
769     (when (and (memq '<-denotational@component attributes)
770                (setq value
771                      (get-char-attribute char '<-denotational@component)))
772       (insert line-separator)
773       (char-db-turtle-insert-relation-feature
774        char '<-denotational@component value
775        line-breaking
776        ccss readable)
777       (setq attributes (delq '<-denotational@component attributes)))
778     (when (and (memq 'name attributes)
779                (setq value (get-char-attribute char 'name)))
780       (insert (format "%s    " line-separator))
781       (insert (format
782                (if (> (+ (current-column) (length value)) 48)
783                    ":name %S ;"
784                  ":name                 %S ;")
785                value))
786       (setq attributes (delq 'name attributes))
787       )
788     (when (and (memq 'name* attributes)
789                (setq value (get-char-attribute char 'name*)))
790       (insert line-separator)
791       (insert (format
792                (if (> (+ (current-column) (length value)) 48)
793                    " \"name*\": %S"
794                  " \"name*\":                 %S")
795                value))
796       (setq attributes (delq 'name* attributes))
797       )
798     (when (and (memq 'script attributes)
799                (setq value (get-char-attribute char 'script)))
800       (insert (format "%s    :script\t\t  ( %s ) ;"
801                       line-separator
802                       (mapconcat (lambda (cell)
803                                    (format "script:%s" cell))
804                                  value " ")))
805       (setq attributes (delq 'script attributes))
806       )
807     ;; (dolist (name '(=>ucs =>ucs*))
808     ;;   (when (and (memq name attributes)
809     ;;              (setq value (get-char-attribute char name)))
810     ;;     (insert line-separator)
811     ;;     (insert (format " \"%-20s\":  #x%04X,\t\"_comment\": \"%c\""
812     ;;                     name value (decode-char '=ucs value)))
813     ;;     (setq attributes (delq name attributes))))
814     (when (and (memq '=>ucs attributes)
815                (setq value (get-char-attribute char '=>ucs)))
816       (insert (format "%s    :to.ucs\t\t  a.ucs:0x%04X ; # %c"
817                       line-separator value (decode-char '=ucs value)))
818       (setq attributes (delq '=>ucs attributes))
819       )
820     (when (setq value (get-char-attribute char '=>ucs*))
821       (insert (format "%s    :to.canonical-ucs\ta.ucs:0x%04X ; # %c"
822                       line-separator value (decode-char '=ucs value)))
823       (setq attributes (delq '=>ucs* attributes))
824       )
825     (dolist (name '(=>ucs@gb =>ucs@big5))
826       (when (and (memq name attributes)
827                  (setq value (get-char-attribute char name)))
828         (insert line-separator)
829         (insert (format " \"%-20s\":  #x%04X,\t\"_comment\": \"%c\"%s"
830                         name value
831                         (decode-char (intern
832                                       (concat "="
833                                               (substring
834                                                (symbol-name name) 2)))
835                                      value)
836                         line-breaking))
837         (setq attributes (delq name attributes))
838         ))
839     (when (and (memq 'general-category attributes)
840                (setq value (get-char-attribute char 'general-category)))
841       (insert (format "%s    :general-category     \"%s\" ; # %s"
842                       line-separator value
843                       (cond ((rassoc value unidata-normative-category-alist)
844                              "Normative Category")
845                             ((rassoc value unidata-informative-category-alist)
846                              "Informative Category")
847                             (t
848                              "Unknown Category"))))
849       (setq attributes (delq 'general-category attributes))
850       )
851     (when (and (memq 'bidi-category attributes)
852                (setq value (get-char-attribute char 'bidi-category)))
853       (insert (format "%s    :bidi-category        %S ;"
854                       line-separator
855                       value))
856       (setq attributes (delq 'bidi-category attributes))
857       )
858     (unless (or (not (memq 'mirrored attributes))
859                 (eq (setq value (get-char-attribute char 'mirrored 'empty))
860                     'empty))
861       (insert (format "%s    :mirrored             \"%s\" ;"
862                       line-separator
863                       value))
864       (setq attributes (delq 'mirrored attributes))
865       )
866     (cond
867      ((and (memq 'decimal-digit-value attributes)
868            (setq value (get-char-attribute char 'decimal-digit-value)))
869       (insert (format "%s    :decimal-digit-value  %2d ;"
870                       line-separator value))
871       (setq attributes (delq 'decimal-digit-value attributes))
872       (when (and (memq 'digit-value attributes)
873                  (setq value (get-char-attribute char 'digit-value)))
874         (insert (format "%s    :digit-value\t  %2d ;"
875                         line-separator value))
876         (setq attributes (delq 'digit-value attributes))
877         )
878       (when (and (memq 'numeric-value attributes)
879                  (setq value (get-char-attribute char 'numeric-value)))
880         (insert (format "%s    :numeric-value\t  %2d ;"
881                         line-separator value))
882         (setq attributes (delq 'numeric-value attributes))
883         )
884       )
885      (t
886       (when (and (memq 'digit-value attributes)
887                  (setq value (get-char-attribute char 'digit-value)))
888         (insert line-separator)
889         (insert (format "%s    :digit-value\t  %2d ;"
890                         line-separator value))
891         (setq attributes (delq 'digit-value attributes))
892         )
893       (when (and (memq 'numeric-value attributes)
894                  (setq value (get-char-attribute char 'numeric-value)))
895         (insert line-separator)
896         (insert (format "%s    :numeric-value\t  %2d ;"
897                         line-separator value))
898         (setq attributes (delq 'numeric-value attributes))
899         )))
900     (when (and (memq 'iso-10646-comment attributes)
901                (setq value (get-char-attribute char 'iso-10646-comment)))
902       (insert line-separator)
903       (insert (format "{\"iso-10646-comment\":\t %S}%s"
904                       value
905                       line-breaking))
906       (setq attributes (delq 'iso-10646-comment attributes))
907       )
908     (when (and (memq 'morohashi-daikanwa attributes)
909                (setq value (get-char-attribute char 'morohashi-daikanwa)))
910       (insert line-separator)
911       (insert (format "%s    :morohashi-daikanwa\t  %S ;"
912                       line-separator value))
913       (setq attributes (delq 'morohashi-daikanwa attributes))
914       )
915     (setq radical nil
916           strokes nil)
917     (when (and (memq 'ideographic-radical attributes)
918                (setq value (get-char-attribute char 'ideographic-radical)))
919       (setq radical value)
920       (insert (format "%s    ideo:radical         %3d ; # %c "
921                       line-separator
922                       radical
923                       (ideographic-radical radical)
924                       ))
925       (setq attributes (delq 'ideographic-radical attributes))
926       )
927     (when (and (memq 'shuowen-radical attributes)
928                (setq value (get-char-attribute char 'shuowen-radical)))
929       (insert line-separator)
930       (insert (format " \"shuowen-radical\":\t %S,\t\"_comment\": \"%c\""
931                       value
932                       (shuowen-radical value)))
933       (setq attributes (delq 'shuowen-radical attributes))
934       )
935     (let (key)
936       (dolist (domain
937                (append
938                 char-db-feature-domains
939                 (let (dest domain)
940                   (dolist (feature (char-attribute-list))
941                     (setq feature (symbol-name feature))
942                     (when (string-match
943                            "\\(radical\\|strokes\\)@\\([^@*]+\\)\\(\\*\\|$\\)"
944                            feature)
945                       (setq domain (intern (match-string 2 feature)))
946                      (unless (memq domain dest)
947                        (setq dest (cons domain dest)))))
948                   (sort dest #'string<))))
949         (setq key (intern (format "%s@%s" 'ideographic-radical domain)))
950         (when (and (memq key attributes)
951                    (setq value (get-char-attribute char key)))
952           (setq radical value)
953           (insert (format "%s    ideo:radical           "
954                           line-separator))
955           (char-db-turtle-insert-feature-value value nil domain 'ideographic-radical)
956           (setq attributes (delq key attributes))
957           )
958         (setq key (intern (format "%s@%s" 'ideographic-strokes domain)))
959         (when (and (memq key attributes)
960                    (setq value (get-char-attribute char key)))
961           (setq strokes value)
962           (insert (format "%s    ideo:strokes           [ "
963                           line-separator))
964           (setq col (current-column))
965           (setq indent (make-string col ?\ ))
966           (insert (format ":context domain:%-7s ;\n%s:target  %S"
967                           (chise-turtle-uri-encode-ccs-name domain)
968                           indent strokes))
969           (setq attributes (delq key attributes))
970           (setq skey (intern (format "%s*sources" key)))
971           (when (and (memq skey attributes)
972                      (setq value (get-char-attribute char skey)))
973             (insert (format " ;\n%s:sources (" indent))
974             (setq col (current-column))
975             (setq indent (make-string col ?\ ))
976             (insert (format " chisebib:%s" (car value)))
977             (dolist (cell (cdr value))
978               (insert (format "\n%s chisebib:%s" indent cell)))
979             (insert " )"))
980           (setq attributes (delq skey attributes))
981           (insert " ] ;")
982           )
983         (setq key (intern (format "%s@%s" 'total-strokes domain)))
984         (when (and (memq key attributes)
985                    (setq value (get-char-attribute char key)))
986           (insert (format "%s    ideo:total-strokes     [ "
987                           line-separator))
988           (setq col (current-column))
989           (insert (format ":context domain:%-7s ;\n%s:target  %S"
990                           (chise-turtle-uri-encode-ccs-name domain)
991                           (make-string col ?\ )
992                           value))
993           (setq attributes (delq key attributes))
994           (setq skey (intern (format "%s*sources" key)))
995           (insert " ] ;")
996           )
997         (dolist (feature '(ideographic-radical
998                            ideographic-strokes
999                            total-strokes))
1000           (setq key (intern (format "%s@%s*sources" feature domain)))
1001           (when (and (memq key attributes)
1002                      (setq value (get-char-attribute char key)))
1003             (insert line-separator)
1004             (insert (format " \"%s\":%s" key line-breaking))
1005             (dolist (cell value)
1006               (insert (format " %s" cell)))
1007             (setq attributes (delq key attributes))
1008             ))
1009         ))
1010     (when (and (memq 'ideographic-strokes attributes)
1011                (setq value (get-char-attribute char 'ideographic-strokes)))
1012       (setq strokes value)
1013       (insert (format "%s    ideo:strokes          %2d ;"
1014                       line-separator strokes))
1015       (setq attributes (delq 'ideographic-strokes attributes))
1016       )
1017     (when (and (memq 'kangxi-radical attributes)
1018                (setq value (get-char-attribute char 'kangxi-radical)))
1019       (unless (eq value radical)
1020         (insert line-separator)
1021         (insert (format "{\"kangxi-radical\":\t%S},\t\"_comment\": \"%c\"%s"
1022                         value
1023                         (ideographic-radical value)
1024                         line-breaking))
1025         (or radical
1026             (setq radical value)))
1027       (setq attributes (delq 'kangxi-radical attributes))
1028       )
1029     (when (and (memq 'kangxi-strokes attributes)
1030                (setq value (get-char-attribute char 'kangxi-strokes)))
1031       (unless (eq value strokes)
1032         (insert line-separator)
1033         (insert (format "{\"kangxi-strokes\":\t%S}%s"
1034                         value
1035                         line-breaking))
1036         (or strokes
1037             (setq strokes value)))
1038       (setq attributes (delq 'kangxi-strokes attributes))
1039       )
1040     (when (and (memq 'japanese-strokes attributes)
1041                (setq value (get-char-attribute char 'japanese-strokes)))
1042       (unless (eq value strokes)
1043         (insert line-separator)
1044         (insert (format "{\"japanese-strokes\":\t%S}%s"
1045                         value
1046                         line-breaking))
1047         (or strokes
1048             (setq strokes value)))
1049       (setq attributes (delq 'japanese-strokes attributes))
1050       )
1051     (when (and (memq 'cns-radical attributes)
1052                (setq value (get-char-attribute char 'cns-radical)))
1053       (insert line-separator)
1054       (insert (format "{\"cns-radical\":\t%S},\t\"_comment\": \"%c\"%s"
1055                       value
1056                       (ideographic-radical value)
1057                       line-breaking))
1058       (setq attributes (delq 'cns-radical attributes))
1059       )
1060     (when (and (memq 'cns-strokes attributes)
1061                (setq value (get-char-attribute char 'cns-strokes)))
1062       (unless (eq value strokes)
1063         (insert line-separator)
1064         (insert (format "{\"cns-strokes\":\t%S}%s"
1065                         value
1066                         line-breaking))
1067         (or strokes
1068             (setq strokes value)))
1069       (setq attributes (delq 'cns-strokes attributes))
1070       )
1071     (when (and (memq 'total-strokes attributes)
1072                (setq value (get-char-attribute char 'total-strokes)))
1073       (insert (format "%s    ideo:total-strokes    %2d ;"
1074                       line-separator value))
1075       (setq attributes (delq 'total-strokes attributes))
1076       )
1077     (if (equal (get-char-attribute char '->titlecase)
1078                (get-char-attribute char '->uppercase))
1079         (setq attributes (delq '->titlecase attributes)))
1080     (unless readable
1081       (dolist (ignored '(composition
1082                          ->denotational <-subsumptive ->ucs-unified
1083                          ->ideographic-component-forms))
1084         (setq attributes (delq ignored attributes))))
1085     (while attributes
1086       (setq name (car attributes))
1087       (setq ret (chise-split-feature-name name))
1088       (setq name-base (car ret)
1089             name-domain (nth 1 ret))
1090       (when (setq value (chise-get-char-attribute-with-metadata
1091                          char name-base name-domain))
1092         (setq metadata (nth 1 value)
1093               value (car value))
1094         (cond ((setq ret (find-charset name))
1095                (setq name (charset-name ret))
1096                (when (not (memq name dest-ccss))
1097                  (setq dest-ccss (cons name dest-ccss))
1098                  (if (null value)
1099                      (insert (format "%s    :%-25s rdf:nil ;" line-separator
1100                                      (chise-turtle-uri-encode-ccs-name name)))
1101                    (setq ret (chise-turtle-format-ccs-code-point name value))
1102                    (insert (format "%s    :eq %-25s ; # %c" line-separator
1103                                    ret
1104                                    (char-db-decode-isolated-char name value)))
1105                    (setq eq-cpos-list (cons (list ret name value) eq-cpos-list))))
1106                (if (find-charset
1107                     (setq ret (if (eq name '=ucs)
1108                                   (if (< value #x10000)
1109                                       '==ucs@unicode
1110                                     '==ucs@iso)
1111                                 (intern (format "=%s" name)))))
1112                    (setq child-ccs-list (cons ret child-ccs-list)))
1113                )
1114               ((and
1115                 (not readable)
1116                 (not (eq name '->subsumptive))
1117                 (not (eq name '->uppercase))
1118                 (not (eq name '->lowercase))
1119                 (not (eq name '->titlecase))
1120                 (not (eq name '->canonical))
1121                 (not (eq name '->Bopomofo))
1122                 (not (eq name '->mistakable))
1123                 (not (eq name '->ideographic-variants))
1124                 (or (eq name '<-identical)
1125                     (eq name '<-uppercase)
1126                     (eq name '<-lowercase)
1127                     (eq name '<-titlecase)
1128                     (eq name '<-canonical)
1129                     (eq name '<-ideographic-variants)
1130                     ;; (eq name '<-synonyms)
1131                     (string-match "^<-synonyms" (symbol-name name))
1132                     (eq name '<-mistakable)
1133                     (when (string-match "^->" (symbol-name name))
1134                       (cond
1135                        ((string-match "^->fullwidth" (symbol-name name))
1136                         (not (and (consp value)
1137                                   (characterp (car value))
1138                                   (encode-char
1139                                    (car value) '=ucs 'defined-only)))
1140                         )
1141                        (t)))
1142                     ))
1143                )
1144               ((eq name 'ideographic-structure)
1145                (insert (isd-turtle-format-char nil nil value (/ column 4)
1146                                                'isd 'without-head-char))
1147                (insert " ;")
1148                )
1149               ((eq name '->subsumptive)
1150                (insert line-separator)
1151                (char-db-turtle-insert-relation-feature char name value
1152                                                        line-breaking
1153                                                        ccss readable)
1154                (setq children value)
1155                )
1156               (t
1157                (insert (format "%s    %-20s "
1158                                line-separator
1159                                (chise-turtle-uri-encode-feature-name name-base)))
1160                (unless (char-db-turtle-insert-feature-value
1161                         value metadata name-domain name-base)
1162                  (insert " ;"))
1163                )
1164               ))
1165       (setq attributes (cdr attributes)))
1166     (insert (format "%s    ." line-breaking))
1167     (dolist (eq-cpos (nreverse eq-cpos-list))
1168       (setq ret (chise-split-ccs-name (nth 1 eq-cpos)))
1169       (insert (format "%s    %s" line-breaking
1170                       (car eq-cpos)))
1171       (insert (format "%s        %25s" line-breaking
1172                       (format ":%s-of" (nth 1 ret))))
1173       (if (null (nth 2 ret))
1174           (insert (format " %14s:%-7s ."
1175                           (chise-turtle-uri-encode-ccs-name (car ret))
1176                           (nth 1 (split-string (car eq-cpos) ":"))))
1177         (insert " [ ")
1178         (setq col (current-column))
1179         (insert (format ":context domain:%-7s ;\n%s:target %7s:%-7s ] ."
1180                         (chise-turtle-uri-encode-ccs-name (nth 2 ret))
1181                         (make-string col ?\ )
1182                         (chise-turtle-uri-encode-ccs-name (car ret))
1183                         (nth 1 (split-string (car eq-cpos) ":"))))))
1184     (setq est-coded-charset-priority-list
1185           (append est-coded-charset-priority-list
1186                   (nreverse child-ccs-list)))
1187     (when children
1188       (dolist (child children)
1189         (insert (format "%s    " line-breaking))
1190         (char-db-turtle-insert-char-features child nil nil nil 'for-sub-node)))
1191     ))
1192
1193 (defun char-db-turtle-insert-char-data (char &optional readable attributes)
1194   (save-restriction
1195     (narrow-to-region (point)(point))
1196     (char-db-turtle-insert-char-features char readable attributes)
1197     (insert "\n\n")
1198     ))
1199
1200 (defun char-db-turtle-insert-prefix ()
1201   (let (base-ccs-list ret)
1202     (insert "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> .
1203 @prefix : <http://rdf.chise.org/rdf/property/character/main/> .
1204 @prefix ideo: <http://rdf.chise.org/rdf/property/character/ideo/> .
1205 @prefix isd: <http://rdf.chise.org/rdf/property/character/isd/> .
1206 @prefix idc: <http://rdf.chise.org/rdf/type/character/idc/> .
1207 @prefix chisegg: <http://rdf.chise.org/rdf/type/character/ggg/> .
1208 @prefix domain: <http://rdf.chise.org/data/domain/> .
1209 @prefix script: <http://rdf.chise.org/data/script/> .
1210 @prefix ideocomb: <http://rdf.chise.org/data/character/ideo/combination/> .
1211 @prefix chisebib: <http://rdf.chise.org/data/bibliography/> .
1212 @prefix ruimoku: <http://www.chise.org/est/view/article@ruimoku/rep.id=/> .
1213 @prefix zob1959: <http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/> .
1214
1215 ")
1216     (dolist (cell (sort chise-turtle-ccs-prefix-alist
1217                         (lambda (a b)
1218                           (char-attribute-name< (cdr a)(cdr b)))))
1219       (insert (format "@prefix %s: <%s/%s=> .\n"
1220                       (car cell)
1221                       "http://www.chise.org/est/view/character"
1222                       (www-uri-encode-feature-name (cdr cell))))
1223       (setq ret (chise-split-ccs-name (cdr cell)))
1224       (unless (memq (car ret) base-ccs-list)
1225         (setq base-ccs-list (cons (car ret) base-ccs-list))))
1226     (insert "\n")
1227     (dolist (base-ccs (nreverse base-ccs-list))
1228       (insert (format "@prefix %s: <%s/%s/code-point/> .\n"
1229                       (chise-turtle-uri-encode-ccs-name base-ccs)
1230                       "http://rdf.chise.org/data/ccs"
1231                       (www-uri-encode-feature-name base-ccs))))))
1232
1233 (defun char-db-turtle-insert-ideograph-radical-char-data (radical)
1234   (let ((chars
1235          (sort (copy-list (aref ideograph-radical-chars-vector radical))
1236                (lambda (a b)
1237                  (ideograph-char< a b radical))))
1238         attributes)
1239     (dolist (name (char-attribute-list))
1240       (unless (memq name char-db-ignored-attributes)
1241         (push name attributes)
1242         ))
1243     (setq attributes (sort attributes #'char-attribute-name<))
1244     (aset ideograph-radical-chars-vector radical chars)
1245     (dolist (char chars)
1246       (when (not (some (lambda (atr)
1247                          (get-char-attribute char atr))
1248                        char-db-ignored-attributes))
1249         (char-db-turtle-insert-char-data char nil attributes)))
1250     ))
1251
1252 (defun char-db-turtle-write-ideograph-radical-char-data (radical file)
1253   (if (file-directory-p file)
1254       (let ((name (char-feature (decode-char 'ucs (+ #x2EFF radical))
1255                                 'name)))
1256         (if (string-match "KANGXI RADICAL " name)
1257             (setq name (capitalize (substring name (match-end 0)))))
1258         (setq name (mapconcat (lambda (char)
1259                                 (if (eq char ? )
1260                                     "-"
1261                                   (char-to-string char))) name ""))
1262         (setq file
1263               (expand-file-name
1264                (format "Ideograph-R%03d-%s.ttl" radical name)
1265                file))))
1266   (let (chise-turtle-ccs-prefix-alist)
1267     (with-temp-buffer
1268       (char-db-turtle-insert-ideograph-radical-char-data radical)
1269       (goto-char (point-min))
1270       (char-db-turtle-insert-prefix)
1271       (insert "\n")
1272       (goto-char (point-min))
1273       (insert (format "# -*- coding: %s -*-\n"
1274                       char-db-file-coding-system))
1275       (let ((coding-system-for-write char-db-file-coding-system))
1276         (write-region (point-min)(point-max) file)))))
1277
1278
1279 ;;; @ end
1280 ;;;
1281
1282 (provide 'char-db-turtle)
1283
1284 ;;; char-db-turtle.el ends here