[elpa] externals/ebdb 5910db7 065/350: Restore mail alias functionality

[Eric Abrahamsen]

branch: externals/ebdb
commit 5910db74eb498302560a44e0829bd526200c7aa1
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Restore mail alias functionality
    
    Closes #7
    
    * ebdb.el (ebdb-field-mail-alias): Expand mail alias field definition.
      Field instances now hold the specific address to use when expanding
      the alias.
      (ebdb-mail-alias-alist): New defvar holding mail alias information.
      As alias fields are created and deleted, this variable is changed.
    * ebdb-com.el (ebdb-mail-aliases): Rework this function to read the
      above variable.
    
    Deleted functions and variables: ebdb-mail-alias-list,
    ebdb-add-mail-alias, ebdb-mail-aliases-need-rebuilt,
    ebdb-mail-alias-field, ebdb-mail-alias.
---
 ebdb-com.el | 266 ++++++++++++++----------------------------------------------
 ebdb.el     |  97 ++++++++++++++--------
 2 files changed, 121 insertions(+), 242 deletions(-)

diff --git a/ebdb-com.el b/ebdb-com.el
index e9afcf6..ec66793 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -865,7 +865,6 @@ If DELETE-P is non-nil RECORD is removed from the EBDB 
buffers."
      ["Send mail" ebdb-mail t]
      ["Save mail address" ebdb-mail-address t]
      "--"
