(require 'ids-find)
(require 'cwiki-common)
(setq www-format-char-img-style "vertical-align:middle;")
(defvar hng-ccs-list
(let (dest)
(dolist (ccs (charset-list))
(when (string-match "^===hng-" (symbol-name ccs))
(setq dest (cons ccs dest))))
dest))
(defun char-hng-p (char)
(or (get-char-attribute char '->HNG)
(char-have-hng-p char)))
(defun char-have-hng-p (char)
(or (some (lambda (ccs)
(and (encode-char char ccs)
char))
hng-ccs-list)
(some #'char-have-hng-p
(get-char-attribute char '->subsumptive))
(some #'char-have-hng-p
(get-char-attribute char '->denotational))))
(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-hng-ids-find-version "0.26")
(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)
(let ((ret (ideographic-products-find components))
products
is as bs len ignore-children)
(dolist (char ret)
(if (char-hng-p char)
(setq products (cons char products))))
(setq len (length products))
(when (>= len 1024)
(setq ignore-children t)
(princ
(encode-coding-string
"
結果が多すぎるため、再帰的検索を省略しました。
" 'utf-8-jp-er))) (if (>= len 2048) (dolist (c products) (www-ids-find-format-char c)) (princ "Version ") (princ www-hng-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 "
") (unless (file-newer-than-file-p www-ids-find-ideographic-products-file-name (locate-file (car command-line-args) exec-path)) (princ (encode-coding-string "
現在、システムの更新作業中です。しばらくお待ちください。
指定した部品を全て含む漢字の一覧を表示します。
CHISE で用いられる実態参照形式(例:&M-00256;)で部品を指定する事もできます。" 'utf-8-jp-er)) (princ (encode-coding-string "
\[Links\]
Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2015 MORIOKA Tomohiko") (princ (format "
Powered by XEmacs CHISE %s." (encode-coding-string xemacs-chise-version 'utf-8-jp-er))) (princ " ")))