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