X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Futf-2000%2Fchar-db-util.el;h=19d49adc680b615c7ac61bbffb57bea566dceb69;hb=819e9e1d3de9662e04886c31f339124831b3df1a;hp=7ed7c62013b7d9548c17806a43dd984220ed76e5;hpb=659c913e9621ac2286a9a258fe71e682ce991338;p=chise%2Fxemacs-chise.git

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index 7ed7c62..19d49ad 100644
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -620,7 +620,19 @@
       (setq attributes (delq 'ideographic-radical attributes))
       )
     (let (key)
-      (dolist (domain char-db-feature-domains)
+      (dolist (domain
+	       (append
+		char-db-feature-domains
+		(let (dest domain)
+		  (dolist (feature (char-attribute-list))
+		    (setq feature (symbol-name feature))
+		    (when (string-match
+			   "\\(radical\\|strokes\\)@\\([^@*]+\\)\\(\\*\\|$\\)"
+			   feature)
+		      (setq domain (intern (match-string 2 feature)))
+		     (unless (memq domain dest)
+		       (setq dest (cons domain dest)))))
+		  (sort dest #'string<))))
 	(setq key (intern (format "%s@%s" 'ideographic-radical domain)))
 	(when (and (memq key attributes)
 		   (setq value (get-char-attribute char key)))
@@ -879,6 +891,13 @@
 		      (not (string-match "\\*sources$" (symbol-name name)))
 		      (or (eq name '<-identical)
 			  (string-match "^->halfwidth" (symbol-name name))
+			  (and
+			   (string-match "^->fullwidth" (symbol-name name))
+			   (not
+			    (and (consp value)
+				 (characterp (car value))
+				 (encode-char
+				  (car value) '=ucs 'defined-only))))
 			  (string-match "^->simplified" (symbol-name name))
 			  (string-match "^->vulgar" (symbol-name name))
 			  (string-match "^->wrong" (symbol-name name))
@@ -1091,20 +1110,26 @@
 		      (let ((ucs (get-char-attribute char '->ucs)))
 			(if ucs
 			    (delete char (char-variants (int-char ucs)))))))
-	variant vs)
+	variant vs ret)
     (setq variants (sort variants #'<))
     (while variants
       (setq variant (car variants))
-      (if (and (or (null script)
-		   (null (setq vs (get-char-attribute variant 'script)))
-		   (memq script vs))
-	       (or (null excluded-script)
-		   (null (setq vs (get-char-attribute variant 'script)))
-		   (not (memq excluded-script vs))))
-	  (or (and no-ucs-unified (get-char-attribute variant '=ucs))
-	      (insert-char-data variant printable)))
-      (setq variants (cdr variants))
-      )))
+      (unless (get-char-attribute variant '<-subsumptive)
+	(if (and (or (null script)
+		     (null (setq vs (get-char-attribute variant 'script)))
+		     (memq script vs))
+		 (or (null excluded-script)
+		     (null (setq vs (get-char-attribute variant 'script)))
+		     (not (memq excluded-script vs))))
+	    (unless (and no-ucs-unified (get-char-attribute variant '=ucs))
+	      (insert-char-data variant printable)
+	      (if (setq ret (char-variants variant))
+		  (while ret
+		    (or (memq (car ret) variants)
+                        ;; (get-char-attribute (car ret) '<-subsumptive)
+			(setq variants (append variants (list (car ret)))))
+		    (setq ret (cdr ret)))))))
+      (setq variants (cdr variants)))))
 
 (defun insert-char-range-data (min max &optional script excluded-script)
   (let ((code min)