From: tomo <tomo>
Date: Wed, 25 Dec 2002 13:33:53 +0000 (+0000)
Subject: (ideographic-structure-member-compare-components): Renamed from
X-Git-Tag: ids-0_0-1~164
X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fids.git;a=commitdiff_plain;h=c3546f3d6fe18aaafb9d2fee20730b4797c1f896

(ideographic-structure-member-compare-components): Renamed from
`ideographic-structure-member-compare-parts'.
(ideographic-structure-member): Rename argument `part' to `component'.
(ideographic-structure-repertoire-p): Likewise.
(ids-find-result-buffer): New variable.
(ids-find-format-line): New function.
(ids-find-chars-including-components): Renamed from
`ideographic-structure-search-chars'; use `ids-find-result-buffer' and
`ids-find-format-line'.
(ideographic-structure-search-chars): New obsolete alias for
`ids-find-chars-including-components'.
(ids-find-chars-covered-by-components): New command.
---

diff --git a/ids-find.el b/ids-find.el
index ad9ff9c..2af3021 100644
--- a/ids-find.el
+++ b/ids-find.el
@@ -41,78 +41,130 @@
 		   (when (or m1 m2)
 		     (ideographic-structure-char= m1 m2))))))))
 
-(defun ideographic-structure-member-compare-parts (part s-part)
+(defun ideographic-structure-member-compare-components (component s-component)
   (let (ret)
-    (cond ((char-ref= part s-part #'ideographic-structure-char=))
-	  ((listp s-part)
-	   (if (setq ret (assq 'ideographic-structure s-part))
-	       (ideographic-structure-member part (cdr ret))))
-	  ((setq ret (get-char-attribute s-part 'ideographic-structure))
-	   (ideographic-structure-member part ret)))))
+    (cond ((char-ref= component s-component #'ideographic-structure-char=))
+	  ((listp s-component)
+	   (if (setq ret (assq 'ideographic-structure s-component))
+	       (ideographic-structure-member component (cdr ret))))
+	  ((setq ret (get-char-attribute s-component 'ideographic-structure))
+	   (ideographic-structure-member component ret)))))
 
 ;;;###autoload
-(defun ideographic-structure-member (part structure)
-  "Return non-nil if PART is included in STRUCTURE."
+(defun ideographic-structure-member (component structure)
+  "Return non-nil if COMPONENT is included in STRUCTURE."
   (or (progn
 	(setq structure (cdr structure))
-	(ideographic-structure-member-compare-parts part (car structure)))
+	(ideographic-structure-member-compare-components
+	 component (car structure)))
       (progn
 	(setq structure (cdr structure))
-	(ideographic-structure-member-compare-parts part (car structure)))
+	(ideographic-structure-member-compare-components
+	 component (car structure)))
       (progn
 	(setq structure (cdr structure))
 	(and (car structure)
-	     (ideographic-structure-member-compare-parts
-	      part (car structure))))))
+	     (ideographic-structure-member-compare-components
+	      component (car structure))))))
 
 
 ;;;###autoload
-(defun ideographic-structure-repertoire-p (structure parts)
-  "Return non-nil if STRUCTURE can be constructed by a subset of PARTS."
+(defun ideographic-structure-repertoire-p (structure components)
+  "Return non-nil if STRUCTURE can be constructed by a subset of COMPONENTS."
   (and structure
-       (let (ret s-part)
+       (let (ret s-component)
 	 (catch 'tag
 	   (while (setq structure (cdr structure))
-	     (setq s-part (car structure))
-	     (unless (characterp s-part)
-	       (if (setq ret (find-char s-part))
-		   (setq s-part ret)))
+	     (setq s-component (car structure))
+	     (unless (characterp s-component)
+	       (if (setq ret (find-char s-component))
+		   (setq s-component ret)))
 	     (unless (cond
-		      ((listp s-part)
-		       (if (setq ret (assq 'ideographic-structure s-part))
+		      ((listp s-component)
+		       (if (setq ret (assq 'ideographic-structure s-component))
 			   (ideographic-structure-repertoire-p
-			    (cdr ret) parts)))
-		      ((member* s-part parts
+			    (cdr ret) components)))
+		      ((member* s-component components
 				:test #'ideographic-structure-char=))
 		      ((setq ret
-			     (get-char-attribute s-part
+			     (get-char-attribute s-component
 						 'ideographic-structure))
-		       (ideographic-structure-repertoire-p ret parts)))
+		       (ideographic-structure-repertoire-p ret components)))
 	       (throw 'tag nil)))
 	   t))))
 
+
+(defvar ids-find-result-buffer "*ids-chars*")
+
+(defun ids-find-format-line (c v)
+  (format "%c\t%s\t%s\n"
+	  c
+	  (or (let ((ucs (or (char-ucs c)
+			     (encode-char c 'ucs))))
+		(if ucs
+		    (cond ((<= ucs #xFFFF)
+			   (format "    U+%04X" ucs))
+			  ((<= ucs #x10FFFF)
+			   (format "U-%08X" ucs)))))
+	      "          ")
+	  (or (ideographic-structure-to-ids v)
+	      v)))
+
 ;;;###autoload
-(defun ideographic-structure-search-chars (parts)
-  "Search Ideographs by PARTS."
-  (interactive "sParts : ")
-  (with-current-buffer (get-buffer-create " *ids-chars*")
+(defun ids-find-chars-including-components (components)
+  "Search Ideographs whose structures have COMPONENTS."
+  (interactive "sComponents : ")
+  (with-current-buffer (get-buffer-create ids-find-result-buffer)
     (setq buffer-read-only nil)
     (erase-buffer)
     (map-char-attribute
      (lambda (c v)
-       (when (every
-	      (lambda (p)
-		;; (member* p v :test #'char-ref=)
-		(ideographic-structure-member p v))
-	      parts)
-	 (insert (format "%c\t%s\n"
-			 c
-			 (or (ideographic-structure-to-ids v)
-			     v))))
+       (when (every (lambda (p)
+		      (ideographic-structure-member p v))
+		    components)
+         (insert (ids-find-format-line c v)))
        nil)
      'ideographic-structure)
     (goto-char (point-min)))
-  (view-buffer " *ids-chars*"))
+  (view-buffer ids-find-result-buffer))
+
+;;;###autoload
+(define-obsolete-function-alias 'ideographic-structure-search-chars
+  'ids-find-chars-including-components)
+
+;;;###autoload
+(defun ids-find-chars-covered-by-components (components)
+  "Search Ideographs which structures are consisted by subsets of COMPONENTS."
+  (interactive "sComponents: ")
+  (if (stringp components)
+      (setq components (string-to-char-list components)))
+  (with-current-buffer (get-buffer-create ids-find-result-buffer)
+    (setq buffer-read-only nil)
+    (erase-buffer)
+    (let (ucs jis)
+      (map-char-attribute
+       (lambda (c v)
+	 (when (ideographic-structure-repertoire-p v components)
+	   (insert
+	    (ids-find-format-line c v)
+            ;; (format "%c\t%s\t%s\n"
+            ;;         c
+            ;;         (or
+            ;;          (when (setq ucs (char-ucs c))
+            ;;            (or
+            ;;             (when (setq jis
+            ;;                         (encode-char
+            ;;                          (decode-char
+            ;;                           'ucs-jis (char-ucs c))
+            ;;                          'japanese-jisx0208-1990))
+            ;;               (format "J0-%04X" jis))))
+            ;;          "")
+            ;;         (or (ideographic-structure-to-ids v)
+            ;;             v))
+	    )))
+       'ideographic-structure))
+    (goto-char (point-min)))
+  (view-buffer ids-find-result-buffer))
 
 
 ;;; @ End.