[elpa] externals/ebdb 4cd4a0c 123/350: Simplify searching

[Eric Abrahamsen]

branch: externals/ebdb
commit 4cd4a0ccd3b0ea487036e6a19531640e5af05070
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Simplify searching
    
    * ebdb-com.el: There's no reason to dispatch on symbols and then
      create these weird data structures. Dispatch on field classes, and
      save the symbol dispatching for strange or compound searches.
    * ebdb.el (ebdb-search): Condition-case cl-no-applicable-method.
      (ebdb-record-search): Record search on user fields can now be much
      simplified.
---
 ebdb-com.el |  60 ++++++++++++++++++++++-----------
 ebdb.el     | 108 +++++++++++++++++++++++++++++++-----------------------------
 2 files changed, 96 insertions(+), 72 deletions(-)

diff --git a/ebdb-com.el b/ebdb-com.el
index 5441f34..6aec6e9 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -1900,13 +1900,13 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
   (interactive (list (ebdb-search-style)
                     (ebdb-search-read 'all)
                     (ebdb-formatter-prefix)))
-  (ebdb-search-display style `((name ,regexp)
+  (ebdb-search-display style `((ebdb-field-name ,regexp)
                               (organization ,regexp)
-                              (mail ,regexp)
-                              (notes ,regexp)
-                              (user ,regexp)
-                              (phone ,regexp)
-                              (address ,regexp))
+                              (ebdb-field-mail ,regexp)
+                              (ebdb-field-notes ,regexp)
+                              (ebdb-field-user ,regexp)
+                              (ebdb-field-phone ,regexp)
+                              (ebdb-field-address ,regexp))
                       fmt))
 
 ;;;###autoload
@@ -1916,7 +1916,7 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
   (interactive (list (ebdb-search-style)
                     (ebdb-search-read "names")
                     (ebdb-formatter-prefix)))
-  (ebdb-search-display style `((name ,regexp)) fmt))
+  (ebdb-search-display style `((ebdb-field-name ,regexp)) fmt))
 
 ;;;###autoload
 (defun ebdb-search-organization (style regexp &optional fmt)
@@ -1932,7 +1932,7 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
   (interactive (list (ebdb-search-style)
                     (ebdb-search-read ebdb-default-address-class)
                     (ebdb-formatter-prefix)))
-  (ebdb-search-display style `((address ,regexp)) fmt))
+  (ebdb-search-display style `((,ebdb-default-address-class ,regexp)) fmt))
 
 ;;;###autoload
 (defun ebdb-search-mail (style regexp &optional fmt)
@@ -1940,7 +1940,7 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
   (interactive (list (ebdb-search-style)
                     (ebdb-search-read ebdb-default-mail-class)
                     (ebdb-formatter-prefix)))
-  (ebdb-search-display style `((mail ,regexp)) fmt))
+  (ebdb-search-display style `((,ebdb-default-mail-class ,regexp)) fmt))
 
 ;;;###autoload
 (defun ebdb-search-phone (style regexp &optional fmt)
@@ -1948,7 +1948,7 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
   (interactive (list (ebdb-search-style)
                     (ebdb-search-read ebdb-default-phone-class)
                     (ebdb-formatter-prefix)))
-  (ebdb-search-display style `((phone ,regexp)) fmt))
+  (ebdb-search-display style `((,ebdb-default-phone-class ,regexp)) fmt))
 
 ;;;###autoload
 (defun ebdb-search-notes (style regexp &optional fmt)
@@ -1956,11 +1956,11 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
   (interactive (list (ebdb-search-style)
                     (ebdb-search-read ebdb-default-notes-class)
                     (ebdb-formatter-prefix)))
-  (ebdb-search-display style `((notes ,regexp)) fmt))
+  (ebdb-search-display style `((,ebdb-default-notes-class ,regexp)) fmt))
 
 ;;;###autoload
