1 ;; -*- coding: utf-8-mcs-er -*-
2 (require 'char-db-util)
3 (require 'chiset-common)
4 ;; (require 'concord-images)
6 (setq file-name-coding-system 'utf-8-mcs-er)
8 (concord-assign-genre 'code-point "/usr/local/var/chise-ipld/db")
9 (concord-assign-genre 'coded-character "/usr/local/var/chise-ipld/db")
10 (concord-assign-genre 'glyph "/usr/local/var/chise-ipld/db")
12 (concord-assign-genre 'image-resource "/usr/local/var/photo/db")
13 (concord-assign-genre 'glyph-image "/usr/local/var/photo/db")
15 (concord-assign-genre 'creator@ruimoku "/usr/local/var/ruimoku/db")
16 (concord-assign-genre 'person-name@ruimoku "/usr/local/var/ruimoku/db")
18 (concord-assign-genre 'journal-volume@ruimoku "/usr/local/var/ruimoku/db")
19 (concord-assign-genre 'article@ruimoku "/usr/local/var/ruimoku/db")
20 (concord-assign-genre 'book@ruimoku "/usr/local/var/ruimoku/db")
22 (concord-assign-genre 'classification@ruimoku "/usr/local/var/ruimoku/db")
23 (concord-assign-genre 'region@ruimoku "/usr/local/var/ruimoku/db")
24 (concord-assign-genre 'era@ruimoku "/usr/local/var/ruimoku/db")
25 (concord-assign-genre 'period@ruimoku "/usr/local/var/ruimoku/db")
26 (concord-assign-genre 'journal@ruimoku "/usr/local/var/ruimoku/db")
27 (concord-assign-genre 'journal-name@ruimoku "/usr/local/var/ruimoku/db")
28 (concord-assign-genre 'publisher@ruimoku "/usr/local/var/ruimoku/db")
29 (concord-assign-genre 'publisher-name@ruimoku "/usr/local/var/ruimoku/db")
31 (mount-char-attribute-table '*instance@ruimoku/bibliography/title)
32 ;; (mount-char-attribute-table '*instance@ruimoku/bibliography/content*note)
34 (concord-assign-genre 'entry@zh-classical "/usr/local/var/kanbun/db")
35 ;; (concord-assign-genre 'morpheme-entry@zh-classical "/usr/local/var/kanbun/db")
36 (concord-assign-genre 'word-class@zh-classical "/usr/local/var/kanbun/db")
37 (concord-assign-genre 'morpheme@zh-classical "/usr/local/var/kanbun/db")
38 (concord-assign-genre 'sentence@zh-classical "/usr/local/var/kanbun/db")
39 ;; (concord-assign-genre 'sentence-entry@zh-classical "/usr/local/var/kanbun/db")
41 (mount-char-attribute-table '*instance@morpheme-entry/zh-classical)
43 (concord-assign-genre 'ud@zh-classical "/usr/local/var/kanbun/db")
46 (concord-assign-genre 'hng-card "/usr/local/var/hng-card/db")
48 (mount-char-attribute-table '->HNG)
49 (mount-char-attribute-table '<-HNG)
50 (mount-char-attribute-table '->HNG@CN/manuscript)
51 (mount-char-attribute-table '<-HNG@CN/manuscript)
52 (mount-char-attribute-table '->HNG@CN/printed)
53 (mount-char-attribute-table '<-HNG@CN/printed)
54 (mount-char-attribute-table '->HNG@JP/manuscript)
55 (mount-char-attribute-table '<-HNG@JP/manuscript)
56 (mount-char-attribute-table '->HNG@JP/printed)
57 (mount-char-attribute-table '<-HNG@JP/printed)
58 (mount-char-attribute-table '->HNG@KR)
59 (mount-char-attribute-table '<-HNG@KR)
60 (mount-char-attribute-table '->HNG@MISC)
61 (mount-char-attribute-table '<-HNG@MISC)
63 (mount-char-attribute-table 'abstract-glyph@iwds-1)
64 (mount-char-attribute-table 'abstract-glyph@iwds-1/confluented)
66 (mount-char-attribute-table '=hdic-tsj-glyph-id)
67 (mount-char-attribute-table '=hdic-syp-entry-id)
68 (mount-char-attribute-table '=hdic-ktb-entry-id)
69 (mount-char-attribute-table '=hdic-ktb-seal-glyph-id)
70 (mount-char-attribute-table 'hdic-tsj-word-id)
71 (mount-char-attribute-table 'hdic-tsj-word)
72 (mount-char-attribute-table 'hdic-tsj-word-description)
73 (mount-char-attribute-table 'hdic-tsj-word-remarks)
74 (mount-char-attribute-table 'hdic-syp-description)
75 (mount-char-attribute-table 'hdic-ktb-description)
76 (mount-char-attribute-table 'hdic-ktb-entry-type)
77 (mount-char-attribute-table 'hdic-ktb-diff)
78 (mount-char-attribute-table 'hdic-ktb-syp-id)
79 (mount-char-attribute-table 'hdic-ktb-yy-id)
80 (mount-char-attribute-table 'hdic-ktb-ndl-pid)
81 (mount-char-attribute-table '<-HDIC-SYP@tenrei-bansho-meigi)
82 (mount-char-attribute-table '->HDIC-SYP@tenrei-bansho-meigi)
83 (mount-char-attribute-table '<-Small-Seal@tenrei-bansho-meigi)
84 (mount-char-attribute-table '->Small-Seal@tenrei-bansho-meigi)
86 (mount-char-attribute-table 'sound@fanqie)
88 (defvar est-hide-cgi-mode nil)
89 (defvar est-view-url-prefix "..")
90 (defvar chise-wiki-view-url "view.cgi")
91 (defvar chise-wiki-edit-url "edit.cgi")
93 (defvar chise-wiki-bitmap-glyph-image-url
94 "https://image.chise.org/glyphs")
96 (defvar chise-wiki-legacy-bitmap-glyphs-url
97 "https://www.chise.org/glyphs")
99 (defvar chise-wiki-hng-bitmap-glyphs-url
100 "https://image.hng-data.org/glyphs/HNG")
102 (defvar chise-wiki-daijiten-bitmap-glyphs-url
103 "https://image.hng-data.org/glyphs/daijiten")
105 (defvar chise-wiki-glyphwiki-glyph-image-url
106 "https://glyphwiki.org/glyph")
108 (defvar chise-wiki-glyph-cgi-url
109 "https://www.chise.org/chisewiki/glyph.cgi")
111 (defvar chise-wiki-displayed-features nil)
113 (defvar est-coded-charset-priority-list
115 =cns11643-1 =cns11643-2 =cns11643-3
116 =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
118 =jis-x0208 =jis-x0208@1990
123 =jis-x0213-1@2000 =jis-x0213-1@2004
124 =jis-x0208@1983 =jis-x0208@1978
125 =zinbun-oracle =>zinbun-oracle
129 ==jis-x0208 ==jis-x0213-1 ==jis-x0213-2
130 =>>jis-x0208 =>>jis-x0213-1 =>>jis-x0213-2
132 =+>jis-x0208 =+>jis-x0213-1 =+>jis-x0213-2
135 =>jis-x0208 =>jis-x0213-1
137 =>ucs@iso =>ucs@unicode
138 =>ucs@jis =>ucs@cns =>ucs@ks
139 =+>ucs@iso =+>ucs@unicode
140 =>>ucs@iso =>>ucs@unicode
141 =>>ucs@jis =>>ucs@cns =>>ucs@ks
142 ==ucs@iso ==ucs@unicode
143 ==ucs@jis ==ucs@cns ==ucs@ks
188 ===cns11643-1 ===cns11643-2 ===cns11643-3
189 ===cns11643-4 ===cns11643-5 ===cns11643-6 ===cns11643-7
192 (defvar est-coded-charset-entity-reference-alist
196 '(=hanyo-denshi/ja "HD-JA-" 4 X)
197 '(=hanyo-denshi/jb "HD-JB-" 4 X)
198 '(=hanyo-denshi/jc "HD-JC-" 4 X)
199 '(=hanyo-denshi/jd "HD-JD-" 4 X)
200 '(=hanyo-denshi/ft "HD-FT-" 4 X)
201 '(=hanyo-denshi/ia "HD-IA-" 4 X)
202 '(=hanyo-denshi/ib "HD-IB-" 4 X)
203 '(=hanyo-denshi/hg "HD-HG-" 4 X)
204 '(=hanyo-denshi/ip "HD-IP-" 4 X)
205 '(=hanyo-denshi/jt "HD-JT-" 4 X)
206 '(=hanyo-denshi/ks "HD-KS-" 6 d)
207 '(=>>hanyo-denshi/ja "G-HD-JA-" 4 X)
208 '(=>>hanyo-denshi/jb "G-HD-JB-" 4 X)
209 '(=>>hanyo-denshi/jc "G-HD-JC-" 4 X)
210 '(=>>hanyo-denshi/jd "G-HD-JD-" 4 X)
211 '(=>>hanyo-denshi/ft "G-HD-FT-" 4 X)
212 '(=>>hanyo-denshi/ia "G-HD-IA-" 4 X)
213 '(=>>hanyo-denshi/ib "G-HD-IB-" 4 X)
214 '(=>>hanyo-denshi/hg "G-HD-HG-" 4 X)
215 '(=>>hanyo-denshi/ip "G-HD-IP-" 4 X)
216 '(=>>hanyo-denshi/jt "G-HD-JT-" 4 X)
217 '(=>>hanyo-denshi/ks "G-HD-KS-" 6 d)
219 '(==hanyo-denshi/ja "g2-HD-JA-" 4 X)
220 '(==hanyo-denshi/jb "g2-HD-JB-" 4 X)
221 '(==hanyo-denshi/jc "g2-HD-JC-" 4 X)
222 '(==hanyo-denshi/jd "g2-HD-JD-" 4 X)
223 '(==hanyo-denshi/ft "g2-HD-FT-" 4 X)
224 '(==hanyo-denshi/ia "g2-HD-IA-" 4 X)
225 '(==hanyo-denshi/ib "g2-HD-IB-" 4 X)
226 '(==hanyo-denshi/hg "g2-HD-HG-" 4 X)
227 '(==hanyo-denshi/ip "g2-HD-IP-" 4 X)
228 '(==hanyo-denshi/jt "g2-HD-JT-" 4 X)
229 '(==hanyo-denshi/ks "g2-HD-KS-" 6 d)
230 '(==daijiten "g2-DJT-" 5 d)
231 '(=cns11643-1 "C1-" 4 X)
232 '(=cns11643-2 "C2-" 4 X)
233 '(=cns11643-3 "C3-" 4 X)
234 '(=cns11643-4 "C4-" 4 X)
235 '(=cns11643-5 "C5-" 4 X)
236 '(=cns11643-6 "C6-" 4 X)
237 '(=cns11643-7 "C7-" 4 X)
238 '(=adobe-japan1-6 "AJ1-" 5 d)
239 '(=big5-cdp "CDP-" 4 X)
240 '(=>big5-cdp "A-CDP-" 4 X)
242 '(=gb12345 "G1-" 4 X)
243 '(=jis-x0208@1990 "J90-" 4 X)
244 '(=jis-x0212 "JSP-" 4 X)
246 '(=jis-x0208@1997 "J97-" 4 X)
247 '(=jis-x0208@1978 "J78-" 4 X)
248 '(=jis-x0208@1983 "J83-" 4 X)
249 '(=ruimoku-v6 "RUI6-" 4 X)
250 '(=zinbun-oracle "ZOB-" 4 d)
251 '(=daijiten "DJT-" 5 d)
252 '(=>ucs-itaiji-001 "A-U-i001+" 4 X)
253 '(=>ucs-itaiji-002 "A-U-i002+" 4 X)
254 '(=>ucs-itaiji-003 "A-U-i003+" 4 X)
255 '(=>ucs-itaiji-004 "A-U-i004+" 4 X)
256 '(=>ucs-itaiji-005 "A-U-i005+" 4 X)
257 '(=>ucs-itaiji-006 "A-U-i006+" 4 X)
258 '(=>ucs-itaiji-007 "A-U-i007+" 4 X)
259 '(=>ucs-itaiji-008 "A-U-i008+" 4 X)
260 '(=>ucs-itaiji-009 "A-U-i009+" 4 X)
261 '(=>ucs-itaiji-010 "A-U-i010+" 4 X)
262 '(=>ucs-itaiji-011 "A-U-i011+" 4 X)
263 '(=>ucs-itaiji-001@iwds-1 "A-IWDSU-i001+" 4 X)
264 '(=>ucs-itaiji-002@iwds-1 "A-IWDSU-i002+" 4 X)
265 '(=>ucs-itaiji-003@iwds-1 "A-IWDSU-i003+" 4 X)
266 '(=>ucs-itaiji-006@iwds-1 "A-IWDSU-i006+" 4 X)
267 '(=jef-china3 "JC3-" 4 X)
268 '(=ucs@unicode "UU+" 4 X)
269 '(=ucs@JP/hanazono "hanaJU+" 4 X)
270 '(==cns11643-1 "R-C1-" 4 X)
271 '(==cns11643-2 "R-C2-" 4 X)
272 '(==cns11643-3 "R-C3-" 4 X)
273 '(==cns11643-4 "R-C4-" 4 X)
274 '(==cns11643-5 "R-C5-" 4 X)
275 '(==cns11643-6 "R-C6-" 4 X)
276 '(==cns11643-7 "R-C7-" 4 X)
277 '(=hanziku-1 "HZK01-" 4 X)
278 '(=hanziku-2 "HZK02-" 4 X)
279 '(=hanziku-3 "HZK03-" 4 X)
280 '(=hanziku-4 "HZK04-" 4 X)
281 '(=hanziku-5 "HZK05-" 4 X)
282 '(=hanziku-6 "HZK06-" 4 X)
283 '(=hanziku-7 "HZK07-" 4 X)
284 '(=hanziku-8 "HZK08-" 4 X)
285 '(=hanziku-9 "HZK09-" 4 X)
286 '(=hanziku-10 "HZK10-" 4 X)
287 '(=hanziku-11 "HZK11-" 4 X)
288 '(=hanziku-12 "HZK12-" 4 X)
289 '(==>daijiten "A2-DJT-" 5 d)
292 '(=daikanwa "M-" 5 d)
293 '(=>>daikanwa "G-M-" 5 d)
294 '(===ucs@ks "R-KU+" 4 X)
295 coded-charset-entity-reference-alist))
297 (defun decode-uri-string (string &optional coding-system)
298 (if (> (length string) 0)
302 (mapconcat (lambda (char)
305 (char-to-string char)))
307 (while (string-match "%\\([0-9A-F][0-9A-F]\\)" string i)
308 (setq dest (concat dest
309 (substring string i (match-beginning 0))
312 (string-to-int (match-string 1 string) 16))))
314 (decode-coding-string
315 (concat dest (substring string i))
318 (defun www-feature-type (feature-name)
319 (or (char-feature-property feature-name 'type)
320 (let ((str (symbol-name feature-name)))
322 ((string-match "\\*note\\(@[^*]+\\)?$" str)
324 ((string-match "\\*sources\\(@[^*]+\\)?$" str)
326 ((string-match "\\*" str)
328 ((string-match "^\\(->\\|<-\\)" str)
330 ((string-match "^ideographic-structure\\(@\\|$\\)" str)
334 (defun www-feature-format (feature-name)
335 (or (char-feature-property feature-name 'presentation-format)
336 (char-feature-property feature-name 'format)
338 (setq fn feature-name)
339 (while (and (setq parent (char-feature-name-parent fn))
341 (char-feature-property
345 '((name) " : " (value))))
347 (defun www-feature-value-format (feature-name)
348 (or (char-feature-property feature-name 'value-presentation-format)
349 (char-feature-property feature-name 'value-format)
351 (setq fn feature-name)
352 (while (and (setq parent (char-feature-name-parent fn))
354 (or (char-feature-property
355 parent 'value-presentation-format)
356 (char-feature-property
357 parent 'value-format)))))
360 (let ((type (www-feature-type feature-name)))
361 (cond ((eq type 'relation)
363 ((eq type 'structure)
364 'space-separated-ids)
365 ((eq type 'domain-list)
366 'space-separated-source-list)
370 (if (find-charset feature-name)
371 (if (and (= (charset-dimension feature-name) 2)
372 (= (charset-chars feature-name) 94))
374 " (" (decimal) ") <" (ku-ten) "> " (prev-char) (next-char))
375 '("0x" (HEX) " (" (decimal) ") " (prev-char) (next-char))))
378 (defun char-feature-name-at-domain (feature-name domain)
380 (let ((name (symbol-name feature-name)))
382 ((string-match "@[^*]+$" name)
383 (intern (format "%s/%s" name domain))
386 (intern (format "%s@%s" name domain))
390 (defun char-feature-name-parent (feature-name)
391 (let ((name (symbol-name feature-name)))
392 (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
393 (intern (substring name 0 (car (last (match-data) 2)))))))
395 (defun char-feature-name-domain (feature-name)
396 (let ((name (symbol-name feature-name)))
397 (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
398 (intern (substring name (1+ (match-beginning 0)))))))
400 (defun char-feature-name-sans-versions (feature)
401 (let ((feature-name (symbol-name feature)))
402 (if (string-match "[@/]\\$rev=latest$" feature-name)
403 (intern (substring feature-name 0 (match-beginning 0)))
406 (defun est-object-genre (object)
407 (if (characterp object)
409 (concord-object-genre object)))
411 (defun www-get-feature-value (object feature)
412 (let ((latest-feature (char-feature-name-at-domain feature '$rev=latest)))
415 (mount-char-attribute-table latest-feature)
416 (or (char-feature object latest-feature)
417 (char-feature object feature))
420 (or (condition-case nil
421 (concord-object-get object latest-feature)
424 (concord-object-get object feature)
428 (defun get-previous-code-point (ccs code)
429 (let ((chars (charset-chars ccs))
430 (dim (charset-dimension ccs))
432 mask byte-min byte-max
455 (setq bytes (make-vector dim 0))
457 (aset bytes i (logand (lsh code (* i -8)) mask))
460 (while (and (< i dim)
462 (aset bytes i (1- (aref bytes i)))
463 (< (aref bytes i) byte-min)))
464 (aset bytes i byte-max)
467 (setq dest (aref bytes 0)
470 (setq dest (logior dest (lsh (aref bytes i) (* i 8)))
474 (defun get-next-code-point (ccs code)
475 (let ((chars (charset-chars ccs))
476 (dim (charset-dimension ccs))
478 mask byte-min byte-max
501 (setq bytes (make-vector dim 0))
503 (aset bytes i (logand (lsh code (* i -8)) mask))
506 (while (and (< i dim)
508 (aset bytes i (1+ (aref bytes i)))
509 (> (aref bytes i) byte-max)))
510 (aset bytes i byte-min)
513 (setq dest (aref bytes 0)
516 (setq dest (logior dest (lsh (aref bytes i) (* i 8)))
520 (defun find-previous-defined-code-point (ccs code)
521 (let ((i (get-previous-code-point ccs code))
524 ((eq ccs '=jis-x0208)
525 (setq ccs '=jis-x0208@1990))
526 ((eq ccs '=jis-x0213-1)
527 (setq ccs '=jis-x0213-1@2004)))
530 (null (setq char (decode-char ccs i
531 (unless (eq ccs '=ucs)
533 (setq i (get-previous-code-point ccs i)))
536 (defun find-next-defined-code-point (ccs code)
537 (let ((i (get-next-code-point ccs code))
539 (setq max (+ code 1000))
541 ((eq ccs '=jis-x0208)
542 (setq ccs '=jis-x0208@1990))
543 ((eq ccs '=jis-x0213-1)
544 (setq ccs '=jis-x0213-1@2004)))
547 (null (setq char (decode-char ccs i
548 (unless (eq ccs '=ucs)
550 (setq i (get-next-code-point ccs i)))
554 ;;; @ URI representation
557 ;; (defun est-uri-decode-feature-name-body (uri-feature)
558 ;; (let ((len (length uri-feature))
565 ;; (if (eq (aref uri-feature i) ?\.)
566 ;; (if (and (< (+ i 2) len)
567 ;; (eq (aref uri-feature (+ i 2)) ?\.))
570 ;; ((eq (setq ch (aref uri-feature (1+ i))) ?\.)
577 ;; (substring uri-feature i (+ i 3))
583 ;; (char-to-string (aref uri-feature i))
584 ;; (setq i (1+ i)))))))
587 ;; (defun est-uri-encode-feature-name-body (feature)
588 ;; (mapconcat (lambda (c)
595 ;; (t (char-to-string c))))
598 ;; (defun www-uri-decode-feature-name (uri-feature)
600 ;; (setq uri-feature (decode-uri-string uri-feature 'utf-8-mcs-er))
602 ;; ((string-match "^from\\." uri-feature)
603 ;; (intern (format "<-%s"
604 ;; (est-uri-decode-feature-name-body
605 ;; (substring uri-feature (match-end 0)))))
607 ;; ((string-match "^to\\." uri-feature)
608 ;; (intern (format "->%s"
609 ;; (est-uri-decode-feature-name-body
610 ;; (substring uri-feature (match-end 0)))))
612 ;; ((string-match "^rep\\." uri-feature)
613 ;; (intern (format "=%s"
614 ;; (est-uri-decode-feature-name-body
615 ;; (substring uri-feature (match-end 0)))))
617 ;; ((string-match "^rep[2i]\\." uri-feature)
618 ;; (intern (format "===%s"
619 ;; (est-uri-decode-feature-name-body
620 ;; (substring uri-feature (match-end 0)))))
622 ;; ((string-match "^g\\." uri-feature)
623 ;; (intern (format "=>>%s"
624 ;; (est-uri-decode-feature-name-body
625 ;; (substring uri-feature (match-end 0)))))
627 ;; ((string-match "^g[i2]\\." uri-feature)
628 ;; (intern (format "==%s"
629 ;; (est-uri-decode-feature-name-body
630 ;; (substring uri-feature (match-end 0)))))
632 ;; ((string-match "^gi\\([0-9]+\\)\\." uri-feature)
633 ;; (intern (format "=>>%s%s"
634 ;; (make-string (string-to-int
635 ;; (match-string 1 uri-feature))
637 ;; (est-uri-decode-feature-name-body
638 ;; (substring uri-feature (match-end 0)))))
640 ;; ((string-match "^o\\." uri-feature)
641 ;; (intern (format "=+>%s"
642 ;; (est-uri-decode-feature-name-body
643 ;; (substring uri-feature (match-end 0)))))
645 ;; ((string-match "^a\\." uri-feature)
646 ;; (intern (format "=>%s"
647 ;; (est-uri-decode-feature-name-body
648 ;; (substring uri-feature (match-end 0)))))
650 ;; ((string-match "^a\\([0-9]+\\)\\." uri-feature)
651 ;; (intern (format "%s>%s"
652 ;; (make-string (string-to-int
653 ;; (match-string 1 uri-feature))
655 ;; (est-uri-decode-feature-name-body
656 ;; (substring uri-feature (match-end 0)))))
658 ;; ((and (setq uri-feature (est-uri-decode-feature-name-body uri-feature))
659 ;; (setq feature (intern (format "=>%s" uri-feature)))
660 ;; (find-charset feature))
662 ;; ((and (setq feature (intern (format "=>>%s" uri-feature)))
663 ;; (find-charset feature))
665 ;; ((and (setq feature (intern (format "=>>>%s" uri-feature)))
666 ;; (find-charset feature))
668 ;; ((and (setq feature (intern (format "=%s" uri-feature)))
669 ;; (find-charset feature))
671 ;; (t (intern uri-feature)))))
673 ;; (defun www-uri-encode-feature-name (feature-name)
674 ;; (setq feature-name (symbol-name feature-name))
676 ;; ((string-match "^=\\+>\\([^=>]+\\)" feature-name)
678 ;; (est-uri-encode-feature-name-body
679 ;; (substring feature-name (match-beginning 1))))
681 ;; ((string-match "^=\\([^=>]+\\)" feature-name)
683 ;; (est-uri-encode-feature-name-body
684 ;; (substring feature-name (match-beginning 1))))
686 ;; ((string-match "^==\\([^=>]+\\)" feature-name)
688 ;; (est-uri-encode-feature-name-body
689 ;; (substring feature-name (match-beginning 1))))
691 ;; ((string-match "^===\\([^=>]+\\)" feature-name)
693 ;; (est-uri-encode-feature-name-body
694 ;; (substring feature-name (match-beginning 1))))
696 ;; ((string-match "^=>>\\([^=>]+\\)" feature-name)
698 ;; (est-uri-encode-feature-name-body
699 ;; (substring feature-name (match-beginning 1))))
701 ;; ((string-match "^=>>>\\([^=>]+\\)" feature-name)
703 ;; (est-uri-encode-feature-name-body
704 ;; (substring feature-name (match-beginning 1))))
706 ;; ((string-match "^=>>\\(>+\\)" feature-name)
708 ;; (length (match-string 1 feature-name))
709 ;; (est-uri-encode-feature-name-body
710 ;; (substring feature-name (match-end 1))))
712 ;; ((string-match "^=>\\([^=>]+\\)" feature-name)
714 ;; (est-uri-encode-feature-name-body
715 ;; (substring feature-name (match-beginning 1))))
717 ;; ((string-match "^\\(=+\\)>" feature-name)
719 ;; (length (match-string 1 feature-name))
720 ;; (est-uri-encode-feature-name-body
721 ;; (substring feature-name (match-end 0))))
723 ;; ((string-match "^->" feature-name)
725 ;; (est-uri-encode-feature-name-body
726 ;; (substring feature-name (match-end 0))))
728 ;; ((string-match "^<-" feature-name)
730 ;; (est-uri-encode-feature-name-body
731 ;; (substring feature-name (match-end 0))))
733 ;; (t (est-uri-encode-feature-name-body feature-name))))
735 (defun www-uri-make-feature-name-url (uri-genre uri-feature-name uri-object)
736 (if est-hide-cgi-mode
737 (format "../feature/%s&%s/%s"
738 uri-feature-name uri-genre uri-object)
739 (format "%s?feature=%s&%s=%s"
740 chise-wiki-view-url uri-feature-name uri-genre uri-object)))
742 (defun www-uri-decode-object (genre char-rep)
745 ((string-match (if est-hide-cgi-mode
746 "\\(%3D\\|=\\|%3A\\|:\\)"
747 "\\(%3A\\|:\\)") char-rep)
748 (setq ccs (substring char-rep 0 (match-beginning 0))
749 cpos (substring char-rep (match-end 0)))
750 (setq ccs (www-uri-decode-feature-name ccs))
751 (setq cpos (est-uri-decode-feature-name-body cpos))
753 ((string-match "^0x" cpos)
755 (string-to-number (substring cpos (match-end 0)) 16))
758 (setq cpos (car (read-from-string
760 cpos file-name-coding-system))))
762 (if (and (eq genre 'character)
764 (decode-char ccs cpos)
765 (concord-decode-object ccs cpos genre))
768 (setq char-rep (decode-uri-string char-rep 'utf-8-mcs-er))
770 ((eq genre 'character)
771 (when (= (length char-rep) 1)
775 (concord-decode-object
776 '=id (www-uri-decode-feature-name char-rep) 'feature)
779 (concord-decode-object
780 '=id (car (read-from-string char-rep)) genre)
783 (defun www-uri-encode-object (object)
784 (if (characterp object)
785 (if (encode-char object '=ucs)
788 (format "%%%02X" byte))
789 (encode-coding-string (char-to-string object) 'utf-8-mcs-er)
791 (let ((ccs-list est-coded-charset-priority-list)
794 (setq ccs (pop ccs-list))
795 (not (setq ret (encode-char object ccs 'defined-only)))))
797 (format (if est-hide-cgi-mode
800 (www-uri-encode-feature-name ccs)
802 ((and (setq ccs (car (split-char object)))
803 (setq ret (encode-char object ccs)))
804 (format (if est-hide-cgi-mode
807 (www-uri-encode-feature-name ccs)
810 (format (if est-hide-cgi-mode
811 "system-char-id=0x%X"
812 "system-char-id:0x%X")
813 (encode-char object 'system-char-id))
815 (format (if est-hide-cgi-mode
818 (www-uri-encode-feature-name
819 (concord-object-id object)))))
821 (defun est-format-object (object &optional readable)
822 (if (characterp object)
823 (char-to-string object)
824 (let ((ret (or (if readable
825 (or (concord-object-get object 'name)
826 (concord-object-get object '=name)
827 (concord-object-get object 'title)
828 (concord-object-get object '=title)))
829 (concord-object-id object))))
832 (defun www-uri-make-object-url (object &optional uri-object)
833 (if est-hide-cgi-mode
836 (est-object-genre object)
838 (www-uri-encode-object object)))
841 (est-object-genre object)
843 (www-uri-encode-object object)))))
846 ;;; @ Feature name presentation
849 (defun www-format-feature-name-default (feature-name)
853 (symbol-name feature-name)
857 (defun www-format-feature-name-as-metadata (feature-name &optional lang)
858 (let ((str (symbol-name feature-name))
861 ((string-match "\\*[^*]+$" str)
862 (setq base (substring str 0 (match-beginning 0))
863 meta (substring str (match-beginning 0)))
864 (concat (www-format-feature-name* (intern base) lang)
867 (www-format-feature-name-default feature-name)
870 (defun www-format-feature-name-as-rel-to (feature-name)
871 (concat "\u2192" (substring (symbol-name feature-name) 2)))
873 (defun www-format-feature-name-as-rel-from (feature-name)
874 (concat "\u2190" (substring (symbol-name feature-name) 2)))
876 (defun www-format-feature-name-as-CCS (feature-name)
879 (symbol-name feature-name)
881 (dest (upcase (pop rest))))
882 (when (string-match "^=+>*" dest)
883 (setq dest (concat (substring dest 0 (match-end 0))
885 (substring dest (match-end 0)))))
889 (setq dest (concat dest " " (upcase (pop rest)))))
890 (if (string-match "^[0-9]+$" (car rest))
891 (concat dest "-" (car rest))
892 (concat dest " " (upcase (car rest))))
896 (defun www-format-feature-name* (feature-name &optional lang)
897 (let (name fn parent ret)
900 (char-feature-property
902 (intern (format "name@%s" lang))))
903 (char-feature-property
904 feature-name 'name)))
905 ((and (setq name (symbol-name feature-name))
906 (string-match "\\*" name))
907 (www-format-feature-name-as-metadata feature-name lang))
909 (setq fn feature-name)
910 (while (and (setq parent (char-feature-name-parent fn))
913 (char-feature-property
915 (intern (format "name@%s" lang))))
916 (char-feature-property
921 (concat ret (substring (symbol-name feature-name)
922 (length (symbol-name parent)))))
923 ((find-charset feature-name)
924 (www-format-feature-name-as-CCS feature-name))
925 ((string-match "^\\(->\\)" name)
926 (www-format-feature-name-as-rel-to feature-name))
927 ((string-match "^\\(<-\\)" name)
928 (www-format-feature-name-as-rel-from feature-name))
930 (www-format-feature-name-default feature-name)
934 (defun www-format-feature-name (feature-name &optional lang)
935 (www-format-encode-string
936 (www-format-feature-name* feature-name lang)))
942 (defvar www-format-char-img-style "vertical-align:bottom;")
944 (defun www-format-encode-string (string &optional without-tags as-body)
947 (let (plane code subcode start end char variants ret rret)
949 (goto-char (point-min))
950 (while (search-forward "&" nil t)
951 (replace-match "&" nil t)))
952 (goto-char (point-min))
953 (while (search-forward "<" nil t)
954 (replace-match "<" nil t))
955 (goto-char (point-min))
956 (while (search-forward ">" nil t)
957 (replace-match ">" nil t))
959 (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
960 (let ((coded-charset-entity-reference-alist
961 est-coded-charset-entity-reference-alist))
962 (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
964 (goto-char (point-min))
965 (while (re-search-forward "&\\(A-\\|G-\\|g2-\\|R-\\)?CB\\([0-9]+\\);" nil t)
966 (setq code (string-to-int (match-string 2)))
968 (format "<img alt=\"CB%05d\" src=\"%s/cb-gaiji/%02d/CB%05d.gif\"
971 chise-wiki-legacy-bitmap-glyphs-url
973 www-format-char-img-style)
976 (goto-char (point-min))
977 (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?J\\(78\\|83\\|90\\|97\\|SP\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
978 (setq plane (match-string 2)
979 code (string-to-int (match-string 3) 16))
981 (format "<img alt=\"J%s-%04X\" src=\"%s/JIS-%s/%02d-%02d.gif\"
984 chise-wiki-legacy-bitmap-glyphs-url
987 (- (logand code 255) 32)
988 www-format-char-img-style)
991 (goto-char (point-min))
992 (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?J0-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
993 (setq code (string-to-int (match-string 2) 16))
995 (format "<img alt=\"J0-%04X\" src=\"%s/JIS-90/%02d-%02d.gif\"
998 chise-wiki-legacy-bitmap-glyphs-url
1000 (- (logand code 255) 32)
1001 www-format-char-img-style)
1004 (goto-char (point-min))
1005 (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-\\(JA\\|JB\\|JC\\|JD\\|FT\\|IA\\|IB\\|HG\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
1006 (setq plane (match-string 2)
1007 code (string-to-int (match-string 3) 16))
1009 (format "<img alt=\"HD-%s-%04X\" src=\"%s/IVD/HanyoDenshi/%s%02d%02d.png\"
1012 chise-wiki-legacy-bitmap-glyphs-url
1014 (- (lsh code -8) 32)
1015 (- (logand code 255) 32)
1016 www-format-char-img-style)
1019 (goto-char (point-min))
1020 (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-\\(IP\\|JT\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
1021 (setq plane (match-string 2)
1022 code (string-to-int (match-string 3) 16))
1024 (format "<img alt=\"HD-%s-%04X\" src=\"%s/IVD/HanyoDenshi/%s%04X.png\"
1027 chise-wiki-legacy-bitmap-glyphs-url
1029 www-format-char-img-style)
1032 (goto-char (point-min))
1033 (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-KS-\\([0-9]+\\);" nil t)
1034 (setq code (string-to-int (match-string 2)))
1036 (format "<img alt=\"HD-KS%06d\" src=\"%s/IVD/HanyoDenshi/KS%06d.png\"
1037 style=\"vertical-align:middle\">"
1039 chise-wiki-legacy-bitmap-glyphs-url
1041 www-format-char-img-style)
1044 (goto-char (point-min))
1045 (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-TK-\\([0-9]+\\);" nil t)
1046 (setq code (string-to-int (match-string 2)))
1048 (format "<img alt=\"HD-KS%06d\" src=\"%s/IVD/HanyoDenshi/TK%08d.png\"
1049 style=\"vertical-align:middle\">"
1051 chise-wiki-legacy-bitmap-glyphs-url
1053 www-format-char-img-style)
1056 (goto-char (point-min))
1057 (while (re-search-forward "&G\\([01]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
1058 (setq plane (string-to-int (match-string 1))
1059 code (string-to-int (match-string 2) 16))
1061 (format "<img alt=\"GB%d-%04X\" src=\"%s/GB%d/%02d-%02d.gif\"
1064 chise-wiki-legacy-bitmap-glyphs-url
1066 (- (lsh code -8) 32)
1067 (- (logand code 255) 32)
1068 www-format-char-img-style)
1071 (goto-char (point-min))
1072 (while (re-search-forward "&\\(R-\\)?C\\([1-7]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
1073 (setq plane (string-to-int (match-string 2))
1074 code (string-to-int (match-string 3) 16))
1076 (format "<img alt=\"CNS%d-%04X\" src=\"%s/CNS%d/%04X.gif\"
1079 chise-wiki-legacy-bitmap-glyphs-url
1081 www-format-char-img-style)
1084 (goto-char (point-min))
1085 (while (re-search-forward "&\\(R-\\)?JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
1086 (setq code (string-to-int (match-string 2) 16))
1088 (format "<img alt=\"JC3-%04X\" src=\"%s/JEF-CHINA3/%04X.png\">"
1089 code chise-wiki-bitmap-glyph-image-url code)
1092 (goto-char (point-min))
1093 (while (re-search-forward "&\\(A-\\)?ZOB-\\([0-9]+\\);" nil t)
1094 (setq code (string-to-int (match-string 2)))
1096 (format "<img alt=\"ZOB-%04d\" src=\"%s/ZOB-1968/%04d.png\"
1097 style=\"vertical-align:middle; width: auto; max-height: 80px\">"
1099 chise-wiki-legacy-bitmap-glyphs-url
1101 www-format-char-img-style)
1104 (goto-char (point-min))
1105 (while (re-search-forward "&\\(A2-\\|g2-\\|R-\\)?DJT-\\([0-9]+\\);" nil t)
1106 (setq code (string-to-int (match-string 2)))
1108 (format "<img alt=\"DJT-%05d\" src=\"%s/%05d.png\"
1109 style=\"vertical-align:middle; width: auto; max-height: 60px\">"
1111 chise-wiki-daijiten-bitmap-glyphs-url
1113 www-format-char-img-style)
1116 (goto-char (point-min))
1117 (while (re-search-forward "&\\(A-\\)?SW-JIGUGE\\([45]?\\)-\\([0-9]+\\);" nil t)
1118 (setq subcode (match-string 2)
1119 code (string-to-int (match-string 3)))
1121 (if (string= subcode "")
1125 (format "<div class=\"tooltip\"><img alt=\"SW-JIGUGE%s-%05d\" src=\"%s/ShuoWen/Jiguge%s/%05d.png\"
1126 style=\"vertical-align:middle; width: auto; max-height: 80px\"><span
1127 class=\"tooltiptext\">%s</span></div>"
1129 chise-wiki-legacy-bitmap-glyphs-url
1131 (charset-description
1132 (if (string= subcode "")
1134 (intern (format "===shuowen-jiguge%s" subcode)))))
1137 (goto-char (point-min))
1138 (while (re-search-forward "&HNG\\([0-9]+\\)-\\([0-9][0-9][0-9][0-9]\\)\\([0-9]\\);" nil t)
1139 (setq plane (match-string 1)
1140 code (string-to-int (match-string 2))
1141 subcode (string-to-int (match-string 3)))
1145 (char-to-string (decode-char 'ascii (+ 96 subcode)))))
1148 "<div class=\"tooltip\"><img alt=\"HNG%s-%04d%s\" src=\"%s/%s/%04d%s.png\" style=\"
1149 vertical-align:middle; width: auto; max-height: 60px\"><span
1150 class=\"tooltiptext\">%s</span></div>"
1152 chise-wiki-hng-bitmap-glyphs-url
1154 (charset-description
1155 (car (find (format "HNG%s-" plane)
1156 coded-charset-entity-reference-alist
1157 :test (lambda (key cell)
1158 (string= key (nth 1 cell))))))
1162 (goto-char (point-min))
1163 (while (re-search-forward "&\\(R-\\)?CHISE-HDIC-TSJ\\([0-9A-F]+\\);" nil t)
1164 (setq code (string-to-int (match-string 2) 16))
1165 (setq char (decode-char '===chise-hdic-tsj code))
1166 (when (setq ret (get-char-attribute char '=hdic-tsj-glyph-id))
1169 "<div class=\"tooltip\"><img alt=\"HDIC-TSJ-%s\" src=\"https://viewer.hdic.jp/img/tsj/%s.jpg\" style=\"
1170 vertical-align:middle; width: auto; max-height: 60px\"><span
1171 class=\"tooltiptext\">%s</span></div>"
1173 (charset-description '===chise-hdic-tsj))
1176 (goto-char (point-min))
1177 (while (re-search-forward "&\\(R-\\)?CHISE-HDIC-SYP\\([0-9A-F]+\\);" nil t)
1178 (setq code (string-to-int (match-string 2) 16))
1179 (setq char (decode-char '===chise-hdic-syp code))
1180 (when (setq ret (get-char-attribute char '=hdic-syp-entry-id))
1183 "<div class=\"tooltip\"><img alt=\"HDIC-SYP-%s\" src=\"https://viewer.hdic.jp/img/syp/%s\" style=\"
1184 vertical-align:middle; width: auto; max-height: 60px\"><span
1185 class=\"tooltiptext\">%s</span></div>"
1187 (charset-description '===chise-hdic-syp))
1190 (goto-char (point-min))
1191 (while (re-search-forward "&\\(R-\\)?CHISE-HDIC-KTB\\([0-9A-F]+\\);" nil t)
1192 (setq code (string-to-int (match-string 2) 16))
1193 (setq char (decode-char '===chise-hdic-ktb code))
1194 (when (setq ret (get-char-attribute char '=hdic-ktb-entry-id))
1197 "<div class=\"tooltip\"><img alt=\"HDIC-KTB-%s\" src=\"https://hdic.chise.org/img/ktb/%s.jpg\" style=\"
1198 vertical-align:middle; width: auto; max-height: 60px\"><span
1199 class=\"tooltiptext\">%s</span></div>"
1201 (charset-description '===chise-hdic-ktb))
1204 (goto-char (point-min))
1205 (while (re-search-forward "&\\(R-\\)?CHISE-HDIC-KTBS\\([0-9A-F]+\\);" nil t)
1206 (setq code (string-to-int (match-string 2) 16))
1207 (setq char (decode-char '===chise-hdic-ktb-seal code))
1208 (when (setq ret (get-char-attribute char '=hdic-ktb-seal-glyph-id))
1211 "<div class=\"tooltip\"><img alt=\"HDIC-KTBS-%s\" src=\"https://hdic.jp/glyphs/KTB-Seal/%s.png\" style=\"
1212 vertical-align:middle; width: auto; max-height: 60px\"><span
1213 class=\"tooltiptext\">%s</span></div>"
1215 (charset-description '===chise-hdic-ktb-seal))
1218 (goto-char (point-min))
1219 (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?AJ1-\\([0-9]+\\);" nil t)
1220 (setq code (string-to-int (match-string 2)))
1222 (format "<img alt=\"AJ1-%05d\" src=\"%s/IVD/AdobeJapan1/CID+%d.png\"
1223 style=\"vertical-align:middle\">"
1225 chise-wiki-legacy-bitmap-glyphs-url
1227 www-format-char-img-style)
1230 (goto-char (point-min))
1231 (while (re-search-forward "&\\(A-\\|o-\\|G-\\|g2-\\|R-\\)?MJ\\([0-9]+\\);" nil t)
1232 (setq code (string-to-int (match-string 2)))
1234 (format "<img alt=\"MJ%06d\" src=\"https://moji.or.jp/mojikibansearch/img/MJ/MJ%06d.png\"
1235 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1238 www-format-char-img-style)
1241 (goto-char (point-min))
1242 (while (re-search-forward "&\\(o-\\|G-\\|g2-\\)?IU[+-]\\([0-9A-F]+\\);" nil t)
1243 (setq code (string-to-int (match-string 2) 16))
1245 (format "<img alt=\"u%04x\" src=\"%s/u%04x.svg\"
1246 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1248 chise-wiki-glyphwiki-glyph-image-url
1250 www-format-char-img-style)
1253 (goto-char (point-min))
1254 (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?KU[+-]\\([0-9A-F]+\\);" nil t)
1255 (setq code (string-to-int (match-string 2) 16))
1257 (format "<img alt=\"u%04x-k\" src=\"%s/u%04x-k.svg\"
1258 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1260 chise-wiki-glyphwiki-glyph-image-url
1262 www-format-char-img-style)
1265 (goto-char (point-min))
1266 (while (re-search-forward "&A-\\(comp\\|cgn\\)U[+-]\\([0-9A-F]+\\);" nil t)
1267 (setq code (string-to-int (match-string 2) 16))
1269 (format "<img alt=\"u%04x\" src=\"%s/u%04x.svg\"
1270 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1272 chise-wiki-glyphwiki-glyph-image-url
1274 www-format-char-img-style)
1277 (goto-char (point-min))
1278 (while (re-search-forward
1279 "&\\(A-\\|g2-\\)?\\(IWDS\\)?U-i\\([0-9]+\\)\\+\\([0-9A-F]+\\);"
1281 (setq plane (string-to-int (match-string 3))
1282 code (string-to-int (match-string 4) 16))
1284 (format "<img alt=\"u%04x-itaiji-%03d\" src=\"%s/u%04x-itaiji-%03d.svg\"
1285 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1288 chise-wiki-glyphwiki-glyph-image-url
1291 www-format-char-img-style)
1294 (goto-char (point-min))
1295 (while (re-search-forward "&A-IWDSU\\+\\([0-9A-F]+\\);" nil t)
1296 (setq code (string-to-int (match-string 1) 16))
1298 (format "<img alt=\"A-IWDSU+%04x\" src=\"%s/u%04x.svg\"
1299 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1301 chise-wiki-glyphwiki-glyph-image-url
1303 www-format-char-img-style)
1306 (goto-char (point-min))
1307 (while (re-search-forward
1308 "&\\(A-\\)?CDP-i\\([0-9]+\\)-\\([0-9A-F]+\\);"
1310 (setq plane (string-to-int (match-string 2))
1311 code (string-to-int (match-string 3) 16))
1313 (format "<img alt=\"cdp-%04x-itaiji-%03d\" src=\"%s/cdp-%04x-itaiji-%03d.svg\"
1314 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1317 chise-wiki-glyphwiki-glyph-image-url
1320 www-format-char-img-style)
1323 (goto-char (point-min))
1324 (while (re-search-forward
1325 "&\\(A-\\)?CDP-v\\([0-9]+\\)-\\([0-9A-F]+\\);"
1327 (setq plane (string-to-int (match-string 2))
1328 code (string-to-int (match-string 3) 16))
1330 (format "<img alt=\"cdp-%04x-var-%03d\" src=\"%s/cdp-%04x-var-%03d.svg\"
1331 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1334 chise-wiki-glyphwiki-glyph-image-url
1337 www-format-char-img-style)
1340 (goto-char (point-min))
1341 (while (re-search-forward
1342 "&\\(A-\\|G-\\|g2-\\|R-\\)?M-\\([0-9]+\\);"
1344 (setq code (string-to-int (match-string 2)))
1346 (format "<img alt=\"dkw-%05d\" src=\"%s/dkw-%05d.svg\"
1347 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1349 chise-wiki-glyphwiki-glyph-image-url
1351 www-format-char-img-style)
1354 (goto-char (point-min))
1355 (while (re-search-forward "&\\(g2-\\)?U-v\\([0-9]+\\)\\+\\([0-9A-F]+\\);" nil t)
1356 (setq plane (string-to-int (match-string 2))
1357 code (string-to-int (match-string 3) 16))
1359 (format "<img alt=\"u%04x-var-%03d\" src=\"%s/u%04x-var-%03d.svg\"
1360 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1363 chise-wiki-glyphwiki-glyph-image-url
1366 www-format-char-img-style)
1369 (goto-char (point-min))
1370 (while (re-search-forward "&\\(A-\\|G-\\|R-\\|g2-\\)?GT-\\([0-9]+\\);" nil t)
1371 (setq code (string-to-int (match-string 2)))
1373 (format "<img alt=\"GT-%05d\" src=\"%s?char=GT-%05d\"
1376 chise-wiki-glyph-cgi-url
1378 www-format-char-img-style)
1381 (goto-char (point-min))
1382 (while (re-search-forward "&\\(A-\\|G-\\|g2-\\)?GT-K\\([0-9]+\\);" nil t)
1383 (setq code (string-to-int (match-string 2)))
1385 (format "<img alt=\"GT-K%05d\" src=\"%s?char=GT-K%05d\"
1388 chise-wiki-glyph-cgi-url
1390 www-format-char-img-style)
1393 (goto-char (point-min))
1394 (while (re-search-forward "&B-\\([0-9A-F]+\\);" nil t)
1395 (setq code (string-to-int (match-string 1) 16))
1397 (format "<img alt=\"B-%04X\" src=\"%s?char=B-%04X\"
1400 chise-wiki-glyph-cgi-url
1402 www-format-char-img-style)
1405 (goto-char (point-min))
1406 (while (re-search-forward
1407 "&\\(A-\\|G-\\|g2-\\|R-\\|A-IWDS\\)?CDP-\\([0-9A-F]+\\);" nil t)
1408 (setq code (string-to-int (match-string 2) 16))
1410 (format "<img alt=\"CDP-%04X\" src=\"%s?char=CDP-%04X\"
1413 chise-wiki-glyph-cgi-url
1415 www-format-char-img-style)
1418 (goto-char (point-min))
1419 (while (re-search-forward
1420 "&\\(I-\\)?HZK\\(0[1-9]\\|1[0-2]\\)-\\([0-9A-F]+\\);" nil t)
1421 (setq plane (match-string 2)
1422 code (string-to-int (match-string 3) 16))
1424 (format "<img alt=\"HZK%s-%04X\" src=\"%s?char=HZK%s-%04X\"
1428 chise-wiki-glyph-cgi-url
1431 www-format-char-img-style)
1434 (goto-char (point-min))
1435 (while (re-search-forward "&\\(A-\\|G-\\|g2-\\|R-\\)?RUI6-\\([0-9A-F]+\\);" nil t)
1436 (setq code (string-to-int (match-string 2) 16))
1438 (format "<img alt=\"RUI6-%04X\" src=\"%s?char=RUI6-%04X\"
1439 style=\"vertical-align:middle\">"
1441 chise-wiki-glyph-cgi-url
1443 www-format-char-img-style)
1446 (goto-char (point-min))
1447 (while (re-search-forward "&hanaJU\\+\\([0-9A-F]+\\);" nil t)
1448 (setq code (string-to-int (match-string 1) 16))
1450 (format "<img alt=\"hanaJU+%04X\" src=\"%s?char=hana-JU+%04X\"
1451 style=\"vertical-align:middle\">"
1453 chise-wiki-glyph-cgi-url
1455 www-format-char-img-style)
1458 (goto-char (point-min))
1459 (while (re-search-forward "&\\(A-\\|G-\\|g2-\\|R-\\)?\\(UU\\+\\|U-\\)\\([0-9A-F]+\\);" nil t)
1460 (setq code (string-to-int (match-string 3) 16))
1462 (format "<img alt=\"UU+%04X\" src=\"https://www.unicode.org/cgi-bin/refglyph?24-%04X\"
1463 style=\"vertical-align:middle\">"
1466 www-format-char-img-style)
1469 (goto-char (point-min))
1470 (while (re-search-forward "&MCS-\\([0-9A-F]+\\);" nil t)
1471 (setq code (string-to-int (match-string 1) 16))
1472 (setq start (match-beginning 0)
1474 (setq char (decode-char 'system-char-id code))
1476 ((and (setq variants
1477 (or (www-get-feature-value char '->subsumptive)
1478 (www-get-feature-value char '->denotational)))
1480 (if (characterp variants)
1481 (setq variants (list variants)))
1482 (while (and variants
1483 (setq ret (www-format-encode-string
1484 (char-to-string (car variants))))
1485 (string-match "&MCS-\\([0-9A-F]+\\);" ret))
1486 (setq variants (cdr variants)))
1488 (unless (string-match "&MCS-\\([0-9A-F]+\\);" ret)
1490 (delete-region start end)
1493 ((setq ret (or (www-get-feature-value char 'ideographic-combination)
1494 (www-get-feature-value char 'ideographic-structure)))
1499 (if (characterp (setq rret (find-char ch)))
1502 (www-format-encode-string
1503 (char-to-string ch) without-tags)
1504 (www-format-encode-string
1505 (format "%S" ch) without-tags)))
1509 (delete-region start end)
1513 ;; (goto-char (point-min))
1514 ;; (while (search-forward ">-" nil t)
1515 ;; (replace-match "&GT-" t 'literal))
1518 (defun www-html-display-text (text)
1522 (goto-char (point-min))
1523 (while (search-forward "<" nil t)
1524 (replace-match "<" nil t))
1525 (goto-char (point-min))
1526 (while (search-forward ">" nil t)
1527 (replace-match ">" nil t))
1528 (goto-char (point-min))
1529 (while (re-search-forward "\\[\\[\\([^]|[]+\\)|\\([^][]+\\)\\]\\]" nil t)
1531 (format "<a href=\"%s\">%s</a>"
1535 (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
1536 (goto-char (point-min))
1537 (while (search-forward ">-" nil t)
1538 (replace-match "&GT-" nil t))
1541 (defun www-html-display-paragraph (text)
1543 (www-html-display-text text)
1550 (defvar coded-charset-GlyphWiki-id-alist
1551 '((===adobe-japan1-0 "aj1-" 5 d nil)
1552 (===adobe-japan1-1 "aj1-" 5 d nil)
1553 (===adobe-japan1-2 "aj1-" 5 d nil)
1554 (===adobe-japan1-3 "aj1-" 5 d nil)
1555 (===adobe-japan1-4 "aj1-" 5 d nil)
1556 (===adobe-japan1-5 "aj1-" 5 d nil)
1557 (===adobe-japan1-6 "aj1-" 5 d nil)
1558 (===mj "jmj-" 6 d nil)
1559 (===ucs@jis "u" 4 x "-j")
1560 (===daikanwa "dkw-" 5 d nil)
1561 (===ucs@ks "u" 4 x "-k")
1562 (===jis-x0208@1978 "j78-" 4 x nil)
1563 (==ucs-itaiji-005 "u" 4 x "-itaiji-005")
1564 (=ucs-var-001 "u" 4 x "-var-001")
1565 (=ucs-var-002 "u" 4 x "-var-002")
1566 (=ucs-var-003 "u" 4 x "-var-003")
1567 (=ucs-var-004 "u" 4 x "-var-004")
1568 (=ucs-var-006 "u" 4 x "-var-006")
1569 (=ucs-var-010 "u" 4 x "-var-010")
1570 (=ucs-itaiji-001 "u" 4 x "-itaiji-001")
1571 (=ucs-itaiji-002 "u" 4 x "-itaiji-002")
1572 (=ucs-itaiji-003 "u" 4 x "-itaiji-003")
1573 (=ucs-itaiji-004 "u" 4 x "-itaiji-004")
1574 (=ucs-itaiji-005 "u" 4 x "-itaiji-005")
1575 (=ucs-itaiji-006 "u" 4 x "-itaiji-006")
1576 (=ucs-itaiji-007 "u" 4 x "-itaiji-007")
1577 (=ucs-itaiji-008 "u" 4 x "-itaiji-008")
1578 (=ucs-itaiji-084 "u" 4 x "-itaiji-084")
1579 (=>ucs-itaiji-001 "u" 4 x "-itaiji-001")
1580 (=>ucs-itaiji-002 "u" 4 x "-itaiji-002")
1581 (=>ucs-itaiji-003 "u" 4 x "-itaiji-003")
1582 (=>ucs-itaiji-004 "u" 4 x "-itaiji-004")
1583 (=>ucs-itaiji-005 "u" 4 x "-itaiji-005")
1584 (=>ucs-itaiji-006 "u" 4 x "-itaiji-006")
1585 (=>ucs-itaiji-007 "u" 4 x "-itaiji-007")
1586 (=>ucs-itaiji-008 "u" 4 x "-itaiji-008")
1587 (==adobe-japan1-0 "aj1-" 5 d nil)
1588 (==adobe-japan1-1 "aj1-" 5 d nil)
1589 (==adobe-japan1-2 "aj1-" 5 d nil)
1590 (==adobe-japan1-3 "aj1-" 5 d nil)
1591 (==adobe-japan1-4 "aj1-" 5 d nil)
1592 (==adobe-japan1-5 "aj1-" 5 d nil)
1593 (==adobe-japan1-6 "aj1-" 5 d nil)
1594 (==mj "jmj-" 6 d nil)
1595 (==ucs@jis "u" 4 x "-j")
1596 (==ucs@iso "u" 4 x nil)
1597 ;; (==ucs@cns "u" 4 x "-t")
1598 (==ucs@unicode "u" 4 x "-us")
1599 (==ucs@JP/hanazono "u" 4 x "-jv")
1600 (==gt "gt-" 5 d nil)
1601 (==gt-k "gt-k" 5 d nil)
1602 (==daikanwa "dkw-" 5 d nil)
1603 (==ucs@ks "u" 4 x "-k")
1604 (==jis-x0208@1978 "j78-" 4 x nil)
1605 (==jis-x0208 "j90-" 4 x nil)
1606 (==jis-x0208@1990 "j90-" 4 x nil)
1607 (==jis-x0208@1983 "j83-" 4 x nil)
1608 (==cbeta "cbeta-" 5 d nil)
1609 (=>>hanyo-denshi/ks "koseki-" 6 d nil)
1610 (=>>jis-x0208@1978 "j78-" 4 x nil)
1611 (=>>big5-cdp "cdp-" 4 x nil)
1612 (=>>adobe-japan1-0 "aj1-" 5 d nil)
1613 (=>>adobe-japan1-1 "aj1-" 5 d nil)
1614 (=>>adobe-japan1-2 "aj1-" 5 d nil)
1615 (=>>adobe-japan1-3 "aj1-" 5 d nil)
1616 (=>>adobe-japan1-4 "aj1-" 5 d nil)
1617 (=>>adobe-japan1-5 "aj1-" 5 d nil)
1618 (=>>adobe-japan1-6 "aj1-" 5 d nil)
1619 (=>>jis-x0208 "j90-" 4 x nil)
1620 (=>>jis-x0208@1990 "j90-" 4 x nil)
1621 (=>>jis-x0208@1983 "j83-" 4 x nil)
1622 (=>>daikanwa "dkw-" 5 d nil)
1623 (=adobe-japan1-0 "aj1-" 5 d nil)
1624 (=adobe-japan1-1 "aj1-" 5 d nil)
1625 (=adobe-japan1-2 "aj1-" 5 d nil)
1626 (=adobe-japan1-3 "aj1-" 5 d nil)
1627 (=adobe-japan1-4 "aj1-" 5 d nil)
1628 (=adobe-japan1-5 "aj1-" 5 d nil)
1629 (=adobe-japan1-6 "aj1-" 5 d nil)
1630 (=hanyo-denshi/ks "koseki-" 6 d nil)
1631 (=mj "jmj-" 6 d nil)
1632 (=decomposition@cid)
1633 (=decomposition@hanyo-denshi)
1634 (=koseki "koseki-" 6 d nil)
1635 (=hanyo-denshi/tk "toki-" 8 d nil)
1636 (=ucs@jis "u" 4 x "-j")
1637 ;; (=ucs@cns "u" 4 x "-t")
1638 (=ucs@ks "u" 4 x "-k")
1639 (=ucs@JP "u" 4 x "-jv")
1640 (=ucs@JP/hanazono "u" 4 x "-jv")
1641 (=ucs@gb "u" 4 x "-g")
1642 (=big5-cdp "cdp-" 4 x nil)
1643 (=>big5-cdp "cdp-" 4 x nil)
1644 (=+>big5-cdp "cdp-" 4 x nil)
1645 (=>big5-cdp@iwds-1 "cdp-" 4 x nil)
1646 (=cbeta "cbeta-" 5 d nil)
1647 (=>cbeta "cbeta-" 5 d nil)
1648 (=big5-cdp-var-001 "cdp-" 4 x "-var-001")
1649 (=big5-cdp-var-003 "cdp-" 4 x "-var-003")
1650 (=big5-cdp-var-005 "cdp-" 4 x "-var-005")
1651 (=big5-cdp-itaiji-001 "cdp-" 4 x "-itaiji-001")
1652 (=big5-cdp-itaiji-002 "cdp-" 4 x "-itaiji-002")
1653 (=big5-cdp-itaiji-003 "cdp-" 4 x "-itaiji-003")
1654 (=>big5-cdp-itaiji-001 "cdp-" 4 x "-itaiji-001")
1655 (=>big5-cdp-itaiji-002 "cdp-" 4 x "-itaiji-002")
1656 (=>big5-cdp-itaiji-003 "cdp-" 4 x "-itaiji-003")
1657 (=jef-china3 "jc3-" 4 x nil)
1658 (=jis-x0212 "jsp-" 4 x nil)
1659 (=jis-x0213-1@2000 "jx1-2000-" 4 x nil)
1660 (=jis-x0213-1@2004 "jx1-2004-" 4 x nil)
1661 (=jis-x0213-2 "jx2-" 4 x nil)
1663 (=gt-k "gt-k" 5 d nil)
1664 (=>gt-k "gt-k" 5 d nil)
1665 (=daikanwa "dkw-" 5 d nil)
1666 (=ruimoku-v6 "rui6-" 4 x nil)
1667 (=>ruimoku-v6 "rui6-" 4 x nil)
1668 (=ucs@iso "u" 4 x "-u")
1669 (=ucs@unicode "u" 4 x "-us")
1670 (=jis-x0208@1978/1pr "j78-" 4 x nil)
1671 (=jis-x0208@1978/-4pr "j78-" 4 x nil)
1672 (=jis-x0208@1978 "j78-" 4 x nil)
1673 (=+>jis-x0208@1978 "j78-" 4 x nil)
1674 (=+>jis-x0208 "j90-" 4 x nil)
1675 (=+>jis-x0208@1990 "j90-" 4 x nil)
1676 (=+>jis-x0208@1983 "j83-" 4 x nil)
1678 (=big5 "b-" 4 x nil)
1679 (=ks-x1001 "k0-" 4 x nil)
1680 ;; (=cns11643-1 "c1-" 4 x nil)
1681 ;; (=cns11643-2 "c2-" 4 x nil)
1682 ;; (=cns11643-3 "c3-" 4 x nil)
1683 ;; (=cns11643-4 "c4-" 4 x nil)
1684 ;; (=cns11643-5 "c5-" 4 x nil)
1685 ;; (=cns11643-6 "c6-" 4 x nil)
1686 ;; (=cns11643-7 "c7-" 4 x nil)
1687 (=jis-x0208 "j90-" 4 x nil)
1688 (=jis-x0208@1990 "j90-" 4 x nil)
1689 (=jis-x0208@1983 "j83-" 4 x nil)
1692 (defun char-GlyphWiki-id (char)
1693 (let ((rest coded-charset-GlyphWiki-id-alist)
1696 (setq spec (pop rest))
1697 (null (setq ret (get-char-attribute char (car spec))))))
1701 (mapconcat #'char-GlyphWiki-id ret "-"))
1702 (and (memq (car spec) '(=ucs@unicode '=ucs@iso))
1704 ((and (or (encode-char char '=jis-x0208@1990)
1705 (encode-char char '=jis-x0212)
1706 (encode-char char '=jis-x0213-1)
1707 (encode-char char '=jis-x0213-2))
1708 (setq code (encode-char char '=ucs@jis)))
1709 (format "u%04x-j" code)
1711 ((and (or (encode-char char '=gb2312)
1712 (encode-char char '=gb12345))
1713 (setq code (encode-char char '=ucs@gb)))
1714 (format "u%04x-g" code)
1716 ;; ((and (or (encode-char char '=cns11643-1)
1717 ;; (encode-char char '=cns11643-2)
1718 ;; (encode-char char '=cns11643-3)
1719 ;; (encode-char char '=cns11643-4)
1720 ;; (encode-char char '=cns11643-5)
1721 ;; (encode-char char '=cns11643-6)
1722 ;; (encode-char char '=cns11643-7))
1723 ;; (setq code (encode-char char '=ucs@cns)))
1724 ;; (format "u%04x-t" code)
1726 ((and (encode-char char '=ks-x1001)
1727 (setq code (encode-char char '=ucs@ks)))
1728 (format "u%04x-k" code)
1730 (format (format "%s%%0%d%s%s"
1734 (or (nth 4 spec) ""))
1741 (provide 'cwiki-common)
1743 ;;; cwiki-common.el ends here