New file.

diff --git a/cwiki-glyph.el b/cwiki-glyph.el
new file mode 100644 (file)
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)))
+    ))