(M-28841): Copied from Ideograph-R040-Roof.el.

[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 e176fd9..a5c9702 100644 (file)
--- a/lisp/utf-2000/ideograph-util.el
+++ b/lisp/utf-2000/ideograph-util.el
@@ -32,6 +32,16 @@
 (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)
@@ -75,16 +85,42 @@
    11 12 12 12 12 13 13 13 13 14
    14 15 16 16 17])
 
-(defun char-ideographic-strokes (char &optional radical)
+;;;###autoload
+(defun char-ideographic-strokes-from-domains (char domains &optional radical)
   (let (ret)
-    (or (catch 'tag
+    (catch 'tag
+      (dolist (domain 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))))))
+
+;;;###autoload
+(defun char-ideographic-strokes (char &optional radical preferred-domains)
+  (let (ret)
+    (or (char-ideographic-strokes-from-domains
+        char preferred-domains radical)
+       (get-char-attribute char 'ideographic-strokes)
+       (char-ideographic-strokes-from-domains
+        char char-db-feature-domains radical)
+       (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)))))
        (get-char-attribute char 'daikanwa-strokes)
-       (get-char-attribute char 'ideographic-strokes)
        (let ((strokes
               (or (get-char-attribute char 'kangxi-strokes)
                   (get-char-attribute char 'japanese-strokes)
@@ -99,9 +135,41 @@
            strokes)))))
 
 ;;;###autoload
+(defun char-total-strokes-from-domains (char domains)
+  (let (ret)
+    (catch 'tag
+      (dolist (domain domains)
+       (if (setq ret (get-char-attribute
+                      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)
+      (get-char-attribute char 'total-strokes)
+      (char-total-strokes-from-domains char char-db-feature-domains)))
+
+;;;###autoload
 (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
@@ -169,7 +237,8 @@
 
 ;;;###autoload
 (defun char-representative-of-daikanwa (char)
-  (if (get-char-attribute char 'ideograph-daikanwa)
+  (if (or (encode-char char 'ideograph-daikanwa 'defined-only)
+         (encode-char char '=daikanwa-rev2 'defined-only))
       char
     (let ((m (get-char-attribute char 'morohashi-daikanwa))
          m-m m-s pat)
@@ -177,7 +246,8 @@
            (setq m-m (pop m))
            (setq m-s (pop m))
            (if (= m-s 0)
-               (decode-char 'ideograph-daikanwa m-m)
+               (or (decode-char '=daikanwa-rev2 m-m 'defined-only)
+                   (decode-char 'ideograph-daikanwa m-m))
              (when m
                (setq pat (list m-m m-s))
                (map-char-attribute (lambda (c v)
@@ -222,16 +292,15 @@
   (unless radical
     (setq radical ideographic-radical))
   (let ((drc (char-representative-of-daikanwa char)))
-    (char-ideographic-strokes
-     (if (= (char-ideographic-radical drc radical)
-           (char-ideographic-radical char radical))
-        drc
-       char)
-     radical)))
+    (if (= (char-ideographic-radical drc radical)
+          (char-ideographic-radical char radical))
+       (setq char drc)))
+  (char-ideographic-strokes char radical '(daikanwa)))
 
 ;;;###autoload
 (defun char-daikanwa (char)
-  (or (get-char-attribute char 'ideograph-daikanwa)
+  (or (encode-char char 'ideograph-daikanwa 'defined-only)
+      (encode-char char '=daikanwa-rev2 'defined-only)
       (get-char-attribute char 'morohashi-daikanwa)))
 
 ;;;###autoload
@@ -288,8 +357,9 @@
               (format "Ideograph-R%03d-%s.el" radical name)
               file))))
   (with-temp-buffer
+    (insert ";; -*- coding: utf-8-mcs -*-\n")
     (insert-ideograph-radical-char-data radical)
-    (let ((coding-system-for-write 'utf-8))
+    (let ((coding-system-for-write 'utf-8-mcs))
       (write-region (point-min)(point-max) file)
       )))