(Fexpand_file_name) [VMS]: Don't upcase the name
[bpt/emacs.git] / lisp / calendar / icalendar.el
CommitLineData
e0cd68ee 1;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
707c20a8 2
74692b14 3;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
707c20a8 4
e0cd68ee
GM
5;; Author: Ulf Jasper <ulf.jasper@web.de>
6;; Created: August 2002
7;; Keywords: calendar
707c20a8
GM
8;; Human-Keywords: calendar, diary, iCalendar, vCalendar
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 2, or (at your option)
15;; 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; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; This package is documented in the Emacs Manual.
30
31
32;;; History:
33
81d56594 34;; 0.07 onwards: see lisp/ChangeLog
e0cd68ee
GM
35
36;; 0.06: Bugfixes regarding icalendar-import-format-*.
37;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp
38;; Grau.
707c20a8
GM
39
40;; 0.05: New import format scheme: Replaced icalendar-import-prefix-*,
41;; icalendar-import-ignored-properties, and
42;; icalendar-import-separator with icalendar-import-format(-*).
43;; icalendar-import-file and icalendar-convert-diary-to-ical
44;; have an extra parameter which should prevent them from
45;; erasing their target files (untested!).
46;; Tested with Emacs 21.3.2
47
48;; 0.04: Bugfix: import: double quoted param values did not work
49;; Read DURATION property when importing.
50;; Added parameter icalendar-duration-correction.
51
52;; 0.03: Export takes care of european-calendar-style.
53;; Tested with Emacs 21.3.2 and XEmacs 21.4.12
54
55;; 0.02: Should work in XEmacs now. Thanks to Len Trigg for the
56;; XEmacs patches!
57;; Added exporting from Emacs diary to ical.
58;; Some bugfixes, after testing with calendars from
59;; http://icalshare.com.
60;; Tested with Emacs 21.3.2 and XEmacs 21.4.12
61
62;; 0.01: First published version. Trial version. Alpha version.
63
64;; ======================================================================
65;; To Do:
66
e0cd68ee 67;; * Import from ical to diary:
707c20a8
GM
68;; + Need more properties for icalendar-import-format
69;; + check vcalendar version
70;; + check (unknown) elements
71;; + recurring events!
72;; + works for european style calendars only! Does it?
73;; + alarm
74;; + exceptions in recurring events
75;; + the parser is too soft
76;; + error log is incomplete
77;; + nice to have: #include "webcal://foo.com/some-calendar.ics"
78
e0cd68ee 79;; * Export from diary to ical
707c20a8
GM
80;; + diary-date, diary-float, and self-made sexp entries are not
81;; understood
82;; + timezones, currently all times are local!
83
84;; * Other things
707c20a8
GM
85;; + clean up all those date/time parsing functions
86;; + Handle todo items?
87;; + Check iso 8601 for datetime and period
88;; + Which chars to (un)escape?
707c20a8
GM
89
90
91;;; Code:
92
8ee7eb6b 93(defconst icalendar-version 0.10
707c20a8
GM
94 "Version number of icalendar.el.")
95
96;; ======================================================================
97;; Customizables
98;; ======================================================================
99(defgroup icalendar nil
100 "Icalendar support."
101 :prefix "icalendar-"
102 :group 'calendar)
103
104(defcustom icalendar-import-format
105 "%s%d%l%o"
106 "Format string for importing events from iCalendar into Emacs diary.
107This string defines how iCalendar events are inserted into diary
108file. Meaning of the specifiers:
109%d Description, see `icalendar-import-format-description'
110%l Location, see `icalendar-import-format-location'
111%o Organizer, see `icalendar-import-format-organizer'
112%s Subject, see `icalendar-import-format-subject'"
113 :type 'string
114 :group 'icalendar)
115
116(defcustom icalendar-import-format-subject
117 "%s"
118 "Format string defining how the subject element is formatted.
119This applies only if the subject is not empty! `%s' is replaced
120by the subject."
121 :type 'string
122 :group 'icalendar)
123
124(defcustom icalendar-import-format-description
125 "\n Desc: %s"
126 "Format string defining how the description element is formatted.
127This applies only if the description is not empty! `%s' is
128replaced by the description."
129 :type 'string
130 :group 'icalendar)
131
132(defcustom icalendar-import-format-location
133 "\n Location: %s"
134 "Format string defining how the location element is formatted.
135This applies only if the location is not empty! `%s' is replaced
136by the location."
137 :type 'string
138 :group 'icalendar)
139
140(defcustom icalendar-import-format-organizer
141 "\n Organizer: %s"
142 "Format string defining how the organizer element is formatted.
143This applies only if the organizer is not empty! `%s' is
144replaced by the organizer."
145 :type 'string
146 :group 'icalendar)
147
148(defcustom icalendar-duration-correction
149 t
150 "Workaround for all-day events.
151If non-nil the length=duration of iCalendar appointments that
152have a length of exactly n days is decreased by one day. This
153fixes problems with all-day events, which appear to be one day
154longer than they are."
155 :type 'boolean
156 :group 'icalendar)
157
158
159;; ======================================================================
160;; NO USER SERVICABLE PARTS BELOW THIS LINE
161;; ======================================================================
162
f2aa5449 163(defconst icalendar--weekday-array ["SU" "MO" "TU" "WE" "TH" "FR" "SA"])
707c20a8
GM
164
165(defvar icalendar-debug nil ".")
166
167;; ======================================================================
168;; all the other libs we need
169;; ======================================================================
170(require 'calendar)
171(require 'appt)
172
e0cd68ee
GM
173;; ======================================================================
174;; misc
175;; ======================================================================
176(defun icalendar--dmsg (&rest args)
177 "Print message ARGS if `icalendar-debug' is non-nil."
178 (if icalendar-debug
179 (apply 'message args)))
180
707c20a8
GM
181;; ======================================================================
182;; Core functionality
183;; Functions for parsing icalendars, importing and so on
184;; ======================================================================
185
e0cd68ee 186(defun icalendar--get-unfolded-buffer (folded-ical-buffer)
707c20a8
GM
187 "Return a new buffer containing the unfolded contents of a buffer.
188Folding is the iCalendar way of wrapping long lines. In the
189created buffer all occurrences of CR LF BLANK are replaced by the
190empty string. Argument FOLDED-ICAL-BUFFER is the unfolded input
191buffer."
192 (let ((unfolded-buffer (get-buffer-create " *icalendar-work*")))
193 (save-current-buffer
194 (set-buffer unfolded-buffer)
195 (erase-buffer)
196 (insert-buffer folded-ical-buffer)
197 (while (re-search-forward "\r?\n[ \t]" nil t)
e0cd68ee 198 (replace-match "" nil nil)))
707c20a8
GM
199 unfolded-buffer))
200
e0cd68ee
GM
201(defsubst icalendar--rris (re rp st)
202 "Replace regexp RE with RP in string ST and return the new string.
203This is here for compatibility with XEmacs."
707c20a8
GM
204 ;; XEmacs:
205 (if (fboundp 'replace-in-string)
206 (save-match-data ;; apparently XEmacs needs save-match-data
207 (replace-in-string st re rp))
208 ;; Emacs:
209 (replace-regexp-in-string re rp st)))
210
e0cd68ee 211(defun icalendar--read-element (invalue inparams)
707c20a8
GM
212 "Recursively read the next iCalendar element in the current buffer.
213INVALUE gives the current iCalendar element we are reading.
214INPARAMS gives the current parameters.....
215This function calls itself recursively for each nested calendar element
216it finds"
217 (let (element children line name params param param-name param-value
218 value
e0cd68ee 219 (continue t))
707c20a8
GM
220 (setq children '())
221 (while (and continue
222 (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t))
223 (setq name (intern (match-string 1)))
224 (backward-char 1)
225 (setq params '())
226 (setq line '())
227 (while (looking-at ";")
228 (re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil)
229 (setq param-name (intern (match-string 1)))
230 (re-search-forward "\\(\\([^;,:\"]+\\)\\|\"\\([^\"]+\\)\"\\)[;:]"
231 nil t)
232 (backward-char 1)
233 (setq param-value (or (match-string 2) (match-string 3)))
234 (setq param (list param-name param-value))
235 (while (looking-at ",")
236 (re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)"
237 nil t)
238 (if (match-string 2)
239 (setq param-value (match-string 2))
240 (setq param-value (match-string 3)))
241 (setq param (append param param-value)))
242 (setq params (append params param)))
243 (unless (looking-at ":")
244 (error "Oops"))
245 (forward-char 1)
246 (re-search-forward "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t)
e0cd68ee 247 (setq value (icalendar--rris "\r?\n[ \t]" "" (match-string 0)))
707c20a8
GM
248 (setq line (list name params value))
249 (cond ((eq name 'BEGIN)
250 (setq children
251 (append children
e0cd68ee
GM
252 (list (icalendar--read-element (intern value)
253 params)))))
707c20a8
GM
254 ((eq name 'END)
255 (setq continue nil))
256 (t
257 (setq element (append element (list line))))))
258 (if invalue
259 (list invalue inparams element children)
260 children)))
261
262;; ======================================================================
263;; helper functions for examining events
264;; ======================================================================
265
e0cd68ee
GM
266;;(defsubst icalendar--get-all-event-properties (event)
267;; "Return the list of properties in this EVENT."
268;; (car (cddr event)))
707c20a8 269
e0cd68ee 270(defun icalendar--get-event-property (event prop)
74692b14 271 "For the given EVENT return the value of the first occurence of PROP."
707c20a8
GM
272 (catch 'found
273 (let ((props (car (cddr event))) pp)
274 (while props
275 (setq pp (car props))
276 (if (eq (car pp) prop)
277 (throw 'found (car (cddr pp))))
278 (setq props (cdr props))))
279 nil))
280
74692b14
GM
281(defun icalendar--get-event-property-attributes (event prop)
282 "For the given EVENT return attributes of the first occurence of PROP."
283 (catch 'found
284 (let ((props (car (cddr event))) pp)
285 (while props
286 (setq pp (car props))
287 (if (eq (car pp) prop)
288 (throw 'found (cadr pp)))
289 (setq props (cdr props))))
290 nil))
291
292(defun icalendar--get-event-properties (event prop)
293 "For the given EVENT return a list of all values of the property PROP."
294 (let ((props (car (cddr event))) pp result)
295 (while props
296 (setq pp (car props))
297 (if (eq (car pp) prop)
298 (setq result (cons (car (cddr pp)) result)))
299 (setq props (cdr props)))
300 result))
301
e0cd68ee
GM
302;; (defun icalendar--set-event-property (event prop new-value)
303;; "For the given EVENT set the property PROP to the value NEW-VALUE."
304;; (catch 'found
305;; (let ((props (car (cddr event))) pp)
306;; (while props
307;; (setq pp (car props))
308;; (when (eq (car pp) prop)
309;; (setcdr (cdr pp) new-value)
310;; (throw 'found (car (cddr pp))))
311;; (setq props (cdr props)))
312;; (setq props (car (cddr event)))
313;; (setcar (cddr event)
314;; (append props (list (list prop nil new-value)))))))
315
316(defun icalendar--get-children (node name)
707c20a8
GM
317 "Return all children of the given NODE which have a name NAME.
318For instance the VCALENDAR node can have VEVENT children as well as VTODO
319children."
320 (let ((result nil)
321 (children (cadr (cddr node))))
322 (when (eq (car node) name)
323 (setq result node))
324 ;;(message "%s" node)
325 (when children
326 (let ((subresult
327 (delq nil
e0cd68ee
GM
328 (mapcar (lambda (n)
329 (icalendar--get-children n name))
330 children))))
707c20a8
GM
331 (if subresult
332 (if result
333 (setq result (append result subresult))
334 (setq result subresult)))))
335 result))
336
e0cd68ee
GM
337 ; private
338(defun icalendar--all-events (icalendar)
707c20a8 339 "Return the list of all existing events in the given ICALENDAR."
e0cd68ee 340 (icalendar--get-children (car icalendar) 'VEVENT))
707c20a8 341
e0cd68ee 342(defun icalendar--split-value (value-string)
74692b14 343 "Split VALUE-STRING at ';='."
707c20a8
GM
344 (let ((result '())
345 param-name param-value)
346 (when value-string
347 (save-current-buffer
81d56594 348 (set-buffer (get-buffer-create " *icalendar-work*"))
707c20a8
GM
349 (set-buffer-modified-p nil)
350 (erase-buffer)
351 (insert value-string)
352 (goto-char (point-min))
353 (while
e0cd68ee
GM
354 (re-search-forward
355 "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
356 nil t)
707c20a8
GM
357 (setq param-name (intern (match-string 1)))
358 (setq param-value (match-string 2))
359 (setq result
e0cd68ee 360 (append result (list (list param-name param-value)))))))
707c20a8
GM
361 result))
362
8ee7eb6b 363(defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift)
707c20a8 364 "Return ISODATETIMESTRING in format like `decode-time'.
8ee7eb6b
GM
365Converts from ISO-8601 to Emacs representation. If
366ISODATETIMESTRING specifies UTC time (trailing letter Z) the
367decoded time is given in the local time zone! If optional
368parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
369days.
370
371FIXME: TZID-attributes are ignored....!
372FIXME: multiple comma-separated values should be allowed!"
e0cd68ee 373 (icalendar--dmsg isodatetimestring)
707c20a8
GM
374 (if isodatetimestring
375 ;; day/month/year must be present
376 (let ((year (read (substring isodatetimestring 0 4)))
377 (month (read (substring isodatetimestring 4 6)))
378 (day (read (substring isodatetimestring 6 8)))
379 (hour 0)
380 (minute 0)
381 (second 0))
382 (when (> (length isodatetimestring) 12)
e0cd68ee 383 ;; hour/minute present
707c20a8
GM
384 (setq hour (read (substring isodatetimestring 9 11)))
385 (setq minute (read (substring isodatetimestring 11 13))))
386 (when (> (length isodatetimestring) 14)
e0cd68ee 387 ;; seconds present
707c20a8
GM
388 (setq second (read (substring isodatetimestring 13 15))))
389 (when (and (> (length isodatetimestring) 15)
e0cd68ee 390 ;; UTC specifier present
707c20a8
GM
391 (char-equal ?Z (aref isodatetimestring 15)))
392 ;; if not UTC add current-time-zone offset
393 (setq second (+ (car (current-time-zone)) second)))
8ee7eb6b
GM
394 ;; shift if necessary
395 (if day-shift
396 (let ((mdy (calendar-gregorian-from-absolute
397 (+ (calendar-absolute-from-gregorian
398 (list month day year))
399 day-shift))))
400 (setq month (nth 0 mdy))
401 (setq day (nth 1 mdy))
402 (setq year (nth 2 mdy))))
707c20a8
GM
403 ;; create the decoded date-time
404 ;; FIXME!?!
405 (condition-case nil
406 (decode-time (encode-time second minute hour day month year))
407 (error
408 (message "Cannot decode \"%s\"" isodatetimestring)
409 ;; hope for the best...
410 (list second minute hour day month year 0 nil 0))))
411 ;; isodatetimestring == nil
412 nil))
413
e0cd68ee 414(defun icalendar--decode-isoduration (isodurationstring)
707c20a8
GM
415 "Return ISODURATIONSTRING in format like `decode-time'.
416Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING
417specifies UTC time (trailing letter Z) the decoded time is given in
418the local time zone! FIXME: TZID-attributes are ignored....! FIXME:
419multiple comma-separated values should be allowed!"
420 (if isodurationstring
421 (save-match-data
422 (string-match
423 (concat
424 "^P[+-]?\\("
425 "\\(\\([0-9]+\\)D\\)" ; days only
426 "\\|"
427 "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days
e0cd68ee 428 "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time
707c20a8
GM
429 "\\|"
430 "\\(\\([0-9]+\\)W\\)" ; weeks only
431 "\\)$") isodurationstring)
432 (let ((seconds 0)
433 (minutes 0)
434 (hours 0)
435 (days 0)
436 (months 0)
437 (years 0))
e0cd68ee
GM
438 (cond
439 ((match-beginning 2) ;days only
440 (setq days (read (substring isodurationstring
441 (match-beginning 3)
442 (match-end 3))))
443 (when icalendar-duration-correction
444 (setq days (1- days))))
445 ((match-beginning 4) ;days and time
446 (if (match-beginning 5)
447 (setq days (* 7 (read (substring isodurationstring
448 (match-beginning 6)
449 (match-end 6))))))
450 (if (match-beginning 7)
451 (setq hours (read (substring isodurationstring
452 (match-beginning 8)
453 (match-end 8)))))
454 (if (match-beginning 9)
455 (setq minutes (read (substring isodurationstring
456 (match-beginning 10)
457 (match-end 10)))))
458 (if (match-beginning 11)
459 (setq seconds (read (substring isodurationstring
460 (match-beginning 12)
74692b14 461 (match-end 12))))))
e0cd68ee
GM
462 ((match-beginning 13) ;weeks only
463 (setq days (* 7 (read (substring isodurationstring
464 (match-beginning 14)
74692b14 465 (match-end 14)))))))
e0cd68ee 466 (list seconds minutes hours days months years)))
707c20a8
GM
467 ;; isodatetimestring == nil
468 nil))
469
e0cd68ee 470(defun icalendar--add-decoded-times (time1 time2)
707c20a8
GM
471 "Add TIME1 to TIME2.
472Both times must be given in decoded form. One of these times must be
473valid (year > 1900 or something)."
474 ;; FIXME: does this function exist already?
475 (decode-time (encode-time
476 (+ (nth 0 time1) (nth 0 time2))
477 (+ (nth 1 time1) (nth 1 time2))
478 (+ (nth 2 time1) (nth 2 time2))
479 (+ (nth 3 time1) (nth 3 time2))
480 (+ (nth 4 time1) (nth 4 time2))
481 (+ (nth 5 time1) (nth 5 time2))
482 nil
483 nil
484 ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
485 )))
486
74692b14 487(defun icalendar--datetime-to-noneuropean-date (datetime &optional separator)
707c20a8 488 "Convert the decoded DATETIME to non-european-style format.
74692b14
GM
489Optional argument SEPARATOR gives the separator between month,
490day, and year. If nil a blank character is used as separator.
491Non-European format: \"month day year\"."
707c20a8 492 (if datetime
74692b14
GM
493 (format "%d%s%d%s%d" (nth 4 datetime) ;month
494 (or separator " ")
495 (nth 3 datetime) ;day
496 (or separator " ")
497 (nth 5 datetime)) ;year
707c20a8
GM
498 ;; datetime == nil
499 nil))
500
74692b14 501(defun icalendar--datetime-to-european-date (datetime &optional separator)
707c20a8 502 "Convert the decoded DATETIME to European format.
74692b14
GM
503Optional argument SEPARATOR gives the separator between month,
504day, and year. If nil a blank character is used as separator.
707c20a8
GM
505European format: (day month year).
506FIXME"
507 (if datetime
74692b14
GM
508 (format "%d%s%d%s%d" (nth 3 datetime) ;day
509 (or separator " ")
e0cd68ee 510 (nth 4 datetime) ;month
74692b14 511 (or separator " ")
e0cd68ee 512 (nth 5 datetime)) ;year
707c20a8
GM
513 ;; datetime == nil
514 nil))
515
74692b14
GM
516(defun icalendar--datetime-to-diary-date (datetime &optional separator)
517 "Convert the decoded DATETIME to diary format.
518Optional argument SEPARATOR gives the separator between month,
519day, and year. If nil a blank character is used as separator.
520Call icalendar--datetime-to-(non)-european-date according to
521value of `european-calendar-style'."
522 (if european-calendar-style
523 (icalendar--datetime-to-european-date datetime separator)
524 (icalendar--datetime-to-noneuropean-date datetime separator)))
525
e0cd68ee 526(defun icalendar--datetime-to-colontime (datetime)
707c20a8
GM
527 "Extract the time part of a decoded DATETIME into 24-hour format.
528Note that this silently ignores seconds."
529 (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime)))
530
e0cd68ee 531(defun icalendar--get-month-number (monthname)
707c20a8 532 "Return the month number for the given MONTHNAME."
f2aa5449
GM
533 (catch 'found
534 (let ((num 1)
535 (m (downcase monthname)))
536 (mapc (lambda (month)
537 (let ((mm (downcase month)))
538 (if (or (string-equal mm m)
539 (string-equal (substring mm 0 3) m))
540 (throw 'found num))
541 (setq num (1+ num))))
542 calendar-month-name-array))
543 ;; Error:
544 -1))
545
546(defun icalendar--get-weekday-number (abbrevweekday)
547 "Return the number for the ABBREVWEEKDAY."
74692b14
GM
548 (if abbrevweekday
549 (catch 'found
550 (let ((num 0)
551 (aw (downcase abbrevweekday)))
552 (mapc (lambda (day)
553 (let ((d (downcase day)))
554 (if (string-equal d aw)
555 (throw 'found num))
556 (setq num (1+ num))))
557 icalendar--weekday-array)))
f2aa5449
GM
558 ;; Error:
559 -1))
707c20a8 560
e0cd68ee 561(defun icalendar--get-weekday-abbrev (weekday)
707c20a8 562 "Return the abbreviated WEEKDAY."
f2aa5449
GM
563 (catch 'found
564 (let ((num 0)
565 (w (downcase weekday)))
566 (mapc (lambda (day)
567 (let ((d (downcase day)))
568 (if (or (string-equal d w)
569 (string-equal (substring d 0 3) w))
570 (throw 'found (aref icalendar--weekday-array num)))
571 (setq num (1+ num))))
572 calendar-day-name-array))
573 ;; Error:
81d56594
GM
574 nil))
575
576(defun icalendar--date-to-isodate (date &optional day-shift)
577 "Convert DATE to iso-style date.
578DATE must be a list of the form (month day year).
579If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
580 (let ((mdy (calendar-gregorian-from-absolute
581 (+ (calendar-absolute-from-gregorian date)
582 (or day-shift 0)))))
583 (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
584
707c20a8 585
e0cd68ee 586(defun icalendar--datestring-to-isodate (datestring &optional day-shift)
707c20a8
GM
587 "Convert diary-style DATESTRING to iso-style date.
588If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
589-- DAY-SHIFT must be either nil or an integer. This function
590takes care of european-style."
591 (let ((day -1) month year)
592 (save-match-data
e0cd68ee
GM
593 (cond ( ;; numeric date
594 (string-match (concat "\\s-*"
595 "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
596 "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
597 "\\([0-9]\\{4\\}\\)")
598 datestring)
599 (setq day (read (substring datestring (match-beginning 1)
600 (match-end 1))))
601 (setq month (read (substring datestring (match-beginning 2)
602 (match-end 2))))
603 (setq year (read (substring datestring (match-beginning 3)
604 (match-end 3))))
605 (unless european-calendar-style
606 (let ((x month))
607 (setq month day)
608 (setq day x))))
609 ( ;; date contains month names -- european-style
610 (and european-calendar-style
611 (string-match (concat "\\s-*"
612 "0?\\([123]?[0-9]\\)[ \t/]\\s-*"
613 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
614 "\\([0-9]\\{4\\}\\)")
615 datestring))
616 (setq day (read (substring datestring (match-beginning 1)
617 (match-end 1))))
618 (setq month (icalendar--get-month-number
619 (substring datestring (match-beginning 2)
620 (match-end 2))))
621 (setq year (read (substring datestring (match-beginning 3)
622 (match-end 3)))))
623 ( ;; date contains month names -- non-european-style
624 (and (not european-calendar-style)
625 (string-match (concat "\\s-*"
626 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
627 "0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
628 "\\([0-9]\\{4\\}\\)")
629 datestring))
630 (setq day (read (substring datestring (match-beginning 2)
631 (match-end 2))))
632 (setq month (icalendar--get-month-number
633 (substring datestring (match-beginning 1)
634 (match-end 1))))
635 (setq year (read (substring datestring (match-beginning 3)
636 (match-end 3)))))
637 (t
638 nil)))
707c20a8 639 (if (> day 0)
e0cd68ee
GM
640 (let ((mdy (calendar-gregorian-from-absolute
641 (+ (calendar-absolute-from-gregorian (list month day
81d56594 642 year))
e0cd68ee
GM
643 (or day-shift 0)))))
644 (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
707c20a8
GM
645 nil)))
646
e0cd68ee 647(defun icalendar--diarytime-to-isotime (timestring ampmstring)
707c20a8
GM
648 "Convert a a time like 9:30pm to an iso-conform string like T213000.
649In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING
650would be \"pm\"."
651 (if timestring
e0cd68ee 652 (let ((starttimenum (read (icalendar--rris ":" "" timestring))))
707c20a8
GM
653 ;; take care of am/pm style
654 (if (and ampmstring (string= "pm" ampmstring))
655 (setq starttimenum (+ starttimenum 1200)))
656 (format "T%04d00" starttimenum))
657 nil))
658
74692b14
GM
659(defun icalendar--convert-string-for-export (string)
660 "Escape comma and other critical characters in STRING."
661 (icalendar--rris "," "\\\\," string))
707c20a8 662
e0cd68ee 663(defun icalendar--convert-string-for-import (string)
707c20a8 664 "Remove escape chars for comma, semicolon etc. from STRING."
e0cd68ee
GM
665 (icalendar--rris
666 "\\\\n" "\n " (icalendar--rris
667 "\\\\\"" "\"" (icalendar--rris
668 "\\\\;" ";" (icalendar--rris
669 "\\\\," "," string)))))
707c20a8
GM
670
671;; ======================================================================
e0cd68ee 672;; Export -- convert emacs-diary to icalendar
707c20a8
GM
673;; ======================================================================
674
e0cd68ee
GM
675;; User function
676(defun icalendar-export-file (diary-filename ical-filename)
677 "Export diary file to iCalendar format.
678All diary entries in the file DIARY-FILENAME are converted to iCalendar
679format. The result is appended to the file ICAL-FILENAME."
81d56594 680 (interactive "FExport diary data from file:
707c20a8 681Finto iCalendar file: ")
e0cd68ee
GM
682 (save-current-buffer
683 (set-buffer (find-file diary-filename))
684 (icalendar-export-region (point-min) (point-max) ical-filename)))
685
686(defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file)
81d56594 687(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file)
e0cd68ee
GM
688
689;; User function
690(defun icalendar-export-region (min max ical-filename)
691 "Export region in diary file to iCalendar format.
692All diary entries in the region from MIN to MAX in the current buffer are
693converted to iCalendar format. The result is appended to the file
81d56594 694ICAL-FILENAME.
74692b14
GM
695This function attempts to return t if something goes wrong. In this
696case an error string which describes all the errors and problems is
697written into the buffer `*icalendar-errors*'."
e0cd68ee
GM
698 (interactive "r
699FExport diary data into iCalendar file: ")
707c20a8
GM
700 (let ((result "")
701 (start 0)
702 (entry-main "")
703 (entry-rest "")
704 (header "")
705 (contents)
81d56594 706 (found-error nil)
707c20a8 707 (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
e0cd68ee 708 "?")))
81d56594
GM
709 ;; prepare buffer with error messages
710 (save-current-buffer
711 (set-buffer (get-buffer-create " *icalendar-errors*"))
712 (erase-buffer))
74692b14 713
81d56594 714 ;; here we go
e0cd68ee
GM
715 (save-excursion
716 (goto-char min)
707c20a8 717 (while (re-search-forward
f2aa5449 718 "^\\([^ \t\n].*\\)\\(\\(\n[ \t].*\\)*\\)" max t)
707c20a8
GM
719 (setq entry-main (match-string 1))
720 (if (match-beginning 2)
721 (setq entry-rest (match-string 2))
722 (setq entry-rest ""))
723 (setq header (format "\nBEGIN:VEVENT\nUID:emacs%d%d%d"
724 (car (current-time))
725 (cadr (current-time))
726 (car (cddr (current-time)))))
81d56594
GM
727 (condition-case error-val
728 (progn
729 (cond
730 ;; anniversaries
731 ((string-match
732 (concat nonmarker
733 "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)")
734 entry-main)
735 (icalendar--dmsg "diary-anniversary %s" entry-main)
736 (let* ((datetime (substring entry-main (match-beginning 1)
737 (match-end 1)))
738 (summary (icalendar--convert-string-for-export
739 (substring entry-main (match-beginning 2)
740 (match-end 2))))
741 (startisostring (icalendar--datestring-to-isodate
742 datetime))
743 (endisostring (icalendar--datestring-to-isodate
744 datetime 1)))
745 (setq contents
746 (concat "\nDTSTART;VALUE=DATE:" startisostring
747 "\nDTEND;VALUE=DATE:" endisostring
748 "\nSUMMARY:" summary
749 "\nRRULE:FREQ=YEARLY;INTERVAL=1"
750 ;; the following is redundant,
751 ;; but korganizer seems to expect this... ;(
752 ;; and evolution doesn't understand it... :(
753 ;; so... who is wrong?!
74692b14
GM
754 ";BYMONTH="
755 (substring startisostring 4 6)
756 ";BYMONTHDAY="
757 (substring startisostring 6 8))))
81d56594 758 (unless (string= entry-rest "")
74692b14
GM
759 (setq contents
760 (concat contents "\nDESCRIPTION:"
761 (icalendar--convert-string-for-export
762 entry-rest)))))
81d56594
GM
763 ;; cyclic events
764 ;; %%(diary-cyclic )
765 ((string-match
766 (concat nonmarker
767 "%%(diary-cyclic \\([^ ]+\\) +"
768 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)")
769 entry-main)
770 (icalendar--dmsg "diary-cyclic %s" entry-main)
771 (let* ((frequency (substring entry-main (match-beginning 1)
772 (match-end 1)))
773 (datetime (substring entry-main (match-beginning 2)
774 (match-end 2)))
775 (summary (icalendar--convert-string-for-export
776 (substring entry-main (match-beginning 3)
777 (match-end 3))))
778 (startisostring (icalendar--datestring-to-isodate
779 datetime))
780 (endisostring (icalendar--datestring-to-isodate
781 datetime 1)))
782 (setq contents
783 (concat "\nDTSTART;VALUE=DATE:" startisostring
784 "\nDTEND;VALUE=DATE:" endisostring
785 "\nSUMMARY:" summary
786 "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
787 ;; strange: korganizer does not expect
788 ;; BYSOMETHING here...
789 )))
790 (unless (string= entry-rest "")
74692b14
GM
791 (setq contents
792 (concat contents "\nDESCRIPTION:"
793 (icalendar--convert-string-for-export
794 entry-rest)))))
81d56594
GM
795 ;; diary-date -- FIXME
796 ((string-match
797 (concat nonmarker
798 "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)")
799 entry-main)
800 (icalendar--dmsg "diary-date %s" entry-main)
801 (error "`diary-date' is not supported yet"))
802 ;; float events -- FIXME
803 ((string-match
804 (concat nonmarker
805 "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)")
806 entry-main)
807 (icalendar--dmsg "diary-float %s" entry-main)
808 (error "`diary-float' is not supported yet"))
809 ;; block events
810 ((string-match
811 (concat nonmarker
74692b14
GM
812 "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)"
813 " +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
814 "\\(.*\\)")
81d56594
GM
815 entry-main)
816 (icalendar--dmsg "diary-block %s" entry-main)
74692b14
GM
817 (let* ((startstring (substring entry-main
818 (match-beginning 1)
81d56594 819 (match-end 1)))
74692b14
GM
820 (endstring (substring entry-main
821 (match-beginning 2)
81d56594
GM
822 (match-end 2)))
823 (summary (icalendar--convert-string-for-export
824 (substring entry-main (match-beginning 3)
825 (match-end 3))))
826 (startisostring (icalendar--datestring-to-isodate
827 startstring))
828 (endisostring (icalendar--datestring-to-isodate
829 endstring 1)))
830 (setq contents
831 (concat "\nDTSTART;VALUE=DATE:" startisostring
832 "\nDTEND;VALUE=DATE:" endisostring
74692b14 833 "\nSUMMARY:" summary))
81d56594 834 (unless (string= entry-rest "")
74692b14
GM
835 (setq contents
836 (concat contents "\nDESCRIPTION:"
837 (icalendar--convert-string-for-export
838 entry-rest))))))
81d56594
GM
839 ;; other sexp diary entries -- FIXME
840 ((string-match
841 (concat nonmarker
842 "%%(\\([^)]+\\))\\s-*\\(.*\\)")
843 entry-main)
844 (icalendar--dmsg "diary-sexp %s" entry-main)
845 (error "sexp-entries are not supported yet"))
846 ;; weekly by day
847 ;; Monday 8:30 Team meeting
848 ((and (string-match
849 (concat nonmarker
850 "\\([a-z]+\\)\\s-+"
74692b14
GM
851 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)"
852 "\\([ap]m\\)?"
81d56594 853 "\\(-0?"
74692b14
GM
854 "\\([1-9][0-9]?:[0-9][0-9]\\)"
855 "\\([ap]m\\)?\\)?"
81d56594
GM
856 "\\)?"
857 "\\s-*\\(.*\\)$")
858 entry-main)
859 (icalendar--get-weekday-abbrev
74692b14
GM
860 (substring entry-main (match-beginning 1)
861 (match-end 1))))
81d56594
GM
862 (icalendar--dmsg "weekly %s" entry-main)
863 (let* ((day (icalendar--get-weekday-abbrev
864 (substring entry-main (match-beginning 1)
865 (match-end 1))))
866 (starttimestring (icalendar--diarytime-to-isotime
867 (if (match-beginning 3)
868 (substring entry-main
869 (match-beginning 3)
870 (match-end 3))
871 nil)
872 (if (match-beginning 4)
873 (substring entry-main
874 (match-beginning 4)
875 (match-end 4))
876 nil)))
877 (endtimestring (icalendar--diarytime-to-isotime
878 (if (match-beginning 6)
879 (substring entry-main
880 (match-beginning 6)
881 (match-end 6))
882 nil)
883 (if (match-beginning 7)
884 (substring entry-main
885 (match-beginning 7)
886 (match-end 7))
887 nil)))
888 (summary (icalendar--convert-string-for-export
889 (substring entry-main (match-beginning 8)
890 (match-end 8)))))
891 (when starttimestring
892 (unless endtimestring
74692b14
GM
893 (let ((time (read
894 (icalendar--rris "^T0?" ""
895 starttimestring))))
896 (setq endtimestring (format "T%06d"
897 (+ 10000 time))))))
81d56594
GM
898 (setq contents
899 (concat "\nDTSTART;"
900 (if starttimestring
901 "VALUE=DATE-TIME:"
902 "VALUE=DATE:")
903 ;; find the correct week day,
904 ;; 1st january 2000 was a saturday
905 (format
906 "200001%02d"
907 (+ (icalendar--get-weekday-number day) 2))
908 (or starttimestring "")
909 "\nDTEND;"
910 (if endtimestring
911 "VALUE=DATE-TIME:"
912 "VALUE=DATE:")
913 (format
914 "200001%02d"
915 ;; end is non-inclusive!
916 (+ (icalendar--get-weekday-number day)
917 (if endtimestring 2 3)))
918 (or endtimestring "")
919 "\nSUMMARY:" summary
74692b14
GM
920 "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY="
921 day)))
81d56594 922 (unless (string= entry-rest "")
74692b14
GM
923 (setq contents
924 (concat contents "\nDESCRIPTION:"
925 (icalendar--convert-string-for-export
926 entry-rest)))))
81d56594
GM
927 ;; yearly by day
928 ;; 1 May Tag der Arbeit
929 ((string-match
930 (concat nonmarker
931 (if european-calendar-style
932 "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
933 "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+")
934 "\\*?\\s-*"
935 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
936 "\\("
937 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
938 "\\)?"
939 "\\s-*\\([^0-9]+.*\\)$" ; must not match years
940 )
941 entry-main)
942 (icalendar--dmsg "yearly %s" entry-main)
943 (let* ((daypos (if european-calendar-style 1 2))
944 (monpos (if european-calendar-style 2 1))
74692b14
GM
945 (day (read (substring entry-main
946 (match-beginning daypos)
81d56594
GM
947 (match-end daypos))))
948 (month (icalendar--get-month-number
74692b14
GM
949 (substring entry-main
950 (match-beginning monpos)
81d56594
GM
951 (match-end monpos))))
952 (starttimestring (icalendar--diarytime-to-isotime
953 (if (match-beginning 4)
954 (substring entry-main
955 (match-beginning 4)
956 (match-end 4))
957 nil)
958 (if (match-beginning 5)
959 (substring entry-main
960 (match-beginning 5)
961 (match-end 5))
962 nil)))
963 (endtimestring (icalendar--diarytime-to-isotime
964 (if (match-beginning 7)
965 (substring entry-main
966 (match-beginning 7)
967 (match-end 7))
968 nil)
969 (if (match-beginning 8)
970 (substring entry-main
971 (match-beginning 8)
972 (match-end 8))
973 nil)))
974 (summary (icalendar--convert-string-for-export
975 (substring entry-main (match-beginning 9)
976 (match-end 9)))))
977 (when starttimestring
978 (unless endtimestring
74692b14
GM
979 (let ((time (read
980 (icalendar--rris "^T0?" ""
981 starttimestring))))
982 (setq endtimestring (format "T%06d"
983 (+ 10000 time))))))
81d56594
GM
984 (setq contents
985 (concat "\nDTSTART;"
986 (if starttimestring "VALUE=DATE-TIME:"
987 "VALUE=DATE:")
988 (format "1900%02d%02d" month day)
989 (or starttimestring "")
990 "\nDTEND;"
991 (if endtimestring "VALUE=DATE-TIME:"
992 "VALUE=DATE:")
993 ;; end is not included! shift by one day
994 (icalendar--date-to-isodate
74692b14
GM
995 (list month day 1900)
996 (if endtimestring 0 1))
81d56594
GM
997 (or endtimestring "")
998 "\nSUMMARY:"
999 summary
1000 "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
1001 (format "%2d" month)
1002 ";BYMONTHDAY="
74692b14 1003 (format "%2d" day))))
81d56594 1004 (unless (string= entry-rest "")
74692b14
GM
1005 (setq contents
1006 (concat contents "\nDESCRIPTION:"
1007 (icalendar--convert-string-for-export
1008 entry-rest)))))
81d56594
GM
1009 ;; "ordinary" events, start and end time given
1010 ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich
1011 ((string-match
1012 (concat nonmarker
1013 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+"
1014 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1015 "\\("
1016 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1017 "\\)?"
1018 "\\s-*\\(.*\\)")
1019 entry-main)
1020 (icalendar--dmsg "ordinary %s" entry-main)
1021 (let* ((startdatestring (icalendar--datestring-to-isodate
1022 (substring entry-main
1023 (match-beginning 1)
1024 (match-end 1))))
1025 (starttimestring (icalendar--diarytime-to-isotime
1026 (if (match-beginning 3)
1027 (substring entry-main
1028 (match-beginning 3)
1029 (match-end 3))
1030 nil)
1031 (if (match-beginning 4)
1032 (substring entry-main
1033 (match-beginning 4)
1034 (match-end 4))
1035 nil)))
1036 (endtimestring (icalendar--diarytime-to-isotime
1037 (if (match-beginning 6)
1038 (substring entry-main
1039 (match-beginning 6)
1040 (match-end 6))
1041 nil)
1042 (if (match-beginning 7)
1043 (substring entry-main
1044 (match-beginning 7)
1045 (match-end 7))
1046 nil)))
1047 (summary (icalendar--convert-string-for-export
1048 (substring entry-main (match-beginning 8)
1049 (match-end 8)))))
1050 (unless startdatestring
1051 (error "Could not parse date"))
1052 (when starttimestring
1053 (unless endtimestring
74692b14
GM
1054 (let ((time
1055 (read (icalendar--rris "^T0?" ""
1056 starttimestring))))
1057 (setq endtimestring (format "T%06d"
1058 (+ 10000 time))))))
81d56594
GM
1059 (setq contents (concat
1060 "\nDTSTART;"
1061 (if starttimestring "VALUE=DATE-TIME:"
1062 "VALUE=DATE:")
1063 startdatestring
1064 (or starttimestring "")
1065 "\nDTEND;"
1066 (if endtimestring "VALUE=DATE-TIME:"
1067 "VALUE=DATE:")
1068 (icalendar--datestring-to-isodate
1069 (substring entry-main
1070 (match-beginning 1)
1071 (match-end 1))
1072 (if endtimestring 0 1))
1073 (or endtimestring "")
1074 "\nSUMMARY:"
1075 summary))
1076 ;; could not parse the date
1077 (unless (string= entry-rest "")
74692b14
GM
1078 (setq contents
1079 (concat contents "\nDESCRIPTION:"
1080 (icalendar--convert-string-for-export
1081 entry-rest))))))
81d56594
GM
1082 ;; everything else
1083 (t
1084 ;; Oops! what's that?
1085 (error "Could not parse entry")))
1086 (setq result (concat result header contents "\nEND:VEVENT")))
1087 ;; handle errors
1088 (error
1089 (setq found-error t)
1090 (save-current-buffer
1091 (set-buffer (get-buffer-create " *icalendar-errors*"))
1092 (insert (format "Error in line %d -- %s: `%s'\n"
1093 (count-lines (point-min) (point))
1094 (cadr error-val)
1095 entry-main))))))
1096
707c20a8 1097 ;; we're done, insert everything into the file
74692b14 1098 (save-current-buffer
8ee7eb6b 1099 (let ((coding-system-for-write 'utf-8))
74692b14
GM
1100 (set-buffer (find-file ical-filename))
1101 (goto-char (point-max))
1102 (insert "BEGIN:VCALENDAR")
1103 (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
1104 (insert "\nVERSION:2.0")
1105 (insert result)
1106 (insert "\nEND:VCALENDAR\n")
1107 ;; save the diary file
1108 (save-buffer))))
81d56594 1109 found-error))
707c20a8 1110
707c20a8 1111;; ======================================================================
e0cd68ee 1112;; Import -- convert icalendar to emacs-diary
707c20a8
GM
1113;; ======================================================================
1114
e0cd68ee 1115;; User function
707c20a8 1116(defun icalendar-import-file (ical-filename diary-filename
e0cd68ee
GM
1117 &optional non-marking)
1118 "Import a iCalendar file and append to a diary file.
707c20a8
GM
1119Argument ICAL-FILENAME output iCalendar file.
1120Argument DIARY-FILENAME input `diary-file'.
1121Optional argument NON-MARKING determines whether events are created as
e0cd68ee 1122non-marking or not."
81d56594 1123 (interactive "fImport iCalendar data from file:
74692b14 1124Finto diary file:
707c20a8
GM
1125p")
1126 ;; clean up the diary file
1127 (save-current-buffer
707c20a8
GM
1128 ;; now load and convert from the ical file
1129 (set-buffer (find-file ical-filename))
e0cd68ee 1130 (icalendar-import-buffer diary-filename t non-marking)))
707c20a8 1131
e0cd68ee
GM
1132;; User function
1133(defun icalendar-import-buffer (&optional diary-file do-not-ask
1134 non-marking)
707c20a8
GM
1135 "Extract iCalendar events from current buffer.
1136
1137This function searches the current buffer for the first iCalendar
1138object, reads it and adds all VEVENT elements to the diary
1139DIARY-FILE.
1140
1141It will ask for each appointment whether to add it to the diary
1142when DO-NOT-ASK is non-nil. When called interactively,
1143DO-NOT-ASK is set to t, so that you are asked fore each event.
1144
1145NON-MARKING determines whether diary events are created as
1146non-marking.
1147
74692b14
GM
1148Return code t means that importing worked well, return code nil
1149means that an error has occured. Error messages will be in the
1150buffer `*icalendar-errors*'."
707c20a8
GM
1151 (interactive)
1152 (save-current-buffer
1153 ;; prepare ical
1154 (message "Preparing icalendar...")
e0cd68ee 1155 (set-buffer (icalendar--get-unfolded-buffer (current-buffer)))
707c20a8
GM
1156 (goto-char (point-min))
1157 (message "Preparing icalendar...done")
1158 (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t)
1159 (let (ical-contents ical-errors)
1160 ;; read ical
1161 (message "Reading icalendar...")
1162 (beginning-of-line)
e0cd68ee 1163 (setq ical-contents (icalendar--read-element nil nil))
707c20a8
GM
1164 (message "Reading icalendar...done")
1165 ;; convert ical
1166 (message "Converting icalendar...")
e0cd68ee 1167 (setq ical-errors (icalendar--convert-ical-to-diary
707c20a8
GM
1168 ical-contents
1169 diary-file do-not-ask non-marking))
1170 (when diary-file
1171 ;; save the diary file
1172 (save-current-buffer
1173 (set-buffer (find-buffer-visiting diary-file))
1174 (save-buffer)))
1175 (message "Converting icalendar...done")
74692b14
GM
1176 ;; return t if no error occured
1177 (not ical-errors))
707c20a8 1178 (message
74692b14
GM
1179 "Current buffer does not contain icalendar contents!")
1180 ;; return nil, i.e. import did not work
1181 nil)))
707c20a8 1182
e0cd68ee 1183(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
81d56594 1184(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
e0cd68ee
GM
1185
1186;; ======================================================================
707c20a8 1187;; private area
e0cd68ee
GM
1188;; ======================================================================
1189
1190(defun icalendar--format-ical-event (event)
707c20a8
GM
1191 "Create a string representation of an iCalendar EVENT."
1192 (let ((string icalendar-import-format)
1193 (conversion-list
1194 '(("%d" DESCRIPTION icalendar-import-format-description)
1195 ("%s" SUMMARY icalendar-import-format-subject)
1196 ("%l" LOCATION icalendar-import-format-location)
1197 ("%o" ORGANIZER icalendar-import-format-organizer))))
1198 ;; convert the specifiers in the format string
1199 (mapcar (lambda (i)
1200 (let* ((spec (car i))
1201 (prop (cadr i))
1202 (format (car (cddr i)))
e0cd68ee 1203 (contents (icalendar--get-event-property event prop))
707c20a8 1204 (formatted-contents ""))
707c20a8
GM
1205 (when (and contents (> (length contents) 0))
1206 (setq formatted-contents
e0cd68ee
GM
1207 (icalendar--rris "%s"
1208 (icalendar--convert-string-for-import
1209 contents)
1210 (symbol-value format))))
1211 (setq string (icalendar--rris spec
1212 formatted-contents
1213 string))))
707c20a8
GM
1214 conversion-list)
1215 string))
1216
e0cd68ee
GM
1217(defun icalendar--convert-ical-to-diary (ical-list diary-file
1218 &optional do-not-ask
1219 non-marking)
707c20a8
GM
1220 "Convert an iCalendar file to an Emacs diary file.
1221Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
1222DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event
1223whether to actually import it. NON-MARKING determines whether diary
1224events are created as non-marking.
1225This function attempts to return t if something goes wrong. In this
1226case an error string which describes all the errors and problems is
1227written into the buffer ` *icalendar-errors*'."
e0cd68ee 1228 (let* ((ev (icalendar--all-events ical-list))
707c20a8
GM
1229 (error-string "")
1230 (event-ok t)
1231 (found-error nil)
1232 e diary-string)
1233 ;; step through all events/appointments
1234 (while ev
1235 (setq e (car ev))
1236 (setq ev (cdr ev))
1237 (setq event-ok nil)
1238 (condition-case error-val
e0cd68ee
GM
1239 (let* ((dtstart (icalendar--decode-isodatetime
1240 (icalendar--get-event-property e 'DTSTART)))
74692b14
GM
1241 (start-d (icalendar--datetime-to-diary-date
1242 dtstart))
e0cd68ee
GM
1243 (start-t (icalendar--datetime-to-colontime dtstart))
1244 (dtend (icalendar--decode-isodatetime
1245 (icalendar--get-event-property e 'DTEND)))
707c20a8
GM
1246 end-d
1247 end-t
e0cd68ee
GM
1248 (subject (icalendar--convert-string-for-import
1249 (or (icalendar--get-event-property e 'SUMMARY)
707c20a8 1250 "No Subject")))
e0cd68ee
GM
1251 (rrule (icalendar--get-event-property e 'RRULE))
1252 (rdate (icalendar--get-event-property e 'RDATE))
1253 (duration (icalendar--get-event-property e 'DURATION)))
1254 (icalendar--dmsg "%s: %s" start-d subject)
74692b14
GM
1255 ;; check whether start-time is missing
1256 (if (and (icalendar--get-event-property-attributes
1257 e 'DTSTART)
1258 (string= (cadr (icalendar--get-event-property-attributes
1259 e 'DTSTART))
1260 "DATE"))
1261 (setq start-t nil))
707c20a8 1262 (when duration
e0cd68ee 1263 (let ((dtend2 (icalendar--add-decoded-times
707c20a8 1264 dtstart
e0cd68ee 1265 (icalendar--decode-isoduration duration))))
707c20a8
GM
1266 (if (and dtend (not (eq dtend dtend2)))
1267 (message "Inconsistent endtime and duration for %s"
1268 subject))
1269 (setq dtend dtend2)))
1270 (setq end-d (if dtend
74692b14 1271 (icalendar--datetime-to-diary-date dtend)
707c20a8
GM
1272 start-d))
1273 (setq end-t (if dtend
e0cd68ee 1274 (icalendar--datetime-to-colontime dtend)
707c20a8 1275 start-t))
e0cd68ee 1276 (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d)
707c20a8
GM
1277 (cond
1278 ;; recurring event
1279 (rrule
e0cd68ee
GM
1280 (icalendar--dmsg "recurring event")
1281 (let* ((rrule-props (icalendar--split-value rrule))
74692b14
GM
1282 (frequency (cadr (assoc 'FREQ rrule-props)))
1283 (until (cadr (assoc 'UNTIL rrule-props)))
1284 (interval (read (cadr (assoc 'INTERVAL rrule-props)))))
707c20a8
GM
1285 (cond ((string-equal frequency "WEEKLY")
1286 (if (not start-t)
1287 (progn
1288 ;; weekly and all-day
e0cd68ee 1289 (icalendar--dmsg "weekly all-day")
74692b14
GM
1290 (if until
1291 (let ((fro
1292 (icalendar--datetime-to-diary-date
1293 (icalendar--decode-isodatetime
1294 (icalendar--get-event-property
1295 e
1296 'DTSTART))))
1297 (unt
1298 (icalendar--datetime-to-diary-date
1299 (icalendar--decode-isodatetime
8ee7eb6b 1300 until -1))))
707c20a8
GM
1301 (setq diary-string
1302 (format
74692b14
GM
1303 (concat "%%%%(and "
1304 "(diary-cyclic %d %s) "
1305 "(diary-block %s %s))")
e0cd68ee 1306 (* interval 7)
74692b14
GM
1307 (icalendar--datetime-to-diary-date
1308 dtstart)
1309 (icalendar--datetime-to-diary-date
1310 dtstart)
1311 (icalendar--datetime-to-diary-date
1312 (icalendar--decode-isodatetime
8ee7eb6b 1313 until -1)))))
74692b14
GM
1314 (setq diary-string
1315 (format "%%%%(and (diary-cyclic %d %s))"
1316 (* interval 7)
1317 (icalendar--datetime-to-diary-date
1318 dtstart))))
1319 (setq event-ok t))
707c20a8
GM
1320 ;; weekly and not all-day
1321 (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
1322 (weekday
f2aa5449 1323 (icalendar--get-weekday-number byday)))
e0cd68ee 1324 (icalendar--dmsg "weekly not-all-day")
74692b14
GM
1325 (if until
1326 (let ((fro
1327 (icalendar--datetime-to-diary-date
1328 (icalendar--decode-isodatetime
1329 (icalendar--get-event-property
1330 e
1331 'DTSTART))))
1332 (unt
1333 (icalendar--datetime-to-diary-date
1334 (icalendar--decode-isodatetime
1335 until))))
1336 (setq diary-string
1337 (format
1338 (concat "%%%%(and "
1339 "(diary-cyclic %d %s) "
1340 "(diary-block %s %s)) "
1341 "%s%s%s")
1342 (* interval 7)
1343 (icalendar--datetime-to-diary-date
1344 dtstart)
1345 (icalendar--datetime-to-diary-date
1346 dtstart)
1347 (icalendar--datetime-to-diary-date
1348 (icalendar--decode-isodatetime
1349 until))
1350 start-t
1351 (if end-t "-" "") (or end-t ""))))
1352 ;; no limit
707c20a8
GM
1353 ;; FIXME!!!!
1354 ;; DTSTART;VALUE=DATE-TIME:20030919T090000
1355 ;; DTEND;VALUE=DATE-TIME:20030919T113000
1356 (setq diary-string
1357 (format
74692b14 1358 "%%%%(and (diary-cyclic %s %s)) %s%s%s"
e0cd68ee 1359 (* interval 7)
74692b14 1360 (icalendar--datetime-to-diary-date
e0cd68ee 1361 dtstart)
74692b14
GM
1362 start-t
1363 (if end-t "-" "") (or end-t ""))))
707c20a8
GM
1364 (setq event-ok t))))
1365 ;; yearly
1366 ((string-equal frequency "YEARLY")
e0cd68ee 1367 (icalendar--dmsg "yearly")
707c20a8
GM
1368 (setq diary-string
1369 (format
74692b14
GM
1370 "%%%%(and (diary-anniversary %s))"
1371 (icalendar--datetime-to-diary-date dtstart)))
707c20a8
GM
1372 (setq event-ok t))
1373 ;; FIXME: war auskommentiert:
1374 ((and (string-equal frequency "DAILY")
1375 ;;(not (string= start-d end-d))
1376 ;;(not start-t)
1377 ;;(not end-t)
1378 )
74692b14 1379 (let ((ds (icalendar--datetime-to-diary-date
e0cd68ee 1380 (icalendar--decode-isodatetime
74692b14
GM
1381 (icalendar--get-event-property
1382 e 'DTSTART))))
1383 (de (icalendar--datetime-to-diary-date
e0cd68ee 1384 (icalendar--decode-isodatetime
8ee7eb6b 1385 until -1))))
707c20a8
GM
1386 (setq diary-string
1387 (format
74692b14
GM
1388 "%%%%(and (diary-block %s %s))"
1389 ds de)))
1390 (setq event-ok t))))
1391 ;; Handle exceptions from recurrence rules
1392 (let ((ex-dates (icalendar--get-event-properties e
1393 'EXDATE)))
1394 (while ex-dates
1395 (let* ((ex-start (icalendar--decode-isodatetime
1396 (car ex-dates)))
1397 (ex-d (icalendar--datetime-to-diary-date
1398 ex-start)))
1399 (setq diary-string
1400 (icalendar--rris "^%%(\\(and \\)?"
1401 (format
1402 "%%%%(and (not (diary-date %s)) "
1403 ex-d)
1404 diary-string)))
1405 (setq ex-dates (cdr ex-dates))))
1406 ;; FIXME: exception rules are not recognized
1407 (if (icalendar--get-event-property e 'EXRULE)
1408 (setq diary-string
1409 (concat diary-string
1410 "\n Exception rules: "
1411 (icalendar--get-event-properties
1412 e 'EXRULE)))))
707c20a8 1413 (rdate
e0cd68ee 1414 (icalendar--dmsg "rdate event")
707c20a8
GM
1415 (setq diary-string "")
1416 (mapcar (lambda (datestring)
1417 (setq diary-string
1418 (concat diary-string
1419 (format "......"))))
e0cd68ee 1420 (icalendar--split-value rdate)))
707c20a8 1421 ;; non-recurring event
8ee7eb6b 1422 ;; all-day event
707c20a8 1423 ((not (string= start-d end-d))
e0cd68ee 1424 (icalendar--dmsg "non-recurring event")
74692b14 1425 (let ((ds (icalendar--datetime-to-diary-date dtstart))
8ee7eb6b
GM
1426 (de (icalendar--datetime-to-diary-date
1427 (icalendar--decode-isodatetime
1428 (icalendar--get-event-property e 'DTEND)
1429 -1))))
707c20a8 1430 (setq diary-string
74692b14
GM
1431 (format "%%%%(and (diary-block %s %s))"
1432 ds de)))
707c20a8
GM
1433 (setq event-ok t))
1434 ;; not all-day
1435 ((and start-t (or (not end-t)
1436 (not (string= start-t end-t))))
e0cd68ee 1437 (icalendar--dmsg "not all day event")
707c20a8 1438 (cond (end-t
74692b14
GM
1439 (setq diary-string
1440 (format "%s %s-%s"
1441 (icalendar--datetime-to-diary-date
1442 dtstart "/")
1443 start-t end-t)))
707c20a8 1444 (t
74692b14
GM
1445 (setq diary-string
1446 (format "%s %s"
1447 (icalendar--datetime-to-diary-date
1448 dtstart "/")
1449 start-t))))
707c20a8
GM
1450 (setq event-ok t))
1451 ;; all-day event
1452 (t
e0cd68ee 1453 (icalendar--dmsg "all day event")
74692b14
GM
1454 (setq diary-string (icalendar--datetime-to-diary-date
1455 dtstart "/"))
707c20a8
GM
1456 (setq event-ok t)))
1457 ;; add all other elements unless the user doesn't want to have
1458 ;; them
1459 (if event-ok
1460 (progn
1461 (setq diary-string
e0cd68ee
GM
1462 (concat diary-string " "
1463 (icalendar--format-ical-event e)))
707c20a8 1464 (if do-not-ask (setq subject nil))
e0cd68ee
GM
1465 (icalendar--add-diary-entry diary-string diary-file
1466 non-marking subject))
707c20a8
GM
1467 ;; event was not ok
1468 (setq found-error t)
1469 (setq error-string
e0cd68ee
GM
1470 (format "%s\nCannot handle this event:%s"
1471 error-string e))))
74692b14 1472 ;; FIXME: inform user about ignored event properties
707c20a8
GM
1473 ;; handle errors
1474 (error
1475 (message "Ignoring event \"%s\"" e)
1476 (setq found-error t)
74692b14
GM
1477 (setq error-string (format "%s\n%s\nCannot handle this event: %s"
1478 error-val error-string e))
1479 (message error-string))))
707c20a8
GM
1480 (if found-error
1481 (save-current-buffer
1482 (set-buffer (get-buffer-create " *icalendar-errors*"))
1483 (erase-buffer)
1484 (insert error-string)))
1485 (message "Converting icalendar...done")
1486 found-error))
1487
e0cd68ee
GM
1488(defun icalendar--add-diary-entry (string diary-file non-marking
1489 &optional subject)
707c20a8
GM
1490 "Add STRING to the diary file DIARY-FILE.
1491STRING must be a properly formatted valid diary entry. NON-MARKING
1492determines whether diary events are created as non-marking. If
1493SUBJECT is not nil it must be a string that gives the subject of the
1494entry. In this case the user will be asked whether he wants to insert
1495the entry."
74692b14 1496 (when (or (not subject)
707c20a8 1497 (y-or-n-p (format "Add appointment for `%s' to diary? "
e0cd68ee 1498 subject)))
707c20a8
GM
1499 (when subject
1500 (setq non-marking
1501 (y-or-n-p (format "Make appointment non-marking? "))))
1502 (save-window-excursion
1503 (unless diary-file
1504 (setq diary-file
1505 (read-file-name "Add appointment to this diary file: ")))
1506 (make-diary-entry string non-marking diary-file))))
1507
707c20a8
GM
1508(provide 'icalendar)
1509
a13bc064 1510;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc
707c20a8 1511;;; icalendar.el ends here