|
@@ -54,6 +54,11 @@ If set to nil, all your Org files will be used."
|
|
|
:type 'string
|
|
|
:group 'org-contacts)
|
|
|
|
|
|
+(defcustom org-contacts-address-property "ADDRESS"
|
|
|
+ "Name of the property for contact address."
|
|
|
+ :type 'string
|
|
|
+ :group 'org-contacts)
|
|
|
+
|
|
|
(defcustom org-contacts-birthday-property "BIRTHDAY"
|
|
|
"Name of the property for contact birthday date."
|
|
|
:type 'string
|
|
@@ -116,6 +121,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 +539,77 @@ 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)))))
|
|
|
+
|
|
|
+(defun org-contacts-show-map (&optional name)
|
|
|
+ "Show contacts on a map. Requires google-maps-el."
|
|
|
+ (interactive)
|
|
|
+ (unless (fboundp 'google-maps-static-show)
|
|
|
+ (error "org-contacts-show-map requires google-maps-el."))
|
|
|
+ (google-maps-static-show
|
|
|
+ :markers
|
|
|
+ (loop
|
|
|
+ for contact in (org-contacts-filter name)
|
|
|
+ for addr = (cdr (assoc-string org-contacts-address-property (caddr contact)))
|
|
|
+ if addr
|
|
|
+ collect (cons (list addr) (list :label (string-to-char (car contact)))))))
|
|
|
+
|
|
|
(provide 'org-contacts)
|