[O] [PATCH] org-contacts: Implement a way to ignore certain new addresses

[Frank Terbeck]

With some bugtrackers (like the one github uses or with roundup for
example) or when you use gwene to follow certain site's RSS feeds,
you may run into situations, where `org-contacts-check-mail-address'
will ask if it should add a non-sensical email-address.

With this change, you can fine-tune in which situations org-contacts
is going ask you about whether or not you want to add a given new
address to an existing contact.

Valid values are functions that accept one argument and strings, that
will be used at regular expressions via `string-match'.

A minimal example is this:

  (add-to-list 'org-contacts-new-address-ignore
               "address@hidden")

The following is equivalent:

  (add-to-list 'org-contacts-new-address-ignore
               #'(lambda (x)
                   (string-match "address@hidden" x)))

Signed-off-by: Frank Terbeck <address@hidden>
---

  Please keep me CC:ed, as I am not subscribed.

 contrib/lisp/org-contacts.el | 45 +++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 40 insertions(+), 5 deletions(-)

diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el
index 97171d0..dd90a92 100644
--- a/contrib/lisp/org-contacts.el
+++ b/contrib/lisp/org-contacts.el
@@ -155,6 +155,25 @@ The following replacements are available:
   :type 'string
   :group 'org-contacts)
 
+(defcustom org-contacts-new-address-ignore
+  nil
+  "List of checks to run to determine whether or not to add a new
+email address to an existing contact.
+
+If an entry is a string, it is assumed to be a regular expression
+to match against the new address. If it is a symbol, it is
+assumed to be a function, that takes one argument, which is going
+to be set to the new address.
+
+If the regular expression matches or the function returns a
+non-nil value, the new address is not considered to be added to
+the existing account.
+
+Finally, here is an example:
+
+  (add-to-list 'org-contacts-new-address-ignore
+               \"address@hidden")")
+
 (defcustom org-contacts-matcher
   (mapconcat 'identity (list org-contacts-email-property
                             org-contacts-alias-property
@@ -728,13 +747,29 @@ This function should be called from 
`gnus-article-prepare-hook'."
       (concat (org-contacts-format-name name) " <" email ">")
     email))
 
+(defun org-contacts-new-address-ignored (mail)
+  "Check whether a mail address is marked to be ignored via the
+`org-contacts-new-address-ignore' list."
+  (catch 'ignored-mail
+    (dolist (matcher org-contacts-new-address-ignore)
+      (cond ((stringp matcher)
+             (and (string-match matcher mail)
+                  (throw 'ignored-mail t)))
+            ((functionp matcher)
+             (and (funcall matcher mail)
+                  (throw 'ignored-mail t)))
+            ;; Ignore all other entries.
+            (t t)))
+    (throw 'ignored-mail nil)))
+
 (defun org-contacts-check-mail-address (mail)
   "Add MAIL address to contact at point if it does not have it."
-  (let ((mails (org-entry-get (point) org-contacts-email-property)))
-    (unless (member mail (split-string mails))
-      (when (yes-or-no-p
-             (format "Do you want to add this address to %s?" (org-get-heading 
t)))
-        (org-set-property org-contacts-email-property (concat mails " " 
mail))))))
+  (unless (org-contacts-new-address-ignored mail)
+    (let ((mails (org-entry-get (point) org-contacts-email-property)))
+      (unless (member mail (split-string mails))
+        (when (yes-or-no-p
+               (format "Do you want to add this address to %s?" 
(org-get-heading t)))
+          (org-set-property org-contacts-email-property (concat mails " " 
mail)))))))
 
 (defun org-contacts-gnus-check-mail-address ()
   "Check that contact has the current address recorded.
-- 
1.8.3