X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fideograph-util.el;h=097d33f4a6c61c170356ed9500caaba61582ce9d;hb=4d9280cd5d0f925d2afa157dcf20f13fdcf4de17;hp=5cd7fda25534c22d5c3b801e731a30cc2df5777e;hpb=628db25f3a8ff20863ab1a9f0c92504a7c11e2f4;p=chise%2Fxemacs-chise.git

diff --git a/lisp/utf-2000/ideograph-util.el b/lisp/utf-2000/ideograph-util.el
index 5cd7fda..097d33f 100644
--- a/lisp/utf-2000/ideograph-util.el
+++ b/lisp/utf-2000/ideograph-util.el
@@ -205,8 +205,13 @@
   (let ((chars
 	 (sort (copy-list (aref ideograph-radical-chars-vector radical))
 	       (function ideograph-char<)))
-	(attributes (sort (char-attribute-list) #'char-attribute-name<))
-	(ccs (sort (charset-list) #'char-attribute-name<)))
+	attributes ccs)
+    (dolist (name (char-attribute-list))
+      (if (find-charset name)
+	  (push name ccs)
+	(push name attributes)))
+    (setq attributes (sort attributes #'char-attribute-name<)
+	  ccs (sort ccs #'char-attribute-name<))
     (aset ideograph-radical-chars-vector radical chars)
     (while chars
       (insert-char-data (car chars) nil attributes ccs)
@@ -232,6 +237,46 @@
       (write-region (point-min)(point-max) file)
       )))
 
+(defun ideographic-structure= (char1 char2)
+  (if (char-ref-p char1)
+      (setq char1 (plist-get char1 :char)))
+  (if (char-ref-p char2)
+      (setq char2 (plist-get char2 :char)))
+  (let ((s1 (if (characterp char1)
+		(get-char-attribute char1 'ideographic-structure)
+	      (cdr (assq 'ideographic-structure char1))))
+	(s2 (if (characterp char2)
+		(get-char-attribute char2 'ideographic-structure)
+	      (cdr (assq 'ideographic-structure char2))))
+	e1 e2)
+    (if (or (null s1)(null s2))
+	(char-spec= char1 char2)
+      (catch 'tag
+	(while (and s1 s2)
+	  (setq e1 (car s1)
+		e2 (car s2))
+	  (unless (ideographic-structure= e1 e2)
+	    (throw 'tag nil))
+	  (setq s1 (cdr s1)
+		s2 (cdr s2)))
+	(and (null s1)(null s2))))))
+
+;;;###autoload
+(defun ideographic-structure-find-char (structure)
+  (let (rest)
+    (map-char-attribute (lambda (char value)
+			  (setq rest structure)
+			  (catch 'tag
+			    (while (and rest value)
+			      (unless (ideographic-structure=
+				       (car rest)(car value))
+				(throw 'tag nil))
+			      (setq rest (cdr rest)
+				    value (cdr value)))
+			    (unless (or rest value)
+			      char)))
+			'ideographic-structure)))
+
 (provide 'ideograph-util)
 
 ;;; ideograph-util.el ends here