Add some GT code points.
[chise/xemacs-chise.git.1] / lisp / utf-2000 / ideograph-util.el
index 5c9bccc..c56844a 100644 (file)
 (defun char-ideographic-radical (char &optional radical)
   (let (ret)
     (or (catch 'tag
+         (dolist (domain char-db-feature-domains)
+           (if (and (setq ret (get-char-attribute
+                               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)
 (defun char-ideographic-strokes (char &optional radical)
   (let (ret)
     (or (catch 'tag
+         (dolist (domain char-db-feature-domains)
+           (if (and (setq ret (or (get-char-attribute
+                                   char
+                                   (intern
+                                    (format "%s@%s"
+                                            'ideographic-radical domain)))
+                                  (get-char-attribute
+                                   char 'ideographic-radical)))
+                    (or (eq ret radical)
+                        (null radical))
+                    (setq ret (get-char-attribute
+                               char
+                               (intern
+                                (format "%s@%s"
+                                        'ideographic-strokes domain)))))
+               (throw 'tag ret))))
+       (catch 'tag
          (dolist (cell (get-char-attribute char 'ideographic-))
            (if (and (setq ret (plist-get cell :radical))
                     (or (eq ret radical)
 (defun update-ideograph-radical-table ()
   (interactive)
   (let (ret radical script)
+    (dolist (domain char-db-feature-domains)
+      (map-char-attribute
+       (lambda (char radical)
+        (when (and radical
+                   (or (null (setq script (get-char-attribute char 'script)))
+                       (memq 'Ideograph script)))
+          (unless (memq char
+                        (setq ret
+                              (aref ideograph-radical-chars-vector radical)))
+            (char-ideographic-strokes char)
+            (aset ideograph-radical-chars-vector radical
+                  (cons char ret))))
+        nil)
+       (intern (format "%s@%s" 'ideographic-radical domain))))
     (map-char-attribute
      (lambda (char radical)
        (when (and radical