(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 '=ucs@JP/hanazono) (setq font (if (<= code-point 65535) "/usr/local/share/fonts/TrueType/Hanazono/HanaMinA.ttf" "/usr/local/share/fonts/TrueType/Hanazono/HanaMinB.ttf")) (setq char (decode-char '=ucs code-point) png-file (format "/opt/chisewiki/glyphs/%d/Hanazono/u%04X.png" size code-point)) ) ((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 '=gt-k) (setq char (decode-char '=gt-k code-point) png-file (format "/opt/chisewiki/glyphs/%d/GT-K/%05d.png" size code-point)) (setq plain 1) (while (and (<= plain 11) (null (setq ret (encode-char char (intern (format "=gt-pj-k%d" plain)))))) (setq plain (1+ plain))) (setq font (format "/usr/local/share/fonts/TrueType/GT/gt2000k%d.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)) ) ((eq ccs '=ruimoku-v6) (setq font "/usr/local/share/fonts/TrueType/Zinbun/rui6-eudc.ttf" char (decode-char '=ucs code-point) png-file (format "/opt/chisewiki/glyphs/%d/Ruimoku-v6/%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 "^hana-JU\\+\\([0-9A-F]+\\)" char-rep) (www-glyph-generate-png '=ucs@JP/hanazono (string-to-int (match-string 1 char-rep) 16) size) ) ((string-match "^GT-\\([0-9]+\\)" char-rep) (www-glyph-generate-png '=gt (string-to-int (match-string 1 char-rep)) size) ) ((string-match "^GT-K\\([0-9]+\\)" char-rep) (www-glyph-generate-png '=gt-k (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) ) ((string-match "^RUI6-\\([0-9A-F]+\\)" char-rep) (www-glyph-generate-png '=ruimoku-v6 (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))) ))