(require 'ids-find)
(require 'cwiki-common)
(setq www-format-char-img-style "vertical-align:middle;")
(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))))
(defconst www-ids-find-version "0.99.1")
(defvar www-ids-find-ideographic-products-file-name
(expand-file-name "ideographic-products"
(expand-file-name
"feature"
(expand-file-name
"character"
chise-system-db-directory))))
(defvar www-ids-find-char-viewer-url
"/est/view/character/")
(defvar www-ids-find-chise-link-map-url-prefix
"http://fonts.jp/chise_linkmap/map.cgi?code=")
(defvar www-ids-find-tang-chars-file-name
"~tomo/projects/chise/ids/www/tang-chars.udd")
(defun www-ids-find-format-char (c &optional code-desc)
(princ
(format "%s"
www-ids-find-char-viewer-url
(www-uri-encode-object c)
(www-format-encode-string (char-to-string c))))
;; (let ((str (encode-coding-string (format "%c" c) 'utf-8-er))
;; plane code)
;; (princ
;; (with-temp-buffer
;; (cond
;; ((string-match "&CB\\([0-9]+\\);" str)
;; (setq code (string-to-int (match-string 1 str)))
;; (insert (format "\n"
;; code (/ code 1000) code))
;; (when code-desc
;; (insert (format "CB%05d" code)))
;; )
;; ((string-match "&JC3-\\([0-9A-F]+\\);" str)
;; (setq code (string-to-int (match-string 1 str) 16))
;; (insert (format "\n"
;; code code))
;; (when code-desc
;; (insert (format "JC3-%04X" code)))
;; )
;; ((string-match "&J\\(78\\|83\\|90\\|SP\\)-\\([0-9A-F]+\\);" str)
;; (setq plane (match-string 1 str)
;; code (string-to-int (match-string 2 str) 16))
;; (insert (format "\n"
;; plane code plane
;; (- (lsh code -8) 32)
;; (- (logand code 255) 32)))
;; (when code-desc
;; (insert (format "J%s-%04X" plane code)))
;; )
;; ((string-match "&G\\([01]\\)-\\([0-9A-F]+\\);" str)
;; (setq plane (string-to-int (match-string 1 str))
;; code (string-to-int (match-string 2 str) 16))
;; (insert (format "\n"
;; plane code plane
;; (- (lsh code -8) 32)
;; (- (logand code 255) 32)))
;; (when code-desc
;; (insert (format "G%d-%04X" plane code)))
;; )
;; ((string-match "&C\\([1-7]\\)-\\([0-9A-F]+\\);" str)
;; (setq plane (string-to-int (match-string 1 str))
;; code (string-to-int (match-string 2 str) 16))
;; (insert (format "\n"
;; plane code plane code))
;; (when code-desc
;; (insert (format "C%d-%04X" plane code)))
;; )
;; ((string-match "&ZOB-\\([0-9]+\\);" str)
;; (setq code (string-to-int (match-string 1 str)))
;; (insert (format "\n"
;; code code))
;; (when code-desc
;; (insert (format "ZOB-%04d" code)))
;; )
;; (t
;; (insert (format "")
;; (insert str)
;; (insert "")
;; ))
;; (goto-char (point-min))
;; (while (search-forward "&" nil t)
;; (replace-match "&" t 'literal))
;; (buffer-string))))
)
(defun www-ids-find-format-line (c is)
(let (ucs len i ids)
(princ "")
(www-ids-find-format-char c 'code-desc)
(princ "")
(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))))
" ")))
(when ucs
(princ
(format " (link map)"
www-ids-find-chise-link-map-url-prefix ucs)))
(princ " ")
(when is
(setq ids (ideographic-structure-to-ids is))
(setq i 0
len (length ids))
(princ "")
(while (< i len)
(www-ids-find-format-char (aref ids i))
(setq i (1+ i)))
(princ ""))
(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-ids-insert-chars-including-components* (components
&optional ignored-chars products)
(unless products
(setq products (ideograph-find-products components ignored-chars)))
(let (is as bs len)
(setq len (length products))
(princ "
結果が多すぎるため、再帰的検索を省略しました。
" 'utf-8-jp-er))) (if (>= len 2048) (dolist (c products) (www-ids-find-format-char c)) (setq ignored-chars (nreverse (www-ids-insert-chars-including-components* components ignored-chars products))) (dolist (c ignored-chars) (dolist (vc (char-component-variants c)) (unless (memq vc ignored-chars) (when (setq is (get-char-attribute vc 'ideographic-structure)) (princ "結果が多すぎるため、関連字の再帰的検索を省略しました。
" 'utf-8-jp-er))) (if (>= len 1024) (dolist (c products) (www-ids-find-format-char c)) (dolist (c (sort (copy-tree products) (lambda (a b) (if (setq as (char-total-strokes a)) (if (setq bs (char-total-strokes b)) (if (= as bs) (ideograph-char< a b) (< as bs)) t) (ideograph-char< a b))))) (unless (memq c ignored-chars) (setq is (get-char-attribute c 'ideographic-structure)) (princ "Version ") (princ www-ids-find-version) (princ (format-time-string " (Last-modified: %Y-%m-%d %H:%M:%S)
" (nth 5 (file-attributes www-ids-find-ideographic-products-file-name)))) (princ "現在、システムの更新作業中です。しばらくお待ちください。
指定した部品を全て含む漢字の一覧を表示します。
CHISE で用いられる実態参照形式(例:&M-00256;)で部品を指定する事もできます。
\[Links\]