www/www-ids-find.el

   1 (require 'ids-find)
   2
   3 (defun decode-url-string (string &optional coding-system)
   4   (if (> (length string) 0)
   5       (let ((i 0)
   6             dest)
   7         (while (string-match "%\\([0-9A-F][0-9A-F]\\)" string i)
   8           (setq dest (concat dest
   9                              (substring string i (match-beginning 0))
  10                              (char-to-string
  11                               (int-char
  12                                (string-to-int (match-string 1 string) 16))))
  13                 i (match-end 0)))
  14         (decode-coding-string
  15          (concat dest (substring string i))
  16          coding-system))))
  17
  18 (defvar www-ids-find-tang-chars-file-name
  19   "~tomo/projects/chise/ids/www/tang-chars.udd")
  20
  21 (defun www-batch-ids-find ()
  22   (let ((components (car command-line-args-left))
  23         is ucs)
  24     (setq command-line-args-left (cdr command-line-args-left))
  25     (cond
  26      ((stringp components)
  27       (if (string-match "^components=" components)
  28           (setq components (substring components (match-end 0))))
  29       (setq components
  30             (if (> (length components) 0)
  31                 (decode-url-string components 'utf-8-jp-er)
  32               nil))
  33       )
  34      (t
  35       (setq components nil)
  36       ))
  37     (princ "Content-Type: text/html; charset=\"UTF-8\"
  38
  39 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
  40             \"http://www.w3.org/TR/html4/loose.dtd\">
  41 <html lang=\"ja\">
  42 <head>
  43 <title>CHISE IDS Find</title>
  44 </head>
  45
  46 <body>
  47
  48 <h1>")
  49     (princ (encode-coding-string "CHISE IDS \e$B4A;z8!:w\e(B" 'utf-8-jp-er))
  50     (princ "</h1>
  51 <p>
  52 <form action=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/ids-find\" method=\"GET\">
  53 ")
  54     (princ (encode-coding-string "\e$BItIJJ8;zNs\e(B" 'utf-8-jp-er))
  55     (princ " <input type=\"text\" name=\"components\" size=\"30\" maxlength=\"30\" value=\"")
  56     (if (> (length components) 0)
  57         (princ (encode-coding-string components 'utf-8-er)))
  58     (princ "\">
  59 <input type=\"submit\" value=\"")
  60     (princ (encode-coding-string "\e$B8!:w3+;O\e(B" 'utf-8-jp-er))
  61     (princ "\">
  62 </form>
  63
  64 ")
  65     (when components
  66       ;; (map-char-attribute
  67       ;;  (lambda (c v)
  68       ;;    (when (every (lambda (p)
  69       ;;                   (ideographic-structure-member p v))
  70       ;;                 components)
  71       ;;      (princ (encode-coding-string
  72       ;;              (ids-find-format-line c v)
  73       ;;              'utf-8-jp-er))
  74       ;;      (princ "<br>\n")
  75       ;;      )
  76       ;;    nil)
  77       ;;  'ideographic-structure)
  78       (dolist (c (ideographic-products-find components))
  79         (setq is (char-feature c 'ideographic-structure))
  80         ;; to avoid problems caused by wrong indexes
  81         (when (every (lambda (c)
  82                        (ideographic-structure-member c is))
  83                      components)
  84           (princ
  85            (encode-coding-string
  86             (format "%c" c)
  87             'utf-8-jp-er))
  88           (princ
  89            (or (if (setq ucs (or (char-ucs c)
  90                                  (encode-char c 'ucs)))
  91                    (format " <a href=\"http://www.unicode.org/cgi-bin/GetUnihanData.pl?codepoint=%X\">%s</a>"
  92                            ucs
  93                            (cond ((<= ucs #xFFFF)
  94                                   (format "U+%04X" ucs))
  95                                  ((<= ucs #x10FFFF)
  96                                   (format "U-%08X" ucs))))
  97                  "          ")))
  98           (princ " ")
  99           (princ
 100            (encode-coding-string
 101             (ideographic-structure-to-ids is)
 102             'utf-8-jp-er))
 103           (when (and ucs
 104                      (with-current-buffer
 105                          (find-file-noselect
 106                           www-ids-find-tang-chars-file-name)
 107                        (goto-char (point-min))
 108                        (re-search-forward (format "^%d$" ucs) nil t)))
 109             (princ
 110              (format " <a href=\"http://coe21.zinbun.kyoto-u.ac.jp/djvuchar?query=%s\">"
 111                      (mapconcat
 112                       (lambda (c)
 113                         (format "%%%02X" (char-int c)))
 114                       (encode-coding-string (char-to-string c)
 115                                             'utf-8-jp)
 116                       "")))
 117             (princ (encode-coding-string "\e$B"M\e(B[\e$BEbBeBsK\\e(B]</a>" 'utf-8-jp-er)))
 118           (princ "<br>\n")
 119           ))
 120       )
 121     (princ "
 122 </body>
 123 </html>
 124 ")))