Commit | Line | Data |
---|---|---|
c8d0cf5c CD |
1 | ;;; org-icalendar.el --- iCalendar export for Org-mode |
2 | ||
b73f1974 | 3 | ;; Copyright (C) 2004-2012 Free Software Foundation, Inc. |
c8d0cf5c CD |
4 | |
5 | ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
6 | ;; Keywords: outlines, hypermedia, calendar, wp | |
7 | ;; Homepage: http://orgmode.org | |
c8d0cf5c CD |
8 | ;; |
9 | ;; This file is part of GNU Emacs. | |
10 | ;; | |
11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation, either version 3 of the License, or | |
14 | ;; (at your option) any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
24 | ;; | |
25 | ;;; Commentary: | |
26 | ||
86fbb8ca CD |
27 | ;;; Code: |
28 | ||
c8d0cf5c CD |
29 | (require 'org-exp) |
30 | ||
8223b1d2 | 31 | (eval-when-compile (require 'cl)) |
86fbb8ca | 32 | |
c8d0cf5c CD |
33 | (declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) |
34 | ||
35 | (defgroup org-export-icalendar nil | |
36 | "Options specific for iCalendar export of Org-mode files." | |
37 | :tag "Org Export iCalendar" | |
38 | :group 'org-export) | |
39 | ||
40 | (defcustom org-combined-agenda-icalendar-file "~/org.ics" | |
41 | "The file name for the iCalendar file covering all agenda files. | |
42 | This file is created with the command \\[org-export-icalendar-all-agenda-files]. | |
43 | The file name should be absolute, the file will be overwritten without warning." | |
44 | :group 'org-export-icalendar | |
45 | :type 'file) | |
46 | ||
afe98dfa CD |
47 | (defcustom org-icalendar-alarm-time 0 |
48 | "Number of minutes for triggering an alarm for exported timed events. | |
49 | A zero value (the default) turns off the definition of an alarm trigger | |
50 | for timed events. If non-zero, alarms are created. | |
51 | ||
52 | - a single alarm per entry is defined | |
53 | - The alarm will go off N minutes before the event | |
54 | - only a DISPLAY action is defined." | |
55 | :group 'org-export-icalendar | |
372d7b21 | 56 | :version "24.1" |
afe98dfa CD |
57 | :type 'integer) |
58 | ||
c8d0cf5c CD |
59 | (defcustom org-icalendar-combined-name "OrgMode" |
60 | "Calendar name for the combined iCalendar representing all agenda files." | |
61 | :group 'org-export-icalendar | |
62 | :type 'string) | |
63 | ||
86fbb8ca | 64 | (defcustom org-icalendar-combined-description nil |
afe98dfa | 65 | "Calendar description for the combined iCalendar (all agenda files)." |
86fbb8ca | 66 | :group 'org-export-icalendar |
372d7b21 | 67 | :version "24.1" |
86fbb8ca CD |
68 | :type 'string) |
69 | ||
8bfe682a | 70 | (defcustom org-icalendar-use-plain-timestamp t |
ed21c5c8 | 71 | "Non-nil means make an event from every plain time stamp." |
8bfe682a CD |
72 | :group 'org-export-icalendar |
73 | :type 'boolean) | |
74 | ||
3ab2c837 BG |
75 | (defcustom org-icalendar-honor-noexport-tag nil |
76 | "Non-nil means don't export entries with a tag in `org-export-exclude-tags'." | |
77 | :group 'org-export-icalendar | |
372d7b21 | 78 | :version "24.1" |
3ab2c837 BG |
79 | :type 'boolean) |
80 | ||
c8d0cf5c CD |
81 | (defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due) |
82 | "Contexts where iCalendar export should use a deadline time stamp. | |
83 | This is a list with several symbols in it. Valid symbol are: | |
84 | ||
85 | event-if-todo Deadlines in TODO entries become calendar events. | |
86 | event-if-not-todo Deadlines in non-TODO entries become calendar events. | |
87 | todo-due Use deadlines in TODO entries as due-dates" | |
88 | :group 'org-export-icalendar | |
89 | :type '(set :greedy t | |
90 | (const :tag "Deadlines in non-TODO entries become events" | |
91 | event-if-not-todo) | |
92 | (const :tag "Deadline in TODO entries become events" | |
93 | event-if-todo) | |
94 | (const :tag "Deadlines in TODO entries become due-dates" | |
95 | todo-due))) | |
96 | ||
97 | (defcustom org-icalendar-use-scheduled '(todo-start) | |
98 | "Contexts where iCalendar export should use a scheduling time stamp. | |
99 | This is a list with several symbols in it. Valid symbol are: | |
100 | ||
101 | event-if-todo Scheduling time stamps in TODO entries become an event. | |
102 | event-if-not-todo Scheduling time stamps in non-TODO entries become an event. | |
103 | todo-start Scheduling time stamps in TODO entries become start date. | |
104 | Some calendar applications show TODO entries only after | |
105 | that date." | |
106 | :group 'org-export-icalendar | |
107 | :type '(set :greedy t | |
108 | (const :tag | |
109 | "SCHEDULED timestamps in non-TODO entries become events" | |
110 | event-if-not-todo) | |
111 | (const :tag "SCHEDULED timestamps in TODO entries become events" | |
112 | event-if-todo) | |
113 | (const :tag "SCHEDULED in TODO entries become start date" | |
114 | todo-start))) | |
115 | ||
116 | (defcustom org-icalendar-categories '(local-tags category) | |
117 | "Items that should be entered into the categories field. | |
118 | This is a list of symbols, the following are valid: | |
119 | ||
120 | category The Org-mode category of the current file or tree | |
121 | todo-state The todo state, if any | |
122 | local-tags The tags, defined in the current line | |
123 | all-tags All tags, including inherited ones." | |
124 | :group 'org-export-icalendar | |
125 | :type '(repeat | |
126 | (choice | |
127 | (const :tag "The file or tree category" category) | |
128 | (const :tag "The TODO state" todo-state) | |
129 | (const :tag "Tags defined in current line" local-tags) | |
130 | (const :tag "All tags, including inherited ones" all-tags)))) | |
131 | ||
132 | (defcustom org-icalendar-include-todo nil | |
ed21c5c8 | 133 | "Non-nil means export to iCalendar files should also cover TODO items. |
c8d0cf5c | 134 | Valid values are: |
8bfe682a | 135 | nil don't include any TODO items |
c8d0cf5c | 136 | t include all TODO items that are not in a DONE state |
8bfe682a | 137 | unblocked include all TODO items that are not blocked |
c8d0cf5c CD |
138 | all include both done and not done items." |
139 | :group 'org-export-icalendar | |
140 | :type '(choice | |
141 | (const :tag "None" nil) | |
142 | (const :tag "Unfinished" t) | |
143 | (const :tag "Unblocked" unblocked) | |
144 | (const :tag "All" all))) | |
145 | ||
8bfe682a CD |
146 | (defvar org-icalendar-verify-function nil |
147 | "Function to verify entries for iCalendar export. | |
148 | This can be set to a function that will be called at each entry that | |
149 | is considered for export to iCalendar. When the function returns nil, | |
150 | the entry will be skipped. When it returns a non-nil value, the entry | |
151 | will be considered for export. | |
152 | This is used internally when an agenda buffer is exported to an ics file, | |
153 | to make sure that only entries currently listed in the agenda will end | |
154 | up in the ics file. But for normal iCalendar export, you can use this | |
155 | for whatever you need.") | |
156 | ||
c8d0cf5c | 157 | (defcustom org-icalendar-include-bbdb-anniversaries nil |
ed21c5c8 | 158 | "Non-nil means a combined iCalendar files should include anniversaries. |
c8d0cf5c CD |
159 | The anniversaries are define in the BBDB database." |
160 | :group 'org-export-icalendar | |
161 | :type 'boolean) | |
162 | ||
163 | (defcustom org-icalendar-include-sexps t | |
ed21c5c8 | 164 | "Non-nil means export to iCalendar files should also cover sexp entries. |
c8d0cf5c CD |
165 | These are entries like in the diary, but directly in an Org-mode file." |
166 | :group 'org-export-icalendar | |
167 | :type 'boolean) | |
168 | ||
169 | (defcustom org-icalendar-include-body 100 | |
170 | "Amount of text below headline to be included in iCalendar export. | |
171 | This is a number of characters that should maximally be included. | |
172 | Properties, scheduling and clocking lines will always be removed. | |
173 | The text will be inserted into the DESCRIPTION field." | |
174 | :group 'org-export-icalendar | |
175 | :type '(choice | |
176 | (const :tag "Nothing" nil) | |
177 | (const :tag "Everything" t) | |
178 | (integer :tag "Max characters"))) | |
179 | ||
180 | (defcustom org-icalendar-store-UID nil | |
ed21c5c8 | 181 | "Non-nil means store any created UIDs in properties. |
c8d0cf5c CD |
182 | The iCalendar standard requires that all entries have a unique identifier. |
183 | Org will create these identifiers as needed. When this variable is non-nil, | |
184 | the created UIDs will be stored in the ID property of the entry. Then the | |
185 | next time this entry is exported, it will be exported with the same UID, | |
86fbb8ca | 186 | superseding the previous form of it. This is essential for |
c8d0cf5c CD |
187 | synchronization services. |
188 | This variable is not turned on by default because we want to avoid creating | |
189 | a property drawer in every entry if people are only playing with this feature, | |
190 | or if they are only using it locally." | |
191 | :group 'org-export-icalendar | |
192 | :type 'boolean) | |
193 | ||
194 | (defcustom org-icalendar-timezone (getenv "TZ") | |
195 | "The time zone string for iCalendar export. | |
8223b1d2 | 196 | When nil or the empty string, use output from \(current-time-zone\)." |
c8d0cf5c CD |
197 | :group 'org-export-icalendar |
198 | :type '(choice | |
199 | (const :tag "Unspecified" nil) | |
200 | (string :tag "Time zone"))) | |
201 | ||
3ab2c837 BG |
202 | ;; Backward compatibility with previous variable |
203 | (defvar org-icalendar-use-UTC-date-time nil) | |
204 | (defcustom org-icalendar-date-time-format | |
205 | (if org-icalendar-use-UTC-date-time | |
206 | ":%Y%m%dT%H%M%SZ" | |
207 | ":%Y%m%dT%H%M%S") | |
e66ba1df | 208 | "Format-string for exporting icalendar DATE-TIME. |
3ab2c837 BG |
209 | See `format-time-string' for a full documentation. The only |
210 | difference is that `org-icalendar-timezone' is used for %Z. | |
211 | ||
212 | Interesting value are: | |
213 | - \":%Y%m%dT%H%M%S\" for local time | |
214 | - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone | |
215 | - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time" | |
216 | ||
afe98dfa | 217 | :group 'org-export-icalendar |
372d7b21 | 218 | :version "24.1" |
3ab2c837 BG |
219 | :type '(choice |
220 | (const :tag "Local time" ":%Y%m%dT%H%M%S") | |
221 | (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S") | |
222 | (const :tag "Universal time" ":%Y%m%dT%H%M%SZ") | |
223 | (string :tag "Explicit format"))) | |
224 | ||
225 | (defun org-icalendar-use-UTC-date-timep () | |
226 | (char-equal (elt org-icalendar-date-time-format | |
227 | (1- (length org-icalendar-date-time-format))) ?Z)) | |
afe98dfa | 228 | |
c8d0cf5c CD |
229 | ;;; iCalendar export |
230 | ||
231 | ;;;###autoload | |
232 | (defun org-export-icalendar-this-file () | |
233 | "Export current file as an iCalendar file. | |
234 | The iCalendar file will be located in the same directory as the Org-mode | |
235 | file, but with extension `.ics'." | |
236 | (interactive) | |
237 | (org-export-icalendar nil buffer-file-name)) | |
238 | ||
239 | ;;;###autoload | |
240 | (defun org-export-icalendar-all-agenda-files () | |
86fbb8ca | 241 | "Export all files in the variable `org-agenda-files' to iCalendar .ics files. |
c8d0cf5c CD |
242 | Each iCalendar file will be located in the same directory as the Org-mode |
243 | file, but with extension `.ics'." | |
244 | (interactive) | |
245 | (apply 'org-export-icalendar nil (org-agenda-files t))) | |
246 | ||
247 | ;;;###autoload | |
248 | (defun org-export-icalendar-combine-agenda-files () | |
249 | "Export all files in `org-agenda-files' to a single combined iCalendar file. | |
250 | The file is stored under the name `org-combined-agenda-icalendar-file'." | |
251 | (interactive) | |
252 | (apply 'org-export-icalendar t (org-agenda-files t))) | |
253 | ||
254 | (defun org-export-icalendar (combine &rest files) | |
255 | "Create iCalendar files for all elements of FILES. | |
256 | If COMBINE is non-nil, combine all calendar entries into a single large | |
257 | file and store it under the name `org-combined-agenda-icalendar-file'." | |
258 | (save-excursion | |
8223b1d2 | 259 | (org-agenda-prepare-buffers files) |
c8d0cf5c CD |
260 | (let* ((dir (org-export-directory |
261 | :ical (list :publishing-directory | |
262 | org-export-publishing-directory))) | |
263 | file ical-file ical-buffer category started org-agenda-new-buffers) | |
264 | (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*")) | |
265 | (when combine | |
266 | (setq ical-file | |
267 | (if (file-name-absolute-p org-combined-agenda-icalendar-file) | |
268 | org-combined-agenda-icalendar-file | |
269 | (expand-file-name org-combined-agenda-icalendar-file dir)) | |
270 | ical-buffer (org-get-agenda-file-buffer ical-file)) | |
271 | (set-buffer ical-buffer) (erase-buffer)) | |
272 | (while (setq file (pop files)) | |
273 | (catch 'nextfile | |
274 | (org-check-agenda-file file) | |
275 | (set-buffer (org-get-agenda-file-buffer file)) | |
276 | (unless combine | |
277 | (setq ical-file (concat (file-name-as-directory dir) | |
278 | (file-name-sans-extension | |
279 | (file-name-nondirectory buffer-file-name)) | |
280 | ".ics")) | |
281 | (setq ical-buffer (org-get-agenda-file-buffer ical-file)) | |
282 | (with-current-buffer ical-buffer (erase-buffer))) | |
283 | (setq category (or org-category | |
284 | (file-name-sans-extension | |
285 | (file-name-nondirectory buffer-file-name)))) | |
286 | (if (symbolp category) (setq category (symbol-name category))) | |
287 | (let ((standard-output ical-buffer)) | |
288 | (if combine | |
289 | (and (not started) (setq started t) | |
8223b1d2 BG |
290 | (org-icalendar-start-file org-icalendar-combined-name)) |
291 | (org-icalendar-start-file category)) | |
292 | (org-icalendar-print-entries combine) | |
c8d0cf5c CD |
293 | (when (or (and combine (not files)) (not combine)) |
294 | (when (and combine org-icalendar-include-bbdb-anniversaries) | |
295 | (require 'org-bbdb) | |
296 | (org-bbdb-anniv-export-ical)) | |
8223b1d2 | 297 | (org-icalendar-finish-file) |
c8d0cf5c CD |
298 | (set-buffer ical-buffer) |
299 | (run-hooks 'org-before-save-iCalendar-file-hook) | |
300 | (save-buffer) | |
301 | (run-hooks 'org-after-save-iCalendar-file-hook) | |
8223b1d2 | 302 | (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))))) |
c8d0cf5c CD |
303 | (org-release-buffers org-agenda-new-buffers)))) |
304 | ||
305 | (defvar org-before-save-iCalendar-file-hook nil | |
306 | "Hook run before an iCalendar file has been saved. | |
307 | This can be used to modify the result of the export.") | |
308 | ||
309 | (defvar org-after-save-iCalendar-file-hook nil | |
310 | "Hook run after an iCalendar file has been saved. | |
311 | The iCalendar buffer is still current when this hook is run. | |
312 | A good way to use this is to tell a desktop calendar application to re-read | |
313 | the iCalendar file.") | |
314 | ||
315 | (defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el | |
8223b1d2 | 316 | (defun org-icalendar-print-entries (&optional combine) |
c8d0cf5c CD |
317 | "Print iCalendar entries for the current Org-mode file to `standard-output'. |
318 | When COMBINE is non nil, add the category to each line." | |
319 | (require 'org-agenda) | |
320 | (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) | |
321 | (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) | |
8223b1d2 | 322 | (dts (org-icalendar-ts-to-string |
c8d0cf5c CD |
323 | (format-time-string (cdr org-time-stamp-formats) (current-time)) |
324 | "DTSTART")) | |
325 | hd ts ts2 state status (inc t) pos b sexp rrule | |
3ab2c837 | 326 | scheduledp deadlinep todo prefix due start tags |
8223b1d2 | 327 | tmp pri categories location summary desc uid alarm alarm-time |
c8d0cf5c CD |
328 | (sexp-buffer (get-buffer-create "*ical-tmp*"))) |
329 | (org-refresh-category-properties) | |
330 | (save-excursion | |
331 | (goto-char (point-min)) | |
332 | (while (re-search-forward re1 nil t) | |
333 | (catch :skip | |
334 | (org-agenda-skip) | |
8bfe682a CD |
335 | (when org-icalendar-verify-function |
336 | (unless (save-match-data (funcall org-icalendar-verify-function)) | |
c8d0cf5c CD |
337 | (outline-next-heading) |
338 | (backward-char 1) | |
339 | (throw :skip nil))) | |
340 | (setq pos (match-beginning 0) | |
341 | ts (match-string 0) | |
3ab2c837 | 342 | tags (org-get-tags-at) |
c8d0cf5c CD |
343 | inc t |
344 | hd (condition-case nil | |
345 | (org-icalendar-cleanup-string | |
afe98dfa | 346 | (org-get-heading t)) |
c8d0cf5c CD |
347 | (error (throw :skip nil))) |
348 | summary (org-icalendar-cleanup-string | |
349 | (org-entry-get nil "SUMMARY")) | |
350 | desc (org-icalendar-cleanup-string | |
351 | (or (org-entry-get nil "DESCRIPTION") | |
352 | (and org-icalendar-include-body (org-get-entry))) | |
353 | t org-icalendar-include-body) | |
354 | location (org-icalendar-cleanup-string | |
355 | (org-entry-get nil "LOCATION" 'selective)) | |
356 | uid (if org-icalendar-store-UID | |
357 | (org-id-get-create) | |
358 | (or (org-id-get) (org-id-new))) | |
359 | categories (org-export-get-categories) | |
8223b1d2 BG |
360 | alarm-time (org-entry-get nil "APPT_WARNTIME") |
361 | alarm-time (if alarm-time (string-to-number alarm-time) 0) | |
afe98dfa | 362 | alarm "" |
c8d0cf5c | 363 | deadlinep nil scheduledp nil) |
8223b1d2 BG |
364 | (setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos) |
365 | deadlinep (string-match org-deadline-regexp tmp) | |
366 | scheduledp (string-match org-scheduled-regexp tmp) | |
367 | todo (org-get-todo-state)) | |
368 | ;; donep (org-entry-is-done-p) | |
c8d0cf5c CD |
369 | (if (looking-at re2) |
370 | (progn | |
371 | (goto-char (match-end 0)) | |
372 | (setq ts2 (match-string 1) | |
373 | inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2)))) | |
8223b1d2 | 374 | (setq ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) |
c8d0cf5c CD |
375 | (progn |
376 | (setq inc nil) | |
377 | (replace-match "\\1" t nil ts)) | |
8223b1d2 | 378 | ts))) |
8bfe682a CD |
379 | (when (and (not org-icalendar-use-plain-timestamp) |
380 | (not deadlinep) (not scheduledp)) | |
381 | (throw :skip t)) | |
3ab2c837 BG |
382 | ;; don't export entries with a :noexport: tag |
383 | (when (and org-icalendar-honor-noexport-tag | |
384 | (delq nil (mapcar (lambda(x) | |
385 | (member x org-export-exclude-tags)) tags))) | |
386 | (throw :skip t)) | |
c8d0cf5c CD |
387 | (when (and |
388 | deadlinep | |
389 | (if todo | |
390 | (not (memq 'event-if-todo org-icalendar-use-deadline)) | |
391 | (not (memq 'event-if-not-todo org-icalendar-use-deadline)))) | |
392 | (throw :skip t)) | |
393 | (when (and | |
394 | scheduledp | |
395 | (if todo | |
396 | (not (memq 'event-if-todo org-icalendar-use-scheduled)) | |
397 | (not (memq 'event-if-not-todo org-icalendar-use-scheduled)))) | |
398 | (throw :skip t)) | |
399 | (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-"))) | |
400 | (if (or (string-match org-tr-regexp hd) | |
401 | (string-match org-ts-regexp hd)) | |
402 | (setq hd (replace-match "" t t hd))) | |
8223b1d2 | 403 | (if (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)>" ts) |
c8d0cf5c CD |
404 | (setq rrule |
405 | (concat "\nRRULE:FREQ=" | |
406 | (cdr (assoc | |
407 | (match-string 2 ts) | |
8223b1d2 | 408 | '(("h" . "HOURLY")("d" . "DAILY")("w" . "WEEKLY") |
c8d0cf5c CD |
409 | ("m" . "MONTHLY")("y" . "YEARLY")))) |
410 | ";INTERVAL=" (match-string 1 ts))) | |
411 | (setq rrule "")) | |
412 | (setq summary (or summary hd)) | |
afe98dfa CD |
413 | ;; create an alarm entry if the entry is timed. this is not very general in that: |
414 | ;; (a) only one alarm per entry is defined, | |
415 | ;; (b) only minutes are allowed for the trigger period ahead of the start time, and | |
416 | ;; (c) only a DISPLAY action is defined. | |
417 | ;; [ESF] | |
418 | (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault)))) | |
8223b1d2 | 419 | (if (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0)) |
afe98dfa | 420 | (car t1) (nth 1 t1) (nth 2 t1)) |
8223b1d2 BG |
421 | (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM" |
422 | summary (or alarm-time org-icalendar-alarm-time))) | |
423 | (setq alarm ""))) | |
c8d0cf5c CD |
424 | (if (string-match org-bracket-link-regexp summary) |
425 | (setq summary | |
426 | (replace-match (if (match-end 3) | |
427 | (match-string 3 summary) | |
428 | (match-string 1 summary)) | |
429 | t t summary))) | |
430 | (if deadlinep (setq summary (concat "DL: " summary))) | |
431 | (if scheduledp (setq summary (concat "S: " summary))) | |
432 | (if (string-match "\\`<%%" ts) | |
433 | (with-current-buffer sexp-buffer | |
3ab2c837 BG |
434 | (let ((entry (substring ts 1 -1))) |
435 | (put-text-property 0 1 'uid | |
436 | (concat " " prefix uid) entry) | |
437 | (insert entry " " summary "\n"))) | |
c8d0cf5c CD |
438 | (princ (format "BEGIN:VEVENT |
439 | UID: %s | |
440 | %s | |
441 | %s%s | |
442 | SUMMARY:%s%s%s | |
afe98dfa | 443 | CATEGORIES:%s%s |
c8d0cf5c CD |
444 | END:VEVENT\n" |
445 | (concat prefix uid) | |
8223b1d2 BG |
446 | (org-icalendar-ts-to-string ts "DTSTART") |
447 | (org-icalendar-ts-to-string ts2 "DTEND" inc) | |
c8d0cf5c CD |
448 | rrule summary |
449 | (if (and desc (string-match "\\S-" desc)) | |
450 | (concat "\nDESCRIPTION: " desc) "") | |
451 | (if (and location (string-match "\\S-" location)) | |
452 | (concat "\nLOCATION: " location) "") | |
afe98dfa CD |
453 | categories |
454 | alarm))))) | |
c8d0cf5c CD |
455 | (when (and org-icalendar-include-sexps |
456 | (condition-case nil (require 'icalendar) (error nil)) | |
457 | (fboundp 'icalendar-export-region)) | |
458 | ;; Get all the literal sexps | |
459 | (goto-char (point-min)) | |
460 | (while (re-search-forward "^&?%%(" nil t) | |
461 | (catch :skip | |
462 | (org-agenda-skip) | |
8bfe682a CD |
463 | (when org-icalendar-verify-function |
464 | (unless (save-match-data (funcall org-icalendar-verify-function)) | |
465 | (outline-next-heading) | |
466 | (backward-char 1) | |
467 | (throw :skip nil))) | |
c8d0cf5c CD |
468 | (setq b (match-beginning 0)) |
469 | (goto-char (1- (match-end 0))) | |
470 | (forward-sexp 1) | |
471 | (end-of-line 1) | |
472 | (setq sexp (buffer-substring b (point))) | |
473 | (with-current-buffer sexp-buffer | |
474 | (insert sexp "\n")))) | |
475 | (princ (org-diary-to-ical-string sexp-buffer)) | |
476 | (kill-buffer sexp-buffer)) | |
477 | ||
478 | (when org-icalendar-include-todo | |
479 | (setq prefix "TODO-") | |
480 | (goto-char (point-min)) | |
afe98dfa | 481 | (while (re-search-forward org-complex-heading-regexp nil t) |
c8d0cf5c CD |
482 | (catch :skip |
483 | (org-agenda-skip) | |
8bfe682a | 484 | (when org-icalendar-verify-function |
c8d0cf5c CD |
485 | (unless (save-match-data |
486 | (funcall org-icalendar-verify-function)) | |
487 | (outline-next-heading) | |
488 | (backward-char 1) | |
489 | (throw :skip nil))) | |
490 | (setq state (match-string 2)) | |
491 | (setq status (if (member state org-done-keywords) | |
492 | "COMPLETED" "NEEDS-ACTION")) | |
493 | (when (and state | |
494 | (cond | |
495 | ;; check if the state is one we should use | |
496 | ((eq org-icalendar-include-todo 'all) | |
497 | ;; all should be included | |
498 | t) | |
499 | ((eq org-icalendar-include-todo 'unblocked) | |
500 | ;; only undone entries that are not blocked | |
501 | (and (member state org-not-done-keywords) | |
502 | (or (not org-blocker-hook) | |
503 | (save-match-data | |
504 | (run-hook-with-args-until-failure | |
505 | 'org-blocker-hook | |
506 | (list :type 'todo-state-change | |
507 | :position (point-at-bol) | |
508 | :from 'todo | |
509 | :to 'done)))))) | |
510 | ((eq org-icalendar-include-todo t) | |
511 | ;; include everything that is not done | |
512 | (member state org-not-done-keywords)))) | |
afe98dfa | 513 | (setq hd (match-string 4) |
c8d0cf5c CD |
514 | summary (org-icalendar-cleanup-string |
515 | (org-entry-get nil "SUMMARY")) | |
516 | desc (org-icalendar-cleanup-string | |
517 | (or (org-entry-get nil "DESCRIPTION") | |
518 | (and org-icalendar-include-body (org-get-entry))) | |
519 | t org-icalendar-include-body) | |
520 | location (org-icalendar-cleanup-string | |
521 | (org-entry-get nil "LOCATION" 'selective)) | |
522 | due (and (member 'todo-due org-icalendar-use-deadline) | |
523 | (org-entry-get nil "DEADLINE")) | |
524 | start (and (member 'todo-start org-icalendar-use-scheduled) | |
8223b1d2 | 525 | (org-entry-get nil "SCHEDULED")) |
c8d0cf5c CD |
526 | categories (org-export-get-categories) |
527 | uid (if org-icalendar-store-UID | |
528 | (org-id-get-create) | |
529 | (or (org-id-get) (org-id-new)))) | |
8223b1d2 BG |
530 | (and due (setq due (org-icalendar-ts-to-string due "DUE"))) |
531 | (and start (setq start (org-icalendar-ts-to-string start "DTSTART"))) | |
c8d0cf5c CD |
532 | |
533 | (if (string-match org-bracket-link-regexp hd) | |
534 | (setq hd (replace-match (if (match-end 3) (match-string 3 hd) | |
535 | (match-string 1 hd)) | |
536 | t t hd))) | |
537 | (if (string-match org-priority-regexp hd) | |
538 | (setq pri (string-to-char (match-string 2 hd)) | |
539 | hd (concat (substring hd 0 (match-beginning 1)) | |
540 | (substring hd (match-end 1)))) | |
541 | (setq pri org-default-priority)) | |
542 | (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri)) | |
543 | (- org-lowest-priority org-highest-priority)))))) | |
544 | ||
545 | (princ (format "BEGIN:VTODO | |
546 | UID: %s | |
547 | %s | |
548 | SUMMARY:%s%s%s%s | |
549 | CATEGORIES:%s | |
550 | SEQUENCE:1 | |
551 | PRIORITY:%d | |
552 | STATUS:%s | |
553 | END:VTODO\n" | |
554 | (concat prefix uid) | |
555 | (or start dts) | |
556 | (or summary hd) | |
557 | (if (and location (string-match "\\S-" location)) | |
558 | (concat "\nLOCATION: " location) "") | |
559 | (if (and desc (string-match "\\S-" desc)) | |
560 | (concat "\nDESCRIPTION: " desc) "") | |
561 | (if due (concat "\n" due) "") | |
562 | categories | |
563 | pri status))))))))) | |
564 | ||
565 | (defun org-export-get-categories () | |
566 | "Get categories according to `org-icalendar-categories'." | |
567 | (let ((cs org-icalendar-categories) c rtn tmp) | |
568 | (while (setq c (pop cs)) | |
569 | (cond | |
570 | ((eq c 'category) (push (org-get-category) rtn)) | |
571 | ((eq c 'todo-state) | |
572 | (setq tmp (org-get-todo-state)) | |
573 | (and tmp (push tmp rtn))) | |
574 | ((eq c 'local-tags) | |
575 | (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn))) | |
576 | ((eq c 'all-tags) | |
577 | (setq rtn (append (nreverse (org-get-tags-at (point))) rtn))))) | |
578 | (mapconcat 'identity (nreverse rtn) ","))) | |
579 | ||
580 | (defun org-icalendar-cleanup-string (s &optional is-body maxlength) | |
581 | "Take out stuff and quote what needs to be quoted. | |
582 | When IS-BODY is non-nil, assume that this is the body of an item, clean up | |
583 | whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH | |
584 | characters." | |
585 | (if (not s) | |
586 | nil | |
86fbb8ca | 587 | (if is-body |
8223b1d2 BG |
588 | (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) |
589 | (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) | |
590 | (while (string-match re s) (setq s (replace-match "" t t s))) | |
591 | (while (string-match re2 s) (setq s (replace-match "" t t s)))) | |
86fbb8ca | 592 | (setq s (replace-regexp-in-string "[[:space:]]+" " " s))) |
c8d0cf5c CD |
593 | (let ((start 0)) |
594 | (while (string-match "\\([,;]\\)" s start) | |
595 | (setq start (+ (match-beginning 0) 2) | |
596 | s (replace-match "\\\\\\1" nil nil s)))) | |
597 | (setq s (org-trim s)) | |
598 | (when is-body | |
599 | (while (string-match "[ \t]*\n[ \t]*" s) | |
600 | (setq s (replace-match "\\n" t t s)))) | |
601 | (if is-body | |
602 | (if maxlength | |
603 | (if (and (numberp maxlength) | |
604 | (> (length s) maxlength)) | |
605 | (setq s (substring s 0 maxlength))))) | |
606 | s)) | |
607 | ||
608 | (defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength) | |
609 | "Take out stuff and quote what needs to be quoted. | |
610 | When IS-BODY is non-nil, assume that this is the body of an item, clean up | |
611 | whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH | |
612 | characters. | |
613 | This seems to be more like RFC 2455, but it causes problems, so it is | |
614 | not used right now." | |
615 | (if (not s) | |
616 | nil | |
617 | (if is-body | |
618 | (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) | |
619 | (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) | |
620 | (while (string-match re s) (setq s (replace-match "" t t s))) | |
621 | (while (string-match re2 s) (setq s (replace-match "" t t s))) | |
622 | (setq s (org-trim s)) | |
623 | (while (string-match "[ \t]*\n[ \t]*" s) | |
624 | (setq s (replace-match "\\n" t t s))) | |
625 | (if maxlength | |
626 | (if (and (numberp maxlength) | |
627 | (> (length s) maxlength)) | |
628 | (setq s (substring s 0 maxlength))))) | |
629 | (setq s (org-trim s))) | |
630 | (while (string-match "\"" s) (setq s (replace-match "''" t t s))) | |
631 | (when (string-match "[;,:]" s) (setq s (concat "\"" s "\""))) | |
632 | s)) | |
633 | ||
8223b1d2 | 634 | (defun org-icalendar-start-file (name) |
c8d0cf5c CD |
635 | "Start an iCalendar file by inserting the header." |
636 | (let ((user user-full-name) | |
637 | (name (or name "unknown")) | |
638 | (timezone (if (> (length org-icalendar-timezone) 0) | |
639 | org-icalendar-timezone | |
86fbb8ca CD |
640 | (cadr (current-time-zone)))) |
641 | (description org-icalendar-combined-description)) | |
c8d0cf5c CD |
642 | (princ |
643 | (format "BEGIN:VCALENDAR | |
644 | VERSION:2.0 | |
645 | X-WR-CALNAME:%s | |
646 | PRODID:-//%s//Emacs with Org-mode//EN | |
647 | X-WR-TIMEZONE:%s | |
86fbb8ca CD |
648 | X-WR-CALDESC:%s |
649 | CALSCALE:GREGORIAN\n" name user timezone description)))) | |
c8d0cf5c | 650 | |
8223b1d2 | 651 | (defun org-icalendar-finish-file () |
c8d0cf5c CD |
652 | "Finish an iCalendar file by inserting the END statement." |
653 | (princ "END:VCALENDAR\n")) | |
654 | ||
8223b1d2 | 655 | (defun org-icalendar-ts-to-string (s keyword &optional inc) |
c8d0cf5c CD |
656 | "Take a time string S and convert it to iCalendar format. |
657 | KEYWORD is added in front, to make a complete line like DTSTART.... | |
658 | When INC is non-nil, increase the hour by two (if time string contains | |
659 | a time), or the day by one (if it does not contain a time)." | |
86fbb8ca | 660 | (let ((t1 (ignore-errors (org-parse-time-string s 'nodefault))) |
c8d0cf5c | 661 | t2 fmt have-time time) |
86fbb8ca CD |
662 | (if (not t1) |
663 | "" | |
664 | (if (and (car t1) (nth 1 t1) (nth 2 t1)) | |
665 | (setq t2 t1 have-time t) | |
666 | (setq t2 (org-parse-time-string s))) | |
667 | (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) | |
668 | (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) | |
669 | (when inc | |
670 | (if have-time | |
671 | (if org-agenda-default-appointment-duration | |
672 | (setq mi (+ org-agenda-default-appointment-duration mi)) | |
673 | (setq h (+ 2 h))) | |
674 | (setq d (1+ d)))) | |
675 | (setq time (encode-time s mi h d m y))) | |
3ab2c837 BG |
676 | (setq fmt (if have-time |
677 | (replace-regexp-in-string "%Z" | |
678 | org-icalendar-timezone | |
679 | org-icalendar-date-time-format) | |
8223b1d2 | 680 | ";VALUE=DATE:%Y%m%d")) |
3ab2c837 BG |
681 | (concat keyword (format-time-string fmt time |
682 | (and (org-icalendar-use-UTC-date-timep) | |
afe98dfa | 683 | have-time)))))) |
c8d0cf5c CD |
684 | |
685 | (provide 'org-icalendar) | |
686 | ||
c8d0cf5c | 687 | ;;; org-icalendar.el ends here |