[O] [PATCH] org-contacts.el: add expire feature

[Feng Shu]

>From e974db131d88acf06bb6b250eac2fae8c7d0a96e Mon Sep 17 00:00:00 2001
From: Feng Shu <address@hidden>
Date: Wed, 29 May 2013 20:30:43 +0800
Subject: [PATCH] * contrib/lisp/org-contacts.el:   Add a feature which can
 expire   emails and phones

* test
  :PROPERTIES:
  :EMAIL: address@hidden  address@hidden  address@hidden
  :PHONE:  123456  123457 123458
  :EXPIRE:  address@hidden 123457
  :END:

when completing or exporting to vcard,  the emails and  phones in the
expire property (address@hidden and 123457) will be ignore
---
 contrib/lisp/org-contacts.el |   32 +++++++++++++++++++++++++++-----
 1 个文件被修改，插入 27 行(+)，删除 5 行(-)

diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el
index 7b0b603..ae6c6f1 100644
--- a/contrib/lisp/org-contacts.el
+++ b/contrib/lisp/org-contacts.el
@@ -86,6 +86,11 @@ When set to nil, all your Org files will be used."
   :type 'string
   :group 'org-contacts)
 
+(defcustom org-contacts-expire-property "EXPIRE"
+  "Name of the property for emails or phones which will be expired"
+  :type 'string
+  :group 'org-contacts)
+
 
 (defcustom org-contacts-birthday-format "Birthday: %l (%Y)"
   "Format of the anniversary agenda entry.
@@ -476,6 +481,14 @@ A group FOO is composed of contacts with the tag FOO."
                (completion-table-case-fold completion-list
                                            (not 
org-contacts-completion-ignore-case))))))))
 
+
+(defun org-contacts-remove-expired-property (expire-list list)
+  "Remove emails or phones in list-expired from list"
+    (while expire-list
+      (setq list (remove (car expire-list) list))
+      (setq expire-list (cdr expire-list)))
+    list)
+
 (defun org-contacts-complete-name (start end string)
   "Complete text at START with a user name and email."
   (let* ((completion-ignore-case org-contacts-completion-ignore-case)
@@ -484,10 +497,17 @@ A group FOO is composed of contacts with the tag FOO."
                ;; The contact name is always the car of the assoc-list
                ;; returned by `org-contacts-filter'.
                for contact-name = (car contact)
+
+               ;; Build the list of the email addresses which has
+               ;; been expired
+               for expire-list = (org-contacts-split-property (or
+                                                               (cdr 
(assoc-string org-contacts-expire-property
+                                                                               
   (caddr contact))) ""))
                ;; Build the list of the user email addresses.
-               for email-list = (org-contacts-split-property (or
-                                               (cdr (assoc-string 
org-contacts-email-property
-                                                                  (caddr 
contact))) ""))
+               for email-list = (org-contacts-remove-expired-property 
expire-list
+                                                                      
(org-contacts-split-property (or
+                                                                               
                     (cdr (assoc-string org-contacts-email-property
+                                                                               
                                        (caddr contact))) "")))
                ;; If the user has email addresses…
                if email-list
                ;; … append a list of USER <EMAIL>.
@@ -869,15 +889,17 @@ to do our best."
         (n (org-contacts-vcard-encode-name name))
         (email (cdr (assoc-string org-contacts-email-property properties)))
         (tel  (cdr (assoc-string org-contacts-tel-property properties)))
+        (expire  (cdr (assoc-string org-contacts-expire-property properties)))
         (note (cdr (assoc-string org-contacts-note-property properties)))
         (bday (org-contacts-vcard-escape (cdr (assoc-string 
org-contacts-birthday-property properties))))
         (addr (cdr (assoc-string org-contacts-address-property properties)))
         (nick (org-contacts-vcard-escape (cdr (assoc-string 
org-contacts-nickname-property properties))))
         (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name))
+        (expire-list (when expire (setq expire-list 
(org-contacts-split-property expire))))
         emails-list result phones-list)
     (concat head
            (when email (progn
-                         (setq emails-list (org-contacts-split-property email))
+                         (setq emails-list 
(org-contacts-remove-expired-property expire-list (org-contacts-split-property 
email))) ;
                          (setq result "")
                          (while emails-list
                            (setq result (concat result  "EMAIL:" 
(org-contacts-strip-link (car emails-list)) "\n"))
@@ -886,7 +908,7 @@ to do our best."
            (when addr
              (format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr)))
            (when tel (progn
-                       (setq phones-list (org-contacts-split-property tel))
+                       (setq phones-list (org-contacts-remove-expired-property 
expire-list (org-contacts-split-property tel)))
                        (setq result "")
                        (while phones-list
                          (setq result (concat result  "TEL:" 
(org-contacts-strip-link (car phones-list)) "\n"))
-- 
1.7.10.4

--