X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=www%2Fwww-ids-find.el;h=1286bd5b2f72e361a4a89b33a45cca5744423c01;hb=754ed7b6d0e4479591ae7aa0d9bde2feb05b1b77;hp=68efbd6b0f379c5bc15e6e17cdf6bd0255aa388a;hpb=6e500584f86577d37d4a0f3eeefcad8fa4db297a;p=chise%2Fids.git diff --git a/www/www-ids-find.el b/www/www-ids-find.el index 68efbd6..1286bd5 100644 --- a/www/www-ids-find.el +++ b/www/www-ids-find.el @@ -15,17 +15,219 @@ (concat dest (substring string i)) coding-system)))) +(defconst www-ids-find-version "0.23.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-chise-link-map-url-prefix + "http://kamichi.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-line (c is) + (let ((str (encode-coding-string (format "%c" c) 'utf-8-er)) + plane code ucs) + (princ + (with-temp-buffer + (cond + ((string-match "&CB\\([0-9]+\\);" str) + (setq code (string-to-int (match-string 1 str))) + (insert "\"CB%05d\"\n" + code (/ code 1000) code)) + (insert (format "CB%05d" code)) + ) + ((string-match "&JC3-\\([0-9A-F]+\\);" str) + (setq code (string-to-int (match-string 1 str) 16)) + (insert "\"JC3-%04X\"\n" + code code)) + (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 "\"J%s-%04X\"\n" + plane code plane + (- (lsh code -8) 32) + (- (logand code 255) 32))) + (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 "\"G%d-%04X\"\n" + plane code plane + (- (lsh code -8) 32) + (- (logand code 255) 32))) + (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 "\"C%d-%04X\"\n" + plane code plane code)) + (insert (format "C%d-%04X" plane code)) + ) + ((string-match "&ZOB-\\([0-9]+\\);" str) + (setq code (string-to-int (match-string 1 str))) + (insert "\"ZOB-%04d\"\n" + code code)) + (insert (format "ZOB-%04d" code)) + ) + (t + (insert "") + (insert str) + (insert "") + )) + (goto-char (point-min)) + (while (search-forward "&" nil t) + (replace-match "&" t 'literal)) + (buffer-string) + )) + (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 + (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 "\"CB%05d\"" + 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-ids-insert-chars-including-components (components + &optional ignored-chars) + (let ((products (copy-list (ideographic-products-find components))) + is as bs) + (dolist (c (cond + ((> (length products) 10000) + products) + ((> (length products) 4096) + (sort products + (lambda (a b) + (< (char-int a)(char-int b)))) + ) + ((> (length products) 512) + (sort products + (lambda (a b) + (if (setq as (char-total-strokes a)) + (if (setq bs (char-total-strokes b)) + (if (= as bs) + (< (char-int a)(char-int b)) + (< as bs)) + t) + (< (char-int a)(char-int b))))) + ) + (t + (sort 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 (char-feature c 'ideographic-structure)) + (princ "
  • ") + (www-ids-find-format-line c is) + (princ "\n") + ) + )) + ignored-chars) + (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)) + '(=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)) - is ucs str code) + ) (setq command-line-args-left (cdr command-line-args-left)) (cond ((stringp components) @@ -39,7 +241,7 @@ (t (setq components nil) )) - (princ "Content-Type: text/html; charset=\"UTF-8\" + (princ "Content-Type: text/html; charset=UTF-8 @@ -52,14 +254,27 @@

    ") (princ (encode-coding-string "CHISE IDS 漢字検索" 'utf-8-jp-er)) - (princ "

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

    +Copyright (C) 2005, 2006 MORIOKA Tomohiko +

    ") (princ (encode-coding-string "部品文字列" 'utf-8-jp-er)) (princ " (length components) 0) - (princ (encode-coding-string components 'utf-8-er))) + (princ (encode-coding-string components 'utf-8-jp-er))) (princ "\"> ") - (when components + (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 ;; (map-char-attribute ;; (lambda (c v) ;; (when (every (lambda (p) @@ -80,66 +306,68 @@ ;; ) ;; nil) ;; '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) - (setq str - (encode-coding-string (format "%c" c) 'utf-8-jp-er)) - (cond - ((string-match "&CB\\([0-9]+\\);" str) - (setq code (string-to-int (match-string 1 str))) - (princ (format "\"CB%05d\"\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 " ") - (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 "\"CB%05d\"" - 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") - )) + (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") ) + (t + (princ (encode-coding-string "
    +

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

    +CHISE で用いられる実態参照形式（例：&M-00256;）で部品を指定する事もできます。" 'utf-8-jp-er)) + (princ (encode-coding-string " +

    +\[Links\] +

    + + +" + 'utf-8-jp-er)) + + )) + (princ "
    ") + (princ + (format + "Powered by XEmacs CHISE %s." + xemacs-chise-version)) (princ "