summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Schulte <schulte.eric@gmail.com>2011-06-14 09:27:08 -0700
committerEric Schulte <schulte.eric@gmail.com>2011-06-14 09:27:08 -0700
commitbcfdc775bf4998698e83b8be153078bd894bbbfd (patch)
tree82fdfe9db9c68915f560888fcfc57125265071a9
parenta56e7c7508da298c92700251a500e06701d59c08 (diff)
parentdf1ad057da991a209cbf6ff32cef4c4ebfe86a8d (diff)
downloadorg-mode-bcfdc775bf4998698e83b8be153078bd894bbbfd.tar.gz
Merge branch 'master' of orgmode.org:org-mode
-rw-r--r--contrib/lisp/org-contacts.el83
-rw-r--r--lisp/org-agenda.el8
-rw-r--r--lisp/org-html.el4
3 files changed, 90 insertions, 5 deletions
diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el
index b32ee86..63ba005 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 65f37d4..b519ff2 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 afc6a77..b5d371f 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 "<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