aliens/org-contacts
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

contrib/lisp/org-contacts.el: Add a feature, which can ignore emails or phones with property

Browse source 
* contrib/lisp/org-contacts.el (org-contacts-ignore-property): New variable.
(org-contacts-remove-ignored-property-values): New function, which
remove all ignore-list's elements from list.
(org-contacts-complete-name): When completing, ignore the
values which has been included into the ignore property.
(org-contacts-vcard-format): Don't export the values which has
been included into the ignore property.

If emails or phones is included into the ignore property, they will
not show in complete buffer. When the contact is exported to vcard,
they will be ignored too.
This commit is contained in:
Feng Shu 2013-05-29 20:30:43 +08:00 committed by Grégoire Jadi
parent a3c24bc7c8
commit e6b5811004
1 changed files with 29 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
org-contacts.el
View file

@ -86,6 +86,11 @@ When set to nil, all your Org files will be used."
:type 'string :type 'string
:group 'org-contacts) :group 'org-contacts)
(defcustom org-contacts-ignore-property "IGNORE"
"Name of the property, which values will be ignored when complete or export to vcard."
:type 'string
:group 'org-contacts)
(defcustom org-contacts-birthday-format "Birthday: %l (%Y)" (defcustom org-contacts-birthday-format "Birthday: %l (%Y)"
"Format of the anniversary agenda entry. "Format of the anniversary agenda entry.
@ -476,6 +481,16 @@ A group FOO is composed of contacts with the tag FOO."
(completion-table-case-fold completion-list (completion-table-case-fold completion-list
(not org-contacts-completion-ignore-case)))))))) (not org-contacts-completion-ignore-case))))))))
(defun org-contacts-remove-ignored-property-values (ignore-list list)
"Remove all ignore-list's elements from list and you can use
regular expressions in the ignore list."
(remove-if (lambda (el)
(find-if (lambda (x)
(string-match-p x el))
ignore-list))
list))
(defun org-contacts-complete-name (start end string) (defun org-contacts-complete-name (start end string)
"Complete text at START with a user name and email." "Complete text at START with a user name and email."
(let* ((completion-ignore-case org-contacts-completion-ignore-case) (let* ((completion-ignore-case org-contacts-completion-ignore-case)
@ -484,10 +499,17 @@ A group FOO is composed of contacts with the tag FOO."
;; The contact name is always the car of the assoc-list ;; The contact name is always the car of the assoc-list
;; returned by `org-contacts-filter'. ;; returned by `org-contacts-filter'.
for contact-name = (car contact) for contact-name = (car contact)
;; Build the list of the email addresses which has
;; been expired
for ignore-list = (org-contacts-split-property (or
(cdr (assoc-string org-contacts-ignore-property
(caddr contact))) ""))
;; Build the list of the user email addresses. ;; Build the list of the user email addresses.
for email-list = (org-contacts-split-property (or for email-list = (org-contacts-remove-ignored-property-values ignore-list
(cdr (assoc-string org-contacts-email-property (org-contacts-split-property (or
(caddr contact))) "")) (cdr (assoc-string org-contacts-email-property
(caddr contact))) "")))
;; If the user has email addresses… ;; If the user has email addresses…
if email-list if email-list
;; … append a list of USER <EMAIL>. ;; … append a list of USER <EMAIL>.
@ -869,15 +891,17 @@ to do our best."
(n (org-contacts-vcard-encode-name name)) (n (org-contacts-vcard-encode-name name))
(email (cdr (assoc-string org-contacts-email-property properties))) (email (cdr (assoc-string org-contacts-email-property properties)))
(tel (cdr (assoc-string org-contacts-tel-property properties))) (tel (cdr (assoc-string org-contacts-tel-property properties)))
(ignore (cdr (assoc-string org-contacts-ignore-property properties)))
(note (cdr (assoc-string org-contacts-note-property properties))) (note (cdr (assoc-string org-contacts-note-property properties)))
(bday (org-contacts-vcard-escape (cdr (assoc-string org-contacts-birthday-property properties)))) (bday (org-contacts-vcard-escape (cdr (assoc-string org-contacts-birthday-property properties))))
(addr (cdr (assoc-string org-contacts-address-property properties))) (addr (cdr (assoc-string org-contacts-address-property properties)))
(nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-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)) (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name))
(ignore-list (when ignore (setq ignore-list (org-contacts-split-property ignore))))
emails-list result phones-list) emails-list result phones-list)
(concat head (concat head
(when email (progn (when email (progn
(setq emails-list (org-contacts-split-property email)) (setq emails-list (org-contacts-remove-ignored-property-values ignore-list (org-contacts-split-property email)))
(setq result "") (setq result "")
(while emails-list (while emails-list
(setq result (concat result "EMAIL:" (org-contacts-strip-link (car emails-list)) "\n")) (setq result (concat result "EMAIL:" (org-contacts-strip-link (car emails-list)) "\n"))
@ -886,7 +910,7 @@ to do our best."
(when addr (when addr
(format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr))) (format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr)))
(when tel (progn (when tel (progn
(setq phones-list (org-contacts-split-property tel)) (setq phones-list (org-contacts-remove-ignored-property-values ignore-list (org-contacts-split-property tel)))
(setq result "") (setq result "")
(while phones-list (while phones-list
(setq result (concat result "TEL:" (org-contacts-strip-link (car phones-list)) "\n")) (setq result (concat result "TEL:" (org-contacts-strip-link (car phones-list)) "\n"))