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