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