From: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Date: Thu, 18 Mar 2010 10:19:15 +0000 (+0900)
Subject: (chise-wiki-glyph-cgi-url): New variable.
X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fest.git;a=commitdiff_plain;h=0d8a692fec9a33ff55159de5d35ed84f62def5a4

(chise-wiki-glyph-cgi-url): New variable.
(www-uri-encode-char): Support `=>>gt'.
(www-format-encode-string):
- Use GT, Big5 and Big5-CDP fonts.
- Use http://www.unicode.org/cgi-bin/refglyph?24-hhhh to display
 `=ucs@unicode' glyphs.
- Display &MCS-hhhhhhhh; with using child's glyph.
---

diff --git a/cwiki-common.el b/cwiki-common.el
index 0aa7094..45f1957 100644
--- a/cwiki-common.el
+++ b/cwiki-common.el
@@ -7,6 +7,9 @@
 (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)
@@ -183,6 +186,7 @@
 		      =gt =gt-k
 		      =>>jis-x0208 =>>jis-x0213-1
 		      =>jis-x0208 =>jis-x0213-1
+		      =>>gt
 		      =big5
 		      =big5-cdp))
 	  ccs ret)
@@ -360,7 +364,7 @@
 (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 "&lt;" nil t))
@@ -383,11 +387,12 @@
 		'(=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)
@@ -456,11 +461,67 @@
 		     chise-wiki-bitmap-glyphs-url
 		     code)
 	     t 'literal))
-	  ))
-      (goto-char (point-min))
-      (while (search-forward "&GT-" nil t)
-	(replace-match "&amp;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 (char-feature char '->subsumptive)
+			       (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 "&GT-" nil t)
+      ;;   (replace-match "&amp;GT-" t 'literal))
       (buffer-string))))
 
 (defun www-format-props-to-string (props &optional format)