(require 'ids-find)
(defun decode-url-string (string &optional coding-system)
(if (> (length string) 0)
(let ((i 0)
dest)
(while (string-match "%\\([0-9A-F][0-9A-F]\\)" string i)
(setq dest (concat dest
(substring string i (match-beginning 0))
(char-to-string
(int-char
(string-to-int (match-string 1 string) 16))))
i (match-end 0)))
(decode-coding-string
(concat dest (substring string i))
coding-system))))
(defvar www-ids-find-tang-chars-file-name
"~tomo/projects/chise/ids/www/tang-chars.udd")
(defun www-ids-find-format-line (c is)
(let ((str (encode-coding-string (format "%c" c) 'utf-8-jp-er))
code ucs)
(cond
((string-match "&CB\\([0-9]+\\);" str)
(setq code (string-to-int (match-string 1 str)))
(princ (format "![\"CB%05d\"](\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/glyphs/cb-gaiji/%02d/CB%05d.gif\")
\n"
code (/ code 1000) code))
(princ (format "CB%05d" code))
)
(t
(princ str)))
(princ
(or (if (setq ucs (or (char-ucs c)
(encode-char c 'ucs)))
(format " %s"
ucs
(cond ((<= ucs #xFFFF)
(format "U+%04X" ucs))
((<= ucs #x10FFFF)
(format "U-%08X" ucs))))
" ")))
(princ " ")
(when is
(princ
(with-temp-buffer
(insert
(encode-coding-string
(ideographic-structure-to-ids is)
'utf-8-jp-er))
(goto-char (point-min))
(while (re-search-forward "&CB\\([0-9]+\\);" nil t)
(setq code (string-to-int (match-string 1)))
(replace-match
(format ""
code (/ code 1000) code)
t 'literal))
(buffer-string))))
(when (and ucs
(with-current-buffer
(find-file-noselect
www-ids-find-tang-chars-file-name)
(goto-char (point-min))
(re-search-forward (format "^%d$" ucs) nil t)))
(princ
(format " "
(mapconcat
(lambda (c)
(format "%%%02X" (char-int c)))
(encode-coding-string (char-to-string c)
'utf-8-jp)
"")))
(princ (encode-coding-string "⇒[唐代拓本]" 'utf-8-jp-er)))
(princ "
\n")))
(defun www-batch-ids-find ()
(let ((components (car command-line-args-left))
(coded-charset-entity-reference-alist
(list*
'((=cbeta "CB" 5 d)
(=jef-china3 "JC3-" 4 X))
coded-charset-entity-reference-alist))
is)
(setq command-line-args-left (cdr command-line-args-left))
(cond
((stringp components)
(if (string-match "^components=" components)
(setq components (substring components (match-end 0))))
(setq components
(if (> (length components) 0)
(decode-url-string components 'utf-8-jp-er)
nil))
)
(t
(setq components nil)
))
(princ "Content-Type: text/html; charset=\"UTF-8\"
CHISE IDS Find
")
(princ (encode-coding-string "CHISE IDS 漢字検索" 'utf-8-jp-er))
(princ "
")
(cond
(components
;; (map-char-attribute
;; (lambda (c v)
;; (when (every (lambda (p)
;; (ideographic-structure-member p v))
;; components)
;; (princ (encode-coding-string
;; (ids-find-format-line c v)
;; 'utf-8-jp-er))
;; (princ "
\n")
;; )
;; nil)
;; 'ideographic-structure)
(when (= (length components) 1)
(www-ids-find-format-line (aref components 0) nil))
(dolist (c (ideographic-products-find components))
(setq is (char-feature c 'ideographic-structure))
;; to avoid problems caused by wrong indexes
(when (every (lambda (c)
(ideographic-structure-member c is))
components)
(www-ids-find-format-line c is)))
)
(t
(princ (encode-coding-string "
指定した部品を全て含む漢字の一覧を表示します。
CHISE で用いられる実態参照形式（例：&M-00256;）で部品を指定する事もできます。" 'utf-8-jp-er))
))
(princ "
")
(princ
(format
"Powered by XEmacs CHISE %s."
xemacs-chise-version))
(princ "
")))