(defvar chise-wiki-bitmap-glyphs-url
"http://chise.zinbun.kyoto-u.ac.jp/glyphs")
+(defvar chise-wiki-glyph-cgi-url
+ "http://chise.zinbun.kyoto-u.ac.jp/chisewiki/glyph.cgi")
+
(defun decode-uri-string (string &optional coding-system)
(if (> (length string) 0)
(let ((i 0)
" (" (decimal) ") <" (ku-ten) ">")
'("0x" (HEX) " (" (decimal) ")")))))
+(defun char-feature-name-at-domain (feature-name domain)
+ (let ((name (symbol-name feature-name)))
+ (cond
+ ((string-match "@[^*]+$" name)
+ (intern (format "%s/%s" name domain))
+ )
+ (t
+ (intern (format "%s@%s" name domain))
+ ))))
+
+(defun www-char-feature (character feature)
+ (let ((latest-feature (char-feature-name-at-domain feature '$rev=latest)))
+ (mount-char-attribute-table latest-feature)
+ (or (char-feature character latest-feature)
+ (char-feature character feature))))
+
;;; @ URI representation
;;;
=gt =gt-k
=>>jis-x0208 =>>jis-x0213-1
=>jis-x0208 =>jis-x0213-1
+ =>>gt
=big5
=big5-cdp))
ccs ret)
(defun www-format-encode-string (string &optional without-tags)
(with-temp-buffer
(insert string)
- (let (plane code)
+ (let (plane code start end char variants ret)
(goto-char (point-min))
(while (search-forward "<" nil t)
(replace-match "<" nil t))
'(=jis-x0208@1990 "J90-" 4 X)
'(=jis-x0212 "JSP-" 4 X)
'(=cbeta "CB" 5 d)
- '(=jef-china3 "JC3-" 4 X)
'(=jis-x0208@1997 "J97-" 4 X)
'(=jis-x0208@1978 "J78-" 4 X)
'(=jis-x0208@1983 "J83-" 4 X)
+ '(=gt "GT-" 5 d)
'(=zinbun-oracle "ZOB-" 4 d)
+ '(=jef-china3 "JC3-" 4 X)
'(=daikanwa "M-" 5 d)
coded-charset-entity-reference-alist)))
(encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
chise-wiki-bitmap-glyphs-url
code)
t 'literal))
- ))
- (goto-char (point-min))
- (while (search-forward ">-" nil t)
- (replace-match "&GT-" t 'literal))
+ (goto-char (point-min))
+ (while (re-search-forward "&\\(G-\\)?GT-\\([0-9]+\\);" nil t)
+ (setq code (string-to-int (match-string 2)))
+ (replace-match
+ (format "<img alt=\"GT-%05d\" src=\"%s?char=GT-%05d\">"
+ code
+ chise-wiki-glyph-cgi-url
+ code)
+ t 'literal))
+
+ (goto-char (point-min))
+ (while (re-search-forward "&B-\\([0-9A-F]+\\);" nil t)
+ (setq code (string-to-int (match-string 1) 16))
+ (replace-match
+ (format "<img alt=\"B-%04X\" src=\"%s?char=B-%04X\">"
+ code
+ chise-wiki-glyph-cgi-url
+ code)
+ t 'literal))
+
+ (goto-char (point-min))
+ (while (re-search-forward "&CDP-\\([0-9A-F]+\\);" nil t)
+ (setq code (string-to-int (match-string 1) 16))
+ (replace-match
+ (format "<img alt=\"CDP-%04X\" src=\"%s?char=CDP-%04X\">"
+ code
+ chise-wiki-glyph-cgi-url
+ code)
+ t 'literal))
+
+ (goto-char (point-min))
+ (while (re-search-forward "&UU\\+\\([0-9A-F]+\\);" nil t)
+ (setq code (string-to-int (match-string 1) 16))
+ (replace-match
+ (format "<img alt=\"UU+%04X\" src=\"http://www.unicode.org/cgi-bin/refglyph?24-%04X\">"
+ code
+ code)
+ t 'literal))
+
+ (goto-char (point-min))
+ (while (re-search-forward "&MCS-\\([0-9A-F]+\\);" nil t)
+ (setq code (string-to-int (match-string 1) 16))
+ (setq start (match-beginning 0)
+ end (match-end 0))
+ (setq char (decode-char 'system-char-id code))
+ (setq variants (or (www-char-feature char '->subsumptive)
+ (www-char-feature char '->denotational)))
+ (while (and variants
+ (setq ret (www-format-encode-string
+ (char-to-string (car variants))))
+ (string-match "&MCS-\\([0-9A-F]+\\);" ret))
+ (setq variants (cdr variants)))
+ (unless (string-match "&MCS-\\([0-9A-F]+\\);" ret)
+ (goto-char start)
+ (delete-region start end)
+ (insert ret)))
+ ))
+ ;; (goto-char (point-min))
+ ;; (while (search-forward ">-" nil t)
+ ;; (replace-match "&GT-" t 'literal))
(buffer-string))))
(defun www-format-props-to-string (props &optional format)
feature-name
&optional format lang uri-char value)
(unless value
- (setq value (char-feature char feature-name)))
+ (setq value (www-char-feature char feature-name)))
(unless format
(setq format (www-feature-value-format feature-name)))
(cond
(defun www-format-eval-unit (exp char feature-name
&optional lang uri-char value)
(unless value
- (setq value (char-feature char feature-name)))
+ (setq value (www-char-feature char feature-name)))
(unless uri-char
(setq uri-char (www-uri-encode-char char)))
(cond