1 ;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
4 ;; Free Software Foundation, Inc.
6 ;; Author: Ulf Jasper <ulf.jasper@web.de>
7 ;; Created: August 2002
9 ;; Human-Keywords: calendar, diary, iCalendar, vCalendar
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;; This package is documented in the Emacs Manual.
31 ;; - Diary entries which have a start time but no end time are assumed to
32 ;; last for one hour when they are exported.
33 ;; - Weekly diary entries are assumed to occur the first time in the first
34 ;; week of the year 2000 when they are exported.
35 ;; - Yearly diary entries are assumed to occur the first time in the year
36 ;; 1900 when they are exported.
40 ;; 0.07 onwards: see lisp/ChangeLog
43 ;; - Bugfixes regarding icalendar-import-format-*.
44 ;; - Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau.
47 ;; - New import format scheme: Replaced icalendar-import-prefix-*,
48 ;; icalendar-import-ignored-properties, and
49 ;; icalendar-import-separator with icalendar-import-format(-*).
50 ;; - icalendar-import-file and icalendar-convert-diary-to-ical
51 ;; have an extra parameter which should prevent them from
52 ;; erasing their target files (untested!).
53 ;; - Tested with Emacs 21.3.2
56 ;; - Bugfix: import: double quoted param values did not work
57 ;; - Read DURATION property when importing.
58 ;; - Added parameter icalendar-duration-correction.
61 ;; - Export takes care of european-calendar-style.
62 ;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12
65 ;; - Should work in XEmacs now. Thanks to Len Trigg for the XEmacs patches!
66 ;; - Added exporting from Emacs diary to ical.
67 ;; - Some bugfixes, after testing with calendars from http://icalshare.com.
68 ;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12
71 ;; - First published version. Trial version. Alpha version.
73 ;; ======================================================================
76 ;; * Import from ical to diary:
77 ;; + Need more properties for icalendar-import-format
78 ;; (added all that Mozilla Calendar uses)
79 ;; From iCal specifications (RFC2445: 4.8.1), icalendar.el lacks
80 ;; ATTACH, CATEGORIES, COMMENT, GEO, PERCENT-COMPLETE (VTODO),
81 ;; PRIORITY, RESOURCES) not considering date/time and time-zone
82 ;; + check vcalendar version
83 ;; + check (unknown) elements
84 ;; + recurring events!
85 ;; + works for european style calendars only! Does it?
87 ;; + exceptions in recurring events
88 ;; + the parser is too soft
89 ;; + error log is incomplete
90 ;; + nice to have: #include "webcal://foo.com/some-calendar.ics"
91 ;; + timezones probably still need some improvements.
93 ;; * Export from diary to ical
94 ;; + diary-date, diary-float, and self-made sexp entries are not
98 ;; + clean up all those date/time parsing functions
99 ;; + Handle todo items?
100 ;; + Check iso 8601 for datetime and period
101 ;; + Which chars to (un)escape?
106 (defconst icalendar-version
"0.18"
107 "Version number of icalendar.el.")
109 ;; ======================================================================
111 ;; ======================================================================
112 (defgroup icalendar nil
117 (defcustom icalendar-import-format
119 "Format for importing events from iCalendar into Emacs diary.
120 It defines how iCalendar events are inserted into diary file.
121 This may either be a string or a function.
123 In case of a formatting STRING the following specifiers can be used:
124 %c Class, see `icalendar-import-format-class'
125 %d Description, see `icalendar-import-format-description'
126 %l Location, see `icalendar-import-format-location'
127 %o Organizer, see `icalendar-import-format-organizer'
128 %s Summary, see `icalendar-import-format-summary'
129 %t Status, see `icalendar-import-format-status'
130 %u URL, see `icalendar-import-format-url'
132 A formatting FUNCTION will be called with a VEVENT as its only
133 argument. It must return a string. See
134 `icalendar-import-format-sample' for an example."
136 (string :tag
"String")
137 (function :tag
"Function"))
140 (defcustom icalendar-import-format-summary
142 "Format string defining how the summary element is formatted.
143 This applies only if the summary is not empty! `%s' is replaced
148 (defcustom icalendar-import-format-description
150 "Format string defining how the description element is formatted.
151 This applies only if the description is not empty! `%s' is
152 replaced by the description."
156 (defcustom icalendar-import-format-location
158 "Format string defining how the location element is formatted.
159 This applies only if the location is not empty! `%s' is replaced
164 (defcustom icalendar-import-format-organizer
166 "Format string defining how the organizer element is formatted.
167 This applies only if the organizer is not empty! `%s' is
168 replaced by the organizer."
172 (defcustom icalendar-import-format-url
174 "Format string defining how the URL element is formatted.
175 This applies only if the URL is not empty! `%s' is replaced by
180 (defcustom icalendar-import-format-status
182 "Format string defining how the status element is formatted.
183 This applies only if the status is not empty! `%s' is replaced by
188 (defcustom icalendar-import-format-class
190 "Format string defining how the class element is formatted.
191 This applies only if the class is not empty! `%s' is replaced by
196 (defcustom icalendar-recurring-start-year
198 "Start year for recurring events.
199 Some calendar browsers only propagate recurring events for
200 several years beyond the start time. Set this string to a year
201 just before the start of your personal calendar."
206 (defcustom icalendar-export-hidden-diary-entries
208 "Determines whether hidden diary entries are exported.
209 If non-nil hidden diary entries (starting with `&') get exported,
210 if nil they are ignored."
214 (defvar icalendar-debug nil
215 "Enable icalendar debug messages.")
217 ;; ======================================================================
218 ;; NO USER SERVICABLE PARTS BELOW THIS LINE
219 ;; ======================================================================
221 (defconst icalendar--weekday-array
["SU" "MO" "TU" "WE" "TH" "FR" "SA"])
223 ;; ======================================================================
224 ;; all the other libs we need
225 ;; ======================================================================
228 ;; ======================================================================
230 ;; ======================================================================
231 (defun icalendar--dmsg (&rest args
)
232 "Print message ARGS if `icalendar-debug' is non-nil."
234 (apply 'message args
)))
236 ;; ======================================================================
237 ;; Core functionality
238 ;; Functions for parsing icalendars, importing and so on
239 ;; ======================================================================
241 (defun icalendar--get-unfolded-buffer (folded-ical-buffer)
242 "Return a new buffer containing the unfolded contents of a buffer.
243 Folding is the iCalendar way of wrapping long lines. In the
244 created buffer all occurrences of CR LF BLANK are replaced by the
245 empty string. Argument FOLDED-ICAL-BUFFER is the unfolded input
247 (let ((unfolded-buffer (get-buffer-create " *icalendar-work*")))
249 (set-buffer unfolded-buffer
)
251 (insert-buffer-substring folded-ical-buffer
)
252 (goto-char (point-min))
253 (while (re-search-forward "\r?\n[ \t]" nil t
)
254 (replace-match "" nil nil
)))
257 (defsubst icalendar--rris
(regexp rep string
&optional fixedcase literal
)
258 "Replace regular expression in string.
259 Pass arguments REGEXP REP STRING FIXEDCASE LITERAL to
260 `replace-regexp-in-string' (Emacs) or to `replace-in-string' (XEmacs)."
261 (cond ((fboundp 'replace-regexp-in-string
)
263 (replace-regexp-in-string regexp rep string fixedcase literal
))
264 ((fboundp 'replace-in-string
)
266 (save-match-data ;; apparently XEmacs needs save-match-data
267 (replace-in-string string regexp rep literal
)))))
269 (defun icalendar--read-element (invalue inparams
)
270 "Recursively read the next iCalendar element in the current buffer.
271 INVALUE gives the current iCalendar element we are reading.
272 INPARAMS gives the current parameters.....
273 This function calls itself recursively for each nested calendar element
275 (let (element children line name params param param-name param-value
280 (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t
))
281 (setq name
(intern (match-string 1)))
285 (while (looking-at ";")
286 (re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil
)
287 (setq param-name
(intern (match-string 1)))
288 (re-search-forward "\\(\\([^;,:\"]+\\)\\|\"\\([^\"]+\\)\"\\)[;:]"
291 (setq param-value
(or (match-string 2) (match-string 3)))
292 (setq param
(list param-name param-value
))
293 (while (looking-at ",")
294 (re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)"
297 (setq param-value
(match-string 2))
298 (setq param-value
(match-string 3)))
299 (setq param
(append param param-value
)))
300 (setq params
(append params param
)))
301 (unless (looking-at ":")
304 (re-search-forward "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t
)
305 (setq value
(icalendar--rris "\r?\n[ \t]" "" (match-string 0)))
306 (setq line
(list name params value
))
307 (cond ((eq name
'BEGIN
)
310 (list (icalendar--read-element (intern value
)
315 (setq element
(append element
(list line
))))))
317 (list invalue inparams element children
)
320 ;; ======================================================================
321 ;; helper functions for examining events
322 ;; ======================================================================
324 ;;(defsubst icalendar--get-all-event-properties (event)
325 ;; "Return the list of properties in this EVENT."
326 ;; (car (cddr event)))
328 (defun icalendar--get-event-property (event prop
)
329 "For the given EVENT return the value of the first occurrence of PROP."
331 (let ((props (car (cddr event
))) pp
)
333 (setq pp
(car props
))
334 (if (eq (car pp
) prop
)
335 (throw 'found
(car (cddr pp
))))
336 (setq props
(cdr props
))))
339 (defun icalendar--get-event-property-attributes (event prop
)
340 "For the given EVENT return attributes of the first occurrence of PROP."
342 (let ((props (car (cddr event
))) pp
)
344 (setq pp
(car props
))
345 (if (eq (car pp
) prop
)
346 (throw 'found
(cadr pp
)))
347 (setq props
(cdr props
))))
350 (defun icalendar--get-event-properties (event prop
)
351 "For the given EVENT return a list of all values of the property PROP."
352 (let ((props (car (cddr event
))) pp result
)
354 (setq pp
(car props
))
355 (if (eq (car pp
) prop
)
356 (setq result
(append (split-string (car (cddr pp
)) ",") result
)))
357 (setq props
(cdr props
)))
360 ;; (defun icalendar--set-event-property (event prop new-value)
361 ;; "For the given EVENT set the property PROP to the value NEW-VALUE."
363 ;; (let ((props (car (cddr event))) pp)
365 ;; (setq pp (car props))
366 ;; (when (eq (car pp) prop)
367 ;; (setcdr (cdr pp) new-value)
368 ;; (throw 'found (car (cddr pp))))
369 ;; (setq props (cdr props)))
370 ;; (setq props (car (cddr event)))
371 ;; (setcar (cddr event)
372 ;; (append props (list (list prop nil new-value)))))))
374 (defun icalendar--get-children (node name
)
375 "Return all children of the given NODE which have a name NAME.
376 For instance the VCALENDAR node can have VEVENT children as well as VTODO
379 (children (cadr (cddr node
))))
380 (when (eq (car node
) name
)
382 ;;(message "%s" node)
387 (icalendar--get-children n name
))
391 (setq result
(append result subresult
))
392 (setq result subresult
)))))
396 (defun icalendar--all-events (icalendar)
397 "Return the list of all existing events in the given ICALENDAR."
398 (icalendar--get-children (car icalendar
) 'VEVENT
))
400 (defun icalendar--split-value (value-string)
401 "Split VALUE-STRING at ';='."
403 param-name param-value
)
406 (set-buffer (get-buffer-create " *icalendar-work*"))
407 (set-buffer-modified-p nil
)
409 (insert value-string
)
410 (goto-char (point-min))
413 "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
415 (setq param-name
(intern (match-string 1)))
416 (setq param-value
(match-string 2))
418 (append result
(list (list param-name param-value
)))))))
421 (defun icalendar--convert-tz-offset (alist dst-p
)
422 "Return a cons of two strings representing a timezone start.
423 ALIST is an alist entry from a VTIMEZONE, like STANDARD.
424 DST-P is non-nil if this is for daylight savings time.
425 The strings are suitable for assembling into a TZ variable."
426 (let ((offset (car (cddr (assq 'TZOFFSETTO alist
))))
427 (rrule-value (car (cddr (assq 'RRULE alist
))))
428 (dtstart (car (cddr (assq 'DTSTART alist
)))))
429 ;; FIXME: for now we only handle RRULE and not RDATE here.
430 (when (and offset rrule-value dtstart
)
431 (let* ((rrule (icalendar--split-value rrule-value
))
432 (freq (cadr (assq 'FREQ rrule
)))
433 (bymonth (cadr (assq 'BYMONTH rrule
)))
434 (byday (cadr (assq 'BYDAY rrule
))))
435 ;; FIXME: we don't correctly handle WKST here.
436 (if (and (string= freq
"YEARLY") bymonth
)
440 (if dst-p
"(DST?)" "(STD?)")
441 ;; For TZ, OFFSET is added to the local time. So,
442 ;; invert the values.
443 (if (eq (aref offset
0) ?-
) "+" "-")
444 (substring offset
1 3)
446 (substring offset
3 5))
448 (let* ((day (icalendar--get-weekday-number (substring byday -
2)))
449 (week (if (eq day -
1)
451 (substring byday
0 -
2))))
452 (concat "M" bymonth
"." week
"." (if (eq day -
1) "0"
456 (substring dtstart -
6 -
4)
458 (substring dtstart -
4 -
2)
460 (substring dtstart -
2)))))))))
462 (defun icalendar--parse-vtimezone (alist)
463 "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
464 Return nil if timezone cannot be parsed."
465 (let* ((tz-id (icalendar--get-event-property alist
'TZID
))
466 (daylight (cadr (cdar (icalendar--get-children alist
'DAYLIGHT
))))
467 (day (and daylight
(icalendar--convert-tz-offset daylight t
)))
468 (standard (cadr (cdar (icalendar--get-children alist
'STANDARD
))))
469 (std (and standard
(icalendar--convert-tz-offset standard nil
))))
473 (concat (car std
) (car day
)
474 "," (cdr day
) "," (cdr std
))
477 (defun icalendar--convert-all-timezones (icalendar)
478 "Convert all timezones in the ICALENDAR into an alist.
479 Each element of the alist is a cons (ID . TZ-STRING),
480 like `icalendar--parse-vtimezone'."
482 (dolist (zone (icalendar--get-children (car icalendar
) 'VTIMEZONE
))
483 (setq zone
(icalendar--parse-vtimezone zone
))
485 (setq result
(cons zone result
))))
488 (defun icalendar--find-time-zone (prop-list zone-map
)
489 "Return a timezone string for the time zone in PROP-LIST, or nil if none.
490 ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'."
491 (let ((id (plist-get prop-list
'TZID
)))
493 (cdr (assoc id zone-map
)))))
495 (defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift
497 "Return ISODATETIMESTRING in format like `decode-time'.
498 Converts from ISO-8601 to Emacs representation. If
499 ISODATETIMESTRING specifies UTC time (trailing letter Z) the
500 decoded time is given in the local time zone! If optional
501 parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
503 ZONE, if provided, is the timezone, in any format understood by `encode-time'.
505 FIXME: multiple comma-separated values should be allowed!"
506 (icalendar--dmsg isodatetimestring
)
507 (if isodatetimestring
508 ;; day/month/year must be present
509 (let ((year (read (substring isodatetimestring
0 4)))
510 (month (read (substring isodatetimestring
4 6)))
511 (day (read (substring isodatetimestring
6 8)))
515 (when (> (length isodatetimestring
) 12)
516 ;; hour/minute present
517 (setq hour
(read (substring isodatetimestring
9 11)))
518 (setq minute
(read (substring isodatetimestring
11 13))))
519 (when (> (length isodatetimestring
) 14)
521 (setq second
(read (substring isodatetimestring
13 15))))
522 (when (and (> (length isodatetimestring
) 15)
523 ;; UTC specifier present
524 (char-equal ?Z
(aref isodatetimestring
15)))
525 ;; if not UTC add current-time-zone offset
526 (setq second
(+ (car (current-time-zone)) second
)))
527 ;; shift if necessary
529 (let ((mdy (calendar-gregorian-from-absolute
530 (+ (calendar-absolute-from-gregorian
531 (list month day year
))
533 (setq month
(nth 0 mdy
))
534 (setq day
(nth 1 mdy
))
535 (setq year
(nth 2 mdy
))))
536 ;; create the decoded date-time
539 (decode-time (encode-time second minute hour day month year zone
))
541 (message "Cannot decode \"%s\"" isodatetimestring
)
542 ;; hope for the best...
543 (list second minute hour day month year
0 nil
0))))
544 ;; isodatetimestring == nil
547 (defun icalendar--decode-isoduration (isodurationstring
548 &optional duration-correction
)
549 "Convert ISODURATIONSTRING into format provided by `decode-time'.
550 Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING
551 specifies UTC time (trailing letter Z) the decoded time is given in
554 Optional argument DURATION-CORRECTION shortens result by one day.
556 FIXME: TZID-attributes are ignored....!
557 FIXME: multiple comma-separated values should be allowed!"
558 (if isodurationstring
563 "\\(\\([0-9]+\\)D\\)" ; days only
565 "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days
566 "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time
568 "\\(\\([0-9]+\\)W\\)" ; weeks only
569 "\\)$") isodurationstring
)
577 ((match-beginning 2) ;days only
578 (setq days
(read (substring isodurationstring
581 (when duration-correction
582 (setq days
(1- days
))))
583 ((match-beginning 4) ;days and time
584 (if (match-beginning 5)
585 (setq days
(* 7 (read (substring isodurationstring
588 (if (match-beginning 7)
589 (setq hours
(read (substring isodurationstring
592 (if (match-beginning 9)
593 (setq minutes
(read (substring isodurationstring
596 (if (match-beginning 11)
597 (setq seconds
(read (substring isodurationstring
600 ((match-beginning 13) ;weeks only
601 (setq days
(* 7 (read (substring isodurationstring
604 (list seconds minutes hours days months years
)))
605 ;; isodatetimestring == nil
608 (defun icalendar--add-decoded-times (time1 time2
)
610 Both times must be given in decoded form. One of these times must be
611 valid (year > 1900 or something)."
612 ;; FIXME: does this function exist already?
613 (decode-time (encode-time
614 (+ (nth 0 time1
) (nth 0 time2
))
615 (+ (nth 1 time1
) (nth 1 time2
))
616 (+ (nth 2 time1
) (nth 2 time2
))
617 (+ (nth 3 time1
) (nth 3 time2
))
618 (+ (nth 4 time1
) (nth 4 time2
))
619 (+ (nth 5 time1
) (nth 5 time2
))
622 ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
625 (defun icalendar--datetime-to-american-date (datetime &optional separator
)
626 "Convert the decoded DATETIME to American-style format.
627 Optional argument SEPARATOR gives the separator between month,
628 day, and year. If nil a blank character is used as separator.
629 American format: \"month day year\"."
631 (format "%d%s%d%s%d" (nth 4 datetime
) ;month
633 (nth 3 datetime
) ;day
635 (nth 5 datetime
)) ;year
639 (define-obsolete-function-alias 'icalendar--datetime-to-noneuropean-date
640 'icalendar--datetime-to-american-date
"icalendar 0.19")
642 (defun icalendar--datetime-to-european-date (datetime &optional separator
)
643 "Convert the decoded DATETIME to European format.
644 Optional argument SEPARATOR gives the separator between month,
645 day, and year. If nil a blank character is used as separator.
646 European format: (day month year).
649 (format "%d%s%d%s%d" (nth 3 datetime
) ;day
651 (nth 4 datetime
) ;month
653 (nth 5 datetime
)) ;year
657 (defun icalendar--datetime-to-iso-date (datetime &optional separator
)
658 "Convert the decoded DATETIME to ISO format.
659 Optional argument SEPARATOR gives the separator between month,
660 day, and year. If nil a blank character is used as separator.
661 ISO format: (year month day)."
663 (format "%d%s%d%s%d" (nth 5 datetime
) ;year
665 (nth 4 datetime
) ;month
667 (nth 3 datetime
)) ;day
671 (defun icalendar--datetime-to-diary-date (datetime &optional separator
)
672 "Convert the decoded DATETIME to diary format.
673 Optional argument SEPARATOR gives the separator between month,
674 day, and year. If nil a blank character is used as separator.
675 Call icalendar--datetime-to-*-date according to the
676 value of `calendar-date-style' (or the older `european-calendar-style')."
677 (funcall (intern-soft (format "icalendar--datetime-to-%s-date"
678 (if (boundp 'calendar-date-style
)
680 (if (with-no-warnings european-calendar-style
)
685 (defun icalendar--datetime-to-colontime (datetime)
686 "Extract the time part of a decoded DATETIME into 24-hour format.
687 Note that this silently ignores seconds."
688 (format "%02d:%02d" (nth 2 datetime
) (nth 1 datetime
)))
690 (defun icalendar--get-month-number (monthname)
691 "Return the month number for the given MONTHNAME."
694 (m (downcase monthname
)))
695 (mapc (lambda (month)
696 (let ((mm (downcase month
)))
697 (if (or (string-equal mm m
)
698 (string-equal (substring mm
0 3) m
))
700 (setq num
(1+ num
))))
701 calendar-month-name-array
))
705 (defun icalendar--get-weekday-number (abbrevweekday)
706 "Return the number for the ABBREVWEEKDAY."
710 (aw (downcase abbrevweekday
)))
712 (let ((d (downcase day
)))
713 (if (string-equal d aw
)
715 (setq num
(1+ num
))))
716 icalendar--weekday-array
)))
720 (defun icalendar--get-weekday-abbrev (weekday)
721 "Return the abbreviated WEEKDAY."
724 (w (downcase weekday
)))
726 (let ((d (downcase day
)))
727 (if (or (string-equal d w
)
728 (string-equal (substring d
0 3) w
))
729 (throw 'found
(aref icalendar--weekday-array num
)))
730 (setq num
(1+ num
))))
731 calendar-day-name-array
))
735 (defun icalendar--date-to-isodate (date &optional day-shift
)
736 "Convert DATE to iso-style date.
737 DATE must be a list of the form (month day year).
738 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
739 (let ((mdy (calendar-gregorian-from-absolute
740 (+ (calendar-absolute-from-gregorian date
)
742 (format "%04d%02d%02d" (nth 2 mdy
) (nth 0 mdy
) (nth 1 mdy
))))
745 (defun icalendar--datestring-to-isodate (datestring &optional day-shift
)
746 "Convert diary-style DATESTRING to iso-style date.
747 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
748 -- DAY-SHIFT must be either nil or an integer. This function
749 takes care of european-style."
750 (let ((day -
1) month year
)
752 (cond ( ;; numeric date
753 (string-match (concat "\\s-*"
754 "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
755 "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
756 "\\([0-9]\\{4\\}\\)")
758 (setq day
(read (substring datestring
(match-beginning 1)
760 (setq month
(read (substring datestring
(match-beginning 2)
762 (setq year
(read (substring datestring
(match-beginning 3)
764 (unless european-calendar-style
768 ( ;; date contains month names -- european-style
769 (string-match (concat "\\s-*"
770 "0?\\([123]?[0-9]\\)[ \t/]\\s-*"
771 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
772 "\\([0-9]\\{4\\}\\)")
774 (setq day
(read (substring datestring
(match-beginning 1)
776 (setq month
(icalendar--get-month-number
777 (substring datestring
(match-beginning 2)
779 (setq year
(read (substring datestring
(match-beginning 3)
781 ( ;; date contains month names -- non-european-style
782 (string-match (concat "\\s-*"
783 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
784 "0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
785 "\\([0-9]\\{4\\}\\)")
787 (setq day
(read (substring datestring
(match-beginning 2)
789 (setq month
(icalendar--get-month-number
790 (substring datestring
(match-beginning 1)
792 (setq year
(read (substring datestring
(match-beginning 3)
797 (let ((mdy (calendar-gregorian-from-absolute
798 (+ (calendar-absolute-from-gregorian (list month day
801 (format "%04d%02d%02d" (nth 2 mdy
) (nth 0 mdy
) (nth 1 mdy
)))
804 (defun icalendar--diarytime-to-isotime (timestring ampmstring
)
805 "Convert a time like 9:30pm to an iso-conform string like T213000.
806 In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING
809 (let ((starttimenum (read (icalendar--rris ":" "" timestring
))))
810 ;; take care of am/pm style
811 ;; Be sure *not* to convert 12:00pm - 12:59pm to 2400-2459
812 (if (and ampmstring
(string= "pm" ampmstring
) (< starttimenum
1200))
813 (setq starttimenum
(+ starttimenum
1200)))
814 (format "T%04d00" starttimenum
))
817 (defun icalendar--convert-string-for-export (string)
818 "Escape comma and other critical characters in STRING."
819 (icalendar--rris "," "\\\\," string
))
821 (defun icalendar--convert-string-for-import (string)
822 "Remove escape chars for comma, semicolon etc. from STRING."
824 "\\\\n" "\n " (icalendar--rris
825 "\\\\\"" "\"" (icalendar--rris
826 "\\\\;" ";" (icalendar--rris
827 "\\\\," "," string
)))))
829 ;; ======================================================================
830 ;; Export -- convert emacs-diary to icalendar
831 ;; ======================================================================
834 (defun icalendar-export-file (diary-filename ical-filename
)
835 "Export diary file to iCalendar format.
836 All diary entries in the file DIARY-FILENAME are converted to iCalendar
837 format. The result is appended to the file ICAL-FILENAME."
838 (interactive "FExport diary data from file:
839 Finto iCalendar file: ")
841 (set-buffer (find-file diary-filename
))
842 (icalendar-export-region (point-min) (point-max) ical-filename
)))
844 (defalias 'icalendar-convert-diary-to-ical
'icalendar-export-file
)
845 (make-obsolete 'icalendar-convert-diary-to-ical
'icalendar-export-file
)
848 (defun icalendar-export-region (min max ical-filename
)
849 "Export region in diary file to iCalendar format.
850 All diary entries in the region from MIN to MAX in the current buffer are
851 converted to iCalendar format. The result is appended to the file
853 This function attempts to return t if something goes wrong. In this
854 case an error string which describes all the errors and problems is
855 written into the buffer `*icalendar-errors*'."
857 FExport diary data into iCalendar file: ")
866 (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol
)
868 (other-elements nil
))
869 ;; prepare buffer with error messages
871 (set-buffer (get-buffer-create "*icalendar-errors*"))
877 (while (re-search-forward
878 ;; possibly ignore hidden entries beginning with "&"
879 (if icalendar-export-hidden-diary-entries
880 "^\\([^ \t\n#].+\\)\\(\\(\n[ \t].*\\)*\\)"
881 "^\\([^ \t\n&#].+\\)\\(\\(\n[ \t].*\\)*\\)") max t
)
882 (setq entry-main
(match-string 1))
883 (if (match-beginning 2)
884 (setq entry-rest
(match-string 2))
885 (setq entry-rest
""))
886 (setq header
(format "\nBEGIN:VEVENT\nUID:emacs%d%d%d"
888 (cadr (current-time))
889 (car (cddr (current-time)))))
890 (condition-case error-val
892 (setq contents-n-summary
893 (icalendar--convert-to-ical nonmarker entry-main
))
894 (setq other-elements
(icalendar--parse-summary-and-rest
895 (concat entry-main entry-rest
)))
896 (setq contents
(concat (car contents-n-summary
)
897 "\nSUMMARY:" (cadr contents-n-summary
)))
898 (let ((cla (cdr (assoc 'cla other-elements
)))
899 (des (cdr (assoc 'des other-elements
)))
900 (loc (cdr (assoc 'loc other-elements
)))
901 (org (cdr (assoc 'org other-elements
)))
902 (sta (cdr (assoc 'sta other-elements
)))
903 (sum (cdr (assoc 'sum other-elements
)))
904 (url (cdr (assoc 'url other-elements
))))
906 (setq contents
(concat contents
"\nCLASS:" cla
)))
908 (setq contents
(concat contents
"\nDESCRIPTION:" des
)))
910 (setq contents
(concat contents
"\nLOCATION:" loc
)))
912 (setq contents
(concat contents
"\nORGANIZER:" org
)))
914 (setq contents
(concat contents
"\nSTATUS:" sta
)))
916 ;; (setq contents (concat contents "\nSUMMARY:" sum)))
918 (setq contents
(concat contents
"\nURL:" url
))))
919 (setq result
(concat result header contents
"\nEND:VEVENT")))
924 (set-buffer (get-buffer-create "*icalendar-errors*"))
925 (insert (format "Error in line %d -- %s: `%s'\n"
926 (count-lines (point-min) (point))
930 ;; we're done, insert everything into the file
932 (let ((coding-system-for-write 'utf-8
))
933 (set-buffer (find-file ical-filename
))
934 (goto-char (point-max))
935 (insert "BEGIN:VCALENDAR")
936 (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
937 (insert "\nVERSION:2.0")
939 (insert "\nEND:VCALENDAR\n")
940 ;; save the diary file
946 (defun icalendar--convert-to-ical (nonmarker entry-main
)
947 "Convert a diary entry to icalendar format.
948 NONMARKER is a regular expression matching the start of non-marking
949 entries. ENTRY-MAIN is the first line of the diary entry."
951 ;; anniversaries -- %%(diary-anniversary ...)
952 (icalendar--convert-anniversary-to-ical nonmarker entry-main
)
953 ;; cyclic events -- %%(diary-cyclic ...)
954 (icalendar--convert-cyclic-to-ical nonmarker entry-main
)
955 ;; diary-date -- %%(diary-date ...)
956 (icalendar--convert-date-to-ical nonmarker entry-main
)
957 ;; float events -- %%(diary-float ...)
958 (icalendar--convert-float-to-ical nonmarker entry-main
)
959 ;; block events -- %%(diary-block ...)
960 (icalendar--convert-block-to-ical nonmarker entry-main
)
961 ;; other sexp diary entries
962 (icalendar--convert-sexp-to-ical nonmarker entry-main
)
963 ;; weekly by day -- Monday 8:30 Team meeting
964 (icalendar--convert-weekly-to-ical nonmarker entry-main
)
965 ;; yearly by day -- 1 May Tag der Arbeit
966 (icalendar--convert-yearly-to-ical nonmarker entry-main
)
967 ;; "ordinary" events, start and end time given
969 (icalendar--convert-ordinary-to-ical nonmarker entry-main
)
971 ;; Oops! what's that?
972 (error "Could not parse entry")))
974 (defun icalendar--parse-summary-and-rest (summary-and-rest)
975 "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties.
978 (if (functionp icalendar-import-format
)
981 ;; split summary-and-rest
982 (let* ((s icalendar-import-format
)
983 (p-cla (or (string-match "%c" icalendar-import-format
) -
1))
984 (p-des (or (string-match "%d" icalendar-import-format
) -
1))
985 (p-loc (or (string-match "%l" icalendar-import-format
) -
1))
986 (p-org (or (string-match "%o" icalendar-import-format
) -
1))
987 (p-sum (or (string-match "%s" icalendar-import-format
) -
1))
988 (p-sta (or (string-match "%t" icalendar-import-format
) -
1))
989 (p-url (or (string-match "%u" icalendar-import-format
) -
1))
990 (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url
) '<))
991 pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url
)
992 (dotimes (i (length p-list
))
993 (cond ((and (>= p-cla
0) (= (nth i p-list
) p-cla
))
994 (setq pos-cla
(+ 2 (* 2 i
))))
995 ((and (>= p-des
0) (= (nth i p-list
) p-des
))
996 (setq pos-des
(+ 2 (* 2 i
))))
997 ((and (>= p-loc
0) (= (nth i p-list
) p-loc
))
998 (setq pos-loc
(+ 2 (* 2 i
))))
999 ((and (>= p-org
0) (= (nth i p-list
) p-org
))
1000 (setq pos-org
(+ 2 (* 2 i
))))
1001 ((and (>= p-sta
0) (= (nth i p-list
) p-sta
))
1002 (setq pos-sta
(+ 2 (* 2 i
))))
1003 ((and (>= p-sum
0) (= (nth i p-list
) p-sum
))
1004 (setq pos-sum
(+ 2 (* 2 i
))))
1005 ((and (>= p-url
0) (= (nth i p-list
) p-url
))
1006 (setq pos-url
(+ 2 (* 2 i
))))))
1008 (setq s
(icalendar--rris (car ij
) (cadr ij
) s t t
)))
1010 ;; summary must be first! because of %s
1012 (concat "\\(" icalendar-import-format-summary
"\\)??"))
1014 (concat "\\(" icalendar-import-format-class
"\\)??"))
1016 (concat "\\(" icalendar-import-format-description
"\\)??"))
1018 (concat "\\(" icalendar-import-format-location
"\\)??"))
1020 (concat "\\(" icalendar-import-format-organizer
"\\)??"))
1022 (concat "\\(" icalendar-import-format-status
"\\)??"))
1024 (concat "\\(" icalendar-import-format-url
"\\)??"))))
1025 (setq s
(concat "^" (icalendar--rris "%s" "\\(.*?\\)" s nil t
)
1027 (if (string-match s summary-and-rest
)
1028 (let (cla des loc org sta sum url
)
1029 (if (and pos-sum
(match-beginning pos-sum
))
1030 (setq sum
(substring summary-and-rest
1031 (match-beginning pos-sum
)
1032 (match-end pos-sum
))))
1033 (if (and pos-cla
(match-beginning pos-cla
))
1034 (setq cla
(substring summary-and-rest
1035 (match-beginning pos-cla
)
1036 (match-end pos-cla
))))
1037 (if (and pos-des
(match-beginning pos-des
))
1038 (setq des
(substring summary-and-rest
1039 (match-beginning pos-des
)
1040 (match-end pos-des
))))
1041 (if (and pos-loc
(match-beginning pos-loc
))
1042 (setq loc
(substring summary-and-rest
1043 (match-beginning pos-loc
)
1044 (match-end pos-loc
))))
1045 (if (and pos-org
(match-beginning pos-org
))
1046 (setq org
(substring summary-and-rest
1047 (match-beginning pos-org
)
1048 (match-end pos-org
))))
1049 (if (and pos-sta
(match-beginning pos-sta
))
1050 (setq sta
(substring summary-and-rest
1051 (match-beginning pos-sta
)
1052 (match-end pos-sta
))))
1053 (if (and pos-url
(match-beginning pos-url
))
1054 (setq url
(substring summary-and-rest
1055 (match-beginning pos-url
)
1056 (match-end pos-url
))))
1057 (list (if cla
(cons 'cla cla
) nil
)
1058 (if des
(cons 'des des
) nil
)
1059 (if loc
(cons 'loc loc
) nil
)
1060 (if org
(cons 'org org
) nil
)
1061 (if sta
(cons 'sta sta
) nil
)
1062 ;;(if sum (cons 'sum sum) nil)
1063 (if url
(cons 'url url
) nil
))))))))
1065 ;; subroutines for icalendar-export-region
1066 (defun icalendar--convert-ordinary-to-ical (nonmarker entry-main
)
1067 "Convert \"ordinary\" diary entry to icalendar format.
1068 NONMARKER is a regular expression matching the start of non-marking
1069 entries. ENTRY-MAIN is the first line of the diary entry."
1070 (if (string-match (concat nonmarker
1071 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*"
1072 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1074 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1076 "\\s-*\\(.*?\\) ?$")
1078 (let* ((datetime (substring entry-main
(match-beginning 1)
1080 (startisostring (icalendar--datestring-to-isodate
1082 (endisostring (icalendar--datestring-to-isodate
1085 (starttimestring (icalendar--diarytime-to-isotime
1086 (if (match-beginning 3)
1087 (substring entry-main
1091 (if (match-beginning 4)
1092 (substring entry-main
1096 (endtimestring (icalendar--diarytime-to-isotime
1097 (if (match-beginning 6)
1098 (substring entry-main
1102 (if (match-beginning 7)
1103 (substring entry-main
1107 (summary (icalendar--convert-string-for-export
1108 (substring entry-main
(match-beginning 8)
1110 (icalendar--dmsg "ordinary %s" entry-main
)
1112 (unless startisostring
1113 (error "Could not parse date"))
1115 ;; If only start-date is specified, then end-date is next day,
1116 ;; otherwise it is same day.
1117 (setq endisostring1
(if starttimestring
1121 (when starttimestring
1122 (unless endtimestring
1124 (read (icalendar--rris "^T0?" ""
1127 ;; Case: ends on same day
1128 (setq endtimestring
(format "T%06d"
1130 ;; Case: ends on next day
1131 (setq endtimestring
(format "T%06d"
1133 (setq endisostring1 endisostring
)) )))
1135 (list (concat "\nDTSTART;"
1136 (if starttimestring
"VALUE=DATE-TIME:"
1139 (or starttimestring
"")
1141 (if endtimestring
"VALUE=DATE-TIME:"
1144 (or endtimestring
""))
1149 (defun icalendar-first-weekday-of-year (abbrevweekday year
)
1150 "Find the first ABBREVWEEKDAY in a given YEAR.
1151 Returns day number."
1152 (let* ((day-of-week-jan01 (calendar-day-of-week (list 1 1 year
)))
1154 (- (icalendar--get-weekday-number abbrevweekday
)
1155 day-of-week-jan01
))))
1156 (cond ((<= result
0)
1157 (setq result
(+ result
7)))
1159 (setq result
(- result
7))))
1162 (defun icalendar--convert-weekly-to-ical (nonmarker entry-main
)
1163 "Convert weekly diary entry to icalendar format.
1164 NONMARKER is a regular expression matching the start of non-marking
1165 entries. ENTRY-MAIN is the first line of the diary entry."
1166 (if (and (string-match (concat nonmarker
1168 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)"
1171 "\\([1-9][0-9]?:[0-9][0-9]\\)"
1174 "\\s-*\\(.*?\\) ?$")
1176 (icalendar--get-weekday-abbrev
1177 (substring entry-main
(match-beginning 1)
1179 (let* ((day (icalendar--get-weekday-abbrev
1180 (substring entry-main
(match-beginning 1)
1182 (starttimestring (icalendar--diarytime-to-isotime
1183 (if (match-beginning 3)
1184 (substring entry-main
1188 (if (match-beginning 4)
1189 (substring entry-main
1193 (endtimestring (icalendar--diarytime-to-isotime
1194 (if (match-beginning 6)
1195 (substring entry-main
1199 (if (match-beginning 7)
1200 (substring entry-main
1204 (summary (icalendar--convert-string-for-export
1205 (substring entry-main
(match-beginning 8)
1207 (icalendar--dmsg "weekly %s" entry-main
)
1209 (when starttimestring
1210 (unless endtimestring
1212 (icalendar--rris "^T0?" ""
1214 (setq endtimestring
(format "T%06d"
1216 (list (concat "\nDTSTART;"
1220 ;; Find the first requested weekday of the
1222 (funcall 'format
"%04d%02d%02d"
1223 icalendar-recurring-start-year
1
1224 (icalendar-first-weekday-of-year
1225 day icalendar-recurring-start-year
))
1226 (or starttimestring
"")
1231 (funcall 'format
"%04d%02d%02d"
1232 ;; end is non-inclusive!
1233 icalendar-recurring-start-year
1
1234 (+ (icalendar-first-weekday-of-year
1235 day icalendar-recurring-start-year
)
1236 (if endtimestring
0 1)))
1237 (or endtimestring
"")
1238 "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY="
1244 (defun icalendar--convert-yearly-to-ical (nonmarker entry-main
)
1245 "Convert yearly diary entry to icalendar format.
1246 NONMARKER is a regular expression matching the start of non-marking
1247 entries. ENTRY-MAIN is the first line of the diary entry."
1248 (if (string-match (concat nonmarker
1249 (if european-calendar-style
1250 "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
1251 "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+")
1253 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1255 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1257 "\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years
1260 (let* ((daypos (if european-calendar-style
1 2))
1261 (monpos (if european-calendar-style
2 1))
1262 (day (read (substring entry-main
1263 (match-beginning daypos
)
1264 (match-end daypos
))))
1265 (month (icalendar--get-month-number
1266 (substring entry-main
1267 (match-beginning monpos
)
1268 (match-end monpos
))))
1269 (starttimestring (icalendar--diarytime-to-isotime
1270 (if (match-beginning 4)
1271 (substring entry-main
1275 (if (match-beginning 5)
1276 (substring entry-main
1280 (endtimestring (icalendar--diarytime-to-isotime
1281 (if (match-beginning 7)
1282 (substring entry-main
1286 (if (match-beginning 8)
1287 (substring entry-main
1291 (summary (icalendar--convert-string-for-export
1292 (substring entry-main
(match-beginning 9)
1294 (icalendar--dmsg "yearly %s" entry-main
)
1296 (when starttimestring
1297 (unless endtimestring
1299 (icalendar--rris "^T0?" ""
1301 (setq endtimestring
(format "T%06d"
1303 (list (concat "\nDTSTART;"
1304 (if starttimestring
"VALUE=DATE-TIME:"
1306 (format "1900%02d%02d" month day
)
1307 (or starttimestring
"")
1309 (if endtimestring
"VALUE=DATE-TIME:"
1311 ;; end is not included! shift by one day
1312 (icalendar--date-to-isodate
1313 (list month day
1900)
1314 (if endtimestring
0 1))
1315 (or endtimestring
"")
1316 "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
1324 (defun icalendar--convert-sexp-to-ical (nonmarker entry-main
)
1325 "Convert complex sexp diary entry to icalendar format -- unsupported!
1329 NONMARKER is a regular expression matching the start of non-marking
1330 entries. ENTRY-MAIN is the first line of the diary entry."
1331 (cond ((string-match (concat nonmarker
1332 "%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$")
1334 ;; simple sexp entry as generated by icalendar.el: strip off the
1335 ;; unnecessary (and)
1336 (icalendar--dmsg "diary-sexp from icalendar.el %s" entry-main
)
1337 (icalendar--convert-to-ical
1340 (substring entry-main
(match-beginning 1) (match-end 1))
1341 (substring entry-main
(match-beginning 2) (match-end 2)))))
1342 ((string-match (concat nonmarker
1345 (icalendar--dmsg "diary-sexp %s" entry-main
)
1346 (error "Sexp-entries are not supported yet"))
1351 (defun icalendar--convert-block-to-ical (nonmarker entry-main
)
1352 "Convert block diary entry to icalendar format.
1353 NONMARKER is a regular expression matching the start of non-marking
1354 entries. ENTRY-MAIN is the first line of the diary entry."
1355 (if (string-match (concat nonmarker
1356 "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)"
1357 " +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1358 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1360 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1362 "\\s-*\\(.*?\\) ?$")
1364 (let* ((startstring (substring entry-main
1367 (endstring (substring entry-main
1370 (startisostring (icalendar--datestring-to-isodate
1372 (endisostring (icalendar--datestring-to-isodate
1374 (endisostring+1 (icalendar--datestring-to-isodate
1376 (starttimestring (icalendar--diarytime-to-isotime
1377 (if (match-beginning 4)
1378 (substring entry-main
1382 (if (match-beginning 5)
1383 (substring entry-main
1387 (endtimestring (icalendar--diarytime-to-isotime
1388 (if (match-beginning 7)
1389 (substring entry-main
1393 (if (match-beginning 8)
1394 (substring entry-main
1398 (summary (icalendar--convert-string-for-export
1399 (substring entry-main
(match-beginning 9)
1401 (icalendar--dmsg "diary-block %s" entry-main
)
1402 (when starttimestring
1403 (unless endtimestring
1405 (read (icalendar--rris "^T0?" ""
1407 (setq endtimestring
(format "T%06d"
1410 ;; with time -> write rrule
1411 (list (concat "\nDTSTART;VALUE=DATE-TIME:"
1414 "\nDTEND;VALUE=DATE-TIME:"
1417 "\nRRULE:FREQ=DAILY;INTERVAL=1;UNTIL="
1420 ;; no time -> write long event
1421 (list (concat "\nDTSTART;VALUE=DATE:" startisostring
1422 "\nDTEND;VALUE=DATE:" endisostring
+1)
1427 (defun icalendar--convert-float-to-ical (nonmarker entry-main
)
1428 "Convert float diary entry to icalendar format -- unsupported!
1432 NONMARKER is a regular expression matching the start of non-marking
1433 entries. ENTRY-MAIN is the first line of the diary entry."
1434 (if (string-match (concat nonmarker
1435 "%%(diary-float \\([^)]+\\))\\s-*\\(.*?\\) ?$")
1438 (icalendar--dmsg "diary-float %s" entry-main
)
1439 (error "`diary-float' is not supported yet"))
1443 (defun icalendar--convert-date-to-ical (nonmarker entry-main
)
1444 "Convert `diary-date' diary entry to icalendar format -- unsupported!
1448 NONMARKER is a regular expression matching the start of non-marking
1449 entries. ENTRY-MAIN is the first line of the diary entry."
1450 (if (string-match (concat nonmarker
1451 "%%(diary-date \\([^)]+\\))\\s-*\\(.*?\\) ?$")
1454 (icalendar--dmsg "diary-date %s" entry-main
)
1455 (error "`diary-date' is not supported yet"))
1459 (defun icalendar--convert-cyclic-to-ical (nonmarker entry-main
)
1460 "Convert `diary-cyclic' diary entry to icalendar format.
1461 NONMARKER is a regular expression matching the start of non-marking
1462 entries. ENTRY-MAIN is the first line of the diary entry."
1463 (if (string-match (concat nonmarker
1464 "%%(diary-cyclic \\([^ ]+\\) +"
1465 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1466 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1468 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1470 "\\s-*\\(.*?\\) ?$")
1472 (let* ((frequency (substring entry-main
(match-beginning 1)
1474 (datetime (substring entry-main
(match-beginning 2)
1476 (startisostring (icalendar--datestring-to-isodate
1478 (endisostring (icalendar--datestring-to-isodate
1480 (endisostring+1 (icalendar--datestring-to-isodate
1482 (starttimestring (icalendar--diarytime-to-isotime
1483 (if (match-beginning 4)
1484 (substring entry-main
1488 (if (match-beginning 5)
1489 (substring entry-main
1493 (endtimestring (icalendar--diarytime-to-isotime
1494 (if (match-beginning 7)
1495 (substring entry-main
1499 (if (match-beginning 8)
1500 (substring entry-main
1504 (summary (icalendar--convert-string-for-export
1505 (substring entry-main
(match-beginning 9)
1507 (icalendar--dmsg "diary-cyclic %s" entry-main
)
1508 (when starttimestring
1509 (unless endtimestring
1511 (read (icalendar--rris "^T0?" ""
1513 (setq endtimestring
(format "T%06d"
1515 (list (concat "\nDTSTART;"
1516 (if starttimestring
"VALUE=DATE-TIME:"
1519 (or starttimestring
"")
1521 (if endtimestring
"VALUE=DATE-TIME:"
1523 (if endtimestring endisostring endisostring
+1)
1524 (or endtimestring
"")
1525 "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
1526 ;; strange: korganizer does not expect
1527 ;; BYSOMETHING here...
1533 (defun icalendar--convert-anniversary-to-ical (nonmarker entry-main
)
1534 "Convert `diary-anniversary' diary entry to icalendar format.
1535 NONMARKER is a regular expression matching the start of non-marking
1536 entries. ENTRY-MAIN is the first line of the diary entry."
1537 (if (string-match (concat nonmarker
1538 "%%(diary-anniversary \\([^)]+\\))\\s-*"
1539 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1541 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1543 "\\s-*\\(.*?\\) ?$")
1545 (let* ((datetime (substring entry-main
(match-beginning 1)
1547 (startisostring (icalendar--datestring-to-isodate
1549 (endisostring (icalendar--datestring-to-isodate
1551 (starttimestring (icalendar--diarytime-to-isotime
1552 (if (match-beginning 3)
1553 (substring entry-main
1557 (if (match-beginning 4)
1558 (substring entry-main
1562 (endtimestring (icalendar--diarytime-to-isotime
1563 (if (match-beginning 6)
1564 (substring entry-main
1568 (if (match-beginning 7)
1569 (substring entry-main
1573 (summary (icalendar--convert-string-for-export
1574 (substring entry-main
(match-beginning 8)
1576 (icalendar--dmsg "diary-anniversary %s" entry-main
)
1577 (when starttimestring
1578 (unless endtimestring
1580 (read (icalendar--rris "^T0?" ""
1582 (setq endtimestring
(format "T%06d"
1584 (list (concat "\nDTSTART;"
1585 (if starttimestring
"VALUE=DATE-TIME:"
1588 (or starttimestring
"")
1590 (if endtimestring
"VALUE=DATE-TIME:"
1593 (or endtimestring
"")
1594 "\nRRULE:FREQ=YEARLY;INTERVAL=1"
1595 ;; the following is redundant,
1596 ;; but korganizer seems to expect this... ;(
1597 ;; and evolution doesn't understand it... :(
1598 ;; so... who is wrong?!
1600 (substring startisostring
4 6)
1602 (substring startisostring
6 8))
1607 ;; ======================================================================
1608 ;; Import -- convert icalendar to emacs-diary
1609 ;; ======================================================================
1612 (defun icalendar-import-file (ical-filename diary-filename
1613 &optional non-marking
)
1614 "Import an iCalendar file and append to a diary file.
1615 Argument ICAL-FILENAME output iCalendar file.
1616 Argument DIARY-FILENAME input `diary-file'.
1617 Optional argument NON-MARKING determines whether events are created as
1618 non-marking or not."
1619 (interactive "fImport iCalendar data from file:
1622 ;; clean up the diary file
1623 (save-current-buffer
1624 ;; now load and convert from the ical file
1625 (set-buffer (find-file ical-filename
))
1626 (icalendar-import-buffer diary-filename t non-marking
)))
1629 (defun icalendar-import-buffer (&optional diary-file do-not-ask
1631 "Extract iCalendar events from current buffer.
1633 This function searches the current buffer for the first iCalendar
1634 object, reads it and adds all VEVENT elements to the diary
1637 It will ask for each appointment whether to add it to the diary
1638 unless DO-NOT-ASK is non-nil. When called interactively,
1639 DO-NOT-ASK is nil, so that you are asked for each event.
1641 NON-MARKING determines whether diary events are created as
1644 Return code t means that importing worked well, return code nil
1645 means that an error has occurred. Error messages will be in the
1646 buffer `*icalendar-errors*'."
1648 (save-current-buffer
1650 (message "Preparing icalendar...")
1651 (set-buffer (icalendar--get-unfolded-buffer (current-buffer)))
1652 (goto-char (point-min))
1653 (message "Preparing icalendar...done")
1654 (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t
)
1655 (let (ical-contents ical-errors
)
1657 (message "Reading icalendar...")
1659 (setq ical-contents
(icalendar--read-element nil nil
))
1660 (message "Reading icalendar...done")
1662 (message "Converting icalendar...")
1663 (setq ical-errors
(icalendar--convert-ical-to-diary
1665 diary-file do-not-ask non-marking
))
1667 ;; save the diary file if it is visited already
1668 (let ((b (find-buffer-visiting diary-file
)))
1670 (save-current-buffer
1673 (message "Converting icalendar...done")
1674 ;; return t if no error occurred
1677 "Current buffer does not contain icalendar contents!")
1678 ;; return nil, i.e. import did not work
1681 (defalias 'icalendar-extract-ical-from-buffer
'icalendar-import-buffer
)
1682 (make-obsolete 'icalendar-extract-ical-from-buffer
'icalendar-import-buffer
)
1684 (defun icalendar--format-ical-event (event)
1685 "Create a string representation of an iCalendar EVENT."
1686 (if (functionp icalendar-import-format
)
1687 (funcall icalendar-import-format event
)
1688 (let ((string icalendar-import-format
)
1690 '(("%c" CLASS icalendar-import-format-class
)
1691 ("%d" DESCRIPTION icalendar-import-format-description
)
1692 ("%l" LOCATION icalendar-import-format-location
)
1693 ("%o" ORGANIZER icalendar-import-format-organizer
)
1694 ("%s" SUMMARY icalendar-import-format-summary
)
1695 ("%t" STATUS icalendar-import-format-status
)
1696 ("%u" URL icalendar-import-format-url
))))
1697 ;; convert the specifiers in the format string
1699 (let* ((spec (car i
))
1701 (format (car (cddr i
)))
1702 (contents (icalendar--get-event-property event prop
))
1703 (formatted-contents ""))
1704 (when (and contents
(> (length contents
) 0))
1705 (setq formatted-contents
1706 (icalendar--rris "%s"
1707 (icalendar--convert-string-for-import
1709 (symbol-value format
)
1711 (setq string
(icalendar--rris spec
1718 (defun icalendar--convert-ical-to-diary (ical-list diary-file
1719 &optional do-not-ask
1721 "Convert iCalendar data to an Emacs diary file.
1722 Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
1723 DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event
1724 whether to actually import it. NON-MARKING determines whether diary
1725 events are created as non-marking.
1726 This function attempts to return t if something goes wrong. In this
1727 case an error string which describes all the errors and problems is
1728 written into the buffer `*icalendar-errors*'."
1729 (let* ((ev (icalendar--all-events ical-list
))
1733 (zone-map (icalendar--convert-all-timezones ical-list
))
1735 ;; step through all events/appointments
1740 (condition-case error-val
1741 (let* ((dtstart (icalendar--get-event-property e
'DTSTART
))
1742 (dtstart-zone (icalendar--find-time-zone
1743 (icalendar--get-event-property-attributes
1746 (dtstart-dec (icalendar--decode-isodatetime dtstart nil
1748 (start-d (icalendar--datetime-to-diary-date
1750 (start-t (icalendar--datetime-to-colontime dtstart-dec
))
1751 (dtend (icalendar--get-event-property e
'DTEND
))
1752 (dtend-zone (icalendar--find-time-zone
1753 (icalendar--get-event-property-attributes
1756 (dtend-dec (icalendar--decode-isodatetime dtend
1758 (dtend-1-dec (icalendar--decode-isodatetime dtend -
1
1763 (summary (icalendar--convert-string-for-import
1764 (or (icalendar--get-event-property e
'SUMMARY
)
1766 (rrule (icalendar--get-event-property e
'RRULE
))
1767 (rdate (icalendar--get-event-property e
'RDATE
))
1768 (duration (icalendar--get-event-property e
'DURATION
)))
1769 (icalendar--dmsg "%s: `%s'" start-d summary
)
1770 ;; check whether start-time is missing
1773 (cadr (icalendar--get-event-property-attributes
1778 (let ((dtend-dec-d (icalendar--add-decoded-times
1780 (icalendar--decode-isoduration duration
)))
1781 (dtend-1-dec-d (icalendar--add-decoded-times
1783 (icalendar--decode-isoduration duration
1785 (if (and dtend-dec
(not (eq dtend-dec dtend-dec-d
)))
1786 (message "Inconsistent endtime and duration for %s"
1788 (setq dtend-dec dtend-dec-d
)
1789 (setq dtend-1-dec dtend-1-dec-d
)))
1790 (setq end-d
(if dtend-dec
1791 (icalendar--datetime-to-diary-date dtend-dec
)
1793 (setq end-1-d
(if dtend-1-dec
1794 (icalendar--datetime-to-diary-date dtend-1-dec
)
1796 (setq end-t
(if (and
1800 (icalendar--get-event-property-attributes
1803 (icalendar--datetime-to-colontime dtend-dec
)
1805 (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d
)
1810 (icalendar--convert-recurring-to-diary e dtstart-dec start-t
1814 (icalendar--dmsg "rdate event")
1815 (setq diary-string
"")
1816 (mapc (lambda (datestring)
1818 (concat diary-string
1819 (format "......"))))
1820 (icalendar--split-value rdate
)))
1821 ;; non-recurring event
1823 ((not (string= start-d end-d
))
1825 (icalendar--convert-non-recurring-all-day-to-diary
1829 ((and start-t
(or (not end-t
)
1830 (not (string= start-t end-t
))))
1832 (icalendar--convert-non-recurring-not-all-day-to-diary
1833 e dtstart-dec dtend-dec start-t end-t
))
1837 (icalendar--dmsg "all day event")
1838 (setq diary-string
(icalendar--datetime-to-diary-date
1841 ;; add all other elements unless the user doesn't want to have
1846 (concat diary-string
" "
1847 (icalendar--format-ical-event e
)))
1848 (if do-not-ask
(setq summary nil
))
1849 ;; add entry to diary and store actual name of diary
1850 ;; file (in case it was nil)
1852 (icalendar--add-diary-entry diary-string diary-file
1853 non-marking summary
)))
1855 (setq found-error t
)
1857 (format "%s\nCannot handle this event:%s"
1859 ;; FIXME: inform user about ignored event properties
1862 (message "Ignoring event \"%s\"" e
)
1863 (setq found-error t
)
1864 (setq error-string
(format "%s\n%s\nCannot handle this event: %s"
1865 error-val error-string e
))
1866 (message "%s" error-string
))))
1868 ;; insert final newline
1870 (let ((b (find-buffer-visiting diary-file
)))
1872 (save-current-buffer
1874 (goto-char (point-max))
1877 (save-current-buffer
1878 (set-buffer (get-buffer-create "*icalendar-errors*"))
1880 (insert error-string
)))
1881 (message "Converting icalendar...done")
1884 ;; subroutines for importing
1885 (defun icalendar--convert-recurring-to-diary (e dtstart-dec start-t end-t
)
1886 "Convert recurring icalendar event E to diary format.
1888 DTSTART-DEC is the DTSTART property of E.
1889 START-T is the event's start time in diary format.
1890 END-T is the event's end time in diary format."
1891 (icalendar--dmsg "recurring event")
1892 (let* ((rrule (icalendar--get-event-property e
'RRULE
))
1893 (rrule-props (icalendar--split-value rrule
))
1894 (frequency (cadr (assoc 'FREQ rrule-props
)))
1895 (until (cadr (assoc 'UNTIL rrule-props
)))
1896 (count (cadr (assoc 'COUNT rrule-props
)))
1897 (interval (read (or (cadr (assoc 'INTERVAL rrule-props
)) "1")))
1898 (dtstart-conv (icalendar--datetime-to-diary-date dtstart-dec
))
1899 (until-conv (icalendar--datetime-to-diary-date
1900 (icalendar--decode-isodatetime until
)))
1901 (until-1-conv (icalendar--datetime-to-diary-date
1902 (icalendar--decode-isodatetime until -
1)))
1905 ;; FIXME FIXME interval!!!!!!!!!!!!!
1909 (message "Must not have UNTIL and COUNT -- ignoring COUNT element!")
1911 (cond ((string-equal frequency
"DAILY")
1912 (setq until
(icalendar--add-decoded-times
1914 (list 0 0 0 (* (read count
) interval
) 0 0)))
1915 (setq until-1
(icalendar--add-decoded-times
1917 (list 0 0 0 (* (- (read count
) 1) interval
)
1920 ((string-equal frequency
"WEEKLY")
1921 (setq until
(icalendar--add-decoded-times
1923 (list 0 0 0 (* (read count
) 7 interval
) 0 0)))
1924 (setq until-1
(icalendar--add-decoded-times
1926 (list 0 0 0 (* (- (read count
) 1) 7
1929 ((string-equal frequency
"MONTHLY")
1930 (setq until
(icalendar--add-decoded-times
1931 dtstart-dec
(list 0 0 0 0 (* (- (read count
) 1)
1933 (setq until-1
(icalendar--add-decoded-times
1934 dtstart-dec
(list 0 0 0 0 (* (- (read count
) 1)
1937 ((string-equal frequency
"YEARLY")
1938 (setq until
(icalendar--add-decoded-times
1939 dtstart-dec
(list 0 0 0 0 0 (* (- (read count
) 1)
1941 (setq until-1
(icalendar--add-decoded-times
1943 (list 0 0 0 0 0 (* (- (read count
) 1)
1947 (message "Cannot handle COUNT attribute for `%s' events."
1949 (setq until-conv
(icalendar--datetime-to-diary-date until
))
1950 (setq until-1-conv
(icalendar--datetime-to-diary-date until-1
))
1953 (cond ((string-equal frequency
"WEEKLY")
1956 ;; weekly and all-day
1957 (icalendar--dmsg "weekly all-day")
1962 "(diary-cyclic %d %s) "
1963 "(diary-block %s %s))")
1967 (if count until-1-conv until-conv
)
1970 (format "%%%%(and (diary-cyclic %d %s))"
1973 ;; weekly and not all-day
1974 (let* ((byday (cadr (assoc 'BYDAY rrule-props
)))
1976 (icalendar--get-weekday-number byday
)))
1977 (icalendar--dmsg "weekly not-all-day")
1982 "(diary-cyclic %d %s) "
1983 "(diary-block %s %s)) "
1990 (if end-t
"-" "") (or end-t
"")))
1993 ;; DTSTART;VALUE=DATE-TIME:20030919T090000
1994 ;; DTEND;VALUE=DATE-TIME:20030919T113000
1997 "%%%%(and (diary-cyclic %s %s)) %s%s%s"
2001 (if end-t
"-" "") (or end-t
"")))))))
2003 ((string-equal frequency
"YEARLY")
2004 (icalendar--dmsg "yearly")
2006 (setq result
(format
2007 (concat "%%%%(and (diary-date %s %s t) "
2008 "(diary-block %s %s)) %s%s%s")
2009 (if european-calendar-style
(nth 3 dtstart-dec
)
2010 (nth 4 dtstart-dec
))
2011 (if european-calendar-style
(nth 4 dtstart-dec
)
2012 (nth 3 dtstart-dec
))
2016 (if end-t
"-" "") (or end-t
"")))
2017 (setq result
(format
2018 "%%%%(and (diary-anniversary %s)) %s%s%s"
2021 (if end-t
"-" "") (or end-t
"")))))
2023 ((string-equal frequency
"MONTHLY")
2024 (icalendar--dmsg "monthly")
2027 "%%%%(and (diary-date %s %s %s) (diary-block %s %s)) %s%s%s"
2028 (if european-calendar-style
(nth 3 dtstart-dec
) "t")
2029 (if european-calendar-style
"t" (nth 3 dtstart-dec
))
2034 "1 1 9999") ;; FIXME: should be unlimited
2036 (if end-t
"-" "") (or end-t
""))))
2038 ((and (string-equal frequency
"DAILY"))
2042 (concat "%%%%(and (diary-cyclic %s %s) "
2043 "(diary-block %s %s)) %s%s%s")
2044 interval dtstart-conv dtstart-conv
2045 (if count until-1-conv until-conv
)
2047 (if end-t
"-" "") (or end-t
"")))
2050 "%%%%(and (diary-cyclic %s %s)) %s%s%s"
2054 (if end-t
"-" "") (or end-t
""))))))
2055 ;; Handle exceptions from recurrence rules
2056 (let ((ex-dates (icalendar--get-event-properties e
'EXDATE
)))
2058 (let* ((ex-start (icalendar--decode-isodatetime
2060 (ex-d (icalendar--datetime-to-diary-date
2063 (icalendar--rris "^%%(\\(and \\)?"
2065 "%%%%(and (not (diary-date %s)) "
2068 (setq ex-dates
(cdr ex-dates
))))
2069 ;; FIXME: exception rules are not recognized
2070 (if (icalendar--get-event-property e
'EXRULE
)
2073 "\n Exception rules: "
2074 (icalendar--get-event-properties
2078 (defun icalendar--convert-non-recurring-all-day-to-diary (event start-d end-d
)
2079 "Convert non-recurring icalendar EVENT to diary format.
2081 DTSTART is the decoded DTSTART property of E.
2082 Argument START-D gives the first day.
2083 Argument END-D gives the last day."
2084 (icalendar--dmsg "non-recurring all-day event")
2085 (format "%%%%(and (diary-block %s %s))" start-d end-d
))
2087 (defun icalendar--convert-non-recurring-not-all-day-to-diary (event dtstart-dec
2091 "Convert recurring icalendar EVENT to diary format.
2093 DTSTART-DEC is the decoded DTSTART property of E.
2094 DTEND-DEC is the decoded DTEND property of E.
2095 START-T is the event's start time in diary format.
2096 END-T is the event's end time in diary format."
2097 (icalendar--dmsg "not all day event")
2100 (icalendar--datetime-to-diary-date
2105 (icalendar--datetime-to-diary-date
2109 (defun icalendar--add-diary-entry (string diary-file non-marking
2111 "Add STRING to the diary file DIARY-FILE.
2112 STRING must be a properly formatted valid diary entry. NON-MARKING
2113 determines whether diary events are created as non-marking. If
2114 SUMMARY is not nil it must be a string that gives the summary of the
2115 entry. In this case the user will be asked whether he wants to insert
2117 (when (or (not summary
)
2118 (y-or-n-p (format "Add appointment for `%s' to diary? "
2122 (y-or-n-p (format "Make appointment non-marking? "))))
2123 (save-window-excursion
2126 (read-file-name "Add appointment to this diary file: ")))
2127 ;; Note: diary-make-entry will add a trailing blank char.... :(
2128 (funcall (if (fboundp 'diary-make-entry
)
2131 string non-marking diary-file
)))
2132 ;; return diary-file in case it has been changed interactively
2135 ;; ======================================================================
2137 ;; ======================================================================
2138 (defun icalendar-import-format-sample (event)
2139 "Example function for formatting an icalendar EVENT."
2140 (format (concat "SUMMARY=`%s' DESCRIPTION=`%s' LOCATION=`%s' ORGANIZER=`%s' "
2141 "STATUS=`%s' URL=`%s' CLASS=`%s'")
2142 (or (icalendar--get-event-property event
'SUMMARY
) "")
2143 (or (icalendar--get-event-property event
'DESCRIPTION
) "")
2144 (or (icalendar--get-event-property event
'LOCATION
) "")
2145 (or (icalendar--get-event-property event
'ORGANIZER
) "")
2146 (or (icalendar--get-event-property event
'STATUS
) "")
2147 (or (icalendar--get-event-property event
'URL
) "")
2148 (or (icalendar--get-event-property event
'CLASS
) "")))
2150 (provide 'icalendar
)
2152 ;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc
2153 ;;; icalendar.el ends here