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