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