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