emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/ebdb 03fcfae 9/9: Allow permanent ignoring of mail addr


From: Eric Abrahamsen
Subject: [elpa] externals/ebdb 03fcfae 9/9: Allow permanent ignoring of mail addresses
Date: Tue, 13 Aug 2019 21:46:52 -0400 (EDT)

branch: externals/ebdb
commit 03fcfaedf5745ef45c0d33df62d1305c0c9df5c8
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    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
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]