HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Make some doc strings bidi-friendly.
[bpt/emacs.git] / lisp / calendar / icalendar.el
CommitLineData
e0cd68ee 1;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
707c20a8 2
114f9c96 3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
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
GM		 9;; Human-Keywords: calendar, diary, iCalendar, vCalendar
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"
215 "Format of unique ID code (UID) for each iCalendar object.
216The following specifiers are available:
217%c COUNTER, an integer value that is increased each time a uid is
218 generated. This may be necessary for systems which do not
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,
223%u USERNAME, the user-login-name.
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
GM		 429 (re-search-forward
430 "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?"
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
e0cd68ee 747(defun icalendar--get-weekday-abbrev (weekday)
707c20a8 748 "Return the abbreviated WEEKDAY."
f2aa5449
GM		 749 (catch 'found
750 (let ((num 0)
751 (w (downcase weekday)))
752 (mapc (lambda (day)
753 (let ((d (downcase day)))
754 (if (or (string-equal d w)
755 (string-equal (substring d 0 3) w))
756 (throw 'found (aref icalendar--weekday-array num)))
757 (setq num (1+ num))))
758 calendar-day-name-array))
759 ;; Error:
81d56594
GM		 760 nil))
761
762(defun icalendar--date-to-isodate (date &optional day-shift)
763 "Convert DATE to iso-style date.
764DATE must be a list of the form (month day year).
765If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
766 (let ((mdy (calendar-gregorian-from-absolute
767 (+ (calendar-absolute-from-gregorian date)
768 (or day-shift 0)))))
769 (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
770
707c20a8 771
e0cd68ee 772(defun icalendar--datestring-to-isodate (datestring &optional day-shift)
707c20a8
GM		 773 "Convert diary-style DATESTRING to iso-style date.
774If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
775-- DAY-SHIFT must be either nil or an integer. This function
0fc438b8
GM		 776tries to figure the date style from DATESTRING itself. If that
777is not possible it uses the current calendar date style."
707c20a8
GM		 778 (let ((day -1) month year)
779 (save-match-data
0fc438b8
GM		 780 (cond ( ;; iso-style numeric date
781 (string-match (concat "\\s-*"
782 "\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
783 "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
784 "0?\\([1-9][0-9]?\\)")
785 datestring)
786 (setq year (read (substring datestring (match-beginning 1)
787 (match-end 1))))
788 (setq month (read (substring datestring (match-beginning 2)
789 (match-end 2))))
790 (setq day (read (substring datestring (match-beginning 3)
791 (match-end 3)))))
792 ( ;; non-iso numeric date -- must rely on configured
793 ;; calendar style
e0cd68ee
GM		 794 (string-match (concat "\\s-*"
795 "0?\\([1-9][0-9]?\\)[ \t/]\\s-*"
796 "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*"
797 "\\([0-9]\\{4\\}\\)")
798 datestring)
799 (setq day (read (substring datestring (match-beginning 1)
800 (match-end 1))))
801 (setq month (read (substring datestring (match-beginning 2)
802 (match-end 2))))
803 (setq year (read (substring datestring (match-beginning 3)
804 (match-end 3))))
0fc438b8
GM		 805 (if (eq (icalendar--date-style) 'american)
806 (let ((x month))
807 (setq month day)
808 (setq day x))))
809 ( ;; date contains month names -- iso style
810 (string-match (concat "\\s-*"
811 "\\([0-9]\\{4\\}\\)[ \t/]\\s-*"
812 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
813 "0?\\([123]?[0-9]\\)")
814 datestring)
815 (setq year (read (substring datestring (match-beginning 1)
816 (match-end 1))))
817 (setq month (icalendar--get-month-number
818 (substring datestring (match-beginning 2)
819 (match-end 2))))
820 (setq day (read (substring datestring (match-beginning 3)
821 (match-end 3)))))
822 ( ;; date contains month names -- european style
d2afe62f
GM		 823 (string-match (concat "\\s-*"
824 "0?\\([123]?[0-9]\\)[ \t/]\\s-*"
825 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
826 "\\([0-9]\\{4\\}\\)")
827 datestring)
e0cd68ee
GM		 828 (setq day (read (substring datestring (match-beginning 1)
829 (match-end 1))))
830 (setq month (icalendar--get-month-number
831 (substring datestring (match-beginning 2)
832 (match-end 2))))
833 (setq year (read (substring datestring (match-beginning 3)
834 (match-end 3)))))
0fc438b8 835 ( ;; date contains month names -- american style
d2afe62f
GM		 836 (string-match (concat "\\s-*"
837 "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*"
838 "0?\\([123]?[0-9]\\),?[ \t/]\\s-*"
839 "\\([0-9]\\{4\\}\\)")
840 datestring)
e0cd68ee
GM		 841 (setq day (read (substring datestring (match-beginning 2)
842 (match-end 2))))
843 (setq month (icalendar--get-month-number
844 (substring datestring (match-beginning 1)
845 (match-end 1))))
846 (setq year (read (substring datestring (match-beginning 3)
847 (match-end 3)))))
848 (t
849 nil)))
707c20a8 850 (if (> day 0)
e0cd68ee
GM		 851 (let ((mdy (calendar-gregorian-from-absolute
852 (+ (calendar-absolute-from-gregorian (list month day
81d56594 853 year))
e0cd68ee 854 (or day-shift 0)))))
0fc438b8 855 (icalendar--dmsg (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
e0cd68ee 856 (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
707c20a8
GM		 857 nil)))
858
e0cd68ee 859(defun icalendar--diarytime-to-isotime (timestring ampmstring)
a864048b 860 "Convert a time like 9:30pm to an iso-conform string like T213000.
707c20a8
GM		 861In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING
862would be \"pm\"."
863 (if timestring
e0cd68ee 864 (let ((starttimenum (read (icalendar--rris ":" "" timestring))))
707c20a8 865 ;; take care of am/pm style
f8e9107c
GM		 866 ;; Be sure *not* to convert 12:00pm - 12:59pm to 2400-2459
867 (if (and ampmstring (string= "pm" ampmstring) (< starttimenum 1200))
707c20a8 868 (setq starttimenum (+ starttimenum 1200)))
f052351a
UJ		 869 ;; Similar effect with 12:00am - 12:59am (need to convert to 0000-0059)
870 (if (and ampmstring (string= "am" ampmstring) (>= starttimenum 1200))
871 (setq starttimenum (- starttimenum 1200)))
707c20a8
GM		 872 (format "T%04d00" starttimenum))
873 nil))
874
74692b14
GM		 875(defun icalendar--convert-string-for-export (string)
876 "Escape comma and other critical characters in STRING."
877 (icalendar--rris "," "\\\\," string))
707c20a8 878
e0cd68ee 879(defun icalendar--convert-string-for-import (string)
707c20a8 880 "Remove escape chars for comma, semicolon etc. from STRING."
e0cd68ee
GM		 881 (icalendar--rris
882 "\\\\n" "\n " (icalendar--rris
883 "\\\\\"" "\"" (icalendar--rris
884 "\\\\;" ";" (icalendar--rris
885 "\\\\," "," string)))))
707c20a8
GM		 886
887;; ======================================================================
e0cd68ee 888;; Export -- convert emacs-diary to icalendar
707c20a8
GM		 889;; ======================================================================
890
86fc29f9 891;;;###autoload
e0cd68ee
GM		 892(defun icalendar-export-file (diary-filename ical-filename)
893 "Export diary file to iCalendar format.
894All diary entries in the file DIARY-FILENAME are converted to iCalendar
895format. The result is appended to the file ICAL-FILENAME."
309c894f 896 (interactive "FExport diary data from file:
707c20a8 897Finto iCalendar file: ")
e0cd68ee
GM		 898 (save-current-buffer
899 (set-buffer (find-file diary-filename))
900 (icalendar-export-region (point-min) (point-max) ical-filename)))
901
902(defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file)
cb5b40ee 903(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file "22.1")
e0cd68ee 904
ca2d101f
UJ		 905(defvar icalendar--uid-count 0
906 "Auxiliary counter for creating unique ids.")
907
f052351a
UJ		 908(defun icalendar--create-uid (entry-full contents)
909 "Construct a unique iCalendar UID for a diary entry.
910ENTRY-FULL is the full diary entry string. CONTENTS is the
911current iCalendar object, as a string. Increase
912`icalendar--uid-count'. Returns the UID string."
913 (let ((uid icalendar-uid-format))
914
915 (setq uid (replace-regexp-in-string
916 "%c"
917 (format "%d" icalendar--uid-count)
918 uid t t))
919 (setq icalendar--uid-count (1+ icalendar--uid-count))
920 (setq uid (replace-regexp-in-string
921 "%t"
922 (format "%d%d%d" (car (current-time))
923 (cadr (current-time))
924 (car (cddr (current-time))))
925 uid t t))
926 (setq uid (replace-regexp-in-string
927 "%h"
928 (format "%d" (abs (sxhash entry-full))) uid t t))
929 (setq uid (replace-regexp-in-string
930 "%u" (or user-login-name "UNKNOWN_USER") uid t t))
931 (let ((dtstart (if (string-match "^DTSTART[^:]*:\\([0-9]*\\)" contents)
932 (substring contents (match-beginning 1) (match-end 1))
933 "DTSTART")))
934 (setq uid (replace-regexp-in-string "%s" dtstart uid t t)))
935
936 ;; Return the UID string
937 uid))
ca2d101f 938
86fc29f9 939;;;###autoload
e0cd68ee
GM		 940(defun icalendar-export-region (min max ical-filename)
941 "Export region in diary file to iCalendar format.
942All diary entries in the region from MIN to MAX in the current buffer are
943converted to iCalendar format. The result is appended to the file
81d56594 944ICAL-FILENAME.
74692b14
GM		 945This function attempts to return t if something goes wrong. In this
946case an error string which describes all the errors and problems is
947written into the buffer `*icalendar-errors*'."
e0cd68ee
GM		 948 (interactive "r
949FExport diary data into iCalendar file: ")
707c20a8
GM		 950 (let ((result "")
951 (start 0)
952 (entry-main "")
953 (entry-rest "")
f052351a 954 (entry-full "")
707c20a8 955 (header "")
d2afe62f 956 (contents-n-summary)
707c20a8 957 (contents)
81d56594 958 (found-error nil)
707c20a8 959 (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
d2afe62f
GM		 960 "?"))
961 (other-elements nil))
81d56594
GM		 962 ;; prepare buffer with error messages
963 (save-current-buffer
9dd9ed20 964 (set-buffer (get-buffer-create "*icalendar-errors*"))
81d56594 965 (erase-buffer))
74692b14 966
81d56594 967 ;; here we go
e0cd68ee
GM		 968 (save-excursion
969 (goto-char min)
707c20a8 970 (while (re-search-forward
615eabde
GM		 971 ;; possibly ignore hidden entries beginning with "&"
972 (if icalendar-export-hidden-diary-entries
973 "^\\([^ \t\n#].+\\)\\(\\(\n[ \t].*\\)*\\)"
974 "^\\([^ \t\n&#].+\\)\\(\\(\n[ \t].*\\)*\\)") max t)
707c20a8
GM		 975 (setq entry-main (match-string 1))
976 (if (match-beginning 2)
977 (setq entry-rest (match-string 2))
978 (setq entry-rest ""))
f052351a
UJ		 979 (setq entry-full (concat entry-main entry-rest))
980
81d56594
GM		 981 (condition-case error-val
982 (progn
d2afe62f
GM		 983 (setq contents-n-summary
984 (icalendar--convert-to-ical nonmarker entry-main))
985 (setq other-elements (icalendar--parse-summary-and-rest
f052351a 986 entry-full))
d2afe62f
GM		 987 (setq contents (concat (car contents-n-summary)
988 "\nSUMMARY:" (cadr contents-n-summary)))
989 (let ((cla (cdr (assoc 'cla other-elements)))
990 (des (cdr (assoc 'des other-elements)))
991 (loc (cdr (assoc 'loc other-elements)))
992 (org (cdr (assoc 'org other-elements)))
993 (sta (cdr (assoc 'sta other-elements)))
994 (sum (cdr (assoc 'sum other-elements)))
995 (url (cdr (assoc 'url other-elements))))
996 (if cla
997 (setq contents (concat contents "\nCLASS:" cla)))
998 (if des
999 (setq contents (concat contents "\nDESCRIPTION:" des)))
1000 (if loc
1001 (setq contents (concat contents "\nLOCATION:" loc)))
1002 (if org
1003 (setq contents (concat contents "\nORGANIZER:" org)))
1004 (if sta
1005 (setq contents (concat contents "\nSTATUS:" sta)))
1006 ;;(if sum
1007 ;; (setq contents (concat contents "\nSUMMARY:" sum)))
1008 (if url
1009 (setq contents (concat contents "\nURL:" url))))
f052351a
UJ		 1010
1011 (setq header (concat "\nBEGIN:VEVENT\nUID:"
1012 (icalendar--create-uid entry-full contents)))
81d56594
GM		 1013 (setq result (concat result header contents "\nEND:VEVENT")))
1014 ;; handle errors
1015 (error
1016 (setq found-error t)
1017 (save-current-buffer
9dd9ed20 1018 (set-buffer (get-buffer-create "*icalendar-errors*"))
81d56594
GM		 1019 (insert (format "Error in line %d -- %s: `%s'\n"
1020 (count-lines (point-min) (point))
615eabde 1021 error-val
81d56594
GM		 1022 entry-main))))))
1023
707c20a8 1024 ;; we're done, insert everything into the file
74692b14 1025 (save-current-buffer
8ee7eb6b 1026 (let ((coding-system-for-write 'utf-8))
74692b14
GM		 1027 (set-buffer (find-file ical-filename))
1028 (goto-char (point-max))
1029 (insert "BEGIN:VCALENDAR")
1030 (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
1031 (insert "\nVERSION:2.0")
1032 (insert result)
1033 (insert "\nEND:VCALENDAR\n")
1034 ;; save the diary file
d2afe62f
GM		 1035 (save-buffer)
1036 (unless found-error
1037 (bury-buffer)))))
81d56594 1038 found-error))
707c20a8 1039
d2afe62f
GM		 1040(defun icalendar--convert-to-ical (nonmarker entry-main)
1041 "Convert a diary entry to icalendar format.
1042NONMARKER is a regular expression matching the start of non-marking
1043entries. ENTRY-MAIN is the first line of the diary entry."
1044 (or
1045 ;; anniversaries -- %%(diary-anniversary ...)
1046 (icalendar--convert-anniversary-to-ical nonmarker entry-main)
1047 ;; cyclic events -- %%(diary-cyclic ...)
1048 (icalendar--convert-cyclic-to-ical nonmarker entry-main)
1049 ;; diary-date -- %%(diary-date ...)
1050 (icalendar--convert-date-to-ical nonmarker entry-main)
1051 ;; float events -- %%(diary-float ...)
1052 (icalendar--convert-float-to-ical nonmarker entry-main)
1053 ;; block events -- %%(diary-block ...)
1054 (icalendar--convert-block-to-ical nonmarker entry-main)
1055 ;; other sexp diary entries
1056 (icalendar--convert-sexp-to-ical nonmarker entry-main)
1057 ;; weekly by day -- Monday 8:30 Team meeting
1058 (icalendar--convert-weekly-to-ical nonmarker entry-main)
1059 ;; yearly by day -- 1 May Tag der Arbeit
1060 (icalendar--convert-yearly-to-ical nonmarker entry-main)
1061 ;; "ordinary" events, start and end time given
1062 ;; 1 Feb 2003 blah
1063 (icalendar--convert-ordinary-to-ical nonmarker entry-main)
1064 ;; everything else
1065 ;; Oops! what's that?
1066 (error "Could not parse entry")))
1067
1068(defun icalendar--parse-summary-and-rest (summary-and-rest)
b3360383
GM		 1069 "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties.
1070Returns an alist."
d2afe62f 1071 (save-match-data
b3360383
GM		 1072 (if (functionp icalendar-import-format)
1073 ;; can't do anything
1074 nil
1075 ;; split summary-and-rest
1076 (let* ((s icalendar-import-format)
1077 (p-cla (or (string-match "%c" icalendar-import-format) -1))
1078 (p-des (or (string-match "%d" icalendar-import-format) -1))
1079 (p-loc (or (string-match "%l" icalendar-import-format) -1))
1080 (p-org (or (string-match "%o" icalendar-import-format) -1))
1081 (p-sum (or (string-match "%s" icalendar-import-format) -1))
1082 (p-sta (or (string-match "%t" icalendar-import-format) -1))
1083 (p-url (or (string-match "%u" icalendar-import-format) -1))
1084 (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<))
f052351a 1085 (ct 0)
b3360383
GM		 1086 pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url)
1087 (dotimes (i (length p-list))
f052351a 1088 ;; Use 'ct' to keep track of current position in list
b3360383 1089 (cond ((and (>= p-cla 0) (= (nth i p-list) p-cla))
f052351a
UJ		 1090 (setq ct (+ ct 1))
1091 (setq pos-cla (* 2 ct)))
b3360383 1092 ((and (>= p-des 0) (= (nth i p-list) p-des))
f052351a
UJ		 1093 (setq ct (+ ct 1))
1094 (setq pos-des (* 2 ct)))
b3360383 1095 ((and (>= p-loc 0) (= (nth i p-list) p-loc))
f052351a
UJ		 1096 (setq ct (+ ct 1))
1097 (setq pos-loc (* 2 ct)))
b3360383 1098 ((and (>= p-org 0) (= (nth i p-list) p-org))
f052351a
UJ		 1099 (setq ct (+ ct 1))
1100 (setq pos-org (* 2 ct)))
b3360383 1101 ((and (>= p-sta 0) (= (nth i p-list) p-sta))
f052351a
UJ		 1102 (setq ct (+ ct 1))
1103 (setq pos-sta (* 2 ct)))
b3360383 1104 ((and (>= p-sum 0) (= (nth i p-list) p-sum))
f052351a
UJ		 1105 (setq ct (+ ct 1))
1106 (setq pos-sum (* 2 ct)))
b3360383 1107 ((and (>= p-url 0) (= (nth i p-list) p-url))
f052351a
UJ		 1108 (setq ct (+ ct 1))
1109 (setq pos-url (* 2 ct)))) )
b3360383
GM		 1110 (mapc (lambda (ij)
1111 (setq s (icalendar--rris (car ij) (cadr ij) s t t)))
1112 (list
1113 ;; summary must be first! because of %s
1114 (list "%s"
1115 (concat "\\(" icalendar-import-format-summary "\\)??"))
1116 (list "%c"
1117 (concat "\\(" icalendar-import-format-class "\\)??"))
1118 (list "%d"
1119 (concat "\\(" icalendar-import-format-description "\\)??"))
1120 (list "%l"
1121 (concat "\\(" icalendar-import-format-location "\\)??"))
1122 (list "%o"
1123 (concat "\\(" icalendar-import-format-organizer "\\)??"))
1124 (list "%t"
1125 (concat "\\(" icalendar-import-format-status "\\)??"))
1126 (list "%u"
1127 (concat "\\(" icalendar-import-format-url "\\)??"))))
f052351a
UJ		 1128 ;; Need the \' regexp in order to detect multi-line items
1129 (setq s (concat "\\`"
1130 (icalendar--rris "%s" "\\(.*?\\)" s nil t)
1131 "\\'"))
b3360383
GM		 1132 (if (string-match s summary-and-rest)
1133 (let (cla des loc org sta sum url)
1134 (if (and pos-sum (match-beginning pos-sum))
1135 (setq sum (substring summary-and-rest
1136 (match-beginning pos-sum)
1137 (match-end pos-sum))))
1138 (if (and pos-cla (match-beginning pos-cla))
1139 (setq cla (substring summary-and-rest
1140 (match-beginning pos-cla)
1141 (match-end pos-cla))))
1142 (if (and pos-des (match-beginning pos-des))
1143 (setq des (substring summary-and-rest
1144 (match-beginning pos-des)
1145 (match-end pos-des))))
1146 (if (and pos-loc (match-beginning pos-loc))
1147 (setq loc (substring summary-and-rest
1148 (match-beginning pos-loc)
1149 (match-end pos-loc))))
1150 (if (and pos-org (match-beginning pos-org))
1151 (setq org (substring summary-and-rest
1152 (match-beginning pos-org)
1153 (match-end pos-org))))
1154 (if (and pos-sta (match-beginning pos-sta))
1155 (setq sta (substring summary-and-rest
1156 (match-beginning pos-sta)
1157 (match-end pos-sta))))
1158 (if (and pos-url (match-beginning pos-url))
1159 (setq url (substring summary-and-rest
1160 (match-beginning pos-url)
1161 (match-end pos-url))))
1162 (list (if cla (cons 'cla cla) nil)
1163 (if des (cons 'des des) nil)
1164 (if loc (cons 'loc loc) nil)
1165 (if org (cons 'org org) nil)
1166 (if sta (cons 'sta sta) nil)
1167 ;;(if sum (cons 'sum sum) nil)
1168 (if url (cons 'url url) nil))))))))
d2afe62f
GM		 1169
1170;; subroutines for icalendar-export-region
9dd9ed20
GM		 1171(defun icalendar--convert-ordinary-to-ical (nonmarker entry-main)
1172 "Convert \"ordinary\" diary entry to icalendar format.
9dd9ed20
GM		 1173NONMARKER is a regular expression matching the start of non-marking
1174entries. ENTRY-MAIN is the first line of the diary entry."
0fc438b8
GM		 1175 (if (string-match
1176 (concat nonmarker
1177 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*" ; date
b4340b3f 1178 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" ; start time
0fc438b8 1179 "\\("
b4340b3f 1180 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" ; end time
0fc438b8
GM		 1181 "\\)?"
1182 "\\s-*\\(.*?\\) ?$")
1183 entry-main)
9dd9ed20
GM		 1184 (let* ((datetime (substring entry-main (match-beginning 1)
1185 (match-end 1)))
1186 (startisostring (icalendar--datestring-to-isodate
1187 datetime))
1188 (endisostring (icalendar--datestring-to-isodate
1189 datetime 1))
f8e9107c 1190 (endisostring1)
9dd9ed20
GM		 1191 (starttimestring (icalendar--diarytime-to-isotime
1192 (if (match-beginning 3)
1193 (substring entry-main
1194 (match-beginning 3)
1195 (match-end 3))
1196 nil)
1197 (if (match-beginning 4)
1198 (substring entry-main
1199 (match-beginning 4)
1200 (match-end 4))
1201 nil)))
1202 (endtimestring (icalendar--diarytime-to-isotime
1203 (if (match-beginning 6)
1204 (substring entry-main
1205 (match-beginning 6)
1206 (match-end 6))
1207 nil)
1208 (if (match-beginning 7)
1209 (substring entry-main
1210 (match-beginning 7)
1211 (match-end 7))
1212 nil)))
1213 (summary (icalendar--convert-string-for-export
1214 (substring entry-main (match-beginning 8)
1215 (match-end 8)))))
1216 (icalendar--dmsg "ordinary %s" entry-main)
1217
1218 (unless startisostring
1219 (error "Could not parse date"))
f8e9107c
GM		 1220
1221 ;; If only start-date is specified, then end-date is next day,
1222 ;; otherwise it is same day.
1223 (setq endisostring1 (if starttimestring
1224 startisostring
1225 endisostring))
1226
9dd9ed20
GM		 1227 (when starttimestring
1228 (unless endtimestring
1229 (let ((time
1230 (read (icalendar--rris "^T0?" ""
1231 starttimestring))))
f8e9107c
GM		 1232 (if (< time 230000)
1233 ;; Case: ends on same day
9dd9ed20 1234 (setq endtimestring (format "T%06d"
f8e9107c
GM		 1235 (+ 10000 time)))
1236 ;; Case: ends on next day
1237 (setq endtimestring (format "T%06d"
1238 (- time 230000)))
1239 (setq endisostring1 endisostring)) )))
1240
d2afe62f
GM		 1241 (list (concat "\nDTSTART;"
1242 (if starttimestring "VALUE=DATE-TIME:"
1243 "VALUE=DATE:")
1244 startisostring
1245 (or starttimestring "")
1246 "\nDTEND;"
1247 (if endtimestring "VALUE=DATE-TIME:"
1248 "VALUE=DATE:")
f8e9107c 1249 endisostring1
d2afe62f
GM		 1250 (or endtimestring ""))
1251 summary))
9dd9ed20
GM		 1252 ;; no match
1253 nil))
1254
615eabde
GM		 1255(defun icalendar-first-weekday-of-year (abbrevweekday year)
1256 "Find the first ABBREVWEEKDAY in a given YEAR.
1257Returns day number."
1258 (let* ((day-of-week-jan01 (calendar-day-of-week (list 1 1 year)))
1259 (result (+ 1
1260 (- (icalendar--get-weekday-number abbrevweekday)
1261 day-of-week-jan01))))
1262 (cond ((<= result 0)
1263 (setq result (+ result 7)))
1264 ((> result 7)
1265 (setq result (- result 7))))
1266 result))
f8e9107c 1267
9dd9ed20
GM		 1268(defun icalendar--convert-weekly-to-ical (nonmarker entry-main)
1269 "Convert weekly diary entry to icalendar format.
9dd9ed20
GM		 1270NONMARKER is a regular expression matching the start of non-marking
1271entries. ENTRY-MAIN is the first line of the diary entry."
1272 (if (and (string-match (concat nonmarker
1273 "\\([a-z]+\\)\\s-+"
b4340b3f 1274 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)"
9dd9ed20 1275 "\\([ap]m\\)?"
b4340b3f
UJ		 1276 "\\(-"
1277 "\\([0-9][0-9]?:[0-9][0-9]\\)"
9dd9ed20
GM		 1278 "\\([ap]m\\)?\\)?"
1279 "\\)?"
d2afe62f 1280 "\\s-*\\(.*?\\) ?$")
9dd9ed20
GM		 1281 entry-main)
1282 (icalendar--get-weekday-abbrev
1283 (substring entry-main (match-beginning 1)
1284 (match-end 1))))
1285 (let* ((day (icalendar--get-weekday-abbrev
1286 (substring entry-main (match-beginning 1)
1287 (match-end 1))))
1288 (starttimestring (icalendar--diarytime-to-isotime
1289 (if (match-beginning 3)
1290 (substring entry-main
1291 (match-beginning 3)
1292 (match-end 3))
1293 nil)
1294 (if (match-beginning 4)
1295 (substring entry-main
1296 (match-beginning 4)
1297 (match-end 4))
1298 nil)))
1299 (endtimestring (icalendar--diarytime-to-isotime
1300 (if (match-beginning 6)
1301 (substring entry-main
1302 (match-beginning 6)
1303 (match-end 6))
1304 nil)
1305 (if (match-beginning 7)
1306 (substring entry-main
1307 (match-beginning 7)
1308 (match-end 7))
1309 nil)))
1310 (summary (icalendar--convert-string-for-export
1311 (substring entry-main (match-beginning 8)
1312 (match-end 8)))))
1313 (icalendar--dmsg "weekly %s" entry-main)
1314
1315 (when starttimestring
1316 (unless endtimestring
1317 (let ((time (read
1318 (icalendar--rris "^T0?" ""
1319 starttimestring))))
1320 (setq endtimestring (format "T%06d"
1321 (+ 10000 time))))))
d2afe62f
GM		 1322 (list (concat "\nDTSTART;"
1323 (if starttimestring
1324 "VALUE=DATE-TIME:"
1325 "VALUE=DATE:")
f8e9107c
GM		 1326 ;; Find the first requested weekday of the
1327 ;; start year
615eabde
GM		 1328 (funcall 'format "%04d%02d%02d"
1329 icalendar-recurring-start-year 1
1330 (icalendar-first-weekday-of-year
1331 day icalendar-recurring-start-year))
d2afe62f
GM		 1332 (or starttimestring "")
1333 "\nDTEND;"
1334 (if endtimestring
1335 "VALUE=DATE-TIME:"
1336 "VALUE=DATE:")
615eabde 1337 (funcall 'format "%04d%02d%02d"
0fc438b8 1338 ;; end is non-inclusive!
615eabde
GM		 1339 icalendar-recurring-start-year 1
1340 (+ (icalendar-first-weekday-of-year
1341 day icalendar-recurring-start-year)
f8e9107c 1342 (if endtimestring 0 1)))
d2afe62f
GM		 1343 (or endtimestring "")
1344 "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY="
1345 day)
1346 summary))
9dd9ed20
GM		 1347 ;; no match
1348 nil))
1349
1350(defun icalendar--convert-yearly-to-ical (nonmarker entry-main)
1351 "Convert yearly diary entry to icalendar format.
9dd9ed20
GM		 1352NONMARKER is a regular expression matching the start of non-marking
1353entries. ENTRY-MAIN is the first line of the diary entry."
1354 (if (string-match (concat nonmarker
0fc438b8 1355 (if (eq (icalendar--date-style) 'european)
b4340b3f
UJ		 1356 "\\([0-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
1357 "\\([a-z]+\\)\\s-+\\([0-9]+[0-9]?\\)\\s-+")
9dd9ed20 1358 "\\*?\\s-*"
b4340b3f 1359 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
9dd9ed20 1360 "\\("
b4340b3f 1361 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
9dd9ed20 1362 "\\)?"
d2afe62f 1363 "\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years
9dd9ed20
GM		 1364 )
1365 entry-main)
0fc438b8
GM		 1366 (let* ((daypos (if (eq (icalendar--date-style) 'european) 1 2))
1367 (monpos (if (eq (icalendar--date-style) 'european) 2 1))
9dd9ed20
GM		 1368 (day (read (substring entry-main
1369 (match-beginning daypos)
1370 (match-end daypos))))
1371 (month (icalendar--get-month-number
1372 (substring entry-main
1373 (match-beginning monpos)
1374 (match-end monpos))))
1375 (starttimestring (icalendar--diarytime-to-isotime
1376 (if (match-beginning 4)
1377 (substring entry-main
1378 (match-beginning 4)
1379 (match-end 4))
1380 nil)
1381 (if (match-beginning 5)
1382 (substring entry-main
1383 (match-beginning 5)
1384 (match-end 5))
1385 nil)))
1386 (endtimestring (icalendar--diarytime-to-isotime
1387 (if (match-beginning 7)
1388 (substring entry-main
1389 (match-beginning 7)
1390 (match-end 7))
1391 nil)
1392 (if (match-beginning 8)
1393 (substring entry-main
1394 (match-beginning 8)
1395 (match-end 8))
1396 nil)))
1397 (summary (icalendar--convert-string-for-export
1398 (substring entry-main (match-beginning 9)
1399 (match-end 9)))))
1400 (icalendar--dmsg "yearly %s" entry-main)
1401
1402 (when starttimestring
1403 (unless endtimestring
1404 (let ((time (read
1405 (icalendar--rris "^T0?" ""
1406 starttimestring))))
1407 (setq endtimestring (format "T%06d"
1408 (+ 10000 time))))))
d2afe62f
GM		 1409 (list (concat "\nDTSTART;"
1410 (if starttimestring "VALUE=DATE-TIME:"
1411 "VALUE=DATE:")
1412 (format "1900%02d%02d" month day)
1413 (or starttimestring "")
1414 "\nDTEND;"
1415 (if endtimestring "VALUE=DATE-TIME:"
1416 "VALUE=DATE:")
1417 ;; end is not included! shift by one day
1418 (icalendar--date-to-isodate
1419 (list month day 1900)
1420 (if endtimestring 0 1))
1421 (or endtimestring "")
1422 "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
f8e9107c 1423 (format "%d" month)
d2afe62f 1424 ";BYMONTHDAY="
f8e9107c 1425 (format "%d" day))
d2afe62f 1426 summary))
9dd9ed20
GM		 1427 ;; no match
1428 nil))
1429
1430(defun icalendar--convert-sexp-to-ical (nonmarker entry-main)
1431 "Convert complex sexp diary entry to icalendar format -- unsupported!
1432
1433FIXME!
1434
1435NONMARKER is a regular expression matching the start of non-marking
1436entries. ENTRY-MAIN is the first line of the diary entry."
d2afe62f
GM		 1437 (cond ((string-match (concat nonmarker
1438 "%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$")
1439 entry-main)
1440 ;; simple sexp entry as generated by icalendar.el: strip off the
1441 ;; unnecessary (and)
1442 (icalendar--dmsg "diary-sexp from icalendar.el %s" entry-main)
1443 (icalendar--convert-to-ical
1444 nonmarker
1445 (concat "%%"
1446 (substring entry-main (match-beginning 1) (match-end 1))
1447 (substring entry-main (match-beginning 2) (match-end 2)))))
1448 ((string-match (concat nonmarker
1449 "%%([^)]+)\\s-*.*")
1450 entry-main)
1451 (icalendar--dmsg "diary-sexp %s" entry-main)
1452 (error "Sexp-entries are not supported yet"))
1453 (t
1454 ;; no match
1455 nil)))
9dd9ed20
GM		 1456
1457(defun icalendar--convert-block-to-ical (nonmarker entry-main)
1458 "Convert block diary entry to icalendar format.
9dd9ed20
GM		 1459NONMARKER is a regular expression matching the start of non-marking
1460entries. ENTRY-MAIN is the first line of the diary entry."
1461 (if (string-match (concat nonmarker
1462 "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)"
1463 " +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
b4340b3f 1464 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
9dd9ed20 1465 "\\("
b4340b3f 1466 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
9dd9ed20 1467 "\\)?"
d2afe62f 1468 "\\s-*\\(.*?\\) ?$")
9dd9ed20
GM		 1469 entry-main)
1470 (let* ((startstring (substring entry-main
1471 (match-beginning 1)
1472 (match-end 1)))
1473 (endstring (substring entry-main
1474 (match-beginning 2)
1475 (match-end 2)))
1476 (startisostring (icalendar--datestring-to-isodate
1477 startstring))
1478 (endisostring (icalendar--datestring-to-isodate
1479 endstring))
1480 (endisostring+1 (icalendar--datestring-to-isodate
1481 endstring 1))
1482 (starttimestring (icalendar--diarytime-to-isotime
1483 (if (match-beginning 4)
1484 (substring entry-main
1485 (match-beginning 4)
1486 (match-end 4))
1487 nil)
1488 (if (match-beginning 5)
1489 (substring entry-main
1490 (match-beginning 5)
1491 (match-end 5))
1492 nil)))
1493 (endtimestring (icalendar--diarytime-to-isotime
1494 (if (match-beginning 7)
1495 (substring entry-main
1496 (match-beginning 7)
1497 (match-end 7))
1498 nil)
1499 (if (match-beginning 8)
1500 (substring entry-main
1501 (match-beginning 8)
1502 (match-end 8))
1503 nil)))
1504 (summary (icalendar--convert-string-for-export
1505 (substring entry-main (match-beginning 9)
1506 (match-end 9)))))
1507 (icalendar--dmsg "diary-block %s" entry-main)
1508 (when starttimestring
1509 (unless endtimestring
1510 (let ((time
1511 (read (icalendar--rris "^T0?" ""
1512 starttimestring))))
1513 (setq endtimestring (format "T%06d"
1514 (+ 10000 time))))))
1515 (if starttimestring
1516 ;; with time -> write rrule
d2afe62f
GM		 1517 (list (concat "\nDTSTART;VALUE=DATE-TIME:"
1518 startisostring
1519 starttimestring
1520 "\nDTEND;VALUE=DATE-TIME:"
1521 startisostring
1522 endtimestring
1523 "\nRRULE:FREQ=DAILY;INTERVAL=1;UNTIL="
1524 endisostring)
1525 summary)
9dd9ed20 1526 ;; no time -> write long event
d2afe62f
GM		 1527 (list (concat "\nDTSTART;VALUE=DATE:" startisostring
1528 "\nDTEND;VALUE=DATE:" endisostring+1)
1529 summary)))
9dd9ed20
GM		 1530 ;; no match
1531 nil))
1532
1533(defun icalendar--convert-float-to-ical (nonmarker entry-main)
1534 "Convert float diary entry to icalendar format -- unsupported!
1535
1536FIXME!
1537
1538NONMARKER is a regular expression matching the start of non-marking
1539entries. ENTRY-MAIN is the first line of the diary entry."
1540 (if (string-match (concat nonmarker
d2afe62f 1541 "%%(diary-float \\([^)]+\\))\\s-*\\(.*?\\) ?$")
9dd9ed20
GM		 1542 entry-main)
1543 (progn
1544 (icalendar--dmsg "diary-float %s" entry-main)
1545 (error "`diary-float' is not supported yet"))
1546 ;; no match
1547 nil))
1548
1549(defun icalendar--convert-date-to-ical (nonmarker entry-main)
1550 "Convert `diary-date' diary entry to icalendar format -- unsupported!
1551
1552FIXME!
1553
1554NONMARKER is a regular expression matching the start of non-marking
1555entries. ENTRY-MAIN is the first line of the diary entry."
1556 (if (string-match (concat nonmarker
d2afe62f 1557 "%%(diary-date \\([^)]+\\))\\s-*\\(.*?\\) ?$")
9dd9ed20
GM		 1558 entry-main)
1559 (progn
1560 (icalendar--dmsg "diary-date %s" entry-main)
1561 (error "`diary-date' is not supported yet"))
1562 ;; no match
1563 nil))
1564
1565(defun icalendar--convert-cyclic-to-ical (nonmarker entry-main)
1566 "Convert `diary-cyclic' diary entry to icalendar format.
9dd9ed20
GM		 1567NONMARKER is a regular expression matching the start of non-marking
1568entries. ENTRY-MAIN is the first line of the diary entry."
1569 (if (string-match (concat nonmarker
1570 "%%(diary-cyclic \\([^ ]+\\) +"
1571 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
b4340b3f 1572 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
9dd9ed20 1573 "\\("
b4340b3f 1574 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
9dd9ed20 1575 "\\)?"
d2afe62f 1576 "\\s-*\\(.*?\\) ?$")
9dd9ed20
GM		 1577 entry-main)
1578 (let* ((frequency (substring entry-main (match-beginning 1)
1579 (match-end 1)))
1580 (datetime (substring entry-main (match-beginning 2)
1581 (match-end 2)))
1582 (startisostring (icalendar--datestring-to-isodate
1583 datetime))
1584 (endisostring (icalendar--datestring-to-isodate
1585 datetime))
1586 (endisostring+1 (icalendar--datestring-to-isodate
1587 datetime 1))
1588 (starttimestring (icalendar--diarytime-to-isotime
1589 (if (match-beginning 4)
1590 (substring entry-main
1591 (match-beginning 4)
1592 (match-end 4))
1593 nil)
1594 (if (match-beginning 5)
1595 (substring entry-main
1596 (match-beginning 5)
1597 (match-end 5))
1598 nil)))
1599 (endtimestring (icalendar--diarytime-to-isotime
1600 (if (match-beginning 7)
1601 (substring entry-main
1602 (match-beginning 7)
1603 (match-end 7))
1604 nil)
1605 (if (match-beginning 8)
1606 (substring entry-main
1607 (match-beginning 8)
1608 (match-end 8))
1609 nil)))
1610 (summary (icalendar--convert-string-for-export
1611 (substring entry-main (match-beginning 9)
1612 (match-end 9)))))
1613 (icalendar--dmsg "diary-cyclic %s" entry-main)
1614 (when starttimestring
1615 (unless endtimestring
1616 (let ((time
1617 (read (icalendar--rris "^T0?" ""
1618 starttimestring))))
1619 (setq endtimestring (format "T%06d"
1620 (+ 10000 time))))))
d2afe62f
GM		 1621 (list (concat "\nDTSTART;"
1622 (if starttimestring "VALUE=DATE-TIME:"
1623 "VALUE=DATE:")
1624 startisostring
1625 (or starttimestring "")
1626 "\nDTEND;"
1627 (if endtimestring "VALUE=DATE-TIME:"
1628 "VALUE=DATE:")
1629 (if endtimestring endisostring endisostring+1)
1630 (or endtimestring "")
1631 "\nRRULE:FREQ=DAILY;INTERVAL=" frequency
1632 ;; strange: korganizer does not expect
1633 ;; BYSOMETHING here...
1634 )
1635 summary))
9dd9ed20
GM		 1636 ;; no match
1637 nil))
1638
1639(defun icalendar--convert-anniversary-to-ical (nonmarker entry-main)
1640 "Convert `diary-anniversary' diary entry to icalendar format.
9dd9ed20
GM		 1641NONMARKER is a regular expression matching the start of non-marking
1642entries. ENTRY-MAIN is the first line of the diary entry."
1643 (if (string-match (concat nonmarker
1644 "%%(diary-anniversary \\([^)]+\\))\\s-*"
b4340b3f 1645 "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?"
9dd9ed20 1646 "\\("
b4340b3f 1647 "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?"
9dd9ed20 1648 "\\)?"
d2afe62f 1649 "\\s-*\\(.*?\\) ?$")
9dd9ed20
GM		 1650 entry-main)
1651 (let* ((datetime (substring entry-main (match-beginning 1)
1652 (match-end 1)))
1653 (startisostring (icalendar--datestring-to-isodate
1654 datetime))
1655 (endisostring (icalendar--datestring-to-isodate
1656 datetime 1))
1657 (starttimestring (icalendar--diarytime-to-isotime
1658 (if (match-beginning 3)
1659 (substring entry-main
1660 (match-beginning 3)
1661 (match-end 3))
1662 nil)
1663 (if (match-beginning 4)
1664 (substring entry-main
1665 (match-beginning 4)
1666 (match-end 4))
1667 nil)))
1668 (endtimestring (icalendar--diarytime-to-isotime
1669 (if (match-beginning 6)
1670 (substring entry-main
1671 (match-beginning 6)
1672 (match-end 6))
1673 nil)
1674 (if (match-beginning 7)
1675 (substring entry-main
1676 (match-beginning 7)
1677 (match-end 7))
1678 nil)))
1679 (summary (icalendar--convert-string-for-export
1680 (substring entry-main (match-beginning 8)
1681 (match-end 8)))))
1682 (icalendar--dmsg "diary-anniversary %s" entry-main)
1683 (when starttimestring
1684 (unless endtimestring
1685 (let ((time
1686 (read (icalendar--rris "^T0?" ""
1687 starttimestring))))
1688 (setq endtimestring (format "T%06d"
1689 (+ 10000 time))))))
d2afe62f
GM		 1690 (list (concat "\nDTSTART;"
1691 (if starttimestring "VALUE=DATE-TIME:"
1692 "VALUE=DATE:")
1693 startisostring
1694 (or starttimestring "")
1695 "\nDTEND;"
1696 (if endtimestring "VALUE=DATE-TIME:"
1697 "VALUE=DATE:")
1698 endisostring
1699 (or endtimestring "")
1700 "\nRRULE:FREQ=YEARLY;INTERVAL=1"
1701 ;; the following is redundant,
1702 ;; but korganizer seems to expect this... ;(
1703 ;; and evolution doesn't understand it... :(
1704 ;; so... who is wrong?!
1705 ";BYMONTH="
1706 (substring startisostring 4 6)
1707 ";BYMONTHDAY="
1708 (substring startisostring 6 8))
1709 summary))
9dd9ed20
GM		 1710 ;; no match
1711 nil))
1712
707c20a8 1713;; ======================================================================
e0cd68ee 1714;; Import -- convert icalendar to emacs-diary
707c20a8
GM		 1715;; ======================================================================
1716
86fc29f9 1717;;;###autoload
707c20a8 1718(defun icalendar-import-file (ical-filename diary-filename
e0cd68ee 1719 &optional non-marking)
d2afe62f 1720 "Import an iCalendar file and append to a diary file.
707c20a8
GM		 1721Argument ICAL-FILENAME output iCalendar file.
1722Argument DIARY-FILENAME input `diary-file'.
1723Optional argument NON-MARKING determines whether events are created as
e0cd68ee 1724non-marking or not."
309c894f
GM		 1725 (interactive "fImport iCalendar data from file:
1726Finto diary file:
707c20a8
GM		 1727p")
1728 ;; clean up the diary file
1729 (save-current-buffer
707c20a8
GM		 1730 ;; now load and convert from the ical file
1731 (set-buffer (find-file ical-filename))
e0cd68ee 1732 (icalendar-import-buffer diary-filename t non-marking)))
707c20a8 1733
86fc29f9 1734;;;###autoload
e0cd68ee
GM		 1735(defun icalendar-import-buffer (&optional diary-file do-not-ask
1736 non-marking)
707c20a8
GM		 1737 "Extract iCalendar events from current buffer.
1738
1739This function searches the current buffer for the first iCalendar
1740object, reads it and adds all VEVENT elements to the diary
1741DIARY-FILE.
1742
1743It will ask for each appointment whether to add it to the diary
76b0b55f
GM		 1744unless DO-NOT-ASK is non-nil. When called interactively,
1745DO-NOT-ASK is nil, so that you are asked for each event.
707c20a8
GM		 1746
1747NON-MARKING determines whether diary events are created as
1748non-marking.
1749
74692b14 1750Return code t means that importing worked well, return code nil
ad25cccf 1751means that an error has occurred. Error messages will be in the
74692b14 1752buffer `*icalendar-errors*'."
707c20a8
GM		 1753 (interactive)
1754 (save-current-buffer
1755 ;; prepare ical
1756 (message "Preparing icalendar...")
e0cd68ee 1757 (set-buffer (icalendar--get-unfolded-buffer (current-buffer)))
707c20a8
GM		 1758 (goto-char (point-min))
1759 (message "Preparing icalendar...done")
1760 (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t)
1761 (let (ical-contents ical-errors)
1762 ;; read ical
1763 (message "Reading icalendar...")
1764 (beginning-of-line)
e0cd68ee 1765 (setq ical-contents (icalendar--read-element nil nil))
707c20a8
GM		 1766 (message "Reading icalendar...done")
1767 ;; convert ical
1768 (message "Converting icalendar...")
e0cd68ee 1769 (setq ical-errors (icalendar--convert-ical-to-diary
707c20a8
GM		 1770 ical-contents
1771 diary-file do-not-ask non-marking))
1772 (when diary-file
9dd9ed20
GM		 1773 ;; save the diary file if it is visited already
1774 (let ((b (find-buffer-visiting diary-file)))
1775 (when b
1776 (save-current-buffer
1777 (set-buffer b)
1778 (save-buffer)))))
707c20a8 1779 (message "Converting icalendar...done")
ad25cccf 1780 ;; return t if no error occurred
74692b14 1781 (not ical-errors))
707c20a8 1782 (message
74692b14
GM		 1783 "Current buffer does not contain icalendar contents!")
1784 ;; return nil, i.e. import did not work
1785 nil)))
707c20a8 1786
e0cd68ee 1787(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
cb5b40ee 1788(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer "22.1")
e0cd68ee 1789
e0cd68ee 1790(defun icalendar--format-ical-event (event)
707c20a8 1791 "Create a string representation of an iCalendar EVENT."
b3360383
GM		 1792 (if (functionp icalendar-import-format)
1793 (funcall icalendar-import-format event)
1794 (let ((string icalendar-import-format)
707c20a8 1795 (conversion-list
d2afe62f
GM		 1796 '(("%c" CLASS icalendar-import-format-class)
1797 ("%d" DESCRIPTION icalendar-import-format-description)
707c20a8 1798 ("%l" LOCATION icalendar-import-format-location)
d2afe62f
GM		 1799 ("%o" ORGANIZER icalendar-import-format-organizer)
1800 ("%s" SUMMARY icalendar-import-format-summary)
1801 ("%t" STATUS icalendar-import-format-status)
1802 ("%u" URL icalendar-import-format-url))))
707c20a8 1803 ;; convert the specifiers in the format string
b67b0f7f
JB		 1804 (mapc (lambda (i)
1805 (let* ((spec (car i))
1806 (prop (cadr i))
1807 (format (car (cddr i)))
1808 (contents (icalendar--get-event-property event prop))
1809 (formatted-contents ""))
1810 (when (and contents (> (length contents) 0))
1811 (setq formatted-contents
1812 (icalendar--rris "%s"
1813 (icalendar--convert-string-for-import
1814 contents)
1815 (symbol-value format)
1816 t t)))
1817 (setq string (icalendar--rris spec
1818 formatted-contents
1819 string
1820 t t))))
1821 conversion-list)
b3360383 1822 string)))
707c20a8 1823
e0cd68ee
GM		 1824(defun icalendar--convert-ical-to-diary (ical-list diary-file
1825 &optional do-not-ask
1826 non-marking)
37b7b216 1827 "Convert iCalendar data to an Emacs diary file.
707c20a8
GM		 1828Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
1829DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event
1830whether to actually import it. NON-MARKING determines whether diary
1831events are created as non-marking.
1832This function attempts to return t if something goes wrong. In this
1833case an error string which describes all the errors and problems is
9dd9ed20 1834written into the buffer `*icalendar-errors*'."
e0cd68ee 1835 (let* ((ev (icalendar--all-events ical-list))
707c20a8
GM		 1836 (error-string "")
1837 (event-ok t)
1838 (found-error nil)
309c894f 1839 (zone-map (icalendar--convert-all-timezones ical-list))
707c20a8
GM		 1840 e diary-string)
1841 ;; step through all events/appointments
1842 (while ev
1843 (setq e (car ev))
1844 (setq ev (cdr ev))
1845 (setq event-ok nil)
1846 (condition-case error-val
9dd9ed20 1847 (let* ((dtstart (icalendar--get-event-property e 'DTSTART))
309c894f
GM		 1848 (dtstart-zone (icalendar--find-time-zone
1849 (icalendar--get-event-property-attributes
1850 e 'DTSTART)
1851 zone-map))
1852 (dtstart-dec (icalendar--decode-isodatetime dtstart nil
1853 dtstart-zone))
74692b14 1854 (start-d (icalendar--datetime-to-diary-date
9dd9ed20
GM		 1855 dtstart-dec))
1856 (start-t (icalendar--datetime-to-colontime dtstart-dec))
1857 (dtend (icalendar--get-event-property e 'DTEND))
309c894f
GM		 1858 (dtend-zone (icalendar--find-time-zone
1859 (icalendar--get-event-property-attributes
1860 e 'DTEND)
1861 zone-map))
1862 (dtend-dec (icalendar--decode-isodatetime dtend
1863 nil dtend-zone))
1864 (dtend-1-dec (icalendar--decode-isodatetime dtend -1
1865 dtend-zone))
707c20a8 1866 end-d
9dd9ed20 1867 end-1-d
707c20a8 1868 end-t
d2afe62f 1869 (summary (icalendar--convert-string-for-import
e0cd68ee 1870 (or (icalendar--get-event-property e 'SUMMARY)
d2afe62f 1871 "No summary")))
e0cd68ee
GM		 1872 (rrule (icalendar--get-event-property e 'RRULE))
1873 (rdate (icalendar--get-event-property e 'RDATE))
1874 (duration (icalendar--get-event-property e 'DURATION)))
d2afe62f 1875 (icalendar--dmsg "%s: `%s'" start-d summary)
74692b14 1876 ;; check whether start-time is missing
9dd9ed20
GM		 1877 (if (and dtstart
1878 (string=
1879 (cadr (icalendar--get-event-property-attributes
1880 e 'DTSTART))
1881 "DATE"))
74692b14 1882 (setq start-t nil))
707c20a8 1883 (when duration
9dd9ed20
GM		 1884 (let ((dtend-dec-d (icalendar--add-decoded-times
1885 dtstart-dec
1886 (icalendar--decode-isoduration duration)))
1887 (dtend-1-dec-d (icalendar--add-decoded-times
1888 dtstart-dec
1889 (icalendar--decode-isoduration duration
1890 t))))
1891 (if (and dtend-dec (not (eq dtend-dec dtend-dec-d)))
707c20a8 1892 (message "Inconsistent endtime and duration for %s"
d2afe62f 1893 summary))
9dd9ed20
GM		 1894 (setq dtend-dec dtend-dec-d)
1895 (setq dtend-1-dec dtend-1-dec-d)))
1896 (setq end-d (if dtend-dec
1897 (icalendar--datetime-to-diary-date dtend-dec)
707c20a8 1898 start-d))
9dd9ed20
GM		 1899 (setq end-1-d (if dtend-1-dec
1900 (icalendar--datetime-to-diary-date dtend-1-dec)
1901 start-d))
1902 (setq end-t (if (and
1903 dtend-dec
1904 (not (string=
1905 (cadr
1906 (icalendar--get-event-property-attributes
1907 e 'DTEND))
1908 "DATE")))
1909 (icalendar--datetime-to-colontime dtend-dec)
707c20a8 1910 start-t))
e0cd68ee 1911 (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d)
707c20a8
GM		 1912 (cond
1913 ;; recurring event
1914 (rrule
9dd9ed20
GM		 1915 (setq diary-string
1916 (icalendar--convert-recurring-to-diary e dtstart-dec start-t
1917 end-t))
1918 (setq event-ok t))
707c20a8 1919 (rdate
e0cd68ee 1920 (icalendar--dmsg "rdate event")
707c20a8 1921 (setq diary-string "")
b67b0f7f
JB		 1922 (mapc (lambda (datestring)
1923 (setq diary-string
1924 (concat diary-string
1925 (format "......"))))
1926 (icalendar--split-value rdate)))
707c20a8 1927 ;; non-recurring event
8ee7eb6b 1928 ;; all-day event
707c20a8 1929 ((not (string= start-d end-d))
9dd9ed20
GM		 1930 (setq diary-string
1931 (icalendar--convert-non-recurring-all-day-to-diary
1932 e start-d end-1-d))
707c20a8
GM		 1933 (setq event-ok t))
1934 ;; not all-day
1935 ((and start-t (or (not end-t)
1936 (not (string= start-t end-t))))
9dd9ed20
GM		 1937 (setq diary-string
1938 (icalendar--convert-non-recurring-not-all-day-to-diary
1939 e dtstart-dec dtend-dec start-t end-t))
707c20a8
GM		 1940 (setq event-ok t))
1941 ;; all-day event
1942 (t
e0cd68ee 1943 (icalendar--dmsg "all day event")
74692b14 1944 (setq diary-string (icalendar--datetime-to-diary-date
9dd9ed20 1945 dtstart-dec "/"))
707c20a8
GM		 1946 (setq event-ok t)))
1947 ;; add all other elements unless the user doesn't want to have
1948 ;; them
1949 (if event-ok
1950 (progn
1951 (setq diary-string
e0cd68ee
GM		 1952 (concat diary-string " "
1953 (icalendar--format-ical-event e)))
d2afe62f 1954 (if do-not-ask (setq summary nil))
76b0b55f
GM		 1955 ;; add entry to diary and store actual name of diary
1956 ;; file (in case it was nil)
1957 (setq diary-file
1958 (icalendar--add-diary-entry diary-string diary-file
1959 non-marking summary)))
707c20a8
GM		 1960 ;; event was not ok
1961 (setq found-error t)
1962 (setq error-string
e0cd68ee
GM		 1963 (format "%s\nCannot handle this event:%s"
1964 error-string e))))
74692b14 1965 ;; FIXME: inform user about ignored event properties
707c20a8
GM		 1966 ;; handle errors
1967 (error
1968 (message "Ignoring event \"%s\"" e)
1969 (setq found-error t)
74692b14
GM		 1970 (setq error-string (format "%s\n%s\nCannot handle this event: %s"
1971 error-val error-string e))
80070cca 1972 (message "%s" error-string))))
76b0b55f 1973
37b7b216 1974 ;; insert final newline
76b0b55f
GM		 1975 (if diary-file
1976 (let ((b (find-buffer-visiting diary-file)))
1977 (when b
1978 (save-current-buffer
1979 (set-buffer b)
1980 (goto-char (point-max))
1981 (insert "\n")))))
707c20a8
GM		 1982 (if found-error
1983 (save-current-buffer
9dd9ed20 1984 (set-buffer (get-buffer-create "*icalendar-errors*"))
707c20a8
GM		 1985 (erase-buffer)
1986 (insert error-string)))
1987 (message "Converting icalendar...done")
1988 found-error))
1989
9dd9ed20
GM		 1990;; subroutines for importing
1991(defun icalendar--convert-recurring-to-diary (e dtstart-dec start-t end-t)
1992 "Convert recurring icalendar event E to diary format.
1993
1994DTSTART-DEC is the DTSTART property of E.
1995START-T is the event's start time in diary format.
1996END-T is the event's end time in diary format."
1997 (icalendar--dmsg "recurring event")
1998 (let* ((rrule (icalendar--get-event-property e 'RRULE))
1999 (rrule-props (icalendar--split-value rrule))
2000 (frequency (cadr (assoc 'FREQ rrule-props)))
2001 (until (cadr (assoc 'UNTIL rrule-props)))
2002 (count (cadr (assoc 'COUNT rrule-props)))
2003 (interval (read (or (cadr (assoc 'INTERVAL rrule-props)) "1")))
2004 (dtstart-conv (icalendar--datetime-to-diary-date dtstart-dec))
2005 (until-conv (icalendar--datetime-to-diary-date
2006 (icalendar--decode-isodatetime until)))
2007 (until-1-conv (icalendar--datetime-to-diary-date
2008 (icalendar--decode-isodatetime until -1)))
2009 (result ""))
2010
2011 ;; FIXME FIXME interval!!!!!!!!!!!!!
2012
2013 (when count
2014 (if until
2015 (message "Must not have UNTIL and COUNT -- ignoring COUNT element!")
2016 (let ((until-1 0))
2017 (cond ((string-equal frequency "DAILY")
2018 (setq until (icalendar--add-decoded-times
d2afe62f 2019 dtstart-dec
9dd9ed20
GM		 2020 (list 0 0 0 (* (read count) interval) 0 0)))
2021 (setq until-1 (icalendar--add-decoded-times
2022 dtstart-dec
2023 (list 0 0 0 (* (- (read count) 1) interval)
2024 0 0)))
2025 )
2026 ((string-equal frequency "WEEKLY")
2027 (setq until (icalendar--add-decoded-times
2028 dtstart-dec
2029 (list 0 0 0 (* (read count) 7 interval) 0 0)))
2030 (setq until-1 (icalendar--add-decoded-times
2031 dtstart-dec
2032 (list 0 0 0 (* (- (read count) 1) 7
2033 interval) 0 0)))
2034 )
2035 ((string-equal frequency "MONTHLY")
2036 (setq until (icalendar--add-decoded-times
2037 dtstart-dec (list 0 0 0 0 (* (- (read count) 1)
2038 interval) 0)))
2039 (setq until-1 (icalendar--add-decoded-times
2040 dtstart-dec (list 0 0 0 0 (* (- (read count) 1)
2041 interval) 0)))
2042 )
2043 ((string-equal frequency "YEARLY")
2044 (setq until (icalendar--add-decoded-times
2045 dtstart-dec (list 0 0 0 0 0 (* (- (read count) 1)
2046 interval))))
2047 (setq until-1 (icalendar--add-decoded-times
2048 dtstart-dec
2049 (list 0 0 0 0 0 (* (- (read count) 1)
2050 interval))))
2051 )
2052 (t
2053 (message "Cannot handle COUNT attribute for `%s' events."
2054 frequency)))
2055 (setq until-conv (icalendar--datetime-to-diary-date until))
2056 (setq until-1-conv (icalendar--datetime-to-diary-date until-1))
2057 ))
2058 )
2059 (cond ((string-equal frequency "WEEKLY")
2060 (if (not start-t)
2061 (progn
2062 ;; weekly and all-day
2063 (icalendar--dmsg "weekly all-day")
2064 (if until
2065 (setq result
2066 (format
2067 (concat "%%%%(and "
2068 "(diary-cyclic %d %s) "
2069 "(diary-block %s %s))")
2070 (* interval 7)
2071 dtstart-conv
2072 dtstart-conv
2073 (if count until-1-conv until-conv)
2074 ))
2075 (setq result
2076 (format "%%%%(and (diary-cyclic %d %s))"
2077 (* interval 7)
2078 dtstart-conv))))
2079 ;; weekly and not all-day
2080 (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
2081 (weekday
2082 (icalendar--get-weekday-number byday)))
2083 (icalendar--dmsg "weekly not-all-day")
2084 (if until
2085 (setq result
2086 (format
2087 (concat "%%%%(and "
2088 "(diary-cyclic %d %s) "
2089 "(diary-block %s %s)) "
2090 "%s%s%s")
2091 (* interval 7)
2092 dtstart-conv
2093 dtstart-conv
2094 until-conv
2095 (or start-t "")
2096 (if end-t "-" "") (or end-t "")))
2097 ;; no limit
2098 ;; FIXME!!!!
2099 ;; DTSTART;VALUE=DATE-TIME:20030919T090000
2100 ;; DTEND;VALUE=DATE-TIME:20030919T113000
2101 (setq result
2102 (format
2103 "%%%%(and (diary-cyclic %s %s)) %s%s%s"
2104 (* interval 7)
2105 dtstart-conv
2106 (or start-t "")
2107 (if end-t "-" "") (or end-t "")))))))
2108 ;; yearly
2109 ((string-equal frequency "YEARLY")
2110 (icalendar--dmsg "yearly")
2111 (if until
0fc438b8
GM		 2112 (let ((day (nth 3 dtstart-dec))
2113 (month (nth 4 dtstart-dec)))
2114 (setq result (concat "%%(and (diary-date "
2115 (cond ((eq (icalendar--date-style) 'iso)
2116 (format "t %d %d" month day))
2117 ((eq (icalendar--date-style) 'european)
2118 (format "%d %d t" day month))
2119 ((eq (icalendar--date-style) 'american)
2120 (format "%d %d t" month day)))
2121 ") (diary-block "
2122 dtstart-conv
2123 " "
2124 until-conv
2125 ")) "
2126 (or start-t "")
2127 (if end-t "-" "")
2128 (or end-t ""))))
9dd9ed20
GM		 2129 (setq result (format
2130 "%%%%(and (diary-anniversary %s)) %s%s%s"
2131 dtstart-conv
2132 (or start-t "")
2133 (if end-t "-" "") (or end-t "")))))
2134 ;; monthly
2135 ((string-equal frequency "MONTHLY")
2136 (icalendar--dmsg "monthly")
2137 (setq result
2138 (format
0fc438b8
GM		 2139 "%%%%(and (diary-date %s) (diary-block %s %s)) %s%s%s"
2140 (let ((day (nth 3 dtstart-dec)))
2141 (cond ((eq (icalendar--date-style) 'iso)
2142 (format "t t %d" day))
2143 ((eq (icalendar--date-style) 'european)
2144 (format "%d t t" day))
2145 ((eq (icalendar--date-style) 'american)
2146 (format "t %d t" day))))
9dd9ed20
GM		 2147 dtstart-conv
2148 (if until
2149 until-conv
0fc438b8 2150 (if (eq (icalendar--date-style) 'iso) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited
9dd9ed20
GM		 2151 (or start-t "")
2152 (if end-t "-" "") (or end-t ""))))
2153 ;; daily
2154 ((and (string-equal frequency "DAILY"))
2155 (if until
2156 (setq result
2157 (format
2158 (concat "%%%%(and (diary-cyclic %s %s) "
2159 "(diary-block %s %s)) %s%s%s")
2160 interval dtstart-conv dtstart-conv
2161 (if count until-1-conv until-conv)
2162 (or start-t "")
2163 (if end-t "-" "") (or end-t "")))
2164 (setq result
2165 (format
2166 "%%%%(and (diary-cyclic %s %s)) %s%s%s"
2167 interval
2168 dtstart-conv
2169 (or start-t "")
2170 (if end-t "-" "") (or end-t ""))))))
2171 ;; Handle exceptions from recurrence rules
2172 (let ((ex-dates (icalendar--get-event-properties e 'EXDATE)))
2173 (while ex-dates
2174 (let* ((ex-start (icalendar--decode-isodatetime
2175 (car ex-dates)))
2176 (ex-d (icalendar--datetime-to-diary-date
2177 ex-start)))
2178 (setq result
2179 (icalendar--rris "^%%(\\(and \\)?"
2180 (format
2181 "%%%%(and (not (diary-date %s)) "
2182 ex-d)
2183 result)))
2184 (setq ex-dates (cdr ex-dates))))
2185 ;; FIXME: exception rules are not recognized
2186 (if (icalendar--get-event-property e 'EXRULE)
2187 (setq result
2188 (concat result
2189 "\n Exception rules: "
2190 (icalendar--get-event-properties
2191 e 'EXRULE))))
2192 result))
2193
2194(defun icalendar--convert-non-recurring-all-day-to-diary (event start-d end-d)
2195 "Convert non-recurring icalendar EVENT to diary format.
2196
2197DTSTART is the decoded DTSTART property of E.
2198Argument START-D gives the first day.
2199Argument END-D gives the last day."
2200 (icalendar--dmsg "non-recurring all-day event")
2201 (format "%%%%(and (diary-block %s %s))" start-d end-d))
2202
2203(defun icalendar--convert-non-recurring-not-all-day-to-diary (event dtstart-dec
2204 dtend-dec
2205 start-t
2206 end-t)
2207 "Convert recurring icalendar EVENT to diary format.
2208
2209DTSTART-DEC is the decoded DTSTART property of E.
2210DTEND-DEC is the decoded DTEND property of E.
2211START-T is the event's start time in diary format.
2212END-T is the event's end time in diary format."
2213 (icalendar--dmsg "not all day event")
2214 (cond (end-t
2215 (format "%s %s-%s"
2216 (icalendar--datetime-to-diary-date
2217 dtstart-dec "/")
2218 start-t end-t))
2219 (t
2220 (format "%s %s"
2221 (icalendar--datetime-to-diary-date
2222 dtstart-dec "/")
2223 start-t))))
2224
e0cd68ee 2225(defun icalendar--add-diary-entry (string diary-file non-marking
d2afe62f 2226 &optional summary)
707c20a8
GM		 2227 "Add STRING to the diary file DIARY-FILE.
2228STRING must be a properly formatted valid diary entry. NON-MARKING
2229determines whether diary events are created as non-marking. If
d2afe62f 2230SUMMARY is not nil it must be a string that gives the summary of the
707c20a8
GM		 2231entry. In this case the user will be asked whether he wants to insert
2232the entry."
d2afe62f 2233 (when (or (not summary)
707c20a8 2234 (y-or-n-p (format "Add appointment for `%s' to diary? "
d2afe62f
GM		 2235 summary)))
2236 (when summary
707c20a8
GM		 2237 (setq non-marking
2238 (y-or-n-p (format "Make appointment non-marking? "))))
2239 (save-window-excursion
2240 (unless diary-file
2241 (setq diary-file
2242 (read-file-name "Add appointment to this diary file: ")))
9ee4e581
GM		 2243 ;; Note: diary-make-entry will add a trailing blank char.... :(
2244 (funcall (if (fboundp 'diary-make-entry)
2245 'diary-make-entry
2246 'make-diary-entry)
2247 string non-marking diary-file)))
6fe539d2 2248 ;; Würgaround to remove the trailing blank char
de3a1fe9 2249 (with-current-buffer (find-file diary-file)
6fe539d2
UJ		 2250 (goto-char (point-max))
2251 (if (= (char-before) ? )
2252 (delete-char -1)))
76b0b55f
GM		 2253 ;; return diary-file in case it has been changed interactively
2254 diary-file)
707c20a8 2255
b3360383
GM		 2256;; ======================================================================
2257;; Examples
2258;; ======================================================================
2259(defun icalendar-import-format-sample (event)
2260 "Example function for formatting an icalendar EVENT."
2261 (format (concat "SUMMARY=`%s' DESCRIPTION=`%s' LOCATION=`%s' ORGANIZER=`%s' "
2262 "STATUS=`%s' URL=`%s' CLASS=`%s'")
2263 (or (icalendar--get-event-property event 'SUMMARY) "")
2264 (or (icalendar--get-event-property event 'DESCRIPTION) "")
2265 (or (icalendar--get-event-property event 'LOCATION) "")
2266 (or (icalendar--get-event-property event 'ORGANIZER) "")
2267 (or (icalendar--get-event-property event 'STATUS) "")
2268 (or (icalendar--get-event-property event 'URL) "")
2269 (or (icalendar--get-event-property event 'CLASS) "")))
2270
707c20a8
GM		 2271(provide 'icalendar)
2272
a13bc064 2273;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc
707c20a8 2274;;; icalendar.el ends here
Unnamed repository; edit this file 'description' to name the repository.