diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el index b32ee8668..63ba00520 100644 --- a/contrib/lisp/org-contacts.el +++ b/contrib/lisp/org-contacts.el @@ -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) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 65f37d47b..b519ff2b5 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -8199,9 +8199,11 @@ The prefix arg is passed through to the command if possible." (setq day-of-week 0))))) ;; silently fail when try to replan a sexp entry (condition-case nil - (org-agenda-schedule nil - (days-to-time - (+ (org-today) distance))) + (let* ((date (calendar-gregorian-from-absolute + (+ (org-today) distance))) + (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) + (nth 2 date)))) + (org-agenda-schedule nil time)) (error nil))))))) ((equal action ?f) diff --git a/lisp/org-html.el b/lisp/org-html.el index afc6a77f0..b5d371f3e 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1395,7 +1395,7 @@ lang=\"%s\" xml:lang=\"%s\"> (setq txt (replace-match "" t t txt))) (setq href (replace-regexp-in-string - "\\." "_" (format "sec-%s" snumber))) + "\\." "-" (format "sec-%s" snumber))) (setq href (org-solidify-link-text (or (cdr (assoc href org-export-preferred-target-alist)) href))) (push (format @@ -2412,7 +2412,7 @@ When TITLE is nil, just close all open levels." (insert "