[elpa] externals/ebdb 8f3a331 3/6: Refactor record mail commands

[Eric Abrahamsen]

branch: externals/ebdb
commit 8f3a331448febe17d5346a5003e82102b20fa4ce
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Refactor record mail commands
    
    * ebdb.el (ebdb-record-one-mail): The main thing being replacing
      `ebdb-prompt-for-mail' with new function `ebdb-record-one-mail'.
      There are now three main functions for producing mail addresses from
      a record: `ebdb-record-mail' returns them all (depending on
      arguments), `ebdb-record-one-mail' returns a single one (which one
      determined by args), and `ebdb-dwim-mail' returns a string mail
      representation of the record. The senses of function arguments have
      been swapped around to minimize the number of arguments that have to
      be passed in the most common cases.
---
 ebdb-com.el      |  36 +++++++++--------
 ebdb-complete.el |   2 +-
 ebdb-mua.el      |   4 +-
 ebdb-test.el     |   4 +-
 ebdb.el          | 115 +++++++++++++++++++++++++++++++++----------------------
 5 files changed, 93 insertions(+), 68 deletions(-)

diff --git a/ebdb-com.el b/ebdb-com.el
index d687978..49c282b 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -1844,7 +1844,7 @@ Also redisplays it after customization."
   "Handle mail priority after customizing.
 Check that some mail is marked as primary after MAIL is edited."
   (let* ((rec ebdb-customization-record)
-        (all-mails (remove mail (ebdb-record-mail rec)))
+        (all-mails (remove mail (ebdb-record-mail rec t)))
         (primaries (when rec (seq-filter
                               (lambda (m)
                                 (eq (slot-value m 'priority) 'primary))
@@ -2323,21 +2323,25 @@ the record to be displayed or nil otherwise."
 ;;;###autoload
 (defun ebdb-mail (records &optional subject arg)
   "Compose a mail message to RECORDS (optional: using SUBJECT).
-If ARG (interactively, the prefix arg) is nil, use the first mail
-address of each record.  If it is t, prompt the user for which
-address to use.
+If ARG (interactively, the prefix arg) is nil, use the primary
+mail address of each record.  If it is t, prompt the user for
+which address to use.
 
 Another approach is to put point on a mail field and press \"a\",
 for `ebdb-field-action'."
   (interactive (list (ebdb-do-records) nil
-                     (or (consp current-prefix-arg)
-                         current-prefix-arg)))
+                     current-prefix-arg))
   (setq records (ebdb-record-list records))
-  (let ((to (mapconcat
-            (lambda (r) (ebdb-dwim-mail r (when arg (ebdb-prompt-for-mail r))))
-            records ", ")))
-    (unless (string= "" to)
-      (ebdb-compose-mail to subject))))
+  (if (= 1 (length records))
+      (let ((mail (ebdb-record-one-mail (car records) arg)))
+       (unless mail (error "Record has no mail address"))
+       (ebdb-field-mail-compose (car records) mail subject))
+   (let ((to (mapconcat
+             (lambda (r) (ebdb-dwim-mail
+                          r (ebdb-record-one-mail r arg)))
+             records ", ")))
+     (unless (string= "" to)
+       (ebdb-compose-mail to subject)))))
 
 ;;; Citing
 
