From: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
Date: Thu, 18 Mar 2010 10:13:23 +0000 (+0900)
Subject: New file.
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=c81e6cceb809e06688fc2ec6b10098227f128096;p=chise%2Fest.git

New file.
---

diff --git a/cwiki-glyph.el b/cwiki-glyph.el
new file mode 100644
index 0000000..78aec8d
--- /dev/null
+++ b/cwiki-glyph.el
@@ -0,0 +1,131 @@
+(require 'cwiki-common)
+
+(setq file-name-coding-system 'utf-8-jp)
+
+(defun www-glyph-generate-png (ccs code-point &optional size)
+  (unless size
+    (setq size 40))
+  (let (png-file dir font char ret plain)
+    (cond
+     ((eq ccs '=gt)
+      (setq char (decode-char '=gt code-point)
+	    png-file (format "/opt/chisewiki/glyphs/%d/GT/%05d.png"
+			     size code-point))
+      (setq plain 1)
+      (while (and (<= plain 11)
+		  (null
+		   (setq ret (encode-char
+			      char
+			      (intern (format "=gt-pj-%d" plain))))))
+	(setq plain (1+ plain)))
+      (setq font (format
+		  "/usr/local/share/fonts/TrueType/GT/gt2000%02d.ttf"
+		  plain)
+	    char (decode-char '=jis-x0208@1990 ret))
+      (when (setq ret (encode-char char '=ucs@jis/1990))
+	(setq char (decode-char '=ucs ret)))
+      )
+     ((eq ccs '=big5)
+      (setq font "/usr/local/share/fonts/TrueType/Arphic/bsmi00lp.ttf"
+	    char (decode-char '=big5 code-point)
+	    png-file (format "/opt/chisewiki/glyphs/%d/Big5/%04X.png"
+			     size code-point))
+      (when (setq ret (or (encode-char char '=ucs@big5)
+			  (char-ucs char)))
+	(setq char (decode-char '=ucs ret)))
+      )
+     ((eq ccs '=big5-cdp)
+      (setq font "/usr/local/share/fonts/TrueType/CDP/Cdpeudc.ttf"
+	    char (decode-char '=big5-pua code-point)
+	    png-file (format "/opt/chisewiki/glyphs/%d/CDP/%04X.png"
+			     size code-point))
+      ))
+    (when font
+      (if (= (call-process
+	      "convert" nil nil nil
+	      "-size" (format "%dx%d" size size)
+	      "-font" font
+	      (concat "label:" (char-to-string char))
+	      (progn
+		(setq dir (file-name-directory png-file))
+		(unless (file-exists-p dir)
+		  (make-directory dir t))
+		png-file))
+	     0)
+	  png-file))))
+
+(defun www-glyph-display-png (char-rep &optional size)
+  (when (stringp size)
+    (setq size (string-to-int size)))
+  (let ((png-file
+	 (cond
+	  ((string-match "^GT-\\([0-9]+\\)" char-rep)
+	   (www-glyph-generate-png
+	    '=gt
+	    (string-to-int (match-string 1 char-rep))
+	    size)
+	   )
+	  ((string-match "^B-\\([0-9A-F]+\\)" char-rep)
+	   (www-glyph-generate-png
+	    '=big5
+	    (string-to-int (match-string 1 char-rep) 16)
+	    size)
+	   )
+	  ((string-match "^CDP-\\([0-9A-F]+\\)" char-rep)
+	   (www-glyph-generate-png
+	    '=big5-cdp
+	    (string-to-int (match-string 1 char-rep) 16)
+	    size)
+	   ))
+	 ))
+    (when png-file
+      (princ (format "Content-Type: %s"
+		     (with-temp-buffer
+		       (call-process
+			"file"
+			nil t t
+			"-b" "--mime" png-file)
+		       (insert "\n")
+		       (let ((coding-system-for-read 'binary)
+			     (coding-system-for-write 'binary))
+			 (insert-file-contents-literally png-file))
+		       (buffer-string)))))))
+
+(defun www-batch-display-glyph ()
+  (setq terminal-coding-system 'binary)
+  (condition-case err
+      (let* ((target (pop command-line-args-left))
+             ;; (user (pop command-line-args-left))
+             ;; (accept-language (pop command-line-args-left))
+             ;; (lang
+             ;;  (intern
+             ;;   (car (split-string
+             ;;         (car (split-string
+             ;;               (car (split-string accept-language ","))
+             ;;               ";"))
+             ;;         "-"))))
+	     ret)
+	(cond
+	 ((stringp target)
+	  (setq target
+		(mapcar (lambda (cell)
+			  (if (string-match "=" cell)
+			      (cons
+			       (intern
+				(decode-uri-string
+				 (substring cell 0 (match-beginning 0))
+				 'utf-8-mcs-er))
+			       (substring cell (match-end 0)))
+			    (list (decode-uri-string cell 'utf-8-mcs-er))))
+			(split-string target "&")))
+	  (setq ret (car target))
+	  (cond ((eq (car ret) 'char)
+		 (www-glyph-display-png
+		  (cdr ret)
+		  (cdr (assq 'size target)))
+		 ))
+	  ))
+	)
+    (error nil
+	   (princ (format "%S" err)))
+    ))