[elpa] externals/org-contacts 66e23e6403 008/154: org-contacts: added VCard 3.0 exporter and ADDRESS field

[ELPA Syncer]

branch: externals/org-contacts
commit 66e23e6403c8cc07779e6a8760b06ab3336dfc6f
Author: Rüdiger Sonderfeld <ruediger@c-plusplus.de>
Commit: Julien Danjou <julien@danjou.info>

    org-contacts: added VCard 3.0 exporter and ADDRESS field
    
    Signed-off-by: Julien Danjou <julien@danjou.info>
---
 org-contacts.el | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 65 insertions(+)

diff --git a/org-contacts.el b/org-contacts.el
index b32ee86680..c07c25ec42 100644
--- a/org-contacts.el
+++ b/org-contacts.el
@@ -116,6 +116,11 @@ This overrides `org-email-link-description-format' if set."
   :group 'org-contacts
   :type 'string)
 
+(defcustom org-contacts-vcard-file "contacts.vcf"
+  "Default file for vcard export."
+  :group 'org-contacts
+  :type 'file)
+
 (defvar org-contacts-keymap
   (let ((map (make-sparse-keymap)))
     (define-key map "M" 'org-contacts-view-send-email)
@@ -529,4 +534,64 @@ If ASK is set, ask for the email address even if there's 
only one address."
 (add-to-list 'org-property-set-functions-alist
              `(,org-contacts-nickname-property . 
org-contacts-completing-read-nickname))
 
+(defun org-contacts-vcard-escape (str)
+  "Escape ; , and \n in STR for use in the VCard format.
+Thanks to http://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el for the 
regexp."
+  (when str
+    (replace-regexp-in-string "\n" "\\\\n" (replace-regexp-in-string 
"\\(;\\|,\\|\\\\\\)" "\\\\\\1" str))))
+
+(defun org-contacts-vcard-encode-name (name)
+  "Try to encode NAME as VCard's N property. The N property expects 
FamilyName;GivenName;AdditionalNames;Prefix;Postfix.
+Org-contacts does not specify how to encode the name. So we try to do our 
best."
+  (concat (replace-regexp-in-string "\\(\\w+\\) \\(.*\\)" "\\2;\\1" name) 
";;;"))
+
+(defun org-contacts-vcard-format (contact)
+  "Formats CONTACT in VCard 3.0 format."
+  (let* ((properties (caddr contact))
+        (name (org-contacts-vcard-escape (car contact)))
+        (n (org-contacts-vcard-encode-name name))
+        (email (org-contacts-vcard-escape (cdr (assoc-string 
org-contacts-email-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)))
+    (concat head
+           (when email (format "EMAIL:%s\n" email))
+           (when addr
+             (format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr)))
+           (when bday
+             (let ((cal-bday (calendar-gregorian-from-absolute 
(org-time-string-to-absolute bday))))
+               (format "BDAY:%04d-%02d-%02d\n"
+                       (calendar-extract-year cal-bday)
+                       (calendar-extract-month cal-bday)
+                       (calendar-extract-day cal-bday))))
+           (when nick (format "NICKNAME:%s\n" nick))
+           "END:VCARD\n\n")))
+
+(defun org-contacts-export-as-vcard (&optional name file to-buffer)
+  "Export all contacts matching NAME as VCard 3.0. It TO-BUFFER is nil, the 
content is written to FILE or `org-contacts-vcard-file'. If TO-BUFFER is 
non-nil, the buffer is created and the VCard is written into that buffer."
+  (interactive) ; TODO ask for name?
+  (let* ((filename (or file org-contacts-vcard-file))
+        (buffer (if to-buffer
+                    (get-buffer-create to-buffer)
+                    (find-file-noselect filename))))
+
+    (message "Exporting...")
+
+    (set-buffer buffer)
+    (let ((inhibit-read-only t)) (erase-buffer))
+    (fundamental-mode)
+    (org-install-letbind)
+
+    (when (fboundp 'set-buffer-file-coding-system)
+      (set-buffer-file-coding-system coding-system-for-write))
+
+    (loop for contact in (org-contacts-filter name)
+        do (insert (org-contacts-vcard-format contact)))
+
+    (if to-buffer
+       (current-buffer)
+       (progn (save-buffer) (kill-buffer)))))
+
 (provide 'org-contacts)