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