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