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