[elpa] externals/ebdb 80ef19d 108/350: Make ebdb-search-read and ebdb-search-field into generics

[Eric Abrahamsen]

branch: externals/ebdb
commit 80ef19d0ad612cfbe13d456c2069821bc7d129f6
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Make ebdb-search-read and ebdb-search-field into generics
    
    * ebdb.el (ebdb-search-read): Each field class has the potential to
      prompt the user for its own search criteria, which are then fed back
      to its own implementation of `ebdb-search-field'.
      (ebdb-record-search): Fix the 'user implementation of this method,
      now works with record labels again.
    * ebdb-com.el: Change interactive calls to `ebdb-search-read' to use
      the field class instead of string prompt, where appropriate.
    * ebdb-org.el: Provide `ebdb-search-read' and `ebdb-field-search'
      methods for the org tags class.
---
 ebdb-com.el |  14 ++--
 ebdb-org.el |  15 ++++
 ebdb.el     | 223 +++++++++++++++++++++++++++++++++---------------------------
 3 files changed, 146 insertions(+), 106 deletions(-)

diff --git a/ebdb-com.el b/ebdb-com.el
index db8c2ed..496bbcc 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -1910,7 +1910,7 @@ not necessarily.  FMT is the optional formatter to use."
   "Display all records in the EBDB matching REGEXP
 in either the name(s), organization, address, phone, mail, or xfields."
   (interactive (list (ebdb-search-style)
-                    (ebdb-search-read)
+                    (ebdb-search-read 'all)
                     (ebdb-formatter-prefix)))
   (ebdb-search-display style `((name ,regexp)
                               (organization ,regexp)
@@ -1942,7 +1942,7 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
 (defun ebdb-search-address (style regexp &optional fmt)
   "Display all records in the EBDB matching REGEXP in the address fields."
   (interactive (list (ebdb-search-style)
-                    (ebdb-search-read "address")
+                    (ebdb-search-read ebdb-default-address-class)
                     (ebdb-formatter-prefix)))
   (ebdb-search-display style `((address ,regexp)) fmt))
 
@@ -1950,7 +1950,7 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
 (defun ebdb-search-mail (style regexp &optional fmt)
   "Display all records in the EBDB matching REGEXP in the mail address."
   (interactive (list (ebdb-search-style)
-                    (ebdb-search-read "mail address")
+                    (ebdb-search-read ebdb-default-mail-class)
                     (ebdb-formatter-prefix)))
   (ebdb-search-display style `((mail ,regexp)) fmt))
 
@@ -1958,7 +1958,7 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
 (defun ebdb-search-phone (style regexp &optional fmt)
   "Display all records in the EBDB matching REGEXP in the phones field."
   (interactive (list (ebdb-search-style)
-                    (ebdb-search-read "phone")
+                    (ebdb-search-read ebdb-default-phone-class)
                     (ebdb-formatter-prefix)))
   (ebdb-search-display style `((phone ,regexp)) fmt))
 
