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