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

[Feng Shu <tumashu@gmail.com>]

[-- Attachment #1: 0001-contrib-lisp-org-contacts.el-Add-a-feature-which-can.patch --]
[-- Type: text/x-diff, Size: 4561 bytes --]

From e974db131d88acf06bb6b250eac2fae8c7d0a96e Mon Sep 17 00:00:00 2001
From: Feng Shu <tumashu@gmail.com>
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: test1@gmail.com  test2@gmail.com  test3@gmail.com
  :PHONE:  123456  123457 123458
  :EXPIRE:  test2@gmail.com 123457
  :END:

when completing or exporting to vcard,  the emails and  phones in the
expire property (test2@gmail.com 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


[-- Attachment #2: Type: text/plain, Size: 5 bytes --]


--