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.19"
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."
205 (defcustom icalendar-export-hidden-diary-entries
207 "Determines whether hidden diary entries are exported.
208 If non-nil hidden diary entries (starting with `&') get exported,
209 if nil they are ignored."
213 (defvar icalendar-debug nil
214 "Enable icalendar debug messages.")
216 ;; ======================================================================
217 ;; NO USER SERVICABLE PARTS BELOW THIS LINE
218 ;; ======================================================================
220 (defconst icalendar--weekday-array
["SU" "MO" "TU" "WE" "TH" "FR" "SA"])
222 ;; ======================================================================
223 ;; all the other libs we need
224 ;; ======================================================================
227 ;; ======================================================================
229 ;; ======================================================================
230 (defun icalendar--dmsg (&rest args
)
231 "Print message ARGS if `icalendar-debug' is non-nil."
233 (apply 'message args
)))
235 ;; ======================================================================
236 ;; Core functionality
237 ;; Functions for parsing icalendars, importing and so on
238 ;; ======================================================================
240 (defun icalendar--get-unfolded-buffer (folded-ical-buffer)
241 "Return a new buffer containing the unfolded contents of a buffer.
242 Folding is the iCalendar way of wrapping long lines. In the
243 created buffer all occurrences of CR LF BLANK are replaced by the
244 empty string. Argument FOLDED-ICAL-BUFFER is the unfolded input
246 (let ((unfolded-buffer (get-buffer-create " *icalendar-work*")))
248 (set-buffer unfolded-buffer
)
250 (insert-buffer-substring folded-ical-buffer
)
251 (goto-char (point-min))
252 (while (re-search-forward "\r?\n[ \t]" nil t
)
253 (replace-match "" nil nil
)))
256 (defsubst icalendar--rris
(regexp rep string
&optional fixedcase literal
)
257 "Replace regular expression in string.
258 Pass arguments REGEXP REP STRING FIXEDCASE LITERAL to
259 `replace-regexp-in-string' (Emacs) or to `replace-in-string' (XEmacs)."
260 (cond ((fboundp 'replace-regexp-in-string
)
262 (replace-regexp-in-string regexp rep string fixedcase literal
))
263 ((fboundp 'replace-in-string
)
265 (save-match-data ;; apparently XEmacs needs save-match-data
266 (replace-in-string string regexp rep literal
)))))
268 (defun icalendar--read-element (invalue inparams
)
269 "Recursively read the next iCalendar element in the current buffer.
270 INVALUE gives the current iCalendar element we are reading.
271 INPARAMS gives the current parameters.....
272 This function calls itself recursively for each nested calendar element
274 (let (element children line name params param param-name param-value
279 (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t
))
280 (setq name
(intern (match-string 1)))
284 (while (looking-at ";")
285 (re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil
)
286 (setq param-name
(intern (match-string 1)))
287 (re-search-forward "\\(\\([^;,:\"]+\\)\\|\"\\([^\"]+\\)\"\\)[;:]"
290 (setq param-value
(or (match-string 2) (match-string 3)))
291 (setq param
(list param-name param-value
))
292 (while (looking-at ",")
293 (re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)"
296 (setq param-value
(match-string 2))
297 (setq param-value
(match-string 3)))
298 (setq param
(append param param-value
)))
299 (setq params
(append params param
)))
300 (unless (looking-at ":")
303 (re-search-forward "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t
)
304 (setq value
(icalendar--rris "\r?\n[ \t]" "" (match-string 0)))
305 (setq line
(list name params value
))
306 (cond ((eq name
'BEGIN
)
309 (list (icalendar--read-element (intern value
)
314 (setq element
(append element
(list line
))))))
316 (list invalue inparams element children
)
319 ;; ======================================================================
320 ;; helper functions for examining events
321 ;; ======================================================================
323 ;;(defsubst icalendar--get-all-event-properties (event)
324 ;; "Return the list of properties in this EVENT."
325 ;; (car (cddr event)))
327 (defun icalendar--get-event-property (event prop
)
328 "For the given EVENT return the value of the first occurrence of PROP."
330 (let ((props (car (cddr event
))) pp
)
332 (setq pp
(car props
))
333 (if (eq (car pp
) prop
)
334 (throw 'found
(car (cddr pp
))))
335 (setq props
(cdr props
))))
338 (defun icalendar--get-event-property-attributes (event prop
)
339 "For the given EVENT return attributes of the first occurrence of PROP."
341 (let ((props (car (cddr event
))) pp
)
343 (setq pp
(car props
))
344 (if (eq (car pp
) prop
)
345 (throw 'found
(cadr pp
)))
346 (setq props
(cdr props
))))
349 (defun icalendar--get-event-properties (event prop
)
350 "For the given EVENT return a list of all values of the property PROP."
351 (let ((props (car (cddr event
))) pp result
)
353 (setq pp
(car props
))
354 (if (eq (car pp
) prop
)
355 (setq result
(append (split-string (car (cddr pp
)) ",") result
)))
356 (setq props
(cdr props
)))
359 ;; (defun icalendar--set-event-property (event prop new-value)
360 ;; "For the given EVENT set the property PROP to the value NEW-VALUE."
362 ;; (let ((props (car (cddr event))) pp)
364 ;; (setq pp (car props))
365 ;; (when (eq (car pp) prop)
366 ;; (setcdr (cdr pp) new-value)
367 ;; (throw 'found (car (cddr pp))))
368 ;; (setq props (cdr props)))
369 ;; (setq props (car (cddr event)))
370 ;; (setcar (cddr event)
371 ;; (append props (list (list prop nil new-value)))))))
373 (defun icalendar--get-children (node name
)
374 "Return all children of the given NODE which have a name NAME.
375 For instance the VCALENDAR node can have VEVENT children as well as VTODO
378 (children (cadr (cddr node
))))
379 (when (eq (car node
) name
)
381 ;;(message "%s" node)
386 (icalendar--get-children n name
))
390 (setq result
(append result subresult
))
391 (setq result subresult
)))))
395 (defun icalendar--all-events (icalendar)
396 "Return the list of all existing events in the given ICALENDAR."
397 (icalendar--get-children (car icalendar
) 'VEVENT
))
399 (defun icalendar--split-value (value-string)
400 "Split VALUE-STRING at ';='."
402 param-name param-value
)
405 (set-buffer (get-buffer-create " *icalendar-work*"))
406 (set-buffer-modified-p nil
)
408 (insert value-string
)
409 (goto-char (point-min))
412 "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
414 (setq param-name
(intern (match-string 1)))
415 (setq param-value
(match-string 2))
417 (append result
(list (list param-name param-value
)))))))
420 (defun icalendar--convert-tz-offset (alist dst-p
)
421 "Return a cons of two strings representing a timezone start.
422 ALIST is an alist entry from a VTIMEZONE, like STANDARD.
423 DST-P is non-nil if this is for daylight savings time.
424 The strings are suitable for assembling into a TZ variable."
425 (let ((offset (car (cddr (assq 'TZOFFSETTO alist
))))
426 (rrule-value (car (cddr (assq 'RRULE alist
))))
427 (dtstart (car (cddr (assq 'DTSTART alist
)))))
428 ;; FIXME: for now we only handle RRULE and not RDATE here.
429 (when (and offset rrule-value dtstart
)
430 (let* ((rrule (icalendar--split-value rrule-value
))
431 (freq (cadr (assq 'FREQ rrule
)))
432 (bymonth (cadr (assq 'BYMONTH rrule
)))
433 (byday (cadr (assq 'BYDAY rrule
))))
434 ;; FIXME: we don't correctly handle WKST here.
435 (if (and (string= freq
"YEARLY") bymonth
)
439 (if dst-p
"(DST?)" "(STD?)")
440 ;; For TZ, OFFSET is added to the local time. So,
441 ;; invert the values.
442 (if (eq (aref offset
0) ?-
) "+" "-")
443 (substring offset
1 3)
445 (substring offset
3 5))
447 (let* ((day (icalendar--get-weekday-number (substring byday -
2)))
448 (week (if (eq day -
1)
450 (substring byday
0 -
2))))
451 (concat "M" bymonth
"." week
"." (if (eq day -
1) "0"
455 (substring dtstart -
6 -
4)
457 (substring dtstart -
4 -
2)
459 (substring dtstart -
2)))))))))
461 (defun icalendar--parse-vtimezone (alist)
462 "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
463 Return nil if timezone cannot be parsed."
464 (let* ((tz-id (icalendar--get-event-property alist
'TZID
))
465 (daylight (cadr (cdar (icalendar--get-children alist
'DAYLIGHT
))))
466 (day (and daylight
(icalendar--convert-tz-offset daylight t
)))
467 (standard (cadr (cdar (icalendar--get-children alist
'STANDARD
))))
468 (std (and standard
(icalendar--convert-tz-offset standard nil
))))
472 (concat (car std
) (car day
)
473 "," (cdr day
) "," (cdr std
))
476 (defun icalendar--convert-all-timezones (icalendar)
477 "Convert all timezones in the ICALENDAR into an alist.
478 Each element of the alist is a cons (ID . TZ-STRING),
479 like `icalendar--parse-vtimezone'."
481 (dolist (zone (icalendar--get-children (car icalendar
) 'VTIMEZONE
))
482 (setq zone
(icalendar--parse-vtimezone zone
))
484 (setq result
(cons zone result
))))
487 (defun icalendar--find-time-zone (prop-list zone-map
)
488 "Return a timezone string for the time zone in PROP-LIST, or nil if none.
489 ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'."
490 (let ((id (plist-get prop-list
'TZID
)))
492 (cdr (assoc id zone-map
)))))
494 (defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift
496 "Return ISODATETIMESTRING in format like `decode-time'.
497 Converts from ISO-8601 to Emacs representation. If
498 ISODATETIMESTRING specifies UTC time (trailing letter Z) the
499 decoded time is given in the local time zone! If optional
500 parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
502 ZONE, if provided, is the timezone, in any format understood by `encode-time'.
504 FIXME: multiple comma-separated values should be allowed!"
505 (icalendar--dmsg isodatetimestring
)
506 (if isodatetimestring
507 ;; day/month/year must be present
508 (let ((year (read (substring isodatetimestring
0 4)))
509 (month (read (substring isodatetimestring
4 6)))
510 (day (read (substring isodatetimestring
6 8)))
514 (when (> (length isodatetimestring
) 12)
515 ;; hour/minute present
516 (setq hour
(read (substring isodatetimestring
9 11)))
517 (setq minute
(read (substring isodatetimestring
11 13))))
518 (when (> (length isodatetimestring
) 14)
520 (setq second
(read (substring isodatetimestring
13 15))))
521 (when (and (> (length isodatetimestring
) 15)
522 ;; UTC specifier present
523 (char-equal ?Z
(aref isodatetimestring
15)))
524 ;; if not UTC add current-time-zone offset
525 (setq second
(+ (car (current-time-zone)) second
)))
526 ;; shift if necessary
528 (let ((mdy (calendar-gregorian-from-absolute
529 (+ (calendar-absolute-from-gregorian
530 (list month day year
))
532 (setq month
(nth 0 mdy
))
533 (setq day
(nth 1 mdy
))
534 (setq year
(nth 2 mdy
))))
535 ;; create the decoded date-time
538 (decode-time (encode-time second minute hour day month year zone
))
540 (message "Cannot decode \"%s\"" isodatetimestring
)
541 ;; hope for the best...
542 (list second minute hour day month year
0 nil
0))))
543 ;; isodatetimestring == nil
546 (defun icalendar--decode-isoduration (isodurationstring
547 &optional duration-correction
)
548 "Convert ISODURATIONSTRING into format provided by `decode-time'.
549 Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING
550 specifies UTC time (trailing letter Z) the decoded time is given in
553 Optional argument DURATION-CORRECTION shortens result by one day.
555 FIXME: TZID-attributes are ignored....!
556 FIXME: multiple comma-separated values should be allowed!"
557 (if isodurationstring
562 "\\(\\([0-9]+\\)D\\)" ; days only
564 "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days
565 "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time
567 "\\(\\([0-9]+\\)W\\)" ; weeks only
568 "\\)$") isodurationstring
)
576 ((match-beginning 2) ;days only
577 (setq days
(read (substring isodurationstring
580 (when duration-correction
581 (setq days
(1- days
))))
582 ((match-beginning 4) ;days and time
583 (if (match-beginning 5)
584 (setq days
(* 7 (read (substring isodurationstring
587 (if (match-beginning 7)
588 (setq hours
(read (substring isodurationstring
591 (if (match-beginning 9)
592 (setq minutes
(read (substring isodurationstring
595 (if (match-beginning 11)
596 (setq seconds
(read (substring isodurationstring
599 ((match-beginning 13) ;weeks only
600 (setq days
(* 7 (read (substring isodurationstring
603 (list seconds minutes hours days months years
)))
604 ;; isodatetimestring == nil
607 (defun icalendar--add-decoded-times (time1 time2
)
609 Both times must be given in decoded form. One of these times must be
610 valid (year > 1900 or something)."
611 ;; FIXME: does this function exist already?
612 (decode-time (encode-time
613 (+ (nth 0 time1
) (nth 0 time2
))
614 (+ (nth 1 time1
) (nth 1 time2
))
615 (+ (nth 2 time1
) (nth 2 time2
))
616 (+ (nth 3 time1
) (nth 3 time2
))
617 (+ (nth 4 time1
) (nth 4 time2
))
618 (+ (nth 5 time1
) (nth 5 time2
))
621 ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
624 (defun icalendar--datetime-to-american-date (datetime &optional separator
)
625 "Convert the decoded DATETIME to American-style format.
626 Optional argument SEPARATOR gives the separator between month,
627 day, and year. If nil a blank character is used as separator.
628 American format: \"month day year\"."
630 (format "%d%s%d%s%d" (nth 4 datetime
) ;month
632 (nth 3 datetime
) ;day
634 (nth 5 datetime
)) ;year
638 (define-obsolete-function-alias 'icalendar--datetime-to-noneuropean-date
639 'icalendar--datetime-to-american-date
"icalendar 0.19")
641 (defun icalendar--datetime-to-european-date (datetime &optional separator
)
642 "Convert the decoded DATETIME to European format.
643 Optional argument SEPARATOR gives the separator between month,
644 day, and year. If nil a blank character is used as separator.
645 European format: (day month year).
648 (format "%d%s%d%s%d" (nth 3 datetime
) ;day
650 (nth 4 datetime
) ;month
652 (nth 5 datetime
)) ;year
656 (defun icalendar--datetime-to-iso-date (datetime &optional separator
)
657 "Convert the decoded DATETIME to ISO format.
658 Optional argument SEPARATOR gives the separator between month,
659 day, and year. If nil a blank character is used as separator.
660 ISO format: (year month day)."
662 (format "%d%s%d%s%d" (nth 5 datetime
) ;year
664 (nth 4 datetime
) ;month
666 (nth 3 datetime
)) ;day
670 (defun icalendar--date-style ()
671 "Return current calendar date style.
672 Convenience function to handle transition from old
673 `european-calendar-style' to new `calendar-date-style'."
674 (if (boundp 'calendar-date-style
)
676 (if (with-no-warnings european-calendar-style
)
680 (defun icalendar--datetime-to-diary-date (datetime &optional separator
)
681 "Convert the decoded DATETIME to diary format.
682 Optional argument SEPARATOR gives the separator between month,
683 day, and year. If nil a blank character is used as separator.
684 Call icalendar--datetime-to-*-date according to the current
685 calendar date style."
686 (funcall (intern-soft (format "icalendar--datetime-to-%s-date"
687 (icalendar--date-style)))
690 (defun icalendar--datetime-to-colontime (datetime)
691 "Extract the time part of a decoded DATETIME into 24-hour format.
692 Note that this silently ignores seconds."
693 (format "%02d:%02d" (nth 2 datetime
) (nth 1 datetime
)))
695 (defun icalendar--get-month-number (monthname)
696 "Return the month number for the given MONTHNAME."
699 (m (downcase monthname
)))
700 (mapc (lambda (month)
701 (let ((mm (downcase month
)))
702 (if (or (string-equal mm m
)
703 (string-equal (substring mm
0 3) m
))
705 (setq num
(1+ num
))))
706 calendar-month-name-array
))
710 (defun icalendar--get-weekday-number (abbrevweekday)
711 "Return the number for the ABBREVWEEKDAY."
715 (aw (downcase abbrevweekday
)))
717 (let ((d (downcase day
)))
718 (if (string-equal d aw
)
720 (setq num
(1+ num
))))
721 icalendar--weekday-array
)))
725 (defun icalendar--get-weekday-abbrev (weekday)
726 "Return the abbreviated WEEKDAY."
729 (w (downcase weekday
)))
731 (let ((d (downcase day
)))
732 (if (or (string-equal d w
)
733 (string-equal (substring d
0 3) w
))
734 (throw 'found
(aref icalendar--weekday-array num
)))
735 (setq num
(1+ num
))))
736 calendar-day-name-array
))
740 (defun icalendar--date-to-isodate (date &optional day-shift
)
741 "Convert DATE to iso-style date.
742 DATE must be a list of the form (month day year).
743 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
744 (let ((mdy (calendar-gregorian-from-absolute
745 (+ (calendar-absolute-from-gregorian date
)
747 (format "%04d%02d%02d" (nth 2 mdy
) (nth 0 mdy
) (nth 1 mdy
))))
750 (defun icalendar--datestring-to-isodate (datestring &optional day-shift
)
751 "Convert diary-style DATESTRING to iso-style date.
752 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
753 -- DAY-SHIFT must be either nil or an integer. This function
754 tries to figure the date style from DATESTRING itself. If that
755 is not possible it uses the current calendar date style."
756 (let ((day -
1) month year
)
758 (cond ( ;; iso-style numeric date
759 (string-match (concat "\\s-*"
760 "\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
761 "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
762 "0?\\([1-9][0-9]?\\)")
764 (setq year
(read (substring datestring
(match-beginning 1)
766 (setq month
(read (substring datestring
(match-beginning 2)
768 (setq day
(read (substring datestring
(match-beginning 3)
770 ( ;; non-iso numeric date -- must rely on configured
772 (string-match (concat "\\s-*"
773 "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
774 "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
775 "\\([0-9]\\{4\\}\\)")
777 (setq day
(read (substring datestring
(match-beginning 1)
779 (setq month
(read (substring datestring
(match-beginning 2)
781 (setq year
(read (substring datestring
(match-beginning 3)
783 (if (eq (icalendar--date-style) 'american
)
787 ( ;; date contains month names -- iso style
788 (string-match (concat "\\s-*"
789 "\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
790 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
791 "0?\\([123]?[0-9]\\)")
793 (setq year
(read (substring datestring
(match-beginning 1)
795 (setq month
(icalendar--get-month-number
796 (substring datestring
(match-beginning 2)
798 (setq day
(read (substring datestring
(match-beginning 3)
800 ( ;; date contains month names -- european style
801 (string-match (concat "\\s-*"
802 "0?\\([123]?[0-9]\\)[ \t/]\\s-*"
803 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
804 "\\([0-9]\\{4\\}\\)")
806 (setq day
(read (substring datestring
(match-beginning 1)
808 (setq month
(icalendar--get-month-number
809 (substring datestring
(match-beginning 2)
811 (setq year
(read (substring datestring
(match-beginning 3)
813 ( ;; date contains month names -- american style
814 (string-match (concat "\\s-*"
815 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
816 "0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
817 "\\([0-9]\\{4\\}\\)")
819 (setq day
(read (substring datestring
(match-beginning 2)
821 (setq month
(icalendar--get-month-number
822 (substring datestring
(match-beginning 1)
824 (setq year
(read (substring datestring
(match-beginning 3)
829 (let ((mdy (calendar-gregorian-from-absolute
830 (+ (calendar-absolute-from-gregorian (list month day
833 (icalendar--dmsg (format "%04d%02d%02d" (nth 2 mdy
) (nth 0 mdy
) (nth 1 mdy
)))
834 (format "%04d%02d%02d" (nth 2 mdy
) (nth 0 mdy
) (nth 1 mdy
)))
837 (defun icalendar--diarytime-to-isotime (timestring ampmstring
)
838 "Convert a time like 9:30pm to an iso-conform string like T213000.
839 In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING
842 (let ((starttimenum (read (icalendar--rris ":" "" timestring
))))
843 ;; take care of am/pm style
844 ;; Be sure *not* to convert 12:00pm - 12:59pm to 2400-2459
845 (if (and ampmstring
(string= "pm" ampmstring
) (< starttimenum
1200))
846 (setq starttimenum
(+ starttimenum
1200)))
847 (format "T%04d00" starttimenum
))
850 (defun icalendar--convert-string-for-export (string)
851 "Escape comma and other critical characters in STRING."
852 (icalendar--rris "," "\\\\," string
))
854 (defun icalendar--convert-string-for-import (string)
855 "Remove escape chars for comma, semicolon etc. from STRING."
857 "\\\\n" "\n " (icalendar--rris
858 "\\\\\"" "\"" (icalendar--rris
859 "\\\\;" ";" (icalendar--rris
860 "\\\\," "," string
)))))
862 ;; ======================================================================
863 ;; Export -- convert emacs-diary to icalendar
864 ;; ======================================================================
867 (defun icalendar-export-file (diary-filename ical-filename
)
868 "Export diary file to iCalendar format.
869 All diary entries in the file DIARY-FILENAME are converted to iCalendar
870 format. The result is appended to the file ICAL-FILENAME."
871 (interactive "FExport diary data from file:
872 Finto iCalendar file: ")
874 (set-buffer (find-file diary-filename
))
875 (icalendar-export-region (point-min) (point-max) ical-filename
)))
877 (defalias 'icalendar-convert-diary-to-ical
'icalendar-export-file
)
878 (make-obsolete 'icalendar-convert-diary-to-ical
'icalendar-export-file
)
880 (defvar icalendar--uid-count
0
881 "Auxiliary counter for creating unique ids.")
883 (defun icalendar--create-uid ()
884 "Create a unique identifier.
885 Use `current-time' and a counter to create unique ids. The
886 counter is necessary for systems which do not provide resolution
887 finer than a second."
888 (setq icalendar--uid-count
(1+ icalendar--uid-count
))
889 (format "emacs%d%d%d%d"
891 (cadr (current-time))
892 (car (cddr (current-time)))
893 icalendar--uid-count
))
896 (defun icalendar-export-region (min max ical-filename
)
897 "Export region in diary file to iCalendar format.
898 All diary entries in the region from MIN to MAX in the current buffer are
899 converted to iCalendar format. The result is appended to the file
901 This function attempts to return t if something goes wrong. In this
902 case an error string which describes all the errors and problems is
903 written into the buffer `*icalendar-errors*'."
905 FExport diary data into iCalendar file: ")
914 (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol
)
916 (other-elements nil
))
917 ;; prepare buffer with error messages
919 (set-buffer (get-buffer-create "*icalendar-errors*"))
925 (while (re-search-forward
926 ;; possibly ignore hidden entries beginning with "&"
927 (if icalendar-export-hidden-diary-entries
928 "^\\([^ \t\n#].+\\)\\(\\(\n[ \t].*\\)*\\)"
929 "^\\([^ \t\n&#].+\\)\\(\\(\n[ \t].*\\)*\\)") max t
)
930 (setq entry-main
(match-string 1))
931 (if (match-beginning 2)
932 (setq entry-rest
(match-string 2))
933 (setq entry-rest
""))
934 (setq header
(format "\nBEGIN:VEVENT\nUID:%s"
935 (icalendar--create-uid)))
936 (condition-case error-val
938 (setq contents-n-summary
939 (icalendar--convert-to-ical nonmarker entry-main
))
940 (setq other-elements
(icalendar--parse-summary-and-rest
941 (concat entry-main entry-rest
)))
942 (setq contents
(concat (car contents-n-summary
)
943 "\nSUMMARY:" (cadr contents-n-summary
)))
944 (let ((cla (cdr (assoc 'cla other-elements
)))
945 (des (cdr (assoc 'des other-elements
)))
946 (loc (cdr (assoc 'loc other-elements
)))
947 (org (cdr (assoc 'org other-elements
)))
948 (sta (cdr (assoc 'sta other-elements
)))
949 (sum (cdr (assoc 'sum other-elements
)))
950 (url (cdr (assoc 'url other-elements
))))
952 (setq contents
(concat contents
"\nCLASS:" cla
)))
954 (setq contents
(concat contents
"\nDESCRIPTION:" des
)))
956 (setq contents
(concat contents
"\nLOCATION:" loc
)))
958 (setq contents
(concat contents
"\nORGANIZER:" org
)))
960 (setq contents
(concat contents
"\nSTATUS:" sta
)))
962 ;; (setq contents (concat contents "\nSUMMARY:" sum)))
964 (setq contents
(concat contents
"\nURL:" url
))))
965 (setq result
(concat result header contents
"\nEND:VEVENT")))
970 (set-buffer (get-buffer-create "*icalendar-errors*"))
971 (insert (format "Error in line %d -- %s: `%s'\n"
972 (count-lines (point-min) (point))
976 ;; we're done, insert everything into the file
978 (let ((coding-system-for-write 'utf-8
))
979 (set-buffer (find-file ical-filename
))
980 (goto-char (point-max))
981 (insert "BEGIN:VCALENDAR")
982 (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
983 (insert "\nVERSION:2.0")
985 (insert "\nEND:VCALENDAR\n")
986 ;; save the diary file
992 (defun icalendar--convert-to-ical (nonmarker entry-main
)
993 "Convert a diary entry to icalendar format.
994 NONMARKER is a regular expression matching the start of non-marking
995 entries. ENTRY-MAIN is the first line of the diary entry."
997 ;; anniversaries -- %%(diary-anniversary ...)
998 (icalendar--convert-anniversary-to-ical nonmarker entry-main
)
999 ;; cyclic events -- %%(diary-cyclic ...)
1000 (icalendar--convert-cyclic-to-ical nonmarker entry-main
)
1001 ;; diary-date -- %%(diary-date ...)
1002 (icalendar--convert-date-to-ical nonmarker entry-main
)
1003 ;; float events -- %%(diary-float ...)
1004 (icalendar--convert-float-to-ical nonmarker entry-main
)
1005 ;; block events -- %%(diary-block ...)
1006 (icalendar--convert-block-to-ical nonmarker entry-main
)
1007 ;; other sexp diary entries
1008 (icalendar--convert-sexp-to-ical nonmarker entry-main
)
1009 ;; weekly by day -- Monday 8:30 Team meeting
1010 (icalendar--convert-weekly-to-ical nonmarker entry-main
)
1011 ;; yearly by day -- 1 May Tag der Arbeit
1012 (icalendar--convert-yearly-to-ical nonmarker entry-main
)
1013 ;; "ordinary" events, start and end time given
1015 (icalendar--convert-ordinary-to-ical nonmarker entry-main
)
1017 ;; Oops! what's that?
1018 (error "Could not parse entry")))
1020 (defun icalendar--parse-summary-and-rest (summary-and-rest)
1021 "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties.
1024 (if (functionp icalendar-import-format
)
1025 ;; can't do anything
1027 ;; split summary-and-rest
1028 (let* ((s icalendar-import-format
)
1029 (p-cla (or (string-match "%c" icalendar-import-format
) -
1))
1030 (p-des (or (string-match "%d" icalendar-import-format
) -
1))
1031 (p-loc (or (string-match "%l" icalendar-import-format
) -
1))
1032 (p-org (or (string-match "%o" icalendar-import-format
) -
1))
1033 (p-sum (or (string-match "%s" icalendar-import-format
) -
1))
1034 (p-sta (or (string-match "%t" icalendar-import-format
) -
1))
1035 (p-url (or (string-match "%u" icalendar-import-format
) -
1))
1036 (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url
) '<))
1037 pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url
)
1038 (dotimes (i (length p-list
))
1039 (cond ((and (>= p-cla
0) (= (nth i p-list
) p-cla
))
1040 (setq pos-cla
(+ 2 (* 2 i
))))
1041 ((and (>= p-des
0) (= (nth i p-list
) p-des
))
1042 (setq pos-des
(+ 2 (* 2 i
))))
1043 ((and (>= p-loc
0) (= (nth i p-list
) p-loc
))
1044 (setq pos-loc
(+ 2 (* 2 i
))))
1045 ((and (>= p-org
0) (= (nth i p-list
) p-org
))
1046 (setq pos-org
(+ 2 (* 2 i
))))
1047 ((and (>= p-sta
0) (= (nth i p-list
) p-sta
))
1048 (setq pos-sta
(+ 2 (* 2 i
))))
1049 ((and (>= p-sum
0) (= (nth i p-list
) p-sum
))
1050 (setq pos-sum
(+ 2 (* 2 i
))))
1051 ((and (>= p-url
0) (= (nth i p-list
) p-url
))
1052 (setq pos-url
(+ 2 (* 2 i
))))))
1054 (setq s
(icalendar--rris (car ij
) (cadr ij
) s t t
)))
1056 ;; summary must be first! because of %s
1058 (concat "\\(" icalendar-import-format-summary
"\\)??"))
1060 (concat "\\(" icalendar-import-format-class
"\\)??"))
1062 (concat "\\(" icalendar-import-format-description
"\\)??"))
1064 (concat "\\(" icalendar-import-format-location
"\\)??"))
1066 (concat "\\(" icalendar-import-format-organizer
"\\)??"))
1068 (concat "\\(" icalendar-import-format-status
"\\)??"))
1070 (concat "\\(" icalendar-import-format-url
"\\)??"))))
1071 (setq s
(concat "^" (icalendar--rris "%s" "\\(.*?\\)" s nil t
)
1073 (if (string-match s summary-and-rest
)
1074 (let (cla des loc org sta sum url
)
1075 (if (and pos-sum
(match-beginning pos-sum
))
1076 (setq sum
(substring summary-and-rest
1077 (match-beginning pos-sum
)
1078 (match-end pos-sum
))))
1079 (if (and pos-cla
(match-beginning pos-cla
))
1080 (setq cla
(substring summary-and-rest
1081 (match-beginning pos-cla
)
1082 (match-end pos-cla
))))
1083 (if (and pos-des
(match-beginning pos-des
))
1084 (setq des
(substring summary-and-rest
1085 (match-beginning pos-des
)
1086 (match-end pos-des
))))
1087 (if (and pos-loc
(match-beginning pos-loc
))
1088 (setq loc
(substring summary-and-rest
1089 (match-beginning pos-loc
)
1090 (match-end pos-loc
))))
1091 (if (and pos-org
(match-beginning pos-org
))
1092 (setq org
(substring summary-and-rest
1093 (match-beginning pos-org
)
1094 (match-end pos-org
))))
1095 (if (and pos-sta
(match-beginning pos-sta
))
1096 (setq sta
(substring summary-and-rest
1097 (match-beginning pos-sta
)
1098 (match-end pos-sta
))))
1099 (if (and pos-url
(match-beginning pos-url
))
1100 (setq url
(substring summary-and-rest
1101 (match-beginning pos-url
)
1102 (match-end pos-url
))))
1103 (list (if cla
(cons 'cla cla
) nil
)
1104 (if des
(cons 'des des
) nil
)
1105 (if loc
(cons 'loc loc
) nil
)
1106 (if org
(cons 'org org
) nil
)
1107 (if sta
(cons 'sta sta
) nil
)
1108 ;;(if sum (cons 'sum sum) nil)
1109 (if url
(cons 'url url
) nil
))))))))
1111 ;; subroutines for icalendar-export-region
1112 (defun icalendar--convert-ordinary-to-ical (nonmarker entry-main
)
1113 "Convert \"ordinary\" diary entry to icalendar format.
1114 NONMARKER is a regular expression matching the start of non-marking
1115 entries. ENTRY-MAIN is the first line of the diary entry."
1118 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*" ; date
1119 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" ; start time
1121 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" ; end time
1123 "\\s-*\\(.*?\\) ?$")
1125 (let* ((datetime (substring entry-main
(match-beginning 1)
1127 (startisostring (icalendar--datestring-to-isodate
1129 (endisostring (icalendar--datestring-to-isodate
1132 (starttimestring (icalendar--diarytime-to-isotime
1133 (if (match-beginning 3)
1134 (substring entry-main
1138 (if (match-beginning 4)
1139 (substring entry-main
1143 (endtimestring (icalendar--diarytime-to-isotime
1144 (if (match-beginning 6)
1145 (substring entry-main
1149 (if (match-beginning 7)
1150 (substring entry-main
1154 (summary (icalendar--convert-string-for-export
1155 (substring entry-main
(match-beginning 8)
1157 (icalendar--dmsg "ordinary %s" entry-main
)
1159 (unless startisostring
1160 (error "Could not parse date"))
1162 ;; If only start-date is specified, then end-date is next day,
1163 ;; otherwise it is same day.
1164 (setq endisostring1
(if starttimestring
1168 (when starttimestring
1169 (unless endtimestring
1171 (read (icalendar--rris "^T0?" ""
1174 ;; Case: ends on same day
1175 (setq endtimestring
(format "T%06d"
1177 ;; Case: ends on next day
1178 (setq endtimestring
(format "T%06d"
1180 (setq endisostring1 endisostring
)) )))
1182 (list (concat "\nDTSTART;"
1183 (if starttimestring
"VALUE=DATE-TIME:"
1186 (or starttimestring
"")
1188 (if endtimestring
"VALUE=DATE-TIME:"
1191 (or endtimestring
""))
1196 (defun icalendar-first-weekday-of-year (abbrevweekday year
)
1197 "Find the first ABBREVWEEKDAY in a given YEAR.
1198 Returns day number."
1199 (let* ((day-of-week-jan01 (calendar-day-of-week (list 1 1 year
)))
1201 (- (icalendar--get-weekday-number abbrevweekday
)
1202 day-of-week-jan01
))))
1203 (cond ((<= result
0)
1204 (setq result
(+ result
7)))
1206 (setq result
(- result
7))))
1209 (defun icalendar--convert-weekly-to-ical (nonmarker entry-main
)
1210 "Convert weekly diary entry to icalendar format.
1211 NONMARKER is a regular expression matching the start of non-marking
1212 entries. ENTRY-MAIN is the first line of the diary entry."
1213 (if (and (string-match (concat nonmarker
1215 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)"
1218 "\\([1-9][0-9]?:[0-9][0-9]\\)"
1221 "\\s-*\\(.*?\\) ?$")
1223 (icalendar--get-weekday-abbrev
1224 (substring entry-main
(match-beginning 1)
1226 (let* ((day (icalendar--get-weekday-abbrev
1227 (substring entry-main
(match-beginning 1)
1229 (starttimestring (icalendar--diarytime-to-isotime
1230 (if (match-beginning 3)
1231 (substring entry-main
1235 (if (match-beginning 4)
1236 (substring entry-main
1240 (endtimestring (icalendar--diarytime-to-isotime
1241 (if (match-beginning 6)
1242 (substring entry-main
1246 (if (match-beginning 7)
1247 (substring entry-main
1251 (summary (icalendar--convert-string-for-export
1252 (substring entry-main
(match-beginning 8)
1254 (icalendar--dmsg "weekly %s" entry-main
)
1256 (when starttimestring
1257 (unless endtimestring
1259 (icalendar--rris "^T0?" ""
1261 (setq endtimestring
(format "T%06d"
1263 (list (concat "\nDTSTART;"
1267 ;; Find the first requested weekday of the
1269 (funcall 'format
"%04d%02d%02d"
1270 icalendar-recurring-start-year
1
1271 (icalendar-first-weekday-of-year
1272 day icalendar-recurring-start-year
))
1273 (or starttimestring
"")
1278 (funcall 'format
"%04d%02d%02d"
1279 ;; end is non-inclusive!
1280 icalendar-recurring-start-year
1
1281 (+ (icalendar-first-weekday-of-year
1282 day icalendar-recurring-start-year
)
1283 (if endtimestring
0 1)))
1284 (or endtimestring
"")
1285 "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY="
1291 (defun icalendar--convert-yearly-to-ical (nonmarker entry-main
)
1292 "Convert yearly diary entry to icalendar format.
1293 NONMARKER is a regular expression matching the start of non-marking
1294 entries. ENTRY-MAIN is the first line of the diary entry."
1295 (if (string-match (concat nonmarker
1296 (if (eq (icalendar--date-style) 'european
)
1297 "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
1298 "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+")
1300 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1302 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1304 "\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years
1307 (let* ((daypos (if (eq (icalendar--date-style) 'european
) 1 2))
1308 (monpos (if (eq (icalendar--date-style) 'european
) 2 1))
1309 (day (read (substring entry-main
1310 (match-beginning daypos
)
1311 (match-end daypos
))))
1312 (month (icalendar--get-month-number
1313 (substring entry-main
1314 (match-beginning monpos
)
1315 (match-end monpos
))))
1316 (starttimestring (icalendar--diarytime-to-isotime
1317 (if (match-beginning 4)
1318 (substring entry-main
1322 (if (match-beginning 5)
1323 (substring entry-main
1327 (endtimestring (icalendar--diarytime-to-isotime
1328 (if (match-beginning 7)
1329 (substring entry-main
1333 (if (match-beginning 8)
1334 (substring entry-main
1338 (summary (icalendar--convert-string-for-export
1339 (substring entry-main
(match-beginning 9)
1341 (icalendar--dmsg "yearly %s" entry-main
)
1343 (when starttimestring
1344 (unless endtimestring
1346 (icalendar--rris "^T0?" ""
1348 (setq endtimestring
(format "T%06d"
1350 (list (concat "\nDTSTART;"
1351 (if starttimestring
"VALUE=DATE-TIME:"
1353 (format "1900%02d%02d" month day
)
1354 (or starttimestring
"")
1356 (if endtimestring
"VALUE=DATE-TIME:"
1358 ;; end is not included! shift by one day
1359 (icalendar--date-to-isodate
1360 (list month day
1900)
1361 (if endtimestring
0 1))
1362 (or endtimestring
"")
1363 "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
1371 (defun icalendar--convert-sexp-to-ical (nonmarker entry-main
)
1372 "Convert complex sexp diary entry to icalendar format -- unsupported!
1376 NONMARKER is a regular expression matching the start of non-marking
1377 entries. ENTRY-MAIN is the first line of the diary entry."
1378 (cond ((string-match (concat nonmarker
1379 "%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$")
1381 ;; simple sexp entry as generated by icalendar.el: strip off the
1382 ;; unnecessary (and)
1383 (icalendar--dmsg "diary-sexp from icalendar.el %s" entry-main
)
1384 (icalendar--convert-to-ical
1387 (substring entry-main
(match-beginning 1) (match-end 1))
1388 (substring entry-main
(match-beginning 2) (match-end 2)))))
1389 ((string-match (concat nonmarker
1392 (icalendar--dmsg "diary-sexp %s" entry-main
)
1393 (error "Sexp-entries are not supported yet"))
1398 (defun icalendar--convert-block-to-ical (nonmarker entry-main
)
1399 "Convert block diary entry to icalendar format.
1400 NONMARKER is a regular expression matching the start of non-marking
1401 entries. ENTRY-MAIN is the first line of the diary entry."
1402 (if (string-match (concat nonmarker
1403 "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)"
1404 " +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1405 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1407 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1409 "\\s-*\\(.*?\\) ?$")
1411 (let* ((startstring (substring entry-main
1414 (endstring (substring entry-main
1417 (startisostring (icalendar--datestring-to-isodate
1419 (endisostring (icalendar--datestring-to-isodate
1421 (endisostring+1 (icalendar--datestring-to-isodate
1423 (starttimestring (icalendar--diarytime-to-isotime
1424 (if (match-beginning 4)
1425 (substring entry-main
1429 (if (match-beginning 5)
1430 (substring entry-main
1434 (endtimestring (icalendar--diarytime-to-isotime
1435 (if (match-beginning 7)
1436 (substring entry-main
1440 (if (match-beginning 8)
1441 (substring entry-main
1445 (summary (icalendar--convert-string-for-export
1446 (substring entry-main
(match-beginning 9)
1448 (icalendar--dmsg "diary-block %s" entry-main
)
1449 (when starttimestring
1450 (unless endtimestring
1452 (read (icalendar--rris "^T0?" ""
1454 (setq endtimestring
(format "T%06d"
1457 ;; with time -> write rrule
1458 (list (concat "\nDTSTART;VALUE=DATE-TIME:"
1461 "\nDTEND;VALUE=DATE-TIME:"
1464 "\nRRULE:FREQ=DAILY;INTERVAL=1;UNTIL="
1467 ;; no time -> write long event
1468 (list (concat "\nDTSTART;VALUE=DATE:" startisostring
1469 "\nDTEND;VALUE=DATE:" endisostring
+1)
1474 (defun icalendar--convert-float-to-ical (nonmarker entry-main
)
1475 "Convert float diary entry to icalendar format -- unsupported!
1479 NONMARKER is a regular expression matching the start of non-marking
1480 entries. ENTRY-MAIN is the first line of the diary entry."
1481 (if (string-match (concat nonmarker
1482 "%%(diary-float \\([^)]+\\))\\s-*\\(.*?\\) ?$")
1485 (icalendar--dmsg "diary-float %s" entry-main
)
1486 (error "`diary-float' is not supported yet"))
1490 (defun icalendar--convert-date-to-ical (nonmarker entry-main
)
1491 "Convert `diary-date' diary entry to icalendar format -- unsupported!
1495 NONMARKER is a regular expression matching the start of non-marking
1496 entries. ENTRY-MAIN is the first line of the diary entry."
1497 (if (string-match (concat nonmarker
1498 "%%(diary-date \\([^)]+\\))\\s-*\\(.*?\\) ?$")
1501 (icalendar--dmsg "diary-date %s" entry-main
)
1502 (error "`diary-date' is not supported yet"))
1506 (defun icalendar--convert-cyclic-to-ical (nonmarker entry-main
)
1507 "Convert `diary-cyclic' diary entry to icalendar format.
1508 NONMARKER is a regular expression matching the start of non-marking
1509 entries. ENTRY-MAIN is the first line of the diary entry."
1510 (if (string-match (concat nonmarker
1511 "%%(diary-cyclic \\([^ ]+\\) +"
1512 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1513 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1515 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1517 "\\s-*\\(.*?\\) ?$")
1519 (let* ((frequency (substring entry-main
(match-beginning 1)
1521 (datetime (substring entry-main
(match-beginning 2)
1523 (startisostring (icalendar--datestring-to-isodate
1525 (endisostring (icalendar--datestring-to-isodate
1527 (endisostring+1 (icalendar--datestring-to-isodate
1529 (starttimestring (icalendar--diarytime-to-isotime
1530 (if (match-beginning 4)
1531 (substring entry-main
1535 (if (match-beginning 5)
1536 (substring entry-main
1540 (endtimestring (icalendar--diarytime-to-isotime
1541 (if (match-beginning 7)
1542 (substring entry-main
1546 (if (match-beginning 8)
1547 (substring entry-main
1551 (summary (icalendar--convert-string-for-export
1552 (substring entry-main
(match-beginning 9)
1554 (icalendar--dmsg "diary-cyclic %s" entry-main
)
1555 (when starttimestring
1556 (unless endtimestring
1558 (read (icalendar--rris "^T0?" ""
1560 (setq endtimestring
(format "T%06d"
1562 (list (concat "\nDTSTART;"
1563 (if starttimestring
"VALUE=DATE-TIME:"
1566 (or starttimestring
"")
1568 (if endtimestring
"VALUE=DATE-TIME:"
1570 (if endtimestring endisostring endisostring
+1)
1571 (or endtimestring
"")
1572 "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
1573 ;; strange: korganizer does not expect
1574 ;; BYSOMETHING here...
1580 (defun icalendar--convert-anniversary-to-ical (nonmarker entry-main
)
1581 "Convert `diary-anniversary' diary entry to icalendar format.
1582 NONMARKER is a regular expression matching the start of non-marking
1583 entries. ENTRY-MAIN is the first line of the diary entry."
1584 (if (string-match (concat nonmarker
1585 "%%(diary-anniversary \\([^)]+\\))\\s-*"
1586 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1588 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1590 "\\s-*\\(.*?\\) ?$")
1592 (let* ((datetime (substring entry-main
(match-beginning 1)
1594 (startisostring (icalendar--datestring-to-isodate
1596 (endisostring (icalendar--datestring-to-isodate
1598 (starttimestring (icalendar--diarytime-to-isotime
1599 (if (match-beginning 3)
1600 (substring entry-main
1604 (if (match-beginning 4)
1605 (substring entry-main
1609 (endtimestring (icalendar--diarytime-to-isotime
1610 (if (match-beginning 6)
1611 (substring entry-main
1615 (if (match-beginning 7)
1616 (substring entry-main
1620 (summary (icalendar--convert-string-for-export
1621 (substring entry-main
(match-beginning 8)
1623 (icalendar--dmsg "diary-anniversary %s" entry-main
)
1624 (when starttimestring
1625 (unless endtimestring
1627 (read (icalendar--rris "^T0?" ""
1629 (setq endtimestring
(format "T%06d"
1631 (list (concat "\nDTSTART;"
1632 (if starttimestring
"VALUE=DATE-TIME:"
1635 (or starttimestring
"")
1637 (if endtimestring
"VALUE=DATE-TIME:"
1640 (or endtimestring
"")
1641 "\nRRULE:FREQ=YEARLY;INTERVAL=1"
1642 ;; the following is redundant,
1643 ;; but korganizer seems to expect this... ;(
1644 ;; and evolution doesn't understand it... :(
1645 ;; so... who is wrong?!
1647 (substring startisostring
4 6)
1649 (substring startisostring
6 8))
1654 ;; ======================================================================
1655 ;; Import -- convert icalendar to emacs-diary
1656 ;; ======================================================================
1659 (defun icalendar-import-file (ical-filename diary-filename
1660 &optional non-marking
)
1661 "Import an iCalendar file and append to a diary file.
1662 Argument ICAL-FILENAME output iCalendar file.
1663 Argument DIARY-FILENAME input `diary-file'.
1664 Optional argument NON-MARKING determines whether events are created as
1665 non-marking or not."
1666 (interactive "fImport iCalendar data from file:
1669 ;; clean up the diary file
1670 (save-current-buffer
1671 ;; now load and convert from the ical file
1672 (set-buffer (find-file ical-filename
))
1673 (icalendar-import-buffer diary-filename t non-marking
)))
1676 (defun icalendar-import-buffer (&optional diary-file do-not-ask
1678 "Extract iCalendar events from current buffer.
1680 This function searches the current buffer for the first iCalendar
1681 object, reads it and adds all VEVENT elements to the diary
1684 It will ask for each appointment whether to add it to the diary
1685 unless DO-NOT-ASK is non-nil. When called interactively,
1686 DO-NOT-ASK is nil, so that you are asked for each event.
1688 NON-MARKING determines whether diary events are created as
1691 Return code t means that importing worked well, return code nil
1692 means that an error has occurred. Error messages will be in the
1693 buffer `*icalendar-errors*'."
1695 (save-current-buffer
1697 (message "Preparing icalendar...")
1698 (set-buffer (icalendar--get-unfolded-buffer (current-buffer)))
1699 (goto-char (point-min))
1700 (message "Preparing icalendar...done")
1701 (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t
)
1702 (let (ical-contents ical-errors
)
1704 (message "Reading icalendar...")
1706 (setq ical-contents
(icalendar--read-element nil nil
))
1707 (message "Reading icalendar...done")
1709 (message "Converting icalendar...")
1710 (setq ical-errors
(icalendar--convert-ical-to-diary
1712 diary-file do-not-ask non-marking
))
1714 ;; save the diary file if it is visited already
1715 (let ((b (find-buffer-visiting diary-file
)))
1717 (save-current-buffer
1720 (message "Converting icalendar...done")
1721 ;; return t if no error occurred
1724 "Current buffer does not contain icalendar contents!")
1725 ;; return nil, i.e. import did not work
1728 (defalias 'icalendar-extract-ical-from-buffer
'icalendar-import-buffer
)
1729 (make-obsolete 'icalendar-extract-ical-from-buffer
'icalendar-import-buffer
)
1731 (defun icalendar--format-ical-event (event)
1732 "Create a string representation of an iCalendar EVENT."
1733 (if (functionp icalendar-import-format
)
1734 (funcall icalendar-import-format event
)
1735 (let ((string icalendar-import-format
)
1737 '(("%c" CLASS icalendar-import-format-class
)
1738 ("%d" DESCRIPTION icalendar-import-format-description
)
1739 ("%l" LOCATION icalendar-import-format-location
)
1740 ("%o" ORGANIZER icalendar-import-format-organizer
)
1741 ("%s" SUMMARY icalendar-import-format-summary
)
1742 ("%t" STATUS icalendar-import-format-status
)
1743 ("%u" URL icalendar-import-format-url
))))
1744 ;; convert the specifiers in the format string
1746 (let* ((spec (car i
))
1748 (format (car (cddr i
)))
1749 (contents (icalendar--get-event-property event prop
))
1750 (formatted-contents ""))
1751 (when (and contents
(> (length contents
) 0))
1752 (setq formatted-contents
1753 (icalendar--rris "%s"
1754 (icalendar--convert-string-for-import
1756 (symbol-value format
)
1758 (setq string
(icalendar--rris spec
1765 (defun icalendar--convert-ical-to-diary (ical-list diary-file
1766 &optional do-not-ask
1768 "Convert iCalendar data to an Emacs diary file.
1769 Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
1770 DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event
1771 whether to actually import it. NON-MARKING determines whether diary
1772 events are created as non-marking.
1773 This function attempts to return t if something goes wrong. In this
1774 case an error string which describes all the errors and problems is
1775 written into the buffer `*icalendar-errors*'."
1776 (let* ((ev (icalendar--all-events ical-list
))
1780 (zone-map (icalendar--convert-all-timezones ical-list
))
1782 ;; step through all events/appointments
1787 (condition-case error-val
1788 (let* ((dtstart (icalendar--get-event-property e
'DTSTART
))
1789 (dtstart-zone (icalendar--find-time-zone
1790 (icalendar--get-event-property-attributes
1793 (dtstart-dec (icalendar--decode-isodatetime dtstart nil
1795 (start-d (icalendar--datetime-to-diary-date
1797 (start-t (icalendar--datetime-to-colontime dtstart-dec
))
1798 (dtend (icalendar--get-event-property e
'DTEND
))
1799 (dtend-zone (icalendar--find-time-zone
1800 (icalendar--get-event-property-attributes
1803 (dtend-dec (icalendar--decode-isodatetime dtend
1805 (dtend-1-dec (icalendar--decode-isodatetime dtend -
1
1810 (summary (icalendar--convert-string-for-import
1811 (or (icalendar--get-event-property e
'SUMMARY
)
1813 (rrule (icalendar--get-event-property e
'RRULE
))
1814 (rdate (icalendar--get-event-property e
'RDATE
))
1815 (duration (icalendar--get-event-property e
'DURATION
)))
1816 (icalendar--dmsg "%s: `%s'" start-d summary
)
1817 ;; check whether start-time is missing
1820 (cadr (icalendar--get-event-property-attributes
1825 (let ((dtend-dec-d (icalendar--add-decoded-times
1827 (icalendar--decode-isoduration duration
)))
1828 (dtend-1-dec-d (icalendar--add-decoded-times
1830 (icalendar--decode-isoduration duration
1832 (if (and dtend-dec
(not (eq dtend-dec dtend-dec-d
)))
1833 (message "Inconsistent endtime and duration for %s"
1835 (setq dtend-dec dtend-dec-d
)
1836 (setq dtend-1-dec dtend-1-dec-d
)))
1837 (setq end-d
(if dtend-dec
1838 (icalendar--datetime-to-diary-date dtend-dec
)
1840 (setq end-1-d
(if dtend-1-dec
1841 (icalendar--datetime-to-diary-date dtend-1-dec
)
1843 (setq end-t
(if (and
1847 (icalendar--get-event-property-attributes
1850 (icalendar--datetime-to-colontime dtend-dec
)
1852 (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d
)
1857 (icalendar--convert-recurring-to-diary e dtstart-dec start-t
1861 (icalendar--dmsg "rdate event")
1862 (setq diary-string
"")
1863 (mapc (lambda (datestring)
1865 (concat diary-string
1866 (format "......"))))
1867 (icalendar--split-value rdate
)))
1868 ;; non-recurring event
1870 ((not (string= start-d end-d
))
1872 (icalendar--convert-non-recurring-all-day-to-diary
1876 ((and start-t
(or (not end-t
)
1877 (not (string= start-t end-t
))))
1879 (icalendar--convert-non-recurring-not-all-day-to-diary
1880 e dtstart-dec dtend-dec start-t end-t
))
1884 (icalendar--dmsg "all day event")
1885 (setq diary-string
(icalendar--datetime-to-diary-date
1888 ;; add all other elements unless the user doesn't want to have
1893 (concat diary-string
" "
1894 (icalendar--format-ical-event e
)))
1895 (if do-not-ask
(setq summary nil
))
1896 ;; add entry to diary and store actual name of diary
1897 ;; file (in case it was nil)
1899 (icalendar--add-diary-entry diary-string diary-file
1900 non-marking summary
)))
1902 (setq found-error t
)
1904 (format "%s\nCannot handle this event:%s"
1906 ;; FIXME: inform user about ignored event properties
1909 (message "Ignoring event \"%s\"" e
)
1910 (setq found-error t
)
1911 (setq error-string
(format "%s\n%s\nCannot handle this event: %s"
1912 error-val error-string e
))
1913 (message "%s" error-string
))))
1915 ;; insert final newline
1917 (let ((b (find-buffer-visiting diary-file
)))
1919 (save-current-buffer
1921 (goto-char (point-max))
1924 (save-current-buffer
1925 (set-buffer (get-buffer-create "*icalendar-errors*"))
1927 (insert error-string
)))
1928 (message "Converting icalendar...done")
1931 ;; subroutines for importing
1932 (defun icalendar--convert-recurring-to-diary (e dtstart-dec start-t end-t
)
1933 "Convert recurring icalendar event E to diary format.
1935 DTSTART-DEC is the DTSTART property of E.
1936 START-T is the event's start time in diary format.
1937 END-T is the event's end time in diary format."
1938 (icalendar--dmsg "recurring event")
1939 (let* ((rrule (icalendar--get-event-property e
'RRULE
))
1940 (rrule-props (icalendar--split-value rrule
))
1941 (frequency (cadr (assoc 'FREQ rrule-props
)))
1942 (until (cadr (assoc 'UNTIL rrule-props
)))
1943 (count (cadr (assoc 'COUNT rrule-props
)))
1944 (interval (read (or (cadr (assoc 'INTERVAL rrule-props
)) "1")))
1945 (dtstart-conv (icalendar--datetime-to-diary-date dtstart-dec
))
1946 (until-conv (icalendar--datetime-to-diary-date
1947 (icalendar--decode-isodatetime until
)))
1948 (until-1-conv (icalendar--datetime-to-diary-date
1949 (icalendar--decode-isodatetime until -
1)))
1952 ;; FIXME FIXME interval!!!!!!!!!!!!!
1956 (message "Must not have UNTIL and COUNT -- ignoring COUNT element!")
1958 (cond ((string-equal frequency
"DAILY")
1959 (setq until
(icalendar--add-decoded-times
1961 (list 0 0 0 (* (read count
) interval
) 0 0)))
1962 (setq until-1
(icalendar--add-decoded-times
1964 (list 0 0 0 (* (- (read count
) 1) interval
)
1967 ((string-equal frequency
"WEEKLY")
1968 (setq until
(icalendar--add-decoded-times
1970 (list 0 0 0 (* (read count
) 7 interval
) 0 0)))
1971 (setq until-1
(icalendar--add-decoded-times
1973 (list 0 0 0 (* (- (read count
) 1) 7
1976 ((string-equal frequency
"MONTHLY")
1977 (setq until
(icalendar--add-decoded-times
1978 dtstart-dec
(list 0 0 0 0 (* (- (read count
) 1)
1980 (setq until-1
(icalendar--add-decoded-times
1981 dtstart-dec
(list 0 0 0 0 (* (- (read count
) 1)
1984 ((string-equal frequency
"YEARLY")
1985 (setq until
(icalendar--add-decoded-times
1986 dtstart-dec
(list 0 0 0 0 0 (* (- (read count
) 1)
1988 (setq until-1
(icalendar--add-decoded-times
1990 (list 0 0 0 0 0 (* (- (read count
) 1)
1994 (message "Cannot handle COUNT attribute for `%s' events."
1996 (setq until-conv
(icalendar--datetime-to-diary-date until
))
1997 (setq until-1-conv
(icalendar--datetime-to-diary-date until-1
))
2000 (cond ((string-equal frequency
"WEEKLY")
2003 ;; weekly and all-day
2004 (icalendar--dmsg "weekly all-day")
2009 "(diary-cyclic %d %s) "
2010 "(diary-block %s %s))")
2014 (if count until-1-conv until-conv
)
2017 (format "%%%%(and (diary-cyclic %d %s))"
2020 ;; weekly and not all-day
2021 (let* ((byday (cadr (assoc 'BYDAY rrule-props
)))
2023 (icalendar--get-weekday-number byday
)))
2024 (icalendar--dmsg "weekly not-all-day")
2029 "(diary-cyclic %d %s) "
2030 "(diary-block %s %s)) "
2037 (if end-t
"-" "") (or end-t
"")))
2040 ;; DTSTART;VALUE=DATE-TIME:20030919T090000
2041 ;; DTEND;VALUE=DATE-TIME:20030919T113000
2044 "%%%%(and (diary-cyclic %s %s)) %s%s%s"
2048 (if end-t
"-" "") (or end-t
"")))))))
2050 ((string-equal frequency
"YEARLY")
2051 (icalendar--dmsg "yearly")
2053 (let ((day (nth 3 dtstart-dec
))
2054 (month (nth 4 dtstart-dec
)))
2055 (setq result
(concat "%%(and (diary-date "
2056 (cond ((eq (icalendar--date-style) 'iso
)
2057 (format "t %d %d" month day
))
2058 ((eq (icalendar--date-style) 'european
)
2059 (format "%d %d t" day month
))
2060 ((eq (icalendar--date-style) 'american
)
2061 (format "%d %d t" month day
)))
2070 (setq result
(format
2071 "%%%%(and (diary-anniversary %s)) %s%s%s"
2074 (if end-t
"-" "") (or end-t
"")))))
2076 ((string-equal frequency
"MONTHLY")
2077 (icalendar--dmsg "monthly")
2080 "%%%%(and (diary-date %s) (diary-block %s %s)) %s%s%s"
2081 (let ((day (nth 3 dtstart-dec
)))
2082 (cond ((eq (icalendar--date-style) 'iso
)
2083 (format "t t %d" day
))
2084 ((eq (icalendar--date-style) 'european
)
2085 (format "%d t t" day
))
2086 ((eq (icalendar--date-style) 'american
)
2087 (format "t %d t" day
))))
2091 (if (eq (icalendar--date-style) 'iso
) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited
2093 (if end-t
"-" "") (or end-t
""))))
2095 ((and (string-equal frequency
"DAILY"))
2099 (concat "%%%%(and (diary-cyclic %s %s) "
2100 "(diary-block %s %s)) %s%s%s")
2101 interval dtstart-conv dtstart-conv
2102 (if count until-1-conv until-conv
)
2104 (if end-t
"-" "") (or end-t
"")))
2107 "%%%%(and (diary-cyclic %s %s)) %s%s%s"
2111 (if end-t
"-" "") (or end-t
""))))))
2112 ;; Handle exceptions from recurrence rules
2113 (let ((ex-dates (icalendar--get-event-properties e
'EXDATE
)))
2115 (let* ((ex-start (icalendar--decode-isodatetime
2117 (ex-d (icalendar--datetime-to-diary-date
2120 (icalendar--rris "^%%(\\(and \\)?"
2122 "%%%%(and (not (diary-date %s)) "
2125 (setq ex-dates
(cdr ex-dates
))))
2126 ;; FIXME: exception rules are not recognized
2127 (if (icalendar--get-event-property e
'EXRULE
)
2130 "\n Exception rules: "
2131 (icalendar--get-event-properties
2135 (defun icalendar--convert-non-recurring-all-day-to-diary (event start-d end-d
)
2136 "Convert non-recurring icalendar EVENT to diary format.
2138 DTSTART is the decoded DTSTART property of E.
2139 Argument START-D gives the first day.
2140 Argument END-D gives the last day."
2141 (icalendar--dmsg "non-recurring all-day event")
2142 (format "%%%%(and (diary-block %s %s))" start-d end-d
))
2144 (defun icalendar--convert-non-recurring-not-all-day-to-diary (event dtstart-dec
2148 "Convert recurring icalendar EVENT to diary format.
2150 DTSTART-DEC is the decoded DTSTART property of E.
2151 DTEND-DEC is the decoded DTEND property of E.
2152 START-T is the event's start time in diary format.
2153 END-T is the event's end time in diary format."
2154 (icalendar--dmsg "not all day event")
2157 (icalendar--datetime-to-diary-date
2162 (icalendar--datetime-to-diary-date
2166 (defun icalendar--add-diary-entry (string diary-file non-marking
2168 "Add STRING to the diary file DIARY-FILE.
2169 STRING must be a properly formatted valid diary entry. NON-MARKING
2170 determines whether diary events are created as non-marking. If
2171 SUMMARY is not nil it must be a string that gives the summary of the
2172 entry. In this case the user will be asked whether he wants to insert
2174 (when (or (not summary
)
2175 (y-or-n-p (format "Add appointment for `%s' to diary? "
2179 (y-or-n-p (format "Make appointment non-marking? "))))
2180 (save-window-excursion
2183 (read-file-name "Add appointment to this diary file: ")))
2184 ;; Note: diary-make-entry will add a trailing blank char.... :(
2185 (funcall (if (fboundp 'diary-make-entry
)
2188 string non-marking diary-file
)))
2189 ;; return diary-file in case it has been changed interactively
2192 ;; ======================================================================
2194 ;; ======================================================================
2195 (defun icalendar-import-format-sample (event)
2196 "Example function for formatting an icalendar EVENT."
2197 (format (concat "SUMMARY=`%s' DESCRIPTION=`%s' LOCATION=`%s' ORGANIZER=`%s' "
2198 "STATUS=`%s' URL=`%s' CLASS=`%s'")
2199 (or (icalendar--get-event-property event
'SUMMARY
) "")
2200 (or (icalendar--get-event-property event
'DESCRIPTION
) "")
2201 (or (icalendar--get-event-property event
'LOCATION
) "")
2202 (or (icalendar--get-event-property event
'ORGANIZER
) "")
2203 (or (icalendar--get-event-property event
'STATUS
) "")
2204 (or (icalendar--get-event-property event
'URL
) "")
2205 (or (icalendar--get-event-property event
'CLASS
) "")))
2207 (provide 'icalendar
)
2209 ;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc
2210 ;;; icalendar.el ends here