* xdisp.c (get_next_display_element): When handling wrap-prefix
[emacs.git] / lisp / calendar / icalendar.el
blobfe3b9771973993eef3b154a74912a8b06db4c379
1 ;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
4 ;; Free Software Foundation, Inc.
6 ;; Author: Ulf Jasper <ulf.jasper@web.de>
7 ;; Created: August 2002
8 ;; Keywords: calendar
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/>.
26 ;;; Commentary:
28 ;; This package is documented in the Emacs Manual.
30 ;; Please note:
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.
38 ;;; History:
40 ;; 0.07 onwards: see lisp/ChangeLog
42 ;; 0.06: (2004-10-06)
43 ;; - Bugfixes regarding icalendar-import-format-*.
44 ;; - Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau.
46 ;; 0.05: (2003-06-19)
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
55 ;; 0.04:
56 ;; - Bugfix: import: double quoted param values did not work
57 ;; - Read DURATION property when importing.
58 ;; - Added parameter icalendar-duration-correction.
60 ;; 0.03: (2003-05-07)
61 ;; - Export takes care of european-calendar-style.
62 ;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12
64 ;; 0.02:
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
70 ;; 0.01: (2003-03-21)
71 ;; - First published version. Trial version. Alpha version.
73 ;; ======================================================================
74 ;; To Do:
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?
86 ;; + alarm
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
95 ;; understood
97 ;; * Other things
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?
104 ;;; Code:
106 (defconst icalendar-version "0.19"
107 "Version number of icalendar.el.")
109 ;; ======================================================================
110 ;; Customizables
111 ;; ======================================================================
112 (defgroup icalendar nil
113 "Icalendar support."
114 :prefix "icalendar-"
115 :group 'calendar)
117 (defcustom icalendar-import-format
118 "%s%d%l%o"
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."
135 :type '(choice
136 (string :tag "String")
137 (function :tag "Function"))
138 :group 'icalendar)
140 (defcustom icalendar-import-format-summary
141 "%s"
142 "Format string defining how the summary element is formatted.
143 This applies only if the summary is not empty! `%s' is replaced
144 by the summary."
145 :type 'string
146 :group 'icalendar)
148 (defcustom icalendar-import-format-description
149 "\n Desc: %s"
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."
153 :type 'string
154 :group 'icalendar)
156 (defcustom icalendar-import-format-location
157 "\n Location: %s"
158 "Format string defining how the location element is formatted.
159 This applies only if the location is not empty! `%s' is replaced
160 by the location."
161 :type 'string
162 :group 'icalendar)
164 (defcustom icalendar-import-format-organizer
165 "\n Organizer: %s"
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."
169 :type 'string
170 :group 'icalendar)
172 (defcustom icalendar-import-format-url
173 "\n URL: %s"
174 "Format string defining how the URL element is formatted.
175 This applies only if the URL is not empty! `%s' is replaced by
176 the URL."
177 :type 'string
178 :group 'icalendar)
180 (defcustom icalendar-import-format-status
181 "\n Status: %s"
182 "Format string defining how the status element is formatted.
183 This applies only if the status is not empty! `%s' is replaced by
184 the status."
185 :type 'string
186 :group 'icalendar)
188 (defcustom icalendar-import-format-class
189 "\n Class: %s"
190 "Format string defining how the class element is formatted.
191 This applies only if the class is not empty! `%s' is replaced by
192 the class."
193 :type 'string
194 :group 'icalendar)
196 (defcustom icalendar-recurring-start-year
197 2005
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."
202 :type 'integer
203 :group 'icalendar)
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."
210 :type 'boolean
211 :group 'icalendar)
213 (defcustom icalendar-uid-format
214 "emacs%t%c"
215 "Format of unique ID code (UID) for each iCalendar object.
216 The following specifiers are available:
217 %c COUNTER, an integer value that is increased each time a uid is
218 generated. This may be necessary for systems which do not
219 provide time-resolution finer than a second.
220 %h HASH, a hash value of the diary entry,
221 %s DTSTART, the start date (excluding time) of the diary entry,
222 %t TIMESTAMP, a unique creation timestamp,
223 %u USERNAME, the user-login-name.
225 For example, a value of \"%s_%h@mydomain.com\" will generate a
226 UID code for each entry composed of the time of the event, a hash
227 code for the event, and your personal domain name."
228 :type 'string
229 :group 'icalendar)
231 (defvar icalendar-debug nil
232 "Enable icalendar debug messages.")
234 ;; ======================================================================
235 ;; NO USER SERVICABLE PARTS BELOW THIS LINE
236 ;; ======================================================================
238 (defconst icalendar--weekday-array ["SU" "MO" "TU" "WE" "TH" "FR" "SA"])
240 ;; ======================================================================
241 ;; all the other libs we need
242 ;; ======================================================================
243 (require 'calendar)
245 ;; ======================================================================
246 ;; misc
247 ;; ======================================================================
248 (defun icalendar--dmsg (&rest args)
249 "Print message ARGS if `icalendar-debug' is non-nil."
250 (if icalendar-debug
251 (apply 'message args)))
253 ;; ======================================================================
254 ;; Core functionality
255 ;; Functions for parsing icalendars, importing and so on
256 ;; ======================================================================
258 (defun icalendar--get-unfolded-buffer (folded-ical-buffer)
259 "Return a new buffer containing the unfolded contents of a buffer.
260 Folding is the iCalendar way of wrapping long lines. In the
261 created buffer all occurrences of CR LF BLANK are replaced by the
262 empty string. Argument FOLDED-ICAL-BUFFER is the unfolded input
263 buffer."
264 (let ((unfolded-buffer (get-buffer-create " *icalendar-work*")))
265 (save-current-buffer
266 (set-buffer unfolded-buffer)
267 (erase-buffer)
268 (insert-buffer-substring folded-ical-buffer)
269 (goto-char (point-min))
270 (while (re-search-forward "\r?\n[ \t]" nil t)
271 (replace-match "" nil nil)))
272 unfolded-buffer))
274 (defsubst icalendar--rris (regexp rep string &optional fixedcase literal)
275 "Replace regular expression in string.
276 Pass arguments REGEXP REP STRING FIXEDCASE LITERAL to
277 `replace-regexp-in-string' (Emacs) or to `replace-in-string' (XEmacs)."
278 (cond ((fboundp 'replace-regexp-in-string)
279 ;; Emacs:
280 (replace-regexp-in-string regexp rep string fixedcase literal))
281 ((fboundp 'replace-in-string)
282 ;; XEmacs:
283 (save-match-data ;; apparently XEmacs needs save-match-data
284 (replace-in-string string regexp rep literal)))))
286 (defun icalendar--read-element (invalue inparams)
287 "Recursively read the next iCalendar element in the current buffer.
288 INVALUE gives the current iCalendar element we are reading.
289 INPARAMS gives the current parameters.....
290 This function calls itself recursively for each nested calendar element
291 it finds."
292 (let (element children line name params param param-name param-value
293 value
294 (continue t))
295 (setq children '())
296 (while (and continue
297 (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t))
298 (setq name (intern (match-string 1)))
299 (backward-char 1)
300 (setq params '())
301 (setq line '())
302 (while (looking-at ";")
303 (re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil)
304 (setq param-name (intern (match-string 1)))
305 (re-search-forward "\\(\\([^;,:\"]+\\)\\|\"\\([^\"]+\\)\"\\)[;:]"
306 nil t)
307 (backward-char 1)
308 (setq param-value (or (match-string 2) (match-string 3)))
309 (setq param (list param-name param-value))
310 (while (looking-at ",")
311 (re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)"
312 nil t)
313 (if (match-string 2)
314 (setq param-value (match-string 2))
315 (setq param-value (match-string 3)))
316 (setq param (append param param-value)))
317 (setq params (append params param)))
318 (unless (looking-at ":")
319 (error "Oops"))
320 (forward-char 1)
321 (re-search-forward "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t)
322 (setq value (icalendar--rris "\r?\n[ \t]" "" (match-string 0)))
323 (setq line (list name params value))
324 (cond ((eq name 'BEGIN)
325 (setq children
326 (append children
327 (list (icalendar--read-element (intern value)
328 params)))))
329 ((eq name 'END)
330 (setq continue nil))
332 (setq element (append element (list line))))))
333 (if invalue
334 (list invalue inparams element children)
335 children)))
337 ;; ======================================================================
338 ;; helper functions for examining events
339 ;; ======================================================================
341 ;;(defsubst icalendar--get-all-event-properties (event)
342 ;; "Return the list of properties in this EVENT."
343 ;; (car (cddr event)))
345 (defun icalendar--get-event-property (event prop)
346 "For the given EVENT return the value of the first occurrence of PROP."
347 (catch 'found
348 (let ((props (car (cddr event))) pp)
349 (while props
350 (setq pp (car props))
351 (if (eq (car pp) prop)
352 (throw 'found (car (cddr pp))))
353 (setq props (cdr props))))
354 nil))
356 (defun icalendar--get-event-property-attributes (event prop)
357 "For the given EVENT return attributes of the first occurrence of PROP."
358 (catch 'found
359 (let ((props (car (cddr event))) pp)
360 (while props
361 (setq pp (car props))
362 (if (eq (car pp) prop)
363 (throw 'found (cadr pp)))
364 (setq props (cdr props))))
365 nil))
367 (defun icalendar--get-event-properties (event prop)
368 "For the given EVENT return a list of all values of the property PROP."
369 (let ((props (car (cddr event))) pp result)
370 (while props
371 (setq pp (car props))
372 (if (eq (car pp) prop)
373 (setq result (append (split-string (car (cddr pp)) ",") result)))
374 (setq props (cdr props)))
375 result))
377 ;; (defun icalendar--set-event-property (event prop new-value)
378 ;; "For the given EVENT set the property PROP to the value NEW-VALUE."
379 ;; (catch 'found
380 ;; (let ((props (car (cddr event))) pp)
381 ;; (while props
382 ;; (setq pp (car props))
383 ;; (when (eq (car pp) prop)
384 ;; (setcdr (cdr pp) new-value)
385 ;; (throw 'found (car (cddr pp))))
386 ;; (setq props (cdr props)))
387 ;; (setq props (car (cddr event)))
388 ;; (setcar (cddr event)
389 ;; (append props (list (list prop nil new-value)))))))
391 (defun icalendar--get-children (node name)
392 "Return all children of the given NODE which have a name NAME.
393 For instance the VCALENDAR node can have VEVENT children as well as VTODO
394 children."
395 (let ((result nil)
396 (children (cadr (cddr node))))
397 (when (eq (car node) name)
398 (setq result node))
399 ;;(message "%s" node)
400 (when children
401 (let ((subresult
402 (delq nil
403 (mapcar (lambda (n)
404 (icalendar--get-children n name))
405 children))))
406 (if subresult
407 (if result
408 (setq result (append result subresult))
409 (setq result subresult)))))
410 result))
412 ; private
413 (defun icalendar--all-events (icalendar)
414 "Return the list of all existing events in the given ICALENDAR."
415 (icalendar--get-children (car icalendar) 'VEVENT))
417 (defun icalendar--split-value (value-string)
418 "Split VALUE-STRING at ';='."
419 (let ((result '())
420 param-name param-value)
421 (when value-string
422 (save-current-buffer
423 (set-buffer (get-buffer-create " *icalendar-work*"))
424 (set-buffer-modified-p nil)
425 (erase-buffer)
426 (insert value-string)
427 (goto-char (point-min))
428 (while
429 (re-search-forward
430 "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
431 nil t)
432 (setq param-name (intern (match-string 1)))
433 (setq param-value (match-string 2))
434 (setq result
435 (append result (list (list param-name param-value)))))))
436 result))
438 (defun icalendar--convert-tz-offset (alist dst-p)
439 "Return a cons of two strings representing a timezone start.
440 ALIST is an alist entry from a VTIMEZONE, like STANDARD.
441 DST-P is non-nil if this is for daylight savings time.
442 The strings are suitable for assembling into a TZ variable."
443 (let ((offset (car (cddr (assq 'TZOFFSETTO alist))))
444 (rrule-value (car (cddr (assq 'RRULE alist))))
445 (dtstart (car (cddr (assq 'DTSTART alist)))))
446 ;; FIXME: for now we only handle RRULE and not RDATE here.
447 (when (and offset rrule-value dtstart)
448 (let* ((rrule (icalendar--split-value rrule-value))
449 (freq (cadr (assq 'FREQ rrule)))
450 (bymonth (cadr (assq 'BYMONTH rrule)))
451 (byday (cadr (assq 'BYDAY rrule))))
452 ;; FIXME: we don't correctly handle WKST here.
453 (if (and (string= freq "YEARLY") bymonth)
454 (cons
455 (concat
456 ;; Fake a name.
457 (if dst-p "(DST?)" "(STD?)")
458 ;; For TZ, OFFSET is added to the local time. So,
459 ;; invert the values.
460 (if (eq (aref offset 0) ?-) "+" "-")
461 (substring offset 1 3)
463 (substring offset 3 5))
464 ;; The start time.
465 (let* ((day (icalendar--get-weekday-number (substring byday -2)))
466 (week (if (eq day -1)
467 byday
468 (substring byday 0 -2))))
469 (concat "M" bymonth "." week "." (if (eq day -1) "0"
470 (int-to-string day))
471 ;; Start time.
473 (substring dtstart -6 -4)
475 (substring dtstart -4 -2)
477 (substring dtstart -2)))))))))
479 (defun icalendar--parse-vtimezone (alist)
480 "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
481 Return nil if timezone cannot be parsed."
482 (let* ((tz-id (icalendar--get-event-property alist 'TZID))
483 (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT))))
484 (day (and daylight (icalendar--convert-tz-offset daylight t)))
485 (standard (cadr (cdar (icalendar--get-children alist 'STANDARD))))
486 (std (and standard (icalendar--convert-tz-offset standard nil))))
487 (if (and tz-id std)
488 (cons tz-id
489 (if day
490 (concat (car std) (car day)
491 "," (cdr day) "," (cdr std))
492 (car std))))))
494 (defun icalendar--convert-all-timezones (icalendar)
495 "Convert all timezones in the ICALENDAR into an alist.
496 Each element of the alist is a cons (ID . TZ-STRING),
497 like `icalendar--parse-vtimezone'."
498 (let (result)
499 (dolist (zone (icalendar--get-children (car icalendar) 'VTIMEZONE))
500 (setq zone (icalendar--parse-vtimezone zone))
501 (if zone
502 (setq result (cons zone result))))
503 result))
505 (defun icalendar--find-time-zone (prop-list zone-map)
506 "Return a timezone string for the time zone in PROP-LIST, or nil if none.
507 ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'."
508 (let ((id (plist-get prop-list 'TZID)))
509 (if id
510 (cdr (assoc id zone-map)))))
512 (defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift
513 zone)
514 "Return ISODATETIMESTRING in format like `decode-time'.
515 Converts from ISO-8601 to Emacs representation. If
516 ISODATETIMESTRING specifies UTC time (trailing letter Z) the
517 decoded time is given in the local time zone! If optional
518 parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
519 days.
520 ZONE, if provided, is the timezone, in any format understood by `encode-time'.
522 FIXME: multiple comma-separated values should be allowed!"
523 (icalendar--dmsg isodatetimestring)
524 (if isodatetimestring
525 ;; day/month/year must be present
526 (let ((year (read (substring isodatetimestring 0 4)))
527 (month (read (substring isodatetimestring 4 6)))
528 (day (read (substring isodatetimestring 6 8)))
529 (hour 0)
530 (minute 0)
531 (second 0))
532 (when (> (length isodatetimestring) 12)
533 ;; hour/minute present
534 (setq hour (read (substring isodatetimestring 9 11)))
535 (setq minute (read (substring isodatetimestring 11 13))))
536 (when (> (length isodatetimestring) 14)
537 ;; seconds present
538 (setq second (read (substring isodatetimestring 13 15))))
539 (when (and (> (length isodatetimestring) 15)
540 ;; UTC specifier present
541 (char-equal ?Z (aref isodatetimestring 15)))
542 ;; if not UTC add current-time-zone offset
543 (setq second (+ (car (current-time-zone)) second)))
544 ;; shift if necessary
545 (if day-shift
546 (let ((mdy (calendar-gregorian-from-absolute
547 (+ (calendar-absolute-from-gregorian
548 (list month day year))
549 day-shift))))
550 (setq month (nth 0 mdy))
551 (setq day (nth 1 mdy))
552 (setq year (nth 2 mdy))))
553 ;; create the decoded date-time
554 ;; FIXME!?!
555 (condition-case nil
556 (decode-time (encode-time second minute hour day month year zone))
557 (error
558 (message "Cannot decode \"%s\"" isodatetimestring)
559 ;; hope for the best...
560 (list second minute hour day month year 0 nil 0))))
561 ;; isodatetimestring == nil
562 nil))
564 (defun icalendar--decode-isoduration (isodurationstring
565 &optional duration-correction)
566 "Convert ISODURATIONSTRING into format provided by `decode-time'.
567 Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING
568 specifies UTC time (trailing letter Z) the decoded time is given in
569 the local time zone!
571 Optional argument DURATION-CORRECTION shortens result by one day.
573 FIXME: TZID-attributes are ignored....!
574 FIXME: multiple comma-separated values should be allowed!"
575 (if isodurationstring
576 (save-match-data
577 (string-match
578 (concat
579 "^P[+-]?\\("
580 "\\(\\([0-9]+\\)D\\)" ; days only
581 "\\|"
582 "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days
583 "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time
584 "\\|"
585 "\\(\\([0-9]+\\)W\\)" ; weeks only
586 "\\)$") isodurationstring)
587 (let ((seconds 0)
588 (minutes 0)
589 (hours 0)
590 (days 0)
591 (months 0)
592 (years 0))
593 (cond
594 ((match-beginning 2) ;days only
595 (setq days (read (substring isodurationstring
596 (match-beginning 3)
597 (match-end 3))))
598 (when duration-correction
599 (setq days (1- days))))
600 ((match-beginning 4) ;days and time
601 (if (match-beginning 5)
602 (setq days (* 7 (read (substring isodurationstring
603 (match-beginning 6)
604 (match-end 6))))))
605 (if (match-beginning 7)
606 (setq hours (read (substring isodurationstring
607 (match-beginning 8)
608 (match-end 8)))))
609 (if (match-beginning 9)
610 (setq minutes (read (substring isodurationstring
611 (match-beginning 10)
612 (match-end 10)))))
613 (if (match-beginning 11)
614 (setq seconds (read (substring isodurationstring
615 (match-beginning 12)
616 (match-end 12))))))
617 ((match-beginning 13) ;weeks only
618 (setq days (* 7 (read (substring isodurationstring
619 (match-beginning 14)
620 (match-end 14)))))))
621 (list seconds minutes hours days months years)))
622 ;; isodatetimestring == nil
623 nil))
625 (defun icalendar--add-decoded-times (time1 time2)
626 "Add TIME1 to TIME2.
627 Both times must be given in decoded form. One of these times must be
628 valid (year > 1900 or something)."
629 ;; FIXME: does this function exist already?
630 (decode-time (encode-time
631 (+ (nth 0 time1) (nth 0 time2))
632 (+ (nth 1 time1) (nth 1 time2))
633 (+ (nth 2 time1) (nth 2 time2))
634 (+ (nth 3 time1) (nth 3 time2))
635 (+ (nth 4 time1) (nth 4 time2))
636 (+ (nth 5 time1) (nth 5 time2))
639 ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
642 (defun icalendar--datetime-to-american-date (datetime &optional separator)
643 "Convert the decoded DATETIME to American-style format.
644 Optional argument SEPARATOR gives the separator between month,
645 day, and year. If nil a blank character is used as separator.
646 American format: \"month day year\"."
647 (if datetime
648 (format "%d%s%d%s%d" (nth 4 datetime) ;month
649 (or separator " ")
650 (nth 3 datetime) ;day
651 (or separator " ")
652 (nth 5 datetime)) ;year
653 ;; datetime == nil
654 nil))
656 (define-obsolete-function-alias 'icalendar--datetime-to-noneuropean-date
657 'icalendar--datetime-to-american-date "icalendar 0.19")
659 (defun icalendar--datetime-to-european-date (datetime &optional separator)
660 "Convert the decoded DATETIME to European format.
661 Optional argument SEPARATOR gives the separator between month,
662 day, and year. If nil a blank character is used as separator.
663 European format: (day month year).
664 FIXME"
665 (if datetime
666 (format "%d%s%d%s%d" (nth 3 datetime) ;day
667 (or separator " ")
668 (nth 4 datetime) ;month
669 (or separator " ")
670 (nth 5 datetime)) ;year
671 ;; datetime == nil
672 nil))
674 (defun icalendar--datetime-to-iso-date (datetime &optional separator)
675 "Convert the decoded DATETIME to ISO format.
676 Optional argument SEPARATOR gives the separator between month,
677 day, and year. If nil a blank character is used as separator.
678 ISO format: (year month day)."
679 (if datetime
680 (format "%d%s%d%s%d" (nth 5 datetime) ;year
681 (or separator " ")
682 (nth 4 datetime) ;month
683 (or separator " ")
684 (nth 3 datetime)) ;day
685 ;; datetime == nil
686 nil))
688 (defun icalendar--date-style ()
689 "Return current calendar date style.
690 Convenience function to handle transition from old
691 `european-calendar-style' to new `calendar-date-style'."
692 (if (boundp 'calendar-date-style)
693 calendar-date-style
694 (if (with-no-warnings european-calendar-style)
695 'european
696 'american)))
698 (defun icalendar--datetime-to-diary-date (datetime &optional separator)
699 "Convert the decoded DATETIME to diary format.
700 Optional argument SEPARATOR gives the separator between month,
701 day, and year. If nil a blank character is used as separator.
702 Call icalendar--datetime-to-*-date according to the current
703 calendar date style."
704 (funcall (intern-soft (format "icalendar--datetime-to-%s-date"
705 (icalendar--date-style)))
706 datetime separator))
708 (defun icalendar--datetime-to-colontime (datetime)
709 "Extract the time part of a decoded DATETIME into 24-hour format.
710 Note that this silently ignores seconds."
711 (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime)))
713 (defun icalendar--get-month-number (monthname)
714 "Return the month number for the given MONTHNAME."
715 (catch 'found
716 (let ((num 1)
717 (m (downcase monthname)))
718 (mapc (lambda (month)
719 (let ((mm (downcase month)))
720 (if (or (string-equal mm m)
721 (string-equal (substring mm 0 3) m))
722 (throw 'found num))
723 (setq num (1+ num))))
724 calendar-month-name-array))
725 ;; Error:
726 -1))
728 (defun icalendar--get-weekday-number (abbrevweekday)
729 "Return the number for the ABBREVWEEKDAY."
730 (if abbrevweekday
731 (catch 'found
732 (let ((num 0)
733 (aw (downcase abbrevweekday)))
734 (mapc (lambda (day)
735 (let ((d (downcase day)))
736 (if (string-equal d aw)
737 (throw 'found num))
738 (setq num (1+ num))))
739 icalendar--weekday-array)))
740 ;; Error:
741 -1))
743 (defun icalendar--get-weekday-abbrev (weekday)
744 "Return the abbreviated WEEKDAY."
745 (catch 'found
746 (let ((num 0)
747 (w (downcase weekday)))
748 (mapc (lambda (day)
749 (let ((d (downcase day)))
750 (if (or (string-equal d w)
751 (string-equal (substring d 0 3) w))
752 (throw 'found (aref icalendar--weekday-array num)))
753 (setq num (1+ num))))
754 calendar-day-name-array))
755 ;; Error:
756 nil))
758 (defun icalendar--date-to-isodate (date &optional day-shift)
759 "Convert DATE to iso-style date.
760 DATE must be a list of the form (month day year).
761 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
762 (let ((mdy (calendar-gregorian-from-absolute
763 (+ (calendar-absolute-from-gregorian date)
764 (or day-shift 0)))))
765 (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
768 (defun icalendar--datestring-to-isodate (datestring &optional day-shift)
769 "Convert diary-style DATESTRING to iso-style date.
770 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
771 -- DAY-SHIFT must be either nil or an integer. This function
772 tries to figure the date style from DATESTRING itself. If that
773 is not possible it uses the current calendar date style."
774 (let ((day -1) month year)
775 (save-match-data
776 (cond ( ;; iso-style numeric date
777 (string-match (concat "\\s-*"
778 "\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
779 "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
780 "0?\\([1-9][0-9]?\\)")
781 datestring)
782 (setq year (read (substring datestring (match-beginning 1)
783 (match-end 1))))
784 (setq month (read (substring datestring (match-beginning 2)
785 (match-end 2))))
786 (setq day (read (substring datestring (match-beginning 3)
787 (match-end 3)))))
788 ( ;; non-iso numeric date -- must rely on configured
789 ;; calendar style
790 (string-match (concat "\\s-*"
791 "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
792 "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
793 "\\([0-9]\\{4\\}\\)")
794 datestring)
795 (setq day (read (substring datestring (match-beginning 1)
796 (match-end 1))))
797 (setq month (read (substring datestring (match-beginning 2)
798 (match-end 2))))
799 (setq year (read (substring datestring (match-beginning 3)
800 (match-end 3))))
801 (if (eq (icalendar--date-style) 'american)
802 (let ((x month))
803 (setq month day)
804 (setq day x))))
805 ( ;; date contains month names -- iso style
806 (string-match (concat "\\s-*"
807 "\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
808 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
809 "0?\\([123]?[0-9]\\)")
810 datestring)
811 (setq year (read (substring datestring (match-beginning 1)
812 (match-end 1))))
813 (setq month (icalendar--get-month-number
814 (substring datestring (match-beginning 2)
815 (match-end 2))))
816 (setq day (read (substring datestring (match-beginning 3)
817 (match-end 3)))))
818 ( ;; date contains month names -- european style
819 (string-match (concat "\\s-*"
820 "0?\\([123]?[0-9]\\)[ \t/]\\s-*"
821 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
822 "\\([0-9]\\{4\\}\\)")
823 datestring)
824 (setq day (read (substring datestring (match-beginning 1)
825 (match-end 1))))
826 (setq month (icalendar--get-month-number
827 (substring datestring (match-beginning 2)
828 (match-end 2))))
829 (setq year (read (substring datestring (match-beginning 3)
830 (match-end 3)))))
831 ( ;; date contains month names -- american style
832 (string-match (concat "\\s-*"
833 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
834 "0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
835 "\\([0-9]\\{4\\}\\)")
836 datestring)
837 (setq day (read (substring datestring (match-beginning 2)
838 (match-end 2))))
839 (setq month (icalendar--get-month-number
840 (substring datestring (match-beginning 1)
841 (match-end 1))))
842 (setq year (read (substring datestring (match-beginning 3)
843 (match-end 3)))))
845 nil)))
846 (if (> day 0)
847 (let ((mdy (calendar-gregorian-from-absolute
848 (+ (calendar-absolute-from-gregorian (list month day
849 year))
850 (or day-shift 0)))))
851 (icalendar--dmsg (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
852 (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
853 nil)))
855 (defun icalendar--diarytime-to-isotime (timestring ampmstring)
856 "Convert a time like 9:30pm to an iso-conform string like T213000.
857 In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING
858 would be \"pm\"."
859 (if timestring
860 (let ((starttimenum (read (icalendar--rris ":" "" timestring))))
861 ;; take care of am/pm style
862 ;; Be sure *not* to convert 12:00pm - 12:59pm to 2400-2459
863 (if (and ampmstring (string= "pm" ampmstring) (< starttimenum 1200))
864 (setq starttimenum (+ starttimenum 1200)))
865 ;; Similar effect with 12:00am - 12:59am (need to convert to 0000-0059)
866 (if (and ampmstring (string= "am" ampmstring) (>= starttimenum 1200))
867 (setq starttimenum (- starttimenum 1200)))
868 (format "T%04d00" starttimenum))
869 nil))
871 (defun icalendar--convert-string-for-export (string)
872 "Escape comma and other critical characters in STRING."
873 (icalendar--rris "," "\\\\," string))
875 (defun icalendar--convert-string-for-import (string)
876 "Remove escape chars for comma, semicolon etc. from STRING."
877 (icalendar--rris
878 "\\\\n" "\n " (icalendar--rris
879 "\\\\\"" "\"" (icalendar--rris
880 "\\\\;" ";" (icalendar--rris
881 "\\\\," "," string)))))
883 ;; ======================================================================
884 ;; Export -- convert emacs-diary to icalendar
885 ;; ======================================================================
887 ;;;###autoload
888 (defun icalendar-export-file (diary-filename ical-filename)
889 "Export diary file to iCalendar format.
890 All diary entries in the file DIARY-FILENAME are converted to iCalendar
891 format. The result is appended to the file ICAL-FILENAME."
892 (interactive "FExport diary data from file:
893 Finto iCalendar file: ")
894 (save-current-buffer
895 (set-buffer (find-file diary-filename))
896 (icalendar-export-region (point-min) (point-max) ical-filename)))
898 (defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file)
899 (make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file)
901 (defvar icalendar--uid-count 0
902 "Auxiliary counter for creating unique ids.")
904 (defun icalendar--create-uid (entry-full contents)
905 "Construct a unique iCalendar UID for a diary entry.
906 ENTRY-FULL is the full diary entry string. CONTENTS is the
907 current iCalendar object, as a string. Increase
908 `icalendar--uid-count'. Returns the UID string."
909 (let ((uid icalendar-uid-format))
911 (setq uid (replace-regexp-in-string
912 "%c"
913 (format "%d" icalendar--uid-count)
914 uid t t))
915 (setq icalendar--uid-count (1+ icalendar--uid-count))
916 (setq uid (replace-regexp-in-string
917 "%t"
918 (format "%d%d%d" (car (current-time))
919 (cadr (current-time))
920 (car (cddr (current-time))))
921 uid t t))
922 (setq uid (replace-regexp-in-string
923 "%h"
924 (format "%d" (abs (sxhash entry-full))) uid t t))
925 (setq uid (replace-regexp-in-string
926 "%u" (or user-login-name "UNKNOWN_USER") uid t t))
927 (let ((dtstart (if (string-match "^DTSTART[^:]*:\\([0-9]*\\)" contents)
928 (substring contents (match-beginning 1) (match-end 1))
929 "DTSTART")))
930 (setq uid (replace-regexp-in-string "%s" dtstart uid t t)))
932 ;; Return the UID string
933 uid))
935 ;;;###autoload
936 (defun icalendar-export-region (min max ical-filename)
937 "Export region in diary file to iCalendar format.
938 All diary entries in the region from MIN to MAX in the current buffer are
939 converted to iCalendar format. The result is appended to the file
940 ICAL-FILENAME.
941 This function attempts to return t if something goes wrong. In this
942 case an error string which describes all the errors and problems is
943 written into the buffer `*icalendar-errors*'."
944 (interactive "r
945 FExport diary data into iCalendar file: ")
946 (let ((result "")
947 (start 0)
948 (entry-main "")
949 (entry-rest "")
950 (entry-full "")
951 (header "")
952 (contents-n-summary)
953 (contents)
954 (found-error nil)
955 (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
956 "?"))
957 (other-elements nil))
958 ;; prepare buffer with error messages
959 (save-current-buffer
960 (set-buffer (get-buffer-create "*icalendar-errors*"))
961 (erase-buffer))
963 ;; here we go
964 (save-excursion
965 (goto-char min)
966 (while (re-search-forward
967 ;; possibly ignore hidden entries beginning with "&"
968 (if icalendar-export-hidden-diary-entries
969 "^\\([^ \t\n#].+\\)\\(\\(\n[ \t].*\\)*\\)"
970 "^\\([^ \t\n&#].+\\)\\(\\(\n[ \t].*\\)*\\)") max t)
971 (setq entry-main (match-string 1))
972 (if (match-beginning 2)
973 (setq entry-rest (match-string 2))
974 (setq entry-rest ""))
975 (setq entry-full (concat entry-main entry-rest))
977 (condition-case error-val
978 (progn
979 (setq contents-n-summary
980 (icalendar--convert-to-ical nonmarker entry-main))
981 (setq other-elements (icalendar--parse-summary-and-rest
982 entry-full))
983 (setq contents (concat (car contents-n-summary)
984 "\nSUMMARY:" (cadr contents-n-summary)))
985 (let ((cla (cdr (assoc 'cla other-elements)))
986 (des (cdr (assoc 'des other-elements)))
987 (loc (cdr (assoc 'loc other-elements)))
988 (org (cdr (assoc 'org other-elements)))
989 (sta (cdr (assoc 'sta other-elements)))
990 (sum (cdr (assoc 'sum other-elements)))
991 (url (cdr (assoc 'url other-elements))))
992 (if cla
993 (setq contents (concat contents "\nCLASS:" cla)))
994 (if des
995 (setq contents (concat contents "\nDESCRIPTION:" des)))
996 (if loc
997 (setq contents (concat contents "\nLOCATION:" loc)))
998 (if org
999 (setq contents (concat contents "\nORGANIZER:" org)))
1000 (if sta
1001 (setq contents (concat contents "\nSTATUS:" sta)))
1002 ;;(if sum
1003 ;; (setq contents (concat contents "\nSUMMARY:" sum)))
1004 (if url
1005 (setq contents (concat contents "\nURL:" url))))
1007 (setq header (concat "\nBEGIN:VEVENT\nUID:"
1008 (icalendar--create-uid entry-full contents)))
1009 (setq result (concat result header contents "\nEND:VEVENT")))
1010 ;; handle errors
1011 (error
1012 (setq found-error t)
1013 (save-current-buffer
1014 (set-buffer (get-buffer-create "*icalendar-errors*"))
1015 (insert (format "Error in line %d -- %s: `%s'\n"
1016 (count-lines (point-min) (point))
1017 error-val
1018 entry-main))))))
1020 ;; we're done, insert everything into the file
1021 (save-current-buffer
1022 (let ((coding-system-for-write 'utf-8))
1023 (set-buffer (find-file ical-filename))
1024 (goto-char (point-max))
1025 (insert "BEGIN:VCALENDAR")
1026 (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
1027 (insert "\nVERSION:2.0")
1028 (insert result)
1029 (insert "\nEND:VCALENDAR\n")
1030 ;; save the diary file
1031 (save-buffer)
1032 (unless found-error
1033 (bury-buffer)))))
1034 found-error))
1036 (defun icalendar--convert-to-ical (nonmarker entry-main)
1037 "Convert a diary entry to icalendar format.
1038 NONMARKER is a regular expression matching the start of non-marking
1039 entries. ENTRY-MAIN is the first line of the diary entry."
1041 ;; anniversaries -- %%(diary-anniversary ...)
1042 (icalendar--convert-anniversary-to-ical nonmarker entry-main)
1043 ;; cyclic events -- %%(diary-cyclic ...)
1044 (icalendar--convert-cyclic-to-ical nonmarker entry-main)
1045 ;; diary-date -- %%(diary-date ...)
1046 (icalendar--convert-date-to-ical nonmarker entry-main)
1047 ;; float events -- %%(diary-float ...)
1048 (icalendar--convert-float-to-ical nonmarker entry-main)
1049 ;; block events -- %%(diary-block ...)
1050 (icalendar--convert-block-to-ical nonmarker entry-main)
1051 ;; other sexp diary entries
1052 (icalendar--convert-sexp-to-ical nonmarker entry-main)
1053 ;; weekly by day -- Monday 8:30 Team meeting
1054 (icalendar--convert-weekly-to-ical nonmarker entry-main)
1055 ;; yearly by day -- 1 May Tag der Arbeit
1056 (icalendar--convert-yearly-to-ical nonmarker entry-main)
1057 ;; "ordinary" events, start and end time given
1058 ;; 1 Feb 2003 blah
1059 (icalendar--convert-ordinary-to-ical nonmarker entry-main)
1060 ;; everything else
1061 ;; Oops! what's that?
1062 (error "Could not parse entry")))
1064 (defun icalendar--parse-summary-and-rest (summary-and-rest)
1065 "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties.
1066 Returns an alist."
1067 (save-match-data
1068 (if (functionp icalendar-import-format)
1069 ;; can't do anything
1071 ;; split summary-and-rest
1072 (let* ((s icalendar-import-format)
1073 (p-cla (or (string-match "%c" icalendar-import-format) -1))
1074 (p-des (or (string-match "%d" icalendar-import-format) -1))
1075 (p-loc (or (string-match "%l" icalendar-import-format) -1))
1076 (p-org (or (string-match "%o" icalendar-import-format) -1))
1077 (p-sum (or (string-match "%s" icalendar-import-format) -1))
1078 (p-sta (or (string-match "%t" icalendar-import-format) -1))
1079 (p-url (or (string-match "%u" icalendar-import-format) -1))
1080 (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<))
1081 (ct 0)
1082 pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url)
1083 (dotimes (i (length p-list))
1084 ;; Use 'ct' to keep track of current position in list
1085 (cond ((and (>= p-cla 0) (= (nth i p-list) p-cla))
1086 (setq ct (+ ct 1))
1087 (setq pos-cla (* 2 ct)))
1088 ((and (>= p-des 0) (= (nth i p-list) p-des))
1089 (setq ct (+ ct 1))
1090 (setq pos-des (* 2 ct)))
1091 ((and (>= p-loc 0) (= (nth i p-list) p-loc))
1092 (setq ct (+ ct 1))
1093 (setq pos-loc (* 2 ct)))
1094 ((and (>= p-org 0) (= (nth i p-list) p-org))
1095 (setq ct (+ ct 1))
1096 (setq pos-org (* 2 ct)))
1097 ((and (>= p-sta 0) (= (nth i p-list) p-sta))
1098 (setq ct (+ ct 1))
1099 (setq pos-sta (* 2 ct)))
1100 ((and (>= p-sum 0) (= (nth i p-list) p-sum))
1101 (setq ct (+ ct 1))
1102 (setq pos-sum (* 2 ct)))
1103 ((and (>= p-url 0) (= (nth i p-list) p-url))
1104 (setq ct (+ ct 1))
1105 (setq pos-url (* 2 ct)))) )
1106 (mapc (lambda (ij)
1107 (setq s (icalendar--rris (car ij) (cadr ij) s t t)))
1108 (list
1109 ;; summary must be first! because of %s
1110 (list "%s"
1111 (concat "\\(" icalendar-import-format-summary "\\)??"))
1112 (list "%c"
1113 (concat "\\(" icalendar-import-format-class "\\)??"))
1114 (list "%d"
1115 (concat "\\(" icalendar-import-format-description "\\)??"))
1116 (list "%l"
1117 (concat "\\(" icalendar-import-format-location "\\)??"))
1118 (list "%o"
1119 (concat "\\(" icalendar-import-format-organizer "\\)??"))
1120 (list "%t"
1121 (concat "\\(" icalendar-import-format-status "\\)??"))
1122 (list "%u"
1123 (concat "\\(" icalendar-import-format-url "\\)??"))))
1124 ;; Need the \' regexp in order to detect multi-line items
1125 (setq s (concat "\\`"
1126 (icalendar--rris "%s" "\\(.*?\\)" s nil t)
1127 "\\'"))
1128 (if (string-match s summary-and-rest)
1129 (let (cla des loc org sta sum url)
1130 (if (and pos-sum (match-beginning pos-sum))
1131 (setq sum (substring summary-and-rest
1132 (match-beginning pos-sum)
1133 (match-end pos-sum))))
1134 (if (and pos-cla (match-beginning pos-cla))
1135 (setq cla (substring summary-and-rest
1136 (match-beginning pos-cla)
1137 (match-end pos-cla))))
1138 (if (and pos-des (match-beginning pos-des))
1139 (setq des (substring summary-and-rest
1140 (match-beginning pos-des)
1141 (match-end pos-des))))
1142 (if (and pos-loc (match-beginning pos-loc))
1143 (setq loc (substring summary-and-rest
1144 (match-beginning pos-loc)
1145 (match-end pos-loc))))
1146 (if (and pos-org (match-beginning pos-org))
1147 (setq org (substring summary-and-rest
1148 (match-beginning pos-org)
1149 (match-end pos-org))))
1150 (if (and pos-sta (match-beginning pos-sta))
1151 (setq sta (substring summary-and-rest
1152 (match-beginning pos-sta)
1153 (match-end pos-sta))))
1154 (if (and pos-url (match-beginning pos-url))
1155 (setq url (substring summary-and-rest
1156 (match-beginning pos-url)
1157 (match-end pos-url))))
1158 (list (if cla (cons 'cla cla) nil)
1159 (if des (cons 'des des) nil)
1160 (if loc (cons 'loc loc) nil)
1161 (if org (cons 'org org) nil)
1162 (if sta (cons 'sta sta) nil)
1163 ;;(if sum (cons 'sum sum) nil)
1164 (if url (cons 'url url) nil))))))))
1166 ;; subroutines for icalendar-export-region
1167 (defun icalendar--convert-ordinary-to-ical (nonmarker entry-main)
1168 "Convert \"ordinary\" diary entry to icalendar format.
1169 NONMARKER is a regular expression matching the start of non-marking
1170 entries. ENTRY-MAIN is the first line of the diary entry."
1171 (if (string-match
1172 (concat nonmarker
1173 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*" ; date
1174 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" ; start time
1175 "\\("
1176 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" ; end time
1177 "\\)?"
1178 "\\s-*\\(.*?\\) ?$")
1179 entry-main)
1180 (let* ((datetime (substring entry-main (match-beginning 1)
1181 (match-end 1)))
1182 (startisostring (icalendar--datestring-to-isodate
1183 datetime))
1184 (endisostring (icalendar--datestring-to-isodate
1185 datetime 1))
1186 (endisostring1)
1187 (starttimestring (icalendar--diarytime-to-isotime
1188 (if (match-beginning 3)
1189 (substring entry-main
1190 (match-beginning 3)
1191 (match-end 3))
1192 nil)
1193 (if (match-beginning 4)
1194 (substring entry-main
1195 (match-beginning 4)
1196 (match-end 4))
1197 nil)))
1198 (endtimestring (icalendar--diarytime-to-isotime
1199 (if (match-beginning 6)
1200 (substring entry-main
1201 (match-beginning 6)
1202 (match-end 6))
1203 nil)
1204 (if (match-beginning 7)
1205 (substring entry-main
1206 (match-beginning 7)
1207 (match-end 7))
1208 nil)))
1209 (summary (icalendar--convert-string-for-export
1210 (substring entry-main (match-beginning 8)
1211 (match-end 8)))))
1212 (icalendar--dmsg "ordinary %s" entry-main)
1214 (unless startisostring
1215 (error "Could not parse date"))
1217 ;; If only start-date is specified, then end-date is next day,
1218 ;; otherwise it is same day.
1219 (setq endisostring1 (if starttimestring
1220 startisostring
1221 endisostring))
1223 (when starttimestring
1224 (unless endtimestring
1225 (let ((time
1226 (read (icalendar--rris "^T0?" ""
1227 starttimestring))))
1228 (if (< time 230000)
1229 ;; Case: ends on same day
1230 (setq endtimestring (format "T%06d"
1231 (+ 10000 time)))
1232 ;; Case: ends on next day
1233 (setq endtimestring (format "T%06d"
1234 (- time 230000)))
1235 (setq endisostring1 endisostring)) )))
1237 (list (concat "\nDTSTART;"
1238 (if starttimestring "VALUE=DATE-TIME:"
1239 "VALUE=DATE:")
1240 startisostring
1241 (or starttimestring "")
1242 "\nDTEND;"
1243 (if endtimestring "VALUE=DATE-TIME:"
1244 "VALUE=DATE:")
1245 endisostring1
1246 (or endtimestring ""))
1247 summary))
1248 ;; no match
1249 nil))
1251 (defun icalendar-first-weekday-of-year (abbrevweekday year)
1252 "Find the first ABBREVWEEKDAY in a given YEAR.
1253 Returns day number."
1254 (let* ((day-of-week-jan01 (calendar-day-of-week (list 1 1 year)))
1255 (result (+ 1
1256 (- (icalendar--get-weekday-number abbrevweekday)
1257 day-of-week-jan01))))
1258 (cond ((<= result 0)
1259 (setq result (+ result 7)))
1260 ((> result 7)
1261 (setq result (- result 7))))
1262 result))
1264 (defun icalendar--convert-weekly-to-ical (nonmarker entry-main)
1265 "Convert weekly diary entry to icalendar format.
1266 NONMARKER is a regular expression matching the start of non-marking
1267 entries. ENTRY-MAIN is the first line of the diary entry."
1268 (if (and (string-match (concat nonmarker
1269 "\\([a-z]+\\)\\s-+"
1270 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)"
1271 "\\([ap]m\\)?"
1272 "\\(-0?"
1273 "\\([1-9][0-9]?:[0-9][0-9]\\)"
1274 "\\([ap]m\\)?\\)?"
1275 "\\)?"
1276 "\\s-*\\(.*?\\) ?$")
1277 entry-main)
1278 (icalendar--get-weekday-abbrev
1279 (substring entry-main (match-beginning 1)
1280 (match-end 1))))
1281 (let* ((day (icalendar--get-weekday-abbrev
1282 (substring entry-main (match-beginning 1)
1283 (match-end 1))))
1284 (starttimestring (icalendar--diarytime-to-isotime
1285 (if (match-beginning 3)
1286 (substring entry-main
1287 (match-beginning 3)
1288 (match-end 3))
1289 nil)
1290 (if (match-beginning 4)
1291 (substring entry-main
1292 (match-beginning 4)
1293 (match-end 4))
1294 nil)))
1295 (endtimestring (icalendar--diarytime-to-isotime
1296 (if (match-beginning 6)
1297 (substring entry-main
1298 (match-beginning 6)
1299 (match-end 6))
1300 nil)
1301 (if (match-beginning 7)
1302 (substring entry-main
1303 (match-beginning 7)
1304 (match-end 7))
1305 nil)))
1306 (summary (icalendar--convert-string-for-export
1307 (substring entry-main (match-beginning 8)
1308 (match-end 8)))))
1309 (icalendar--dmsg "weekly %s" entry-main)
1311 (when starttimestring
1312 (unless endtimestring
1313 (let ((time (read
1314 (icalendar--rris "^T0?" ""
1315 starttimestring))))
1316 (setq endtimestring (format "T%06d"
1317 (+ 10000 time))))))
1318 (list (concat "\nDTSTART;"
1319 (if starttimestring
1320 "VALUE=DATE-TIME:"
1321 "VALUE=DATE:")
1322 ;; Find the first requested weekday of the
1323 ;; start year
1324 (funcall 'format "%04d%02d%02d"
1325 icalendar-recurring-start-year 1
1326 (icalendar-first-weekday-of-year
1327 day icalendar-recurring-start-year))
1328 (or starttimestring "")
1329 "\nDTEND;"
1330 (if endtimestring
1331 "VALUE=DATE-TIME:"
1332 "VALUE=DATE:")
1333 (funcall 'format "%04d%02d%02d"
1334 ;; end is non-inclusive!
1335 icalendar-recurring-start-year 1
1336 (+ (icalendar-first-weekday-of-year
1337 day icalendar-recurring-start-year)
1338 (if endtimestring 0 1)))
1339 (or endtimestring "")
1340 "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY="
1341 day)
1342 summary))
1343 ;; no match
1344 nil))
1346 (defun icalendar--convert-yearly-to-ical (nonmarker entry-main)
1347 "Convert yearly diary entry to icalendar format.
1348 NONMARKER is a regular expression matching the start of non-marking
1349 entries. ENTRY-MAIN is the first line of the diary entry."
1350 (if (string-match (concat nonmarker
1351 (if (eq (icalendar--date-style) 'european)
1352 "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
1353 "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+")
1354 "\\*?\\s-*"
1355 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1356 "\\("
1357 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1358 "\\)?"
1359 "\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years
1361 entry-main)
1362 (let* ((daypos (if (eq (icalendar--date-style) 'european) 1 2))
1363 (monpos (if (eq (icalendar--date-style) 'european) 2 1))
1364 (day (read (substring entry-main
1365 (match-beginning daypos)
1366 (match-end daypos))))
1367 (month (icalendar--get-month-number
1368 (substring entry-main
1369 (match-beginning monpos)
1370 (match-end monpos))))
1371 (starttimestring (icalendar--diarytime-to-isotime
1372 (if (match-beginning 4)
1373 (substring entry-main
1374 (match-beginning 4)
1375 (match-end 4))
1376 nil)
1377 (if (match-beginning 5)
1378 (substring entry-main
1379 (match-beginning 5)
1380 (match-end 5))
1381 nil)))
1382 (endtimestring (icalendar--diarytime-to-isotime
1383 (if (match-beginning 7)
1384 (substring entry-main
1385 (match-beginning 7)
1386 (match-end 7))
1387 nil)
1388 (if (match-beginning 8)
1389 (substring entry-main
1390 (match-beginning 8)
1391 (match-end 8))
1392 nil)))
1393 (summary (icalendar--convert-string-for-export
1394 (substring entry-main (match-beginning 9)
1395 (match-end 9)))))
1396 (icalendar--dmsg "yearly %s" entry-main)
1398 (when starttimestring
1399 (unless endtimestring
1400 (let ((time (read
1401 (icalendar--rris "^T0?" ""
1402 starttimestring))))
1403 (setq endtimestring (format "T%06d"
1404 (+ 10000 time))))))
1405 (list (concat "\nDTSTART;"
1406 (if starttimestring "VALUE=DATE-TIME:"
1407 "VALUE=DATE:")
1408 (format "1900%02d%02d" month day)
1409 (or starttimestring "")
1410 "\nDTEND;"
1411 (if endtimestring "VALUE=DATE-TIME:"
1412 "VALUE=DATE:")
1413 ;; end is not included! shift by one day
1414 (icalendar--date-to-isodate
1415 (list month day 1900)
1416 (if endtimestring 0 1))
1417 (or endtimestring "")
1418 "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
1419 (format "%d" month)
1420 ";BYMONTHDAY="
1421 (format "%d" day))
1422 summary))
1423 ;; no match
1424 nil))
1426 (defun icalendar--convert-sexp-to-ical (nonmarker entry-main)
1427 "Convert complex sexp diary entry to icalendar format -- unsupported!
1429 FIXME!
1431 NONMARKER is a regular expression matching the start of non-marking
1432 entries. ENTRY-MAIN is the first line of the diary entry."
1433 (cond ((string-match (concat nonmarker
1434 "%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$")
1435 entry-main)
1436 ;; simple sexp entry as generated by icalendar.el: strip off the
1437 ;; unnecessary (and)
1438 (icalendar--dmsg "diary-sexp from icalendar.el %s" entry-main)
1439 (icalendar--convert-to-ical
1440 nonmarker
1441 (concat "%%"
1442 (substring entry-main (match-beginning 1) (match-end 1))
1443 (substring entry-main (match-beginning 2) (match-end 2)))))
1444 ((string-match (concat nonmarker
1445 "%%([^)]+)\\s-*.*")
1446 entry-main)
1447 (icalendar--dmsg "diary-sexp %s" entry-main)
1448 (error "Sexp-entries are not supported yet"))
1450 ;; no match
1451 nil)))
1453 (defun icalendar--convert-block-to-ical (nonmarker entry-main)
1454 "Convert block diary entry to icalendar format.
1455 NONMARKER is a regular expression matching the start of non-marking
1456 entries. ENTRY-MAIN is the first line of the diary entry."
1457 (if (string-match (concat nonmarker
1458 "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)"
1459 " +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1460 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1461 "\\("
1462 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1463 "\\)?"
1464 "\\s-*\\(.*?\\) ?$")
1465 entry-main)
1466 (let* ((startstring (substring entry-main
1467 (match-beginning 1)
1468 (match-end 1)))
1469 (endstring (substring entry-main
1470 (match-beginning 2)
1471 (match-end 2)))
1472 (startisostring (icalendar--datestring-to-isodate
1473 startstring))
1474 (endisostring (icalendar--datestring-to-isodate
1475 endstring))
1476 (endisostring+1 (icalendar--datestring-to-isodate
1477 endstring 1))
1478 (starttimestring (icalendar--diarytime-to-isotime
1479 (if (match-beginning 4)
1480 (substring entry-main
1481 (match-beginning 4)
1482 (match-end 4))
1483 nil)
1484 (if (match-beginning 5)
1485 (substring entry-main
1486 (match-beginning 5)
1487 (match-end 5))
1488 nil)))
1489 (endtimestring (icalendar--diarytime-to-isotime
1490 (if (match-beginning 7)
1491 (substring entry-main
1492 (match-beginning 7)
1493 (match-end 7))
1494 nil)
1495 (if (match-beginning 8)
1496 (substring entry-main
1497 (match-beginning 8)
1498 (match-end 8))
1499 nil)))
1500 (summary (icalendar--convert-string-for-export
1501 (substring entry-main (match-beginning 9)
1502 (match-end 9)))))
1503 (icalendar--dmsg "diary-block %s" entry-main)
1504 (when starttimestring
1505 (unless endtimestring
1506 (let ((time
1507 (read (icalendar--rris "^T0?" ""
1508 starttimestring))))
1509 (setq endtimestring (format "T%06d"
1510 (+ 10000 time))))))
1511 (if starttimestring
1512 ;; with time -> write rrule
1513 (list (concat "\nDTSTART;VALUE=DATE-TIME:"
1514 startisostring
1515 starttimestring
1516 "\nDTEND;VALUE=DATE-TIME:"
1517 startisostring
1518 endtimestring
1519 "\nRRULE:FREQ=DAILY;INTERVAL=1;UNTIL="
1520 endisostring)
1521 summary)
1522 ;; no time -> write long event
1523 (list (concat "\nDTSTART;VALUE=DATE:" startisostring
1524 "\nDTEND;VALUE=DATE:" endisostring+1)
1525 summary)))
1526 ;; no match
1527 nil))
1529 (defun icalendar--convert-float-to-ical (nonmarker entry-main)
1530 "Convert float diary entry to icalendar format -- unsupported!
1532 FIXME!
1534 NONMARKER is a regular expression matching the start of non-marking
1535 entries. ENTRY-MAIN is the first line of the diary entry."
1536 (if (string-match (concat nonmarker
1537 "%%(diary-float \\([^)]+\\))\\s-*\\(.*?\\) ?$")
1538 entry-main)
1539 (progn
1540 (icalendar--dmsg "diary-float %s" entry-main)
1541 (error "`diary-float' is not supported yet"))
1542 ;; no match
1543 nil))
1545 (defun icalendar--convert-date-to-ical (nonmarker entry-main)
1546 "Convert `diary-date' diary entry to icalendar format -- unsupported!
1548 FIXME!
1550 NONMARKER is a regular expression matching the start of non-marking
1551 entries. ENTRY-MAIN is the first line of the diary entry."
1552 (if (string-match (concat nonmarker
1553 "%%(diary-date \\([^)]+\\))\\s-*\\(.*?\\) ?$")
1554 entry-main)
1555 (progn
1556 (icalendar--dmsg "diary-date %s" entry-main)
1557 (error "`diary-date' is not supported yet"))
1558 ;; no match
1559 nil))
1561 (defun icalendar--convert-cyclic-to-ical (nonmarker entry-main)
1562 "Convert `diary-cyclic' diary entry to icalendar format.
1563 NONMARKER is a regular expression matching the start of non-marking
1564 entries. ENTRY-MAIN is the first line of the diary entry."
1565 (if (string-match (concat nonmarker
1566 "%%(diary-cyclic \\([^ ]+\\) +"
1567 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1568 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1569 "\\("
1570 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1571 "\\)?"
1572 "\\s-*\\(.*?\\) ?$")
1573 entry-main)
1574 (let* ((frequency (substring entry-main (match-beginning 1)
1575 (match-end 1)))
1576 (datetime (substring entry-main (match-beginning 2)
1577 (match-end 2)))
1578 (startisostring (icalendar--datestring-to-isodate
1579 datetime))
1580 (endisostring (icalendar--datestring-to-isodate
1581 datetime))
1582 (endisostring+1 (icalendar--datestring-to-isodate
1583 datetime 1))
1584 (starttimestring (icalendar--diarytime-to-isotime
1585 (if (match-beginning 4)
1586 (substring entry-main
1587 (match-beginning 4)
1588 (match-end 4))
1589 nil)
1590 (if (match-beginning 5)
1591 (substring entry-main
1592 (match-beginning 5)
1593 (match-end 5))
1594 nil)))
1595 (endtimestring (icalendar--diarytime-to-isotime
1596 (if (match-beginning 7)
1597 (substring entry-main
1598 (match-beginning 7)
1599 (match-end 7))
1600 nil)
1601 (if (match-beginning 8)
1602 (substring entry-main
1603 (match-beginning 8)
1604 (match-end 8))
1605 nil)))
1606 (summary (icalendar--convert-string-for-export
1607 (substring entry-main (match-beginning 9)
1608 (match-end 9)))))
1609 (icalendar--dmsg "diary-cyclic %s" entry-main)
1610 (when starttimestring
1611 (unless endtimestring
1612 (let ((time
1613 (read (icalendar--rris "^T0?" ""
1614 starttimestring))))
1615 (setq endtimestring (format "T%06d"
1616 (+ 10000 time))))))
1617 (list (concat "\nDTSTART;"
1618 (if starttimestring "VALUE=DATE-TIME:"
1619 "VALUE=DATE:")
1620 startisostring
1621 (or starttimestring "")
1622 "\nDTEND;"
1623 (if endtimestring "VALUE=DATE-TIME:"
1624 "VALUE=DATE:")
1625 (if endtimestring endisostring endisostring+1)
1626 (or endtimestring "")
1627 "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
1628 ;; strange: korganizer does not expect
1629 ;; BYSOMETHING here...
1631 summary))
1632 ;; no match
1633 nil))
1635 (defun icalendar--convert-anniversary-to-ical (nonmarker entry-main)
1636 "Convert `diary-anniversary' diary entry to icalendar format.
1637 NONMARKER is a regular expression matching the start of non-marking
1638 entries. ENTRY-MAIN is the first line of the diary entry."
1639 (if (string-match (concat nonmarker
1640 "%%(diary-anniversary \\([^)]+\\))\\s-*"
1641 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1642 "\\("
1643 "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1644 "\\)?"
1645 "\\s-*\\(.*?\\) ?$")
1646 entry-main)
1647 (let* ((datetime (substring entry-main (match-beginning 1)
1648 (match-end 1)))
1649 (startisostring (icalendar--datestring-to-isodate
1650 datetime))
1651 (endisostring (icalendar--datestring-to-isodate
1652 datetime 1))
1653 (starttimestring (icalendar--diarytime-to-isotime
1654 (if (match-beginning 3)
1655 (substring entry-main
1656 (match-beginning 3)
1657 (match-end 3))
1658 nil)
1659 (if (match-beginning 4)
1660 (substring entry-main
1661 (match-beginning 4)
1662 (match-end 4))
1663 nil)))
1664 (endtimestring (icalendar--diarytime-to-isotime
1665 (if (match-beginning 6)
1666 (substring entry-main
1667 (match-beginning 6)
1668 (match-end 6))
1669 nil)
1670 (if (match-beginning 7)
1671 (substring entry-main
1672 (match-beginning 7)
1673 (match-end 7))
1674 nil)))
1675 (summary (icalendar--convert-string-for-export
1676 (substring entry-main (match-beginning 8)
1677 (match-end 8)))))
1678 (icalendar--dmsg "diary-anniversary %s" entry-main)
1679 (when starttimestring
1680 (unless endtimestring
1681 (let ((time
1682 (read (icalendar--rris "^T0?" ""
1683 starttimestring))))
1684 (setq endtimestring (format "T%06d"
1685 (+ 10000 time))))))
1686 (list (concat "\nDTSTART;"
1687 (if starttimestring "VALUE=DATE-TIME:"
1688 "VALUE=DATE:")
1689 startisostring
1690 (or starttimestring "")
1691 "\nDTEND;"
1692 (if endtimestring "VALUE=DATE-TIME:"
1693 "VALUE=DATE:")
1694 endisostring
1695 (or endtimestring "")
1696 "\nRRULE:FREQ=YEARLY;INTERVAL=1"
1697 ;; the following is redundant,
1698 ;; but korganizer seems to expect this... ;(
1699 ;; and evolution doesn't understand it... :(
1700 ;; so... who is wrong?!
1701 ";BYMONTH="
1702 (substring startisostring 4 6)
1703 ";BYMONTHDAY="
1704 (substring startisostring 6 8))
1705 summary))
1706 ;; no match
1707 nil))
1709 ;; ======================================================================
1710 ;; Import -- convert icalendar to emacs-diary
1711 ;; ======================================================================
1713 ;;;###autoload
1714 (defun icalendar-import-file (ical-filename diary-filename
1715 &optional non-marking)
1716 "Import an iCalendar file and append to a diary file.
1717 Argument ICAL-FILENAME output iCalendar file.
1718 Argument DIARY-FILENAME input `diary-file'.
1719 Optional argument NON-MARKING determines whether events are created as
1720 non-marking or not."
1721 (interactive "fImport iCalendar data from file:
1722 Finto diary file:
1724 ;; clean up the diary file
1725 (save-current-buffer
1726 ;; now load and convert from the ical file
1727 (set-buffer (find-file ical-filename))
1728 (icalendar-import-buffer diary-filename t non-marking)))
1730 ;;;###autoload
1731 (defun icalendar-import-buffer (&optional diary-file do-not-ask
1732 non-marking)
1733 "Extract iCalendar events from current buffer.
1735 This function searches the current buffer for the first iCalendar
1736 object, reads it and adds all VEVENT elements to the diary
1737 DIARY-FILE.
1739 It will ask for each appointment whether to add it to the diary
1740 unless DO-NOT-ASK is non-nil. When called interactively,
1741 DO-NOT-ASK is nil, so that you are asked for each event.
1743 NON-MARKING determines whether diary events are created as
1744 non-marking.
1746 Return code t means that importing worked well, return code nil
1747 means that an error has occurred. Error messages will be in the
1748 buffer `*icalendar-errors*'."
1749 (interactive)
1750 (save-current-buffer
1751 ;; prepare ical
1752 (message "Preparing icalendar...")
1753 (set-buffer (icalendar--get-unfolded-buffer (current-buffer)))
1754 (goto-char (point-min))
1755 (message "Preparing icalendar...done")
1756 (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t)
1757 (let (ical-contents ical-errors)
1758 ;; read ical
1759 (message "Reading icalendar...")
1760 (beginning-of-line)
1761 (setq ical-contents (icalendar--read-element nil nil))
1762 (message "Reading icalendar...done")
1763 ;; convert ical
1764 (message "Converting icalendar...")
1765 (setq ical-errors (icalendar--convert-ical-to-diary
1766 ical-contents
1767 diary-file do-not-ask non-marking))
1768 (when diary-file
1769 ;; save the diary file if it is visited already
1770 (let ((b (find-buffer-visiting diary-file)))
1771 (when b
1772 (save-current-buffer
1773 (set-buffer b)
1774 (save-buffer)))))
1775 (message "Converting icalendar...done")
1776 ;; return t if no error occurred
1777 (not ical-errors))
1778 (message
1779 "Current buffer does not contain icalendar contents!")
1780 ;; return nil, i.e. import did not work
1781 nil)))
1783 (defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
1784 (make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
1786 (defun icalendar--format-ical-event (event)
1787 "Create a string representation of an iCalendar EVENT."
1788 (if (functionp icalendar-import-format)
1789 (funcall icalendar-import-format event)
1790 (let ((string icalendar-import-format)
1791 (conversion-list
1792 '(("%c" CLASS icalendar-import-format-class)
1793 ("%d" DESCRIPTION icalendar-import-format-description)
1794 ("%l" LOCATION icalendar-import-format-location)
1795 ("%o" ORGANIZER icalendar-import-format-organizer)
1796 ("%s" SUMMARY icalendar-import-format-summary)
1797 ("%t" STATUS icalendar-import-format-status)
1798 ("%u" URL icalendar-import-format-url))))
1799 ;; convert the specifiers in the format string
1800 (mapc (lambda (i)
1801 (let* ((spec (car i))
1802 (prop (cadr i))
1803 (format (car (cddr i)))
1804 (contents (icalendar--get-event-property event prop))
1805 (formatted-contents ""))
1806 (when (and contents (> (length contents) 0))
1807 (setq formatted-contents
1808 (icalendar--rris "%s"
1809 (icalendar--convert-string-for-import
1810 contents)
1811 (symbol-value format)
1812 t t)))
1813 (setq string (icalendar--rris spec
1814 formatted-contents
1815 string
1816 t t))))
1817 conversion-list)
1818 string)))
1820 (defun icalendar--convert-ical-to-diary (ical-list diary-file
1821 &optional do-not-ask
1822 non-marking)
1823 "Convert iCalendar data to an Emacs diary file.
1824 Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
1825 DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event
1826 whether to actually import it. NON-MARKING determines whether diary
1827 events are created as non-marking.
1828 This function attempts to return t if something goes wrong. In this
1829 case an error string which describes all the errors and problems is
1830 written into the buffer `*icalendar-errors*'."
1831 (let* ((ev (icalendar--all-events ical-list))
1832 (error-string "")
1833 (event-ok t)
1834 (found-error nil)
1835 (zone-map (icalendar--convert-all-timezones ical-list))
1836 e diary-string)
1837 ;; step through all events/appointments
1838 (while ev
1839 (setq e (car ev))
1840 (setq ev (cdr ev))
1841 (setq event-ok nil)
1842 (condition-case error-val
1843 (let* ((dtstart (icalendar--get-event-property e 'DTSTART))
1844 (dtstart-zone (icalendar--find-time-zone
1845 (icalendar--get-event-property-attributes
1846 e 'DTSTART)
1847 zone-map))
1848 (dtstart-dec (icalendar--decode-isodatetime dtstart nil
1849 dtstart-zone))
1850 (start-d (icalendar--datetime-to-diary-date
1851 dtstart-dec))
1852 (start-t (icalendar--datetime-to-colontime dtstart-dec))
1853 (dtend (icalendar--get-event-property e 'DTEND))
1854 (dtend-zone (icalendar--find-time-zone
1855 (icalendar--get-event-property-attributes
1856 e 'DTEND)
1857 zone-map))
1858 (dtend-dec (icalendar--decode-isodatetime dtend
1859 nil dtend-zone))
1860 (dtend-1-dec (icalendar--decode-isodatetime dtend -1
1861 dtend-zone))
1862 end-d
1863 end-1-d
1864 end-t
1865 (summary (icalendar--convert-string-for-import
1866 (or (icalendar--get-event-property e 'SUMMARY)
1867 "No summary")))
1868 (rrule (icalendar--get-event-property e 'RRULE))
1869 (rdate (icalendar--get-event-property e 'RDATE))
1870 (duration (icalendar--get-event-property e 'DURATION)))
1871 (icalendar--dmsg "%s: `%s'" start-d summary)
1872 ;; check whether start-time is missing
1873 (if (and dtstart
1874 (string=
1875 (cadr (icalendar--get-event-property-attributes
1876 e 'DTSTART))
1877 "DATE"))
1878 (setq start-t nil))
1879 (when duration
1880 (let ((dtend-dec-d (icalendar--add-decoded-times
1881 dtstart-dec
1882 (icalendar--decode-isoduration duration)))
1883 (dtend-1-dec-d (icalendar--add-decoded-times
1884 dtstart-dec
1885 (icalendar--decode-isoduration duration
1886 t))))
1887 (if (and dtend-dec (not (eq dtend-dec dtend-dec-d)))
1888 (message "Inconsistent endtime and duration for %s"
1889 summary))
1890 (setq dtend-dec dtend-dec-d)
1891 (setq dtend-1-dec dtend-1-dec-d)))
1892 (setq end-d (if dtend-dec
1893 (icalendar--datetime-to-diary-date dtend-dec)
1894 start-d))
1895 (setq end-1-d (if dtend-1-dec
1896 (icalendar--datetime-to-diary-date dtend-1-dec)
1897 start-d))
1898 (setq end-t (if (and
1899 dtend-dec
1900 (not (string=
1901 (cadr
1902 (icalendar--get-event-property-attributes
1903 e 'DTEND))
1904 "DATE")))
1905 (icalendar--datetime-to-colontime dtend-dec)
1906 start-t))
1907 (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d)
1908 (cond
1909 ;; recurring event
1910 (rrule
1911 (setq diary-string
1912 (icalendar--convert-recurring-to-diary e dtstart-dec start-t
1913 end-t))
1914 (setq event-ok t))
1915 (rdate
1916 (icalendar--dmsg "rdate event")
1917 (setq diary-string "")
1918 (mapc (lambda (datestring)
1919 (setq diary-string
1920 (concat diary-string
1921 (format "......"))))
1922 (icalendar--split-value rdate)))
1923 ;; non-recurring event
1924 ;; all-day event
1925 ((not (string= start-d end-d))
1926 (setq diary-string
1927 (icalendar--convert-non-recurring-all-day-to-diary
1928 e start-d end-1-d))
1929 (setq event-ok t))
1930 ;; not all-day
1931 ((and start-t (or (not end-t)
1932 (not (string= start-t end-t))))
1933 (setq diary-string
1934 (icalendar--convert-non-recurring-not-all-day-to-diary
1935 e dtstart-dec dtend-dec start-t end-t))
1936 (setq event-ok t))
1937 ;; all-day event
1939 (icalendar--dmsg "all day event")
1940 (setq diary-string (icalendar--datetime-to-diary-date
1941 dtstart-dec "/"))
1942 (setq event-ok t)))
1943 ;; add all other elements unless the user doesn't want to have
1944 ;; them
1945 (if event-ok
1946 (progn
1947 (setq diary-string
1948 (concat diary-string " "
1949 (icalendar--format-ical-event e)))
1950 (if do-not-ask (setq summary nil))
1951 ;; add entry to diary and store actual name of diary
1952 ;; file (in case it was nil)
1953 (setq diary-file
1954 (icalendar--add-diary-entry diary-string diary-file
1955 non-marking summary)))
1956 ;; event was not ok
1957 (setq found-error t)
1958 (setq error-string
1959 (format "%s\nCannot handle this event:%s"
1960 error-string e))))
1961 ;; FIXME: inform user about ignored event properties
1962 ;; handle errors
1963 (error
1964 (message "Ignoring event \"%s\"" e)
1965 (setq found-error t)
1966 (setq error-string (format "%s\n%s\nCannot handle this event: %s"
1967 error-val error-string e))
1968 (message "%s" error-string))))
1970 ;; insert final newline
1971 (if diary-file
1972 (let ((b (find-buffer-visiting diary-file)))
1973 (when b
1974 (save-current-buffer
1975 (set-buffer b)
1976 (goto-char (point-max))
1977 (insert "\n")))))
1978 (if found-error
1979 (save-current-buffer
1980 (set-buffer (get-buffer-create "*icalendar-errors*"))
1981 (erase-buffer)
1982 (insert error-string)))
1983 (message "Converting icalendar...done")
1984 found-error))
1986 ;; subroutines for importing
1987 (defun icalendar--convert-recurring-to-diary (e dtstart-dec start-t end-t)
1988 "Convert recurring icalendar event E to diary format.
1990 DTSTART-DEC is the DTSTART property of E.
1991 START-T is the event's start time in diary format.
1992 END-T is the event's end time in diary format."
1993 (icalendar--dmsg "recurring event")
1994 (let* ((rrule (icalendar--get-event-property e 'RRULE))
1995 (rrule-props (icalendar--split-value rrule))
1996 (frequency (cadr (assoc 'FREQ rrule-props)))
1997 (until (cadr (assoc 'UNTIL rrule-props)))
1998 (count (cadr (assoc 'COUNT rrule-props)))
1999 (interval (read (or (cadr (assoc 'INTERVAL rrule-props)) "1")))
2000 (dtstart-conv (icalendar--datetime-to-diary-date dtstart-dec))
2001 (until-conv (icalendar--datetime-to-diary-date
2002 (icalendar--decode-isodatetime until)))
2003 (until-1-conv (icalendar--datetime-to-diary-date
2004 (icalendar--decode-isodatetime until -1)))
2005 (result ""))
2007 ;; FIXME FIXME interval!!!!!!!!!!!!!
2009 (when count
2010 (if until
2011 (message "Must not have UNTIL and COUNT -- ignoring COUNT element!")
2012 (let ((until-1 0))
2013 (cond ((string-equal frequency "DAILY")
2014 (setq until (icalendar--add-decoded-times
2015 dtstart-dec
2016 (list 0 0 0 (* (read count) interval) 0 0)))
2017 (setq until-1 (icalendar--add-decoded-times
2018 dtstart-dec
2019 (list 0 0 0 (* (- (read count) 1) interval)
2020 0 0)))
2022 ((string-equal frequency "WEEKLY")
2023 (setq until (icalendar--add-decoded-times
2024 dtstart-dec
2025 (list 0 0 0 (* (read count) 7 interval) 0 0)))
2026 (setq until-1 (icalendar--add-decoded-times
2027 dtstart-dec
2028 (list 0 0 0 (* (- (read count) 1) 7
2029 interval) 0 0)))
2031 ((string-equal frequency "MONTHLY")
2032 (setq until (icalendar--add-decoded-times
2033 dtstart-dec (list 0 0 0 0 (* (- (read count) 1)
2034 interval) 0)))
2035 (setq until-1 (icalendar--add-decoded-times
2036 dtstart-dec (list 0 0 0 0 (* (- (read count) 1)
2037 interval) 0)))
2039 ((string-equal frequency "YEARLY")
2040 (setq until (icalendar--add-decoded-times
2041 dtstart-dec (list 0 0 0 0 0 (* (- (read count) 1)
2042 interval))))
2043 (setq until-1 (icalendar--add-decoded-times
2044 dtstart-dec
2045 (list 0 0 0 0 0 (* (- (read count) 1)
2046 interval))))
2049 (message "Cannot handle COUNT attribute for `%s' events."
2050 frequency)))
2051 (setq until-conv (icalendar--datetime-to-diary-date until))
2052 (setq until-1-conv (icalendar--datetime-to-diary-date until-1))
2055 (cond ((string-equal frequency "WEEKLY")
2056 (if (not start-t)
2057 (progn
2058 ;; weekly and all-day
2059 (icalendar--dmsg "weekly all-day")
2060 (if until
2061 (setq result
2062 (format
2063 (concat "%%%%(and "
2064 "(diary-cyclic %d %s) "
2065 "(diary-block %s %s))")
2066 (* interval 7)
2067 dtstart-conv
2068 dtstart-conv
2069 (if count until-1-conv until-conv)
2071 (setq result
2072 (format "%%%%(and (diary-cyclic %d %s))"
2073 (* interval 7)
2074 dtstart-conv))))
2075 ;; weekly and not all-day
2076 (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
2077 (weekday
2078 (icalendar--get-weekday-number byday)))
2079 (icalendar--dmsg "weekly not-all-day")
2080 (if until
2081 (setq result
2082 (format
2083 (concat "%%%%(and "
2084 "(diary-cyclic %d %s) "
2085 "(diary-block %s %s)) "
2086 "%s%s%s")
2087 (* interval 7)
2088 dtstart-conv
2089 dtstart-conv
2090 until-conv
2091 (or start-t "")
2092 (if end-t "-" "") (or end-t "")))
2093 ;; no limit
2094 ;; FIXME!!!!
2095 ;; DTSTART;VALUE=DATE-TIME:20030919T090000
2096 ;; DTEND;VALUE=DATE-TIME:20030919T113000
2097 (setq result
2098 (format
2099 "%%%%(and (diary-cyclic %s %s)) %s%s%s"
2100 (* interval 7)
2101 dtstart-conv
2102 (or start-t "")
2103 (if end-t "-" "") (or end-t "")))))))
2104 ;; yearly
2105 ((string-equal frequency "YEARLY")
2106 (icalendar--dmsg "yearly")
2107 (if until
2108 (let ((day (nth 3 dtstart-dec))
2109 (month (nth 4 dtstart-dec)))
2110 (setq result (concat "%%(and (diary-date "
2111 (cond ((eq (icalendar--date-style) 'iso)
2112 (format "t %d %d" month day))
2113 ((eq (icalendar--date-style) 'european)
2114 (format "%d %d t" day month))
2115 ((eq (icalendar--date-style) 'american)
2116 (format "%d %d t" month day)))
2117 ") (diary-block "
2118 dtstart-conv
2120 until-conv
2121 ")) "
2122 (or start-t "")
2123 (if end-t "-" "")
2124 (or end-t ""))))
2125 (setq result (format
2126 "%%%%(and (diary-anniversary %s)) %s%s%s"
2127 dtstart-conv
2128 (or start-t "")
2129 (if end-t "-" "") (or end-t "")))))
2130 ;; monthly
2131 ((string-equal frequency "MONTHLY")
2132 (icalendar--dmsg "monthly")
2133 (setq result
2134 (format
2135 "%%%%(and (diary-date %s) (diary-block %s %s)) %s%s%s"
2136 (let ((day (nth 3 dtstart-dec)))
2137 (cond ((eq (icalendar--date-style) 'iso)
2138 (format "t t %d" day))
2139 ((eq (icalendar--date-style) 'european)
2140 (format "%d t t" day))
2141 ((eq (icalendar--date-style) 'american)
2142 (format "t %d t" day))))
2143 dtstart-conv
2144 (if until
2145 until-conv
2146 (if (eq (icalendar--date-style) 'iso) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited
2147 (or start-t "")
2148 (if end-t "-" "") (or end-t ""))))
2149 ;; daily
2150 ((and (string-equal frequency "DAILY"))
2151 (if until
2152 (setq result
2153 (format
2154 (concat "%%%%(and (diary-cyclic %s %s) "
2155 "(diary-block %s %s)) %s%s%s")
2156 interval dtstart-conv dtstart-conv
2157 (if count until-1-conv until-conv)
2158 (or start-t "")
2159 (if end-t "-" "") (or end-t "")))
2160 (setq result
2161 (format
2162 "%%%%(and (diary-cyclic %s %s)) %s%s%s"
2163 interval
2164 dtstart-conv
2165 (or start-t "")
2166 (if end-t "-" "") (or end-t ""))))))
2167 ;; Handle exceptions from recurrence rules
2168 (let ((ex-dates (icalendar--get-event-properties e 'EXDATE)))
2169 (while ex-dates
2170 (let* ((ex-start (icalendar--decode-isodatetime
2171 (car ex-dates)))
2172 (ex-d (icalendar--datetime-to-diary-date
2173 ex-start)))
2174 (setq result
2175 (icalendar--rris "^%%(\\(and \\)?"
2176 (format
2177 "%%%%(and (not (diary-date %s)) "
2178 ex-d)
2179 result)))
2180 (setq ex-dates (cdr ex-dates))))
2181 ;; FIXME: exception rules are not recognized
2182 (if (icalendar--get-event-property e 'EXRULE)
2183 (setq result
2184 (concat result
2185 "\n Exception rules: "
2186 (icalendar--get-event-properties
2187 e 'EXRULE))))
2188 result))
2190 (defun icalendar--convert-non-recurring-all-day-to-diary (event start-d end-d)
2191 "Convert non-recurring icalendar EVENT to diary format.
2193 DTSTART is the decoded DTSTART property of E.
2194 Argument START-D gives the first day.
2195 Argument END-D gives the last day."
2196 (icalendar--dmsg "non-recurring all-day event")
2197 (format "%%%%(and (diary-block %s %s))" start-d end-d))
2199 (defun icalendar--convert-non-recurring-not-all-day-to-diary (event dtstart-dec
2200 dtend-dec
2201 start-t
2202 end-t)
2203 "Convert recurring icalendar EVENT to diary format.
2205 DTSTART-DEC is the decoded DTSTART property of E.
2206 DTEND-DEC is the decoded DTEND property of E.
2207 START-T is the event's start time in diary format.
2208 END-T is the event's end time in diary format."
2209 (icalendar--dmsg "not all day event")
2210 (cond (end-t
2211 (format "%s %s-%s"
2212 (icalendar--datetime-to-diary-date
2213 dtstart-dec "/")
2214 start-t end-t))
2216 (format "%s %s"
2217 (icalendar--datetime-to-diary-date
2218 dtstart-dec "/")
2219 start-t))))
2221 (defun icalendar--add-diary-entry (string diary-file non-marking
2222 &optional summary)
2223 "Add STRING to the diary file DIARY-FILE.
2224 STRING must be a properly formatted valid diary entry. NON-MARKING
2225 determines whether diary events are created as non-marking. If
2226 SUMMARY is not nil it must be a string that gives the summary of the
2227 entry. In this case the user will be asked whether he wants to insert
2228 the entry."
2229 (when (or (not summary)
2230 (y-or-n-p (format "Add appointment for `%s' to diary? "
2231 summary)))
2232 (when summary
2233 (setq non-marking
2234 (y-or-n-p (format "Make appointment non-marking? "))))
2235 (save-window-excursion
2236 (unless diary-file
2237 (setq diary-file
2238 (read-file-name "Add appointment to this diary file: ")))
2239 ;; Note: diary-make-entry will add a trailing blank char.... :(
2240 (funcall (if (fboundp 'diary-make-entry)
2241 'diary-make-entry
2242 'make-diary-entry)
2243 string non-marking diary-file)))
2244 ;; return diary-file in case it has been changed interactively
2245 diary-file)
2247 ;; ======================================================================
2248 ;; Examples
2249 ;; ======================================================================
2250 (defun icalendar-import-format-sample (event)
2251 "Example function for formatting an icalendar EVENT."
2252 (format (concat "SUMMARY=`%s' DESCRIPTION=`%s' LOCATION=`%s' ORGANIZER=`%s' "
2253 "STATUS=`%s' URL=`%s' CLASS=`%s'")
2254 (or (icalendar--get-event-property event 'SUMMARY) "")
2255 (or (icalendar--get-event-property event 'DESCRIPTION) "")
2256 (or (icalendar--get-event-property event 'LOCATION) "")
2257 (or (icalendar--get-event-property event 'ORGANIZER) "")
2258 (or (icalendar--get-event-property event 'STATUS) "")
2259 (or (icalendar--get-event-property event 'URL) "")
2260 (or (icalendar--get-event-property event 'CLASS) "")))
2262 (provide 'icalendar)
2264 ;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc
2265 ;;; icalendar.el ends here