(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 (file)
--- 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.