-(defun ebdb-search-user-fields (style field regexp &optional fmt)
-  "Display all EBDB records for which user field FIELD matches REGEXP."
+(defun ebdb-search-user-fields (style field criterion &optional fmt)
+  "Display all EBDB records for which user field FIELD matches CRITERION."
   (interactive
    ;; TODO: Refactor this with `ebdb-prompt-for-field-type'
    (let* ((style (ebdb-search-style))
@@ -1971,7 +1971,10 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
               (cons
                (ebdb-field-readable-name (intern (car f)))
                (intern (car f))))
-            (eieio-build-class-alist 'ebdb-field-user t))
+            (cl-remove-if
+             (lambda (f)
+               (string= "ebdb-field-user-simple" (car f)))
+             (eieio-build-class-alist 'ebdb-field-user t)))
            (mapcar
             (lambda (l)
               (cons l 'ebdb-field-user-simple))
@@ -1979,14 +1982,31 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
          (field (assoc (completing-read "Field to search (RET for all): "
                                         field-alist
                                         nil t)
-                       field-alist)))
+                       field-alist))
+         (criterion (ebdb-search-read (cond ((null field)
+                                             "any user field")
+                                            ((eql (cdr field) 
ebdb-field-user-simple)
+                                             (format "%s field" (car field)))
+                                            (t (cdr field))))))
      (list style
-          (if (null field) '* field)
-           (ebdb-search-read (if (null field)
-                                "any user field"
-                              (cdr field)))
+          (or (cdr-safe field) ebdb-field-user)
+          (if (child-of-class-p (cdr-safe field) ebdb-field-user-simple)
+              (cons (car field) criterion)
+            criterion)
            (ebdb-formatter-prefix))))
-  (ebdb-search-display style `((user ,(list field regexp))) fmt))
+  (ebdb-search-display
+   style
+   `((,field ,criterion))
+   fmt))
+
+;;;###autoload
+(defun ebdb-search-organization (style regexp &optional fmt)
+  (interactive
+   (list
+    (ebdb-search-style)
+    (read-string "Search for organizations: ")
+    (ebdb-formatter-prefix)))
+  (ebdb-search-display style `((organization ,regexp)) fmt))
 
 ;;;###autoload
 (defun ebdb-search-changed (&optional fmt)
diff --git a/ebdb.el b/ebdb.el
index a45f646..c229b80 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -4487,15 +4487,17 @@ interpreted as t, ie the record passes."
      (lambda (r)
        (eql (null invert)
            (catch 'found
-             (dolist (c clauses)
-               (pcase c
-                 (`(,(and type (pred symbolp)) ,criteria)
-                  (and (ebdb-record-search r type criteria)
-                       (throw 'found t)))
-                 (`,(and func (pred functionp))
-                  (and (funcall func r)
-                       (throw 'found t)))
-                 (_ t))))))
+             (condition-case nil
+              (dolist (c clauses)
+                (pcase c
+                  (`(,(and type (pred class-p)) ,criteria)
+                   (and (ebdb-record-search r type criteria)
+                        (throw 'found t)))
+                  (`,(and func (pred functionp))
+                   (and (funcall func r)
+                        (throw 'found t)))
+                  (_ t)))
+              (cl-no-applicable-method nil)))))
      records)))
 
 (cl-defgeneric ebdb-field-search (field criterion)
@@ -4520,6 +4522,12 @@ interpreted as t, ie the record passes."
         (or (null value)
             (ebdb-field-search field value)))))
 