@@ -1966,7 +1966,7 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
 (defun ebdb-search-notes (style regexp &optional fmt)
   "Display all records in the EBDB matching REGEXP in the phones field."
   (interactive (list (ebdb-search-style)
-                    (ebdb-search-read "notes")
+                    (ebdb-search-read ebdb-default-notes-class)
                     (ebdb-formatter-prefix)))
   (ebdb-search-display style `((notes ,regexp)) fmt))
 
@@ -1996,9 +1996,9 @@ in either the name(s), organization, address, phone, 
mail, or xfields."
           (if (null field) '* field)
            (ebdb-search-read (if (null field)
                                 "any user field"
-                              (car field)))
+                              (cdr field)))
            (ebdb-formatter-prefix))))
-  (ebdb-search-display style `((user ,(cons field regexp))) fmt))
+  (ebdb-search-display style `((user ,(list field regexp))) fmt))
 
 ;;;###autoload
 (defun ebdb-search-changed (&optional fmt)
diff --git a/ebdb-org.el b/ebdb-org.el
index 411e93c..761094e 100644
--- a/ebdb-org.el
+++ b/ebdb-org.el
@@ -142,6 +142,21 @@ potential tags for completion.")
               (when obj (ebdb-string obj)))))
     (cl-call-next-method field (plist-put slots :tags val))))
 
+(cl-defmethod ebdb-search-read ((class (subclass ebdb-org-field-tags)))
+  (let ((crm-separator (cadr (assq 'ebdb-org-field-tags 
ebdb-separator-alist))))
+    (completing-read-multiple
+     "Search for tags: "
+     (append (org-global-tags-completion-table)
+            (when ebdb-org-tags
+              (mapcar #'list ebdb-org-tags)))
+     nil nil)))
+
+(cl-defmethod ebdb-field-search ((field ebdb-org-field-tags) (tag-list list))
+  (catch 'found
+    (dolist (tag (slot-value field 'tags) nil)
+      (when (member tag tag-list)
+       (throw 'found t)))))
+
 (cl-defmethod ebdb-init-field ((field ebdb-org-field-tags) _record)
   (let ((tags (slot-value field 'tags)))
     (dolist (tag tags)
diff --git a/ebdb.el b/ebdb.el
index 5c171dc..6620a91 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -607,11 +607,6 @@ MESSAGE-HEADERS is a list of all the headers of the 
incoming
 message."
   nil)
 
-(cl-defmethod ebdb-field-search ((field ebdb-field) (regex string))
-  (condition-case nil
-      (string-match-p regex (ebdb-string field))
-    (cl-no-applicable-method nil)))
-
 ;;; The UUID field.
 
 ;; This was originally just a string-value slot, but it was such a
@@ -904,13 +899,6 @@ first one."
        (cl-call-next-method class slots obj))
     (ebdb-parse class (ebdb-read-string "Name: " (when obj (ebdb-string obj))) 
slots)))
 
-(cl-defmethod ebdb-field-search ((_field ebdb-field-name-complex) _regex)
-  "Short-circuit the plain field search for names.
-
-The record itself performs more complex searches on cached name
-values, by default the search is not handed to the name field itself."
-  nil)
-
 (cl-defmethod ebdb-parse ((class (subclass ebdb-field-name-complex)) str 
&optional slots)
   (let ((bits (ebdb-divide-name str)))
     (unless (plist-get slots :given-names)
@@ -1969,57 +1957,6 @@ only return fields that are suitable for user editing.")
   ;; Implement this later.
   t)
 
-(cl-defmethod ebdb-record-search ((record ebdb-record)
-                                 (_type (eql name))
-                                 (regexp string))
-  (or (string-match-p regexp (or (ebdb-record-name record) ""))
-      (seq-find
-       (lambda (n)
-        (string-match-p regexp n))
-       (ebdb-record-alt-names record))
-      (ebdb-field-search (slot-value record 'name) regexp)))
-
-(cl-defmethod ebdb-record-search ((record ebdb-record)
-                                 (_type (eql 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)
-                                 (_type (eql user))
-                                 search-clause)
-  (pcase search-clause
-    (`(* . ,(and regexp (pred stringp)))
-     ;; check all user fields
-     (catch 'found
-       (dolist (f (ebdb-record-user-fields record))
-        (when (or (string-match-p regexp (ebdb-string f))
-                  (and (slot-exists-p f 'object-name)
-                       (string-match-p regexp (slot-value f 'object-name))))
-          (throw 'found t)))
-       ;; so that "^$" can be used to find records that
-       ;; have no notes
-       (when (string-match-p regexp "")
-        (throw 'found t))))
-    (`((,(and field-string (pred stringp)) . ,(and class (pred symbolp))) . 
,(and regexp (pred stringp))) ; check one field
-     (catch 'found
-       (if (eql class 'ebdb-field-class-simple)
-          (when (string-match-p
-                 regexp (ebdb-string
-                         (ebdb-record-user-field record field-string)))
-            (throw 'found t))
-        (dolist (f (ebdb-record-user-fields record))
-          ;; If it's not a `ebdb-field-class-simple', the
-          ;; "field-string" is always going to be the same.  Just
-          ;; check if the regexp matches either the label, if there
-          ;; is one, or the value.
-          (when (and (object-of-class-p f class)
-                     (or (and (slot-exists-p f 'object-name)
-                              (string-match-p regexp (slot-value f 
'object-name)))
-                         (string-match-p regexp (ebdb-string f))))
-            (throw 'found t))))))
-    (_ nil)))
-
 ;; TODO: rename this to `ebdb-record-name-string', it's confusing.
 (cl-defmethod ebdb-record-name ((record ebdb-record))
   "Get or set-and-get the cached name string of RECORD."
@@ -2203,39 +2140,6 @@ priority."
   (let ((mails (ebdb-record-mail record t)))
     (object-assoc 'primary 'priority mails)))
 
-(cl-defmethod ebdb-record-search ((record ebdb-record-entity)
-                                 (_type (eql 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 ""))))
-
-(cl-defmethod ebdb-record-search ((record ebdb-record-entity)
-                                 (_type (eql 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 ""))))
-
-(cl-defmethod ebdb-record-search ((record ebdb-record-entity)
-                                 (_type (eql 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 ""))))
-
 ;; This needs to be a :before method so that the 'address slot is
 ;; filled by the time we call `ebdb-init-field'.
 (cl-defmethod ebdb-record-insert-field :before ((record ebdb-record-entity)
@@ -4595,10 +4499,131 @@ interpreted as t, ie the record passes."
                  (_ t))))))
      records)))
 
-(defun ebdb-search-read (&optional field)
+(cl-defgeneric ebdb-field-search (field criterion)
+  "Return t if search CRITERION somehow matches the value of
+  FIELD.")
+
+(cl-defgeneric ebdb-record-search (record type criterion)
+  "Return t if CRITERION matches RECORD, given STYLE.")
+
+(cl-defmethod ebdb-field-search ((field ebdb-field) (regex string))
+  (condition-case nil
+      (string-match-p regex (ebdb-string field))
+    (cl-no-applicable-method nil)))
+
+(cl-defmethod ebdb-field-search ((field ebdb-field-labeled) (pair cons))
+  (let ((label (car pair))
+       (value (cdr pair)))
+    (and (or (null label)
+            (string-empty-p label)
+            (string-match-p label (slot-value field 'object-name)))
+        (or (null value)
+            (string-empty-p value)
+            (ebdb-field-search field value)))))
+
+(cl-defmethod ebdb-field-search ((_field ebdb-field-name-complex) _regex)
+  "Short-circuit the plain field search for names.
+
+The record itself performs more complex searches on cached name
+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))
+                                 (regexp string))
+  (or (string-match-p regexp (or (ebdb-record-name record) ""))
+      (seq-find
+       (lambda (n)
+        (string-match-p regexp n))
+       (ebdb-record-alt-names record))
+      (ebdb-field-search (slot-value record 'name) regexp)))
+
+(cl-defmethod ebdb-record-search ((record ebdb-record)
+                                 (_type (eql 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))
+                                 (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 ""))))
+
+(cl-defmethod ebdb-record-search ((record ebdb-record-entity)
+                                 (_type (eql 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 ""))))
+
+(cl-defmethod ebdb-record-search ((record ebdb-record-entity)
+                                 (_type (eql 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 ""))))
+
+(cl-defmethod ebdb-record-search ((record ebdb-record)
+                                 (_type (eql user))
+                                 search-clause)
+  (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)))
+       ;; so that "^$" can be used to find records that
+       ;; have no notes
+       (when (string-match-p regexp "")
+        (throw 'found t)))
+      (`((,(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))))
+      (`((,(and field-string (pred stringp)) . ,(and class (pred symbolp))) 
,criterion) ; check one field
+       (dolist (f (ebdb-record-user-fields record))
+        (when (and (object-of-class-p f class)
+                   (ebdb-field-search f criterion))
+          (throw 'found t))))
+      (_ nil))))
+
+(cl-defgeneric ebdb-search-read (field-class)
+  "Prompt the user for a search string to match against instances
+  of FIELD-CLASS.
+
+In most cases this is a simple regexp, but field classes can
+prompt users for more complex search criteria, if necessary.")
+
+(cl-defmethod ebdb-search-read ((cls (subclass ebdb-field)))
+  (read-string (format "Search records with %s %smatching regexp: "
+                      (ebdb-field-readable-name cls)
+                      (if ebdb-search-invert "not " ""))))
+
+(cl-defmethod ebdb-search-read ((field string))
   "Read regexp to search FIELD values of records."
-  (read-string (format "Search records%s %smatching regexp: "
-                       (if field (concat " with " field) "")
+  (read-string (format "Search records with %s %smatching regexp: "
+                       field
+                       (if ebdb-search-invert "not " ""))))
+
+(cl-defmethod ebdb-search-read ((_all symbol))
+  "Read regexp to search across all records."
+  (read-string (format "Search records %smatching regexp: "
                        (if ebdb-search-invert "not " ""))))
 
 ;; Create autoload statements for fields defined in other files.