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