1 ;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
3 ;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
5 ;; Author: Ulf Jasper <ulf.jasper@web.de>
6 ;; Created: August 2002
8 ;; 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.
37 ;; - Float diary entries are assumed to occur the first time on the
38 ;; day when they are exported.
42 ;; 0.07 onwards: see commit logs and ../ChangeLog*.
45 ;; - Bugfixes regarding icalendar-import-format-*.
46 ;; - Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau.
49 ;; - New import format scheme: Replaced icalendar-import-prefix-*,
50 ;; icalendar-import-ignored-properties, and
51 ;; icalendar-import-separator with icalendar-import-format(-*).
52 ;; - icalendar-import-file and icalendar-convert-diary-to-ical
53 ;; have an extra parameter which should prevent them from
54 ;; erasing their target files (untested!).
55 ;; - Tested with Emacs 21.3.2
58 ;; - Bugfix: import: double quoted param values did not work
59 ;; - Read DURATION property when importing.
60 ;; - Added parameter icalendar-duration-correction.
63 ;; - Export takes care of european-calendar-style.
64 ;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12
67 ;; - Should work in XEmacs now. Thanks to Len Trigg for the XEmacs patches!
68 ;; - Added exporting from Emacs diary to ical.
69 ;; - Some bugfixes, after testing with calendars from http://icalshare.com.
70 ;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12
73 ;; - First published version. Trial version. Alpha version.
75 ;; ======================================================================
78 ;; * Import from ical to diary:
79 ;; + Need more properties for icalendar-import-format
80 ;; (added all that Mozilla Calendar uses)
81 ;; From iCal specifications (RFC2445: 4.8.1), icalendar.el lacks
82 ;; ATTACH, CATEGORIES, COMMENT, GEO, PERCENT-COMPLETE (VTODO),
83 ;; PRIORITY, RESOURCES) not considering date/time and time-zone
84 ;; + check vcalendar version
85 ;; + check (unknown) elements
86 ;; + recurring events!
87 ;; + works for european style calendars only! Does it?
89 ;; + exceptions in recurring events
90 ;; + the parser is too soft
91 ;; + error log is incomplete
92 ;; + nice to have: #include "webcal://foo.com/some-calendar.ics"
93 ;; + timezones probably still need some improvements.
95 ;; * Export from diary to ical
96 ;; + diary-date, diary-float, and self-made sexp entries are not
100 ;; + clean up all those date/time parsing functions
101 ;; + Handle todo items?
102 ;; + Check iso 8601 for datetime and period
103 ;; + Which chars to (un)escape?
108 (defconst icalendar-version
"0.19"
109 "Version number of icalendar.el.")
111 ;; ======================================================================
113 ;; ======================================================================
114 (defgroup icalendar nil
119 (defcustom icalendar-import-format
121 "Format for importing events from iCalendar into Emacs diary.
122 It defines how iCalendar events are inserted into diary file.
123 This may either be a string or a function.
125 In case of a formatting STRING the following specifiers can be used:
126 %c Class, see `icalendar-import-format-class'
127 %d Description, see `icalendar-import-format-description'
128 %l Location, see `icalendar-import-format-location'
129 %o Organizer, see `icalendar-import-format-organizer'
130 %s Summary, see `icalendar-import-format-summary'
131 %t Status, see `icalendar-import-format-status'
132 %u URL, see `icalendar-import-format-url'
133 %U UID, see `icalendar-import-format-uid'
135 A formatting FUNCTION will be called with a VEVENT as its only
136 argument. It must return a string. See
137 `icalendar-import-format-sample' for an example."
139 (string :tag
"String")
140 (function :tag
"Function"))
143 (defcustom icalendar-import-format-summary
145 "Format string defining how the summary element is formatted.
146 This applies only if the summary is not empty! `%s' is replaced
151 (defcustom icalendar-import-format-description
153 "Format string defining how the description element is formatted.
154 This applies only if the description is not empty! `%s' is
155 replaced by the description."
159 (defcustom icalendar-import-format-location
161 "Format string defining how the location element is formatted.
162 This applies only if the location is not empty! `%s' is replaced
167 (defcustom icalendar-import-format-organizer
169 "Format string defining how the organizer element is formatted.
170 This applies only if the organizer is not empty! `%s' is
171 replaced by the organizer."
175 (defcustom icalendar-import-format-url
177 "Format string defining how the URL element is formatted.
178 This applies only if the URL is not empty! `%s' is replaced by
183 (defcustom icalendar-import-format-uid
185 "Format string defining how the UID element is formatted.
186 This applies only if the UID is not empty! `%s' is replaced by
192 (defcustom icalendar-import-format-status
194 "Format string defining how the status element is formatted.
195 This applies only if the status is not empty! `%s' is replaced by
200 (defcustom icalendar-import-format-class
202 "Format string defining how the class element is formatted.
203 This applies only if the class is not empty! `%s' is replaced by
208 (defcustom icalendar-recurring-start-year
210 "Start year for recurring events.
211 Some calendar browsers only propagate recurring events for
212 several years beyond the start time. Set this string to a year
213 just before the start of your personal calendar."
217 (defcustom icalendar-export-hidden-diary-entries
219 "Determines whether hidden diary entries are exported.
220 If non-nil hidden diary entries (starting with `&') get exported,
221 if nil they are ignored."
225 (defcustom icalendar-uid-format
227 "Format of unique ID code (UID) for each iCalendar object.
228 The following specifiers are available:
229 %c COUNTER, an integer value that is increased each time a uid is
230 generated. This may be necessary for systems which do not
231 provide time-resolution finer than a second.
232 %h HASH, a hash value of the diary entry,
233 %s DTSTART, the start date (excluding time) of the diary entry,
234 %t TIMESTAMP, a unique creation timestamp,
235 %u USERNAME, the variable `user-login-name'.
237 For example, a value of \"%s_%h@mydomain.com\" will generate a
238 UID code for each entry composed of the time of the event, a hash
239 code for the event, and your personal domain name."
243 (defcustom icalendar-export-sexp-enumeration-days
245 "Number of days over which a sexp diary entry is enumerated.
246 In general sexp entries cannot be translated to icalendar format.
247 They are therefore enumerated, i.e. explicitly evaluated for a
248 certain number of days, and then exported. The enumeration starts
249 on the current day and continues for the number of days given here.
251 See `icalendar-export-sexp-enumerate-all' for a list of sexp
252 entries which by default are NOT enumerated."
257 (defcustom icalendar-export-sexp-enumerate-all
259 "Determines whether ALL sexp diary entries are enumerated.
260 If non-nil all sexp diary entries are enumerated for
261 `icalendar-export-sexp-enumeration-days' days instead of
262 translating into an icalendar equivalent. This affects the
263 following sexp diary entries: `diary-anniversary',
264 `diary-cyclic', `diary-date', `diary-float',`diary-block'. All
265 other sexp entries are enumerated in any case."
271 (defcustom icalendar-export-alarms
273 "Determine if and how alarms are included in exported diary events."
275 :type
'(choice (const :tag
"Do not include alarms in export"
277 (list :tag
"Create alarms in exported diary entries"
278 (integer :tag
"Advance time (minutes)"
280 (set :tag
"Alarm type"
282 (const audio
:tag
"Audio"))
284 (const display
:tag
"Display"))
287 (repeat :tag
"Attendees"
288 (string :tag
"Email"))))))
292 (defvar icalendar-debug nil
293 "Enable icalendar debug messages.")
295 ;; ======================================================================
296 ;; NO USER SERVICEABLE PARTS BELOW THIS LINE
297 ;; ======================================================================
299 (defconst icalendar--weekday-array
["SU" "MO" "TU" "WE" "TH" "FR" "SA"])
301 ;; ======================================================================
302 ;; all the other libs we need
303 ;; ======================================================================
307 ;; ======================================================================
309 ;; ======================================================================
310 (defun icalendar--dmsg (&rest args
)
311 "Print message ARGS if `icalendar-debug' is non-nil."
313 (apply 'message args
)))
315 ;; ======================================================================
316 ;; Core functionality
317 ;; Functions for parsing icalendars, importing and so on
318 ;; ======================================================================
320 (defun icalendar--get-unfolded-buffer (folded-ical-buffer)
321 "Return a new buffer containing the unfolded contents of a buffer.
322 Folding is the iCalendar way of wrapping long lines. In the
323 created buffer all occurrences of CR LF BLANK are replaced by the
324 empty string. Argument FOLDED-ICAL-BUFFER is the unfolded input
326 (let ((unfolded-buffer (get-buffer-create " *icalendar-work*")))
328 (set-buffer unfolded-buffer
)
330 (insert-buffer-substring folded-ical-buffer
)
331 (goto-char (point-min))
332 (while (re-search-forward "\r?\n[ \t]" nil t
)
333 (replace-match "" nil nil
)))
336 (defsubst icalendar--rris
(regexp rep string
&optional fixedcase literal
)
337 "Replace regular expression in string.
338 Pass arguments REGEXP REP STRING FIXEDCASE LITERAL to
339 `replace-regexp-in-string' (Emacs) or to `replace-in-string' (XEmacs)."
340 (cond ((fboundp 'replace-regexp-in-string
)
342 (replace-regexp-in-string regexp rep string fixedcase literal
))
343 ((fboundp 'replace-in-string
)
345 (save-match-data ;; apparently XEmacs needs save-match-data
346 (replace-in-string string regexp rep literal
)))))
348 (defun icalendar--read-element (invalue inparams
)
349 "Recursively read the next iCalendar element in the current buffer.
350 INVALUE gives the current iCalendar element we are reading.
351 INPARAMS gives the current parameters.....
352 This function calls itself recursively for each nested calendar element
354 (let (element children line name params param param-name param-value
359 (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t
))
360 (setq name
(intern (match-string 1)))
364 (while (looking-at ";")
365 (re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil
)
366 (setq param-name
(intern (match-string 1)))
367 (re-search-forward "\\(\\([^;,:\"]+\\)\\|\"\\([^\"]+\\)\"\\)[;:]"
370 (setq param-value
(or (match-string 2) (match-string 3)))
371 (setq param
(list param-name param-value
))
372 (while (looking-at ",")
373 (re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)"
376 (setq param-value
(match-string 2))
377 (setq param-value
(match-string 3)))
378 (setq param
(append param param-value
)))
379 (setq params
(append params param
)))
380 (unless (looking-at ":")
383 (re-search-forward "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t
)
384 (setq value
(icalendar--rris "\r?\n[ \t]" "" (match-string 0)))
385 (setq line
(list name params value
))
386 (cond ((eq name
'BEGIN
)
389 (list (icalendar--read-element (intern value
)
394 (setq element
(append element
(list line
))))))
396 (list invalue inparams element children
)
399 ;; ======================================================================
400 ;; helper functions for examining events
401 ;; ======================================================================
403 ;;(defsubst icalendar--get-all-event-properties (event)
404 ;; "Return the list of properties in this EVENT."
405 ;; (car (cddr event)))
407 (defun icalendar--get-event-property (event prop
)
408 "For the given EVENT return the value of the first occurrence of PROP."
410 (let ((props (car (cddr event
))) pp
)
412 (setq pp
(car props
))
413 (if (eq (car pp
) prop
)
414 (throw 'found
(car (cddr pp
))))
415 (setq props
(cdr props
))))
418 (defun icalendar--get-event-property-attributes (event prop
)
419 "For the given EVENT return attributes of the first occurrence of PROP."
421 (let ((props (car (cddr event
))) pp
)
423 (setq pp
(car props
))
424 (if (eq (car pp
) prop
)
425 (throw 'found
(cadr pp
)))
426 (setq props
(cdr props
))))
429 (defun icalendar--get-event-properties (event prop
)
430 "For the given EVENT return a list of all values of the property PROP."
431 (let ((props (car (cddr event
))) pp result
)
433 (setq pp
(car props
))
434 (if (eq (car pp
) prop
)
435 (setq result
(append (split-string (car (cddr pp
)) ",") result
)))
436 (setq props
(cdr props
)))
439 ;; (defun icalendar--set-event-property (event prop new-value)
440 ;; "For the given EVENT set the property PROP to the value NEW-VALUE."
442 ;; (let ((props (car (cddr event))) pp)
444 ;; (setq pp (car props))
445 ;; (when (eq (car pp) prop)
446 ;; (setcdr (cdr pp) new-value)
447 ;; (throw 'found (car (cddr pp))))
448 ;; (setq props (cdr props)))
449 ;; (setq props (car (cddr event)))
450 ;; (setcar (cddr event)
451 ;; (append props (list (list prop nil new-value)))))))
453 (defun icalendar--get-children (node name
)
454 "Return all children of the given NODE which have a name NAME.
455 For instance the VCALENDAR node can have VEVENT children as well as VTODO
458 (children (cadr (cddr node
))))
459 (when (eq (car node
) name
)
461 ;;(message "%s" node)
466 (icalendar--get-children n name
))
470 (setq result
(append result subresult
))
471 (setq result subresult
)))))
475 (defun icalendar--all-events (icalendar)
476 "Return the list of all existing events in the given ICALENDAR."
479 (setq result
(append (icalendar--get-children elt
'VEVENT
)
481 (nreverse icalendar
))
484 (defun icalendar--split-value (value-string)
485 "Split VALUE-STRING at ';='."
487 param-name param-value
)
490 (set-buffer (get-buffer-create " *icalendar-work*"))
491 (set-buffer-modified-p nil
)
493 (insert value-string
)
494 (goto-char (point-min))
497 "\\([A-Za-z0-9-]+\\)=\\(\\([^;:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
499 (setq param-name
(intern (match-string 1)))
500 (setq param-value
(match-string 2))
502 (append result
(list (list param-name param-value
)))))))
505 (defun icalendar--convert-tz-offset (alist dst-p
)
506 "Return a cons of two strings representing a timezone start.
507 ALIST is an alist entry from a VTIMEZONE, like STANDARD.
508 DST-P is non-nil if this is for daylight savings time.
509 The strings are suitable for assembling into a TZ variable."
510 (let* ((offsetto (car (cddr (assq 'TZOFFSETTO alist
))))
511 (offsetfrom (car (cddr (assq 'TZOFFSETFROM alist
))))
512 (rrule-value (car (cddr (assq 'RRULE alist
))))
513 (dtstart (car (cddr (assq 'DTSTART alist
))))
514 (no-dst (equal offsetto offsetfrom
)))
515 ;; FIXME: for now we only handle RRULE and not RDATE here.
516 (when (and offsetto dtstart
(or rrule-value no-dst
))
517 (let* ((rrule (icalendar--split-value rrule-value
))
518 (freq (cadr (assq 'FREQ rrule
)))
519 (bymonth (cadr (assq 'BYMONTH rrule
)))
520 (byday (cadr (assq 'BYDAY rrule
))))
521 ;; FIXME: we don't correctly handle WKST here.
522 (if (or no-dst
(and (string= freq
"YEARLY") bymonth
))
526 (if dst-p
"DST" "STD")
527 ;; For TZ, OFFSET is added to the local time. So,
528 ;; invert the values.
529 (if (eq (aref offsetto
0) ?-
) "+" "-")
530 (substring offsetto
1 3)
532 (substring offsetto
3 5))
534 (let* ((day (if no-dst
536 (icalendar--get-weekday-number (substring byday -
2))))
541 (substring byday
0 -
2)))))
542 ;; "Translate" the iCalendar way to specify the last
543 ;; (sun|mon|...)day in month to the tzset way.
544 (if (string= week
"-1") ; last day as iCalendar calls it
545 (setq week
"5")) ; last day as tzset calls it
546 (when no-dst
(setq bymonth
"1"))
547 (concat "M" bymonth
"." week
"." (if (eq day -
1) "0"
551 (substring dtstart -
6 -
4)
553 (substring dtstart -
4 -
2)
555 (substring dtstart -
2)))))))))
557 (defun icalendar--parse-vtimezone (alist)
558 "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
559 Return nil if timezone cannot be parsed."
560 (let* ((tz-id (icalendar--convert-string-for-import
561 (icalendar--get-event-property alist
'TZID
)))
562 (daylight (cadr (cdar (icalendar--get-children alist
'DAYLIGHT
))))
563 (day (and daylight
(icalendar--convert-tz-offset daylight t
)))
564 (standard (cadr (cdar (icalendar--get-children alist
'STANDARD
))))
565 (std (and standard
(icalendar--convert-tz-offset standard nil
))))
569 (concat (car std
) (car day
)
570 "," (cdr day
) "," (cdr std
))
573 (defun icalendar--convert-all-timezones (icalendar)
574 "Convert all timezones in the ICALENDAR into an alist.
575 Each element of the alist is a cons (ID . TZ-STRING),
576 like `icalendar--parse-vtimezone'."
578 (dolist (zone (icalendar--get-children (car icalendar
) 'VTIMEZONE
))
579 (setq zone
(icalendar--parse-vtimezone zone
))
581 (setq result
(cons zone result
))))
584 (defun icalendar--find-time-zone (prop-list zone-map
)
585 "Return a timezone string for the time zone in PROP-LIST, or nil if none.
586 ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'."
587 (let ((id (plist-get prop-list
'TZID
)))
589 (cdr (assoc id zone-map
)))))
591 (defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift
593 "Return ISODATETIMESTRING in format like `decode-time'.
594 Converts from ISO-8601 to Emacs representation. If
595 ISODATETIMESTRING specifies UTC time (trailing letter Z) the
596 decoded time is given in the local time zone! If optional
597 parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
599 ZONE, if provided, is the timezone, in any format understood by `encode-time'.
601 FIXME: multiple comma-separated values should be allowed!"
602 (icalendar--dmsg isodatetimestring
)
603 (if isodatetimestring
604 ;; day/month/year must be present
605 (let ((year (read (substring isodatetimestring
0 4)))
606 (month (read (substring isodatetimestring
4 6)))
607 (day (read (substring isodatetimestring
6 8)))
611 (when (> (length isodatetimestring
) 12)
612 ;; hour/minute present
613 (setq hour
(read (substring isodatetimestring
9 11)))
614 (setq minute
(read (substring isodatetimestring
11 13))))
615 (when (> (length isodatetimestring
) 14)
617 (setq second
(read (substring isodatetimestring
13 15))))
618 (when (and (> (length isodatetimestring
) 15)
619 ;; UTC specifier present
620 (char-equal ?Z
(aref isodatetimestring
15)))
621 ;; if not UTC add current-time-zone offset
622 ;; current-time-zone should be called with actual UTC time
623 ;; (daylight saving at that time may differ to current one)
624 (setq second
(+ (car (current-time-zone
625 (encode-time second minute hour day month year
628 ;; shift if necessary
630 (let ((mdy (calendar-gregorian-from-absolute
631 (+ (calendar-absolute-from-gregorian
632 (list month day year
))
634 (setq month
(nth 0 mdy
))
635 (setq day
(nth 1 mdy
))
636 (setq year
(nth 2 mdy
))))
637 ;; create the decoded date-time
640 (decode-time (encode-time second minute hour day month year zone
))
642 (message "Cannot decode \"%s\"" isodatetimestring
)
643 ;; hope for the best...
644 (list second minute hour day month year
0 nil
0))))
645 ;; isodatetimestring == nil
648 (defun icalendar--decode-isoduration (isodurationstring
649 &optional duration-correction
)
650 "Convert ISODURATIONSTRING into format provided by `decode-time'.
651 Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING
652 specifies UTC time (trailing letter Z) the decoded time is given in
655 Optional argument DURATION-CORRECTION shortens result by one day.
657 FIXME: TZID-attributes are ignored....!
658 FIXME: multiple comma-separated values should be allowed!"
659 (if isodurationstring
664 "\\(\\([0-9]+\\)D\\)" ; days only
666 "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days
667 "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time
669 "\\(\\([0-9]+\\)W\\)" ; weeks only
670 "\\)$") isodurationstring
)
678 ((match-beginning 2) ;days only
679 (setq days
(read (substring isodurationstring
682 (when duration-correction
683 (setq days
(1- days
))))
684 ((match-beginning 4) ;days and time
685 (if (match-beginning 5)
686 (setq days
(* 7 (read (substring isodurationstring
689 (if (match-beginning 7)
690 (setq hours
(read (substring isodurationstring
693 (if (match-beginning 9)
694 (setq minutes
(read (substring isodurationstring
697 (if (match-beginning 11)
698 (setq seconds
(read (substring isodurationstring
701 ((match-beginning 13) ;weeks only
702 (setq days
(* 7 (read (substring isodurationstring
705 (list seconds minutes hours days months years
)))
706 ;; isodatetimestring == nil
709 (defun icalendar--add-decoded-times (time1 time2
)
711 Both times must be given in decoded form. One of these times must be
712 valid (year > 1900 or something)."
713 ;; FIXME: does this function exist already?
714 (decode-time (encode-time
715 (+ (nth 0 time1
) (nth 0 time2
))
716 (+ (nth 1 time1
) (nth 1 time2
))
717 (+ (nth 2 time1
) (nth 2 time2
))
718 (+ (nth 3 time1
) (nth 3 time2
))
719 (+ (nth 4 time1
) (nth 4 time2
))
720 (+ (nth 5 time1
) (nth 5 time2
))
723 ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
726 (defun icalendar--datetime-to-american-date (datetime &optional separator
)
727 "Convert the decoded DATETIME to American-style format.
728 Optional argument SEPARATOR gives the separator between month,
729 day, and year. If nil a blank character is used as separator.
730 American format: \"month day year\"."
732 (format "%d%s%d%s%d" (nth 4 datetime
) ;month
734 (nth 3 datetime
) ;day
736 (nth 5 datetime
)) ;year
740 (define-obsolete-function-alias 'icalendar--datetime-to-noneuropean-date
741 'icalendar--datetime-to-american-date
"icalendar 0.19")
743 (defun icalendar--datetime-to-european-date (datetime &optional separator
)
744 "Convert the decoded DATETIME to European format.
745 Optional argument SEPARATOR gives the separator between month,
746 day, and year. If nil a blank character is used as separator.
747 European format: (day month year).
750 (format "%d%s%d%s%d" (nth 3 datetime
) ;day
752 (nth 4 datetime
) ;month
754 (nth 5 datetime
)) ;year
758 (defun icalendar--datetime-to-iso-date (datetime &optional separator
)
759 "Convert the decoded DATETIME to ISO format.
760 Optional argument SEPARATOR gives the separator between month,
761 day, and year. If nil a blank character is used as separator.
762 ISO format: (year month day)."
764 (format "%d%s%d%s%d" (nth 5 datetime
) ;year
766 (nth 4 datetime
) ;month
768 (nth 3 datetime
)) ;day
772 (defun icalendar--datetime-to-diary-date (datetime &optional separator
)
773 "Convert the decoded DATETIME to diary format.
774 Optional argument SEPARATOR gives the separator between month,
775 day, and year. If nil a blank character is used as separator.
776 Call icalendar--datetime-to-*-date according to the current
777 calendar date style."
778 (funcall (intern-soft (format "icalendar--datetime-to-%s-date"
779 calendar-date-style
))
782 (defun icalendar--datetime-to-colontime (datetime)
783 "Extract the time part of a decoded DATETIME into 24-hour format.
784 Note that this silently ignores seconds."
785 (format "%02d:%02d" (nth 2 datetime
) (nth 1 datetime
)))
787 (defun icalendar--get-month-number (monthname)
788 "Return the month number for the given MONTHNAME."
791 (m (downcase monthname
)))
792 (mapc (lambda (month)
793 (let ((mm (downcase month
)))
794 (if (or (string-equal mm m
)
795 (string-equal (substring mm
0 3) m
))
797 (setq num
(1+ num
))))
798 calendar-month-name-array
))
802 (defun icalendar--get-weekday-number (abbrevweekday)
803 "Return the number for the ABBREVWEEKDAY."
807 (aw (downcase abbrevweekday
)))
809 (let ((d (downcase day
)))
810 (if (string-equal d aw
)
812 (setq num
(1+ num
))))
813 icalendar--weekday-array
)))
817 (defun icalendar--get-weekday-numbers (abbrevweekdays)
818 "Return the list of numbers for the comma-separated ABBREVWEEKDAYS."
821 (weekday-alist (mapcar (lambda (day)
824 (cons (downcase day
) num
)))
825 icalendar--weekday-array
)))
827 (mapcar (lambda (abbrevday)
828 (cdr (assoc abbrevday weekday-alist
)))
829 (split-string (downcase abbrevweekdays
) ","))))))
831 (defun icalendar--get-weekday-abbrev (weekday)
832 "Return the abbreviated WEEKDAY."
835 (w (downcase weekday
)))
837 (let ((d (downcase day
)))
838 (if (or (string-equal d w
)
839 (string-equal (substring d
0 3) w
))
840 (throw 'found
(aref icalendar--weekday-array num
)))
841 (setq num
(1+ num
))))
842 calendar-day-name-array
))
846 (defun icalendar--date-to-isodate (date &optional day-shift
)
847 "Convert DATE to iso-style date.
848 DATE must be a list of the form (month day year).
849 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
850 (let ((mdy (calendar-gregorian-from-absolute
851 (+ (calendar-absolute-from-gregorian date
)
853 (format "%04d%02d%02d" (nth 2 mdy
) (nth 0 mdy
) (nth 1 mdy
))))
856 (defun icalendar--datestring-to-isodate (datestring &optional day-shift
)
857 "Convert diary-style DATESTRING to iso-style date.
858 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
859 -- DAY-SHIFT must be either nil or an integer. This function
860 tries to figure the date style from DATESTRING itself. If that
861 is not possible it uses the current calendar date style."
862 (let ((day -
1) month year
)
864 (cond ( ;; iso-style numeric date
865 (string-match (concat "\\s-*"
866 "\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
867 "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
868 "0?\\([1-9][0-9]?\\)")
870 (setq year
(read (substring datestring
(match-beginning 1)
872 (setq month
(read (substring datestring
(match-beginning 2)
874 (setq day
(read (substring datestring
(match-beginning 3)
876 ( ;; non-iso numeric date -- must rely on configured
878 (string-match (concat "\\s-*"
879 "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
880 "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
881 "\\([0-9]\\{4\\}\\)")
883 (setq day
(read (substring datestring
(match-beginning 1)
885 (setq month
(read (substring datestring
(match-beginning 2)
887 (setq year
(read (substring datestring
(match-beginning 3)
889 (if (eq calendar-date-style
'american
)
893 ( ;; date contains month names -- iso style
894 (string-match (concat "\\s-*"
895 "\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
896 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
897 "0?\\([123]?[0-9]\\)")
899 (setq year
(read (substring datestring
(match-beginning 1)
901 (setq month
(icalendar--get-month-number
902 (substring datestring
(match-beginning 2)
904 (setq day
(read (substring datestring
(match-beginning 3)
906 ( ;; date contains month names -- european style
907 (string-match (concat "\\s-*"
908 "0?\\([123]?[0-9]\\)[ \t/]\\s-*"
909 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
910 "\\([0-9]\\{4\\}\\)")
912 (setq day
(read (substring datestring
(match-beginning 1)
914 (setq month
(icalendar--get-month-number
915 (substring datestring
(match-beginning 2)
917 (setq year
(read (substring datestring
(match-beginning 3)
919 ( ;; date contains month names -- american style
920 (string-match (concat "\\s-*"
921 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
922 "0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
923 "\\([0-9]\\{4\\}\\)")
925 (setq day
(read (substring datestring
(match-beginning 2)
927 (setq month
(icalendar--get-month-number
928 (substring datestring
(match-beginning 1)
930 (setq year
(read (substring datestring
(match-beginning 3)
935 (let ((mdy (calendar-gregorian-from-absolute
936 (+ (calendar-absolute-from-gregorian (list month day
939 (icalendar--dmsg (format "%04d%02d%02d" (nth 2 mdy
) (nth 0 mdy
) (nth 1 mdy
)))
940 (format "%04d%02d%02d" (nth 2 mdy
) (nth 0 mdy
) (nth 1 mdy
)))
943 (defun icalendar--diarytime-to-isotime (timestring ampmstring
)
944 "Convert a time like 9:30pm to an iso-conform string like T213000.
945 In this example the TIMESTRING would be \"9:30\" and the
946 AMPMSTRING would be \"pm\". The minutes may be missing as long
947 as the colon is missing as well, i.e. \"9\" is allowed as
948 TIMESTRING and has the same result as \"9:00\"."
950 (let* ((parts (save-match-data (split-string timestring
":")))
952 (m (if (cdr parts
) (cadr parts
)
953 (if (> (length h
) 2) "" "00")))
954 (starttimenum (read (concat h m
))))
955 ;; take care of am/pm style
956 ;; Be sure *not* to convert 12:00pm - 12:59pm to 2400-2459
957 (if (and ampmstring
(string= "pm" ampmstring
) (< starttimenum
1200))
958 (setq starttimenum
(+ starttimenum
1200)))
959 ;; Similar effect with 12:00am - 12:59am (need to convert to 0000-0059)
960 (if (and ampmstring
(string= "am" ampmstring
) (>= starttimenum
1200))
961 (setq starttimenum
(- starttimenum
1200)))
962 (format "T%04d00" starttimenum
))
965 (defun icalendar--convert-string-for-export (string)
966 "Escape comma and other critical characters in STRING."
967 (icalendar--rris "," "\\\\," string
))
969 (defun icalendar--convert-string-for-import (string)
970 "Remove escape chars for comma, semicolon etc. from STRING."
972 "\\\\n" "\n " (icalendar--rris
973 "\\\\\"" "\"" (icalendar--rris
974 "\\\\;" ";" (icalendar--rris
975 "\\\\," "," string
)))))
977 ;; ======================================================================
978 ;; Export -- convert emacs-diary to iCalendar
979 ;; ======================================================================
982 (defun icalendar-export-file (diary-filename ical-filename
)
983 "Export diary file to iCalendar format.
984 All diary entries in the file DIARY-FILENAME are converted to iCalendar
985 format. The result is appended to the file ICAL-FILENAME."
986 (interactive "FExport diary data from file: \n\
987 Finto iCalendar file: ")
989 (set-buffer (find-file diary-filename
))
990 (icalendar-export-region (point-min) (point-max) ical-filename
)))
992 (define-obsolete-function-alias 'icalendar-convert-diary-to-ical
993 'icalendar-export-file
"22.1")
995 (defvar icalendar--uid-count
0
996 "Auxiliary counter for creating unique ids.")
998 (defun icalendar--create-uid (entry-full contents
)
999 "Construct a unique iCalendar UID for a diary entry.
1000 ENTRY-FULL is the full diary entry string. CONTENTS is the
1001 current iCalendar object, as a string. Increase
1002 `icalendar--uid-count'. Returns the UID string."
1003 (let ((uid icalendar-uid-format
))
1005 ;; Allow other apps (such as org-mode) to create its own uid
1006 (get-text-property 0 'uid entry-full
)
1007 (setq uid
(get-text-property 0 'uid entry-full
))
1008 (setq uid
(replace-regexp-in-string
1010 (format "%d" icalendar--uid-count
)
1012 (setq icalendar--uid-count
(1+ icalendar--uid-count
))
1013 (setq uid
(replace-regexp-in-string
1015 (format "%d%d%d" (car (current-time))
1016 (cadr (current-time))
1017 (car (cddr (current-time))))
1019 (setq uid
(replace-regexp-in-string
1021 (format "%d" (abs (sxhash entry-full
))) uid t t
))
1022 (setq uid
(replace-regexp-in-string
1023 "%u" (or user-login-name
"UNKNOWN_USER") uid t t
))
1024 (let ((dtstart (if (string-match "^DTSTART[^:]*:\\([0-9]*\\)" contents
)
1025 (substring contents
(match-beginning 1) (match-end 1))
1027 (setq uid
(replace-regexp-in-string "%s" dtstart uid t t
))))
1029 ;; Return the UID string
1033 (defun icalendar-export-region (min max ical-filename
)
1034 "Export region in diary file to iCalendar format.
1035 All diary entries in the region from MIN to MAX in the current buffer are
1036 converted to iCalendar format. The result is appended to the file
1038 This function attempts to return t if something goes wrong. In this
1039 case an error string which describes all the errors and problems is
1040 written into the buffer `*icalendar-errors*'."
1042 FExport diary data into iCalendar file: ")
1049 (contents-n-summary)
1053 (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol
)
1055 (other-elements nil
)
1056 (cns-cons-or-list nil
))
1057 ;; prepare buffer with error messages
1058 (save-current-buffer
1059 (set-buffer (get-buffer-create "*icalendar-errors*"))
1065 (while (re-search-forward
1066 ;; possibly ignore hidden entries beginning with "&"
1067 (if icalendar-export-hidden-diary-entries
1068 "^\\([^ \t\n#].+\\)\\(\\(\n[ \t].*\\)*\\)"
1069 "^\\([^ \t\n&#].+\\)\\(\\(\n[ \t].*\\)*\\)") max t
)
1070 (setq entry-main
(match-string 1))
1071 (if (match-beginning 2)
1072 (setq entry-rest
(match-string 2))
1073 (setq entry-rest
""))
1074 (setq entry-full
(concat entry-main entry-rest
))
1076 (condition-case error-val
1078 (setq cns-cons-or-list
1079 (icalendar--convert-to-ical nonmarker entry-main
))
1080 (setq other-elements
(icalendar--parse-summary-and-rest
1082 (mapc (lambda (contents-n-summary)
1083 (setq contents
(concat (car contents-n-summary
)
1085 (cdr contents-n-summary
)))
1086 (let ((cla (cdr (assoc 'cla other-elements
)))
1087 (des (cdr (assoc 'des other-elements
)))
1088 (loc (cdr (assoc 'loc other-elements
)))
1089 (org (cdr (assoc 'org other-elements
)))
1090 (sta (cdr (assoc 'sta other-elements
)))
1091 (sum (cdr (assoc 'sum other-elements
)))
1092 (url (cdr (assoc 'url other-elements
)))
1093 (uid (cdr (assoc 'uid other-elements
))))
1095 (setq contents
(concat contents
"\nCLASS:" cla
)))
1097 (setq contents
(concat contents
"\nDESCRIPTION:"
1100 (setq contents
(concat contents
"\nLOCATION:" loc
)))
1102 (setq contents
(concat contents
"\nORGANIZER:"
1105 (setq contents
(concat contents
"\nSTATUS:" sta
)))
1107 ;; (setq contents (concat contents "\nSUMMARY:" sum)))
1109 (setq contents
(concat contents
"\nURL:" url
)))
1111 (setq header
(concat "\nBEGIN:VEVENT\nUID:"
1113 (icalendar--create-uid
1114 entry-full contents
))))
1115 (setq alarm
(icalendar--create-ical-alarm
1116 (cdr contents-n-summary
))))
1117 (setq result
(concat result header contents alarm
1119 (if (consp cns-cons-or-list
)
1120 (list cns-cons-or-list
)
1124 (setq found-error t
)
1125 (save-current-buffer
1126 (set-buffer (get-buffer-create "*icalendar-errors*"))
1127 (insert (format "Error in line %d -- %s: `%s'\n"
1128 (count-lines (point-min) (point))
1132 ;; we're done, insert everything into the file
1133 (save-current-buffer
1134 (let ((coding-system-for-write 'utf-8
))
1135 (set-buffer (find-file ical-filename
))
1136 (goto-char (point-max))
1137 (insert "BEGIN:VCALENDAR")
1138 (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
1139 (insert "\nVERSION:2.0")
1141 (insert "\nEND:VCALENDAR\n")
1142 ;; save the diary file
1148 (defun icalendar--convert-to-ical (nonmarker entry-main
)
1149 "Convert a diary entry to iCalendar format.
1150 NONMARKER is a regular expression matching the start of non-marking
1151 entries. ENTRY-MAIN is the first line of the diary entry."
1153 (unless icalendar-export-sexp-enumerate-all
1155 ;; anniversaries -- %%(diary-anniversary ...)
1156 (icalendar--convert-anniversary-to-ical nonmarker entry-main
)
1157 ;; cyclic events -- %%(diary-cyclic ...)
1158 (icalendar--convert-cyclic-to-ical nonmarker entry-main
)
1159 ;; diary-date -- %%(diary-date ...)
1160 (icalendar--convert-date-to-ical nonmarker entry-main
)
1161 ;; float events -- %%(diary-float ...)
1162 (icalendar--convert-float-to-ical nonmarker entry-main
)
1163 ;; block events -- %%(diary-block ...)
1164 (icalendar--convert-block-to-ical nonmarker entry-main
)))
1165 ;; other sexp diary entries
1166 (icalendar--convert-sexp-to-ical nonmarker entry-main
)
1167 ;; weekly by day -- Monday 8:30 Team meeting
1168 (icalendar--convert-weekly-to-ical nonmarker entry-main
)
1169 ;; yearly by day -- 1 May Tag der Arbeit
1170 (icalendar--convert-yearly-to-ical nonmarker entry-main
)
1171 ;; "ordinary" events, start and end time given
1173 (icalendar--convert-ordinary-to-ical nonmarker entry-main
)
1175 ;; Oops! what's that?
1176 (error "Could not parse entry")))
1178 (defun icalendar--parse-summary-and-rest (summary-and-rest)
1179 "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties.
1182 (if (functionp icalendar-import-format
)
1183 ;; can't do anything
1185 ;; split summary-and-rest
1186 (let* ((case-fold-search nil
)
1187 (s icalendar-import-format
)
1188 (p-cla (or (string-match "%c" icalendar-import-format
) -
1))
1189 (p-des (or (string-match "%d" icalendar-import-format
) -
1))
1190 (p-loc (or (string-match "%l" icalendar-import-format
) -
1))
1191 (p-org (or (string-match "%o" icalendar-import-format
) -
1))
1192 (p-sum (or (string-match "%s" icalendar-import-format
) -
1))
1193 (p-sta (or (string-match "%t" icalendar-import-format
) -
1))
1194 (p-url (or (string-match "%u" icalendar-import-format
) -
1))
1195 (p-uid (or (string-match "%U" icalendar-import-format
) -
1))
1196 (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url p-uid
) '<))
1198 pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url pos-uid
)
1199 (dotimes (i (length p-list
))
1200 ;; Use 'ct' to keep track of current position in list
1201 (cond ((and (>= p-cla
0) (= (nth i p-list
) p-cla
))
1203 (setq pos-cla
(* 2 ct
)))
1204 ((and (>= p-des
0) (= (nth i p-list
) p-des
))
1206 (setq pos-des
(* 2 ct
)))
1207 ((and (>= p-loc
0) (= (nth i p-list
) p-loc
))
1209 (setq pos-loc
(* 2 ct
)))
1210 ((and (>= p-org
0) (= (nth i p-list
) p-org
))
1212 (setq pos-org
(* 2 ct
)))
1213 ((and (>= p-sta
0) (= (nth i p-list
) p-sta
))
1215 (setq pos-sta
(* 2 ct
)))
1216 ((and (>= p-sum
0) (= (nth i p-list
) p-sum
))
1218 (setq pos-sum
(* 2 ct
)))
1219 ((and (>= p-url
0) (= (nth i p-list
) p-url
))
1221 (setq pos-url
(* 2 ct
)))
1222 ((and (>= p-uid
0) (= (nth i p-list
) p-uid
))
1224 (setq pos-uid
(* 2 ct
)))) )
1226 (setq s
(icalendar--rris (car ij
) (cadr ij
) s t t
)))
1228 ;; summary must be first! because of %s
1230 (concat "\\(" icalendar-import-format-summary
"\\)??"))
1232 (concat "\\(" icalendar-import-format-class
"\\)??"))
1234 (concat "\\(" icalendar-import-format-description
"\\)??"))
1236 (concat "\\(" icalendar-import-format-location
"\\)??"))
1238 (concat "\\(" icalendar-import-format-organizer
"\\)??"))
1240 (concat "\\(" icalendar-import-format-status
"\\)??"))
1242 (concat "\\(" icalendar-import-format-url
"\\)??"))
1244 (concat "\\(" icalendar-import-format-uid
"\\)??"))))
1245 ;; Need the \' regexp in order to detect multi-line items
1246 (setq s
(concat "\\`"
1247 (icalendar--rris "%s" "\\(.*?\\)" s nil t
)
1249 (if (string-match s summary-and-rest
)
1250 (let (cla des loc org sta sum url uid
)
1251 (if (and pos-sum
(match-beginning pos-sum
))
1252 (setq sum
(substring summary-and-rest
1253 (match-beginning pos-sum
)
1254 (match-end pos-sum
))))
1255 (if (and pos-cla
(match-beginning pos-cla
))
1256 (setq cla
(substring summary-and-rest
1257 (match-beginning pos-cla
)
1258 (match-end pos-cla
))))
1259 (if (and pos-des
(match-beginning pos-des
))
1260 (setq des
(substring summary-and-rest
1261 (match-beginning pos-des
)
1262 (match-end pos-des
))))
1263 (if (and pos-loc
(match-beginning pos-loc
))
1264 (setq loc
(substring summary-and-rest
1265 (match-beginning pos-loc
)
1266 (match-end pos-loc
))))
1267 (if (and pos-org
(match-beginning pos-org
))
1268 (setq org
(substring summary-and-rest
1269 (match-beginning pos-org
)
1270 (match-end pos-org
))))
1271 (if (and pos-sta
(match-beginning pos-sta
))
1272 (setq sta
(substring summary-and-rest
1273 (match-beginning pos-sta
)
1274 (match-end pos-sta
))))
1275 (if (and pos-url
(match-beginning pos-url
))
1276 (setq url
(substring summary-and-rest
1277 (match-beginning pos-url
)
1278 (match-end pos-url
))))
1279 (if (and pos-uid
(match-beginning pos-uid
))
1280 (setq uid
(substring summary-and-rest
1281 (match-beginning pos-uid
)
1282 (match-end pos-uid
))))
1283 (list (if cla
(cons 'cla cla
) nil
)
1284 (if des
(cons 'des des
) nil
)
1285 (if loc
(cons 'loc loc
) nil
)
1286 (if org
(cons 'org org
) nil
)
1287 (if sta
(cons 'sta sta
) nil
)
1288 ;;(if sum (cons 'sum sum) nil)
1289 (if url
(cons 'url url
) nil
)
1290 (if uid
(cons 'uid uid
) nil
))))))))
1292 (defun icalendar--create-ical-alarm (summary)
1293 "Return VALARM blocks for the given SUMMARY."
1294 (when icalendar-export-alarms
1295 (let* ((advance-time (car icalendar-export-alarms
))
1296 (alarm-specs (cadr icalendar-export-alarms
))
1298 (icalendar--do-create-ical-alarm advance-time spec summary
))))
1299 (mapconcat fun alarm-specs
""))))
1301 (defun icalendar--do-create-ical-alarm (advance-time alarm-spec summary
)
1302 "Return a VALARM block.
1303 Argument ADVANCE-TIME is a number giving the time when the alarm
1304 fires (minutes before the respective event). Argument ALARM-SPEC
1305 is a list which must be one of '(audio), '(display) or
1306 '(email (ADDRESS1 ...)), see `icalendar-export-alarms'. Argument
1307 SUMMARY is a string which contains a short description for the
1309 (let* ((action (car alarm-spec
))
1310 (act (format "\nACTION:%s"
1311 (cdr (assoc action
'((audio .
"AUDIO")
1312 (display .
"DISPLAY")
1313 (email .
"EMAIL"))))))
1314 (tri (format "\nTRIGGER:-PT%dM" advance-time
))
1315 (des (if (memq action
'(display email
))
1316 (format "\nDESCRIPTION:%s" summary
)
1318 (sum (if (eq action
'email
)
1319 (format "\nSUMMARY:%s" summary
)
1321 (att (if (eq action
'email
)
1322 (mapconcat (lambda (i)
1323 (format "\nATTENDEE:MAILTO:%s" i
))
1324 (cadr alarm-spec
) "")
1327 (concat "\nBEGIN:VALARM" act tri des sum att
"\nEND:VALARM")))
1329 ;; subroutines for icalendar-export-region
1330 (defun icalendar--convert-ordinary-to-ical (nonmarker entry-main
)
1331 "Convert \"ordinary\" diary entry to iCalendar format.
1332 NONMARKER is a regular expression matching the start of non-marking
1333 entries. ENTRY-MAIN is the first line of the diary entry."
1336 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*" ; date
1337 "\\(\\([0-9][0-9]?\\(:[0-9][0-9]\\)?\\)\\([ap]m\\)?" ; start time
1339 "-\\([0-9][0-9]?\\(:[0-9][0-9]\\)?\\)\\([ap]m\\)?\\)?" ; end time
1341 "\\s-*\\(.*?\\) ?$")
1343 (let* ((datetime (substring entry-main
(match-beginning 1)
1345 (startisostring (icalendar--datestring-to-isodate
1347 (endisostring (icalendar--datestring-to-isodate
1350 (starttimestring (icalendar--diarytime-to-isotime
1351 (if (match-beginning 3)
1352 (substring entry-main
1356 (if (match-beginning 5)
1357 (substring entry-main
1361 (endtimestring (icalendar--diarytime-to-isotime
1362 (if (match-beginning 7)
1363 (substring entry-main
1367 (if (match-beginning 9)
1368 (substring entry-main
1372 (summary (icalendar--convert-string-for-export
1373 (substring entry-main
(match-beginning 10)
1375 (icalendar--dmsg "ordinary %s" entry-main
)
1377 (unless startisostring
1378 (error "Could not parse date"))
1380 ;; If only start-date is specified, then end-date is next day,
1381 ;; otherwise it is same day.
1382 (setq endisostring1
(if starttimestring
1386 (when starttimestring
1387 (unless endtimestring
1389 (read (icalendar--rris "^T0?" ""
1392 ;; Case: ends on same day
1393 (setq endtimestring
(format "T%06d"
1395 ;; Case: ends on next day
1396 (setq endtimestring
(format "T%06d"
1398 (setq endisostring1 endisostring
)) )))
1400 (cons (concat "\nDTSTART;"
1401 (if starttimestring
"VALUE=DATE-TIME:"
1404 (or starttimestring
"")
1406 (if endtimestring
"VALUE=DATE-TIME:"
1409 (or endtimestring
""))
1414 (defun icalendar-first-weekday-of-year (abbrevweekday year
)
1415 "Find the first ABBREVWEEKDAY in a given YEAR.
1416 Returns day number."
1417 (let* ((day-of-week-jan01 (calendar-day-of-week (list 1 1 year
)))
1419 (- (icalendar--get-weekday-number abbrevweekday
)
1420 day-of-week-jan01
))))
1421 (cond ((<= result
0)
1422 (setq result
(+ result
7)))
1424 (setq result
(- result
7))))
1427 (defun icalendar--convert-weekly-to-ical (nonmarker entry-main
)
1428 "Convert weekly diary entry to iCalendar format.
1429 NONMARKER is a regular expression matching the start of non-marking
1430 entries. ENTRY-MAIN is the first line of the diary entry."
1431 (if (and (string-match (concat nonmarker
1433 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)"
1436 "\\([0-9][0-9]?:[0-9][0-9]\\)"
1439 "\\s-*\\(.*?\\) ?$")
1441 (icalendar--get-weekday-abbrev
1442 (substring entry-main
(match-beginning 1)
1444 (let* ((day (icalendar--get-weekday-abbrev
1445 (substring entry-main
(match-beginning 1)
1447 (starttimestring (icalendar--diarytime-to-isotime
1448 (if (match-beginning 3)
1449 (substring entry-main
1453 (if (match-beginning 4)
1454 (substring entry-main
1458 (endtimestring (icalendar--diarytime-to-isotime
1459 (if (match-beginning 6)
1460 (substring entry-main
1464 (if (match-beginning 7)
1465 (substring entry-main
1469 (summary (icalendar--convert-string-for-export
1470 (substring entry-main
(match-beginning 8)
1472 (icalendar--dmsg "weekly %s" entry-main
)
1474 (when starttimestring
1475 (unless endtimestring
1477 (icalendar--rris "^T0?" ""
1479 (setq endtimestring
(format "T%06d"
1481 (cons (concat "\nDTSTART;"
1485 ;; Find the first requested weekday of the
1487 (funcall 'format
"%04d%02d%02d"
1488 icalendar-recurring-start-year
1
1489 (icalendar-first-weekday-of-year
1490 day icalendar-recurring-start-year
))
1491 (or starttimestring
"")
1496 (funcall 'format
"%04d%02d%02d"
1497 ;; end is non-inclusive!
1498 icalendar-recurring-start-year
1
1499 (+ (icalendar-first-weekday-of-year
1500 day icalendar-recurring-start-year
)
1501 (if endtimestring
0 1)))
1502 (or endtimestring
"")
1503 "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY="
1509 (defun icalendar--convert-yearly-to-ical (nonmarker entry-main
)
1510 "Convert yearly diary entry to iCalendar format.
1511 NONMARKER is a regular expression matching the start of non-marking
1512 entries. ENTRY-MAIN is the first line of the diary entry."
1513 (if (string-match (concat nonmarker
1514 (if (eq calendar-date-style
'european
)
1515 "\\([0-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
1516 "\\([a-z]+\\)\\s-+\\([0-9]+[0-9]?\\)\\s-+")
1518 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1520 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1522 "\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years
1525 (let* ((daypos (if (eq calendar-date-style
'european
) 1 2))
1526 (monpos (if (eq calendar-date-style
'european
) 2 1))
1527 (day (read (substring entry-main
1528 (match-beginning daypos
)
1529 (match-end daypos
))))
1530 (month (icalendar--get-month-number
1531 (substring entry-main
1532 (match-beginning monpos
)
1533 (match-end monpos
))))
1534 (starttimestring (icalendar--diarytime-to-isotime
1535 (if (match-beginning 4)
1536 (substring entry-main
1540 (if (match-beginning 5)
1541 (substring entry-main
1545 (endtimestring (icalendar--diarytime-to-isotime
1546 (if (match-beginning 7)
1547 (substring entry-main
1551 (if (match-beginning 8)
1552 (substring entry-main
1556 (summary (icalendar--convert-string-for-export
1557 (substring entry-main
(match-beginning 9)
1559 (icalendar--dmsg "yearly %s" entry-main
)
1561 (when starttimestring
1562 (unless endtimestring
1564 (icalendar--rris "^T0?" ""
1566 (setq endtimestring
(format "T%06d"
1568 (cons (concat "\nDTSTART;"
1569 (if starttimestring
"VALUE=DATE-TIME:"
1571 (format "1900%02d%02d" month day
)
1572 (or starttimestring
"")
1574 (if endtimestring
"VALUE=DATE-TIME:"
1576 ;; end is not included! shift by one day
1577 (icalendar--date-to-isodate
1578 (list month day
1900)
1579 (if endtimestring
0 1))
1580 (or endtimestring
"")
1581 "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
1589 (defun icalendar--convert-sexp-to-ical (nonmarker entry-main
&optional start
)
1590 "Convert sexp diary entry to iCalendar format.
1591 Enumerate the evaluated sexp entry for the next
1592 `icalendar-export-sexp-enumeration-days' days. NONMARKER is a
1593 regular expression matching the start of non-marking entries.
1594 ENTRY-MAIN is the first line of the diary entry.
1596 Optional argument START determines the first day of the
1597 enumeration, given as a time value, in same format as returned by
1598 `current-time' -- used for test purposes."
1599 (cond ((string-match (concat nonmarker
1600 "%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$")
1602 ;; simple sexp entry as generated by icalendar.el: strip off the
1603 ;; unnecessary (and)
1604 (icalendar--dmsg "diary-sexp from icalendar.el %s" entry-main
)
1605 (icalendar--convert-to-ical
1608 (substring entry-main
(match-beginning 1) (match-end 1))
1609 (substring entry-main
(match-beginning 2) (match-end 2)))))
1610 ((string-match (concat nonmarker
1611 "%%\\(([^)]+)\\)\\s-*\\(.*\\)")
1613 ;; regular sexp entry
1614 (icalendar--dmsg "diary-sexp %s" entry-main
)
1615 (let ((p1 (substring entry-main
(match-beginning 1) (match-end 1)))
1616 (p2 (substring entry-main
(match-beginning 2) (match-end 2)))
1617 (now (or start
(current-time))))
1621 (let* ((day (decode-time (time-add now
1623 (* offset
60 60 24)))))
1627 (se (diary-sexp-entry p1 p2
(list m d y
)))
1628 (see (cond ((stringp se
) se
)
1629 ((consp se
) (cdr se
))
1634 (let ((calendar-date-style 'iso
))
1635 (icalendar--convert-ordinary-to-ical
1636 nonmarker
(format "%4d/%02d/%02d %s" y m d see
))))
1638 (error (format "Unsupported Sexp-entry: %s"
1641 0 (- icalendar-export-sexp-enumeration-days
1))))))
1646 (defun icalendar--convert-block-to-ical (nonmarker entry-main
)
1647 "Convert block diary entry to iCalendar format.
1648 NONMARKER is a regular expression matching the start of non-marking
1649 entries. ENTRY-MAIN is the first line of the diary entry."
1650 (if (string-match (concat nonmarker
1651 "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)"
1652 " +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1653 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1655 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1657 "\\s-*\\(.*?\\) ?$")
1659 (let* ((startstring (substring entry-main
1662 (endstring (substring entry-main
1665 (startisostring (icalendar--datestring-to-isodate
1667 (endisostring (icalendar--datestring-to-isodate
1669 (endisostring+1 (icalendar--datestring-to-isodate
1671 (starttimestring (icalendar--diarytime-to-isotime
1672 (if (match-beginning 4)
1673 (substring entry-main
1677 (if (match-beginning 5)
1678 (substring entry-main
1682 (endtimestring (icalendar--diarytime-to-isotime
1683 (if (match-beginning 7)
1684 (substring entry-main
1688 (if (match-beginning 8)
1689 (substring entry-main
1693 (summary (icalendar--convert-string-for-export
1694 (substring entry-main
(match-beginning 9)
1696 (icalendar--dmsg "diary-block %s" entry-main
)
1697 (when starttimestring
1698 (unless endtimestring
1700 (read (icalendar--rris "^T0?" ""
1702 (setq endtimestring
(format "T%06d"
1705 ;; with time -> write rrule
1706 (cons (concat "\nDTSTART;VALUE=DATE-TIME:"
1709 "\nDTEND;VALUE=DATE-TIME:"
1712 "\nRRULE:FREQ=DAILY;INTERVAL=1;UNTIL="
1715 ;; no time -> write long event
1716 (cons (concat "\nDTSTART;VALUE=DATE:" startisostring
1717 "\nDTEND;VALUE=DATE:" endisostring
+1)
1722 (defun icalendar--convert-float-to-ical (nonmarker entry-main
)
1723 "Convert float diary entry to iCalendar format -- partially unsupported!
1725 FIXME! DAY from diary-float yet unimplemented.
1727 NONMARKER is a regular expression matching the start of non-marking
1728 entries. ENTRY-MAIN is the first line of the diary entry."
1729 (if (string-match (concat nonmarker
"%%\\((diary-float .+\\) ?$") entry-main
)
1731 (insert (match-string 1 entry-main
))
1732 (goto-char (point-min))
1733 (let* ((sexp (read (current-buffer))) ;using `read' here
1735 ;matching, esp. with
1738 (month (nth 1 sexp
))
1739 (dayname (nth 2 sexp
))
1743 (replace-regexp-in-string
1744 "\\(^\s+\\|\s+$\\)" ""
1745 (buffer-substring (point) (point-max)))))
1749 (icalendar--dmsg "diary-float %s" entry-main
)
1750 (error "Don't know if or how to implement day in `diary-float'")))
1753 ;;Start today (yes this is an arbitrary choice):
1754 "\nDTSTART;VALUE=DATE:"
1755 (format-time-string "%Y%m%d")
1756 ;;BUT remove today if `diary-float'
1757 ;;expression does not hold true for today:
1759 (null (let ((date (calendar-current-date))
1761 (diary-float month dayname n
)))
1763 "\nEXDATE;VALUE=DATE:"
1764 (format-time-string "%Y%m%d")))
1766 (if (or (numberp month
) (listp month
))
1767 "FREQ=YEARLY;BYMONTH="
1773 (number-to-string m
))
1777 (number-to-string month
))
1779 (number-to-string n
)
1780 (aref icalendar--weekday-array dayname
))
1785 (defun icalendar--convert-date-to-ical (nonmarker entry-main
)
1786 "Convert `diary-date' diary entry to iCalendar format -- unsupported!
1790 NONMARKER is a regular expression matching the start of non-marking
1791 entries. ENTRY-MAIN is the first line of the diary entry."
1792 (if (string-match (concat nonmarker
1793 "%%(diary-date \\([^)]+\\))\\s-*\\(.*?\\) ?$")
1796 (icalendar--dmsg "diary-date %s" entry-main
)
1797 (error "`diary-date' is not supported yet"))
1801 (defun icalendar--convert-cyclic-to-ical (nonmarker entry-main
)
1802 "Convert `diary-cyclic' diary entry to iCalendar format.
1803 NONMARKER is a regular expression matching the start of non-marking
1804 entries. ENTRY-MAIN is the first line of the diary entry."
1805 (if (string-match (concat nonmarker
1806 "%%(diary-cyclic \\([^ ]+\\) +"
1807 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1808 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1810 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1812 "\\s-*\\(.*?\\) ?$")
1814 (let* ((frequency (substring entry-main
(match-beginning 1)
1816 (datetime (substring entry-main
(match-beginning 2)
1818 (startisostring (icalendar--datestring-to-isodate
1820 (endisostring (icalendar--datestring-to-isodate
1822 (endisostring+1 (icalendar--datestring-to-isodate
1824 (starttimestring (icalendar--diarytime-to-isotime
1825 (if (match-beginning 4)
1826 (substring entry-main
1830 (if (match-beginning 5)
1831 (substring entry-main
1835 (endtimestring (icalendar--diarytime-to-isotime
1836 (if (match-beginning 7)
1837 (substring entry-main
1841 (if (match-beginning 8)
1842 (substring entry-main
1846 (summary (icalendar--convert-string-for-export
1847 (substring entry-main
(match-beginning 9)
1849 (icalendar--dmsg "diary-cyclic %s" entry-main
)
1850 (when starttimestring
1851 (unless endtimestring
1853 (read (icalendar--rris "^T0?" ""
1855 (setq endtimestring
(format "T%06d"
1857 (cons (concat "\nDTSTART;"
1858 (if starttimestring
"VALUE=DATE-TIME:"
1861 (or starttimestring
"")
1863 (if endtimestring
"VALUE=DATE-TIME:"
1865 (if endtimestring endisostring endisostring
+1)
1866 (or endtimestring
"")
1867 "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
1868 ;; strange: korganizer does not expect
1869 ;; BYSOMETHING here...
1875 (defun icalendar--convert-anniversary-to-ical (nonmarker entry-main
)
1876 "Convert `diary-anniversary' diary entry to iCalendar format.
1877 NONMARKER is a regular expression matching the start of non-marking
1878 entries. ENTRY-MAIN is the first line of the diary entry."
1879 (if (string-match (concat nonmarker
1880 "%%(diary-anniversary \\([^)]+\\))\\s-*"
1881 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1883 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1885 "\\s-*\\(.*?\\) ?$")
1887 (let* ((datetime (substring entry-main
(match-beginning 1)
1889 (startisostring (icalendar--datestring-to-isodate
1891 (endisostring (icalendar--datestring-to-isodate
1893 (starttimestring (icalendar--diarytime-to-isotime
1894 (if (match-beginning 3)
1895 (substring entry-main
1899 (if (match-beginning 4)
1900 (substring entry-main
1904 (endtimestring (icalendar--diarytime-to-isotime
1905 (if (match-beginning 6)
1906 (substring entry-main
1910 (if (match-beginning 7)
1911 (substring entry-main
1915 (summary (icalendar--convert-string-for-export
1916 (substring entry-main
(match-beginning 8)
1918 (icalendar--dmsg "diary-anniversary %s" entry-main
)
1919 (when starttimestring
1920 (unless endtimestring
1922 (read (icalendar--rris "^T0?" ""
1924 (setq endtimestring
(format "T%06d"
1926 (cons (concat "\nDTSTART;"
1927 (if starttimestring
"VALUE=DATE-TIME:"
1930 (or starttimestring
"")
1932 (if endtimestring
"VALUE=DATE-TIME:"
1935 (or endtimestring
"")
1936 "\nRRULE:FREQ=YEARLY;INTERVAL=1"
1937 ;; the following is redundant,
1938 ;; but korganizer seems to expect this... ;(
1939 ;; and evolution doesn't understand it... :(
1940 ;; so... who is wrong?!
1942 (substring startisostring
4 6)
1944 (substring startisostring
6 8))
1949 ;; ======================================================================
1950 ;; Import -- convert iCalendar to emacs-diary
1951 ;; ======================================================================
1954 (defun icalendar-import-file (ical-filename diary-filename
1955 &optional non-marking
)
1956 "Import an iCalendar file and append to a diary file.
1957 Argument ICAL-FILENAME output iCalendar file.
1958 Argument DIARY-FILENAME input `diary-file'.
1959 Optional argument NON-MARKING determines whether events are created as
1960 non-marking or not."
1961 (interactive "fImport iCalendar data from file: \n\
1964 ;; clean up the diary file
1965 (save-current-buffer
1966 ;; now load and convert from the ical file
1967 (set-buffer (find-file ical-filename
))
1968 (icalendar-import-buffer diary-filename t non-marking
)))
1971 (defun icalendar-import-buffer (&optional diary-file do-not-ask
1973 "Extract iCalendar events from current buffer.
1975 This function searches the current buffer for the first iCalendar
1976 object, reads it and adds all VEVENT elements to the diary
1979 It will ask for each appointment whether to add it to the diary
1980 unless DO-NOT-ASK is non-nil. When called interactively,
1981 DO-NOT-ASK is nil, so that you are asked for each event.
1983 NON-MARKING determines whether diary events are created as
1986 Return code t means that importing worked well, return code nil
1987 means that an error has occurred. Error messages will be in the
1988 buffer `*icalendar-errors*'."
1990 (save-current-buffer
1992 (message "Preparing iCalendar...")
1993 (set-buffer (icalendar--get-unfolded-buffer (current-buffer)))
1994 (goto-char (point-min))
1995 (message "Preparing iCalendar...done")
1996 (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t
)
1997 (let (ical-contents ical-errors
)
1999 (message "Reading iCalendar...")
2001 (setq ical-contents
(icalendar--read-element nil nil
))
2002 (message "Reading iCalendar...done")
2004 (message "Converting iCalendar...")
2005 (setq ical-errors
(icalendar--convert-ical-to-diary
2007 diary-file do-not-ask non-marking
))
2009 ;; save the diary file if it is visited already
2010 (let ((b (find-buffer-visiting diary-file
)))
2012 (save-current-buffer
2015 (message "Converting iCalendar...done")
2016 ;; return t if no error occurred
2019 "Current buffer does not contain iCalendar contents!")
2020 ;; return nil, i.e. import did not work
2023 (define-obsolete-function-alias 'icalendar-extract-ical-from-buffer
2024 'icalendar-import-buffer
"22.1")
2026 (defun icalendar--format-ical-event (event)
2027 "Create a string representation of an iCalendar EVENT."
2028 (if (functionp icalendar-import-format
)
2029 (funcall icalendar-import-format event
)
2030 (let ((string icalendar-import-format
)
2031 (case-fold-search nil
)
2033 '(("%c" CLASS icalendar-import-format-class
)
2034 ("%d" DESCRIPTION icalendar-import-format-description
)
2035 ("%l" LOCATION icalendar-import-format-location
)
2036 ("%o" ORGANIZER icalendar-import-format-organizer
)
2037 ("%s" SUMMARY icalendar-import-format-summary
)
2038 ("%t" STATUS icalendar-import-format-status
)
2039 ("%u" URL icalendar-import-format-url
)
2040 ("%U" UID icalendar-import-format-uid
))))
2041 ;; convert the specifiers in the format string
2043 (let* ((spec (car i
))
2045 (format (car (cddr i
)))
2046 (contents (icalendar--get-event-property event prop
))
2047 (formatted-contents ""))
2048 (when (and contents
(> (length contents
) 0))
2049 (setq formatted-contents
2050 (icalendar--rris "%s"
2051 (icalendar--convert-string-for-import
2053 (symbol-value format
)
2055 (setq string
(icalendar--rris spec
2062 (defun icalendar--convert-ical-to-diary (ical-list diary-file
2063 &optional do-not-ask
2065 "Convert iCalendar data to an Emacs diary file.
2066 Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
2067 DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event
2068 whether to actually import it. NON-MARKING determines whether diary
2069 events are created as non-marking.
2070 This function attempts to return t if something goes wrong. In this
2071 case an error string which describes all the errors and problems is
2072 written into the buffer `*icalendar-errors*'."
2073 (let* ((ev (icalendar--all-events ical-list
))
2077 (zone-map (icalendar--convert-all-timezones ical-list
))
2079 ;; step through all events/appointments
2084 (condition-case error-val
2085 (let* ((dtstart (icalendar--get-event-property e
'DTSTART
))
2086 (dtstart-zone (icalendar--find-time-zone
2087 (icalendar--get-event-property-attributes
2090 (dtstart-dec (icalendar--decode-isodatetime dtstart nil
2092 (start-d (icalendar--datetime-to-diary-date
2094 (start-t (icalendar--datetime-to-colontime dtstart-dec
))
2095 (dtend (icalendar--get-event-property e
'DTEND
))
2096 (dtend-zone (icalendar--find-time-zone
2097 (icalendar--get-event-property-attributes
2100 (dtend-dec (icalendar--decode-isodatetime dtend
2102 (dtend-1-dec (icalendar--decode-isodatetime dtend -
1
2107 (summary (icalendar--convert-string-for-import
2108 (or (icalendar--get-event-property e
'SUMMARY
)
2110 (rrule (icalendar--get-event-property e
'RRULE
))
2111 (rdate (icalendar--get-event-property e
'RDATE
))
2112 (duration (icalendar--get-event-property e
'DURATION
)))
2113 (icalendar--dmsg "%s: `%s'" start-d summary
)
2114 ;; check whether start-time is missing
2117 (cadr (icalendar--get-event-property-attributes
2122 (let ((dtend-dec-d (icalendar--add-decoded-times
2124 (icalendar--decode-isoduration duration
)))
2125 (dtend-1-dec-d (icalendar--add-decoded-times
2127 (icalendar--decode-isoduration duration
2129 (if (and dtend-dec
(not (eq dtend-dec dtend-dec-d
)))
2130 (message "Inconsistent endtime and duration for %s"
2132 (setq dtend-dec dtend-dec-d
)
2133 (setq dtend-1-dec dtend-1-dec-d
)))
2134 (setq end-d
(if dtend-dec
2135 (icalendar--datetime-to-diary-date dtend-dec
)
2137 (setq end-1-d
(if dtend-1-dec
2138 (icalendar--datetime-to-diary-date dtend-1-dec
)
2140 (setq end-t
(if (and
2144 (icalendar--get-event-property-attributes
2147 (icalendar--datetime-to-colontime dtend-dec
)
2149 (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d
)
2154 (icalendar--convert-recurring-to-diary e dtstart-dec start-t
2158 (icalendar--dmsg "rdate event")
2159 (setq diary-string
"")
2160 (mapc (lambda (datestring)
2162 (concat diary-string
2163 (format "......"))))
2164 (icalendar--split-value rdate
)))
2165 ;; non-recurring event
2167 ((not (string= start-d end-d
))
2169 (icalendar--convert-non-recurring-all-day-to-diary
2173 ((and start-t
(or (not end-t
)
2174 (not (string= start-t end-t
))))
2176 (icalendar--convert-non-recurring-not-all-day-to-diary
2177 e dtstart-dec dtend-dec start-t end-t
))
2181 (icalendar--dmsg "all day event")
2182 (setq diary-string
(icalendar--datetime-to-diary-date
2185 ;; add all other elements unless the user doesn't want to have
2190 (concat diary-string
" "
2191 (icalendar--format-ical-event e
)))
2192 (if do-not-ask
(setq summary nil
))
2193 ;; add entry to diary and store actual name of diary
2194 ;; file (in case it was nil)
2196 (icalendar--add-diary-entry diary-string diary-file
2197 non-marking summary
)))
2199 (setq found-error t
)
2201 (format "%s\nCannot handle this event:%s"
2203 ;; FIXME: inform user about ignored event properties
2206 (message "Ignoring event \"%s\"" e
)
2207 (setq found-error t
)
2208 (setq error-string
(format "%s\n%s\nCannot handle this event: %s"
2209 error-val error-string e
))
2210 (message "%s" error-string
))))
2212 ;; insert final newline
2214 (let ((b (find-buffer-visiting diary-file
)))
2216 (save-current-buffer
2218 (goto-char (point-max))
2221 (save-current-buffer
2222 (set-buffer (get-buffer-create "*icalendar-errors*"))
2224 (insert error-string
)))
2225 (message "Converting iCalendar...done")
2228 ;; subroutines for importing
2229 (defun icalendar--convert-recurring-to-diary (e dtstart-dec start-t end-t
)
2230 "Convert recurring iCalendar event E to diary format.
2232 DTSTART-DEC is the DTSTART property of E.
2233 START-T is the event's start time in diary format.
2234 END-T is the event's end time in diary format."
2235 (icalendar--dmsg "recurring event")
2236 (let* ((rrule (icalendar--get-event-property e
'RRULE
))
2237 (rrule-props (icalendar--split-value rrule
))
2238 (frequency (cadr (assoc 'FREQ rrule-props
)))
2239 (until (cadr (assoc 'UNTIL rrule-props
)))
2240 (count (cadr (assoc 'COUNT rrule-props
)))
2241 (interval (read (or (cadr (assoc 'INTERVAL rrule-props
)) "1")))
2242 (dtstart-conv (icalendar--datetime-to-diary-date dtstart-dec
))
2243 (until-conv (icalendar--datetime-to-diary-date
2244 (icalendar--decode-isodatetime until
)))
2245 (until-1-conv (icalendar--datetime-to-diary-date
2246 (icalendar--decode-isodatetime until -
1)))
2249 ;; FIXME FIXME interval!!!!!!!!!!!!!
2253 (message "Must not have UNTIL and COUNT -- ignoring COUNT element!")
2255 (cond ((string-equal frequency
"DAILY")
2256 (setq until
(icalendar--add-decoded-times
2258 (list 0 0 0 (* (read count
) interval
) 0 0)))
2259 (setq until-1
(icalendar--add-decoded-times
2261 (list 0 0 0 (* (- (read count
) 1) interval
)
2264 ((string-equal frequency
"WEEKLY")
2265 (setq until
(icalendar--add-decoded-times
2267 (list 0 0 0 (* (read count
) 7 interval
) 0 0)))
2268 (setq until-1
(icalendar--add-decoded-times
2270 (list 0 0 0 (* (- (read count
) 1) 7
2273 ((string-equal frequency
"MONTHLY")
2274 (setq until
(icalendar--add-decoded-times
2275 dtstart-dec
(list 0 0 0 0 (* (- (read count
) 1)
2277 (setq until-1
(icalendar--add-decoded-times
2278 dtstart-dec
(list 0 0 0 0 (* (- (read count
) 1)
2281 ((string-equal frequency
"YEARLY")
2282 (setq until
(icalendar--add-decoded-times
2283 dtstart-dec
(list 0 0 0 0 0 (* (- (read count
) 1)
2285 (setq until-1
(icalendar--add-decoded-times
2287 (list 0 0 0 0 0 (* (- (read count
) 1)
2291 (message "Cannot handle COUNT attribute for `%s' events."
2293 (setq until-conv
(icalendar--datetime-to-diary-date until
))
2294 (setq until-1-conv
(icalendar--datetime-to-diary-date until-1
))
2297 (cond ((string-equal frequency
"WEEKLY")
2298 (let* ((byday (cadr (assoc 'BYDAY rrule-props
)))
2300 (icalendar--get-weekday-numbers byday
))
2302 (when (> (length weekdays
) 1)
2303 (format "(memq (calendar-day-of-week date) '%s) "
2307 ;; weekly and all-day
2308 (icalendar--dmsg "weekly all-day")
2314 "(diary-block %s %s))")
2316 (format "(diary-cyclic %d %s) "
2320 (if count until-1-conv until-conv
)
2323 (format "%%%%(and %s(diary-cyclic %d %s))"
2324 (or weekday-clause
"")
2325 (if weekday-clause
1 (* interval
7))
2327 ;; weekly and not all-day
2328 (icalendar--dmsg "weekly not-all-day")
2334 "(diary-block %s %s)) "
2337 (format "(diary-cyclic %d %s) "
2343 (if end-t
"-" "") (or end-t
"")))
2346 ;; DTSTART;VALUE=DATE-TIME:20030919T090000
2347 ;; DTEND;VALUE=DATE-TIME:20030919T113000
2350 "%%%%(and %s(diary-cyclic %d %s)) %s%s%s"
2351 (or weekday-clause
"")
2352 (if weekday-clause
1 (* interval
7))
2355 (if end-t
"-" "") (or end-t
"")))))))
2357 ((string-equal frequency
"YEARLY")
2358 (icalendar--dmsg "yearly")
2360 (let ((day (nth 3 dtstart-dec
))
2361 (month (nth 4 dtstart-dec
)))
2362 (setq result
(concat "%%(and (diary-date "
2363 (cond ((eq calendar-date-style
'iso
)
2364 (format "t %d %d" month day
))
2365 ((eq calendar-date-style
'european
)
2366 (format "%d %d t" day month
))
2367 ((eq calendar-date-style
'american
)
2368 (format "%d %d t" month day
)))
2377 (setq result
(format
2378 "%%%%(and (diary-anniversary %s)) %s%s%s"
2381 (if end-t
"-" "") (or end-t
"")))))
2383 ((string-equal frequency
"MONTHLY")
2384 (icalendar--dmsg "monthly")
2387 "%%%%(and (diary-date %s) (diary-block %s %s)) %s%s%s"
2388 (let ((day (nth 3 dtstart-dec
)))
2389 (cond ((eq calendar-date-style
'iso
)
2390 (format "t t %d" day
))
2391 ((eq calendar-date-style
'european
)
2392 (format "%d t t" day
))
2393 ((eq calendar-date-style
'american
)
2394 (format "t %d t" day
))))
2398 (if (eq calendar-date-style
'iso
) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited
2400 (if end-t
"-" "") (or end-t
""))))
2402 ((and (string-equal frequency
"DAILY"))
2406 (concat "%%%%(and (diary-cyclic %s %s) "
2407 "(diary-block %s %s)) %s%s%s")
2408 interval dtstart-conv dtstart-conv
2409 (if count until-1-conv until-conv
)
2411 (if end-t
"-" "") (or end-t
"")))
2414 "%%%%(and (diary-cyclic %s %s)) %s%s%s"
2418 (if end-t
"-" "") (or end-t
""))))))
2419 ;; Handle exceptions from recurrence rules
2420 (let ((ex-dates (icalendar--get-event-properties e
'EXDATE
)))
2422 (let* ((ex-start (icalendar--decode-isodatetime
2424 (ex-d (icalendar--datetime-to-diary-date
2427 (icalendar--rris "^%%(\\(and \\)?"
2429 "%%%%(and (not (diary-date %s)) "
2432 (setq ex-dates
(cdr ex-dates
))))
2433 ;; FIXME: exception rules are not recognized
2434 (if (icalendar--get-event-property e
'EXRULE
)
2437 "\n Exception rules: "
2438 (icalendar--get-event-properties
2442 (defun icalendar--convert-non-recurring-all-day-to-diary (event start-d end-d
)
2443 "Convert non-recurring iCalendar EVENT to diary format.
2445 DTSTART is the decoded DTSTART property of E.
2446 Argument START-D gives the first day.
2447 Argument END-D gives the last day."
2448 (icalendar--dmsg "non-recurring all-day event")
2449 (format "%%%%(and (diary-block %s %s))" start-d end-d
))
2451 (defun icalendar--convert-non-recurring-not-all-day-to-diary (event dtstart-dec
2455 "Convert recurring icalendar EVENT to diary format.
2457 DTSTART-DEC is the decoded DTSTART property of E.
2458 DTEND-DEC is the decoded DTEND property of E.
2459 START-T is the event's start time in diary format.
2460 END-T is the event's end time in diary format."
2461 (icalendar--dmsg "not all day event")
2464 (icalendar--datetime-to-diary-date
2469 (icalendar--datetime-to-diary-date
2473 (defun icalendar--add-diary-entry (string diary-file non-marking
2475 "Add STRING to the diary file DIARY-FILE.
2476 STRING must be a properly formatted valid diary entry. NON-MARKING
2477 determines whether diary events are created as non-marking. If
2478 SUMMARY is not nil it must be a string that gives the summary of the
2479 entry. In this case the user will be asked whether he wants to insert
2481 (when (or (not summary
)
2482 (y-or-n-p (format "Add appointment for `%s' to diary? "
2486 (y-or-n-p (format "Make appointment non-marking? "))))
2487 (save-window-excursion
2490 (read-file-name "Add appointment to this diary file: ")))
2491 ;; Note: diary-make-entry will add a trailing blank char.... :(
2492 (funcall (if (fboundp 'diary-make-entry
)
2495 string non-marking diary-file
)))
2496 ;; Würgaround to remove the trailing blank char
2497 (with-current-buffer (find-file diary-file
)
2498 (goto-char (point-max))
2499 (if (= (char-before) ?
)
2501 ;; return diary-file in case it has been changed interactively
2504 ;; ======================================================================
2506 ;; ======================================================================
2507 (defun icalendar-import-format-sample (event)
2508 "Example function for formatting an iCalendar EVENT."
2509 (format (concat "SUMMARY=`%s' DESCRIPTION=`%s' LOCATION=`%s' ORGANIZER=`%s' "
2510 "STATUS=`%s' URL=`%s' CLASS=`%s'")
2511 (or (icalendar--get-event-property event
'SUMMARY
) "")
2512 (or (icalendar--get-event-property event
'DESCRIPTION
) "")
2513 (or (icalendar--get-event-property event
'LOCATION
) "")
2514 (or (icalendar--get-event-property event
'ORGANIZER
) "")
2515 (or (icalendar--get-event-property event
'STATUS
) "")
2516 (or (icalendar--get-event-property event
'URL
) "")
2517 (or (icalendar--get-event-property event
'CLASS
) "")))
2519 (provide 'icalendar
)
2521 ;;; icalendar.el ends here