+(cl-defmethod ebdb-field-search ((field ebdb-field-labeled)
+                                (regexp string))
+  (or (string-match-p regexp (ebdb-string field))
+      (string-match-p regexp (slot-value field 'object-name))
+      (cl-call-next-method)))
+
 (cl-defmethod ebdb-field-search ((_field ebdb-field-name-complex) _regex)
   "Short-circuit the plain field search for names.
 
@@ -4528,7 +4536,7 @@ values, by default the search is not handed to the name 
field itself."
   nil)
 
 (cl-defmethod ebdb-record-search ((record ebdb-record)
-                                 (_type (eql name))
+                                 (_type (subclass ebdb-field-name))
                                  (regexp string))
   (or (string-match-p regexp (or (ebdb-record-name record) ""))
       (seq-find
@@ -4538,69 +4546,65 @@ values, by default the search is not handed to the name 
field itself."
       (ebdb-field-search (slot-value record 'name) regexp)))
 
 (cl-defmethod ebdb-record-search ((record ebdb-record)
-                                 (_type (eql notes))
+                                 (_type (subclass ebdb-field-notes))
                                  (regexp string))
   (if-let (notes (slot-value record 'notes))
       (string-match-p regexp (ebdb-string notes))))
 
 (cl-defmethod ebdb-record-search ((record ebdb-record-entity)
-                                 (_type (eql phone))
+                                 (_type (subclass ebdb-field-phone))
                                  (regexp string))
   (let ((phones (ebdb-record-phone record)))
     (if phones
-       (catch 'found
-         (dolist (ph phones)
-           (when (ebdb-field-search ph regexp)
-             (throw 'found t))))
-      (string-match-p regexp ""))))
+       (or (string-match-p regexp "")
+           (catch 'found
+             (dolist (ph phones)
+               (when (ebdb-field-search ph regexp)
+                 (throw 'found t))))))))
 
 (cl-defmethod ebdb-record-search ((record ebdb-record-entity)
-                                 (_type (eql address))
+                                 (_type (subclass ebdb-field-address))
                                  (regexp string))
   (let ((adds (ebdb-record-address record)))
     (if adds
-       (catch 'found
-         (dolist (a adds)
-           (when (ebdb-field-search a regexp)
-             (throw 'found t))))
-      (string-match-p regexp ""))))
+       (or (string-match-p regexp "")
+           (catch 'found
+             (dolist (a adds)
+               (when (ebdb-field-search a regexp)
+                 (throw 'found t))))))))
 
 (cl-defmethod ebdb-record-search ((record ebdb-record-entity)
-                                 (_type (eql mail))
+                                 (_type (subclass ebdb-field-mail))
                                  (regexp string))
   (let ((mails (ebdb-record-mail record t nil t)))
     (if mails
-       (catch 'found
-         (dolist (m mails)
-           (when (ebdb-field-search m regexp)
-             (throw 'found t))))
-      (string-match-p regexp ""))))
+       (or (string-match-p regexp "")
+           (catch 'found
+             (dolist (m mails)
+               (when (ebdb-field-search m regexp)
+                 (throw 'found t))))))))
+
+(cl-defmethod ebdb-record-search ((record ebdb-record-person)
+                                 (_type (eql organization))
+                                 (regexp string))
+  (seq-find
+   (lambda (o)
+     (string-match-p regexp o))
+   (slot-value (ebdb-record-cache record) 'organizations)))
+
+(cl-defmethod ebdb-record-search ((record ebdb-record-organization)
+                                 (_type (eql organization))
+                                 (regexp string))
+  (ebdb-record-search record ebdb-field-name regexp))
 
 (cl-defmethod ebdb-record-search ((record ebdb-record)
-                                 (_type (eql user))
-                                 search-clause)
+                                 (cls (subclass ebdb-field-user))
+                                 criterion)
   (catch 'found
-    (pcase search-clause
-      (`(* ,(and regexp (pred stringp)))
-       ;; Check all user fields.
-       (dolist (f (ebdb-record-user-fields record))
-        (when (ebdb-field-search f regexp)
-          (throw 'found t))))
-      ;; This is bad, we should not be hard-coding for specific
-      ;; classes.  Should just be composing the right kind of search
-      ;; criteria, then passing it on.
-      (`((,(and label (pred stringp)) . ,'ebdb-field-user-simple) ,(and regexp 
(pred stringp)))
-       (dolist (f (ebdb-record-user-fields record))
-        (when (and (object-of-class-p f ebdb-field-user-simple)
-                   (ebdb-field-search f (cons label regexp)))
-          (throw 'found t))))
-       ;; Check one field.
-      (`((,(and field-string (pred stringp)) . ,(and class (pred symbolp))) 
,criterion)
-       (dolist (f (ebdb-record-user-fields record))
-        (when (and (object-of-class-p f class)
-                   (ebdb-field-search f criterion))
-          (throw 'found t))))
-      (_ nil))))
+    (dolist (f (ebdb-record-user-fields record))
+      (when (and (object-of-class-p f cls)
+                (ebdb-field-search f criterion))
+       (throw 'found t)))))
 
 (cl-defgeneric ebdb-search-read (field-class)
   "Prompt the user for a search string to match against instances