cwiki-glyph.el

   1 (require 'cwiki-common)
   2
   3 (setq file-name-coding-system 'utf-8-jp)
   4
   5 (defun www-glyph-generate-png (ccs code-point &optional size)
   6   (unless size
   7     (setq size 40))
   8   (let (png-file dir font char ret plain)
   9     (cond
  10      ((eq ccs '=gt)
  11       (setq char (decode-char '=gt code-point)
  12             png-file (format "/opt/chisewiki/glyphs/%d/GT/%05d.png"
  13                              size code-point))
  14       (setq plain 1)
  15       (while (and (<= plain 11)
  16                   (null
  17                    (setq ret (encode-char
  18                               char
  19                               (intern (format "=gt-pj-%d" plain))))))
  20         (setq plain (1+ plain)))
  21       (setq font (format
  22                   "/usr/local/share/fonts/TrueType/GT/gt2000%02d.ttf"
  23                   plain)
  24             char (decode-char '=jis-x0208@1990 ret))
  25       (when (setq ret (encode-char char '=ucs@jis/1990))
  26         (setq char (decode-char '=ucs ret)))
  27       )
  28      ((eq ccs '=big5)
  29       (setq font "/usr/local/share/fonts/TrueType/Arphic/bsmi00lp.ttf"
  30             char (decode-char '=big5 code-point)
  31             png-file (format "/opt/chisewiki/glyphs/%d/Big5/%04X.png"
  32                              size code-point))
  33       (when (setq ret (or (encode-char char '=ucs@big5)
  34                           (char-ucs char)))
  35         (setq char (decode-char '=ucs ret)))
  36       )
  37      ((eq ccs '=big5-cdp)
  38       (setq font "/usr/local/share/fonts/TrueType/CDP/Cdpeudc.ttf"
  39             char (decode-char '=big5-pua code-point)
  40             png-file (format "/opt/chisewiki/glyphs/%d/CDP/%04X.png"
  41                              size code-point))
  42       ))
  43     (when font
  44       (if (= (call-process
  45               "convert" nil nil nil
  46               "-size" (format "%dx%d" size size)
  47               "-font" font
  48               (concat "label:" (char-to-string char))
  49               (progn
  50                 (setq dir (file-name-directory png-file))
  51                 (unless (file-exists-p dir)
  52                   (make-directory dir t))
  53                 png-file))
  54              0)
  55           png-file))))
  56
  57 (defun www-glyph-display-png (char-rep &optional size)
  58   (when (stringp size)
  59     (setq size (string-to-int size)))
  60   (let ((png-file
  61          (cond
  62           ((string-match "^GT-\\([0-9]+\\)" char-rep)
  63            (www-glyph-generate-png
  64             '=gt
  65             (string-to-int (match-string 1 char-rep))
  66             size)
  67            )
  68           ((string-match "^B-\\([0-9A-F]+\\)" char-rep)
  69            (www-glyph-generate-png
  70             '=big5
  71             (string-to-int (match-string 1 char-rep) 16)
  72             size)
  73            )
  74           ((string-match "^CDP-\\([0-9A-F]+\\)" char-rep)
  75            (www-glyph-generate-png
  76             '=big5-cdp
  77             (string-to-int (match-string 1 char-rep) 16)
  78             size)
  79            ))
  80          ))
  81     (when png-file
  82       (princ (format "Content-Type: %s"
  83                      (with-temp-buffer
  84                        (call-process
  85                         "file"
  86                         nil t t
  87                         "-b" "--mime" png-file)
  88                        (insert "\n")
  89                        (let ((coding-system-for-read 'binary)
  90                              (coding-system-for-write 'binary))
  91                          (insert-file-contents-literally png-file))
  92                        (buffer-string)))))))
  93
  94 (defun www-batch-display-glyph ()
  95   (setq terminal-coding-system 'binary)
  96   (condition-case err
  97       (let* ((target (pop command-line-args-left))
  98              ;; (user (pop command-line-args-left))
  99              ;; (accept-language (pop command-line-args-left))
 100              ;; (lang
 101              ;;  (intern
 102              ;;   (car (split-string
 103              ;;         (car (split-string
 104              ;;               (car (split-string accept-language ","))
 105              ;;               ";"))
 106              ;;         "-"))))
 107              ret)
 108         (cond
 109          ((stringp target)
 110           (setq target
 111                 (mapcar (lambda (cell)
 112                           (if (string-match "=" cell)
 113                               (cons
 114                                (intern
 115                                 (decode-uri-string
 116                                  (substring cell 0 (match-beginning 0))
 117                                  'utf-8-mcs-er))
 118                                (substring cell (match-end 0)))
 119                             (list (decode-uri-string cell 'utf-8-mcs-er))))
 120                         (split-string target "&")))
 121           (setq ret (car target))
 122           (cond ((eq (car ret) 'char)
 123                  (www-glyph-display-png
 124                   (cdr ret)
 125                   (cdr (assq 'size target)))
 126                  ))
 127           ))
 128         )
 129     (error nil
 130            (princ (format "%S" err)))
 131     ))