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