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