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