0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-07-15 23:16:27 +00:00

Merge branch 'master' of orgmode.org:org-mode

This commit is contained in:
Eric Schulte 2011-06-14 09:27:08 -07:00
commit bcfdc775bf
3 changed files with 90 additions and 5 deletions

View file

@ -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)

View file

@ -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)

View file

@ -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 "<ul>\n<li>" title "<br/>\n"))))
(aset org-levels-open (1- level) t)
(setq snumber (org-section-number level)
snu (replace-regexp-in-string "\\." "_" snumber))
snu (replace-regexp-in-string "\\." "-" snumber))
(setq level (+ level org-export-html-toplevel-hlevel -1))
(if (and num (not body-only))
(setq title (concat