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