-     ["Add mail alias" ebdb-add-mail-alias t]
      ["(Re-)Build mail aliases" ebdb-mail-aliases t])
     ("Use database"
      ["Send mail" ebdb-mail t]
@@ -2607,212 +2606,67 @@ If we are past `fill-column', wrap at the previous 
comma."
 
 ;;; interface to mail-abbrevs.el.
 
-;; Just stub this out for now.
 ;;;###autoload
-(defun ebdb-mail-aliases (&optional _force-rebuilt _noisy)
-  t)
-;; (defun ebdb-mail-aliases (&optional force-rebuilt noisy)
-;;   "Define mail aliases for the records in the database.
-;; Define a mail alias for every record that has a `mail-alias' field
-;; which is the contents of that field.
-;; If there are multiple comma-separated words in the `mail-alias' field,
-;; then all of those words will be defined as aliases for that person.
-
-;; If multiple records in the database have the same mail alias,
-;; then that alias expands to a comma-separated list of the mail addresses
-;; of all of these people.
-;; Add this command to `mail-setup-hook'.
-
-;; Mail aliases are (re)built only if `ebdb-mail-aliases-need-rebuilt' is 
non-nil
-;; because the database was newly loaded or it has been edited.
-;; Rebuilding the aliases is enforced if prefix FORCE-REBUILT is t."
-;;   (interactive (list current-prefix-arg t))
-;;   ;; Build `mail-aliases' if not yet done.
-;;   ;; Note: `mail-abbrevs-setup' rebuilds the mail-aliases only if
-;;   ;; `mail-personal-alias-file' has changed.  So it would not do anything
-;;   ;; if we want to rebuild the mail-aliases because of changes in EBDB.
-;;   (if (or force-rebuilt (eq t mail-aliases)) (build-mail-aliases))
-
-;;   ;; We should be cleverer here and instead of rebuilding all aliases
-;;   ;; we should just do what's necessary, i.e. remove deleted records
-;;   ;; and add new records
-;;   ;; Calling `ebdb-records' can change `ebdb-mail-aliases-need-rebuilt'
-;;   (let ((records (ebdb-search (ebdb-records) nil nil nil
-;;                               (cons ebdb-mail-alias-field ".")))
-;;         results match)
-;;     (if (not (or force-rebuilt ebdb-mail-aliases-need-rebuilt))
-;;         (if noisy (message "EBDB mail alias: nothing to do"))
-;;       (setq ebdb-mail-aliases-need-rebuilt nil)
-
-;;       ;; collect an alist of (alias rec1 [rec2 ...])
-;;       (dolist (record records)
-;;         (if (ebdb-record-mail record)
-;;             (dolist (alias (ebdb-record-xfield-split record 
ebdb-mail-alias-field))
-;;               (if (setq match (assoc alias results))
-;;                   ;; If an alias appears more than once, we collect all 
records
-;;                   ;; that refer to it.
-;;                   (nconc match (list record))
-;;                 (push (list alias record) results)))
-;;           (unless ebdb-silent
-;;             (ebdb-warn "record %S has no mail address, but the aliases: %s"
-;;                        (ebdb-record-name record)
-;;                        (ebdb-record-xfield record ebdb-mail-alias-field))
-;;             (sit-for 1))))
-
-;;       ;; Iterate over the results and create the aliases
-;;       (dolist (result results)
-;;         (let* ((aliasstem (car result))
-;;                (expansions
-;;                 (if (cddr result)
-;;                     ;; for group aliases we just take all the primary mails
-;;                     ;; and define only one expansion!
-;;                     (list (mapconcat (lambda (record) (ebdb-dwim-mail 
record))
-;;                                      (cdr result) 
mail-alias-separator-string))
-;;                   ;; this is an alias for a single person so deal with it
-;;                   ;; according to `ebdb-mail-alias'
-;;                   (let* ((record (nth 1 result))
-;;                          (mails (ebdb-record-mail record)))
-;;                     (if (or (eq 'first ebdb-mail-alias)
-;;                             (not (cdr mails)))
-;;                         ;; Either we want to define only one alias for
-;;                         ;; the first mail address or there is anyway
-;;                         ;; only one address.  In either case, we take
-;;                         ;; take only the first address.
-;;                         (list (ebdb-dwim-mail record (car mails)))
-;;                       ;; We need to deal with more than one mail address...
-;;                       (let* ((all (mapcar (lambda (m) (ebdb-dwim-mail 
record m))
-;;                                           mails))
-;;                              (star (ebdb-concat mail-alias-separator-string 
all)))
-;;                         (if (eq 'star ebdb-mail-alias)
-;;                             (list star (car all))
-;;                           ;; if `ebdb-mail-alias' is 'all, we create
-;;                           ;; two aliases for the primary mail address
-;;                           (cons star (cons (car all) all))))))))
-;;                (count -1) ; n=-1: <alias>*;  n=0: <alias>;  n>0: <alias>n
-;;                (len (length expansions))
-;;                alias f-alias)
-
-;;           ;; create the aliases for each expansion
-;;           (dolist (expansion expansions)
-;;             (cond ((or (= 1 len)
-;;                        (= count 0))
-;;                    (setq alias aliasstem))
-;;                   ((= count -1) ;; all the mails of a record
-;;                    (setq alias (concat aliasstem "*")))
-;;                   (t ;; <alias>n for each mail of a record
-;;                    (setq alias (format "%s%s" aliasstem count))))
-;;             (setq count (1+ count))
-
-;;             (add-to-list 'mail-aliases (cons alias expansion))
-
-;;             (define-mail-abbrev alias expansion)
-;;             (unless (setq f-alias (intern-soft (downcase alias) 
mail-abbrevs))
-;;               (error "Cannot find the alias"))
-
-;;             ;; `define-mail-abbrev' initializes f-alias to be
-;;             ;; `mail-abbrev-expand-hook'. We replace this by
-;;             ;; `ebdb-mail-abbrev-expand-hook'
-;;             (unless (eq (symbol-function f-alias) 'mail-abbrev-expand-hook)
-;;               (error "mail-aliases contains unexpected hook %s"
-;;                      (symbol-function f-alias)))
-;;             ;; `ebdb-mail-abbrev-hook' is called with mail addresses 
instead of
-;;             ;; ebdb records to avoid keeping pointers to records, which 
would
-;;             ;; lose if the database was reverted.
-;;             ;; `ebdb-mail-abbrev-hook' uses `ebdb-message-search' to convert
-;;             ;; these mail addresses to records, which is plenty fast.
-;;             ;; FIXME: The value of arg MAILS for `ebdb-mail-abbrev-hook'
-;;             ;; is wrong. Currently it is based on the list of records that 
have
-;;             ;; referenced ALIASTEM and we simply take the first mail address
-;;             ;; from each of these records.
-;;             ;; Then `ebdb-message-search' will find the correct records
-;;             ;; (assuming that each mail address appears only once in the
-;;             ;; database).  Nonethless, arg MAILS for `ebdb-mail-abbrev-hook'
-;;             ;; does not, in general, contain the actual mail addresses
-;;             ;; of EXPANSION.  So what we would need is to go back from
-;;             ;; EXPANSION to the mail addresses it contains (which is tricky
-;;             ;; because mail addresses in the database can be shortcuts for
-;;             ;; the addresses in EXPANSION).
-;;             (fset f-alias `(lambda ()
-;;                              (ebdb-mail-abbrev-expand-hook
-;;                               ,alias
-;;                               ',(mapcar (lambda (r) (car (ebdb-record-mail 
r)))
-;;                                         (cdr result))))))))
-
-;;       (if noisy (message "EBDB mail alias: rebuilding done")))))
-
-;; (defun ebdb-mail-abbrev-expand-hook (alias mails)
-;;   (run-hook-with-args 'ebdb-mail-abbrev-expand-hook alias mails)
-;;   (mail-abbrev-expand-hook)
-;;   (when ebdb-completion-display-record
-;;     (let ((ebdb-silent-internal t))
-;;       (ebdb-display-records
-;;        (apply 'append
-;;               (mapcar (lambda (mail) (ebdb-message-search nil mail)) mails))
-;;        nil t))))
-
-;; (defun ebdb-get-mail-aliases ()
-;;   "Return a list of mail aliases used in the EBDB."
-;;   (let ((records (ebdb-search (ebdb-records) nil nil nil
-;;                               (cons ebdb-mail-alias-field ".")))
-;;         result)
-;;     (dolist (record records result)
-;;       (dolist (alias (ebdb-record-xfield-split record 
ebdb-mail-alias-field))
-;;         (add-to-list 'result alias)))))
-
-;; ;;;###autoload
-;; (defsubst ebdb-mail-alias-list (alias)
-;;   (if (stringp alias)
-;;       (ebdb-split ebdb-mail-alias-field alias)
-;;     alias))
-
-;; (defun ebdb-add-mail-alias (records &optional alias delete)
-;;   "Add ALIAS to RECORDS.
-;; If prefix DELETE is non-nil, remove ALIAS from RECORDS.
-;; Arg ALIAS is ignored if list RECORDS contains more than one record.
-;; Instead read ALIAS interactively for each record in RECORDS.
-;; If the function `ebdb-init-mail-alias' is defined, it is called with
-;; one arg RECORD to define the default value for ALIAS of RECORD."
-;;   (interactive (list (ebdb-do-records) nil current-prefix-arg))
-;;   (ebdb-editable)
-;;   (setq records (ebdb-record-list records))
-;;   (if (< 1 (length records)) (setq alias nil))
-;;   (let* ((tmp (intern-soft
-;;                (concat "ebdb-init-" (symbol-name ebdb-mail-alias-field))))
-;;          (init-f (if (functionp tmp) tmp)))
-;;     (dolist (record records)
-;;       (let ((r-a-list (ebdb-record-xfield-split record 
ebdb-mail-alias-field))
-;;             (alias alias)
-;;             a-list)
-;;         (if alias
-;;             (setq a-list (ebdb-mail-alias-list alias))
-;;           (when init-f
-;;             (setq a-list (ebdb-mail-alias-list (funcall init-f record))
-;;                   alias (if a-list (ebdb-concat ebdb-mail-alias-field 
a-list))))
-;;           (let ((crm-separator
-;;                  (concat "[ \t\n]*"
-;;                          (cadr (assq ebdb-mail-alias-field 
ebdb-separator-alist))
-;;                          "[ \t\n]*"))
-;;                 (crm-local-completion-map ebdb-crm-local-completion-map)
-;;                 (prompt (format "%s mail alias:%s " (if delete "Remove" 
"Add")
-;;                                 (if alias (format " (default %s)" alias) 
"")))
-;;                 (collection (if delete
-;;                                 (or r-a-list (error "Record has no alias"))
-;;                               (ebdb-get-mail-aliases))))
-;;             (setq a-list (if (string< "24.3" (substring emacs-version 0 4))
-;;                              (completing-read-multiple prompt collection nil
-;;                                                        delete nil nil alias)
-;;                           (ebdb-split ebdb-mail-alias-field
-;;                                       (completing-read prompt collection nil
-;;                                                        delete nil nil 
alias))))))
-;;         (dolist (a a-list)
-;;           (if delete
-;;               (setq r-a-list (delete a r-a-list))
-;;             ;; Add alias only if it is not there yet
-;;             (add-to-list 'r-a-list a)))
-;;         ;; This also handles `ebdb-mail-aliases-need-rebuilt'
-;;         (ebdb-record-set-xfield record ebdb-mail-alias-field
-;;                                 (ebdb-concat ebdb-mail-alias-field 
r-a-list))
-;;         (ebdb-change-record record)))))
+(defun ebdb-mail-aliases (&optional noisy)
+  "Add aliases from the database to the global alias table.
+
+Give records a \"mail alias\" field to define an alias for that
+record.
+
+If multiple records in the database have the same mail alias,
+then that alias expands to a comma-separated list of the mail addresses
+of all of these people."
+  (interactive)
+
+  ;; Build `mail-aliases' if not yet done.
+  (when (eq t mail-aliases) (build-mail-aliases))
+
+  ;; Create the aliases from `ebdb-mail-alias-alist'.
+  (dolist (entry ebdb-mail-alias-alist)
+    (let* ((alias (car entry))
+          (expansion
+           (mapconcat
+            (lambda (e)
+              (ebdb-dwim-mail (if (stringp (car e))
+                                  (ebdb-gethash e 'uuid)
+                                (car e))
+                              (second e)))
+            (cdr entry) ", "))
+          f-alias)
+
+      (add-to-list 'mail-aliases (cons alias expansion))
+
+      (define-mail-abbrev alias expansion)
+      (unless (setq f-alias (intern-soft (downcase alias) mail-abbrevs))
+       (error "Cannot find the alias"))
+
+      ;; `define-mail-abbrev' initializes f-alias to be
+      ;; `mail-abbrev-expand-hook'.  We replace this with
+      ;; `ebdb-mail-abbrev-expand-hook'
+      (unless (eq (symbol-function f-alias) 'mail-abbrev-expand-hook)
+       (error "mail-aliases contains unexpected hook %s"
+              (symbol-function f-alias)))
+      (fset f-alias `(lambda ()
+                      (ebdb-mail-abbrev-expand-hook
+                       ,alias
+                       ',(mapcar (lambda (r) (ebdb-record-uuid (car r)))
+                                 (cdr entry)))))))
+
+  (if noisy (message "EBDB mail alias: rebuilding done")))
+
+(defun ebdb-mail-abbrev-expand-hook (alias records)
+;  (run-hook-with-args 'ebdb-mail-abbrev-expand-hook alias records)
+  (mail-abbrev-expand-hook)
+  (when ebdb-completion-display-record
+    (let ((ebdb-silent-internal t))
+      (ebdb-display-records
+       (delq nil
+            (mapcar (lambda (u) (ebdb-gethash u 'uuid)) records))
+       nil t))))
+
+(defun ebdb-get-mail-aliases ()
+  "Return a list of mail aliases used in the EBDB."
+  (mapcar #'car ebdb-mail-alias-alist))
 
 ;;; Actions
 
diff --git a/ebdb.el b/ebdb.el
index d41a32f..6571431 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -96,9 +96,6 @@ You really should not disable debugging.  But it will speed 
things up."))
 (defvar ebdb-version-date "October 15, 2016"
   "Date this version of EBDB was released.")
 
-(defvar ebdb-mail-aliases-need-rebuilt nil
-  "Non-nil if mail aliases need to be rebuilt.")
-
 (defvar ebdb-silent-internal nil
   "Bind this to t to quiet things down - do not set it.
 See also `ebdb-silent'.")
@@ -1575,11 +1572,21 @@ override parsing."
 (cl-defmethod ebdb-string ((field ebdb-field-url))
   (slot-value field 'url))
 
-;;; Fields that change EBDB's behavior.  Right now we've got
-;;; `ebdb-mail-name' and the hard-coded 'name-format xfield that are
-;;; meant to change a record's behavior.  I'm not convinced that
-;;; that's the best way to handle that.  At the very least we need
-;;; mail aliases, though.
+;;; Fields that change EBDB's behavior.
+
+;;; Mail aliases
+
+;; As alias fields are initialized or deleted, they modify
+;; `ebdb-mail-alias-alist', which is read by `ebdb-mail-aliases'
+;; later.
+
+(defvar ebdb-mail-alias-alist nil
+  "An alist holding all alias definitions from EBDB.
+
+Each element looks like: (alias (rec1 addr1) (rec2 addr2) ...).
+
+Instead of actual records, the rec1, rec2 elements can also be
+record uuids.")
 
 (defclass ebdb-field-mail-alias (ebdb-field-user)
   ((alias
@@ -1587,19 +1594,44 @@ override parsing."
     :initarg :alias
     :custom string
     :documentation
-    "A string used as a mail alias for this record."))
-  :human-readable "mail alias")
+    "A mail alias for this record.")
+   (address
+    :type (or null ebdb-field-mail)
+    :initarg :address
+    :documentation. "The mail address to use with this record."))
+  :human-readable "mail alias"
+  :documentation "A field holding a single mail alias for a
+  record.  The field holds the alias string, and an optional
+  mail address to use with that alias.")
 
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-mail-alias)) &optional 
slots obj)
-  (let ((alias (ebdb-read-string "Alias: " (when obj (slot-value obj 
'alias)))))
+  (let ((alias (ebdb-read-string "Alias: " (when obj (car (slot-value obj 
'alias)))
+                                (mapcar #'car ebdb-mail-alias-alist))))
     (cl-call-next-method class (plist-put slots :alias alias) obj)))
 
 (cl-defmethod ebdb-string ((field ebdb-field-mail-alias))
-  (slot-value field 'alias))
-
-;; TODO: Write `ebdb-init-field' and `ebdb-delete-field' methods for
-;; the `ebdb-field-mail-alias' class.  These methods should do the
-;; work of changing the defined mail aliases.
+  (with-slots (alias address) field
+    (format (if address
+               "%s: %s"
+             "%s")
+           alias (ebdb-string address))))
+
+(cl-defmethod ebdb-init-field ((field ebdb-field-mail-alias) &optional record)
+  (with-slots (alias address) field
+    (let ((existing (assoc alias ebdb-mail-alias-alist)))
+      (if existing
+         (setcdr existing (cons (list record address) (cdr existing)))
+       (push (list alias (list record address)) ebdb-mail-alias-alist)))))
+
+(cl-defmethod ebdb-delete-field ((field ebdb-field-mail-alias)
+                                &optional record unload)
+  (with-slots (alias address) field
+    (let* ((existing (assoc alias ebdb-mail-alias-alist))
+          (entry (assq record (cdr-safe existing))))
+      (if entry
+         (setcdr existing (remove entry (cdr existing)))
+       (setq ebdb-mail-alias-alist
+             (delq existing ebdb-mail-alias-alist))))))
 
 ;; Passports
 
@@ -2161,6 +2193,19 @@ priority."
              (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)
+                                              _slot
+                                              (field ebdb-field-mail-alias))
+  "After inserting a new alias field, prompt the user for which
+  address to use with it."
+  (unless (and (slot-boundp field 'address)
+              (slot-value field 'address))
+   (let ((mail (ebdb-prompt-for-mail record)))
+     (when mail
+      (setf (slot-value field 'address) mail)))))
+
 ;; TODO: There's no reason why the aka slot can't belong to
 ;; `ebdb-record-entity'.  In fact, what we ought to do is put both the
 ;; 'name and the 'aka slots on `ebdb-record-entity', and have both
@@ -3609,26 +3654,6 @@ for this record, these are formatted obeying 
`ebdb-mail-name-format'."
   :type '(choice (symbol :tag "xfield")
                  (function :tag "mail name function")))
 
-(defcustom ebdb-mail-alias-field 'mail-alias
-  "Xfield holding the mail alias for a record.
-Used by `ebdb-mail-aliases'.  See also `ebdb-mail-alias'."
-  :group 'ebdb-sendmail
-  :type 'symbol)
-
-(defcustom ebdb-mail-alias 'first
-  "Defines which mail aliases are generated for a EBDB record.
-first: Generate one alias \"<alias>\" that expands to the first mail address
-       of a record.
-star:  Generate a second alias \"<alias>*\" that expands to all mail addresses
-       of a record.
-all:   Generate the aliases \"<alias>\" and \"<alias>*\" (as for 'star)
-       and aliases \"<alias>n\" for each mail address, where n is the position
-       of the mail address of a record."
-  :group 'ebdb-sendmail
-  :type '(choice (symbol :tag "Only first" first)
-                 (symbol :tag "<alias>* for all mails" star)
-                 (symbol :tag "All aliases" all)))
-
 (defcustom ebdb-mail-avoid-redundancy nil
   "Mail address to use for EBDB records when sending mail.
 If non-nil do not use full name in mail address when same as mail.