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