icalendar.el

Revision 4220, 84.5 kB (checked in by miyoshi, 9 months ago)
Sync up with Emacs22.2.

Line
1	;;; icalendar.el --- iCalendar implementation --coding: utf-8 --
2
3	;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
4
5	;; Author: Ulf Jasper <ulf.jasper@web.de>
6	;; Created: August 2002
7	;; Keywords: calendar
8	;; Human-Keywords: calendar, diary, iCalendar, vCalendar
9
10	;; This file is part of GNU Emacs.
11
12	;; GNU Emacs is free software; you can redistribute it and/or modify
13	;; it under the terms of the GNU General Public License as published by
14	;; the Free Software Foundation; either version 3, or (at your option)
15	;; any later version.
16
17	;; GNU Emacs is distributed in the hope that it will be useful,
18	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20	;; GNU General Public License for more details.
21
22	;; You should have received a copy of the GNU General Public License
23	;; along with GNU Emacs; see the file COPYING. If not, write to the
24	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25	;; Boston, MA 02110-1301, USA.
26
27	;;; Commentary:
28
29	;; This package is documented in the Emacs Manual.
30
31	;; Please note:
32	;; - Diary entries which have a start time but no end time are assumed to
33	;; last for one hour when they are exported.
34	;; - Weekly diary entries are assumed to occur the first time in the first
35	;; week of the year 2000 when they are exported.
36	;; - Yearly diary entries are assumed to occur the first time in the year
37	;; 1900 when they are exported.
38
39	;;; History:
40
41	;; 0.07 onwards: see lisp/ChangeLog
42
43	;; 0.06: Bugfixes regarding icalendar-import-format-.*
44	;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp
45	;; Grau.
46
47	;; 0.05: 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: Bugfix: import: double quoted param values did not work
56	;; Read DURATION property when importing.
57	;; Added parameter icalendar-duration-correction.
58
59	;; 0.03: Export takes care of european-calendar-style.
60	;; Tested with Emacs 21.3.2 and XEmacs 21.4.12
61
62	;; 0.02: Should work in XEmacs now. Thanks to Len Trigg for the
63	;; XEmacs patches!
64	;; Added exporting from Emacs diary to ical.
65	;; Some bugfixes, after testing with calendars from
66	;; http://icalshare.com.
67	;; Tested with Emacs 21.3.2 and XEmacs 21.4.12
68
69	;; 0.01: First published version. Trial version. Alpha version.
70
71	;; ======================================================================
72	;; To Do:
73
74	;; Import from ical to diary:*
75	;; + Need more properties for icalendar-import-format
76	;; (added all that Mozilla Calendar uses)
77	;; From iCal specifications (RFC2445: 4.8.1), icalendar.el lacks
78	;; ATTACH, CATEGORIES, COMMENT, GEO, PERCENT-COMPLETE (VTODO),
79	;; PRIORITY, RESOURCES) not considering date/time and time-zone
80	;; + check vcalendar version
81	;; + check (unknown) elements
82	;; + recurring events!
83	;; + works for european style calendars only! Does it?
84	;; + alarm
85	;; + exceptions in recurring events
86	;; + the parser is too soft
87	;; + error log is incomplete
88	;; + nice to have: #include "webcal://foo.com/some-calendar.ics"
89	;; + timezones, currently all times are local!
90
91	;; Export from diary to ical*
92	;; + diary-date, diary-float, and self-made sexp entries are not
93	;; understood
94
95	;; Other things*
96	;; + clean up all those date/time parsing functions
97	;; + Handle todo items?
98	;; + Check iso 8601 for datetime and period
99	;; + Which chars to (un)escape?
100
101
102	;;; Code:
103
104	(defconst icalendar-version "0.15"
105	"Version number of icalendar.el.")
106
107	;; ======================================================================
108	;; Customizables
109	;; ======================================================================
110	(defgroup icalendar nil
111	"Icalendar support."
112	:prefix "icalendar-"
113	:group 'calendar)
114
115	(defcustom icalendar-import-format
116	"%s%d%l%o"
117	"Format string for importing events from iCalendar into Emacs diary.
118	This string defines how iCalendar events are inserted into diary
119	file. Meaning of the specifiers:
120	%c Class, see `icalendar-import-format-class'
121	%d Description, see `icalendar-import-format-description'
122	%l Location, see `icalendar-import-format-location'
123	%o Organizer, see `icalendar-import-format-organizer'
124	%s Summary, see `icalendar-import-format-summary'
125	%t Status, see `icalendar-import-format-status'
126	%u URL, see `icalendar-import-format-url'"
127	:type 'string
128	:group 'icalendar)
129
130	(defcustom icalendar-import-format-summary
131	"%s"
132	"Format string defining how the summary element is formatted.
133	This applies only if the summary is not empty! `%s' is replaced
134	by the summary."
135	:type 'string
136	:group 'icalendar)
137
138	(defcustom icalendar-import-format-description
139	"\n Desc: %s"
140	"Format string defining how the description element is formatted.
141	This applies only if the description is not empty! `%s' is
142	replaced by the description."
143	:type 'string
144	:group 'icalendar)
145
146	(defcustom icalendar-import-format-location
147	"\n Location: %s"
148	"Format string defining how the location element is formatted.
149	This applies only if the location is not empty! `%s' is replaced
150	by the location."
151	:type 'string
152	:group 'icalendar)
153
154	(defcustom icalendar-import-format-organizer
155	"\n Organizer: %s"
156	"Format string defining how the organizer element is formatted.
157	This applies only if the organizer is not empty! `%s' is
158	replaced by the organizer."
159	:type 'string
160	:group 'icalendar)
161
162	(defcustom icalendar-import-format-url
163	"\n URL: %s"
164	"Format string defining how the URL element is formatted.
165	This applies only if the URL is not empty! `%s' is replaced by
166	the URL."
167	:type 'string
168	:group 'icalendar)
169
170	(defcustom icalendar-import-format-status
171	"\n Status: %s"
172	"Format string defining how the status element is formatted.
173	This applies only if the status is not empty! `%s' is replaced by
174	the status."
175	:type 'string
176	:group 'icalendar)
177
178	(defcustom icalendar-import-format-class
179	"\n Class: %s"
180	"Format string defining how the class element is formatted.
181	This applies only if the class is not empty! `%s' is replaced by
182	the class."
183	:type 'string
184	:group 'icalendar)
185
186	(defvar icalendar-debug nil
187	"Enable icalendar debug messages.")
188
189	;; ======================================================================
190	;; NO USER SERVICABLE PARTS BELOW THIS LINE
191	;; ======================================================================
192
193	(defconst icalendar--weekday-array ["SU" "MO" "TU" "WE" "TH" "FR" "SA"])
194
195	;; ======================================================================
196	;; all the other libs we need
197	;; ======================================================================
198	(require 'calendar)
199
200	;; ======================================================================
201	;; misc
202	;; ======================================================================
203	(defun icalendar--dmsg (&rest args)
204	"Print message ARGS if `icalendar-debug' is non-nil."
205	(if icalendar-debug
206	(apply 'message args)))
207
208	;; ======================================================================
209	;; Core functionality
210	;; Functions for parsing icalendars, importing and so on
211	;; ======================================================================
212
213	(defun icalendar--get-unfolded-buffer (folded-ical-buffer)
214	"Return a new buffer containing the unfolded contents of a buffer.
215	Folding is the iCalendar way of wrapping long lines. In the
216	created buffer all occurrences of CR LF BLANK are replaced by the
217	empty string. Argument FOLDED-ICAL-BUFFER is the unfolded input
218	buffer."
219	(let ((unfolded-buffer (get-buffer-create *" icalendar-work"*)))
220	(save-current-buffer
221	(set-buffer unfolded-buffer)
222	(erase-buffer)
223	(insert-buffer-substring folded-ical-buffer)
224	(goto-char (point-min))
225	(while (re-search-forward "\r?\n[ \t]" nil t)
226	(replace-match "" nil nil)))
227	unfolded-buffer))
228
229	(defsubst icalendar--rris (regexp rep string &optional fixedcase literal)
230	"Replace regular expression in string.
231	Pass arguments REGEXP REP STRING FIXEDCASE LITERAL to
232	`replace-regexp-in-string' (Emacs) or to `replace-in-string' (XEmacs)."
233	(cond ((fboundp 'replace-regexp-in-string)
234	;; Emacs:
235	(replace-regexp-in-string regexp rep string fixedcase literal))
236	((fboundp 'replace-in-string)
237	;; XEmacs:
238	(save-match-data ;; apparently XEmacs needs save-match-data
239	(replace-in-string string regexp rep literal)))))
240
241	(defun icalendar--read-element (invalue inparams)
242	"Recursively read the next iCalendar element in the current buffer.
243	INVALUE gives the current iCalendar element we are reading.
244	INPARAMS gives the current parameters.....
245	This function calls itself recursively for each nested calendar element
246	it finds"
247	(let (element children line name params param param-name param-value
248	value
249	(continue t))
250	(setq children '())
251	(while (and continue
252	(re-search-forward "^\$[A-Za-z0-9-]+\$[;:]" nil t))
253	(setq name (intern (match-string 1)))
254	(backward-char 1)
255	(setq params '())
256	(setq line '())
257	(while (looking-at ";")
258	(re-search-forward ";\$[A-Za-z0-9-]+\$=" nil nil)
259	(setq param-name (intern (match-string 1)))
260	(re-search-forward "\$\\([^;,:\"]+\$\\\|\"\$[^\"]+\$\"\\)[;:]"
261	nil t)
262	(backward-char 1)
263	(setq param-value (or (match-string 2) (match-string 3)))
264	(setq param (list param-name param-value))
265	(while (looking-at ",")
266	(re-search-forward "\$\\([^;,:]+\$\\\|\"\$[^\"]+\$\"\\)"
267	nil t)
268	(if (match-string 2)
269	(setq param-value (match-string 2))
270	(setq param-value (match-string 3)))
271	(setq param (append param param-value)))
272	(setq params (append params param)))
273	(unless (looking-at ":")
274	(error "Oops"))
275	(forward-char 1)
276	(re-search-forward *"\$.\$\$\r?\n[ \t].\$"** nil t)
277	(setq value (icalendar--rris "\r?\n[ \t]" "" (match-string 0)))
278	(setq line (list name params value))
279	(cond ((eq name 'BEGIN)
280	(setq children
281	(append children
282	(list (icalendar--read-element (intern value)
283	params)))))
284	((eq name 'END)
285	(setq continue nil))
286	(t
287	(setq element (append element (list line))))))
288	(if invalue
289	(list invalue inparams element children)
290	children)))
291
292	;; ======================================================================
293	;; helper functions for examining events
294	;; ======================================================================
295
296	;;(defsubst icalendar--get-all-event-properties (event)
297	;; "Return the list of properties in this EVENT."
298	;; (car (cddr event)))
299
300	(defun icalendar--get-event-property (event prop)
301	"For the given EVENT return the value of the first occurrence of PROP."
302	(catch 'found
303	(let ((props (car (cddr event))) pp)
304	(while props
305	(setq pp (car props))
306	(if (eq (car pp) prop)
307	(throw 'found (car (cddr pp))))
308	(setq props (cdr props))))
309	nil))
310
311	(defun icalendar--get-event-property-attributes (event prop)
312	"For the given EVENT return attributes of the first occurrence of PROP."
313	(catch 'found
314	(let ((props (car (cddr event))) pp)
315	(while props
316	(setq pp (car props))
317	(if (eq (car pp) prop)
318	(throw 'found (cadr pp)))
319	(setq props (cdr props))))
320	nil))
321
322	(defun icalendar--get-event-properties (event prop)
323	"For the given EVENT return a list of all values of the property PROP."
324	(let ((props (car (cddr event))) pp result)
325	(while props
326	(setq pp (car props))
327	(if (eq (car pp) prop)
328	(setq result (append (split-string (car (cddr pp)) ",") result)))
329	(setq props (cdr props)))
330	result))
331
332	;; (defun icalendar--set-event-property (event prop new-value)
333	;; "For the given EVENT set the property PROP to the value NEW-VALUE."
334	;; (catch 'found
335	;; (let ((props (car (cddr event))) pp)
336	;; (while props
337	;; (setq pp (car props))
338	;; (when (eq (car pp) prop)
339	;; (setcdr (cdr pp) new-value)
340	;; (throw 'found (car (cddr pp))))
341	;; (setq props (cdr props)))
342	;; (setq props (car (cddr event)))
343	;; (setcar (cddr event)
344	;; (append props (list (list prop nil new-value)))))))
345
346	(defun icalendar--get-children (node name)
347	"Return all children of the given NODE which have a name NAME.
348	For instance the VCALENDAR node can have VEVENT children as well as VTODO
349	children."
350	(let ((result nil)
351	(children (cadr (cddr node))))
352	(when (eq (car node) name)
353	(setq result node))
354	;;(message "%s" node)
355	(when children
356	(let ((subresult
357	(delq nil
358	(mapcar (lambda (n)
359	(icalendar--get-children n name))
360	children))))
361	(if subresult
362	(if result
363	(setq result (append result subresult))
364	(setq result subresult)))))
365	result))
366
367	; private
368	(defun icalendar--all-events (icalendar)
369	"Return the list of all existing events in the given ICALENDAR."
370	(icalendar--get-children (car icalendar) 'VEVENT))
371
372	(defun icalendar--split-value (value-string)
373	"Split VALUE-STRING at ';='."
374	(let ((result '())
375	param-name param-value)
376	(when value-string
377	(save-current-buffer
378	(set-buffer (get-buffer-create *" icalendar-work"*))
379	(set-buffer-modified-p nil)
380	(erase-buffer)
381	(insert value-string)
382	(goto-char (point-min))
383	(while
384	(re-search-forward
385	"\$[A-Za-z0-9-]+\$=\$\\([^;,:]+\$\\\|\"\$[^\"]+\$\"\\);?"
386	nil t)
387	(setq param-name (intern (match-string 1)))
388	(setq param-value (match-string 2))
389	(setq result
390	(append result (list (list param-name param-value)))))))
391	result))
392
393	(defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift)
394	"Return ISODATETIMESTRING in format like `decode-time'.
395	Converts from ISO-8601 to Emacs representation. If
396	ISODATETIMESTRING specifies UTC time (trailing letter Z) the
397	decoded time is given in the local time zone! If optional
398	parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
399	days.
400
401	FIXME: TZID-attributes are ignored....!
402	FIXME: multiple comma-separated values should be allowed!"
403	(icalendar--dmsg isodatetimestring)
404	(if isodatetimestring
405	;; day/month/year must be present
406	(let ((year (read (substring isodatetimestring 0 4)))
407	(month (read (substring isodatetimestring 4 6)))
408	(day (read (substring isodatetimestring 6 8)))
409	(hour 0)
410	(minute 0)
411	(second 0))
412	(when (> (length isodatetimestring) 12)
413	;; hour/minute present
414	(setq hour (read (substring isodatetimestring 9 11)))
415	(setq minute (read (substring isodatetimestring 11 13))))
416	(when (> (length isodatetimestring) 14)
417	;; seconds present
418	(setq second (read (substring isodatetimestring 13 15))))
419	(when (and (> (length isodatetimestring) 15)
420	;; UTC specifier present
421	(char-equal ?Z (aref isodatetimestring 15)))
422	;; if not UTC add current-time-zone offset
423	(setq second (+ (car (current-time-zone)) second)))
424	;; shift if necessary
425	(if day-shift
426	(let ((mdy (calendar-gregorian-from-absolute
427	(+ (calendar-absolute-from-gregorian
428	(list month day year))
429	day-shift))))
430	(setq month (nth 0 mdy))
431	(setq day (nth 1 mdy))
432	(setq year (nth 2 mdy))))
433	;; create the decoded date-time
434	;; FIXME!?!
435	(condition-case nil
436	(decode-time (encode-time second minute hour day month year))
437	(error
438	(message "Cannot decode \"%s\"" isodatetimestring)
439	;; hope for the best...
440	(list second minute hour day month year 0 nil 0))))
441	;; isodatetimestring == nil
442	nil))
443
444	(defun icalendar--decode-isoduration (isodurationstring
445	&optional duration-correction)
446	"Convert ISODURATIONSTRING into format provided by `decode-time'.
447	Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING
448	specifies UTC time (trailing letter Z) the decoded time is given in
449	the local time zone!
450
451	Optional argument DURATION-CORRECTION shortens result by one day.
452
453	FIXME: TZID-attributes are ignored....!
454	FIXME: multiple comma-separated values should be allowed!"
455	(if isodurationstring
456	(save-match-data
457	(string-match
458	(concat
459	"^P[+-]?\\("
460	"\$\\([0-9]+\$D\\)" ; days only
461	"\\\|"
462	"\$\\(\\([0-9]+\$D\\)?T\$\\([0-9]+\$H\\)?" ; opt days
463	"\$\\([0-9]+\$M\\)?\$\\([0-9]+\$S\\)?\\)" ; mand. time
464	"\\\|"
465	"\$\\([0-9]+\$W\\)" ; weeks only
466	"\\)$") isodurationstring)
467	(let ((seconds 0)
468	(minutes 0)
469	(hours 0)
470	(days 0)
471	(months 0)
472	(years 0))
473	(cond
474	((match-beginning 2) ;days only
475	(setq days (read (substring isodurationstring
476	(match-beginning 3)
477	(match-end 3))))
478	(when duration-correction
479	(setq days (1- days))))
480	((match-beginning 4) ;days and time
481	(if (match-beginning 5)
482	(setq days (* 7 (read (substring isodurationstring
483	(match-beginning 6)
484	(match-end 6))))))
485	(if (match-beginning 7)
486	(setq hours (read (substring isodurationstring
487	(match-beginning 8)
488	(match-end 8)))))
489	(if (match-beginning 9)
490	(setq minutes (read (substring isodurationstring
491	(match-beginning 10)
492	(match-end 10)))))
493	(if (match-beginning 11)
494	(setq seconds (read (substring isodurationstring
495	(match-beginning 12)
496	(match-end 12))))))
497	((match-beginning 13) ;weeks only
498	(setq days (* 7 (read (substring isodurationstring
499	(match-beginning 14)
500	(match-end 14)))))))
501	(list seconds minutes hours days months years)))
502	;; isodatetimestring == nil
503	nil))
504
505	(defun icalendar--add-decoded-times (time1 time2)
506	"Add TIME1 to TIME2.
507	Both times must be given in decoded form. One of these times must be
508	valid (year > 1900 or something)."
509	;; FIXME: does this function exist already?
510	(decode-time (encode-time
511	(+ (nth 0 time1) (nth 0 time2))
512	(+ (nth 1 time1) (nth 1 time2))
513	(+ (nth 2 time1) (nth 2 time2))
514	(+ (nth 3 time1) (nth 3 time2))
515	(+ (nth 4 time1) (nth 4 time2))
516	(+ (nth 5 time1) (nth 5 time2))
517	nil
518	nil
519	;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
520	)))
521
522	(defun icalendar--datetime-to-noneuropean-date (datetime &optional separator)
523	"Convert the decoded DATETIME to non-european-style format.
524	Optional argument SEPARATOR gives the separator between month,
525	day, and year. If nil a blank character is used as separator.
526	Non-European format: \"month day year\"."
527	(if datetime
528	(format "%d%s%d%s%d" (nth 4 datetime) ;month
529	(or separator " ")
530	(nth 3 datetime) ;day
531	(or separator " ")
532	(nth 5 datetime)) ;year
533	;; datetime == nil
534	nil))
535
536	(defun icalendar--datetime-to-european-date (datetime &optional separator)
537	"Convert the decoded DATETIME to European format.
538	Optional argument SEPARATOR gives the separator between month,
539	day, and year. If nil a blank character is used as separator.
540	European format: (day month year).
541	FIXME"
542	(if datetime
543	(format "%d%s%d%s%d" (nth 3 datetime) ;day
544	(or separator " ")
545	(nth 4 datetime) ;month
546	(or separator " ")
547	(nth 5 datetime)) ;year
548	;; datetime == nil
549	nil))
550
551	(defun icalendar--datetime-to-diary-date (datetime &optional separator)
552	"Convert the decoded DATETIME to diary format.
553	Optional argument SEPARATOR gives the separator between month,
554	day, and year. If nil a blank character is used as separator.
555	Call icalendar--datetime-to-(non)-european-date according to
556	value of `european-calendar-style'."
557	(if european-calendar-style
558	(icalendar--datetime-to-european-date datetime separator)
559	(icalendar--datetime-to-noneuropean-date datetime separator)))
560
561	(defun icalendar--datetime-to-colontime (datetime)
562	"Extract the time part of a decoded DATETIME into 24-hour format.
563	Note that this silently ignores seconds."
564	(format "%02d:%02d" (nth 2 datetime) (nth 1 datetime)))
565
566	(defun icalendar--get-month-number (monthname)
567	"Return the month number for the given MONTHNAME."
568	(catch 'found
569	(let ((num 1)
570	(m (downcase monthname)))
571	(mapc (lambda (month)
572	(let ((mm (downcase month)))
573	(if (or (string-equal mm m)
574	(string-equal (substring mm 0 3) m))
575	(throw 'found num))
576	(setq num (1+ num))))
577	calendar-month-name-array))
578	;; Error:
579	-1))
580
581	(defun icalendar--get-weekday-number (abbrevweekday)
582	"Return the number for the ABBREVWEEKDAY."
583	(if abbrevweekday
584	(catch 'found
585	(let ((num 0)
586	(aw (downcase abbrevweekday)))
587	(mapc (lambda (day)
588	(let ((d (downcase day)))
589	(if (string-equal d aw)
590	(throw 'found num))
591	(setq num (1+ num))))
592	icalendar--weekday-array)))
593	;; Error:
594	-1))
595
596	(defun icalendar--get-weekday-abbrev (weekday)
597	"Return the abbreviated WEEKDAY."
598	(catch 'found
599	(let ((num 0)
600	(w (downcase weekday)))
601	(mapc (lambda (day)
602	(let ((d (downcase day)))
603	(if (or (string-equal d w)
604	(string-equal (substring d 0 3) w))
605	(throw 'found (aref icalendar--weekday-array num)))
606	(setq num (1+ num))))
607	calendar-day-name-array))
608	;; Error:
609	nil))
610
611	(defun icalendar--date-to-isodate (date &optional day-shift)
612	"Convert DATE to iso-style date.
613	DATE must be a list of the form (month day year).
614	If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
615	(let ((mdy (calendar-gregorian-from-absolute
616	(+ (calendar-absolute-from-gregorian date)
617	(or day-shift 0)))))
618	(format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
619
620
621	(defun icalendar--datestring-to-isodate (datestring &optional day-shift)
622	"Convert diary-style DATESTRING to iso-style date.
623	If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
624	-- DAY-SHIFT must be either nil or an integer. This function
625	takes care of european-style."
626	(let ((day -1) month year)
627	(save-match-data
628	(cond ( ;; numeric date
629	(string-match (concat *"\\s-"**
630	*"0?\$[1-9][0-9]?\$[ \t/]\\s-"**
631	*"0?\$[1-9][0-9]?\$,?[ \t/]\\s-"**
632	"\$[0-9]\\{4\\}\$")
633	datestring)
634	(setq day (read (substring datestring (match-beginning 1)
635	(match-end 1))))
636	(setq month (read (substring datestring (match-beginning 2)
637	(match-end 2))))
638	(setq year (read (substring datestring (match-beginning 3)
639	(match-end 3))))
640	(unless european-calendar-style
641	(let ((x month))
642	(setq month day)
643	(setq day x))))
644	( ;; date contains month names -- european-style
645	(string-match (concat *"\\s-"**
646	*"0?\$[123]?[0-9]\$[ \t/]\\s-"**
647	*"\$[A-Za-z][^ ]+\$[ \t/]\\s-"**
648	"\$[0-9]\\{4\\}\$")
649	datestring)
650	(setq day (read (substring datestring (match-beginning 1)
651	(match-end 1))))
652	(setq month (icalendar--get-month-number
653	(substring datestring (match-beginning 2)
654	(match-end 2))))
655	(setq year (read (substring datestring (match-beginning 3)
656	(match-end 3)))))
657	( ;; date contains month names -- non-european-style
658	(string-match (concat *"\\s-"**
659	*"\$[A-Za-z][^ ]+\$[ \t/]\\s-"**
660	*"0?\$[123]?[0-9]\$,?[ \t/]\\s-"**
661	"\$[0-9]\\{4\\}\$")
662	datestring)
663	(setq day (read (substring datestring (match-beginning 2)
664	(match-end 2))))
665	(setq month (icalendar--get-month-number
666	(substring datestring (match-beginning 1)
667	(match-end 1))))
668	(setq year (read (substring datestring (match-beginning 3)
669	(match-end 3)))))
670	(t
671	nil)))
672	(if (> day 0)
673	(let ((mdy (calendar-gregorian-from-absolute
674	(+ (calendar-absolute-from-gregorian (list month day
675	year))
676	(or day-shift 0)))))
677	(format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))
678	nil)))
679
680	(defun icalendar--diarytime-to-isotime (timestring ampmstring)
681	"Convert a time like 9:30pm to an iso-conform string like T213000.
682	In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING
683	would be \"pm\"."
684	(if timestring
685	(let ((starttimenum (read (icalendar--rris ":" "" timestring))))
686	;; take care of am/pm style
687	(if (and ampmstring (string= "pm" ampmstring))
688	(setq starttimenum (+ starttimenum 1200)))
689	(format "T%04d00" starttimenum))
690	nil))
691
692	(defun icalendar--convert-string-for-export (string)
693	"Escape comma and other critical characters in STRING."
694	(icalendar--rris "," "\\\\," string))
695
696	(defun icalendar--convert-string-for-import (string)
697	"Remove escape chars for comma, semicolon etc. from STRING."
698	(icalendar--rris
699	"\\\\n" "\n " (icalendar--rris
700	"\\\\\"" "\"" (icalendar--rris
701	"\\\\;" ";" (icalendar--rris
702	"\\\\," "," string)))))
703
704	;; ======================================================================
705	;; Export -- convert emacs-diary to icalendar
706	;; ======================================================================
707
708	;;;###autoload
709	(defun icalendar-export-file (diary-filename ical-filename)
710	"Export diary file to iCalendar format.
711	All diary entries in the file DIARY-FILENAME are converted to iCalendar
712	format. The result is appended to the file ICAL-FILENAME."
713	(interactive "FExport diary data from file:
714	Finto iCalendar file: ")
715	(save-current-buffer
716	(set-buffer (find-file diary-filename))
717	(icalendar-export-region (point-min) (point-max) ical-filename)))
718
719	(defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file)
720	(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file)
721
722	;;;###autoload
723	(defun icalendar-export-region (min max ical-filename)
724	"Export region in diary file to iCalendar format.
725	All diary entries in the region from MIN to MAX in the current buffer are
726	converted to iCalendar format. The result is appended to the file
727	ICAL-FILENAME.
728	This function attempts to return t if something goes wrong. In this
729	case an error string which describes all the errors and problems is
730	*written into the buffer `icalendar-errors'."*
731	(interactive "r
732	FExport diary data into iCalendar file: ")
733	(let ((result "")
734	(start 0)
735	(entry-main "")
736	(entry-rest "")
737	(header "")
738	(contents-n-summary)
739	(contents)
740	(found-error nil)
741	(nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
742	"?"))
743	(other-elements nil))
744	;; prepare buffer with error messages
745	(save-current-buffer
746	(set-buffer (get-buffer-create *"icalendar-errors"*))
747	(erase-buffer))
748
749	;; here we go
750	(save-excursion
751	(goto-char min)
752	(while (re-search-forward
753	*"^\$[^ \t\n].+\$\$\\(\n[ \t].\$\\)"* max t)
754	(setq entry-main (match-string 1))
755	(if (match-beginning 2)
756	(setq entry-rest (match-string 2))
757	(setq entry-rest ""))
758	(setq header (format "\nBEGIN:VEVENT\nUID:emacs%d%d%d"
759	(car (current-time))
760	(cadr (current-time))
761	(car (cddr (current-time)))))
762	(condition-case error-val
763	(progn
764	(setq contents-n-summary
765	(icalendar--convert-to-ical nonmarker entry-main))
766	(setq other-elements (icalendar--parse-summary-and-rest
767	(concat entry-main entry-rest)))
768	(setq contents (concat (car contents-n-summary)
769	"\nSUMMARY:" (cadr contents-n-summary)))
770	(let ((cla (cdr (assoc 'cla other-elements)))
771	(des (cdr (assoc 'des other-elements)))
772	(loc (cdr (assoc 'loc other-elements)))
773	(org (cdr (assoc 'org other-elements)))
774	(sta (cdr (assoc 'sta other-elements)))
775	(sum (cdr (assoc 'sum other-elements)))
776	(url (cdr (assoc 'url other-elements))))
777	(if cla
778	(setq contents (concat contents "\nCLASS:" cla)))
779	(if des
780	(setq contents (concat contents "\nDESCRIPTION:" des)))
781	(if loc
782