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