Release 6.26
[org-mode.git] / lisp / org-icalendar.el
blob17fd8fcac28da460bb7137ffae5d6ca09c8eeb4b
1 ;;; org-icalendar.el --- iCalendar export for Org-mode
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
4 ;; Free Software Foundation, Inc.
6 ;; Author: Carsten Dominik <carsten at orgmode dot org>
7 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;; Homepage: http://orgmode.org
9 ;; Version: 6.26
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 ;;; Commentary:
29 (require 'org-exp)
31 (defgroup org-export-icalendar nil
32 "Options specific for iCalendar export of Org-mode files."
33 :tag "Org Export iCalendar"
34 :group 'org-export)
36 (defcustom org-combined-agenda-icalendar-file "~/org.ics"
37 "The file name for the iCalendar file covering all agenda files.
38 This file is created with the command \\[org-export-icalendar-all-agenda-files].
39 The file name should be absolute, the file will be overwritten without warning."
40 :group 'org-export-icalendar
41 :type 'file)
43 (defcustom org-icalendar-combined-name "OrgMode"
44 "Calendar name for the combined iCalendar representing all agenda files."
45 :group 'org-export-icalendar
46 :type 'string)
48 (defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
49 "Contexts where iCalendar export should use a deadline time stamp.
50 This is a list with several symbols in it. Valid symbol are:
52 event-if-todo Deadlines in TODO entries become calendar events.
53 event-if-not-todo Deadlines in non-TODO entries become calendar events.
54 todo-due Use deadlines in TODO entries as due-dates"
55 :group 'org-export-icalendar
56 :type '(set :greedy t
57 (const :tag "Deadlines in non-TODO entries become events"
58 event-if-not-todo)
59 (const :tag "Deadline in TODO entries become events"
60 event-if-todo)
61 (const :tag "Deadlines in TODO entries become due-dates"
62 todo-due)))
64 (defcustom org-icalendar-use-scheduled '(todo-start)
65 "Contexts where iCalendar export should use a scheduling time stamp.
66 This is a list with several symbols in it. Valid symbol are:
68 event-if-todo Scheduling time stamps in TODO entries become an event.
69 event-if-not-todo Scheduling time stamps in non-TODO entries become an event.
70 todo-start Scheduling time stamps in TODO entries become start date.
71 Some calendar applications show TODO entries only after
72 that date."
73 :group 'org-export-icalendar
74 :type '(set :greedy t
75 (const :tag
76 "SCHEDULED timestamps in non-TODO entries become events"
77 event-if-not-todo)
78 (const :tag "SCHEDULED timestamps in TODO entries become events"
79 event-if-todo)
80 (const :tag "SCHEDULED in TODO entries become start date"
81 todo-start)))
83 (defcustom org-icalendar-categories '(local-tags category)
84 "Items that should be entered into the categories field.
85 This is a list of symbols, the following are valid:
87 category The Org-mode category of the current file or tree
88 todo-state The todo state, if any
89 local-tags The tags, defined in the current line
90 all-tags All tags, including inherited ones."
91 :group 'org-export-icalendar
92 :type '(repeat
93 (choice
94 (const :tag "The file or tree category" category)
95 (const :tag "The TODO state" todo-state)
96 (const :tag "Tags defined in current line" local-tags)
97 (const :tag "All tags, including inherited ones" all-tags))))
99 (defcustom org-icalendar-include-todo nil
100 "Non-nil means, export to iCalendar files should also cover TODO items."
101 :group 'org-export-icalendar
102 :type '(choice
103 (const :tag "None" nil)
104 (const :tag "Unfinished" t)
105 (const :tag "All" all)))
107 (defcustom org-icalendar-include-sexps t
108 "Non-nil means, export to iCalendar files should also cover sexp entries.
109 These are entries like in the diary, but directly in an Org-mode file."
110 :group 'org-export-icalendar
111 :type 'boolean)
113 (defcustom org-icalendar-include-body 100
114 "Amount of text below headline to be included in iCalendar export.
115 This is a number of characters that should maximally be included.
116 Properties, scheduling and clocking lines will always be removed.
117 The text will be inserted into the DESCRIPTION field."
118 :group 'org-export-icalendar
119 :type '(choice
120 (const :tag "Nothing" nil)
121 (const :tag "Everything" t)
122 (integer :tag "Max characters")))
124 (defcustom org-icalendar-store-UID nil
125 "Non-nil means, store any created UIDs in properties.
126 The iCalendar standard requires that all entries have a unique identifier.
127 Org will create these identifiers as needed. When this variable is non-nil,
128 the created UIDs will be stored in the ID property of the entry. Then the
129 next time this entry is exported, it will be exported with the same UID,
130 superceding the previous form of it. This is essential for
131 synchronization services.
132 This variable is not turned on by default because we want to avoid creating
133 a property drawer in every entry if people are only playing with this feature,
134 or if they are only using it locally."
135 :group 'org-export-icalendar
136 :type 'boolean)
138 ;;; iCalendar export
140 ;;;###autoload
141 (defun org-export-icalendar-this-file ()
142 "Export current file as an iCalendar file.
143 The iCalendar file will be located in the same directory as the Org-mode
144 file, but with extension `.ics'."
145 (interactive)
146 (org-export-icalendar nil buffer-file-name))
148 ;;;###autoload
149 (defun org-export-icalendar-all-agenda-files ()
150 "Export all files in `org-agenda-files' to iCalendar .ics files.
151 Each iCalendar file will be located in the same directory as the Org-mode
152 file, but with extension `.ics'."
153 (interactive)
154 (apply 'org-export-icalendar nil (org-agenda-files t)))
156 ;;;###autoload
157 (defun org-export-icalendar-combine-agenda-files ()
158 "Export all files in `org-agenda-files' to a single combined iCalendar file.
159 The file is stored under the name `org-combined-agenda-icalendar-file'."
160 (interactive)
161 (apply 'org-export-icalendar t (org-agenda-files t)))
163 (defun org-export-icalendar (combine &rest files)
164 "Create iCalendar files for all elements of FILES.
165 If COMBINE is non-nil, combine all calendar entries into a single large
166 file and store it under the name `org-combined-agenda-icalendar-file'."
167 (save-excursion
168 (org-prepare-agenda-buffers files)
169 (let* ((dir (org-export-directory
170 :ical (list :publishing-directory
171 org-export-publishing-directory)))
172 file ical-file ical-buffer category started org-agenda-new-buffers)
173 (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*"))
174 (when combine
175 (setq ical-file
176 (if (file-name-absolute-p org-combined-agenda-icalendar-file)
177 org-combined-agenda-icalendar-file
178 (expand-file-name org-combined-agenda-icalendar-file dir))
179 ical-buffer (org-get-agenda-file-buffer ical-file))
180 (set-buffer ical-buffer) (erase-buffer))
181 (while (setq file (pop files))
182 (catch 'nextfile
183 (org-check-agenda-file file)
184 (set-buffer (org-get-agenda-file-buffer file))
185 (unless combine
186 (setq ical-file (concat (file-name-as-directory dir)
187 (file-name-sans-extension
188 (file-name-nondirectory buffer-file-name))
189 ".ics"))
190 (setq ical-buffer (org-get-agenda-file-buffer ical-file))
191 (with-current-buffer ical-buffer (erase-buffer)))
192 (setq category (or org-category
193 (file-name-sans-extension
194 (file-name-nondirectory buffer-file-name))))
195 (if (symbolp category) (setq category (symbol-name category)))
196 (let ((standard-output ical-buffer))
197 (if combine
198 (and (not started) (setq started t)
199 (org-start-icalendar-file org-icalendar-combined-name))
200 (org-start-icalendar-file category))
201 (org-print-icalendar-entries combine)
202 (when (or (and combine (not files)) (not combine))
203 (org-finish-icalendar-file)
204 (set-buffer ical-buffer)
205 (run-hooks 'org-before-save-iCalendar-file-hook)
206 (save-buffer)
207 (run-hooks 'org-after-save-iCalendar-file-hook)
208 (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
209 ))))
210 (org-release-buffers org-agenda-new-buffers))))
212 (defvar org-before-save-iCalendar-file-hook nil
213 "Hook run before an iCalendar file has been saved.
214 This can be used to modify the result of the export.")
216 (defvar org-after-save-iCalendar-file-hook nil
217 "Hook run after an iCalendar file has been saved.
218 The iCalendar buffer is still current when this hook is run.
219 A good way to use this is to tell a desktop calendar application to re-read
220 the iCalendar file.")
222 (defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
223 (defun org-print-icalendar-entries (&optional combine)
224 "Print iCalendar entries for the current Org-mode file to `standard-output'.
225 When COMBINE is non nil, add the category to each line."
226 (require 'org-agenda)
227 (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
228 (re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
229 (dts (org-ical-ts-to-string
230 (format-time-string (cdr org-time-stamp-formats) (current-time))
231 "DTSTART"))
232 hd ts ts2 state status (inc t) pos b sexp rrule
233 scheduledp deadlinep todo prefix due start
234 tmp pri categories location summary desc uid
235 (sexp-buffer (get-buffer-create "*ical-tmp*")))
236 (org-refresh-category-properties)
237 (save-excursion
238 (goto-char (point-min))
239 (while (re-search-forward re1 nil t)
240 (catch :skip
241 (org-agenda-skip)
242 (when (boundp 'org-icalendar-verify-function)
243 (unless (funcall org-icalendar-verify-function)
244 (outline-next-heading)
245 (backward-char 1)
246 (throw :skip nil)))
247 (setq pos (match-beginning 0)
248 ts (match-string 0)
249 inc t
250 hd (condition-case nil
251 (org-icalendar-cleanup-string
252 (org-get-heading))
253 (error (throw :skip nil)))
254 summary (org-icalendar-cleanup-string
255 (org-entry-get nil "SUMMARY"))
256 desc (org-icalendar-cleanup-string
257 (or (org-entry-get nil "DESCRIPTION")
258 (and org-icalendar-include-body (org-get-entry)))
259 t org-icalendar-include-body)
260 location (org-icalendar-cleanup-string
261 (org-entry-get nil "LOCATION" 'selective))
262 uid (if org-icalendar-store-UID
263 (org-id-get-create)
264 (or (org-id-get) (org-id-new)))
265 categories (org-export-get-categories)
266 deadlinep nil scheduledp nil)
267 (if (looking-at re2)
268 (progn
269 (goto-char (match-end 0))
270 (setq ts2 (match-string 1)
271 inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
272 (setq tmp (buffer-substring (max (point-min)
273 (- pos org-ds-keyword-length))
274 pos)
275 ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
276 (progn
277 (setq inc nil)
278 (replace-match "\\1" t nil ts))
280 deadlinep (string-match org-deadline-regexp tmp)
281 scheduledp (string-match org-scheduled-regexp tmp)
282 todo (org-get-todo-state)
283 ;; donep (org-entry-is-done-p)
285 (when (and
286 deadlinep
287 (if todo
288 (not (memq 'event-if-todo org-icalendar-use-deadline))
289 (not (memq 'event-if-not-todo org-icalendar-use-deadline))))
290 (throw :skip t))
291 (when (and
292 scheduledp
293 (if todo
294 (not (memq 'event-if-todo org-icalendar-use-scheduled))
295 (not (memq 'event-if-not-todo org-icalendar-use-scheduled))))
296 (throw :skip t))
297 (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-")))
298 (if (or (string-match org-tr-regexp hd)
299 (string-match org-ts-regexp hd))
300 (setq hd (replace-match "" t t hd)))
301 (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
302 (setq rrule
303 (concat "\nRRULE:FREQ="
304 (cdr (assoc
305 (match-string 2 ts)
306 '(("d" . "DAILY")("w" . "WEEKLY")
307 ("m" . "MONTHLY")("y" . "YEARLY"))))
308 ";INTERVAL=" (match-string 1 ts)))
309 (setq rrule ""))
310 (setq summary (or summary hd))
311 (if (string-match org-bracket-link-regexp summary)
312 (setq summary
313 (replace-match (if (match-end 3)
314 (match-string 3 summary)
315 (match-string 1 summary))
316 t t summary)))
317 (if deadlinep (setq summary (concat "DL: " summary)))
318 (if scheduledp (setq summary (concat "S: " summary)))
319 (if (string-match "\\`<%%" ts)
320 (with-current-buffer sexp-buffer
321 (insert (substring ts 1 -1) " " summary "\n"))
322 (princ (format "BEGIN:VEVENT
323 UID: %s
325 %s%s
326 SUMMARY:%s%s%s
327 CATEGORIES:%s
328 END:VEVENT\n"
329 (concat prefix uid)
330 (org-ical-ts-to-string ts "DTSTART")
331 (org-ical-ts-to-string ts2 "DTEND" inc)
332 rrule summary
333 (if (and desc (string-match "\\S-" desc))
334 (concat "\nDESCRIPTION: " desc) "")
335 (if (and location (string-match "\\S-" location))
336 (concat "\nLOCATION: " location) "")
337 categories)))))
338 (when (and org-icalendar-include-sexps
339 (condition-case nil (require 'icalendar) (error nil))
340 (fboundp 'icalendar-export-region))
341 ;; Get all the literal sexps
342 (goto-char (point-min))
343 (while (re-search-forward "^&?%%(" nil t)
344 (catch :skip
345 (org-agenda-skip)
346 (setq b (match-beginning 0))
347 (goto-char (1- (match-end 0)))
348 (forward-sexp 1)
349 (end-of-line 1)
350 (setq sexp (buffer-substring b (point)))
351 (with-current-buffer sexp-buffer
352 (insert sexp "\n"))))
353 (princ (org-diary-to-ical-string sexp-buffer))
354 (kill-buffer sexp-buffer))
356 (when org-icalendar-include-todo
357 (setq prefix "TODO-")
358 (goto-char (point-min))
359 (while (re-search-forward org-todo-line-regexp nil t)
360 (catch :skip
361 (org-agenda-skip)
362 (when (boundp 'org-icalendar-verify-function)
363 (unless (funcall org-icalendar-verify-function)
364 (outline-next-heading)
365 (backward-char 1)
366 (throw :skip nil)))
367 (setq state (match-string 2))
368 (setq status (if (member state org-done-keywords)
369 "COMPLETED" "NEEDS-ACTION"))
370 (when (and state
371 (or (not (member state org-done-keywords))
372 (eq org-icalendar-include-todo 'all))
373 (not (member org-archive-tag (org-get-tags-at)))
375 (setq hd (match-string 3)
376 summary (org-icalendar-cleanup-string
377 (org-entry-get nil "SUMMARY"))
378 desc (org-icalendar-cleanup-string
379 (or (org-entry-get nil "DESCRIPTION")
380 (and org-icalendar-include-body (org-get-entry)))
381 t org-icalendar-include-body)
382 location (org-icalendar-cleanup-string
383 (org-entry-get nil "LOCATION" 'selective))
384 due (and (member 'todo-due org-icalendar-use-deadline)
385 (org-entry-get nil "DEADLINE"))
386 start (and (member 'todo-start org-icalendar-use-scheduled)
387 (org-entry-get nil "SCHEDULED"))
388 categories (org-export-get-categories)
389 uid (if org-icalendar-store-UID
390 (org-id-get-create)
391 (or (org-id-get) (org-id-new))))
392 (and due (setq due (org-ical-ts-to-string due "DUE")))
393 (and start (setq start (org-ical-ts-to-string start "DTSTART")))
395 (if (string-match org-bracket-link-regexp hd)
396 (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
397 (match-string 1 hd))
398 t t hd)))
399 (if (string-match org-priority-regexp hd)
400 (setq pri (string-to-char (match-string 2 hd))
401 hd (concat (substring hd 0 (match-beginning 1))
402 (substring hd (match-end 1))))
403 (setq pri org-default-priority))
404 (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
405 (- org-lowest-priority org-highest-priority))))))
407 (princ (format "BEGIN:VTODO
408 UID: %s
410 SUMMARY:%s%s%s%s
411 CATEGORIES:%s
412 SEQUENCE:1
413 PRIORITY:%d
414 STATUS:%s
415 END:VTODO\n"
416 (concat prefix uid)
417 (or start dts)
418 (or summary hd)
419 (if (and location (string-match "\\S-" location))
420 (concat "\nLOCATION: " location) "")
421 (if (and desc (string-match "\\S-" desc))
422 (concat "\nDESCRIPTION: " desc) "")
423 (if due (concat "\n" due) "")
424 categories
425 pri status)))))))))
427 (defun org-export-get-categories ()
428 "Get categories according to `org-icalendar-categories'."
429 (let ((cs org-icalendar-categories) c rtn tmp)
430 (while (setq c (pop cs))
431 (cond
432 ((eq c 'category) (push (org-get-category) rtn))
433 ((eq c 'todo-state)
434 (setq tmp (org-get-todo-state))
435 (and tmp (push tmp rtn)))
436 ((eq c 'local-tags)
437 (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
438 ((eq c 'all-tags)
439 (setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
440 (mapconcat 'identity (nreverse rtn) ",")))
442 (defun org-icalendar-cleanup-string (s &optional is-body maxlength)
443 "Take out stuff and quote what needs to be quoted.
444 When IS-BODY is non-nil, assume that this is the body of an item, clean up
445 whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
446 characters."
447 (if (not s)
449 (when is-body
450 (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
451 (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
452 (while (string-match re s) (setq s (replace-match "" t t s)))
453 (while (string-match re2 s) (setq s (replace-match "" t t s)))))
454 (let ((start 0))
455 (while (string-match "\\([,;]\\)" s start)
456 (setq start (+ (match-beginning 0) 2)
457 s (replace-match "\\\\\\1" nil nil s))))
458 (setq s (org-trim s))
459 (when is-body
460 (while (string-match "[ \t]*\n[ \t]*" s)
461 (setq s (replace-match "\\n" t t s))))
462 (if is-body
463 (if maxlength
464 (if (and (numberp maxlength)
465 (> (length s) maxlength))
466 (setq s (substring s 0 maxlength)))))
469 (defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength)
470 "Take out stuff and quote what needs to be quoted.
471 When IS-BODY is non-nil, assume that this is the body of an item, clean up
472 whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
473 characters.
474 This seems to be more like RFC 2455, but it causes problems, so it is
475 not used right now."
476 (if (not s)
478 (if is-body
479 (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
480 (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
481 (while (string-match re s) (setq s (replace-match "" t t s)))
482 (while (string-match re2 s) (setq s (replace-match "" t t s)))
483 (setq s (org-trim s))
484 (while (string-match "[ \t]*\n[ \t]*" s)
485 (setq s (replace-match "\\n" t t s)))
486 (if maxlength
487 (if (and (numberp maxlength)
488 (> (length s) maxlength))
489 (setq s (substring s 0 maxlength)))))
490 (setq s (org-trim s)))
491 (while (string-match "\"" s) (setq s (replace-match "''" t t s)))
492 (when (string-match "[;,:]" s) (setq s (concat "\"" s "\"")))
495 (defun org-start-icalendar-file (name)
496 "Start an iCalendar file by inserting the header."
497 (let ((user user-full-name)
498 (name (or name "unknown"))
499 (timezone (cadr (current-time-zone))))
500 (princ
501 (format "BEGIN:VCALENDAR
502 VERSION:2.0
503 X-WR-CALNAME:%s
504 PRODID:-//%s//Emacs with Org-mode//EN
505 X-WR-TIMEZONE:%s
506 CALSCALE:GREGORIAN\n" name user timezone))))
508 (defun org-finish-icalendar-file ()
509 "Finish an iCalendar file by inserting the END statement."
510 (princ "END:VCALENDAR\n"))
512 (defun org-ical-ts-to-string (s keyword &optional inc)
513 "Take a time string S and convert it to iCalendar format.
514 KEYWORD is added in front, to make a complete line like DTSTART....
515 When INC is non-nil, increase the hour by two (if time string contains
516 a time), or the day by one (if it does not contain a time)."
517 (let ((t1 (org-parse-time-string s 'nodefault))
518 t2 fmt have-time time)
519 (if (and (car t1) (nth 1 t1) (nth 2 t1))
520 (setq t2 t1 have-time t)
521 (setq t2 (org-parse-time-string s)))
522 (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
523 (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
524 (when inc
525 (if have-time
526 (if org-agenda-default-appointment-duration
527 (setq mi (+ org-agenda-default-appointment-duration mi))
528 (setq h (+ 2 h)))
529 (setq d (1+ d))))
530 (setq time (encode-time s mi h d m y)))
531 (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d"))
532 (concat keyword (format-time-string fmt time))))
534 (provide 'org-icalendar)
536 ;; arch-tag: 2dee2b6e-9211-4aee-8a47-a3c7e5bc30cf
538 ;;; org-icalendar.el ends here