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