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