branch: externals/ebdb
commit 03fcfaedf5745ef45c0d33df62d1305c0c9df5c8
Author: Eric Abrahamsen <e...@ericabrahamsen.net>
Commit: Eric Abrahamsen <e...@ericabrahamsen.net>
Allow permanent ignoring of mail addresses
* ebdb-mua.el (ebdb-permanent-ignores-file): New option specifying
where ignored mail addresses should be saved.
(ebdb-permanently-ignored-mails): Variable holding ignored addresses.
(ebdb-mua-load-permanent-ignores): Load addresses on
`ebdb-after-load-hook'.
(ebdb-mua-save-permanent-ignores): Save them on
`ebdb-after-save-hook'.
(ebdb-get-address-components): Ignore them here.
(ebdb-query-create): Give the user a new "i" option to ignore.
(ebdb-annotate-message): Add ignored messages to the list.
* ebdb.texi (Auto-Updating Records): Document.
---
ebdb-mua.el | 108 +++++++++++++++++++++++++++++++++++++++++++++---------------
ebdb.info | 102 +++++++++++++++++++++++++++++++++++---------------------
ebdb.org | 24 ++++++++++++++
ebdb.texi | 24 ++++++++++++++
4 files changed, 193 insertions(+), 65 deletions(-)
diff --git a/ebdb-mua.el b/ebdb-mua.el
index 5fb859c..a5b38cf 100644
--- a/ebdb-mua.el
+++ b/ebdb-mua.el
@@ -245,6 +245,50 @@ will not operate on your own record. See also
(const :tag "Use the value of `message-alternative-emails'"
message)
(regexp :tag "Regexp matching your mail addresses")))
+(defcustom ebdb-permanent-ignores-file
+ (locate-user-emacs-file ".ebdb-permanent-ignores")
+ "File in which to save a list of permanently-ignored mails.
+EBDB can offer to permanently ignore a mail address, so that it
+will never again be considered for record creation or update.
+This option specifies the file in which to save those mails, or
+nil not to permanently ignore any mail addresses.
+
+Ignored mails are written one per line, with no name or other
+leading/trailing characters."
+ :type '(choice (const :tag "do not save ignored mails" nil)
+ (file :tag "file in which to save ignored mails")))
+
+;; Maybe more efficient to make this a buffer instead of a list
+;; variable, and use `search-forward' to find mails instead of
+;; `member'?
+(defvar ebdb-permanently-ignored-mails nil
+ "Variable holding a list of permanently-ignored mails.")
+
+(defun ebdb-mua-load-permanent-ignores ()
+ "Load permanent ignores.
+Reads mail addresses to permanently ignore from the option
+`ebdb-permanent-ignores-file', and stores them in the variable
+`ebdb-permanently-ignored-mails'."
+ (when (and ebdb-permanent-ignores-file
+ (file-exists-p ebdb-permanent-ignores-file))
+ (with-temp-buffer
+ (insert-file-contents ebdb-permanent-ignores-file)
+ (when (null (zerop (buffer-size)))
+ (setq ebdb-permanently-ignored-mails
+ (split-string (buffer-string) "\n" t "[[:blank:]]"))))))
+
+(add-hook 'ebdb-after-load-hook #'ebdb-mua-load-permanent-ignores)
+
+(defun ebdb-mua-save-permanent-ignores ()
+ "Write the list of permanently-ignored mails to disk."
+ (when (and ebdb-permanent-ignores-file
+ ebdb-permanently-ignored-mails)
+ (with-temp-file ebdb-permanent-ignores-file
+ (dolist (m ebdb-permanently-ignored-mails)
+ (insert m "\n")))))
+
+(add-hook 'ebdb-after-save-hook #'ebdb-mua-save-permanent-ignores)
+
;; This is currently only called in `ebdb-mua-test-headers'.
(defun ebdb-get-user-mail-address-re ()
"Get or set the value of variable `ebdb-user-mail-address-re'.
@@ -678,7 +722,8 @@ are discarded as appropriate."
(let ((message-headers (if header-class
(list (assoc header-class ebdb-message-headers))
ebdb-message-headers))
- address-list mail mail-list content)
+ (mail-list (copy-sequence ebdb-permanently-ignored-mails))
+ address-list mail content)
(condition-case nil
(dolist (headers message-headers)
(dolist (header (cdr headers))
@@ -688,14 +733,14 @@ are discarded as appropriate."
(setq mail (cadr address))
;; Ignore addresses that should be ignored.
(when (and mail
- (not (member-ignore-case mail mail-list))
+ (not (member (downcase mail) mail-list))
(ebdb-mua-test-headers (car headers) address
ignore-address))
;; Add each address only once. (Use MAIL-LIST for book
keeping.)
;; Thus if we care about whether an address gets associated
with
;; one or another header, the order of elements in
;; `ebdb-message-headers' is relevant. The "most important"
;; headers should be first in `ebdb-message-headers'.
- (push mail mail-list)
+ (push (downcase mail) mail-list)
(push (list (car address) (cadr address) header (car headers)
major-mode) address-list))))))
(cl-no-applicable-method
;; Potentially triggered by `ebdb-mua-message-header', which
@@ -770,6 +815,13 @@ Usually this function is called by the wrapper
`ebdb-mua-auto-update'."
nil)))
(cond ((eq task 'quit)
(setq address-list nil))
+ ((eq task 'ignore)
+ (when (cadr address)
+ (cl-pushnew (downcase (cadr address))
+ ebdb-permanently-ignored-mails :test #'equal))
+ (unless ebdb-permanent-ignores-file
+ (message "Mail will be ignored for this session only")
+ (sit-for 2)))
((not (eq task 'next))
(dolist (hit (delq nil (nreverse hits)))
(cl-pushnew hit records :test #'equal)
@@ -787,7 +839,6 @@ Usually this function is called by the wrapper
`ebdb-mua-auto-update'."
records))
-;;; This whole thing could probably be replaced by `map-y-or-n-p'
(defun ebdb-query-create ()
"Interactive query used by `ebdb-update-records'.
Return t if the record should be created or nil otherwise.
@@ -797,7 +848,7 @@ Honor previous answers such as `!'."
;; `ebdb-offer-to-create' holds a character, i.e., a number.
;; -- Right now, we only remember "!".
(when (not (integerp task))
- (let ((prompt (format "%s is not in EBDB; add? (y,!,n,s,q,?) "
+ (let ((prompt (format "%s is not in EBDB; add? (y,!,n,i,s,q,?) "
(or (nth 0 ebdb-update-records-address)
(nth 1 ebdb-update-records-address))))
event)
@@ -818,6 +869,8 @@ Honor previous answers such as `!'."
((or (eq task ?q)
(eq task ?\a)) ; ?\a = C-g
(throw 'done 'quit))
+ ((eq task ?i)
+ (throw 'done 'ignore))
((eq task ?s)
(setq ebdb-update-records-p 'existing)
(throw 'done 'next))
@@ -836,7 +889,8 @@ Honor previous answers such as `!'."
Type ? for this help.
Type y to add the current record.
Type ! to add all remaining records.
-Type n to skip the current record. (You might also type space)
+Type n to skip the current record. (You can also type space)
+Type i to permanently ignore this mail address
Type s to switch from annotate to search mode.
Type q to quit updating records. No more search or annotation is done.")
(set-buffer-modified-p nil)
@@ -880,7 +934,7 @@ Return the records matching ADDRESS or nil."
(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)
+ (or (null name)
(string= "" name)))
(setq name (funcall ebdb-message-clean-name-function mail)))
(if (or (eq update-p 'create)
@@ -902,7 +956,7 @@ Return the records matching ADDRESS or nil."
;; Analyze the name part of the record.
(cond (created-p ; new record
- (ebdb-record-change-name record name))
+ (ebdb-record-change-name record name))
((or (not name)
;; The following tests can differ for more complicated names
@@ -913,19 +967,19 @@ Return the records matching ADDRESS or nil."
((numberp add-name)
- (unless ebdb-silent
+ (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
+ (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
+ ;; 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))))
@@ -933,8 +987,8 @@ Return the records matching ADDRESS or nil."
(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))
+ (ebdb-record-change-name record name)
+ (setq change-p 'name))
;; make new name an AKA?
((and old-name
@@ -943,15 +997,15 @@ Return the records matching ADDRESS or nil."
(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
+ (ebdb-record-insert-field
record (ebdb-parse 'ebdb-field-name name) 'aka)
- (setq change-p 'name)))
+ (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)))
+ (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))
@@ -974,12 +1028,12 @@ Return the records matching ADDRESS or nil."
(member-ignore-case (ebdb-string mail)
(ebdb-record-mail-canon record)))) ; do nothing
(created-p ; new record
- (ebdb-record-insert-field record mail 'mail))
+ (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
+ (unless ebdb-silent
(message "%s: new address `%s'"
(ebdb-string record) (ebdb-string mail))
(sit-for add-mails)))
@@ -1001,16 +1055,16 @@ Return the records matching ADDRESS or nil."
(ebdb-record-change-name record name)
(setq created-p t))))
- (let ((mails (ebdb-record-mail record)))
+ (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)
+ (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"
+ (let ((form (format "redundant mail%s %s"
(if (< 1 (length redundant)) "s" "")
(ebdb-concat 'mail (nreverse
redundant))))
(name (ebdb-record-name record)))
@@ -1033,24 +1087,24 @@ Return the records matching ADDRESS or nil."
(unless change-p (setq change-p t)))))
(cond (created-p
- (unless ebdb-silent
+ (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))
+ (ebdb-init-record record))
(change-p
- (unless ebdb-silent
+ (unless ebdb-silent
(cond ((eq change-p 'name)
(message "noticed \"%s\"" (ebdb-string record)))
- ((ebdb-record-name record)
+ ((ebdb-record-name record)
(message "noticed %s's address \"%s\""
(ebdb-string record)
(ebdb-string mail)))
- (t
+ (t
(message "noticed naked address \"%s\""
(ebdb-string mail)))))))
diff --git a/ebdb.info b/ebdb.info
index 10d17f5..bf3e05c 100644
--- a/ebdb.info
+++ b/ebdb.info
@@ -759,6 +759,28 @@ address or not:
the value will be constructed from the record pointed to by the
option ‘ebdb-record-self’.
+ When auto update is set to ‘query’, and the user has already told
+EBDB not to automatically create or update a record for a given mail
+address, it can be annoying when opening the message a second timed to
+be prompted again. It is possible to permanently ignore a mail address,
+by saving it to disk.
+
+ -- User Option: ebdb-permanent-ignores-file
+ A file in which to save permanently-ignored mail addresses. This
+ defaults to “.ebdb-permanent-ignores” in the user’s Emacs
+ directory, but can be set to a different location, or to nil to
+ disable saving of the ignored list altogether.
+
+ When EBDB queries to create or update a record, the ‘i’ key will
+ignore the mail permanently. If the above option is nil, the mail will
+be ignored for this session only, otherwise it will be saved to disk the
+next time EBDB is saved.
+
+ It’s also possible to add addresses manually, while EBDB is shut
+down. The format is one address per line, with no attached name or
+angle brackets. The addresses are matched literally (though
+case-insensitively); it’s not possible to use regexps.
+
File: ebdb.info, Node: Noticing and Automatic Rules, Next: Interactive
Commands, Prev: Auto-Updating Records, Up: Display and Updating
@@ -2489,6 +2511,8 @@ File: ebdb.info, Node: Index, Prev: Hacking EBDB, Up:
Top
* ebdb-open: Starting a New Database.
(line 6)
* ebdb-org-agenda-popup: Org Integration. (line 32)
+* ebdb-permanent-ignores-file: Auto-Updating Records.
+ (line 80)
* ebdb-popup-window: Writing Integration For New MUAs.
(line 60)
* ebdb-prev-field: The Basics of ebdb-mode.
@@ -2575,6 +2599,8 @@ File: ebdb.info, Node: Index, Prev: Hacking EBDB, Up:
Top
(line 13)
* P: The Basics of ebdb-mode.
(line 19)
+* Permanently ignoring mail addresses: Auto-Updating Records.
+ (line 80)
* Pop-up buffers: Pop-up Buffers. (line 6)
* q: The Basics of ebdb-mode.
(line 124)
@@ -2632,44 +2658,44 @@ Node: Loading MUA Code20835
Node: Display and Updating21548
Node: Pop-up Buffers22314
Node: Auto-Updating Records24234
-Node: Noticing and Automatic Rules27418
-Node: Interactive Commands28751
-Node: EBDB and MUA summary buffers31225
-Node: Sender name display31743
-Node: Summary buffer marks32970
-Node: Mail Address Completion34149
-Node: A Note on Completion36658
-Node: Specific MUAs37281
-Node: Gnus37429
-Node: Posting Styles37651
-Node: EBDB Buffers39226
-Node: Searching40437
-Node: Changing Search Behavior42151
-Node: The Basics of ebdb-mode43398
-Node: Customizing Record Display47707
-Node: Marking52027
-Node: Exporting/Formatting52454
-Node: Completion53389
-Node: Snarfing54185
-Node: Internationalization56202
-Node: Diary Integration58903
-Node: Mail Aliases59768
-Node: vCard Support60482
-Node: Org Integration60981
-Node: Citing Records62879
-Node: Hacking EBDB63637
-Node: Field Classes66228
-Node: Init and Delete Methods69364
-Node: The Labeled Field Class70871
-Node: The Singleton Field Class71725
-Node: Actions72163
-Node: Custom Field Searching72835
-Node: Fast Lookups75702
-Node: Formatting in the EBDB Buffer77512
-Node: Writing Internationalization Libraries79588
-Node: Writing Integration For New MUAs84002
-Node: Article snarfing87450
-Node: Index88168
+Node: Noticing and Automatic Rules28534
+Node: Interactive Commands29867
+Node: EBDB and MUA summary buffers32341
+Node: Sender name display32859
+Node: Summary buffer marks34086
+Node: Mail Address Completion35265
+Node: A Note on Completion37774
+Node: Specific MUAs38397
+Node: Gnus38545
+Node: Posting Styles38767
+Node: EBDB Buffers40342
+Node: Searching41553
+Node: Changing Search Behavior43267
+Node: The Basics of ebdb-mode44514
+Node: Customizing Record Display48823
+Node: Marking53143
+Node: Exporting/Formatting53570
+Node: Completion54505
+Node: Snarfing55301
+Node: Internationalization57318
+Node: Diary Integration60019
+Node: Mail Aliases60884
+Node: vCard Support61598
+Node: Org Integration62097
+Node: Citing Records63995
+Node: Hacking EBDB64753
+Node: Field Classes67344
+Node: Init and Delete Methods70480
+Node: The Labeled Field Class71987
+Node: The Singleton Field Class72841
+Node: Actions73279
+Node: Custom Field Searching73951
+Node: Fast Lookups76818
+Node: Formatting in the EBDB Buffer78628
+Node: Writing Internationalization Libraries80704
+Node: Writing Integration For New MUAs85118
+Node: Article snarfing88566
+Node: Index89284
End Tag Table
diff --git a/ebdb.org b/ebdb.org
index 7a55736..d216d4a 100644
--- a/ebdb.org
+++ b/ebdb.org
@@ -593,6 +593,30 @@ the symbol ~self~, in which case the value will be
constructed from
the record pointed to by the option ~ebdb-record-self~.
#+end_defopt
+When auto update is set to ~query~, and the user has already told EBDB
+not to automatically create or update a record for a given mail
+address, it can be annoying when opening the message a second timed to
+be prompted again. It is possible to permanently ignore a mail
+address, by saving it to disk.
+
+#+CINDEX: Permanently ignoring mail addresses
+#+ATTR_TEXINFO: :options ebdb-permanent-ignores-file
+#+begin_defopt
+A file in which to save permanently-ignored mail addresses. This
+defaults to ".ebdb-permanent-ignores" in the user's Emacs directory,
+but can be set to a different location, or to nil to disable saving of
+the ignored list altogether.
+#+end_defopt
+
+When EBDB queries to create or update a record, the {{{kbd(i)}}} key
+will ignore the mail permanently. If the above option is nil, the
+mail will be ignored for this session only, otherwise it will be saved
+to disk the next time EBDB is saved.
+
+It's also possible to add addresses manually, while EBDB is shut
+down. The format is one address per line, with no attached name or
+angle brackets. The addresses are matched literally (though
+case-insensitively); it's not possible to use regexps.
*** Noticing and Automatic Rules
#+CINDEX: Automatic Rules
diff --git a/ebdb.texi b/ebdb.texi
index 050ade4..f44b918 100644
--- a/ebdb.texi
+++ b/ebdb.texi
@@ -803,6 +803,30 @@ the symbol @code{self}, in which case the value will be
constructed from
the record pointed to by the option @code{ebdb-record-self}.
@end defopt
+When auto update is set to @code{query}, and the user has already told EBDB
+not to automatically create or update a record for a given mail
+address, it can be annoying when opening the message a second timed to
+be prompted again. It is possible to permanently ignore a mail
+address, by saving it to disk.
+
+@cindex Permanently ignoring mail addresses
+@defopt ebdb-permanent-ignores-file
+A file in which to save permanently-ignored mail addresses. This
+defaults to ``.ebdb-permanent-ignores'' in the user's Emacs directory,
+but can be set to a different location, or to nil to disable saving of
+the ignored list altogether.
+@end defopt
+
+When EBDB queries to create or update a record, the @kbd{i} key
+will ignore the mail permanently. If the above option is nil, the
+mail will be ignored for this session only, otherwise it will be saved
+to disk the next time EBDB is saved.
+
+It's also possible to add addresses manually, while EBDB is shut
+down. The format is one address per line, with no attached name or
+angle brackets. The addresses are matched literally (though
+case-insensitively); it's not possible to use regexps.
+
@node Noticing and Automatic Rules
@subsection Noticing and Automatic Rules
