projects / chise / ids.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
New file.
[chise/ids.git] / www / www-ids-find.el
diff --git a/www/www-ids-find.el b/www/www-ids-find.el
index 28098fc..8c5b29a 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.24.1")
+(defconst www-ids-find-version "0.25.0")
 
 (defvar www-ids-find-ideographic-products-file-name
   (expand-file-name "ideographic-products"
@@ -26,7 +26,7 @@
                      chise-system-db-directory))))
 
 (defvar www-ids-find-chise-link-map-url-prefix
-  "http://kamichi.jp/chise_linkmap/map.cgi?code=")
+  "http://fonts.jp/chise_linkmap/map.cgi?code=")
 
 (defvar www-ids-find-tang-chars-file-name
   "~tomo/projects/chise/ids/www/tang-chars.udd")
@@ -39,16 +39,16 @@
        (cond
        ((string-match "&CB\\([0-9]+\\);" str)
         (setq code (string-to-int (match-string 1 str)))
-        (insert "<a href=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/char-desc?char=")
+        (insert "<a href=\"/char-desc?char=")
         (insert str)
-        (insert (format "\"><img alt=\"CB%05d\" src=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/glyphs/cb-gaiji/%02d/CB%05d.gif\">\n"
+        (insert (format "\"><img alt=\"CB%05d\" src=\"/glyphs/cb-gaiji/%02d/CB%05d.gif\">\n"
                         code (/ code 1000) code))
         (when code-desc
           (insert (format "CB%05d</a>" code)))
         )
        ((string-match "&JC3-\\([0-9A-F]+\\);" str)
         (setq code (string-to-int (match-string 1 str) 16))
-        (insert "<a href=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/char-desc?char=")
+        (insert "<a href=\"/char-desc?char=")
         (insert str)
         (insert (format "\"><img alt=\"JC3-%04X\" src=\"http://kanji.zinbun.kyoto-u.ac.jp/db/CHINA3/Gaiji/%04x.gif\">\n"
                         code code))
@@ -58,9 +58,9 @@
        ((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 "<a href=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/char-desc?char=")
+        (insert "<a href=\"/char-desc?char=")
         (insert str)
-        (insert (format "\"><img alt=\"J%s-%04X\" src=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/glyphs/JIS-%s/%02d-%02d.gif\">\n"
+        (insert (format "\"><img alt=\"J%s-%04X\" src=\"/glyphs/JIS-%s/%02d-%02d.gif\">\n"
                         plane code plane
                         (- (lsh code -8) 32)
                         (- (logand code 255) 32)))
@@ -70,9 +70,9 @@
        ((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 "<a href=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/char-desc?char=")
+        (insert "<a href=\"/char-desc?char=")
         (insert str)
-        (insert (format "\"><img alt=\"G%d-%04X\" src=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/glyphs/GB%d/%02d-%02d.gif\">\n"
+        (insert (format "\"><img alt=\"G%d-%04X\" src=\"/glyphs/GB%d/%02d-%02d.gif\">\n"
                         plane code plane
                         (- (lsh code -8) 32)
                         (- (logand code 255) 32)))
@@ -82,24 +82,24 @@
        ((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 "<a href=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/char-desc?char=")
+        (insert "<a href=\"/char-desc?char=")
         (insert str)
-        (insert (format "\"><img alt=\"C%d-%04X\" src=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/glyphs/CNS%d/%04X.gif\">\n"
+        (insert (format "\"><img alt=\"C%d-%04X\" src=\"/glyphs/CNS%d/%04X.gif\">\n"
                         plane code plane code))
         (when code-desc
           (insert (format "C%d-%04X</a>" plane code)))
         )
        ((string-match "&ZOB-\\([0-9]+\\);" str)
         (setq code (string-to-int (match-string 1 str)))
-        (insert "<a href=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/char-desc?char=")
+        (insert "<a href=\"/char-desc?char=")
         (insert str)
-        (insert (format "\"><img alt=\"ZOB-%04d\" src=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/glyphs/ZOB-1968/%04d.png\">\n"
+        (insert (format "\"><img alt=\"ZOB-%04d\" src=\"/glyphs/ZOB-1968/%04d.png\">\n"
                         code code))
         (when code-desc
           (insert (format "ZOB-%04d</a>" code)))
         )
        (t
-        (insert "<a href=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/char-desc?char=")
+        (insert "<a href=\"/char-desc?char=")
          ;; (insert str)
         (insert
          (mapconcat (lambda (c)
@@ -161,49 +161,66 @@
 
 (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")
-       (setq ignored-chars
-             (www-ids-insert-chars-including-components
-              (char-to-string c)
-              (cons c ignored-chars)))
-       (princ "</ul>\n")
+  (let ((products (ideographic-products-find components))
+       is as bs len ignore-children)
+    (setq len (length products))
+    (when (>= len 1024)
+      (setq ignore-children t)
+      (princ
+       (encode-coding-string
+       "<p>\e$B7k2L$,B?$9$.$k$?$a!":F5"E*8!:w$r>JN,$7$^$7$?!#\e(B</p>"
+       'utf-8-jp-er)))
+    (if (>= len 2048)
+       (dolist (c products)
+         (www-ids-find-format-char c))
+      (princ "<ul>\n")
+      (dolist (c (cond
+                  ;; ((>= len 2048)
+                  ;;  (setq ignore-children t)
+                  ;;  products)
+                  ;; ((>= len 1024)
+                  ;;  products)
+                 ((>= len 1024)
+                  (sort (copy-list products)
+                        (lambda (a b)
+                          (< (char-int a)(char-int b))))
+                  )
+                 ((>= len 512)
+                  (sort (copy-list 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 (copy-list 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)
+         (unless ignore-children
+            ;; (princ "<ul>\n")
+           (setq ignored-chars
+                 (www-ids-insert-chars-including-components
+                  (char-to-string c)
+                  (cons c ignored-chars)))
+            ;; (princ "</ul>\n")
+           ))
        )
+      (princ "</ul>\n")
       ))
   ignored-chars)
 
@@ -267,7 +284,7 @@
     (princ "
 <hr>
 <p>
-<form action=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/ids-find\" method=\"GET\">
+<form action=\"/ids-find\" method=\"GET\">
 ")
     (princ (encode-coding-string "\e$BItIJJ8;zNs\e(B" 'utf-8-jp-er))
     (princ " <input type=\"text\" name=\"components\" size=\"30\" maxlength=\"30\" value=\"")
@@ -315,9 +332,9 @@
       ;;                  (ideographic-structure-member c is))
       ;;                components)
       ;;     (www-ids-find-format-line c is)))
-      (princ "<ul>\n")
+      ;; (princ "<ul>\n")
       (www-ids-insert-chars-including-components components)
-      (princ "</ul>\n")
+      ;; (princ "</ul>\n")
       )
      (t
       (princ (encode-coding-string "<hr>
@@ -341,11 +358,11 @@ href=\"http://www.shuiren.org/\">\e$B?g?MDb\e(B</a>\e$B!K$K$h$k2r@b\e(B
 <ul>
 <li><a href=\"http://cvs.m17n.org/viewcvs/chise/ids/www/www-ids-find.el?view=markup\"
 >www-ids-find.el (source file (Emacs Lisp part))
-<li><a href=\"http://kanji.zinbun.kyoto-u.ac.jp/projects/chise/ids/\"
+<li><a href=\"http://chise.zinbun.kyoto-u.ac.jp/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/\"
+<li><a href=\"http://chise.zinbun.kyoto-u.ac.jp/chise/\"
 >CHISE Project</a>
 </ul>
 <ul>
@@ -361,14 +378,14 @@ href=\"http://www.shuiren.org/\">\e$B?g?MDb\e(B</a>\e$B!K$K$h$k2r@b\e(B
       ))
     (princ "<hr>")
     (princ "<p>
-Copyright (C) 2005, 2006, 2007, 2008 <a href=\"http://kanji.zinbun.kyoto-u.ac.jp/~tomo/\"
+Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 <a href=\"http://kanji.zinbun.kyoto-u.ac.jp/~tomo/\"
 >MORIOKA Tomohiko</a>")
     (princ
      (format
       "<p>Powered by <a
-href=\"http://kanji.zinbun.kyoto-u.ac.jp/projects/chise/xemacs/\"
+href=\"http://chise.zinbun.kyoto-u.ac.jp/chise/xemacs/\"
 >XEmacs CHISE</a> %s."
-      xemacs-chise-version))
+      (encode-coding-string xemacs-chise-version 'utf-8-jp-er)))
     (princ "
 </body>
 </html>