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