Add/modify some IDSs.

[chise/ids.git] / www / www-ids-find.el

diff --git a/www/www-ids-find.el b/www/www-ids-find.el
index 4688510..84c6e9e 100644 (file)
--- 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.22.3")
 
 (defvar www-ids-find-ideographic-products-file-name
   (expand-file-name "ideographic-products"
@@ -110,13 +110,18 @@
     (princ
      (or (if (setq ucs (or (char-ucs c)
                           (encode-char c 'ucs)))
-            (format " <a href=\"http://www.unicode.org/cgi-bin/GetUnihanData.pl?codepoint=%X\">%s</a>"
-                    ucs
-                    (cond ((<= ucs #xFFFF)
-                           (format "U+%04X" ucs))
-                          ((<= ucs #x10FFFF)
-                           (format "U-%08X" ucs))))
+            (format
+             " <a href=\"http://www.unicode.org/cgi-bin/GetUnihanData.pl?codepoint=%X\">%s</a>"
+             ucs
+             (cond ((<= ucs #xFFFF)
+                    (format "U+%04X" ucs))
+                   ((<= ucs #x10FFFF)
+                    (format "U-%08X" ucs))))
           "          ")))
+    (when ucs
+      (princ
+       (format " <a href=\"http://geta.mag.keio.ac.jp/chiseperl/map.cgi?code=%X\">(link map)</a>"
+              ucs)))
     (princ " ")
     (when is
       (princ
@@ -150,21 +155,53 @@
       (princ (encode-coding-string "\e$B"M\e(B[\e$BEbBeBsK\\e(B]</a>" 'utf-8-jp-er)))
     (princ "<br>\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) 
+    (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 "<li>")
        (www-ids-find-format-line c is)
        (princ "<ul>\n")
-       (www-ids-insert-chars-including-components (char-to-string c))
+       (setq ignored-chars
+             (www-ids-insert-chars-including-components
+              (char-to-string c)
+              (cons c ignored-chars)))
        (princ "</ul>\n")
        )
-      )))
+      ))
+  ignored-chars)
 
 (defun www-batch-ids-find ()
   (let ((components (car command-line-args-left))
@@ -305,6 +342,8 @@ href=\"http://www.shuiren.org/\">\e$B?g?MDb\e(B</a>\e$B!K$K$h$k2r@b\e(B
 >www-ids-find.el (source file (Emacs Lisp part))
 <li><a href=\"http://kanji.zinbun.kyoto-u.ac.jp/projects/chise/ids/\"
 >\e$B!V\e(BCHISE \e$B4A;z9=B$>pJs%G!<%?%Y!<%9!W\e(B</a>
+<li><a href=\"http://fonts.jp/chise_linkmap/\"
+>\e$B!V\e(Bchise_linkmap : CHISE \e$B4A;zO"4D?^!W\e(B</a> by \e$B>eCO9(0l$5$s\e(B
 <li><a href=\"http://kanji.zinbun.kyoto-u.ac.jp/projects/chise/\"
 >CHISE Project</a>
 </ul>