(require 'ids-find) (require 'cwiki-common) (defun www-format-encode-string (string &optional without-tags as-body) (with-temp-buffer (insert string) (let (plane code subcode start end char variants ret rret) (when as-body (goto-char (point-min)) (while (search-forward "&" nil t) (replace-match "&" nil t))) (goto-char (point-min)) (while (search-forward "<" nil t) (replace-match "<" nil t)) (goto-char (point-min)) (while (search-forward ">" nil t) (replace-match ">" nil t)) (if without-tags (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er) (let ((coded-charset-entity-reference-alist (list* '(=gt "GT-" 5 d) '(=mj "MJ" 6 d) '(=hanyo-denshi/ja "HD-JA-" 4 X) '(=hanyo-denshi/jb "HD-JB-" 4 X) '(=hanyo-denshi/jc "HD-JC-" 4 X) '(=hanyo-denshi/jd "HD-JD-" 4 X) '(=hanyo-denshi/ft "HD-FT-" 4 X) '(=hanyo-denshi/ia "HD-IA-" 4 X) '(=hanyo-denshi/ib "HD-IB-" 4 X) '(=hanyo-denshi/hg "HD-HG-" 4 X) '(=hanyo-denshi/ip "HD-IP-" 4 X) '(=hanyo-denshi/jt "HD-JT-" 4 X) '(=hanyo-denshi/ks "HD-KS-" 6 d) '(=>>hanyo-denshi/ja "G-HD-JA-" 4 X) '(=>>hanyo-denshi/jb "G-HD-JB-" 4 X) '(=>>hanyo-denshi/jc "G-HD-JC-" 4 X) '(=>>hanyo-denshi/jd "G-HD-JD-" 4 X) '(=>>hanyo-denshi/ft "G-HD-FT-" 4 X) '(=>>hanyo-denshi/ia "G-HD-IA-" 4 X) '(=>>hanyo-denshi/ib "G-HD-IB-" 4 X) '(=>>hanyo-denshi/hg "G-HD-HG-" 4 X) '(=>>hanyo-denshi/ip "G-HD-IP-" 4 X) '(=>>hanyo-denshi/jt "G-HD-JT-" 4 X) '(=>>hanyo-denshi/ks "G-HD-KS-" 6 d) '(==mj "g2-MJ" 6 d) '(==hanyo-denshi/ja "g2-HD-JA-" 4 X) '(==hanyo-denshi/jb "g2-HD-JB-" 4 X) '(==hanyo-denshi/jc "g2-HD-JC-" 4 X) '(==hanyo-denshi/jd "g2-HD-JD-" 4 X) '(==hanyo-denshi/ft "g2-HD-FT-" 4 X) '(==hanyo-denshi/ia "g2-HD-IA-" 4 X) '(==hanyo-denshi/ib "g2-HD-IB-" 4 X) '(==hanyo-denshi/hg "g2-HD-HG-" 4 X) '(==hanyo-denshi/ip "g2-HD-IP-" 4 X) '(==hanyo-denshi/jt "g2-HD-JT-" 4 X) '(==hanyo-denshi/ks "g2-HD-KS-" 6 d) '(==daijiten "g2-DJT-" 5 d) '(=cns11643-1 "C1-" 4 X) '(=cns11643-2 "C2-" 4 X) '(=cns11643-3 "C3-" 4 X) '(=cns11643-4 "C4-" 4 X) '(=cns11643-5 "C5-" 4 X) '(=cns11643-6 "C6-" 4 X) '(=cns11643-7 "C7-" 4 X) '(=adobe-japan1-6 "AJ1-" 5 d) '(=big5-cdp "CDP-" 4 X) '(=>big5-cdp "A-CDP-" 4 X) '(=gb2312 "G0-" 4 X) '(=gb12345 "G1-" 4 X) '(=jis-x0208@1990 "J90-" 4 X) '(=jis-x0212 "JSP-" 4 X) '(=cbeta "CB" 5 d) '(=jis-x0208@1997 "J97-" 4 X) '(=jis-x0208@1978 "J78-" 4 X) '(=jis-x0208@1983 "J83-" 4 X) '(=ruimoku-v6 "RUI6-" 4 X) '(=zinbun-oracle "ZOB-" 4 d) '(=daijiten "DJT-" 5 d) '(=jef-china3 "JC3-" 4 X) '(=ucs@unicode "UU+" 4 X) '(=ucs@JP/hanazono "hanaJU+" 4 X) '(==cns11643-1 "R-C1-" 4 X) '(==cns11643-2 "R-C2-" 4 X) '(==cns11643-3 "R-C3-" 4 X) '(==cns11643-4 "R-C4-" 4 X) '(==cns11643-5 "R-C5-" 4 X) '(==cns11643-6 "R-C6-" 4 X) '(==cns11643-7 "R-C7-" 4 X) '(=hanziku-1 "HZK01-" 4 X) '(=hanziku-2 "HZK02-" 4 X) '(=hanziku-3 "HZK03-" 4 X) '(=hanziku-4 "HZK04-" 4 X) '(=hanziku-5 "HZK05-" 4 X) '(=hanziku-6 "HZK06-" 4 X) '(=hanziku-7 "HZK07-" 4 X) '(=hanziku-8 "HZK08-" 4 X) '(=hanziku-9 "HZK09-" 4 X) '(=hanziku-10 "HZK10-" 4 X) '(=hanziku-11 "HZK11-" 4 X) '(=hanziku-12 "HZK12-" 4 X) '(==>daijiten "A2-DJT-" 5 d) '(==cbeta "CB" 5 d) '(=big5 "B-" 4 X) '(=daikanwa "M-" 5 d) '(=>>daikanwa "G-M-" 5 d) '(===ucs@ks "R-KU+" 4 X) coded-charset-entity-reference-alist))) (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er) (goto-char (point-min)) (while (re-search-forward "&\\(A-\\|G-\\|g2-\\|R-\\)?CB\\([0-9]+\\);" nil t) (setq code (string-to-int (match-string 2))) (replace-match (format "\"CB%05d\"" code chise-wiki-legacy-bitmap-glyphs-url (/ code 1000) code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?J\\(78\\|83\\|90\\|97\\|SP\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t) (setq plane (match-string 2) code (string-to-int (match-string 3) 16)) (replace-match (format "\"J%s-%04X\"" plane code chise-wiki-legacy-bitmap-glyphs-url plane (- (lsh code -8) 32) (- (logand code 255) 32) www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?J0-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t) (setq code (string-to-int (match-string 2) 16)) (replace-match (format "\"J0-%04X\"" code chise-wiki-legacy-bitmap-glyphs-url (- (lsh code -8) 32) (- (logand code 255) 32) www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-\\(JA\\|JB\\|JC\\|JD\\|FT\\|IA\\|IB\\|HG\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t) (setq plane (match-string 2) code (string-to-int (match-string 3) 16)) (replace-match (format "\"HD-%s-%04X\"" plane code chise-wiki-legacy-bitmap-glyphs-url plane (- (lsh code -8) 32) (- (logand code 255) 32) www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-\\(IP\\|JT\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t) (setq plane (match-string 2) code (string-to-int (match-string 3) 16)) (replace-match (format "\"HD-%s-%04X\"" plane code chise-wiki-legacy-bitmap-glyphs-url plane code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-KS-\\([0-9]+\\);" nil t) (setq code (string-to-int (match-string 2))) (replace-match (format "\"HD-KS%06d\"" code chise-wiki-legacy-bitmap-glyphs-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-TK-\\([0-9]+\\);" nil t) (setq code (string-to-int (match-string 2))) (replace-match (format "\"HD-KS%06d\"" code chise-wiki-legacy-bitmap-glyphs-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&G\\([01]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t) (setq plane (string-to-int (match-string 1)) code (string-to-int (match-string 2) 16)) (replace-match (format "\"GB%d-%04X\"" plane code chise-wiki-legacy-bitmap-glyphs-url plane (- (lsh code -8) 32) (- (logand code 255) 32) www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(R-\\)?C\\([1-7]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t) (setq plane (string-to-int (match-string 2)) code (string-to-int (match-string 3) 16)) (replace-match (format "\"CNS%d-%04X\"" plane code chise-wiki-legacy-bitmap-glyphs-url plane code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(R-\\)?JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t) (setq code (string-to-int (match-string 2) 16)) (replace-match (format "\"JC3-%04X\"" code chise-wiki-bitmap-glyph-image-url code) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(A-\\)?ZOB-\\([0-9]+\\);" nil t) (setq code (string-to-int (match-string 2))) (replace-match (format "\"ZOB-%04d\"" code chise-wiki-legacy-bitmap-glyphs-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(A2-\\|g2-\\|R-\\)?DJT-\\([0-9]+\\);" nil t) (setq code (string-to-int (match-string 2))) (replace-match (format "\"DJT-%05d\"" code chise-wiki-daijiten-bitmap-glyphs-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&SW-JIGUGE\\([45]?\\)-\\([0-9]+\\);" nil t) (setq subcode (match-string 1) code (string-to-int (match-string 2))) (setq plane (if (string= subcode "") "5" subcode)) (replace-match (format "\"SW-JIGUGE%s-%05d\"" plane code chise-wiki-legacy-bitmap-glyphs-url plane code) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&HNG\\([0-9]+\\)-\\([0-9][0-9][0-9][0-9]\\)\\([0-9]\\);" nil t) (setq plane (match-string 1) code (string-to-int (match-string 2)) subcode (string-to-int (match-string 3))) (setq subcode (if (eq subcode 0) "" (char-to-string (decode-char 'ascii (+ 96 subcode))))) (replace-match (format "\"HNG%s-%04d%s\"" plane code subcode chise-wiki-hng-bitmap-glyphs-url plane code subcode ) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(R-\\)?CHISE-HDIC-TSJ\\([0-9A-F]+\\);" nil t) (setq code (string-to-int (match-string 2) 16)) (setq char (decode-char '===chise-hdic-tsj code)) (when (setq ret (get-char-attribute char '=hdic-tsj-glyph-id)) (replace-match (format "\"HDIC-TSJ-%s\"" ret ret) t 'literal))) (goto-char (point-min)) (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?AJ1-\\([0-9]+\\);" nil t) (setq code (string-to-int (match-string 2))) (replace-match (format "\"AJ1-%05d\"" code chise-wiki-legacy-bitmap-glyphs-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(A-\\|o-\\|G-\\|g2-\\|R-\\)?MJ\\([0-9]+\\);" nil t) (setq code (string-to-int (match-string 2))) (replace-match (format "\"MJ%06d\"" code code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(o-\\|G-\\|g2-\\)?IU[+-]\\([0-9A-F]+\\);" nil t) (setq code (string-to-int (match-string 2) 16)) (replace-match (format "\"u%04x\"" code chise-wiki-glyphwiki-glyph-image-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?KU[+-]\\([0-9A-F]+\\);" nil t) (setq code (string-to-int (match-string 2) 16)) (replace-match (format "\"u%04x-k\"" code chise-wiki-glyphwiki-glyph-image-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&A-\\(comp\\|cgn\\)U[+-]\\([0-9A-F]+\\);" nil t) (setq code (string-to-int (match-string 2) 16)) (replace-match (format "\"u%04x\"" code chise-wiki-glyphwiki-glyph-image-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(A-\\|g2-\\)?U-i\\([0-9]+\\)\\+\\([0-9A-F]+\\);" nil t) (setq plane (string-to-int (match-string 2)) code (string-to-int (match-string 3) 16)) (replace-match (format "\"u%04x-itaiji-%03d\"" code plane chise-wiki-glyphwiki-glyph-image-url code plane www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&A-IWDSU\\+\\([0-9A-F]+\\);" nil t) (setq code (string-to-int (match-string 1) 16)) (replace-match (format "\"A-IWDSU+%04x\"" code chise-wiki-glyphwiki-glyph-image-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(A-\\)?CDP-i\\([0-9]+\\)-\\([0-9A-F]+\\);" nil t) (setq plane (string-to-int (match-string 2)) code (string-to-int (match-string 3) 16)) (replace-match (format "\"cdp-%04x-itaiji-%03d\"" code plane chise-wiki-glyphwiki-glyph-image-url code plane www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(A-\\)?CDP-v\\([0-9]+\\)-\\([0-9A-F]+\\);" nil t) (setq plane (string-to-int (match-string 2)) code (string-to-int (match-string 3) 16)) (replace-match (format "\"cdp-%04x-var-%03d\"" code plane chise-wiki-glyphwiki-glyph-image-url code plane www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(A-\\|G-\\|g2-\\|R-\\)?M-\\([0-9]+\\);" nil t) (setq code (string-to-int (match-string 2))) (replace-match (format "\"dkw-%05d\"" code chise-wiki-glyphwiki-glyph-image-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(g2-\\)?U-v\\([0-9]+\\)\\+\\([0-9A-F]+\\);" nil t) (setq plane (string-to-int (match-string 2)) code (string-to-int (match-string 3) 16)) (replace-match (format "\"u%04x-var-%03d\"" code plane chise-wiki-glyphwiki-glyph-image-url code plane www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(A-\\|G-\\|R-\\|g2-\\)?GT-\\([0-9]+\\);" nil t) (setq code (string-to-int (match-string 2))) (replace-match (format "\"GT-%05d\"" code chise-wiki-glyph-cgi-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(A-\\|G-\\|g2-\\)?GT-K\\([0-9]+\\);" nil t) (setq code (string-to-int (match-string 2))) (replace-match (format "\"GT-K%05d\"" code chise-wiki-glyph-cgi-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&B-\\([0-9A-F]+\\);" nil t) (setq code (string-to-int (match-string 1) 16)) (replace-match (format "\"B-%04X\"" code chise-wiki-glyph-cgi-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(A-\\|G-\\|g2-\\|R-\\)?CDP-\\([0-9A-F]+\\);" nil t) (setq code (string-to-int (match-string 2) 16)) (replace-match (format "\"CDP-%04X\"" code chise-wiki-glyph-cgi-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(I-\\)?HZK\\(0[1-9]\\|1[0-2]\\)-\\([0-9A-F]+\\);" nil t) (setq plane (match-string 2) code (string-to-int (match-string 3) 16)) (replace-match (format "\"HZK%s-%04X\"" plane code chise-wiki-glyph-cgi-url plane code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(A-\\|G-\\|g2-\\|R-\\)?RUI6-\\([0-9A-F]+\\);" nil t) (setq code (string-to-int (match-string 2) 16)) (replace-match (format "\"RUI6-%04X\"" code chise-wiki-glyph-cgi-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&hanaJU\\+\\([0-9A-F]+\\);" nil t) (setq code (string-to-int (match-string 1) 16)) (replace-match (format "\"hanaJU+%04X\"" code chise-wiki-glyph-cgi-url code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&\\(A-\\|G-\\|g2-\\|R-\\)?\\(UU\\+\\|U-\\)\\([0-9A-F]+\\);" nil t) (setq code (string-to-int (match-string 3) 16)) (replace-match (format "\"UU+%04X\"" code code www-format-char-img-style) t 'literal)) (goto-char (point-min)) (while (re-search-forward "&MCS-\\([0-9A-F]+\\);" nil t) (setq code (string-to-int (match-string 1) 16)) (setq start (match-beginning 0) end (match-end 0)) (setq char (decode-char 'system-char-id code)) (cond ((and (setq variants (or (www-get-feature-value char '->subsumptive) (www-get-feature-value char '->denotational))) (progn (if (characterp variants) (setq variants (list variants))) (while (and variants (setq ret (www-format-encode-string (char-to-string (car variants)))) (string-match "&MCS-\\([0-9A-F]+\\);" ret)) (setq variants (cdr variants))) ret)) (unless (string-match "&MCS-\\([0-9A-F]+\\);" ret) (goto-char start) (delete-region start end) (insert ret)) ) ((setq ret (or (www-get-feature-value char 'ideographic-combination) (www-get-feature-value char 'ideographic-structure))) (setq ret (mapconcat (lambda (ch) (if (listp ch) (if (characterp (setq rret (find-char ch))) (setq ch rret))) (if (characterp ch) (www-format-encode-string (char-to-string ch) without-tags) (www-format-encode-string (format "%S" ch) without-tags))) ret "")) (when ret (goto-char start) (delete-region start end) (insert ret)) ))) )) ;; (goto-char (point-min)) ;; (while (search-forward ">-" nil t) ;; (replace-match "&GT-" t 'literal)) (buffer-string)))) (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.2") (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 "\"CB%05d\"\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 "\"JC3-%04X\"\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 "\"J%s-%04X\"\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 "\"G%d-%04X\"\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 "\"C%d-%04X\"\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 "\"ZOB-%04d\"\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 "\n") ) ignored-chars) (defun www-ids-insert-chars-including-components (components &optional ignored-chars) (let ((products (ideograph-find-products components ignored-chars)) is as bs len ignore-children) (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)) (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 "
  • ") (www-ids-find-format-line vc is) (setq ignored-chars (www-ids-insert-chars-including-components* (char-to-string vc) (cons vc ignored-chars))))))) (setq products (ideograph-find-products-with-variants components ignored-chars)) (setq len (length products)) (when (>= len 512) (setq ignore-children t) (princ (encode-coding-string "

    結果が多すぎるため、関連字の再帰的検索を省略しました。

    " '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 "
  • ") (www-ids-find-format-line c is) (unless ignore-children (setq ignored-chars (www-ids-insert-chars-including-components* (char-to-string c) (cons c ignored-chars)))) )) )) ) ignored-chars) (defun www-batch-ids-find () (let ((components (car command-line-args-left)) (coded-charset-entity-reference-alist (list* '(=cns11643-1 "C1-" 4 X) '(=cns11643-2 "C2-" 4 X) '(=cns11643-3 "C3-" 4 X) '(=cns11643-4 "C4-" 4 X) '(=cns11643-5 "C5-" 4 X) '(=cns11643-6 "C6-" 4 X) '(=cns11643-7 "C7-" 4 X) '(=gb2312 "G0-" 4 X) '(=gb12345 "G1-" 4 X) '(=jis-x0208@1990 "J90-" 4 X) '(=jis-x0212 "JSP-" 4 X) '(=cbeta "CB" 5 d) '(=jef-china3 "JC3-" 4 X) '(=jis-x0208@1978 "J78-" 4 X) '(=jis-x0208@1983 "J83-" 4 X) '(=daikanwa "M-" 5 d) coded-charset-entity-reference-alist)) ) (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-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 "

    ") (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 "

    ") (princ (encode-coding-string "部品文字列" 'utf-8-jp-er)) (princ "
    (length components) 0) (princ (encode-coding-string components 'utf-8-er))) (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 "

    現在、システムの更新作業中です。しばらくお待ちください。


    " 'utf-8-jp-er)) ;; (setq components nil) ) (cond (components (princ "
    ") ;; (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) (char-feature (aref components 0) 'ideographic-structure))) ;; (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))) ;; (princ "\n") (princ "
    \n") ) (t (princ (encode-coding-string "

    指定した部品を全て含む漢字の一覧を表示します。

    CHISE で用いられる実態参照形式(例:&M-00256;)で部品を指定する事もできます。

    " 'utf-8-jp-er)) (princ (encode-coding-string "

    \[Links\]

    " 'utf-8-jp-er)) )) (princ "
    ") (princ "
    Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2015, 2016, 2017, 2020 MORIOKA Tomohiko
    ") (princ (format "
    Powered by XEmacs CHISE %s.
    " (encode-coding-string xemacs-chise-version 'utf-8-jp-er))) (princ "
    ")))