X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=www%2Fwww-ids-find.el;h=f3d0c1d2c3885c1c3e0e58d0e14ab397cf418467;hb=f983faf32cf54de4913a8469a3294863be1cafe4;hp=46885107a27d0b4a47dfd9585b10754a4598a2a8;hpb=8f98c17963abd1f83849e90f454630c0f0f8414e;p=chise%2Fids.git diff --git a/www/www-ids-find.el b/www/www-ids-find.el index 4688510..f3d0c1d 100644 --- a/www/www-ids-find.el +++ b/www/www-ids-find.el @@ -15,7 +15,7 @@ (concat dest (substring string i)) coding-system)))) -(defconst www-ids-find-version "0.22.1") +(defconst www-ids-find-version "0.24.2") (defvar www-ids-find-ideographic-products-file-name (expand-file-name "ideographic-products" @@ -25,72 +25,81 @@ "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) +(defun www-ids-find-format-char (c &optional code-desc) (let ((str (encode-coding-string (format "%c" c) 'utf-8-er)) - plane code ucs) + plane code) (princ (with-temp-buffer (cond ((string-match "&CB\\([0-9]+\\);" str) (setq code (string-to-int (match-string 1 str))) - (insert "\"CB%05d\"\n" + (insert (format "\">\"CB%05d\"\n" code (/ code 1000) code)) - (insert (format "CB%05d" 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 "\"JC3-%04X\"\n" code code)) - (insert (format "JC3-%04X" 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 "\"J%s-%04X\"\n" + (insert (format "\">\"J%s-%04X\"\n" plane code plane (- (lsh code -8) 32) (- (logand code 255) 32))) - (insert (format "J%s-%04X" plane code)) + (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 "\"G%d-%04X\"\n" + (insert (format "\">\"G%d-%04X\"\n" plane code plane (- (lsh code -8) 32) (- (logand code 255) 32))) - (insert (format "G%d-%04X" plane code)) + (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 "\"C%d-%04X\"\n" + (insert (format "\">\"C%d-%04X\"\n" plane code plane code)) - (insert (format "C%d-%04X" 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 "\"ZOB-%04d\"\n" + (insert (format "\">\"ZOB-%04d\"\n" code code)) - (insert (format "ZOB-%04d" code)) + (when code-desc + (insert (format "ZOB-%04d" code))) ) (t - (insert "%s" - ucs - (cond ((<= ucs #xFFFF) - (format "U+%04X" ucs)) - ((<= ucs #x10FFFF) - (format "U-%08X" 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)))) + (setq ids (ideographic-structure-to-ids is)) + (setq i 0 + len (length ids)) + (while (< i len) + (www-ids-find-format-char (aref ids i)) + (setq i (1+ i)))) (when (and ucs (with-current-buffer (find-file-noselect @@ -150,21 +159,56 @@ (princ (encode-coding-string "⇒[唐代拓本]" 'utf-8-jp-er))) (princ "
\n"))) -(defun www-ids-insert-chars-including-components (components) - (let (is) - (dolist (c (ideographic-products-find components)) - (setq is (char-feature c 'ideographic-structure)) - ;; to avoid problems caused by wrong indexes - (when (every (lambda (cc) - (ideographic-structure-member cc is)) - components) +(defun www-ids-insert-chars-including-components (components + &optional ignored-chars) + (let ((products (copy-list (ideographic-products-find components))) + is as bs len ignore-children) + (setq len (length products)) + (dolist (c (cond + ((> len 8192) + (setq ignore-children t) + products) + ((> len 4096) + (sort products + (lambda (a b) + (< (char-int a)(char-int b)))) + ) + ((> len 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") + (unless ignore-children + (princ "\n")) ) - ))) + )) + ignored-chars) (defun www-batch-ids-find () (let ((components (car command-line-args-left)) @@ -195,7 +239,7 @@ (setq components (substring components (match-end 0)))) (setq components (if (> (length components) 0) - (decode-url-string components 'utf-8-jp-er) + (decode-url-string components 'utf-8-er) nil)) ) (t @@ -224,17 +268,14 @@ (file-attributes www-ids-find-ideographic-products-file-name)))) (princ " -

    -Copyright (C) 2005 MORIOKA Tomohiko

    -

    + ") (princ (encode-coding-string "部品文字列" 'utf-8-jp-er)) (princ " (length components) 0) - (princ (encode-coding-string components 'utf-8-jp-er))) + (princ (encode-coding-string components 'utf-8-er))) (princ "\"> 睡人亭）による解説 >www-ids-find.el (source file (Emacs Lisp part))
  • 「CHISE 漢字構造情報データベース」 +
  • 「chise_linkmap : CHISE 漢字連環図」 by 上地宏一さん
  • CHISE Project @@ -320,9 +363,12 @@ href=\"http://www.shuiren.org/\">睡人亭）による解説 )) (princ "
    ") + (princ "

    +Copyright (C) 2005, 2006, 2007, 2008, 2009 MORIOKA Tomohiko") (princ (format - "Powered by Powered by XEmacs CHISE %s." xemacs-chise-version))