(GT-39643): Unify <CJK RADICAL GRASS TWO> instead of U+FA5E; add

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

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index 5c3aac5..20bd5c4 100644 (file)
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -220,7 +220,7 @@
                                      required-features)
   (unless column
     (setq column (current-column)))
-  (let (char-spec al cal key temp-char)
+  (let (char-spec temp-char)
     (setq char-spec (char-db-make-char-spec char))
     (unless (or (characterp char) ; char
                (condition-case nil
@@ -232,40 +232,10 @@
                                         char-spec)))
       (remove-char-attribute temp-char 'ideograph-daikanwa)
       (setq char temp-char))
-    ;; (setq al nil
-    ;;       cal nil)
-    ;; (while char-spec
-    ;;   (setq key (car (car char-spec)))
-    ;;   (unless (memq key char-db-ignored-attributes)
-    ;;     (if (find-charset key)
-    ;;         (if (encode-char char key 'defined-only)
-    ;;             (setq cal (cons key cal)))
-    ;;       (setq al (cons key al))))
-    ;;   (setq char-spec (cdr char-spec)))
-    ;; (unless cal
-    ;;   (setq char-spec (char-db-make-char-spec char))
-    ;;   (while char-spec
-    ;;     (setq key (car (car char-spec)))
-    ;;     (unless (memq key char-db-ignored-attributes)
-    ;;       (if (find-charset key)
-    ;;           (setq cal (cons key cal))
-    ;;         (setq al (cons key al))))
-    ;;     (setq char-spec (cdr char-spec)))
-    ;;   )
-    ;; (unless (or cal
-    ;;             (memq 'ideographic-structure al))
-    ;;   (push 'ideographic-structure al))
-    ;; (dolist (feature required-features)
-    ;;   (if (find-charset feature)
-    ;;       (if (encode-char char feature 'defined-only)
-    ;;           (setq cal (adjoin feature cal)))
-    ;;     (setq al (adjoin feature al))))
     (insert-char-attributes char
                            readable
-                            ;; (or al 'none) cal
-                           (union (mapcar #'car char-spec)
-                                  required-features)
-                           )
+                            (union (mapcar #'car char-spec)
+                                  required-features))
     (when temp-char
       ;; undefine temporary character
       ;;   Current implementation is dirty.
@@ -294,7 +264,8 @@
                             (error nil)))
                 (progn
                   (setq al nil
-                        cal nil)
+                        ;; cal nil
+                        )
                   (while value
                     (setq key (car (car value)))
                      ;; (if (find-charset key)
@@ -323,7 +294,8 @@
                   (progn
                     (setq rest cell
                           al nil
-                          cal nil)
+                          ;; cal nil
+                          )
                     (while rest
                       (setq key (car (car rest)))
                        ;; (if (find-charset key)
@@ -475,6 +447,14 @@
                      line-breaking))
       (setq attributes (delq 'script attributes))
       )
+    ;; (when (and (memq '<-denotational attributes)
+    ;;            (setq value (get-char-attribute char '<-denotational))
+    ;;            (null (cdr value))
+    ;;            (setq value (encode-char (car value) 'ucs 'defined-only)))
+    ;;   (insert (format "(%-18s . #x%04X)\t; %c%s"
+    ;;                   '=>ucs value (decode-char 'ucs value)
+    ;;                   line-breaking))
+    ;;   (setq attributes (delq '<-denotational attributes)))
     (dolist (name '(=>ucs =>ucs*))
       (when (and (memq name attributes)
                 (setq value (get-char-attribute char name)))
@@ -856,7 +836,8 @@
       )
     (unless readable
       (dolist (ignored '(composition
-                        ->denotational <-subsumptive ->ucs-unified))
+                        ->denotational <-subsumptive ->ucs-unified
+                        ->ideographic-component-forms))
        (setq attributes (delq ignored attributes))))
     ;; (setq rest ccs-attributes)
     ;; (while (and rest
@@ -924,7 +905,8 @@
                                 line-breaking))
                 )
                ((and (not readable)
-                     (string-match "^->simplified" (symbol-name name)))
+                     (or (eq name '<-identical)
+                         (string-match "^->simplified" (symbol-name name))))
                 )
                ((or (eq name 'ideographic-structure)
                     (eq name 'ideographic-)