[elpa] externals/ebdb 877510b 1/6: Be more lenient about finding records during MUA auto updating

[Eric Abrahamsen]

branch: externals/ebdb
commit 877510beb302a3fddb2ee5c1dca2eeeb5f4b235c
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Be more lenient about finding records during MUA auto updating
    
    * ebdb-mua.el (ebdb-annotate-message): The logic of ignoring
    mail-or-name seems backwards.  `mail-extract-address-components'
    always returns a mail string, so the first comment is wrong.  If it
    can't find a valid mail, it returns the same string as both the name
    and mail.  Therefore, in all cases I can think of, we should be
    ignoring the mail (not the name) if the strings are the same.
---
 ebdb-mua.el | 406 ++++++++++++++++++++++++++++++------------------------------
 1 file changed, 206 insertions(+), 200 deletions(-)

diff --git a/ebdb-mua.el b/ebdb-mua.el
index a5b38cf..f6ff490 100644
--- a/ebdb-mua.el
+++ b/ebdb-mua.el
@@ -913,206 +913,212 @@ a new record is created for ADDRESS.  UPDATE-P may take 
the values:
  a function     This functions will be called with no arguments.
                   It should return one of the above values.
 Return the records matching ADDRESS or nil."
-  (let* ((mail (nth 1 address))                ; possibly nil
-         (name (unless (equal mail (car address))
-                 (car address)))
-        (record-class (if (eql (nth 3 address) 'organization)
-                          'ebdb-record-organization
-                        ebdb-default-record-class))
-         (records (ebdb-message-search name mail))
-         created-p new-records)
-    (if (and (not records) (functionp update-p))
-        (setq update-p (funcall update-p)))
-    (cond ((eq t update-p) (setq update-p 'create))
-          ((not update-p) (setq update-p 'update)))
-
-    ;; Create a new record if nothing else fits.
-    ;; In this way, we can fill the slots of the new record with
-    ;; the same code that updates the slots of existing records.
-    (unless (or records
-                (eq update-p 'update)
-                (not (or name mail)))
-      ;; If there is no name, try to use the mail address as name
-      (if (and ebdb-message-mail-as-name mail
-              (or (null name)
-                   (string= "" name)))
-          (setq name (funcall ebdb-message-clean-name-function mail)))
-      (if (or (eq update-p 'create)
-              (and (eq update-p 'query)
-                   (y-or-n-p (format "%s is not in the EBDB.  Add? "
-                                     (or name mail)))))
-          (setq records (list (ebdb-db-add-record
-                              (car ebdb-db-list)
-                              (make-instance
-                               record-class)))
-                created-p t)))
-
-    (dolist (record records)
-      (let* ((old-name (ebdb-record-name record))
-             (mail mail) ;; possibly changed below
-             (created-p created-p)
-             (update-p update-p)
-             change-p add-mails add-name ignore-redundant)
-
-        ;; Analyze the name part of the record.
-        (cond (created-p               ; new record
-              (ebdb-record-change-name record name))
-
-              ((or (not name)
-                   ;; The following tests can differ for more complicated names
-                   (ebdb-string= name old-name)
-                   (ebdb-record-search record 'ebdb-field-name name)))
-
-              ((null (setq add-name (ebdb-add-job ebdb-add-name record 
name)))) ; do nothing
-
-
-              ((numberp add-name)
-              (unless ebdb-silent
-                 (message "name mismatch: \"%s\" changed to \"%s\""
-                          old-name name)
-                 (sit-for add-name)))
-
-              ((ebdb-eval-spec add-name
-                              (if old-name
-                                   (format "Change name \"%s\" to \"%s\"? "
-                                           old-name name)
-                                 (format "Assign name \"%s\" to address 
\"%s\"? "
-                                         name (ebdb-record-one-mail record))))
-              ;; Keep old-name as AKA?
-              (when (and old-name
-                         ;; Leaky abstraction
-                         (object-of-class-p record 'ebdb-record-person)
-                          (not (member-ignore-case old-name 
(ebdb-record-alt-names record))))
-                 (if (ebdb-eval-spec (ebdb-add-job ebdb-add-aka record 
old-name)
-                                     (format "Keep name \"%s\" as an AKA? " 
old-name))
-                     (ebdb-record-insert-field
-                      record (slot-value record 'name) 'aka)))
-              (ebdb-record-change-name record name)
-              (setq change-p 'name))
-
-              ;; make new name an AKA?
-              ((and old-name
-                   (object-of-class-p record 'ebdb-record-person)
-                    (not (member-ignore-case name (ebdb-record-alt-names 
record)))
-                    (ebdb-eval-spec (ebdb-add-job ebdb-add-aka record name)
-                                    (format "Make \"%s\" an alternate for 
\"%s\"? "
-                                            name old-name)))
-              (ebdb-record-insert-field
-                record (ebdb-parse 'ebdb-field-name name) 'aka)
-              (setq change-p 'name)))
-
-        ;; Is MAIL redundant compared with the mail addresses
-        ;; that are already known for RECORD?
-        (if (and mail
-                 (setq ignore-redundant
-                      (ebdb-add-job ebdb-ignore-redundant-mails record mail)))
-            (let ((mails (ebdb-record-mail-canon record))
-                  (case-fold-search t) redundant ml re)
-              (while (setq ml (pop mails))
-                (if (and (setq re (ebdb-mail-redundant-re ml))
-                         (string-match re mail))
-                    (setq redundant ml mails nil)))
-              (if redundant
-                  (cond ((numberp ignore-redundant)
-                         (unless ebdb-silent
-                           (message "%s: redundant mail `%s'"
-                                    (ebdb-string record) mail)
-                           (sit-for ignore-redundant)))
-                        ((or (eq t ignore-redundant)
-                             ebdb-silent
-                             (y-or-n-p (format "Ignore redundant mail %s? " 
mail)))
-                         (setq mail redundant))))))
-       (setq mail (make-instance ebdb-default-mail-class :mail mail))
-        ;; Analyze the mail part of the new records
-        (cond ((or (not mail) (equal (ebdb-string mail) "???")
-                   (member-ignore-case (ebdb-string mail) 
(ebdb-record-mail-canon record)))) ; do nothing
-
-              (created-p               ; new record
-              (ebdb-record-insert-field record mail 'mail))
-
-              ((not (setq add-mails (ebdb-add-job ebdb-add-mails record 
mail)))) ; do nothing
-
-              ((numberp add-mails)
-              (unless ebdb-silent
-                 (message "%s: new address `%s'"
-                          (ebdb-string record) (ebdb-string mail))
-                 (sit-for add-mails)))
-
-              ((or (eq add-mails t)    ; add it automatically
-                   ebdb-silent
-                   (y-or-n-p (format "Add address \"%s\" to %s? " (ebdb-string 
mail)
-                                     (ebdb-string record)))
-                   (and (or (and (functionp update-p)
-                                 (progn (setq update-p (funcall update-p)) 
nil))
-                            (memq update-p '(t create))
-                            (and (eq update-p 'query)
-                                 (y-or-n-p
-                                  (format "Create a new record for %s? "
-                                          (ebdb-string record)))))
-                        (progn
-                          (setq record (make-instance 
ebdb-default-record-class))
-                         (ebdb-db-add-record (car ebdb-db-list) record)
-                          (ebdb-record-change-name record name)
-                          (setq created-p t))))
-
-              (let ((mails (ebdb-record-mail record)))
-                 (if ignore-redundant
-                     ;; Does the new address MAIL make an old address 
redundant?
-                     (let ((mail-re (ebdb-mail-redundant-re (ebdb-string 
mail)))
-                           (case-fold-search t) okay redundant)
-                      (dolist (ml mails)
-                         (if (string-match mail-re (ebdb-string ml)) ; 
redundant mail address
-                             (push ml redundant)
-                           (push ml okay)))
-                      (let ((form (format "redundant mail%s %s"
-                                           (if (< 1 (length redundant)) "s" "")
-                                           (ebdb-concat 'mail (nreverse 
redundant))))
-                             (name (ebdb-record-name record)))
-                         (if redundant
-                             (cond ((numberp ignore-redundant)
-                                    (unless ebdb-silent
-                                      (message "%s: %s" name form)
-                                      (sit-for ignore-redundant)))
-                                   ((or (eq t ignore-redundant)
-                                        ebdb-silent
-                                        (y-or-n-p (format "Delete %s? " form)))
-                                    (if (eq t ignore-redundant)
-                                        (message "%s: deleting %s" name form))
-                                    (setq mails okay)))))))
-
-                 ;; then modify RECORD
-
-                ;; TODO: Reinstate the question about making this primary.
-                 (ebdb-record-insert-field record mail 'mail)
-                 (unless change-p (setq change-p t)))))
-
-        (cond (created-p
-              (unless ebdb-silent
-                 (if (ebdb-record-name record)
-                     (message "created %s's record with address \"%s\""
-                              (ebdb-string record)
-                             (ebdb-string mail))
-                   (message "created record with naked address \"%s\""
-                           (ebdb-string mail))))
-              (ebdb-init-record record))
-
-              (change-p
-              (unless ebdb-silent
-                 (cond ((eq change-p 'name)
-                        (message "noticed \"%s\"" (ebdb-string record)))
-                      ((ebdb-record-name record)
-                        (message "noticed %s's address \"%s\""
-                                 (ebdb-string record)
-                                (ebdb-string mail)))
-                      (t
-                        (message "noticed naked address \"%s\""
-                                (ebdb-string mail)))))))
-
-        (run-hook-with-args 'ebdb-notice-mail-hook record)
-
-        (push record new-records)))
-
-    (nreverse new-records)))
+  (pcase-let ((`(,name ,mail ,_header ,header-type ,_mode) address))
+    (let ((record-class (if (eql header-type 'organization)
+                           'ebdb-record-organization
+                         ebdb-default-record-class))
+          (records (ebdb-message-search
+                   name
+                   ;; If `mail-extract-address-components' can't find
+                   ;; a mail addres it returns two identical strings
+                   ;; (the name), I don't know why.  But when it
+                   ;; does, EBDB assumes the string is a valid mail
+                   ;; address and tries to find/add it.
+                   (unless (string= mail name)
+                     mail)))
+          created-p new-records)
+      (if (and (not records) (functionp update-p))
+          (setq update-p (funcall update-p)))
+      (cond ((eq t update-p) (setq update-p 'create))
+            ((not update-p) (setq update-p 'update)))
+
+      ;; Create a new record if nothing else fits.
+      ;; In this way, we can fill the slots of the new record with
+      ;; the same code that updates the slots of existing records.
+      (unless (or records
+                  (eq update-p 'update)
+                  (not (or name mail)))
+       ;; If there is no name, try to use the mail address as name
+       (if (and ebdb-message-mail-as-name mail
+                (or (null name)
+                     (string= "" name)))
+            (setq name (funcall ebdb-message-clean-name-function mail)))
+       (if (or (eq update-p 'create)
+               (and (eq update-p 'query)
+                     (y-or-n-p (format "%s is not in the EBDB.  Add? "
+                                       (or name mail)))))
+            (setq records (list (ebdb-db-add-record
+                                (car ebdb-db-list)
+                                (make-instance
+                                 record-class)))
+                  created-p t)))
+
+      (dolist (record records)
+       (let* ((old-name (ebdb-record-name record))
+               (mail mail) ;; possibly changed below
+               (created-p created-p)
+               (update-p update-p)
+               change-p add-mails add-name ignore-redundant)
+
+          ;; Analyze the name part of the record.
+          (cond (created-p             ; new record
+                (ebdb-record-change-name record name))
+
+               ((or (not name)
+                     ;; The following tests can differ for more complicated 
names
+                     (ebdb-string= name old-name)
+                     (ebdb-record-search record 'ebdb-field-name name)))
+
+               ((null (setq add-name (ebdb-add-job ebdb-add-name record 
name)))) ; do nothing
+
+
+               ((numberp add-name)
+                (unless ebdb-silent
+                   (message "name mismatch: \"%s\" changed to \"%s\""
+                            old-name name)
+                   (sit-for add-name)))
+
+               ((ebdb-eval-spec add-name
+                                (if old-name
+                                     (format "Change name \"%s\" to \"%s\"? "
+                                             old-name name)
+                                   (format "Assign name \"%s\" to address 
\"%s\"? "
+                                           name (ebdb-record-one-mail 
record))))
+                ;; Keep old-name as AKA?
+                (when (and old-name
+                           ;; Leaky abstraction
+                           (object-of-class-p record 'ebdb-record-person)
+                            (not (member-ignore-case old-name 
(ebdb-record-alt-names record))))
+                   (if (ebdb-eval-spec (ebdb-add-job ebdb-add-aka record 
old-name)
+                                       (format "Keep name \"%s\" as an AKA? " 
old-name))
+                       (ebdb-record-insert-field
+                       record (slot-value record 'name) 'aka)))
+                (ebdb-record-change-name record name)
+                (setq change-p 'name))
+
+               ;; make new name an AKA?
+               ((and old-name
+                     (object-of-class-p record 'ebdb-record-person)
+                      (not (member-ignore-case name (ebdb-record-alt-names 
record)))
+                      (ebdb-eval-spec (ebdb-add-job ebdb-add-aka record name)
+                                      (format "Make \"%s\" an alternate for 
\"%s\"? "
+                                              name old-name)))
+                (ebdb-record-insert-field
+                  record (ebdb-parse 'ebdb-field-name name) 'aka)
+                (setq change-p 'name)))
+
+          ;; Is MAIL redundant compared with the mail addresses
+          ;; that are already known for RECORD?
+          (if (and mail
+                   (setq ignore-redundant
+                        (ebdb-add-job ebdb-ignore-redundant-mails record 
mail)))
+              (let ((mails (ebdb-record-mail-canon record))
+                    (case-fold-search t) redundant ml re)
+               (while (setq ml (pop mails))
+                  (if (and (setq re (ebdb-mail-redundant-re ml))
+                           (string-match re mail))
+                      (setq redundant ml mails nil)))
+               (if redundant
+                    (cond ((numberp ignore-redundant)
+                           (unless ebdb-silent
+                             (message "%s: redundant mail `%s'"
+                                      (ebdb-string record) mail)
+                             (sit-for ignore-redundant)))
+                          ((or (eq t ignore-redundant)
+                               ebdb-silent
+                               (y-or-n-p (format "Ignore redundant mail %s? " 
mail)))
+                           (setq mail redundant))))))
+         (setq mail (make-instance ebdb-default-mail-class :mail mail))
+          ;; Analyze the mail part of the new records
+          (cond ((or (not mail) (equal (ebdb-string mail) "???")
+                     (member-ignore-case (ebdb-string mail) 
(ebdb-record-mail-canon record)))) ; do nothing
+
+               (created-p              ; new record
+                (ebdb-record-insert-field record mail 'mail))
+
+               ((not (setq add-mails (ebdb-add-job ebdb-add-mails record 
mail)))) ; do nothing
+
+               ((numberp add-mails)
+                (unless ebdb-silent
+                   (message "%s: new address `%s'"
+                            (ebdb-string record) (ebdb-string mail))
+                   (sit-for add-mails)))
+
+               ((or (eq add-mails t)   ; add it automatically
+                     ebdb-silent
+                     (y-or-n-p (format "Add address \"%s\" to %s? " 
(ebdb-string mail)
+                                       (ebdb-string record)))
+                     (and (or (and (functionp update-p)
+                                   (progn (setq update-p (funcall update-p)) 
nil))
+                              (memq update-p '(t create))
+                              (and (eq update-p 'query)
+                                   (y-or-n-p
+                                    (format "Create a new record for %s? "
+                                            (ebdb-string record)))))
+                          (progn
+                            (setq record (make-instance 
ebdb-default-record-class))
+                           (ebdb-db-add-record (car ebdb-db-list) record)
+                            (ebdb-record-change-name record name)
+                            (setq created-p t))))
+
+                (let ((mails (ebdb-record-mail record)))
+                   (if ignore-redundant
+                       ;; Does the new address MAIL make an old address 
redundant?
+                       (let ((mail-re (ebdb-mail-redundant-re (ebdb-string 
mail)))
+                             (case-fold-search t) okay redundant)
+                        (dolist (ml mails)
+                           (if (string-match mail-re (ebdb-string ml)) ; 
redundant mail address
+                               (push ml redundant)
+                             (push ml okay)))
+                        (let ((form (format "redundant mail%s %s"
+                                             (if (< 1 (length redundant)) "s" 
"")
+                                             (ebdb-concat 'mail (nreverse 
redundant))))
+                               (name (ebdb-record-name record)))
+                           (if redundant
+                               (cond ((numberp ignore-redundant)
+                                      (unless ebdb-silent
+                                       (message "%s: %s" name form)
+                                       (sit-for ignore-redundant)))
+                                     ((or (eq t ignore-redundant)
+                                          ebdb-silent
+                                          (y-or-n-p (format "Delete %s? " 
form)))
+                                      (if (eq t ignore-redundant)
+                                          (message "%s: deleting %s" name 
form))
+                                      (setq mails okay)))))))
+
+                   ;; then modify RECORD
+
+                  ;; TODO: Reinstate the question about making this primary.
+                   (ebdb-record-insert-field record mail 'mail)
+                   (unless change-p (setq change-p t)))))
+
+          (cond (created-p
+                (unless ebdb-silent
+                   (if (ebdb-record-name record)
+                       (message "created %s's record with address \"%s\""
+                               (ebdb-string record)
+                               (ebdb-string mail))
+                     (message "created record with naked address \"%s\""
+                             (ebdb-string mail))))
+                (ebdb-init-record record))
+
+               (change-p
+                (unless ebdb-silent
+                   (cond ((eq change-p 'name)
+                          (message "noticed \"%s\"" (ebdb-string record)))
+                        ((ebdb-record-name record)
+                          (message "noticed %s's address \"%s\""
+                                   (ebdb-string record)
+                                  (ebdb-string mail)))
+                        (t
+                          (message "noticed naked address \"%s\""
+                                  (ebdb-string mail)))))))
+
+          (run-hook-with-args 'ebdb-notice-mail-hook record)
+
+          (push record new-records)))
+
+      (nreverse new-records))))
 
 (cl-defmethod ebdb-mua-prepare-article ()
   "Do whatever preparations are necessary to work on records