@@ -2548,7 +2552,7 @@ as part of the MUA insinuation."
         (let ((completion-list (if (eq t ebdb-completion-list)
                                    '(name alt-names mail aka organization)
                                  ebdb-completion-list))
-              (mails (ebdb-record-mail one-record t))
+              (mails (ebdb-record-mail one-record))
               mail elt)
           (if (not mails)
               (progn
@@ -2610,7 +2614,7 @@ as part of the MUA insinuation."
           ;; Add it if the mail is part of the completions
           (dolist (key all-completions)
             (dolist (record (gethash key ebdb-hashtable))
-              (let ((mails (ebdb-record-mail record t))
+              (let ((mails (ebdb-record-mail record))
                     accept)
                 (when mails
                   (dolist (field completion-list)
@@ -2668,7 +2672,7 @@ as part of the MUA insinuation."
         (if (and record
                  (setq dwim-completions
                        (mapcar (lambda (m) (ebdb-dwim-mail record m))
-                               (ebdb-record-mail record t))))
+                               (ebdb-record-mail record))))
             (cond ((and (= 1 (length dwim-completions))
                         (string= orig (car dwim-completions)))
                    (setq done 'unchanged))
@@ -2991,9 +2995,7 @@ With prefix argument ARG, prompt for which mail address 
to use."
                     current-prefix-arg))
   (let* (mail-list mail result)
     (dolist (r records)
-      (setq mail (if arg
-              (ebdb-prompt-for-mail r)
-              (car-safe (ebdb-record-mail r t))))
+      (setq mail (ebdb-record-one-mail r arg))
       (when mail
        (push (cons r mail) mail-list)))
     (setq result
diff --git a/ebdb-complete.el b/ebdb-complete.el
index 66c9a9b..e293199 100644
--- a/ebdb-complete.el
+++ b/ebdb-complete.el
@@ -105,7 +105,7 @@ For use in `completion-at-point-functions'."
       (message "No records")
     (let ((to (mapconcat
                (lambda (r)
-                 (ebdb-dwim-mail r (when arg (ebdb-prompt-for-mail r))))
+                 (ebdb-dwim-mail r (ebdb-record-one-mail r arg)))
                records ", "))
           (buffer (gethash :buffer ebdb-complete-info)))
       (when buffer
diff --git a/ebdb-mua.el b/ebdb-mua.el
index d8f0b4f..dd70f79 100644
--- a/ebdb-mua.el
+++ b/ebdb-mua.el
@@ -894,7 +894,7 @@ Return the records matching ADDRESS or nil."
                                    (format "Change name \"%s\" to \"%s\"? "
                                            old-name name)
                                  (format "Assign name \"%s\" to address 
\"%s\"? "
-                                         name (car (ebdb-record-mail 
record)))))
+                                         name (ebdb-record-one-mail record))))
                ;; Keep old-name as AKA?
                (when (and old-name
                          ;; Leaky abstraction
@@ -1250,7 +1250,7 @@ buffer."
          (with-current-buffer buffer
             (delq nil
                   (mapcar (lambda (x)
-                           (when (setq mail (car (ebdb-record-mail (car x) t)))
+                           (when (setq mail (ebdb-record-one-mail (car x)))
                              (ebdb-dwim-mail (car x) mail)))
                           ebdb-records)))))
     (if (derived-mode-p 'message-mode 'mail-mode)
diff --git a/ebdb-test.el b/ebdb-test.el
index 9789348..282fad4 100644
--- a/ebdb-test.el
+++ b/ebdb-test.el
@@ -272,10 +272,10 @@ If it doesn't exist, raise `ebdb-related-unfound'."
          (mail2 (ebdb-parse ebdb-default-mail-class
                             "address@hidden")))
       (ebdb-record-insert-field rec mail)
-      (should (string= (ebdb-string (car (ebdb-record-mail rec)))
+      (should (string= (ebdb-string (ebdb-record-one-mail rec))
                       "address@hidden"))
       (ebdb-record-change-field rec mail mail2)
-      (should (string= (ebdb-string (car (ebdb-record-mail rec)))
+      (should (string= (ebdb-string (ebdb-record-one-mail rec))
                       "address@hidden")))))
 
 ;; Field instance parse tests.
diff --git a/ebdb.el b/ebdb.el
index 07c7e3c..817ecc4 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -3033,7 +3033,7 @@ If FIELD doesn't specify a year, use the current year."
   "Possibly set the priority of a newly-added mail address.
 If RECORD has no other primary mail, set MAIL's priority to
 primary."
-  (when (null (object-assoc 'primary 'priority (ebdb-record-mail record t)))
+  (when (null (ebdb-record-one-mail record nil 'primary-only))
     (setf (slot-value mail 'priority) 'primary)))
 
 (cl-defmethod ebdb-record-delete-field :after ((record ebdb-record-entity)
@@ -3042,26 +3042,36 @@ primary."
   "Possibly alter the priority of RECORD's remaining mails.
 If there aren't any other primary mails, make the first of the
 remaining mails primary."
-  (let* ((mails (remove mail (ebdb-record-mail record)))
+  (let* ((mails (remove mail (ebdb-record-mail record t)))
         (clone (unless (object-assoc 'primary 'priority mails)
                  (when (car mails)
                    (clone (car mails) :priority 'primary)))))
     (when clone
       (ebdb-record-change-field record (car mails) clone))))
 
-(defun ebdb-compose-mail (&rest args)
-  "Start composing a mail message to send.
-ARGS is passed to `compose-mail'."
-  (apply 'compose-mail args))
-
-(cl-defmethod ebdb-field-mail-compose ((record ebdb-record-entity)
-                                      (mail ebdb-field-mail))
-  (ebdb-compose-mail (ebdb-dwim-mail record mail)))
-
-(cl-defmethod ebdb-record-primary-mail ((record ebdb-record-entity))
-  "Return the primary mail field of RECORD."
-  (let ((mails (ebdb-record-mail record t)))
-    (object-assoc 'primary 'priority mails)))
+(cl-defgeneric ebdb-compose-mail (records &rest args)
+  "Prepare to compose a mail message to RECORDS.
+Mail-sending MUAs can override this method to do extra setup
+before/after message composition, by using a &context specializer
+on eg. the value of `read-mail-command'.  The default
+implementation turns RECORDS in a string of mail addresses, then
+passes that along with ARGS to `compose-mail'.")
+
+(cl-defmethod ebdb-compose-mail ((records list) &rest args)
+  (let ((to (mapconcat #'ebdb-dwim-mail records ", ")))
+    (ebdb-compose-mail to args)))
+
+(cl-defmethod ebdb-compose-mail ((to string) &rest args)
+  (apply #'compose-mail to args))
+
+(cl-defgeneric ebdb-field-mail-compose (record mail &rest args)
+  "Begin composing a message to RECORD's mail field MAIL.
+ARGS are passed to `ebdb-compose-mail', and then to
+`compose-mail'."
+  (:method ((record ebdb-record-entity)
+           (mail ebdb-field-mail)
+           &rest args)
+          (apply #'ebdb-compose-mail (ebdb-dwim-mail record mail) args)))
 
 ;; This needs to be a :before method so that the 'address slot is
 ;; filled by the time we call `ebdb-init-field'.
@@ -3072,7 +3082,7 @@ ARGS is passed to `compose-mail'."
   address to use with it."
   (unless (and (slot-boundp field 'address)
               (slot-value field 'address))
-   (let ((mail (ebdb-prompt-for-mail record)))
+   (let ((mail (ebdb-record-one-mail record t)))
      (when mail
       (setf (slot-value field 'address) mail)))))
 
@@ -3389,7 +3399,7 @@ Currently only works for mail fields."
     (dolist (r roles)
       (when (and (string= (slot-value r 'org-uuid) (ebdb-record-uuid org))
                 org-domain)
-       (dolist (m (ebdb-record-mail record))
+       (dolist (m (ebdb-record-mail record t))
          (setq mail-domain (cadr (split-string (slot-value m 'mail) "@")))
          (when (and mail-domain
                     (string-match-p mail-domain
@@ -4193,18 +4203,33 @@ prompting if there's only one database."
                              t))
       (object-assoc db-string 'label collection))))
 
-(defun ebdb-prompt-for-mail (record)
-  "Prompt for one of RECORD's mail addresses.
-If RECORD only has one address, return that directly."
-  (let ((mail-alist (mapcar
-                    (lambda (m) (cons (ebdb-string m) m))
-                    (ebdb-record-mail record t))))
-    (cdr (if (= 1 (length mail-alist))
-            (car mail-alist)
-          (assoc (ebdb-read-string
-                  (format "Mail address for %s: " (ebdb-string record))
-                  nil mail-alist t)
-                 mail-alist)))))
+(defun ebdb-record-one-mail (record &optional
+                                   prompt primary-only no-roles defunct)
+  "Return a single mail address to use for RECORD.
+If RECORD only has one address, return that directly.  If PROMPT
+is non-nil, ask the user which address to use.  Otherwise, return
+the record's primary address, or the first of the list of
+addresses, if none are primary.  If PRIMARY-ONLY is non-nil,
+return nil if RECORD has no primary address.  NO-ROLES and
+DEFUNCT function as in `ebdb-record-mail'."
+  (let ((mails (ebdb-record-mail record no-roles nil defunct)))
+    (when mails
+      (cond
+       ((= 1 (length mails))
+       (car mails))
+       (prompt
+       (let ((mail-alist (mapcar
+                          (lambda (m) (cons (ebdb-string m) m))
+                          mails)))
+         (cdr (assoc (ebdb-read-string
+                      (format "Mail address for %s: "
+                              (ebdb-string record))
+                      nil mail-alist t)
+                     mail-alist))))
+       (primary-only
+       (object-assoc 'primary 'priority mails))
+       (t (or (object-assoc 'primary 'priority mails)
+             (car mails)))))))
 
 (defun ebdb-dirty-records (&optional records)
   "Return all records with unsaved changes.
@@ -4242,14 +4267,14 @@ If RECORDS are given, only search those records."
        (object-assoc label 'label phones)
       phones)))
 
-(defun ebdb-record-mail (record &optional roles label defunct)
+(defun ebdb-record-mail (record &optional no-roles label defunct)
   "Return a list of all RECORD's mail fields.
-If ROLES is non-nil, also consider mail fields from RECORD's
-roles.  If LABEL is a string, return the mail with that label.
-If DEFUNCT is non-nil, also consider RECORD's defunct mail
+If NO-ROLES is non-nil, exclude mail fields from RECORD's roles.
+If LABEL is a string, return the mail with that label.  If
+DEFUNCT is non-nil, also consider RECORD's defunct mail
 addresses."
   (let ((mails (slot-value record 'mail)))
-    (when (and roles (slot-exists-p record 'organizations))
+    (when (and (null no-roles) (slot-exists-p record 'organizations))
       (dolist (r (slot-value record 'organizations))
        (when (and (slot-value r 'mail)
                   (or defunct
@@ -4272,15 +4297,13 @@ addresses."
 However, if both the first name and last name are constituents of
 the address as in address@hidden, and
 `ebdb-mail-avoid-redundancy' is non-nil, then the address is used
-as is.  If `ebdb-mail-avoid-redundancy' is 'mail-only the name
-is never included.  MAIL may be a mail address to be used for
-RECORD.  If MAIL is an integer, use the MAILth mail address of
-RECORD.  If MAIL is nil use RECORD's primary mail address."
-  (unless mail
-    (let ((mails (ebdb-record-mail record t)))
-      (setq mail (or (and (integerp mail) (nth mail mails))
-                     (object-assoc 'primary 'priority mails)
-                    (car mails)))))
+as is.  If `ebdb-mail-avoid-redundancy' is 'mail-only the name is
+never included.  MAIL may be a mail address to be used for
+RECORD.  If MAIL is nil use RECORD's primary mail address.  If
+MAIL is the symbol `prompt', prompt the user for a mail address
+to use."
+  (unless (ebdb-field-mail-p mail)
+    (setq mail (ebdb-record-one-mail record (eq mail 'prompt) t t)))
   (unless mail (error "Record has no mail addresses"))
   (let* ((name-base (or (slot-value mail 'aka) (ebdb-record-name record)))
         (mail (slot-value mail 'mail))
@@ -4819,7 +4842,7 @@ also be one of the special symbols below.
        ((eq field 'mail-canon) (ebdb-record-mail-canon record)) ; derived 
(cached) field
        ;; Mail is special-cased, because mail addresses can come from
        ;; more than one slot.
-       ((eq field 'mail) (ebdb-record-mail record t nil t))
+       ((eq field 'mail) (ebdb-record-mail record nil nil t))
        ((eq field 'mail-aka) (ebdb-record-mail-aka record)) ; derived (cached) 
field
        ((eq field 'aka-all)  (append (ebdb-record-aka record) ; derived field
                                      (ebdb-record-mail-aka record)))
@@ -5022,7 +5045,7 @@ inserting it."
        (style (if arg 'list 'inline))
        usable str m)
     (dolist (r recs)
-      (when (setq m (ebdb-record-mail r t))
+      (when (setq m (ebdb-record-mail r))
        (push (cons r (or (object-assoc 'primary 'priority m)
                          (car m)))
              usable)))
@@ -5383,7 +5406,7 @@ values, by default the search is not handed to the name 
field itself."
 (cl-defmethod ebdb-record-search ((record ebdb-record-entity)
                                  (_type (subclass ebdb-field-mail))
                                  (regexp string))
-  (let ((mails (ebdb-record-mail record t nil t)))
+  (let ((mails (ebdb-record-mail record nil nil t)))
     (if mails
        (or (string-match-p regexp "")
            (catch 'found