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