Require `ideograph-subr'.
authortomo <tomo>
Mon, 31 May 2010 14:41:30 +0000 (14:41 +0000)
committertomo <tomo>
Mon, 31 May 2010 14:41:30 +0000 (14:41 +0000)
(get-char-feature-from-domains): Moved to ideograph-subr.el.
(char-ideographic-radical): Ditto.

lisp/utf-2000/ideograph-util.el

index 24979a2..095a018 100644 (file)
 ;;; Code:
 
 (require 'chise-subr)
+(require 'ideograph-subr)
 (require 'char-db-util)
 
-(defun get-char-feature-from-domains (char feature domains
-                                          &optional tester arg
-                                          ignore-sisters)
-  (map-char-family
-   (lambda (ch)
-     (let (ret)
-       (catch 'tag
-        (dolist (domain domains)
-          (if (and (or (null tester)
-                       (equal (or (char-feature
-                                   ch (expand-char-feature-name
-                                       tester domain))
-                                  (char-feature ch tester))
-                              arg))
-                   (setq ret (or (char-feature
-                                  ch (expand-char-feature-name
-                                      feature domain))
-                                 (char-feature ch feature))))
-              (throw 'tag ret))))))
-   char ignore-sisters))
-
 
 (defvar ideograph-radical-chars-vector
   (make-vector 215 nil))
 
-(defun char-ideographic-radical (char &optional radical ignore-sisters)
-  (let (ret)
-    (or (if radical
-           (get-char-feature-from-domains
-            char 'ideographic-radical (cons nil char-db-feature-domains)
-            'ideographic-radical radical ignore-sisters)
-         (get-char-feature-from-domains
-          char 'ideographic-radical (cons nil char-db-feature-domains)
-          ignore-sisters))
-        ;; (catch 'tag
-        ;;   (dolist (domain char-db-feature-domains)
-        ;;     (if (and (setq ret (char-feature
-        ;;                         char
-        ;;                         (intern
-        ;;                          (format "%s@%s"
-        ;;                                  'ideographic-radical domain))))
-        ;;              (or (eq ret radical)
-        ;;                  (null radical)))
-        ;;         (throw 'tag ret))))
-       (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 ret))))
-       (get-char-feature-from-domains
-        char 'ideographic-radical (cons nil char-db-feature-domains))
-        ;; (char-feature char 'ideographic-radical)
-       (progn
-         (setq ret
-               (or (get-char-attribute char 'daikanwa-radical)
-                   (get-char-attribute char 'kangxi-radical)
-                   (get-char-attribute char 'japanese-radical)
-                   (get-char-attribute char 'korean-radical)))
-         (when ret
-           (put-char-attribute char 'ideographic-radical ret)
-           ret)))))
-
 (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