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