summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2014-08-26 00:08:38 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2014-08-26 02:14:18 +0200
commit67ae102b4be87976240555d1c0d80ee55906f53c (patch)
tree18e0aa97562fbb17df9ca23aa331628b36195f56
parent6987059a205cae5d0470115322539876ed2868c8 (diff)
downloadorg-mode-67ae102b4be87976240555d1c0d80ee55906f53c.tar.gz
ox-icalendar: Speed up `org-agenda-write' process
* lisp/ox-icalendar.el (org-icalendar-create-uid): Remove unused optional argument. (org-icalendar--combine-files): Change signature. Simplify process. (org-icalendar-combine-agenda-files): Apply signature change. Do not check anymore ICALENDAR-MARK property. (org-icalendar-entry): Do not check anymore ICALENDAR-MARK property. (org-icalendar-export-to-ics): Comply to comments. (org-icalendar-export-current-agenda): Rewrite function. * lisp/org-agenda.el (org-agenda-write): Update docstring. Instead of parsing every agenda before picking up needed entries, copy these entries in a temporary buffer, then export it.
-rw-r--r--lisp/org-agenda.el23
-rw-r--r--lisp/ox-icalendar.el304
2 files changed, 148 insertions, 179 deletions
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 7015ad6..bcbacf0 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -3312,19 +3312,20 @@ This ensures the export commands can easily use it."
(defvar org-agenda-write-buffer-name "Agenda View")
(defun org-agenda-write (file &optional open nosettings agenda-bufname)
"Write the current buffer (an agenda view) as a file.
+
Depending on the extension of the file name, plain text (.txt),
HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced.
-If the extension is .ics, run icalendar export over all files used
-to construct the agenda and limit the export to entries listed in the
-agenda now.
-If the extension is .org, collect all subtrees corresponding to the
-agenda entries and add them in an .org file.
-With prefix argument OPEN, open the new file immediately.
-If NOSETTINGS is given, do not scope the settings of
-`org-agenda-exporter-settings' into the export commands. This is used when
-the settings have already been scoped and we do not wish to overrule other,
-higher priority settings.
-If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
+If the extension is .ics, translate visible agenda into iCalendar
+format. If the extension is .org, collect all subtrees
+corresponding to the agenda entries and add them in an .org file.
+
+With prefix argument OPEN, open the new file immediately. If
+NOSETTINGS is given, do not scope the settings of
+`org-agenda-exporter-settings' into the export commands. This is
+used when the settings have already been scoped and we do not
+wish to overrule other, higher priority settings. If
+AGENDA-BUFFER-NAME is provided, use this as the buffer name for
+the agenda to write."
(interactive "FWrite agenda to file: \nP")
(if (or (not (file-writable-p file))
(and (file-exists-p file)
diff --git a/lisp/ox-icalendar.el b/lisp/ox-icalendar.el
index 8d62ae2..7ebee35 100644
--- a/lisp/ox-icalendar.el
+++ b/lisp/ox-icalendar.el
@@ -269,11 +269,7 @@ re-read the iCalendar file.")
(:icalendar-store-UID nil nil org-icalendar-store-UID)
(:icalendar-timezone nil nil org-icalendar-timezone)
(:icalendar-use-deadline nil nil org-icalendar-use-deadline)
- (:icalendar-use-scheduled nil nil org-icalendar-use-scheduled)
- ;; The following property will be non-nil when export has been
- ;; started from org-agenda-mode. In this case, any entry without
- ;; a non-nil "ICALENDAR_MARK" property will be ignored.
- (:icalendar-agenda-view nil nil nil))
+ (:icalendar-use-scheduled nil nil org-icalendar-use-scheduled))
:filters-alist
'((:filter-headline . org-icalendar-clear-blank-lines))
:menu-entry
@@ -288,22 +284,18 @@ re-read the iCalendar file.")
;;; Internal Functions
-(defun org-icalendar-create-uid (file &optional bell h-markers)
+(defun org-icalendar-create-uid (file &optional bell)
"Set ID property on headlines missing it in FILE.
When optional argument BELL is non-nil, inform the user with
-a message if the file was modified. With optional argument
-H-MARKERS non-nil, it is a list of markers for the headlines
-which will be updated."
- (let ((pt (if h-markers (goto-char (car h-markers)) (point-min)))
- modified-flag)
+a message if the file was modified."
+ (let (modified-flag)
(org-map-entries
(lambda ()
(let ((entry (org-element-at-point)))
- (unless (or (< (point) pt) (org-element-property :ID entry))
+ (unless (org-element-property :ID entry)
(org-id-get-create)
(setq modified-flag t)
- (forward-line))
- (when h-markers (setq org-map-continue-from (pop h-markers)))))
+ (forward-line))))
nil nil 'comment)
(when (and bell modified-flag)
(message "ID properties created in file \"%s\"" file)
@@ -534,99 +526,97 @@ inlinetask within the section."
(cons 'org-data
(cons nil (org-element-contents first))))))))
(concat
- (unless (and (plist-get info :icalendar-agenda-view)
- (not (org-element-property :ICALENDAR-MARK entry)))
- (let ((todo-type (org-element-property :todo-type entry))
- (uid (or (org-element-property :ID entry) (org-id-new)))
- (summary (org-icalendar-cleanup-string
- (or (org-element-property :SUMMARY entry)
- (org-export-data
- (org-element-property :title entry) info))))
- (loc (org-icalendar-cleanup-string
- (org-element-property :LOCATION entry)))
- ;; Build description of the entry from associated
- ;; section (headline) or contents (inlinetask).
- (desc
- (org-icalendar-cleanup-string
- (or (org-element-property :DESCRIPTION entry)
- (let ((contents (org-export-data inside info)))
- (cond
- ((not (org-string-nw-p contents)) nil)
- ((wholenump org-icalendar-include-body)
- (let ((contents (org-trim contents)))
- (substring
- contents 0 (min (length contents)
- org-icalendar-include-body))))
- (org-icalendar-include-body (org-trim contents)))))))
- (cat (org-icalendar-get-categories entry info)))
- (concat
- ;; Events: Delegate to `org-icalendar--vevent' to
- ;; generate "VEVENT" component from scheduled, deadline,
- ;; or any timestamp in the entry.
- (let ((deadline (org-element-property :deadline entry)))
- (and deadline
- (memq (if todo-type 'event-if-todo 'event-if-not-todo)
- org-icalendar-use-deadline)
- (org-icalendar--vevent
- entry deadline (concat "DL-" uid)
- (concat "DL: " summary) loc desc cat)))
- (let ((scheduled (org-element-property :scheduled entry)))
- (and scheduled
- (memq (if todo-type 'event-if-todo 'event-if-not-todo)
- org-icalendar-use-scheduled)
- (org-icalendar--vevent
- entry scheduled (concat "SC-" uid)
- (concat "S: " summary) loc desc cat)))
- ;; When collecting plain timestamps from a headline and
- ;; its title, skip inlinetasks since collection will
- ;; happen once ENTRY is one of them.
+ (let ((todo-type (org-element-property :todo-type entry))
+ (uid (or (org-element-property :ID entry) (org-id-new)))
+ (summary (org-icalendar-cleanup-string
+ (or (org-element-property :SUMMARY entry)
+ (org-export-data
+ (org-element-property :title entry) info))))
+ (loc (org-icalendar-cleanup-string
+ (org-element-property :LOCATION entry)))
+ ;; Build description of the entry from associated section
+ ;; (headline) or contents (inlinetask).
+ (desc
+ (org-icalendar-cleanup-string
+ (or (org-element-property :DESCRIPTION entry)
+ (let ((contents (org-export-data inside info)))
+ (cond
+ ((not (org-string-nw-p contents)) nil)
+ ((wholenump org-icalendar-include-body)
+ (let ((contents (org-trim contents)))
+ (substring
+ contents 0 (min (length contents)
+ org-icalendar-include-body))))
+ (org-icalendar-include-body (org-trim contents)))))))
+ (cat (org-icalendar-get-categories entry info)))
+ (concat
+ ;; Events: Delegate to `org-icalendar--vevent' to generate
+ ;; "VEVENT" component from scheduled, deadline, or any
+ ;; timestamp in the entry.
+ (let ((deadline (org-element-property :deadline entry)))
+ (and deadline
+ (memq (if todo-type 'event-if-todo 'event-if-not-todo)
+ org-icalendar-use-deadline)
+ (org-icalendar--vevent
+ entry deadline (concat "DL-" uid)
+ (concat "DL: " summary) loc desc cat)))
+ (let ((scheduled (org-element-property :scheduled entry)))
+ (and scheduled
+ (memq (if todo-type 'event-if-todo 'event-if-not-todo)
+ org-icalendar-use-scheduled)
+ (org-icalendar--vevent
+ entry scheduled (concat "SC-" uid)
+ (concat "S: " summary) loc desc cat)))
+ ;; When collecting plain timestamps from a headline and its
+ ;; title, skip inlinetasks since collection will happen once
+ ;; ENTRY is one of them.
+ (let ((counter 0))
+ (mapconcat
+ #'identity
+ (org-element-map (cons (org-element-property :title entry)
+ (org-element-contents inside))
+ 'timestamp
+ (lambda (ts)
+ (when (let ((type (org-element-property :type ts)))
+ (case (plist-get info :with-timestamps)
+ (active (memq type '(active active-range)))
+ (inactive (memq type '(inactive inactive-range)))
+ ((t) t)))
+ (let ((uid (format "TS%d-%s" (incf counter) uid)))
+ (org-icalendar--vevent
+ entry ts uid summary loc desc cat))))
+ info nil (and (eq type 'headline) 'inlinetask))
+ ""))
+ ;; Task: First check if it is appropriate to export it. If
+ ;; so, call `org-icalendar--vtodo' to transcode it into
+ ;; a "VTODO" component.
+ (when (and todo-type
+ (case (plist-get info :icalendar-include-todo)
+ (all t)
+ (unblocked
+ (and (eq type 'headline)
+ (not (org-icalendar-blocked-headline-p
+ entry info))))
+ ((t) (eq todo-type 'todo))))
+ (org-icalendar--vtodo entry uid summary loc desc cat))
+ ;; Diary-sexp: Collect every diary-sexp element within ENTRY
+ ;; and its title, and transcode them. If ENTRY is
+ ;; a headline, skip inlinetasks: they will be handled
+ ;; separately.
+ (when org-icalendar-include-sexps
(let ((counter 0))
- (mapconcat
- #'identity
- (org-element-map (cons (org-element-property :title entry)
- (org-element-contents inside))
- 'timestamp
- (lambda (ts)
- (when (let ((type (org-element-property :type ts)))
- (case (plist-get info :with-timestamps)
- (active (memq type '(active active-range)))
- (inactive (memq type '(inactive inactive-range)))
- ((t) t)))
- (let ((uid (format "TS%d-%s" (incf counter) uid)))
- (org-icalendar--vevent
- entry ts uid summary loc desc cat))))
- info nil (and (eq type 'headline) 'inlinetask))
- ""))
- ;; Task: First check if it is appropriate to export it.
- ;; If so, call `org-icalendar--vtodo' to transcode it
- ;; into a "VTODO" component.
- (when (and todo-type
- (case (plist-get info :icalendar-include-todo)
- (all t)
- (unblocked
- (and (eq type 'headline)
- (not (org-icalendar-blocked-headline-p
- entry info))))
- ((t) (eq todo-type 'todo))))
- (org-icalendar--vtodo entry uid summary loc desc cat))
- ;; Diary-sexp: Collect every diary-sexp element within
- ;; ENTRY and its title, and transcode them. If ENTRY is
- ;; a headline, skip inlinetasks: they will be handled
- ;; separately.
- (when org-icalendar-include-sexps
- (let ((counter 0))
- (mapconcat #'identity
- (org-element-map
- (cons (org-element-property :title entry)
- (org-element-contents inside))
- 'diary-sexp
- (lambda (sexp)
- (org-icalendar-transcode-diary-sexp
- (org-element-property :value sexp)
- (format "DS%d-%s" (incf counter) uid)
- summary))
- info nil (and (eq type 'headline) 'inlinetask))
- ""))))))
+ (mapconcat #'identity
+ (org-element-map
+ (cons (org-element-property :title entry)
+ (org-element-contents inside))
+ 'diary-sexp
+ (lambda (sexp)
+ (org-icalendar-transcode-diary-sexp
+ (org-element-property :value sexp)
+ (format "DS%d-%s" (incf counter) uid)
+ summary))
+ info nil (and (eq type 'headline) 'inlinetask))
+ "")))))
;; If ENTRY is a headline, call current function on every
;; inlinetask within it. In agenda export, this is independent
;; from the mark (or lack thereof) on the entry.
@@ -833,7 +823,8 @@ Return ICS file name."
;; links will not be collected at the end of sections.
(let ((outfile (org-export-output-file-name ".ics" subtreep)))
(org-export-to-file 'icalendar outfile
- async subtreep visible-only body-only '(:ascii-charset utf-8)
+ async subtreep visible-only body-only
+ '(:ascii-charset utf-8 :ascii-links-to-notes nil)
(lambda (file)
(run-hook-with-args 'org-icalendar-after-save-hook file) nil))))
@@ -888,50 +879,44 @@ The file is stored under the name chosen in
(org-export-add-to-stack
(expand-file-name org-icalendar-combined-agenda-file)
'icalendar))
- `(apply 'org-icalendar--combine-files nil ',files)))
- (apply 'org-icalendar--combine-files nil (org-agenda-files t))))
+ `(apply 'org-icalendar--combine-files ',files)))
+ (apply 'org-icalendar--combine-files (org-agenda-files t))))
(defun org-icalendar-export-current-agenda (file)
"Export current agenda view to an iCalendar FILE.
This function assumes major mode for current buffer is
`org-agenda-mode'."
- (let (org-export-babel-evaluate ; Don't evaluate Babel block
- (org-icalendar-combined-agenda-file file)
- (marker-list
- ;; Collect the markers pointing to entries in the current
- ;; agenda buffer.
- (let (markers)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (let ((m (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker))))
- (and m (push m markers)))
- (beginning-of-line 2)))
- (nreverse markers))))
- (apply 'org-icalendar--combine-files
- ;; Build restriction alist.
- (let (restriction)
- ;; Sort markers in each association within RESTRICTION.
- (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x)
- (dolist (m marker-list restriction)
- (let* ((pos (marker-position m))
- (file (buffer-file-name
- (org-base-buffer (marker-buffer m))))
- (file-markers (assoc file restriction)))
- ;; Add POS in FILE association if one exists
- ;; or create a new association for FILE.
- (if file-markers (push pos (cdr file-markers))
- (push (list file pos) restriction))))))
- (org-agenda-files nil 'ifmode))))
-
-(defun org-icalendar--combine-files (restriction &rest files)
+ (let* ((org-export-babel-evaluate) ; Don't evaluate Babel block.
+ (contents
+ (org-export-string-as
+ (with-output-to-string
+ (save-excursion
+ (let ((p (point-min)))
+ (while (setq p (next-single-property-change p 'org-hd-marker))
+ (let ((m (get-text-property p 'org-hd-marker)))
+ (when m
+ (with-current-buffer (marker-buffer m)
+ (org-with-wide-buffer
+ (goto-char (marker-position m))
+ (princ
+ (org-element-normalize-string
+ (buffer-substring
+ (point) (progn (outline-next-heading) (point)))))))))
+ (forward-line)))))
+ 'icalendar file)))
+ (with-temp-file file
+ (insert
+ (org-icalendar--vcalendar
+ org-icalendar-combined-name
+ user-full-name
+ org-icalendar-combined-description
+ (or (org-string-nw-p org-icalendar-timezone) (cadr (current-time-zone)))
+ contents)))
+ (run-hook-with-args 'org-icalendar-after-save-hook file)))
+
+(defun org-icalendar--combine-files (&rest files)
"Combine entries from multiple files into an iCalendar file.
-RESTRICTION, when non-nil, is an alist where key is a file name
-and value a list of buffer positions pointing to entries that
-should appear in the calendar. It only makes sense if the
-function was called from an agenda buffer. FILES is a list of
-files to build the calendar from."
+FILES is a list of files to build the calendar from."
(org-agenda-prepare-buffers files)
(unwind-protect
(progn
@@ -955,29 +940,12 @@ files to build the calendar from."
(catch 'nextfile
(org-check-agenda-file file)
(with-current-buffer (org-get-agenda-file-buffer file)
- (let ((marks (cdr (assoc (expand-file-name file)
- restriction))))
- ;; Create ID if necessary.
- (when org-icalendar-store-UID
- (org-icalendar-create-uid file t marks))
- (unless (and restriction (not marks))
- ;; Add a hook adding :ICALENDAR_MARK: property
- ;; to each entry appearing in agenda view.
- ;; Use `apply-partially' because the function
- ;; still has to accept one argument.
- (let ((org-export-before-processing-hook
- (cons (apply-partially
- (lambda (m-list dummy)
- (mapc (lambda (m)
- (org-entry-put
- m "ICALENDAR-MARK" "t"))
- m-list))
- (sort marks '>))
- org-export-before-processing-hook)))
- (org-export-as
- 'icalendar nil nil t
- (list :ascii-charset 'utf-8
- :icalendar-agenda-view restriction))))))))
+ ;; Create ID if necessary.
+ (when org-icalendar-store-UID
+ (org-icalendar-create-uid file t))
+ (org-export-as
+ 'icalendar nil nil t
+ '(:ascii-charset utf-8 :ascii-links-to-notes nil)))))
files "")
;; BBDB anniversaries.
(when (and org-icalendar-include-bbdb-anniversaries