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