(CB07416): New character.

[chise/xemacs-chise.git.1] / lisp / utf-2000 / ideograph-util.el

diff --git a/lisp/utf-2000/ideograph-util.el b/lisp/utf-2000/ideograph-util.el
index 095a018..8889ac3 100644 (file)
--- a/lisp/utf-2000/ideograph-util.el
+++ b/lisp/utf-2000/ideograph-util.el
@@ -33,85 +33,6 @@
 (defvar ideograph-radical-chars-vector
   (make-vector 215 nil))
 
-(defvar ideograph-radical-strokes-vector
-  ;;0  1  2  3  4  5  6  7  8  9
-  [nil 1  1  1  1  1  1  2  2  2
-    2  2  2  2  2  2  2  2  2  2
-    2  2  2  2  2  2  2  2  2  2
-    3  3  3  3  3  3  3  3  3  3
-    3  3  3  3  3  3  3  3  3  3
-    3  3  3  3  3  3  3  3  3  3
-    3  4  4  4  3  4  4  4  4  4
-    4  4  4  4  4  4  4  4  4  4
-    4  4  4  4  4  3  4  4  4  4
-    4  4  4  4  3  5  4  5  5  5
-    ;; 100
-    5  5  5  5  5  5  5  5  5  5
-    5  5  5  5  5  5  5  5  6  6
-    6  6  6  6  6  6  6  6  6  6
-    4  6  6  6  6  6  6  6  6  6
-    4  6  6  6  6  6  6  7  7  7
-    7  7  7  7  7  7  7  7  7  7
-    7  7  4  3  7  7  7  8  7  8
-    3  8  8  8  8  8  9  9  9  9
-    9  9  9  9  8  9  9 10 10 10
-   10 10 10 10 10 11 11 11 11 11
-   ;; 200
-   11 12 12 12 12 13 13 13 13 14
-   14 15 16 16 17])
-
-;;;###autoload
-(defun char-ideographic-strokes-from-domains (char domains &optional radical)
-  (if radical
-      (get-char-feature-from-domains char 'ideographic-strokes domains
-                                    'ideographic-radical radical)
-    (get-char-feature-from-domains char 'ideographic-strokes domains)))
-
-;;;###autoload
-(defun char-ideographic-strokes (char &optional radical preferred-domains)
-  (let (ret)
-    (or (catch 'tag
-         (dolist (cell (get-char-attribute char 'ideographic-))
-           (if (and (setq ret (plist-get cell :radical))
-                    (or (eq ret radical)
-                        (null radical)))
-               (throw 'tag (plist-get cell :strokes)))))
-       (char-ideographic-strokes-from-domains
-        char (append preferred-domains
-                     (cons nil
-                           char-db-feature-domains))
-        radical)
-       (get-char-attribute char 'daikanwa-strokes)
-       (let ((strokes
-              (or (get-char-attribute char 'kangxi-strokes)
-                  (get-char-attribute char 'japanese-strokes)
-                  (get-char-attribute char 'korean-strokes)
-                  (let ((r (char-ideographic-radical char))
-                        (ts (get-char-attribute char 'total-strokes)))
-                    (if (and r ts)
-                        (- ts (aref ideograph-radical-strokes-vector r))))
-                  )))
-         (when strokes
-           (put-char-attribute char 'ideographic-strokes strokes)
-           strokes)))))
-
-;;;###autoload
-(defun char-total-strokes-from-domains (char domains)
-  (let (ret)
-    (catch 'tag
-      (dolist (domain domains)
-       (if (setq ret (char-feature
-                      char
-                      (intern
-                       (format "%s@%s"
-                               'total-strokes domain))))
-           (throw 'tag ret))))))
-
-;;;###autoload
-(defun char-total-strokes (char &optional preferred-domains)
-  (or (char-total-strokes-from-domains char preferred-domains)
-      (char-feature char 'total-strokes)
-      (char-total-strokes-from-domains char char-db-feature-domains)))
 
 ;;;###autoload
 (defun update-ideograph-radical-table ()
@@ -193,6 +114,7 @@
                   (cons char ret))))))
      'ideographic-)))
 
+
 (defun int-list< (a b)
   (if (numberp (car a))
       (if (numberp (car b))
@@ -343,8 +265,9 @@
     (setq radical ideographic-radical))
   (let ((drc (char-representative-of-daikanwa char radical))
        (r (char-ideographic-radical char radical)))
-    (if (or (null r)
-           (= (char-ideographic-radical drc radical) r))
+    (if (and drc
+            (or (null r)
+                (= (char-ideographic-radical drc radical) r)))
        (setq char drc)))
   (char-ideographic-strokes char radical '(daikanwa)))
 
@@ -367,8 +290,8 @@
                  ret))
            (and (setq ret (get-char-attribute char '=>daikanwa))
                 (if (numberp ret)
-                    (list ret 0 8)
-                  (append ret '(8))))
+                    (list ret -10)
+                  (append ret '(-10))))
            (unless (memq char checked)
              (unless depth
                (setq depth 0))