(chise-wiki-glyph-cgi-url): New variable.
authorMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Thu, 18 Mar 2010 10:19:15 +0000 (19:19 +0900)
committerMORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Thu, 18 Mar 2010 10:19:15 +0000 (19:19 +0900)
(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.

cwiki-common.el

index 0aa7094..45f1957 100644 (file)
@@ -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)
                      =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 "&lt;" 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 "&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)