Merge branch 'master' into comment-cache
[emacs.git] / lisp / calendar / icalendar.el
blobaa092b233efe565dd19e92fa2678e73ab62f72ed
1 ;;; icalendar.el --- iCalendar implementation -*- lexical-binding: t -*-
3 ;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
5 ;; Author: Ulf Jasper <ulf.jasper@web.de>
6 ;; Created: August 2002
7 ;; Keywords: calendar
8 ;; Human-Keywords: calendar, diary, iCalendar, vCalendar
9 ;; Version: 0.19
11 ;; This file is part of GNU Emacs.
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.
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.
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/>.
26 ;;; Commentary:
28 ;; This package is documented in the Emacs Manual.
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 ;; - Float diary entries are assumed to occur the first time on the
38 ;; day when they are exported.
40 ;;; History:
42 ;; 0.07 onwards: see commit logs and ../ChangeLog*.
44 ;; 0.06: (2004-10-06)
45 ;; - Bugfixes regarding icalendar-import-format-*.
46 ;; - Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau.
48 ;; 0.05: (2003-06-19)
49 ;; - New import format scheme: Replaced icalendar-import-prefix-*,
50 ;; icalendar-import-ignored-properties, and
51 ;; icalendar-import-separator with icalendar-import-format(-*).
52 ;; - icalendar-import-file and icalendar-convert-diary-to-ical
53 ;; have an extra parameter which should prevent them from
54 ;; erasing their target files (untested!).
55 ;; - Tested with Emacs 21.3.2
57 ;; 0.04:
58 ;; - Bugfix: import: double quoted param values did not work
59 ;; - Read DURATION property when importing.
60 ;; - Added parameter icalendar-duration-correction.
62 ;; 0.03: (2003-05-07)
63 ;; - Export takes care of european-calendar-style.
64 ;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12
66 ;; 0.02:
67 ;; - Should work in XEmacs now. Thanks to Len Trigg for the XEmacs patches!
68 ;; - Added exporting from Emacs diary to ical.
69 ;; - Some bugfixes, after testing with calendars from http://icalshare.com.
70 ;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12
72 ;; 0.01: (2003-03-21)
73 ;; - First published version. Trial version. Alpha version.
75 ;; ======================================================================
76 ;; To Do:
78 ;; * Import from ical to diary:
79 ;; + Need more properties for icalendar-import-format
80 ;; (added all that Mozilla Calendar uses)
81 ;; From iCal specifications (RFC2445: 4.8.1), icalendar.el lacks
82 ;; ATTACH, CATEGORIES, COMMENT, GEO, PERCENT-COMPLETE (VTODO),
83 ;; PRIORITY, RESOURCES) not considering date/time and time-zone
84 ;; + check vcalendar version
85 ;; + check (unknown) elements
86 ;; + recurring events!
87 ;; + works for european style calendars only! Does it?
88 ;; + alarm
89 ;; + exceptions in recurring events
90 ;; + the parser is too soft
91 ;; + error log is incomplete
92 ;; + nice to have: #include "webcal://foo.com/some-calendar.ics"
93 ;; + timezones probably still need some improvements.
95 ;; * Export from diary to ical
96 ;; + diary-date, diary-float, and self-made sexp entries are not
97 ;; understood
99 ;; * Other things
100 ;; + clean up all those date/time parsing functions
101 ;; + Handle todo items?
102 ;; + Check iso 8601 for datetime and period
103 ;; + Which chars to (un)escape?
106 ;;; Code:
108 (defconst icalendar-version "0.19"
109 "Version number of icalendar.el.")
111 ;; ======================================================================
112 ;; Customizables
113 ;; ======================================================================
114 (defgroup icalendar nil
115 "iCalendar support."
116 :prefix "icalendar-"
117 :group 'calendar)
119 (defcustom icalendar-import-format
120 "%s%d%l%o"
121 "Format for importing events from iCalendar into Emacs diary.
122 It defines how iCalendar events are inserted into diary file.
123 This may either be a string or a function.
125 In case of a formatting STRING the following specifiers can be used:
126 %c Class, see `icalendar-import-format-class'
127 %d Description, see `icalendar-import-format-description'
128 %l Location, see `icalendar-import-format-location'
129 %o Organizer, see `icalendar-import-format-organizer'
130 %s Summary, see `icalendar-import-format-summary'
131 %t Status, see `icalendar-import-format-status'
132 %u URL, see `icalendar-import-format-url'
133 %U UID, see `icalendar-import-format-uid'
135 A formatting FUNCTION will be called with a VEVENT as its only
136 argument. It must return a string. See
137 `icalendar-import-format-sample' for an example."
138 :type '(choice
139 (string :tag "String")
140 (function :tag "Function"))
141 :group 'icalendar)
143 (defcustom icalendar-import-format-summary
144 "%s"
145 "Format string defining how the summary element is formatted.
146 This applies only if the summary is not empty! `%s' is replaced
147 by the summary."
148 :type 'string
149 :group 'icalendar)
151 (defcustom icalendar-import-format-description
152 "\n Desc: %s"
153 "Format string defining how the description element is formatted.
154 This applies only if the description is not empty! `%s' is
155 replaced by the description."
156 :type 'string
157 :group 'icalendar)
159 (defcustom icalendar-import-format-location
160 "\n Location: %s"
161 "Format string defining how the location element is formatted.
162 This applies only if the location is not empty! `%s' is replaced
163 by the location."
164 :type 'string
165 :group 'icalendar)
167 (defcustom icalendar-import-format-organizer
168 "\n Organizer: %s"
169 "Format string defining how the organizer element is formatted.
170 This applies only if the organizer is not empty! `%s' is
171 replaced by the organizer."
172 :type 'string
173 :group 'icalendar)
175 (defcustom icalendar-import-format-url
176 "\n URL: %s"
177 "Format string defining how the URL element is formatted.
178 This applies only if the URL is not empty! `%s' is replaced by
179 the URL."
180 :type 'string
181 :group 'icalendar)
183 (defcustom icalendar-import-format-uid
184 "\n UID: %s"
185 "Format string defining how the UID element is formatted.
186 This applies only if the UID is not empty! `%s' is replaced by
187 the UID."
188 :type 'string
189 :version "24.3"
190 :group 'icalendar)
192 (defcustom icalendar-import-format-status
193 "\n Status: %s"
194 "Format string defining how the status element is formatted.
195 This applies only if the status is not empty! `%s' is replaced by
196 the status."
197 :type 'string
198 :group 'icalendar)
200 (defcustom icalendar-import-format-class
201 "\n Class: %s"
202 "Format string defining how the class element is formatted.
203 This applies only if the class is not empty! `%s' is replaced by
204 the class."
205 :type 'string
206 :group 'icalendar)
208 (defcustom icalendar-recurring-start-year
209 2005
210 "Start year for recurring events.
211 Some calendar browsers only propagate recurring events for
212 several years beyond the start time. Set this string to a year
213 just before the start of your personal calendar."
214 :type 'integer
215 :group 'icalendar)
217 (defcustom icalendar-export-hidden-diary-entries
219 "Determines whether hidden diary entries are exported.
220 If non-nil hidden diary entries (starting with `&') get exported,
221 if nil they are ignored."
222 :type 'boolean
223 :group 'icalendar)
225 (defcustom icalendar-uid-format
226 "emacs%t%c"
227 "Format of unique ID code (UID) for each iCalendar object.
228 The following specifiers are available:
229 %c COUNTER, an integer value that is increased each time a uid is
230 generated. This may be necessary for systems which do not
231 provide time-resolution finer than a second.
232 %h HASH, a hash value of the diary entry,
233 %s DTSTART, the start date (excluding time) of the diary entry,
234 %t TIMESTAMP, a unique creation timestamp,
235 %u USERNAME, the variable `user-login-name'.
237 For example, a value of \"%s_%h@mydomain.com\" will generate a
238 UID code for each entry composed of the time of the event, a hash
239 code for the event, and your personal domain name."
240 :type 'string
241 :group 'icalendar)
243 (defcustom icalendar-export-sexp-enumeration-days
245 "Number of days over which a sexp diary entry is enumerated.
246 In general sexp entries cannot be translated to icalendar format.
247 They are therefore enumerated, i.e. explicitly evaluated for a
248 certain number of days, and then exported. The enumeration starts
249 on the current day and continues for the number of days given here.
251 See `icalendar-export-sexp-enumerate-all' for a list of sexp
252 entries which by default are NOT enumerated."
253 :version "25.1"
254 :type 'integer
255 :group 'icalendar)
257 (defcustom icalendar-export-sexp-enumerate-all
259 "Determines whether ALL sexp diary entries are enumerated.
260 If non-nil all sexp diary entries are enumerated for
261 `icalendar-export-sexp-enumeration-days' days instead of
262 translating into an icalendar equivalent. This affects the
263 following sexp diary entries: `diary-anniversary',
264 `diary-cyclic', `diary-date', `diary-float', `diary-block'. All
265 other sexp entries are enumerated in any case."
266 :version "25.1"
267 :type 'boolean
268 :group 'icalendar)
271 (defcustom icalendar-export-alarms
273 "Determine if and how alarms are included in exported diary events."
274 :version "25.1"
275 :type '(choice (const :tag "Do not include alarms in export"
276 nil)
277 (list :tag "Create alarms in exported diary entries"
278 (integer :tag "Advance time (minutes)"
279 :value 10)
280 (set :tag "Alarm type"
281 (list :tag "Audio"
282 (const audio :tag "Audio"))
283 (list :tag "Display"
284 (const display :tag "Display"))
285 (list :tag "Email"
286 (const email)
287 (repeat :tag "Attendees"
288 (string :tag "Email"))))))
289 :group 'icalendar)
292 (defvar icalendar-debug nil
293 "Enable icalendar debug messages.")
295 ;; ======================================================================
296 ;; NO USER SERVICEABLE PARTS BELOW THIS LINE
297 ;; ======================================================================
299 (defconst icalendar--weekday-array ["SU" "MO" "TU" "WE" "TH" "FR" "SA"])
301 ;; ======================================================================
302 ;; all the other libs we need
303 ;; ======================================================================
304 (require 'calendar)
305 (require 'diary-lib)
307 ;; ======================================================================
308 ;; misc
309 ;; ======================================================================
310 (defun icalendar--dmsg (&rest args)
311 "Print message ARGS if `icalendar-debug' is non-nil."
312 (if icalendar-debug
313 (apply 'message args)))
315 ;; ======================================================================
316 ;; Core functionality
317 ;; Functions for parsing icalendars, importing and so on
318 ;; ======================================================================
320 (defun icalendar--get-unfolded-buffer (folded-ical-buffer)
321 "Return a new buffer containing the unfolded contents of a buffer.
322 Folding is the iCalendar way of wrapping long lines. In the
323 created buffer all occurrences of CR LF BLANK are replaced by the
324 empty string. Argument FOLDED-ICAL-BUFFER is the folded input
325 buffer."
326 (let ((unfolded-buffer (get-buffer-create " *icalendar-work*")))
327 (save-current-buffer
328 (set-buffer unfolded-buffer)
329 (erase-buffer)
330 (insert-buffer-substring folded-ical-buffer)
331 (icalendar--clean-up-line-endings)
332 (goto-char (point-min))
333 (while (re-search-forward "\r?\n[ \t]" nil t)
334 (replace-match "" nil nil)))
335 unfolded-buffer))
337 (defun icalendar--clean-up-line-endings ()
338 "Replace DOS- and MAC-like line endings with unix line endings.
339 All occurrences of (CR LF) and (LF CF) are replaced with LF in
340 the current buffer. This is necessary in buffers which contain a
341 mix of different line endings."
342 (save-excursion
343 (goto-char (point-min))
344 (while (re-search-forward "\r\n\\|\n\r" nil t)
345 (replace-match "\n" nil nil))))
347 (defsubst icalendar--rris (regexp rep string &optional fixedcase literal)
348 "Replace regular expression in string.
349 Pass arguments REGEXP REP STRING FIXEDCASE LITERAL to
350 `replace-regexp-in-string' (Emacs) or to `replace-in-string' (XEmacs)."
351 (cond ((fboundp 'replace-regexp-in-string)
352 ;; Emacs:
353 (replace-regexp-in-string regexp rep string fixedcase literal))
354 ((fboundp 'replace-in-string)
355 ;; XEmacs:
356 (save-match-data ;; apparently XEmacs needs save-match-data
357 (replace-in-string string regexp rep literal)))))
359 (defun icalendar--read-element (invalue inparams)
360 "Recursively read the next iCalendar element in the current buffer.
361 INVALUE gives the current iCalendar element we are reading.
362 INPARAMS gives the current parameters.....
363 This function calls itself recursively for each nested calendar element
364 it finds. The current buffer should be an unfolded buffer as returned
365 from `icalendar--get-unfolded-buffer'."
366 (let (element children line name params param param-name param-value
367 value
368 (continue t))
369 (setq children '())
370 (while (and continue
371 (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t))
372 (setq name (intern (match-string 1)))
373 (backward-char 1)
374 (setq params '())
375 (setq line '())
376 (while (looking-at ";")
377 (re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil)
378 (setq param-name (intern (match-string 1)))
379 (re-search-forward "\\(\\([^;,:\"]+\\)\\|\"\\([^\"]+\\)\"\\)[;:]"
380 nil t)
381 (backward-char 1)
382 (setq param-value (or (match-string 2) (match-string 3)))
383 (setq param (list param-name param-value))
384 (while (looking-at ",")
385 (re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)"
386 nil t)
387 (if (match-string 2)
388 (setq param-value (match-string 2))
389 (setq param-value (match-string 3)))
390 (setq param (append param param-value)))
391 (setq params (append params param)))
392 (unless (looking-at ":")
393 (error "Oops"))
394 (forward-char 1)
395 (let ((start (point)))
396 (end-of-line)
397 (setq value (buffer-substring start (point))))
398 (setq line (list name params value))
399 (cond ((eq name 'BEGIN)
400 (setq children
401 (append children
402 (list (icalendar--read-element (intern value)
403 params)))))
404 ((eq name 'END)
405 (setq continue nil))
407 (setq element (append element (list line))))))
408 (if invalue
409 (list invalue inparams element children)
410 children)))
412 ;; ======================================================================
413 ;; helper functions for examining events
414 ;; ======================================================================
416 ;;(defsubst icalendar--get-all-event-properties (event)
417 ;; "Return the list of properties in this EVENT."
418 ;; (car (cddr event)))
420 (defun icalendar--get-event-property (event prop)
421 "For the given EVENT return the value of the first occurrence of PROP."
422 (catch 'found
423 (let ((props (car (cddr event))) pp)
424 (while props
425 (setq pp (car props))
426 (if (eq (car pp) prop)
427 (throw 'found (car (cddr pp))))
428 (setq props (cdr props))))
429 nil))
431 (defun icalendar--get-event-property-attributes (event prop)
432 "For the given EVENT return attributes of the first occurrence of PROP."
433 (catch 'found
434 (let ((props (car (cddr event))) pp)
435 (while props
436 (setq pp (car props))
437 (if (eq (car pp) prop)
438 (throw 'found (cadr pp)))
439 (setq props (cdr props))))
440 nil))
442 (defun icalendar--get-event-properties (event prop)
443 "For the given EVENT return a list of all values of the property PROP."
444 (let ((props (car (cddr event))) pp result)
445 (while props
446 (setq pp (car props))
447 (if (eq (car pp) prop)
448 (setq result (append (split-string (car (cddr pp)) ",") result)))
449 (setq props (cdr props)))
450 result))
452 ;; (defun icalendar--set-event-property (event prop new-value)
453 ;; "For the given EVENT set the property PROP to the value NEW-VALUE."
454 ;; (catch 'found
455 ;; (let ((props (car (cddr event))) pp)
456 ;; (while props
457 ;; (setq pp (car props))
458 ;; (when (eq (car pp) prop)
459 ;; (setcdr (cdr pp) new-value)
460 ;; (throw 'found (car (cddr pp))))
461 ;; (setq props (cdr props)))
462 ;; (setq props (car (cddr event)))
463 ;; (setcar (cddr event)
464 ;; (append props (list (list prop nil new-value)))))))
466 (defun icalendar--get-children (node name)
467 "Return all children of the given NODE which have a name NAME.
468 For instance the VCALENDAR node can have VEVENT children as well as VTODO
469 children."
470 (let ((result nil)
471 (children (cadr (cddr node))))
472 (when (eq (car node) name)
473 (setq result node))
474 ;;(message "%s" node)
475 (when children
476 (let ((subresult
477 (delq nil
478 (mapcar (lambda (n)
479 (icalendar--get-children n name))
480 children))))
481 (if subresult
482 (if result
483 (setq result (append result subresult))
484 (setq result subresult)))))
485 result))
487 ;; private
488 (defun icalendar--all-events (icalendar)
489 "Return the list of all existing events in the given ICALENDAR."
490 (let ((result '()))
491 (mapc (lambda (elt)
492 (setq result (append (icalendar--get-children elt 'VEVENT)
493 result)))
494 (nreverse icalendar))
495 result))
497 (defun icalendar--split-value (value-string)
498 "Split VALUE-STRING at `;='."
499 (let ((result '())
500 param-name param-value)
501 (when value-string
502 (save-current-buffer
503 (set-buffer (get-buffer-create " *icalendar-work*"))
504 (set-buffer-modified-p nil)
505 (erase-buffer)
506 (insert value-string)
507 (goto-char (point-min))
508 (while
509 (re-search-forward
510 "\\([A-Za-z0-9-]+\\)=\\(\\([^;:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
511 nil t)
512 (setq param-name (intern (match-string 1)))
513 (setq param-value (match-string 2))
514 (setq result
515 (append result (list (list param-name param-value)))))))
516 result))
518 (defun icalendar--convert-tz-offset (alist dst-p)
519 "Return a cons of two strings representing a timezone start.
520 ALIST is an alist entry from a VTIMEZONE, like STANDARD.
521 DST-P is non-nil if this is for daylight savings time.
522 The strings are suitable for assembling into a TZ variable."
523 (let* ((offsetto (car (cddr (assq 'TZOFFSETTO alist))))
524 (offsetfrom (car (cddr (assq 'TZOFFSETFROM alist))))
525 (rrule-value (car (cddr (assq 'RRULE alist))))
526 (dtstart (car (cddr (assq 'DTSTART alist))))
527 (no-dst (equal offsetto offsetfrom)))
528 ;; FIXME: for now we only handle RRULE and not RDATE here.
529 (when (and offsetto dtstart (or rrule-value no-dst))
530 (let* ((rrule (icalendar--split-value rrule-value))
531 (freq (cadr (assq 'FREQ rrule)))
532 (bymonth (cadr (assq 'BYMONTH rrule)))
533 (byday (cadr (assq 'BYDAY rrule))))
534 ;; FIXME: we don't correctly handle WKST here.
535 (if (or no-dst (and (string= freq "YEARLY") bymonth))
536 (cons
537 (concat
538 ;; Fake a name.
539 (if dst-p "DST" "STD")
540 ;; For TZ, OFFSET is added to the local time. So,
541 ;; invert the values.
542 (if (eq (aref offsetto 0) ?-) "+" "-")
543 (substring offsetto 1 3)
545 (substring offsetto 3 5))
546 ;; The start time.
547 (let* ((day (if no-dst
549 (icalendar--get-weekday-number (substring byday -2))))
550 (week (if no-dst
552 (if (eq day -1)
553 byday
554 (substring byday 0 -2)))))
555 ;; "Translate" the iCalendar way to specify the last
556 ;; (sun|mon|...)day in month to the tzset way.
557 (if (string= week "-1") ; last day as iCalendar calls it
558 (setq week "5")) ; last day as tzset calls it
559 (when no-dst (setq bymonth "1"))
560 (concat "M" bymonth "." week "." (if (eq day -1) "0"
561 (int-to-string day))
562 ;; Start time.
564 (substring dtstart -6 -4)
566 (substring dtstart -4 -2)
568 (substring dtstart -2)))))))))
570 (defun icalendar--parse-vtimezone (alist)
571 "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
572 Return nil if timezone cannot be parsed."
573 (let* ((tz-id (icalendar--convert-string-for-import
574 (icalendar--get-event-property alist 'TZID)))
575 (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT))))
576 (day (and daylight (icalendar--convert-tz-offset daylight t)))
577 (standard (cadr (cdar (icalendar--get-children alist 'STANDARD))))
578 (std (and standard (icalendar--convert-tz-offset standard nil))))
579 (if (and tz-id std)
580 (cons tz-id
581 (if day
582 (concat (car std) (car day)
583 "," (cdr day) "," (cdr std))
584 (car std))))))
586 (defun icalendar--convert-all-timezones (icalendar)
587 "Convert all timezones in the ICALENDAR into an alist.
588 Each element of the alist is a cons (ID . TZ-STRING),
589 like `icalendar--parse-vtimezone'."
590 (let (result)
591 (dolist (zone (icalendar--get-children (car icalendar) 'VTIMEZONE))
592 (setq zone (icalendar--parse-vtimezone zone))
593 (if zone
594 (setq result (cons zone result))))
595 result))
597 (defun icalendar--find-time-zone (prop-list zone-map)
598 "Return a timezone string for the time zone in PROP-LIST, or nil if none.
599 ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'."
600 (let ((id (plist-get prop-list 'TZID)))
601 (if id
602 (cdr (assoc id zone-map)))))
604 (defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift
605 zone)
606 "Return ISODATETIMESTRING in format like `decode-time'.
607 Converts from ISO-8601 to Emacs representation. If
608 ISODATETIMESTRING specifies UTC time (trailing letter Z) the
609 decoded time is given in the local time zone! If optional
610 parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
611 days.
612 ZONE, if provided, is the timezone, in any format understood by `encode-time'.
614 FIXME: multiple comma-separated values should be allowed!"
615 (icalendar--dmsg isodatetimestring)
616 (if isodatetimestring
617 ;; day/month/year must be present
618 (let ((year (read (substring isodatetimestring 0 4)))
619 (month (read (substring isodatetimestring 4 6)))
620 (day (read (substring isodatetimestring 6 8)))
621 (hour 0)
622 (minute 0)
623 (second 0))
624 (when (> (length isodatetimestring) 12)
625 ;; hour/minute present
626 (setq hour (read (substring isodatetimestring 9 11)))
627 (setq minute (read (substring isodatetimestring 11 13))))
628 (when (> (length isodatetimestring) 14)
629 ;; seconds present
630 (setq second (read (substring isodatetimestring 13 15))))
631 (when (and (> (length isodatetimestring) 15)
632 ;; UTC specifier present
633 (char-equal ?Z (aref isodatetimestring 15)))
634 (setq zone t))
635 ;; shift if necessary
636 (if day-shift
637 (let ((mdy (calendar-gregorian-from-absolute
638 (+ (calendar-absolute-from-gregorian
639 (list month day year))
640 day-shift))))
641 (setq month (nth 0 mdy))
642 (setq day (nth 1 mdy))
643 (setq year (nth 2 mdy))))
644 ;; create the decoded date-time
645 ;; FIXME!?!
646 (condition-case nil
647 (decode-time (encode-time second minute hour day month year zone))
648 (error
649 (message "Cannot decode \"%s\"" isodatetimestring)
650 ;; hope for the best...
651 (list second minute hour day month year 0 nil 0))))
652 ;; isodatetimestring == nil
653 nil))
655 (defun icalendar--decode-isoduration (isodurationstring
656 &optional duration-correction)
657 "Convert ISODURATIONSTRING into format provided by `decode-time'.
658 Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING
659 specifies UTC time (trailing letter Z) the decoded time is given in
660 the local time zone!
662 Optional argument DURATION-CORRECTION shortens result by one day.
664 FIXME: TZID-attributes are ignored....!
665 FIXME: multiple comma-separated values should be allowed!"
666 (if isodurationstring
667 (save-match-data
668 (string-match
669 (concat
670 "^P[+-]?\\("
671 "\\(\\([0-9]+\\)D\\)" ; days only
672 "\\|"
673 "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days
674 "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time
675 "\\|"
676 "\\(\\([0-9]+\\)W\\)" ; weeks only
677 "\\)$") isodurationstring)
678 (let ((seconds 0)
679 (minutes 0)
680 (hours 0)
681 (days 0)
682 (months 0)
683 (years 0))
684 (cond
685 ((match-beginning 2) ;days only
686 (setq days (read (substring isodurationstring
687 (match-beginning 3)
688 (match-end 3))))
689 (when duration-correction
690 (setq days (1- days))))
691 ((match-beginning 4) ;days and time
692 (if (match-beginning 5)
693 (setq days (* 7 (read (substring isodurationstring
694 (match-beginning 6)
695 (match-end 6))))))
696 (if (match-beginning 7)
697 (setq hours (read (substring isodurationstring
698 (match-beginning 8)
699 (match-end 8)))))
700 (if (match-beginning 9)
701 (setq minutes (read (substring isodurationstring
702 (match-beginning 10)
703 (match-end 10)))))
704 (if (match-beginning 11)
705 (setq seconds (read (substring isodurationstring
706 (match-beginning 12)
707 (match-end 12))))))
708 ((match-beginning 13) ;weeks only
709 (setq days (* 7 (read (substring isodurationstring
710 (match-beginning 14)
711 (match-end 14)))))))
712 (list seconds minutes hours days months years)))
713 ;; isodatetimestring == nil
714 nil))
716 (defun icalendar--add-decoded-times (time1 time2)
717 "Add TIME1 to TIME2.
718 Both times must be given in decoded form. One of these times must be
719 valid (year > 1900 or something)."
720 ;; FIXME: does this function exist already?
721 (decode-time (encode-time
722 (+ (nth 0 time1) (nth 0 time2))
723 (+ (nth 1 time1) (nth 1 time2))
724 (+ (nth 2 time1) (nth 2 time2))
725 (+ (nth 3 time1) (nth 3 time2))
726 (+ (nth 4 time1) (nth 4 time2))
727 (+ (nth 5 time1) (nth 5 time2))
730 ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
733 (defun icalendar--datetime-to-american-date (datetime &optional separator)
734 "Convert the decoded DATETIME to American-style format.
735 Optional argument SEPARATOR gives the separator between month,
736 day, and year. If nil a blank character is used as separator.
737 American format: \"month day year\"."
738 (if datetime
739 (format "%d%s%d%s%d" (nth 4 datetime) ;month
740 (or separator " ")
741 (nth 3 datetime) ;day
742 (or separator " ")
743 (nth 5 datetime)) ;year
744 ;; datetime == nil
745 nil))
747 (define-obsolete-function-alias 'icalendar--datetime-to-noneuropean-date
748 'icalendar--datetime-to-american-date "icalendar 0.19")
750 (defun icalendar--datetime-to-european-date (datetime &optional separator)
751 "Convert the decoded DATETIME to European format.
752 Optional argument SEPARATOR gives the separator between month,
753 day, and year. If nil a blank character is used as separator.
754 European format: (day month year).
755 FIXME"
756 (if datetime
757 (format "%d%s%d%s%d" (nth 3 datetime) ;day
758 (or separator " ")
759 (nth 4 datetime) ;month
760 (or separator " ")
761 (nth 5 datetime)) ;year
762 ;; datetime == nil
763 nil))
765 (defun icalendar--datetime-to-iso-date (datetime &optional separator)
766 "Convert the decoded DATETIME to ISO format.
767 Optional argument SEPARATOR gives the separator between month,
768 day, and year. If nil a blank character is used as separator.
769 ISO format: (year month day)."
770 (if datetime
771 (format "%d%s%d%s%d" (nth 5 datetime) ;year
772 (or separator " ")
773 (nth 4 datetime) ;month
774 (or separator " ")
775 (nth 3 datetime)) ;day
776 ;; datetime == nil
777 nil))
779 (defun icalendar--datetime-to-diary-date (datetime &optional separator)
780 "Convert the decoded DATETIME to diary format.
781 Optional argument SEPARATOR gives the separator between month,
782 day, and year. If nil a blank character is used as separator.
783 Call icalendar--datetime-to-*-date according to the current
784 calendar date style."
785 (funcall (intern-soft (format "icalendar--datetime-to-%s-date"
786 calendar-date-style))
787 datetime separator))
789 (defun icalendar--datetime-to-colontime (datetime)
790 "Extract the time part of a decoded DATETIME into 24-hour format.
791 Note that this silently ignores seconds."
792 (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime)))
794 (defun icalendar--get-month-number (monthname)
795 "Return the month number for the given MONTHNAME."
796 (catch 'found
797 (let ((num 1)
798 (m (downcase monthname)))
799 (mapc (lambda (month)
800 (let ((mm (downcase month)))
801 (if (or (string-equal mm m)
802 (string-equal (substring mm 0 3) m))
803 (throw 'found num))
804 (setq num (1+ num))))
805 calendar-month-name-array))
806 ;; Error:
807 -1))
809 (defun icalendar--get-weekday-number (abbrevweekday)
810 "Return the number for the ABBREVWEEKDAY."
811 (if abbrevweekday
812 (catch 'found
813 (let ((num 0)
814 (aw (downcase abbrevweekday)))
815 (mapc (lambda (day)
816 (let ((d (downcase day)))
817 (if (string-equal d aw)
818 (throw 'found num))
819 (setq num (1+ num))))
820 icalendar--weekday-array)))
821 ;; Error:
822 -1))
824 (defun icalendar--get-weekday-numbers (abbrevweekdays)
825 "Return the list of numbers for the comma-separated ABBREVWEEKDAYS."
826 (when abbrevweekdays
827 (let* ((num -1)
828 (weekday-alist (mapcar (lambda (day)
829 (progn
830 (setq num (1+ num))
831 (cons (downcase day) num)))
832 icalendar--weekday-array)))
833 (delq nil
834 (mapcar (lambda (abbrevday)
835 (cdr (assoc abbrevday weekday-alist)))
836 (split-string (downcase abbrevweekdays) ","))))))
838 (defun icalendar--get-weekday-abbrev (weekday)
839 "Return the abbreviated WEEKDAY."
840 (catch 'found
841 (let ((num 0)
842 (w (downcase weekday)))
843 (mapc (lambda (day)
844 (let ((d (downcase day)))
845 (if (or (string-equal d w)
846 (string-equal (substring d 0 3) w))
847 (throw 'found (aref icalendar--weekday-array num)))
848 (setq num (1+ num))))
849 calendar-day-name-array))
850 ;; Error:
851 nil))
853 (defun icalendar--date-to-isodate (date &optional day-shift)
854 "Convert DATE to iso-style date.
855 DATE must be a list of the form (month day year).
856 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
857 (let ((mdy (calendar-gregorian-from-absolute
858 (+ (calendar-absolute-from-gregorian date)
859 (or day-shift 0)))))
860 (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
863 (defun icalendar--datestring-to-isodate (datestring &optional day-shift)
864 "Convert diary-style DATESTRING to iso-style date.
865 If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
866 -- DAY-SHIFT must be either nil or an integer. This function
867 tries to figure the date style from DATESTRING itself. If that
868 is not possible it uses the current calendar date style."
869 (let ((day -1) month year)
870 (save-match-data
871 (cond ( ;; iso-style numeric date
872 (string-match (concat "\\s-*"
873 "\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
874 "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
875 "0?\\([1-9][0-9]?\\)")
876 datestring)
877 (setq year (read (substring datestring (match-beginning 1)
878 (match-end 1))))
879 (setq month (read (substring datestring (match-beginning 2)
880 (match-end 2))))
881 (setq day (read (substring datestring (match-beginning 3)
882 (match-end 3)))))
883 ( ;; non-iso numeric date -- must rely on configured
884 ;; calendar style
885 (string-match (concat "\\s-*"
886 "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
887 "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
888 "\\([0-9]\\{4\\}\\)")
889 datestring)
890 (setq day (read (substring datestring (match-beginning 1)
891 (match-end 1))))
892 (setq month (read (substring datestring (match-beginning 2)
893 (match-end 2))))
894 (setq year (read (substring datestring (match-beginning 3)
895 (match-end 3))))
896 (if (eq calendar-date-style 'american)
897 (let ((x month))
898 (setq month day)
899 (setq day x))))
900 ( ;; date contains month names -- iso style
901 (string-match (concat "\\s-*"
902 "\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
903 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
904 "0?\\([123]?[0-9]\\)")
905 datestring)
906 (setq year (read (substring datestring (match-beginning 1)
907 (match-end 1))))
908 (setq month (icalendar--get-month-number
909 (substring datestring (match-beginning 2)
910 (match-end 2))))
911 (setq day (read (substring datestring (match-beginning 3)
912 (match-end 3)))))
913 ( ;; date contains month names -- european style
914 (string-match (concat "\\s-*"
915 "0?\\([123]?[0-9]\\)[ \t/]\\s-*"
916 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
917 "\\([0-9]\\{4\\}\\)")
918 datestring)
919 (setq day (read (substring datestring (match-beginning 1)
920 (match-end 1))))
921 (setq month (icalendar--get-month-number
922 (substring datestring (match-beginning 2)
923 (match-end 2))))
924 (setq year (read (substring datestring (match-beginning 3)
925 (match-end 3)))))
926 ( ;; date contains month names -- american style
927 (string-match (concat "\\s-*"
928 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
929 "0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
930 "\\([0-9]\\{4\\}\\)")
931 datestring)
932 (setq day (read (substring datestring (match-beginning 2)
933 (match-end 2))))
934 (setq month (icalendar--get-month-number
935 (substring datestring (match-beginning 1)
936 (match-end 1))))
937 (setq year (read (substring datestring (match-beginning 3)
938 (match-end 3)))))
940 nil)))
941 (if (> day 0)
942 (let ((mdy (calendar-gregorian-from-absolute
943 (+ (calendar-absolute-from-gregorian (list month day
944 year))
945 (or day-shift 0)))))
946 (icalendar--dmsg (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
947 (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
948 nil)))
950 (defun icalendar--diarytime-to-isotime (timestring ampmstring)
951 "Convert a time like 9:30pm to an iso-conform string like T213000.
952 In this example the TIMESTRING would be \"9:30\" and the
953 AMPMSTRING would be \"pm\". The minutes may be missing as long
954 as the colon is missing as well, i.e. \"9\" is allowed as
955 TIMESTRING and has the same result as \"9:00\"."
956 (if timestring
957 (let* ((parts (save-match-data (split-string timestring ":")))
958 (h (car parts))
959 (m (if (cdr parts) (cadr parts)
960 (if (> (length h) 2) "" "00")))
961 (starttimenum (read (concat h m))))
962 ;; take care of am/pm style
963 ;; Be sure *not* to convert 12:00pm - 12:59pm to 2400-2459
964 (if (and ampmstring (string= "pm" ampmstring) (< starttimenum 1200))
965 (setq starttimenum (+ starttimenum 1200)))
966 ;; Similar effect with 12:00am - 12:59am (need to convert to 0000-0059)
967 (if (and ampmstring (string= "am" ampmstring) (>= starttimenum 1200))
968 (setq starttimenum (- starttimenum 1200)))
969 (format "T%04d00" starttimenum))
970 nil))
972 (defun icalendar--convert-string-for-export (string)
973 "Escape comma and other critical characters in STRING."
974 (icalendar--rris "," "\\\\," string))
976 (defun icalendar--convert-string-for-import (string)
977 "Remove escape chars for comma, semicolon etc. from STRING."
978 (icalendar--rris
979 "\\\\n" "\n " (icalendar--rris
980 "\\\\\"" "\"" (icalendar--rris
981 "\\\\;" ";" (icalendar--rris
982 "\\\\," "," string)))))
984 ;; ======================================================================
985 ;; Export -- convert emacs-diary to iCalendar
986 ;; ======================================================================
988 ;;;###autoload
989 (defun icalendar-export-file (diary-filename ical-filename)
990 "Export diary file to iCalendar format.
991 All diary entries in the file DIARY-FILENAME are converted to iCalendar
992 format. The result is appended to the file ICAL-FILENAME."
993 (interactive "FExport diary data from file: \n\
994 Finto iCalendar file: ")
995 (save-current-buffer
996 (set-buffer (find-file diary-filename))
997 (icalendar-export-region (point-min) (point-max) ical-filename)))
999 (define-obsolete-function-alias 'icalendar-convert-diary-to-ical
1000 'icalendar-export-file "22.1")
1002 (defvar icalendar--uid-count 0
1003 "Auxiliary counter for creating unique ids.")
1005 (defun icalendar--create-uid (entry-full contents)
1006 "Construct a unique iCalendar UID for a diary entry.
1007 ENTRY-FULL is the full diary entry string. CONTENTS is the
1008 current iCalendar object, as a string. Increase
1009 `icalendar--uid-count'. Returns the UID string."
1010 (let ((uid icalendar-uid-format))
1012 ;; Allow other apps (such as org-mode) to create its own uid
1013 (get-text-property 0 'uid entry-full)
1014 (setq uid (get-text-property 0 'uid entry-full))
1015 (setq uid (replace-regexp-in-string
1016 "%c"
1017 (format "%d" icalendar--uid-count)
1018 uid t t))
1019 (setq icalendar--uid-count (1+ icalendar--uid-count))
1020 (setq uid (replace-regexp-in-string
1021 "%t"
1022 (format "%d%d%d" (car (current-time))
1023 (cadr (current-time))
1024 (car (cddr (current-time))))
1025 uid t t))
1026 (setq uid (replace-regexp-in-string
1027 "%h"
1028 (format "%d" (abs (sxhash entry-full))) uid t t))
1029 (setq uid (replace-regexp-in-string
1030 "%u" (or user-login-name "UNKNOWN_USER") uid t t))
1031 (let ((dtstart (if (string-match "^DTSTART[^:]*:\\([0-9]*\\)" contents)
1032 (substring contents (match-beginning 1) (match-end 1))
1033 "DTSTART")))
1034 (setq uid (replace-regexp-in-string "%s" dtstart uid t t))))
1036 ;; Return the UID string
1037 uid))
1039 ;;;###autoload
1040 (defun icalendar-export-region (min max ical-filename)
1041 "Export region in diary file to iCalendar format.
1042 All diary entries in the region from MIN to MAX in the current buffer are
1043 converted to iCalendar format. The result is appended to the file
1044 ICAL-FILENAME.
1045 This function attempts to return t if something goes wrong. In this
1046 case an error string which describes all the errors and problems is
1047 written into the buffer `*icalendar-errors*'."
1048 (interactive "r
1049 FExport diary data into iCalendar file: ")
1050 (let ((result "")
1051 (start 0)
1052 (entry-main "")
1053 (entry-rest "")
1054 (entry-full "")
1055 (header "")
1056 (contents-n-summary)
1057 (contents)
1058 (alarm)
1059 (found-error nil)
1060 (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
1061 "?"))
1062 (other-elements nil)
1063 (cns-cons-or-list nil))
1064 ;; prepare buffer with error messages
1065 (save-current-buffer
1066 (set-buffer (get-buffer-create "*icalendar-errors*"))
1067 (erase-buffer))
1069 ;; here we go
1070 (save-excursion
1071 (goto-char min)
1072 (while (re-search-forward
1073 ;; possibly ignore hidden entries beginning with "&"
1074 (if icalendar-export-hidden-diary-entries
1075 "^\\([^ \t\n#].+\\)\\(\\(\n[ \t].*\\)*\\)"
1076 "^\\([^ \t\n&#].+\\)\\(\\(\n[ \t].*\\)*\\)") max t)
1077 (setq entry-main (match-string 1))
1078 (if (match-beginning 2)
1079 (setq entry-rest (match-string 2))
1080 (setq entry-rest ""))
1081 (setq entry-full (concat entry-main entry-rest))
1083 (condition-case error-val
1084 (progn
1085 (setq cns-cons-or-list
1086 (icalendar--convert-to-ical nonmarker entry-main))
1087 (setq other-elements (icalendar--parse-summary-and-rest
1088 entry-full))
1089 (mapc (lambda (contents-n-summary)
1090 (setq contents (concat (car contents-n-summary)
1091 "\nSUMMARY:"
1092 (cdr contents-n-summary)))
1093 (let ((cla (cdr (assoc 'cla other-elements)))
1094 (des (cdr (assoc 'des other-elements)))
1095 (loc (cdr (assoc 'loc other-elements)))
1096 (org (cdr (assoc 'org other-elements)))
1097 (sta (cdr (assoc 'sta other-elements)))
1098 (sum (cdr (assoc 'sum other-elements)))
1099 (url (cdr (assoc 'url other-elements)))
1100 (uid (cdr (assoc 'uid other-elements))))
1101 (if cla
1102 (setq contents (concat contents "\nCLASS:" cla)))
1103 (if des
1104 (setq contents (concat contents "\nDESCRIPTION:"
1105 des)))
1106 (if loc
1107 (setq contents (concat contents "\nLOCATION:" loc)))
1108 (if org
1109 (setq contents (concat contents "\nORGANIZER:"
1110 org)))
1111 (if sta
1112 (setq contents (concat contents "\nSTATUS:" sta)))
1113 ;;(if sum
1114 ;; (setq contents (concat contents "\nSUMMARY:" sum)))
1115 (if url
1116 (setq contents (concat contents "\nURL:" url)))
1118 (setq header (concat "\nBEGIN:VEVENT\nUID:"
1119 (or uid
1120 (icalendar--create-uid
1121 entry-full contents))))
1122 (setq alarm (icalendar--create-ical-alarm
1123 (cdr contents-n-summary))))
1124 (setq result (concat result header contents alarm
1125 "\nEND:VEVENT")))
1126 (if (consp cns-cons-or-list)
1127 (list cns-cons-or-list)
1128 cns-cons-or-list)))
1129 ;; handle errors
1130 (error
1131 (setq found-error t)
1132 (save-current-buffer
1133 (set-buffer (get-buffer-create "*icalendar-errors*"))
1134 (insert (format-message "Error in line %d -- %s: `%s'\n"
1135 (count-lines (point-min) (point))
1136 error-val
1137 entry-main))))))
1139 ;; we're done, insert everything into the file
1140 (save-current-buffer
1141 (let ((coding-system-for-write 'utf-8))
1142 (set-buffer (find-file ical-filename))
1143 (goto-char (point-max))
1144 (insert "BEGIN:VCALENDAR")
1145 (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
1146 (insert "\nVERSION:2.0")
1147 (insert result)
1148 (insert "\nEND:VCALENDAR\n")
1149 ;; save the diary file
1150 (save-buffer)
1151 (unless found-error
1152 (bury-buffer)))))
1153 found-error))
1155 (defun icalendar--convert-to-ical (nonmarker entry-main)
1156 "Convert a diary entry to iCalendar format.
1157 NONMARKER is a regular expression matching the start of non-marking
1158 entries. ENTRY-MAIN is the first line of the diary entry."
1160 (unless icalendar-export-sexp-enumerate-all
1162 ;; anniversaries -- %%(diary-anniversary ...)
1163 (icalendar--convert-anniversary-to-ical nonmarker entry-main)
1164 ;; cyclic events -- %%(diary-cyclic ...)
1165 (icalendar--convert-cyclic-to-ical nonmarker entry-main)
1166 ;; diary-date -- %%(diary-date ...)
1167 (icalendar--convert-date-to-ical nonmarker entry-main)
1168 ;; float events -- %%(diary-float ...)
1169 (icalendar--convert-float-to-ical nonmarker entry-main)
1170 ;; block events -- %%(diary-block ...)
1171 (icalendar--convert-block-to-ical nonmarker entry-main)))
1172 ;; other sexp diary entries
1173 (icalendar--convert-sexp-to-ical nonmarker entry-main)
1174 ;; weekly by day -- Monday 8:30 Team meeting
1175 (icalendar--convert-weekly-to-ical nonmarker entry-main)
1176 ;; yearly by day -- 1 May Tag der Arbeit
1177 (icalendar--convert-yearly-to-ical nonmarker entry-main)
1178 ;; "ordinary" events, start and end time given
1179 ;; 1 Feb 2003 blah
1180 (icalendar--convert-ordinary-to-ical nonmarker entry-main)
1181 ;; everything else
1182 ;; Oops! what's that?
1183 (error "Could not parse entry")))
1185 (defun icalendar--parse-summary-and-rest (summary-and-rest)
1186 "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties.
1187 Returns an alist."
1188 (save-match-data
1189 (if (functionp icalendar-import-format)
1190 ;; can't do anything
1192 ;; split summary-and-rest
1193 (let* ((case-fold-search nil)
1194 (s icalendar-import-format)
1195 (p-cla (or (string-match "%c" icalendar-import-format) -1))
1196 (p-des (or (string-match "%d" icalendar-import-format) -1))
1197 (p-loc (or (string-match "%l" icalendar-import-format) -1))
1198 (p-org (or (string-match "%o" icalendar-import-format) -1))
1199 (p-sum (or (string-match "%s" icalendar-import-format) -1))
1200 (p-sta (or (string-match "%t" icalendar-import-format) -1))
1201 (p-url (or (string-match "%u" icalendar-import-format) -1))
1202 (p-uid (or (string-match "%U" icalendar-import-format) -1))
1203 (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url p-uid) '<))
1204 (ct 0)
1205 pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url pos-uid)
1206 (dotimes (i (length p-list))
1207 ;; Use 'ct' to keep track of current position in list
1208 (cond ((and (>= p-cla 0) (= (nth i p-list) p-cla))
1209 (setq ct (+ ct 1))
1210 (setq pos-cla (* 2 ct)))
1211 ((and (>= p-des 0) (= (nth i p-list) p-des))
1212 (setq ct (+ ct 1))
1213 (setq pos-des (* 2 ct)))
1214 ((and (>= p-loc 0) (= (nth i p-list) p-loc))
1215 (setq ct (+ ct 1))
1216 (setq pos-loc (* 2 ct)))
1217 ((and (>= p-org 0) (= (nth i p-list) p-org))
1218 (setq ct (+ ct 1))
1219 (setq pos-org (* 2 ct)))
1220 ((and (>= p-sta 0) (= (nth i p-list) p-sta))
1221 (setq ct (+ ct 1))
1222 (setq pos-sta (* 2 ct)))
1223 ((and (>= p-sum 0) (= (nth i p-list) p-sum))
1224 (setq ct (+ ct 1))
1225 (setq pos-sum (* 2 ct)))
1226 ((and (>= p-url 0) (= (nth i p-list) p-url))
1227 (setq ct (+ ct 1))
1228 (setq pos-url (* 2 ct)))
1229 ((and (>= p-uid 0) (= (nth i p-list) p-uid))
1230 (setq ct (+ ct 1))
1231 (setq pos-uid (* 2 ct)))) )
1232 (mapc (lambda (ij)
1233 (setq s (icalendar--rris (car ij) (cadr ij) s t t)))
1234 (list
1235 ;; summary must be first! because of %s
1236 (list "%s"
1237 (concat "\\(" icalendar-import-format-summary "\\)??"))
1238 (list "%c"
1239 (concat "\\(" icalendar-import-format-class "\\)??"))
1240 (list "%d"
1241 (concat "\\(" icalendar-import-format-description "\\)??"))
1242 (list "%l"
1243 (concat "\\(" icalendar-import-format-location "\\)??"))
1244 (list "%o"
1245 (concat "\\(" icalendar-import-format-organizer "\\)??"))
1246 (list "%t"
1247 (concat "\\(" icalendar-import-format-status "\\)??"))
1248 (list "%u"
1249 (concat "\\(" icalendar-import-format-url "\\)??"))
1250 (list "%U"
1251 (concat "\\(" icalendar-import-format-uid "\\)??"))))
1252 ;; Need the \' regexp in order to detect multi-line items
1253 (setq s (concat "\\`"
1254 (icalendar--rris "%s" "\\(.*?\\)" s nil t)
1255 "\\'"))
1256 (if (string-match s summary-and-rest)
1257 (let (cla des loc org sta sum url uid)
1258 (if (and pos-sum (match-beginning pos-sum))
1259 (setq sum (substring summary-and-rest
1260 (match-beginning pos-sum)
1261 (match-end pos-sum))))
1262 (if (and pos-cla (match-beginning pos-cla))
1263 (setq cla (substring summary-and-rest
1264 (match-beginning pos-cla)
1265 (match-end pos-cla))))
1266 (if (and pos-des (match-beginning pos-des))
1267 (setq des (substring summary-and-rest
1268 (match-beginning pos-des)
1269 (match-end pos-des))))
1270 (if (and pos-loc (match-beginning pos-loc))
1271 (setq loc (substring summary-and-rest
1272 (match-beginning pos-loc)
1273 (match-end pos-loc))))
1274 (if (and pos-org (match-beginning pos-org))
1275 (setq org (substring summary-and-rest
1276 (match-beginning pos-org)
1277 (match-end pos-org))))
1278 (if (and pos-sta (match-beginning pos-sta))
1279 (setq sta (substring summary-and-rest
1280 (match-beginning pos-sta)
1281 (match-end pos-sta))))
1282 (if (and pos-url (match-beginning pos-url))
1283 (setq url (substring summary-and-rest
1284 (match-beginning pos-url)
1285 (match-end pos-url))))
1286 (if (and pos-uid (match-beginning pos-uid))
1287 (setq uid (substring summary-and-rest
1288 (match-beginning pos-uid)
1289 (match-end pos-uid))))
1290 (list (if cla (cons 'cla cla) nil)
1291 (if des (cons 'des des) nil)
1292 (if loc (cons 'loc loc) nil)
1293 (if org (cons 'org org) nil)
1294 (if sta (cons 'sta sta) nil)
1295 ;;(if sum (cons 'sum sum) nil)
1296 (if url (cons 'url url) nil)
1297 (if uid (cons 'uid uid) nil))))))))
1299 (defun icalendar--create-ical-alarm (summary)
1300 "Return VALARM blocks for the given SUMMARY."
1301 (when icalendar-export-alarms
1302 (let* ((advance-time (car icalendar-export-alarms))
1303 (alarm-specs (cadr icalendar-export-alarms))
1304 (fun (lambda (spec)
1305 (icalendar--do-create-ical-alarm advance-time spec summary))))
1306 (mapconcat fun alarm-specs ""))))
1308 (defun icalendar--do-create-ical-alarm (advance-time alarm-spec summary)
1309 "Return a VALARM block.
1310 Argument ADVANCE-TIME is a number giving the time when the alarm
1311 fires (minutes before the respective event). Argument ALARM-SPEC
1312 is a list which must be one of (audio), (display) or
1313 (email (ADDRESS1 ...)), see `icalendar-export-alarms'. Argument
1314 SUMMARY is a string which contains a short description for the
1315 alarm."
1316 (let* ((action (car alarm-spec))
1317 (act (format "\nACTION:%s"
1318 (cdr (assoc action '((audio . "AUDIO")
1319 (display . "DISPLAY")
1320 (email . "EMAIL"))))))
1321 (tri (format "\nTRIGGER:-PT%dM" advance-time))
1322 (des (if (memq action '(display email))
1323 (format "\nDESCRIPTION:%s" summary)
1324 ""))
1325 (sum (if (eq action 'email)
1326 (format "\nSUMMARY:%s" summary)
1327 ""))
1328 (att (if (eq action 'email)
1329 (mapconcat (lambda (i)
1330 (format "\nATTENDEE:MAILTO:%s" i))
1331 (cadr alarm-spec) "")
1332 "")))
1334 (concat "\nBEGIN:VALARM" act tri des sum att "\nEND:VALARM")))
1336 ;; subroutines for icalendar-export-region
1337 (defun icalendar--convert-ordinary-to-ical (nonmarker entry-main)
1338 "Convert \"ordinary\" diary entry to iCalendar format.
1339 NONMARKER is a regular expression matching the start of non-marking
1340 entries. ENTRY-MAIN is the first line of the diary entry."
1341 (if (string-match
1342 (concat nonmarker
1343 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*" ; date
1344 "\\(\\([0-9][0-9]?\\(:[0-9][0-9]\\)?\\)\\([ap]m\\)?" ; start time
1345 "\\("
1346 "-\\([0-9][0-9]?\\(:[0-9][0-9]\\)?\\)\\([ap]m\\)?\\)?" ; end time
1347 "\\)?"
1348 "\\s-*\\(.*?\\) ?$")
1349 entry-main)
1350 (let* ((datetime (substring entry-main (match-beginning 1)
1351 (match-end 1)))
1352 (startisostring (icalendar--datestring-to-isodate
1353 datetime))
1354 (endisostring (icalendar--datestring-to-isodate
1355 datetime 1))
1356 (endisostring1)
1357 (starttimestring (icalendar--diarytime-to-isotime
1358 (if (match-beginning 3)
1359 (substring entry-main
1360 (match-beginning 3)
1361 (match-end 3))
1362 nil)
1363 (if (match-beginning 5)
1364 (substring entry-main
1365 (match-beginning 5)
1366 (match-end 5))
1367 nil)))
1368 (endtimestring (icalendar--diarytime-to-isotime
1369 (if (match-beginning 7)
1370 (substring entry-main
1371 (match-beginning 7)
1372 (match-end 7))
1373 nil)
1374 (if (match-beginning 9)
1375 (substring entry-main
1376 (match-beginning 9)
1377 (match-end 9))
1378 nil)))
1379 (summary (icalendar--convert-string-for-export
1380 (substring entry-main (match-beginning 10)
1381 (match-end 10)))))
1382 (icalendar--dmsg "ordinary %s" entry-main)
1384 (unless startisostring
1385 (error "Could not parse date"))
1387 ;; If only start-date is specified, then end-date is next day,
1388 ;; otherwise it is same day.
1389 (setq endisostring1 (if starttimestring
1390 startisostring
1391 endisostring))
1393 (when starttimestring
1394 (unless endtimestring
1395 (let ((time
1396 (read (icalendar--rris "^T0?" ""
1397 starttimestring))))
1398 (if (< time 230000)
1399 ;; Case: ends on same day
1400 (setq endtimestring (format "T%06d"
1401 (+ 10000 time)))
1402 ;; Case: ends on next day
1403 (setq endtimestring (format "T%06d"
1404 (- time 230000)))
1405 (setq endisostring1 endisostring)) )))
1407 (cons (concat "\nDTSTART;"
1408 (if starttimestring "VALUE=DATE-TIME:"
1409 "VALUE=DATE:")
1410 startisostring
1411 (or starttimestring "")
1412 "\nDTEND;"
1413 (if endtimestring "VALUE=DATE-TIME:"
1414 "VALUE=DATE:")
1415 endisostring1
1416 (or endtimestring ""))
1417 summary))
1418 ;; no match
1419 nil))
1421 (defun icalendar-first-weekday-of-year (abbrevweekday year)
1422 "Find the first ABBREVWEEKDAY in a given YEAR.
1423 Returns day number."
1424 (let* ((day-of-week-jan01 (calendar-day-of-week (list 1 1 year)))
1425 (result (+ 1
1426 (- (icalendar--get-weekday-number abbrevweekday)
1427 day-of-week-jan01))))
1428 (cond ((<= result 0)
1429 (setq result (+ result 7)))
1430 ((> result 7)
1431 (setq result (- result 7))))
1432 result))
1434 (defun icalendar--convert-weekly-to-ical (nonmarker entry-main)
1435 "Convert weekly diary entry to iCalendar format.
1436 NONMARKER is a regular expression matching the start of non-marking
1437 entries. ENTRY-MAIN is the first line of the diary entry."
1438 (if (and (string-match (concat nonmarker
1439 "\\([a-z]+\\)\\s-+"
1440 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)"
1441 "\\([ap]m\\)?"
1442 "\\(-"
1443 "\\([0-9][0-9]?:[0-9][0-9]\\)"
1444 "\\([ap]m\\)?\\)?"
1445 "\\)?"
1446 "\\s-*\\(.*?\\) ?$")
1447 entry-main)
1448 (icalendar--get-weekday-abbrev
1449 (substring entry-main (match-beginning 1)
1450 (match-end 1))))
1451 (let* ((day (icalendar--get-weekday-abbrev
1452 (substring entry-main (match-beginning 1)
1453 (match-end 1))))
1454 (starttimestring (icalendar--diarytime-to-isotime
1455 (if (match-beginning 3)
1456 (substring entry-main
1457 (match-beginning 3)
1458 (match-end 3))
1459 nil)
1460 (if (match-beginning 4)
1461 (substring entry-main
1462 (match-beginning 4)
1463 (match-end 4))
1464 nil)))
1465 (endtimestring (icalendar--diarytime-to-isotime
1466 (if (match-beginning 6)
1467 (substring entry-main
1468 (match-beginning 6)
1469 (match-end 6))
1470 nil)
1471 (if (match-beginning 7)
1472 (substring entry-main
1473 (match-beginning 7)
1474 (match-end 7))
1475 nil)))
1476 (summary (icalendar--convert-string-for-export
1477 (substring entry-main (match-beginning 8)
1478 (match-end 8)))))
1479 (icalendar--dmsg "weekly %s" entry-main)
1481 (when starttimestring
1482 (unless endtimestring
1483 (let ((time (read
1484 (icalendar--rris "^T0?" ""
1485 starttimestring))))
1486 (setq endtimestring (format "T%06d"
1487 (+ 10000 time))))))
1488 (cons (concat "\nDTSTART;"
1489 (if starttimestring
1490 "VALUE=DATE-TIME:"
1491 "VALUE=DATE:")
1492 ;; Find the first requested weekday of the
1493 ;; start year
1494 (funcall 'format "%04d%02d%02d"
1495 icalendar-recurring-start-year 1
1496 (icalendar-first-weekday-of-year
1497 day icalendar-recurring-start-year))
1498 (or starttimestring "")
1499 "\nDTEND;"
1500 (if endtimestring
1501 "VALUE=DATE-TIME:"
1502 "VALUE=DATE:")
1503 (funcall 'format "%04d%02d%02d"
1504 ;; end is non-inclusive!
1505 icalendar-recurring-start-year 1
1506 (+ (icalendar-first-weekday-of-year
1507 day icalendar-recurring-start-year)
1508 (if endtimestring 0 1)))
1509 (or endtimestring "")
1510 "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY="
1511 day)
1512 summary))
1513 ;; no match
1514 nil))
1516 (defun icalendar--convert-yearly-to-ical (nonmarker entry-main)
1517 "Convert yearly diary entry to iCalendar format.
1518 NONMARKER is a regular expression matching the start of non-marking
1519 entries. ENTRY-MAIN is the first line of the diary entry."
1520 (if (string-match (concat nonmarker
1521 (if (eq calendar-date-style 'european)
1522 "\\([0-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
1523 "\\([a-z]+\\)\\s-+\\([0-9]+[0-9]?\\)\\s-+")
1524 "\\*?\\s-*"
1525 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1526 "\\("
1527 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1528 "\\)?"
1529 "\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years
1531 entry-main)
1532 (let* ((daypos (if (eq calendar-date-style 'european) 1 2))
1533 (monpos (if (eq calendar-date-style 'european) 2 1))
1534 (day (read (substring entry-main
1535 (match-beginning daypos)
1536 (match-end daypos))))
1537 (month (icalendar--get-month-number
1538 (substring entry-main
1539 (match-beginning monpos)
1540 (match-end monpos))))
1541 (starttimestring (icalendar--diarytime-to-isotime
1542 (if (match-beginning 4)
1543 (substring entry-main
1544 (match-beginning 4)
1545 (match-end 4))
1546 nil)
1547 (if (match-beginning 5)
1548 (substring entry-main
1549 (match-beginning 5)
1550 (match-end 5))
1551 nil)))
1552 (endtimestring (icalendar--diarytime-to-isotime
1553 (if (match-beginning 7)
1554 (substring entry-main
1555 (match-beginning 7)
1556 (match-end 7))
1557 nil)
1558 (if (match-beginning 8)
1559 (substring entry-main
1560 (match-beginning 8)
1561 (match-end 8))
1562 nil)))
1563 (summary (icalendar--convert-string-for-export
1564 (substring entry-main (match-beginning 9)
1565 (match-end 9)))))
1566 (icalendar--dmsg "yearly %s" entry-main)
1568 (when starttimestring
1569 (unless endtimestring
1570 (let ((time (read
1571 (icalendar--rris "^T0?" ""
1572 starttimestring))))
1573 (setq endtimestring (format "T%06d"
1574 (+ 10000 time))))))
1575 (cons (concat "\nDTSTART;"
1576 (if starttimestring "VALUE=DATE-TIME:"
1577 "VALUE=DATE:")
1578 (format "1900%02d%02d" month day)
1579 (or starttimestring "")
1580 "\nDTEND;"
1581 (if endtimestring "VALUE=DATE-TIME:"
1582 "VALUE=DATE:")
1583 ;; end is not included! shift by one day
1584 (icalendar--date-to-isodate
1585 (list month day 1900)
1586 (if endtimestring 0 1))
1587 (or endtimestring "")
1588 "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
1589 (format "%d" month)
1590 ";BYMONTHDAY="
1591 (format "%d" day))
1592 summary))
1593 ;; no match
1594 nil))
1596 (defun icalendar--convert-sexp-to-ical (nonmarker entry-main &optional start)
1597 "Convert sexp diary entry to iCalendar format.
1598 Enumerate the evaluated sexp entry for the next
1599 `icalendar-export-sexp-enumeration-days' days. NONMARKER is a
1600 regular expression matching the start of non-marking entries.
1601 ENTRY-MAIN is the first line of the diary entry.
1603 Optional argument START determines the first day of the
1604 enumeration, given as a time value, in same format as returned by
1605 `current-time' -- used for test purposes."
1606 (cond ((string-match (concat nonmarker
1607 "%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$")
1608 entry-main)
1609 ;; simple sexp entry as generated by icalendar.el: strip off the
1610 ;; unnecessary (and)
1611 (icalendar--dmsg "diary-sexp from icalendar.el %s" entry-main)
1612 (icalendar--convert-to-ical
1613 nonmarker
1614 (concat "%%"
1615 (substring entry-main (match-beginning 1) (match-end 1))
1616 (substring entry-main (match-beginning 2) (match-end 2)))))
1617 ((string-match (concat nonmarker
1618 "%%\\(([^)]+)\\)\\s-*\\(.*\\)")
1619 entry-main)
1620 ;; regular sexp entry
1621 (icalendar--dmsg "diary-sexp %s" entry-main)
1622 (let ((p1 (substring entry-main (match-beginning 1) (match-end 1)))
1623 (p2 (substring entry-main (match-beginning 2) (match-end 2)))
1624 (now (or start (current-time))))
1625 (delete nil
1626 (mapcar
1627 (lambda (offset)
1628 (let* ((day (decode-time (time-add now
1629 (seconds-to-time
1630 (* offset 60 60 24)))))
1631 (d (nth 3 day))
1632 (m (nth 4 day))
1633 (y (nth 5 day))
1634 (se (diary-sexp-entry p1 p2 (list m d y)))
1635 (see (cond ((stringp se) se)
1636 ((consp se) (cdr se))
1637 (t nil))))
1638 (cond ((null see)
1639 nil)
1640 ((stringp see)
1641 (let ((calendar-date-style 'iso))
1642 (icalendar--convert-ordinary-to-ical
1643 nonmarker (format "%4d/%02d/%02d %s" y m d see))))
1644 (;TODO:
1645 (error "Unsupported Sexp-entry: %s"
1646 entry-main)))))
1647 (number-sequence
1648 0 (- icalendar-export-sexp-enumeration-days 1))))))
1650 ;; no match
1651 nil)))
1653 (defun icalendar--convert-block-to-ical (nonmarker entry-main)
1654 "Convert block diary entry to iCalendar format.
1655 NONMARKER is a regular expression matching the start of non-marking
1656 entries. ENTRY-MAIN is the first line of the diary entry."
1657 (if (string-match (concat nonmarker
1658 "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)"
1659 " +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1660 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1661 "\\("
1662 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1663 "\\)?"
1664 "\\s-*\\(.*?\\) ?$")
1665 entry-main)
1666 (let* ((startstring (substring entry-main
1667 (match-beginning 1)
1668 (match-end 1)))
1669 (endstring (substring entry-main
1670 (match-beginning 2)
1671 (match-end 2)))
1672 (startisostring (icalendar--datestring-to-isodate
1673 startstring))
1674 (endisostring (icalendar--datestring-to-isodate
1675 endstring))
1676 (endisostring+1 (icalendar--datestring-to-isodate
1677 endstring 1))
1678 (starttimestring (icalendar--diarytime-to-isotime
1679 (if (match-beginning 4)
1680 (substring entry-main
1681 (match-beginning 4)
1682 (match-end 4))
1683 nil)
1684 (if (match-beginning 5)
1685 (substring entry-main
1686 (match-beginning 5)
1687 (match-end 5))
1688 nil)))
1689 (endtimestring (icalendar--diarytime-to-isotime
1690 (if (match-beginning 7)
1691 (substring entry-main
1692 (match-beginning 7)
1693 (match-end 7))
1694 nil)
1695 (if (match-beginning 8)
1696 (substring entry-main
1697 (match-beginning 8)
1698 (match-end 8))
1699 nil)))
1700 (summary (icalendar--convert-string-for-export
1701 (substring entry-main (match-beginning 9)
1702 (match-end 9)))))
1703 (icalendar--dmsg "diary-block %s" entry-main)
1704 (when starttimestring
1705 (unless endtimestring
1706 (let ((time
1707 (read (icalendar--rris "^T0?" ""
1708 starttimestring))))
1709 (setq endtimestring (format "T%06d"
1710 (+ 10000 time))))))
1711 (if starttimestring
1712 ;; with time -> write rrule
1713 (cons (concat "\nDTSTART;VALUE=DATE-TIME:"
1714 startisostring
1715 starttimestring
1716 "\nDTEND;VALUE=DATE-TIME:"
1717 startisostring
1718 endtimestring
1719 "\nRRULE:FREQ=DAILY;INTERVAL=1;UNTIL="
1720 endisostring)
1721 summary)
1722 ;; no time -> write long event
1723 (cons (concat "\nDTSTART;VALUE=DATE:" startisostring
1724 "\nDTEND;VALUE=DATE:" endisostring+1)
1725 summary)))
1726 ;; no match
1727 nil))
1729 (defun icalendar--convert-float-to-ical (nonmarker entry-main)
1730 "Convert float diary entry to iCalendar format -- partially unsupported!
1732 FIXME! DAY from diary-float yet unimplemented.
1734 NONMARKER is a regular expression matching the start of non-marking
1735 entries. ENTRY-MAIN is the first line of the diary entry."
1736 (if (string-match (concat nonmarker "%%\\((diary-float .+\\) ?$") entry-main)
1737 (with-temp-buffer
1738 (insert (match-string 1 entry-main))
1739 (goto-char (point-min))
1740 (let* ((sexp (read (current-buffer))) ;using `read' here
1741 ;easier than regexp
1742 ;matching, esp. with
1743 ;different forms of
1744 ;MONTH
1745 (month (nth 1 sexp))
1746 (dayname (nth 2 sexp))
1747 (n (nth 3 sexp))
1748 (day (nth 4 sexp))
1749 (summary
1750 (replace-regexp-in-string
1751 "\\(^\s+\\|\s+$\\)" ""
1752 (buffer-substring (point) (point-max)))))
1754 (when day
1755 (progn
1756 (icalendar--dmsg "diary-float %s" entry-main)
1757 (error "Don't know if or how to implement day in `diary-float'")))
1759 (cons (concat
1760 ;;Start today (yes this is an arbitrary choice):
1761 "\nDTSTART;VALUE=DATE:"
1762 (format-time-string "%Y%m%d")
1763 ;;BUT remove today if `diary-float'
1764 ;;expression does not hold true for today:
1765 (when
1766 (null (let ((date (calendar-current-date))
1767 (entry entry-main))
1768 (diary-float month dayname n)))
1769 (concat
1770 "\nEXDATE;VALUE=DATE:"
1771 (format-time-string "%Y%m%d")))
1772 "\nRRULE:"
1773 (if (or (numberp month) (listp month))
1774 "FREQ=YEARLY;BYMONTH="
1775 "FREQ=MONTHLY")
1776 (when
1777 (listp month)
1778 (mapconcat
1779 (lambda (m)
1780 (number-to-string m))
1781 (cadr month) ","))
1782 (when
1783 (numberp month)
1784 (number-to-string month))
1785 ";BYDAY="
1786 (number-to-string n)
1787 (aref icalendar--weekday-array dayname))
1788 summary)))
1789 ;; no match
1790 nil))
1792 (defun icalendar--convert-date-to-ical (nonmarker entry-main)
1793 "Convert `diary-date' diary entry to iCalendar format -- unsupported!
1795 FIXME!
1797 NONMARKER is a regular expression matching the start of non-marking
1798 entries. ENTRY-MAIN is the first line of the diary entry."
1799 (if (string-match (concat nonmarker
1800 "%%(diary-date \\([^)]+\\))\\s-*\\(.*?\\) ?$")
1801 entry-main)
1802 (progn
1803 (icalendar--dmsg "diary-date %s" entry-main)
1804 (error "`diary-date' is not supported yet"))
1805 ;; no match
1806 nil))
1808 (defun icalendar--convert-cyclic-to-ical (nonmarker entry-main)
1809 "Convert `diary-cyclic' diary entry to iCalendar format.
1810 NONMARKER is a regular expression matching the start of non-marking
1811 entries. ENTRY-MAIN is the first line of the diary entry."
1812 (if (string-match (concat nonmarker
1813 "%%(diary-cyclic \\([^ ]+\\) +"
1814 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
1815 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1816 "\\("
1817 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1818 "\\)?"
1819 "\\s-*\\(.*?\\) ?$")
1820 entry-main)
1821 (let* ((frequency (substring entry-main (match-beginning 1)
1822 (match-end 1)))
1823 (datetime (substring entry-main (match-beginning 2)
1824 (match-end 2)))
1825 (startisostring (icalendar--datestring-to-isodate
1826 datetime))
1827 (endisostring (icalendar--datestring-to-isodate
1828 datetime))
1829 (endisostring+1 (icalendar--datestring-to-isodate
1830 datetime 1))
1831 (starttimestring (icalendar--diarytime-to-isotime
1832 (if (match-beginning 4)
1833 (substring entry-main
1834 (match-beginning 4)
1835 (match-end 4))
1836 nil)
1837 (if (match-beginning 5)
1838 (substring entry-main
1839 (match-beginning 5)
1840 (match-end 5))
1841 nil)))
1842 (endtimestring (icalendar--diarytime-to-isotime
1843 (if (match-beginning 7)
1844 (substring entry-main
1845 (match-beginning 7)
1846 (match-end 7))
1847 nil)
1848 (if (match-beginning 8)
1849 (substring entry-main
1850 (match-beginning 8)
1851 (match-end 8))
1852 nil)))
1853 (summary (icalendar--convert-string-for-export
1854 (substring entry-main (match-beginning 9)
1855 (match-end 9)))))
1856 (icalendar--dmsg "diary-cyclic %s" entry-main)
1857 (when starttimestring
1858 (unless endtimestring
1859 (let ((time
1860 (read (icalendar--rris "^T0?" ""
1861 starttimestring))))
1862 (setq endtimestring (format "T%06d"
1863 (+ 10000 time))))))
1864 (cons (concat "\nDTSTART;"
1865 (if starttimestring "VALUE=DATE-TIME:"
1866 "VALUE=DATE:")
1867 startisostring
1868 (or starttimestring "")
1869 "\nDTEND;"
1870 (if endtimestring "VALUE=DATE-TIME:"
1871 "VALUE=DATE:")
1872 (if endtimestring endisostring endisostring+1)
1873 (or endtimestring "")
1874 "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
1875 ;; strange: korganizer does not expect
1876 ;; BYSOMETHING here...
1878 summary))
1879 ;; no match
1880 nil))
1882 (defun icalendar--convert-anniversary-to-ical (nonmarker entry-main)
1883 "Convert `diary-anniversary' diary entry to iCalendar format.
1884 NONMARKER is a regular expression matching the start of non-marking
1885 entries. ENTRY-MAIN is the first line of the diary entry."
1886 (if (string-match (concat nonmarker
1887 "%%(diary-anniversary \\([^)]+\\))\\s-*"
1888 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
1889 "\\("
1890 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
1891 "\\)?"
1892 "\\s-*\\(.*?\\) ?$")
1893 entry-main)
1894 (let* ((datetime (substring entry-main (match-beginning 1)
1895 (match-end 1)))
1896 (startisostring (icalendar--datestring-to-isodate
1897 datetime))
1898 (endisostring (icalendar--datestring-to-isodate
1899 datetime 1))
1900 (starttimestring (icalendar--diarytime-to-isotime
1901 (if (match-beginning 3)
1902 (substring entry-main
1903 (match-beginning 3)
1904 (match-end 3))
1905 nil)
1906 (if (match-beginning 4)
1907 (substring entry-main
1908 (match-beginning 4)
1909 (match-end 4))
1910 nil)))
1911 (endtimestring (icalendar--diarytime-to-isotime
1912 (if (match-beginning 6)
1913 (substring entry-main
1914 (match-beginning 6)
1915 (match-end 6))
1916 nil)
1917 (if (match-beginning 7)
1918 (substring entry-main
1919 (match-beginning 7)
1920 (match-end 7))
1921 nil)))
1922 (summary (icalendar--convert-string-for-export
1923 (substring entry-main (match-beginning 8)
1924 (match-end 8)))))
1925 (icalendar--dmsg "diary-anniversary %s" entry-main)
1926 (when starttimestring
1927 (unless endtimestring
1928 (let ((time
1929 (read (icalendar--rris "^T0?" ""
1930 starttimestring))))
1931 (setq endtimestring (format "T%06d"
1932 (+ 10000 time))))))
1933 (cons (concat "\nDTSTART;"
1934 (if starttimestring "VALUE=DATE-TIME:"
1935 "VALUE=DATE:")
1936 startisostring
1937 (or starttimestring "")
1938 "\nDTEND;"
1939 (if endtimestring "VALUE=DATE-TIME:"
1940 "VALUE=DATE:")
1941 endisostring
1942 (or endtimestring "")
1943 "\nRRULE:FREQ=YEARLY;INTERVAL=1"
1944 ;; the following is redundant,
1945 ;; but korganizer seems to expect this... ;(
1946 ;; and evolution doesn't understand it... :(
1947 ;; so... who is wrong?!
1948 ";BYMONTH="
1949 (substring startisostring 4 6)
1950 ";BYMONTHDAY="
1951 (substring startisostring 6 8))
1952 summary))
1953 ;; no match
1954 nil))
1956 ;; ======================================================================
1957 ;; Import -- convert iCalendar to emacs-diary
1958 ;; ======================================================================
1960 ;;;###autoload
1961 (defun icalendar-import-file (ical-filename diary-filename
1962 &optional non-marking)
1963 "Import an iCalendar file and append to a diary file.
1964 Argument ICAL-FILENAME output iCalendar file.
1965 Argument DIARY-FILENAME input `diary-file'.
1966 Optional argument NON-MARKING determines whether events are created as
1967 non-marking or not."
1968 (interactive "fImport iCalendar data from file: \n\
1969 Finto diary file:
1971 ;; clean up the diary file
1972 (save-current-buffer
1973 ;; now load and convert from the ical file
1974 (set-buffer (find-file ical-filename))
1975 (icalendar-import-buffer diary-filename t non-marking)))
1977 ;;;###autoload
1978 (defun icalendar-import-buffer (&optional diary-file do-not-ask
1979 non-marking)
1980 "Extract iCalendar events from current buffer.
1982 This function searches the current buffer for the first iCalendar
1983 object, reads it and adds all VEVENT elements to the diary
1984 DIARY-FILE.
1986 It will ask for each appointment whether to add it to the diary
1987 unless DO-NOT-ASK is non-nil. When called interactively,
1988 DO-NOT-ASK is nil, so that you are asked for each event.
1990 NON-MARKING determines whether diary events are created as
1991 non-marking.
1993 Return code t means that importing worked well, return code nil
1994 means that an error has occurred. Error messages will be in the
1995 buffer `*icalendar-errors*'."
1996 (interactive)
1997 (save-current-buffer
1998 ;; prepare ical
1999 (message "Preparing iCalendar...")
2000 (set-buffer (icalendar--get-unfolded-buffer (current-buffer)))
2001 (goto-char (point-min))
2002 (message "Preparing iCalendar...done")
2003 (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t)
2004 (let (ical-contents ical-errors)
2005 ;; read ical
2006 (message "Reading iCalendar...")
2007 (beginning-of-line)
2008 (setq ical-contents (icalendar--read-element nil nil))
2009 (message "Reading iCalendar...done")
2010 ;; convert ical
2011 (message "Converting iCalendar...")
2012 (setq ical-errors (icalendar--convert-ical-to-diary
2013 ical-contents
2014 diary-file do-not-ask non-marking))
2015 (when diary-file
2016 ;; save the diary file if it is visited already
2017 (let ((b (find-buffer-visiting diary-file)))
2018 (when b
2019 (save-current-buffer
2020 (set-buffer b)
2021 (save-buffer)))))
2022 (message "Converting iCalendar...done")
2023 ;; return t if no error occurred
2024 (not ical-errors))
2025 (message
2026 "Current buffer does not contain iCalendar contents!")
2027 ;; return nil, i.e. import did not work
2028 nil)))
2030 (define-obsolete-function-alias 'icalendar-extract-ical-from-buffer
2031 'icalendar-import-buffer "22.1")
2033 (defun icalendar--format-ical-event (event)
2034 "Create a string representation of an iCalendar EVENT."
2035 (if (functionp icalendar-import-format)
2036 (funcall icalendar-import-format event)
2037 (let ((string icalendar-import-format)
2038 (case-fold-search nil)
2039 (conversion-list
2040 '(("%c" CLASS icalendar-import-format-class)
2041 ("%d" DESCRIPTION icalendar-import-format-description)
2042 ("%l" LOCATION icalendar-import-format-location)
2043 ("%o" ORGANIZER icalendar-import-format-organizer)
2044 ("%s" SUMMARY icalendar-import-format-summary)
2045 ("%t" STATUS icalendar-import-format-status)
2046 ("%u" URL icalendar-import-format-url)
2047 ("%U" UID icalendar-import-format-uid))))
2048 ;; convert the specifiers in the format string
2049 (mapc (lambda (i)
2050 (let* ((spec (car i))
2051 (prop (cadr i))
2052 (format (car (cddr i)))
2053 (contents (icalendar--get-event-property event prop))
2054 (formatted-contents ""))
2055 (when (and contents (> (length contents) 0))
2056 (setq formatted-contents
2057 (icalendar--rris "%s"
2058 (icalendar--convert-string-for-import
2059 contents)
2060 (symbol-value format)
2061 t t)))
2062 (setq string (icalendar--rris spec
2063 formatted-contents
2064 string
2065 t t))))
2066 conversion-list)
2067 string)))
2069 (defun icalendar--convert-ical-to-diary (ical-list diary-file
2070 &optional do-not-ask
2071 non-marking)
2072 "Convert iCalendar data to an Emacs diary file.
2073 Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
2074 DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event
2075 whether to actually import it. NON-MARKING determines whether diary
2076 events are created as non-marking.
2077 This function attempts to return t if something goes wrong. In this
2078 case an error string which describes all the errors and problems is
2079 written into the buffer `*icalendar-errors*'."
2080 (let* ((ev (icalendar--all-events ical-list))
2081 (error-string "")
2082 (event-ok t)
2083 (found-error nil)
2084 (zone-map (icalendar--convert-all-timezones ical-list))
2085 e diary-string)
2086 ;; step through all events/appointments
2087 (while ev
2088 (setq e (car ev))
2089 (setq ev (cdr ev))
2090 (setq event-ok nil)
2091 (condition-case error-val
2092 (let* ((dtstart (icalendar--get-event-property e 'DTSTART))
2093 (dtstart-zone (icalendar--find-time-zone
2094 (icalendar--get-event-property-attributes
2095 e 'DTSTART)
2096 zone-map))
2097 (dtstart-dec (icalendar--decode-isodatetime dtstart nil
2098 dtstart-zone))
2099 (start-d (icalendar--datetime-to-diary-date
2100 dtstart-dec))
2101 (start-t (icalendar--datetime-to-colontime dtstart-dec))
2102 (dtend (icalendar--get-event-property e 'DTEND))
2103 (dtend-zone (icalendar--find-time-zone
2104 (icalendar--get-event-property-attributes
2105 e 'DTEND)
2106 zone-map))
2107 (dtend-dec (icalendar--decode-isodatetime dtend
2108 nil dtend-zone))
2109 (dtend-1-dec (icalendar--decode-isodatetime dtend -1
2110 dtend-zone))
2111 end-d
2112 end-1-d
2113 end-t
2114 (summary (icalendar--convert-string-for-import
2115 (or (icalendar--get-event-property e 'SUMMARY)
2116 "No summary")))
2117 (rrule (icalendar--get-event-property e 'RRULE))
2118 (rdate (icalendar--get-event-property e 'RDATE))
2119 (duration (icalendar--get-event-property e 'DURATION)))
2120 (icalendar--dmsg "%s: `%s'" start-d summary)
2121 ;; check whether start-time is missing
2122 (if (and dtstart
2123 (string=
2124 (cadr (icalendar--get-event-property-attributes
2125 e 'DTSTART))
2126 "DATE"))
2127 (setq start-t nil))
2128 (when duration
2129 (let ((dtend-dec-d (icalendar--add-decoded-times
2130 dtstart-dec
2131 (icalendar--decode-isoduration duration)))
2132 (dtend-1-dec-d (icalendar--add-decoded-times
2133 dtstart-dec
2134 (icalendar--decode-isoduration duration
2135 t))))
2136 (if (and dtend-dec (not (eq dtend-dec dtend-dec-d)))
2137 (message "Inconsistent endtime and duration for %s"
2138 summary))
2139 (setq dtend-dec dtend-dec-d)
2140 (setq dtend-1-dec dtend-1-dec-d)))
2141 (setq end-d (if dtend-dec
2142 (icalendar--datetime-to-diary-date dtend-dec)
2143 start-d))
2144 (setq end-1-d (if dtend-1-dec
2145 (icalendar--datetime-to-diary-date dtend-1-dec)
2146 start-d))
2147 (setq end-t (if (and
2148 dtend-dec
2149 (not (string=
2150 (cadr
2151 (icalendar--get-event-property-attributes
2152 e 'DTEND))
2153 "DATE")))
2154 (icalendar--datetime-to-colontime dtend-dec)
2155 start-t))
2156 (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d)
2157 (cond
2158 ;; recurring event
2159 (rrule
2160 (setq diary-string
2161 (icalendar--convert-recurring-to-diary e dtstart-dec start-t
2162 end-t))
2163 (setq event-ok t))
2164 (rdate
2165 (icalendar--dmsg "rdate event")
2166 (setq diary-string "")
2167 (mapc (lambda (datestring)
2168 (setq diary-string
2169 (concat diary-string
2170 (format "......"))))
2171 (icalendar--split-value rdate)))
2172 ;; non-recurring event
2173 ;; all-day event
2174 ((not (string= start-d end-d))
2175 (setq diary-string
2176 (icalendar--convert-non-recurring-all-day-to-diary
2177 e start-d end-1-d))
2178 (setq event-ok t))
2179 ;; not all-day
2180 ((and start-t (or (not end-t)
2181 (not (string= start-t end-t))))
2182 (setq diary-string
2183 (icalendar--convert-non-recurring-not-all-day-to-diary
2184 e dtstart-dec dtend-dec start-t end-t))
2185 (setq event-ok t))
2186 ;; all-day event
2188 (icalendar--dmsg "all day event")
2189 (setq diary-string (icalendar--datetime-to-diary-date
2190 dtstart-dec "/"))
2191 (setq event-ok t)))
2192 ;; add all other elements unless the user doesn't want to have
2193 ;; them
2194 (if event-ok
2195 (progn
2196 (setq diary-string
2197 (concat diary-string " "
2198 (icalendar--format-ical-event e)))
2199 (if do-not-ask (setq summary nil))
2200 ;; add entry to diary and store actual name of diary
2201 ;; file (in case it was nil)
2202 (setq diary-file
2203 (icalendar--add-diary-entry diary-string diary-file
2204 non-marking summary)))
2205 ;; event was not ok
2206 (setq found-error t)
2207 (setq error-string
2208 (format "%s\nCannot handle this event:%s"
2209 error-string e))))
2210 ;; FIXME: inform user about ignored event properties
2211 ;; handle errors
2212 (error
2213 (message "Ignoring event \"%s\"" e)
2214 (setq found-error t)
2215 (setq error-string (format "%s\n%s\nCannot handle this event: %s"
2216 error-val error-string e))
2217 (message "%s" error-string))))
2219 ;; insert final newline
2220 (if diary-file
2221 (let ((b (find-buffer-visiting diary-file)))
2222 (when b
2223 (save-current-buffer
2224 (set-buffer b)
2225 (goto-char (point-max))
2226 (insert "\n")))))
2227 (if found-error
2228 (save-current-buffer
2229 (set-buffer (get-buffer-create "*icalendar-errors*"))
2230 (erase-buffer)
2231 (insert error-string)))
2232 (message "Converting iCalendar...done")
2233 found-error))
2235 ;; subroutines for importing
2236 (defun icalendar--convert-recurring-to-diary (e dtstart-dec start-t end-t)
2237 "Convert recurring iCalendar event E to diary format.
2239 DTSTART-DEC is the DTSTART property of E.
2240 START-T is the event's start time in diary format.
2241 END-T is the event's end time in diary format."
2242 (icalendar--dmsg "recurring event")
2243 (let* ((rrule (icalendar--get-event-property e 'RRULE))
2244 (rrule-props (icalendar--split-value rrule))
2245 (frequency (cadr (assoc 'FREQ rrule-props)))
2246 (until (cadr (assoc 'UNTIL rrule-props)))
2247 (count (cadr (assoc 'COUNT rrule-props)))
2248 (interval (read (or (cadr (assoc 'INTERVAL rrule-props)) "1")))
2249 (dtstart-conv (icalendar--datetime-to-diary-date dtstart-dec))
2250 (until-conv (icalendar--datetime-to-diary-date
2251 (icalendar--decode-isodatetime until)))
2252 (until-1-conv (icalendar--datetime-to-diary-date
2253 (icalendar--decode-isodatetime until -1)))
2254 (result ""))
2256 ;; FIXME FIXME interval!!!!!!!!!!!!!
2258 (when count
2259 (if until
2260 (message "Must not have UNTIL and COUNT -- ignoring COUNT element!")
2261 (let ((until-1 0))
2262 (cond ((string-equal frequency "DAILY")
2263 (setq until (icalendar--add-decoded-times
2264 dtstart-dec
2265 (list 0 0 0 (* (read count) interval) 0 0)))
2266 (setq until-1 (icalendar--add-decoded-times
2267 dtstart-dec
2268 (list 0 0 0 (* (- (read count) 1) interval)
2269 0 0)))
2271 ((string-equal frequency "WEEKLY")
2272 (setq until (icalendar--add-decoded-times
2273 dtstart-dec
2274 (list 0 0 0 (* (read count) 7 interval) 0 0)))
2275 (setq until-1 (icalendar--add-decoded-times
2276 dtstart-dec
2277 (list 0 0 0 (* (- (read count) 1) 7
2278 interval) 0 0)))
2280 ((string-equal frequency "MONTHLY")
2281 (setq until (icalendar--add-decoded-times
2282 dtstart-dec (list 0 0 0 0 (* (- (read count) 1)
2283 interval) 0)))
2284 (setq until-1 (icalendar--add-decoded-times
2285 dtstart-dec (list 0 0 0 0 (* (- (read count) 1)
2286 interval) 0)))
2288 ((string-equal frequency "YEARLY")
2289 (setq until (icalendar--add-decoded-times
2290 dtstart-dec (list 0 0 0 0 0 (* (- (read count) 1)
2291 interval))))
2292 (setq until-1 (icalendar--add-decoded-times
2293 dtstart-dec
2294 (list 0 0 0 0 0 (* (- (read count) 1)
2295 interval))))
2298 (message "Cannot handle COUNT attribute for `%s' events."
2299 frequency)))
2300 (setq until-conv (icalendar--datetime-to-diary-date until))
2301 (setq until-1-conv (icalendar--datetime-to-diary-date until-1))
2304 (cond ((string-equal frequency "WEEKLY")
2305 (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
2306 (weekdays
2307 (icalendar--get-weekday-numbers byday))
2308 (weekday-clause
2309 (when (> (length weekdays) 1)
2310 (format "(memq (calendar-day-of-week date) '%s) "
2311 weekdays))))
2312 (if (not start-t)
2313 (progn
2314 ;; weekly and all-day
2315 (icalendar--dmsg "weekly all-day")
2316 (if until
2317 (setq result
2318 (format
2319 (concat "%%%%(and "
2320 "%s"
2321 "(diary-block %s %s))")
2322 (or weekday-clause
2323 (format "(diary-cyclic %d %s) "
2324 (* interval 7)
2325 dtstart-conv))
2326 dtstart-conv
2327 (if count until-1-conv until-conv)
2329 (setq result
2330 (format "%%%%(and %s(diary-cyclic %d %s))"
2331 (or weekday-clause "")
2332 (if weekday-clause 1 (* interval 7))
2333 dtstart-conv))))
2334 ;; weekly and not all-day
2335 (icalendar--dmsg "weekly not-all-day")
2336 (if until
2337 (setq result
2338 (format
2339 (concat "%%%%(and "
2340 "%s"
2341 "(diary-block %s %s)) "
2342 "%s%s%s")
2343 (or weekday-clause
2344 (format "(diary-cyclic %d %s) "
2345 (* interval 7)
2346 dtstart-conv))
2347 dtstart-conv
2348 until-conv
2349 (or start-t "")
2350 (if end-t "-" "") (or end-t "")))
2351 ;; no limit
2352 ;; FIXME!!!!
2353 ;; DTSTART;VALUE=DATE-TIME:20030919T090000
2354 ;; DTEND;VALUE=DATE-TIME:20030919T113000
2355 (setq result
2356 (format
2357 "%%%%(and %s(diary-cyclic %d %s)) %s%s%s"
2358 (or weekday-clause "")
2359 (if weekday-clause 1 (* interval 7))
2360 dtstart-conv
2361 (or start-t "")
2362 (if end-t "-" "") (or end-t "")))))))
2363 ;; yearly
2364 ((string-equal frequency "YEARLY")
2365 (icalendar--dmsg "yearly")
2366 (if until
2367 (let ((day (nth 3 dtstart-dec))
2368 (month (nth 4 dtstart-dec)))
2369 (setq result (concat "%%(and (diary-date "
2370 (cond ((eq calendar-date-style 'iso)
2371 (format "t %d %d" month day))
2372 ((eq calendar-date-style 'european)
2373 (format "%d %d t" day month))
2374 ((eq calendar-date-style 'american)
2375 (format "%d %d t" month day)))
2376 ") (diary-block "
2377 dtstart-conv
2379 until-conv
2380 ")) "
2381 (or start-t "")
2382 (if end-t "-" "")
2383 (or end-t ""))))
2384 (setq result (format
2385 "%%%%(and (diary-anniversary %s)) %s%s%s"
2386 dtstart-conv
2387 (or start-t "")
2388 (if end-t "-" "") (or end-t "")))))
2389 ;; monthly
2390 ((string-equal frequency "MONTHLY")
2391 (icalendar--dmsg "monthly")
2392 (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
2393 (count-weekday
2394 (and byday
2395 (save-match-data
2396 (when (string-match "\\(-?[0-9]+\\)\\([A-Z][A-Z]\\)"
2397 byday)
2398 (cons (substring byday
2399 (match-beginning 1)
2400 (match-end 1))
2401 (substring byday
2402 (match-beginning 2)
2403 (match-end 2)))))))
2404 (rule-part
2405 (if count-weekday
2406 (let ((count (car count-weekday))
2407 (weekdaynum (icalendar--get-weekday-number
2408 (cdr count-weekday))))
2409 ;; FIXME: this is valid only for interval==1
2410 (format "(diary-float t %s %s)" weekdaynum count))
2411 (format "(diary-date %s)"
2412 (let ((day (nth 3 dtstart-dec)))
2413 (cond ((eq calendar-date-style 'iso)
2414 (format "t t %d" day))
2415 ((eq calendar-date-style 'european)
2416 (format "%d t t" day))
2417 ((eq calendar-date-style 'american)
2418 (format "t %d t" day))))))))
2419 (setq result
2420 (format
2421 "%%%%(and %s (diary-block %s %s)) %s%s%s"
2422 rule-part
2423 dtstart-conv
2424 (if until
2425 until-conv
2426 (if (eq calendar-date-style 'iso) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited
2427 (or start-t "")
2428 (if end-t "-" "") (or end-t "")))))
2429 ;; daily
2430 ((and (string-equal frequency "DAILY"))
2431 (if until
2432 (setq result
2433 (format
2434 (concat "%%%%(and (diary-cyclic %s %s) "
2435 "(diary-block %s %s)) %s%s%s")
2436 interval dtstart-conv dtstart-conv
2437 (if count until-1-conv until-conv)
2438 (or start-t "")
2439 (if end-t "-" "") (or end-t "")))
2440 (setq result
2441 (format
2442 "%%%%(and (diary-cyclic %s %s)) %s%s%s"
2443 interval
2444 dtstart-conv
2445 (or start-t "")
2446 (if end-t "-" "") (or end-t ""))))))
2447 ;; Handle exceptions from recurrence rules
2448 (let ((ex-dates (icalendar--get-event-properties e 'EXDATE)))
2449 (while ex-dates
2450 (let* ((ex-start (icalendar--decode-isodatetime
2451 (car ex-dates)))
2452 (ex-d (icalendar--datetime-to-diary-date
2453 ex-start)))
2454 (setq result
2455 (icalendar--rris "^%%(\\(and \\)?"
2456 (format
2457 "%%%%(and (not (diary-date %s)) "
2458 ex-d)
2459 result)))
2460 (setq ex-dates (cdr ex-dates))))
2461 ;; FIXME: exception rules are not recognized
2462 (if (icalendar--get-event-property e 'EXRULE)
2463 (setq result
2464 (concat result
2465 "\n Exception rules: "
2466 (icalendar--get-event-properties
2467 e 'EXRULE))))
2468 result))
2470 (defun icalendar--convert-non-recurring-all-day-to-diary (event start-d end-d)
2471 "Convert non-recurring iCalendar EVENT to diary format.
2473 DTSTART is the decoded DTSTART property of E.
2474 Argument START-D gives the first day.
2475 Argument END-D gives the last day."
2476 (icalendar--dmsg "non-recurring all-day event")
2477 (format "%%%%(and (diary-block %s %s))" start-d end-d))
2479 (defun icalendar--convert-non-recurring-not-all-day-to-diary (event dtstart-dec
2480 dtend-dec
2481 start-t
2482 end-t)
2483 "Convert recurring icalendar EVENT to diary format.
2485 DTSTART-DEC is the decoded DTSTART property of E.
2486 DTEND-DEC is the decoded DTEND property of E.
2487 START-T is the event's start time in diary format.
2488 END-T is the event's end time in diary format."
2489 (icalendar--dmsg "not all day event")
2490 (cond (end-t
2491 (format "%s %s-%s"
2492 (icalendar--datetime-to-diary-date
2493 dtstart-dec "/")
2494 start-t end-t))
2496 (format "%s %s"
2497 (icalendar--datetime-to-diary-date
2498 dtstart-dec "/")
2499 start-t))))
2501 (defun icalendar--add-diary-entry (string diary-file non-marking
2502 &optional summary)
2503 "Add STRING to the diary file DIARY-FILE.
2504 STRING must be a properly formatted valid diary entry. NON-MARKING
2505 determines whether diary events are created as non-marking. If
2506 SUMMARY is not nil it must be a string that gives the summary of the
2507 entry. In this case the user will be asked whether he wants to insert
2508 the entry."
2509 (when (or (not summary)
2510 (y-or-n-p (format-message "Add appointment for `%s' to diary? "
2511 summary)))
2512 (when summary
2513 (setq non-marking
2514 (y-or-n-p (format "Make appointment non-marking? "))))
2515 (save-window-excursion
2516 (unless diary-file
2517 (setq diary-file
2518 (read-file-name "Add appointment to this diary file: ")))
2519 ;; Note: diary-make-entry will add a trailing blank char.... :(
2520 (funcall (if (fboundp 'diary-make-entry)
2521 'diary-make-entry
2522 'make-diary-entry)
2523 string non-marking diary-file)))
2524 ;; Würgaround to remove the trailing blank char
2525 (with-current-buffer (find-file diary-file)
2526 (goto-char (point-max))
2527 (if (= (char-before) ? )
2528 (delete-char -1)))
2529 ;; return diary-file in case it has been changed interactively
2530 diary-file)
2532 ;; ======================================================================
2533 ;; Examples
2534 ;; ======================================================================
2535 (defun icalendar-import-format-sample (event)
2536 "Example function for formatting an iCalendar EVENT."
2537 (format (concat "SUMMARY='%s' DESCRIPTION='%s' LOCATION='%s' ORGANIZER='%s' "
2538 "STATUS='%s' URL='%s' CLASS='%s'")
2539 (or (icalendar--get-event-property event 'SUMMARY) "")
2540 (or (icalendar--get-event-property event 'DESCRIPTION) "")
2541 (or (icalendar--get-event-property event 'LOCATION) "")
2542 (or (icalendar--get-event-property event 'ORGANIZER) "")
2543 (or (icalendar--get-event-property event 'STATUS) "")
2544 (or (icalendar--get-event-property event 'URL) "")
2545 (or (icalendar--get-event-property event 'CLASS) "")))
2547 (provide 'icalendar)
2549 ;;; icalendar.el ends here