X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/86fc29f9260012dcf77d9ef2562f1a12a049345c..94ce023059fcc9856a3914a70ea462e385551bed:/lisp/calendar/icalendar.el diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 320a6aa0f7..570fb62674 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -1,6 +1,6 @@ ;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*- -;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Ulf Jasper ;; Created: August 2002 @@ -21,13 +21,20 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This package is documented in the Emacs Manual. +;; Please note: +;; - Diary entries which have a start time but no end time are assumed to +;; last for one hour when they are exported. +;; - Weekly diary entries are assumed to occur the first time in the first +;; week of the year 2000 when they are exported. +;; - Yearly diary entries are assumed to occur the first time in the year +;; 1900 when they are exported. ;;; History: @@ -75,11 +82,11 @@ ;; + the parser is too soft ;; + error log is incomplete ;; + nice to have: #include "webcal://foo.com/some-calendar.ics" +;; + timezones, currently all times are local! ;; * Export from diary to ical ;; + diary-date, diary-float, and self-made sexp entries are not ;; understood -;; + timezones, currently all times are local! ;; * Other things ;; + clean up all those date/time parsing functions @@ -90,7 +97,7 @@ ;;; Code: -(defconst icalendar-version 0.11 +(defconst icalendar-version "0.13" "Version number of icalendar.el.") ;; ====================================================================== @@ -106,18 +113,21 @@ "Format string for importing events from iCalendar into Emacs diary. This string defines how iCalendar events are inserted into diary file. Meaning of the specifiers: +%c Class, see `icalendar-import-format-class' %d Description, see `icalendar-import-format-description' %l Location, see `icalendar-import-format-location' %o Organizer, see `icalendar-import-format-organizer' -%s Subject, see `icalendar-import-format-subject'" +%s Summary, see `icalendar-import-format-summary' +%t Status, see `icalendar-import-format-status' +%u URL, see `icalendar-import-format-url'" :type 'string :group 'icalendar) -(defcustom icalendar-import-format-subject +(defcustom icalendar-import-format-summary "%s" - "Format string defining how the subject element is formatted. -This applies only if the subject is not empty! `%s' is replaced -by the subject." + "Format string defining how the summary element is formatted. +This applies only if the summary is not empty! `%s' is replaced +by the summary." :type 'string :group 'icalendar) @@ -145,16 +155,32 @@ replaced by the organizer." :type 'string :group 'icalendar) -(defcustom icalendar-duration-correction - t - "Workaround for all-day events. -If non-nil the length=duration of iCalendar appointments that -have a length of exactly n days is decreased by one day. This -fixes problems with all-day events, which appear to be one day -longer than they are." - :type 'boolean +(defcustom icalendar-import-format-url + "\n URL: %s" + "Format string defining how the URL element is formatted. +This applies only if the URL is not empty! `%s' is replaced by +the URL." + :type 'string + :group 'icalendar) + +(defcustom icalendar-import-format-status + "\n Status: %s" + "Format string defining how the status element is formatted. +This applies only if the status is not empty! `%s' is replaced by +the status." + :type 'string + :group 'icalendar) + +(defcustom icalendar-import-format-class + "\n Class: %s" + "Format string defining how the class element is formatted. +This applies only if the class is not empty! `%s' is replaced by +the class." + :type 'string :group 'icalendar) +(defvar icalendar-debug nil + "Enable icalendar debug messages.") ;; ====================================================================== ;; NO USER SERVICABLE PARTS BELOW THIS LINE @@ -162,13 +188,10 @@ longer than they are." (defconst icalendar--weekday-array ["SU" "MO" "TU" "WE" "TH" "FR" "SA"]) -(defvar icalendar-debug nil ".") - ;; ====================================================================== ;; all the other libs we need ;; ====================================================================== (require 'calendar) -(require 'appt) ;; ====================================================================== ;; misc @@ -193,20 +216,22 @@ buffer." (save-current-buffer (set-buffer unfolded-buffer) (erase-buffer) - (insert-buffer folded-ical-buffer) + (insert-buffer-substring folded-ical-buffer) + (goto-char (point-min)) (while (re-search-forward "\r?\n[ \t]" nil t) (replace-match "" nil nil))) unfolded-buffer)) -(defsubst icalendar--rris (re rp st) - "Replace regexp RE with RP in string ST and return the new string. -This is here for compatibility with XEmacs." +(defsubst icalendar--rris (&rest args) + "Replace regular expression in string. +Pass ARGS to `replace-regexp-in-string' (Emacs) or to +`replace-in-string' (XEmacs)." ;; XEmacs: (if (fboundp 'replace-in-string) (save-match-data ;; apparently XEmacs needs save-match-data - (replace-in-string st re rp)) + (apply 'replace-in-string args)) ;; Emacs: - (replace-regexp-in-string re rp st))) + (apply 'replace-regexp-in-string args))) (defun icalendar--read-element (invalue inparams) "Recursively read the next iCalendar element in the current buffer. @@ -268,7 +293,7 @@ it finds" ;; (car (cddr event))) (defun icalendar--get-event-property (event prop) - "For the given EVENT return the value of the first occurence of PROP." + "For the given EVENT return the value of the first occurrence of PROP." (catch 'found (let ((props (car (cddr event))) pp) (while props @@ -279,7 +304,7 @@ it finds" nil)) (defun icalendar--get-event-property-attributes (event prop) - "For the given EVENT return attributes of the first occurence of PROP." + "For the given EVENT return attributes of the first occurrence of PROP." (catch 'found (let ((props (car (cddr event))) pp) (while props @@ -295,7 +320,7 @@ it finds" (while props (setq pp (car props)) (if (eq (car pp) prop) - (setq result (cons (car (cddr pp)) result))) + (setq result (append (split-string (car (cddr pp)) ",") result))) (setq props (cdr props))) result)) @@ -411,12 +436,15 @@ FIXME: multiple comma-separated values should be allowed!" ;; isodatetimestring == nil nil)) -(defun icalendar--decode-isoduration (isodurationstring) - "Return ISODURATIONSTRING in format like `decode-time'. +(defun icalendar--decode-isoduration (isodurationstring + &optional duration-correction) + "Convert ISODURATIONSTRING into format provided by `decode-time'. Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING specifies UTC time (trailing letter Z) the decoded time is given in the local time zone! +Optional argument DURATION-CORRECTION shortens result by one day. + FIXME: TZID-attributes are ignored....! FIXME: multiple comma-separated values should be allowed!" (if isodurationstring @@ -442,7 +470,7 @@ FIXME: multiple comma-separated values should be allowed!" (setq days (read (substring isodurationstring (match-beginning 3) (match-end 3)))) - (when icalendar-duration-correction + (when duration-correction (setq days (1- days)))) ((match-beginning 4) ;days and time (if (match-beginning 5) @@ -609,12 +637,11 @@ takes care of european-style." (setq month day) (setq day x)))) ( ;; date contains month names -- european-style - (and european-calendar-style - (string-match (concat "\\s-*" - "0?\\([123]?[0-9]\\)[ \t/]\\s-*" - "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" - "\\([0-9]\\{4\\}\\)") - datestring)) + (string-match (concat "\\s-*" + "0?\\([123]?[0-9]\\)[ \t/]\\s-*" + "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" + "\\([0-9]\\{4\\}\\)") + datestring) (setq day (read (substring datestring (match-beginning 1) (match-end 1)))) (setq month (icalendar--get-month-number @@ -623,12 +650,11 @@ takes care of european-style." (setq year (read (substring datestring (match-beginning 3) (match-end 3))))) ( ;; date contains month names -- non-european-style - (and (not european-calendar-style) - (string-match (concat "\\s-*" - "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" - "0?\\([123]?[0-9]\\),?[ \t/]\\s-*" - "\\([0-9]\\{4\\}\\)") - datestring)) + (string-match (concat "\\s-*" + "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" + "0?\\([123]?[0-9]\\),?[ \t/]\\s-*" + "\\([0-9]\\{4\\}\\)") + datestring) (setq day (read (substring datestring (match-beginning 2) (match-end 2)))) (setq month (icalendar--get-month-number @@ -704,20 +730,22 @@ FExport diary data into iCalendar file: ") (entry-main "") (entry-rest "") (header "") + (contents-n-summary) (contents) (found-error nil) (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol) - "?"))) + "?")) + (other-elements nil)) ;; prepare buffer with error messages (save-current-buffer - (set-buffer (get-buffer-create " *icalendar-errors*")) + (set-buffer (get-buffer-create "*icalendar-errors*")) (erase-buffer)) ;; here we go (save-excursion (goto-char min) (while (re-search-forward - "^\\([^ \t\n].*\\)\\(\\(\n[ \t].*\\)*\\)" max t) + "^\\([^ \t\n].+\\)\\(\\(\n[ \t].*\\)*\\)" max t) (setq entry-main (match-string 1)) (if (match-beginning 2) (setq entry-rest (match-string 2)) @@ -728,369 +756,39 @@ FExport diary data into iCalendar file: ") (car (cddr (current-time))))) (condition-case error-val (progn - (cond - ;; anniversaries - ((string-match - (concat nonmarker - "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-anniversary %s" entry-main) - (let* ((datetime (substring entry-main (match-beginning 1) - (match-end 1))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 2) - (match-end 2)))) - (startisostring (icalendar--datestring-to-isodate - datetime)) - (endisostring (icalendar--datestring-to-isodate - datetime 1))) - (setq contents - (concat "\nDTSTART;VALUE=DATE:" startisostring - "\nDTEND;VALUE=DATE:" endisostring - "\nSUMMARY:" summary - "\nRRULE:FREQ=YEARLY;INTERVAL=1" - ;; the following is redundant, - ;; but korganizer seems to expect this... ;( - ;; and evolution doesn't understand it... :( - ;; so... who is wrong?! - ";BYMONTH=" - (substring startisostring 4 6) - ";BYMONTHDAY=" - (substring startisostring 6 8)))) - (unless (string= entry-rest "") - (setq contents - (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest))))) - ;; cyclic events - ;; %%(diary-cyclic ) - ((string-match - (concat nonmarker - "%%(diary-cyclic \\([^ ]+\\) +" - "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-cyclic %s" entry-main) - (let* ((frequency (substring entry-main (match-beginning 1) - (match-end 1))) - (datetime (substring entry-main (match-beginning 2) - (match-end 2))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 3) - (match-end 3)))) - (startisostring (icalendar--datestring-to-isodate - datetime)) - (endisostring (icalendar--datestring-to-isodate - datetime 1))) - (setq contents - (concat "\nDTSTART;VALUE=DATE:" startisostring - "\nDTEND;VALUE=DATE:" endisostring - "\nSUMMARY:" summary - "\nRRULE:FREQ=DAILY;INTERVAL=" frequency - ;; strange: korganizer does not expect - ;; BYSOMETHING here... - ))) - (unless (string= entry-rest "") - (setq contents - (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest))))) - ;; diary-date -- FIXME - ((string-match - (concat nonmarker - "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-date %s" entry-main) - (error "`diary-date' is not supported yet")) - ;; float events -- FIXME - ((string-match - (concat nonmarker - "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-float %s" entry-main) - (error "`diary-float' is not supported yet")) - ;; block events - ((string-match - (concat nonmarker - "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)" - " +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*" - "\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-block %s" entry-main) - (let* ((startstring (substring entry-main - (match-beginning 1) - (match-end 1))) - (endstring (substring entry-main - (match-beginning 2) - (match-end 2))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 3) - (match-end 3)))) - (startisostring (icalendar--datestring-to-isodate - startstring)) - (endisostring (icalendar--datestring-to-isodate - endstring 1))) - (setq contents - (concat "\nDTSTART;VALUE=DATE:" startisostring - "\nDTEND;VALUE=DATE:" endisostring - "\nSUMMARY:" summary)) - (unless (string= entry-rest "") - (setq contents - (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest)))))) - ;; other sexp diary entries -- FIXME - ((string-match - (concat nonmarker - "%%(\\([^)]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-sexp %s" entry-main) - (error "sexp-entries are not supported yet")) - ;; weekly by day - ;; Monday 8:30 Team meeting - ((and (string-match - (concat nonmarker - "\\([a-z]+\\)\\s-+" - "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)" - "\\([ap]m\\)?" - "\\(-0?" - "\\([1-9][0-9]?:[0-9][0-9]\\)" - "\\([ap]m\\)?\\)?" - "\\)?" - "\\s-*\\(.*\\)$") - entry-main) - (icalendar--get-weekday-abbrev - (substring entry-main (match-beginning 1) - (match-end 1)))) - (icalendar--dmsg "weekly %s" entry-main) - (let* ((day (icalendar--get-weekday-abbrev - (substring entry-main (match-beginning 1) - (match-end 1)))) - (starttimestring (icalendar--diarytime-to-isotime - (if (match-beginning 3) - (substring entry-main - (match-beginning 3) - (match-end 3)) - nil) - (if (match-beginning 4) - (substring entry-main - (match-beginning 4) - (match-end 4)) - nil))) - (endtimestring (icalendar--diarytime-to-isotime - (if (match-beginning 6) - (substring entry-main - (match-beginning 6) - (match-end 6)) - nil) - (if (match-beginning 7) - (substring entry-main - (match-beginning 7) - (match-end 7)) - nil))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 8) - (match-end 8))))) - (when starttimestring - (unless endtimestring - (let ((time (read - (icalendar--rris "^T0?" "" - starttimestring)))) - (setq endtimestring (format "T%06d" - (+ 10000 time)))))) - (setq contents - (concat "\nDTSTART;" - (if starttimestring - "VALUE=DATE-TIME:" - "VALUE=DATE:") - ;; find the correct week day, - ;; 1st january 2000 was a saturday - (format - "200001%02d" - (+ (icalendar--get-weekday-number day) 2)) - (or starttimestring "") - "\nDTEND;" - (if endtimestring - "VALUE=DATE-TIME:" - "VALUE=DATE:") - (format - "200001%02d" - ;; end is non-inclusive! - (+ (icalendar--get-weekday-number day) - (if endtimestring 2 3))) - (or endtimestring "") - "\nSUMMARY:" summary - "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" - day))) - (unless (string= entry-rest "") - (setq contents - (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest))))) - ;; yearly by day - ;; 1 May Tag der Arbeit - ((string-match - (concat nonmarker - (if european-calendar-style - "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+" - "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+") - "\\*?\\s-*" - "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" - "\\(" - "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" - "\\)?" - "\\s-*\\([^0-9]+.*\\)$" ; must not match years - ) - entry-main) - (icalendar--dmsg "yearly %s" entry-main) - (let* ((daypos (if european-calendar-style 1 2)) - (monpos (if european-calendar-style 2 1)) - (day (read (substring entry-main - (match-beginning daypos) - (match-end daypos)))) - (month (icalendar--get-month-number - (substring entry-main - (match-beginning monpos) - (match-end monpos)))) - (starttimestring (icalendar--diarytime-to-isotime - (if (match-beginning 4) - (substring entry-main - (match-beginning 4) - (match-end 4)) - nil) - (if (match-beginning 5) - (substring entry-main - (match-beginning 5) - (match-end 5)) - nil))) - (endtimestring (icalendar--diarytime-to-isotime - (if (match-beginning 7) - (substring entry-main - (match-beginning 7) - (match-end 7)) - nil) - (if (match-beginning 8) - (substring entry-main - (match-beginning 8) - (match-end 8)) - nil))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 9) - (match-end 9))))) - (when starttimestring - (unless endtimestring - (let ((time (read - (icalendar--rris "^T0?" "" - starttimestring)))) - (setq endtimestring (format "T%06d" - (+ 10000 time)))))) - (setq contents - (concat "\nDTSTART;" - (if starttimestring "VALUE=DATE-TIME:" - "VALUE=DATE:") - (format "1900%02d%02d" month day) - (or starttimestring "") - "\nDTEND;" - (if endtimestring "VALUE=DATE-TIME:" - "VALUE=DATE:") - ;; end is not included! shift by one day - (icalendar--date-to-isodate - (list month day 1900) - (if endtimestring 0 1)) - (or endtimestring "") - "\nSUMMARY:" - summary - "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=" - (format "%2d" month) - ";BYMONTHDAY=" - (format "%2d" day)))) - (unless (string= entry-rest "") - (setq contents - (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest))))) - ;; "ordinary" events, start and end time given - ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich - ((string-match - (concat nonmarker - "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+" - "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" - "\\(" - "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" - "\\)?" - "\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "ordinary %s" entry-main) - (let* ((startdatestring (icalendar--datestring-to-isodate - (substring entry-main - (match-beginning 1) - (match-end 1)))) - (starttimestring (icalendar--diarytime-to-isotime - (if (match-beginning 3) - (substring entry-main - (match-beginning 3) - (match-end 3)) - nil) - (if (match-beginning 4) - (substring entry-main - (match-beginning 4) - (match-end 4)) - nil))) - (endtimestring (icalendar--diarytime-to-isotime - (if (match-beginning 6) - (substring entry-main - (match-beginning 6) - (match-end 6)) - nil) - (if (match-beginning 7) - (substring entry-main - (match-beginning 7) - (match-end 7)) - nil))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 8) - (match-end 8))))) - (unless startdatestring - (error "Could not parse date")) - (when starttimestring - (unless endtimestring - (let ((time - (read (icalendar--rris "^T0?" "" - starttimestring)))) - (setq endtimestring (format "T%06d" - (+ 10000 time)))))) - (setq contents (concat - "\nDTSTART;" - (if starttimestring "VALUE=DATE-TIME:" - "VALUE=DATE:") - startdatestring - (or starttimestring "") - "\nDTEND;" - (if endtimestring "VALUE=DATE-TIME:" - "VALUE=DATE:") - (icalendar--datestring-to-isodate - (substring entry-main - (match-beginning 1) - (match-end 1)) - (if endtimestring 0 1)) - (or endtimestring "") - "\nSUMMARY:" - summary)) - ;; could not parse the date - (unless (string= entry-rest "") - (setq contents - (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest)))))) - ;; everything else - (t - ;; Oops! what's that? - (error "Could not parse entry"))) + (setq contents-n-summary + (icalendar--convert-to-ical nonmarker entry-main)) + (setq other-elements (icalendar--parse-summary-and-rest + (concat entry-main entry-rest))) + (setq contents (concat (car contents-n-summary) + "\nSUMMARY:" (cadr contents-n-summary))) + (let ((cla (cdr (assoc 'cla other-elements))) + (des (cdr (assoc 'des other-elements))) + (loc (cdr (assoc 'loc other-elements))) + (org (cdr (assoc 'org other-elements))) + (sta (cdr (assoc 'sta other-elements))) + (sum (cdr (assoc 'sum other-elements))) + (url (cdr (assoc 'url other-elements)))) + (if cla + (setq contents (concat contents "\nCLASS:" cla))) + (if des + (setq contents (concat contents "\nDESCRIPTION:" des))) + (if loc + (setq contents (concat contents "\nLOCATION:" loc))) + (if org + (setq contents (concat contents "\nORGANIZER:" org))) + (if sta + (setq contents (concat contents "\nSTATUS:" sta))) + ;;(if sum + ;; (setq contents (concat contents "\nSUMMARY:" sum))) + (if url + (setq contents (concat contents "\nURL:" url)))) (setq result (concat result header contents "\nEND:VEVENT"))) ;; handle errors (error (setq found-error t) (save-current-buffer - (set-buffer (get-buffer-create " *icalendar-errors*")) + (set-buffer (get-buffer-create "*icalendar-errors*")) (insert (format "Error in line %d -- %s: `%s'\n" (count-lines (point-min) (point)) (cadr error-val) @@ -1107,9 +805,638 @@ FExport diary data into iCalendar file: ") (insert result) (insert "\nEND:VCALENDAR\n") ;; save the diary file - (save-buffer)))) + (save-buffer) + (unless found-error + (bury-buffer))))) found-error)) +(defun icalendar--convert-to-ical (nonmarker entry-main) + "Convert a diary entry to icalendar format. +NONMARKER is a regular expression matching the start of non-marking +entries. ENTRY-MAIN is the first line of the diary entry." + (or + ;; anniversaries -- %%(diary-anniversary ...) + (icalendar--convert-anniversary-to-ical nonmarker entry-main) + ;; cyclic events -- %%(diary-cyclic ...) + (icalendar--convert-cyclic-to-ical nonmarker entry-main) + ;; diary-date -- %%(diary-date ...) + (icalendar--convert-date-to-ical nonmarker entry-main) + ;; float events -- %%(diary-float ...) + (icalendar--convert-float-to-ical nonmarker entry-main) + ;; block events -- %%(diary-block ...) + (icalendar--convert-block-to-ical nonmarker entry-main) + ;; other sexp diary entries + (icalendar--convert-sexp-to-ical nonmarker entry-main) + ;; weekly by day -- Monday 8:30 Team meeting + (icalendar--convert-weekly-to-ical nonmarker entry-main) + ;; yearly by day -- 1 May Tag der Arbeit + (icalendar--convert-yearly-to-ical nonmarker entry-main) + ;; "ordinary" events, start and end time given + ;; 1 Feb 2003 blah + (icalendar--convert-ordinary-to-ical nonmarker entry-main) + ;; everything else + ;; Oops! what's that? + (error "Could not parse entry"))) + +(defun icalendar--parse-summary-and-rest (summary-and-rest) + "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties." + (save-match-data + (let* ((s icalendar-import-format) + (p-cla (or (string-match "%c" icalendar-import-format) -1)) + (p-des (or (string-match "%d" icalendar-import-format) -1)) + (p-loc (or (string-match "%l" icalendar-import-format) -1)) + (p-org (or (string-match "%o" icalendar-import-format) -1)) + (p-sum (or (string-match "%s" icalendar-import-format) -1)) + (p-sta (or (string-match "%t" icalendar-import-format) -1)) + (p-url (or (string-match "%u" icalendar-import-format) -1)) + (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<)) + pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url) + (dotimes (i (length p-list)) + (cond ((and (>= p-cla 0) (= (nth i p-list) p-cla)) + (setq pos-cla (+ 2 (* 2 i)))) + ((and (>= p-des 0) (= (nth i p-list) p-des)) + (setq pos-des (+ 2 (* 2 i)))) + ((and (>= p-loc 0) (= (nth i p-list) p-loc)) + (setq pos-loc (+ 2 (* 2 i)))) + ((and (>= p-org 0) (= (nth i p-list) p-org)) + (setq pos-org (+ 2 (* 2 i)))) + ((and (>= p-sta 0) (= (nth i p-list) p-sta)) + (setq pos-sta (+ 2 (* 2 i)))) + ((and (>= p-sum 0) (= (nth i p-list) p-sum)) + (setq pos-sum (+ 2 (* 2 i)))) + ((and (>= p-url 0) (= (nth i p-list) p-url)) + (setq pos-url (+ 2 (* 2 i)))))) + (mapc (lambda (ij) + (setq s (icalendar--rris (car ij) (cadr ij) s t t))) + (list + ;; summary must be first! because of %s + (list "%s" + (concat "\\(" icalendar-import-format-summary "\\)?")) + (list "%c" + (concat "\\(" icalendar-import-format-class "\\)?")) + (list "%d" + (concat "\\(" icalendar-import-format-description "\\)?")) + (list "%l" + (concat "\\(" icalendar-import-format-location "\\)?")) + (list "%o" + (concat "\\(" icalendar-import-format-organizer "\\)?")) + (list "%t" + (concat "\\(" icalendar-import-format-status "\\)?")) + (list "%u" + (concat "\\(" icalendar-import-format-url "\\)?")))) + (setq s (concat (icalendar--rris "%s" "\\(.*\\)" s nil t) " ")) + (if (string-match s summary-and-rest) + (let (cla des loc org sta sum url) + (if (and pos-sum (match-beginning pos-sum)) + (setq sum (substring summary-and-rest + (match-beginning pos-sum) + (match-end pos-sum)))) + (if (and pos-cla (match-beginning pos-cla)) + (setq cla (substring summary-and-rest + (match-beginning pos-cla) + (match-end pos-cla)))) + (if (and pos-des (match-beginning pos-des)) + (setq des (substring summary-and-rest + (match-beginning pos-des) + (match-end pos-des)))) + (if (and pos-loc (match-beginning pos-loc)) + (setq loc (substring summary-and-rest + (match-beginning pos-loc) + (match-end pos-loc)))) + (if (and pos-org (match-beginning pos-org)) + (setq org (substring summary-and-rest + (match-beginning pos-org) + (match-end pos-org)))) + (if (and pos-sta (match-beginning pos-sta)) + (setq sta (substring summary-and-rest + (match-beginning pos-sta) + (match-end pos-sta)))) + (if (and pos-url (match-beginning pos-url)) + (setq url (substring summary-and-rest + (match-beginning pos-url) + (match-end pos-url)))) + (list (if cla (cons 'cla cla) nil) + (if des (cons 'des des) nil) + (if loc (cons 'loc loc) nil) + (if org (cons 'org org) nil) + (if sta (cons 'sta sta) nil) + ;;(if sum (cons 'sum sum) nil) + (if url (cons 'url url) nil))))))) + +;; subroutines for icalendar-export-region +(defun icalendar--convert-ordinary-to-ical (nonmarker entry-main) + "Convert \"ordinary\" diary entry to icalendar format. +NONMARKER is a regular expression matching the start of non-marking +entries. ENTRY-MAIN is the first line of the diary entry." + (if (string-match (concat nonmarker + "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(" + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\(.*?\\) ?$") + entry-main) + (let* ((datetime (substring entry-main (match-beginning 1) + (match-end 1))) + (startisostring (icalendar--datestring-to-isodate + datetime)) + (endisostring (icalendar--datestring-to-isodate + datetime 1)) + (starttimestring (icalendar--diarytime-to-isotime + (if (match-beginning 3) + (substring entry-main + (match-beginning 3) + (match-end 3)) + nil) + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil))) + (endtimestring (icalendar--diarytime-to-isotime + (if (match-beginning 6) + (substring entry-main + (match-beginning 6) + (match-end 6)) + nil) + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 8) + (match-end 8))))) + (icalendar--dmsg "ordinary %s" entry-main) + + (unless startisostring + (error "Could not parse date")) + (when starttimestring + (unless endtimestring + (let ((time + (read (icalendar--rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" + (+ 10000 time)))))) + (list (concat "\nDTSTART;" + (if starttimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + startisostring + (or starttimestring "") + "\nDTEND;" + (if endtimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + (if starttimestring + startisostring + endisostring) + (or endtimestring "")) + summary)) + ;; no match + nil)) + +(defun icalendar--convert-weekly-to-ical (nonmarker entry-main) + "Convert weekly diary entry to icalendar format. +NONMARKER is a regular expression matching the start of non-marking +entries. ENTRY-MAIN is the first line of the diary entry." + (if (and (string-match (concat nonmarker + "\\([a-z]+\\)\\s-+" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)" + "\\([ap]m\\)?" + "\\(-0?" + "\\([1-9][0-9]?:[0-9][0-9]\\)" + "\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\(.*?\\) ?$") + entry-main) + (icalendar--get-weekday-abbrev + (substring entry-main (match-beginning 1) + (match-end 1)))) + (let* ((day (icalendar--get-weekday-abbrev + (substring entry-main (match-beginning 1) + (match-end 1)))) + (starttimestring (icalendar--diarytime-to-isotime + (if (match-beginning 3) + (substring entry-main + (match-beginning 3) + (match-end 3)) + nil) + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil))) + (endtimestring (icalendar--diarytime-to-isotime + (if (match-beginning 6) + (substring entry-main + (match-beginning 6) + (match-end 6)) + nil) + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 8) + (match-end 8))))) + (icalendar--dmsg "weekly %s" entry-main) + + (when starttimestring + (unless endtimestring + (let ((time (read + (icalendar--rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" + (+ 10000 time)))))) + (list (concat "\nDTSTART;" + (if starttimestring + "VALUE=DATE-TIME:" + "VALUE=DATE:") + ;; find the correct week day, + ;; 1st january 2000 was a saturday + (format + "200001%02d" + (+ (icalendar--get-weekday-number day) 2)) + (or starttimestring "") + "\nDTEND;" + (if endtimestring + "VALUE=DATE-TIME:" + "VALUE=DATE:") + (format + "200001%02d" + ;; end is non-inclusive! + (+ (icalendar--get-weekday-number day) + (if endtimestring 2 3))) + (or endtimestring "") + "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" + day) + summary)) + ;; no match + nil)) + +(defun icalendar--convert-yearly-to-ical (nonmarker entry-main) + "Convert yearly diary entry to icalendar format. +NONMARKER is a regular expression matching the start of non-marking +entries. ENTRY-MAIN is the first line of the diary entry." + (if (string-match (concat nonmarker + (if european-calendar-style + "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+" + "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+") + "\\*?\\s-*" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(" + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years + ) + entry-main) + (let* ((daypos (if european-calendar-style 1 2)) + (monpos (if european-calendar-style 2 1)) + (day (read (substring entry-main + (match-beginning daypos) + (match-end daypos)))) + (month (icalendar--get-month-number + (substring entry-main + (match-beginning monpos) + (match-end monpos)))) + (starttimestring (icalendar--diarytime-to-isotime + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil) + (if (match-beginning 5) + (substring entry-main + (match-beginning 5) + (match-end 5)) + nil))) + (endtimestring (icalendar--diarytime-to-isotime + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil) + (if (match-beginning 8) + (substring entry-main + (match-beginning 8) + (match-end 8)) + nil))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 9) + (match-end 9))))) + (icalendar--dmsg "yearly %s" entry-main) + + (when starttimestring + (unless endtimestring + (let ((time (read + (icalendar--rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" + (+ 10000 time)))))) + (list (concat "\nDTSTART;" + (if starttimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + (format "1900%02d%02d" month day) + (or starttimestring "") + "\nDTEND;" + (if endtimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + ;; end is not included! shift by one day + (icalendar--date-to-isodate + (list month day 1900) + (if endtimestring 0 1)) + (or endtimestring "") + "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=" + (format "%2d" month) + ";BYMONTHDAY=" + (format "%2d" day)) + summary)) + ;; no match + nil)) + +(defun icalendar--convert-sexp-to-ical (nonmarker entry-main) + "Convert complex sexp diary entry to icalendar format -- unsupported! + +FIXME! + +NONMARKER is a regular expression matching the start of non-marking +entries. ENTRY-MAIN is the first line of the diary entry." + (cond ((string-match (concat nonmarker + "%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$") + entry-main) + ;; simple sexp entry as generated by icalendar.el: strip off the + ;; unnecessary (and) + (icalendar--dmsg "diary-sexp from icalendar.el %s" entry-main) + (icalendar--convert-to-ical + nonmarker + (concat "%%" + (substring entry-main (match-beginning 1) (match-end 1)) + (substring entry-main (match-beginning 2) (match-end 2))))) + ((string-match (concat nonmarker + "%%([^)]+)\\s-*.*") + entry-main) + (icalendar--dmsg "diary-sexp %s" entry-main) + (error "Sexp-entries are not supported yet")) + (t + ;; no match + nil))) + +(defun icalendar--convert-block-to-ical (nonmarker entry-main) + "Convert block diary entry to icalendar format. +NONMARKER is a regular expression matching the start of non-marking +entries. ENTRY-MAIN is the first line of the diary entry." + (if (string-match (concat nonmarker + "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)" + " +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(" + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\(.*?\\) ?$") + entry-main) + (let* ((startstring (substring entry-main + (match-beginning 1) + (match-end 1))) + (endstring (substring entry-main + (match-beginning 2) + (match-end 2))) + (startisostring (icalendar--datestring-to-isodate + startstring)) + (endisostring (icalendar--datestring-to-isodate + endstring)) + (endisostring+1 (icalendar--datestring-to-isodate + endstring 1)) + (starttimestring (icalendar--diarytime-to-isotime + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil) + (if (match-beginning 5) + (substring entry-main + (match-beginning 5) + (match-end 5)) + nil))) + (endtimestring (icalendar--diarytime-to-isotime + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil) + (if (match-beginning 8) + (substring entry-main + (match-beginning 8) + (match-end 8)) + nil))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 9) + (match-end 9))))) + (icalendar--dmsg "diary-block %s" entry-main) + (when starttimestring + (unless endtimestring + (let ((time + (read (icalendar--rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" + (+ 10000 time)))))) + (if starttimestring + ;; with time -> write rrule + (list (concat "\nDTSTART;VALUE=DATE-TIME:" + startisostring + starttimestring + "\nDTEND;VALUE=DATE-TIME:" + startisostring + endtimestring + "\nRRULE:FREQ=DAILY;INTERVAL=1;UNTIL=" + endisostring) + summary) + ;; no time -> write long event + (list (concat "\nDTSTART;VALUE=DATE:" startisostring + "\nDTEND;VALUE=DATE:" endisostring+1) + summary))) + ;; no match + nil)) + +(defun icalendar--convert-float-to-ical (nonmarker entry-main) + "Convert float diary entry to icalendar format -- unsupported! + +FIXME! + +NONMARKER is a regular expression matching the start of non-marking +entries. ENTRY-MAIN is the first line of the diary entry." + (if (string-match (concat nonmarker + "%%(diary-float \\([^)]+\\))\\s-*\\(.*?\\) ?$") + entry-main) + (progn + (icalendar--dmsg "diary-float %s" entry-main) + (error "`diary-float' is not supported yet")) + ;; no match + nil)) + +(defun icalendar--convert-date-to-ical (nonmarker entry-main) + "Convert `diary-date' diary entry to icalendar format -- unsupported! + +FIXME! + +NONMARKER is a regular expression matching the start of non-marking +entries. ENTRY-MAIN is the first line of the diary entry." + (if (string-match (concat nonmarker + "%%(diary-date \\([^)]+\\))\\s-*\\(.*?\\) ?$") + entry-main) + (progn + (icalendar--dmsg "diary-date %s" entry-main) + (error "`diary-date' is not supported yet")) + ;; no match + nil)) + +(defun icalendar--convert-cyclic-to-ical (nonmarker entry-main) + "Convert `diary-cyclic' diary entry to icalendar format. +NONMARKER is a regular expression matching the start of non-marking +entries. ENTRY-MAIN is the first line of the diary entry." + (if (string-match (concat nonmarker + "%%(diary-cyclic \\([^ ]+\\) +" + "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(" + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\(.*?\\) ?$") + entry-main) + (let* ((frequency (substring entry-main (match-beginning 1) + (match-end 1))) + (datetime (substring entry-main (match-beginning 2) + (match-end 2))) + (startisostring (icalendar--datestring-to-isodate + datetime)) + (endisostring (icalendar--datestring-to-isodate + datetime)) + (endisostring+1 (icalendar--datestring-to-isodate + datetime 1)) + (starttimestring (icalendar--diarytime-to-isotime + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil) + (if (match-beginning 5) + (substring entry-main + (match-beginning 5) + (match-end 5)) + nil))) + (endtimestring (icalendar--diarytime-to-isotime + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil) + (if (match-beginning 8) + (substring entry-main + (match-beginning 8) + (match-end 8)) + nil))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 9) + (match-end 9))))) + (icalendar--dmsg "diary-cyclic %s" entry-main) + (when starttimestring + (unless endtimestring + (let ((time + (read (icalendar--rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" + (+ 10000 time)))))) + (list (concat "\nDTSTART;" + (if starttimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + startisostring + (or starttimestring "") + "\nDTEND;" + (if endtimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + (if endtimestring endisostring endisostring+1) + (or endtimestring "") + "\nRRULE:FREQ=DAILY;INTERVAL=" frequency + ;; strange: korganizer does not expect + ;; BYSOMETHING here... + ) + summary)) + ;; no match + nil)) + +(defun icalendar--convert-anniversary-to-ical (nonmarker entry-main) + "Convert `diary-anniversary' diary entry to icalendar format. +NONMARKER is a regular expression matching the start of non-marking +entries. ENTRY-MAIN is the first line of the diary entry." + (if (string-match (concat nonmarker + "%%(diary-anniversary \\([^)]+\\))\\s-*" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(" + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\(.*?\\) ?$") + entry-main) + (let* ((datetime (substring entry-main (match-beginning 1) + (match-end 1))) + (startisostring (icalendar--datestring-to-isodate + datetime)) + (endisostring (icalendar--datestring-to-isodate + datetime 1)) + (starttimestring (icalendar--diarytime-to-isotime + (if (match-beginning 3) + (substring entry-main + (match-beginning 3) + (match-end 3)) + nil) + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil))) + (endtimestring (icalendar--diarytime-to-isotime + (if (match-beginning 6) + (substring entry-main + (match-beginning 6) + (match-end 6)) + nil) + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 8) + (match-end 8))))) + (icalendar--dmsg "diary-anniversary %s" entry-main) + (when starttimestring + (unless endtimestring + (let ((time + (read (icalendar--rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" + (+ 10000 time)))))) + (list (concat "\nDTSTART;" + (if starttimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + startisostring + (or starttimestring "") + "\nDTEND;" + (if endtimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + endisostring + (or endtimestring "") + "\nRRULE:FREQ=YEARLY;INTERVAL=1" + ;; the following is redundant, + ;; but korganizer seems to expect this... ;( + ;; and evolution doesn't understand it... :( + ;; so... who is wrong?! + ";BYMONTH=" + (substring startisostring 4 6) + ";BYMONTHDAY=" + (substring startisostring 6 8)) + summary)) + ;; no match + nil)) + ;; ====================================================================== ;; Import -- convert icalendar to emacs-diary ;; ====================================================================== @@ -1117,7 +1444,7 @@ FExport diary data into iCalendar file: ") ;;;###autoload (defun icalendar-import-file (ical-filename diary-filename &optional non-marking) - "Import a iCalendar file and append to a diary file. + "Import an iCalendar file and append to a diary file. Argument ICAL-FILENAME output iCalendar file. Argument DIARY-FILENAME input `diary-file'. Optional argument NON-MARKING determines whether events are created as @@ -1170,10 +1497,12 @@ buffer `*icalendar-errors*'." ical-contents diary-file do-not-ask non-marking)) (when diary-file - ;; save the diary file - (save-current-buffer - (set-buffer (find-buffer-visiting diary-file)) - (save-buffer))) + ;; save the diary file if it is visited already + (let ((b (find-buffer-visiting diary-file))) + (when b + (save-current-buffer + (set-buffer b) + (save-buffer))))) (message "Converting icalendar...done") ;; return t if no error occured (not ical-errors)) @@ -1185,18 +1514,17 @@ buffer `*icalendar-errors*'." (defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) (make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) -;; ====================================================================== -;; private area -;; ====================================================================== - (defun icalendar--format-ical-event (event) "Create a string representation of an iCalendar EVENT." (let ((string icalendar-import-format) (conversion-list - '(("%d" DESCRIPTION icalendar-import-format-description) - ("%s" SUMMARY icalendar-import-format-subject) + '(("%c" CLASS icalendar-import-format-class) + ("%d" DESCRIPTION icalendar-import-format-description) ("%l" LOCATION icalendar-import-format-location) - ("%o" ORGANIZER icalendar-import-format-organizer)))) + ("%o" ORGANIZER icalendar-import-format-organizer) + ("%s" SUMMARY icalendar-import-format-summary) + ("%t" STATUS icalendar-import-format-status) + ("%u" URL icalendar-import-format-url)))) ;; convert the specifiers in the format string (mapcar (lambda (i) (let* ((spec (car i)) @@ -1209,24 +1537,26 @@ buffer `*icalendar-errors*'." (icalendar--rris "%s" (icalendar--convert-string-for-import contents) - (symbol-value format)))) + (symbol-value format) + t t))) (setq string (icalendar--rris spec formatted-contents - string)))) + string + t t)))) conversion-list) string)) (defun icalendar--convert-ical-to-diary (ical-list diary-file &optional do-not-ask non-marking) - "Convert an iCalendar file to an Emacs diary file. + "Convert Calendar data to an Emacs diary file. Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event whether to actually import it. NON-MARKING determines whether diary events are created as non-marking. This function attempts to return t if something goes wrong. In this case an error string which describes all the errors and problems is -written into the buffer ` *icalendar-errors*'." +written into the buffer `*icalendar-errors*'." (let* ((ev (icalendar--all-events ical-list)) (error-string "") (event-ok t) @@ -1238,180 +1568,67 @@ written into the buffer ` *icalendar-errors*'." (setq ev (cdr ev)) (setq event-ok nil) (condition-case error-val - (let* ((dtstart (icalendar--decode-isodatetime - (icalendar--get-event-property e 'DTSTART))) + (let* ((dtstart (icalendar--get-event-property e 'DTSTART)) + (dtstart-dec (icalendar--decode-isodatetime dtstart)) (start-d (icalendar--datetime-to-diary-date - dtstart)) - (start-t (icalendar--datetime-to-colontime dtstart)) - (dtend (icalendar--decode-isodatetime - (icalendar--get-event-property e 'DTEND))) + dtstart-dec)) + (start-t (icalendar--datetime-to-colontime dtstart-dec)) + (dtend (icalendar--get-event-property e 'DTEND)) + (dtend-dec (icalendar--decode-isodatetime dtend)) + (dtend-1-dec (icalendar--decode-isodatetime dtend -1)) end-d + end-1-d end-t - (subject (icalendar--convert-string-for-import + (summary (icalendar--convert-string-for-import (or (icalendar--get-event-property e 'SUMMARY) - "No Subject"))) + "No summary"))) (rrule (icalendar--get-event-property e 'RRULE)) (rdate (icalendar--get-event-property e 'RDATE)) (duration (icalendar--get-event-property e 'DURATION))) - (icalendar--dmsg "%s: %s" start-d subject) + (icalendar--dmsg "%s: `%s'" start-d summary) ;; check whether start-time is missing - (if (and (icalendar--get-event-property-attributes - e 'DTSTART) - (string= (cadr (icalendar--get-event-property-attributes - e 'DTSTART)) - "DATE")) + (if (and dtstart + (string= + (cadr (icalendar--get-event-property-attributes + e 'DTSTART)) + "DATE")) (setq start-t nil)) (when duration - (let ((dtend2 (icalendar--add-decoded-times - dtstart - (icalendar--decode-isoduration duration)))) - (if (and dtend (not (eq dtend dtend2))) + (let ((dtend-dec-d (icalendar--add-decoded-times + dtstart-dec + (icalendar--decode-isoduration duration))) + (dtend-1-dec-d (icalendar--add-decoded-times + dtstart-dec + (icalendar--decode-isoduration duration + t)))) + (if (and dtend-dec (not (eq dtend-dec dtend-dec-d))) (message "Inconsistent endtime and duration for %s" - subject)) - (setq dtend dtend2))) - (setq end-d (if dtend - (icalendar--datetime-to-diary-date dtend) + summary)) + (setq dtend-dec dtend-dec-d) + (setq dtend-1-dec dtend-1-dec-d))) + (setq end-d (if dtend-dec + (icalendar--datetime-to-diary-date dtend-dec) start-d)) - (setq end-t (if dtend - (icalendar--datetime-to-colontime dtend) + (setq end-1-d (if dtend-1-dec + (icalendar--datetime-to-diary-date dtend-1-dec) + start-d)) + (setq end-t (if (and + dtend-dec + (not (string= + (cadr + (icalendar--get-event-property-attributes + e 'DTEND)) + "DATE"))) + (icalendar--datetime-to-colontime dtend-dec) start-t)) (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d) (cond ;; recurring event (rrule - (icalendar--dmsg "recurring event") - (let* ((rrule-props (icalendar--split-value rrule)) - (frequency (cadr (assoc 'FREQ rrule-props))) - (until (cadr (assoc 'UNTIL rrule-props))) - (interval (read (cadr (assoc 'INTERVAL rrule-props))))) - (cond ((string-equal frequency "WEEKLY") - (if (not start-t) - (progn - ;; weekly and all-day - (icalendar--dmsg "weekly all-day") - (if until - (let ((fro - (icalendar--datetime-to-diary-date - (icalendar--decode-isodatetime - (icalendar--get-event-property - e - 'DTSTART)))) - (unt - (icalendar--datetime-to-diary-date - (icalendar--decode-isodatetime - until -1)))) - (setq diary-string - (format - (concat "%%%%(and " - "(diary-cyclic %d %s) " - "(diary-block %s %s))") - (* interval 7) - (icalendar--datetime-to-diary-date - dtstart) - (icalendar--datetime-to-diary-date - dtstart) - (icalendar--datetime-to-diary-date - (icalendar--decode-isodatetime - until -1))))) - (setq diary-string - (format "%%%%(and (diary-cyclic %d %s))" - (* interval 7) - (icalendar--datetime-to-diary-date - dtstart)))) - (setq event-ok t)) - ;; weekly and not all-day - (let* ((byday (cadr (assoc 'BYDAY rrule-props))) - (weekday - (icalendar--get-weekday-number byday))) - (icalendar--dmsg "weekly not-all-day") - (if until - (let ((fro - (icalendar--datetime-to-diary-date - (icalendar--decode-isodatetime - (icalendar--get-event-property - e - 'DTSTART)))) - (unt - (icalendar--datetime-to-diary-date - (icalendar--decode-isodatetime - until)))) - (setq diary-string - (format - (concat "%%%%(and " - "(diary-cyclic %d %s) " - "(diary-block %s %s)) " - "%s%s%s") - (* interval 7) - (icalendar--datetime-to-diary-date - dtstart) - (icalendar--datetime-to-diary-date - dtstart) - (icalendar--datetime-to-diary-date - (icalendar--decode-isodatetime - until)) - start-t - (if end-t "-" "") (or end-t "")))) - ;; no limit - ;; FIXME!!!! - ;; DTSTART;VALUE=DATE-TIME:20030919T090000 - ;; DTEND;VALUE=DATE-TIME:20030919T113000 - (setq diary-string - (format - "%%%%(and (diary-cyclic %s %s)) %s%s%s" - (* interval 7) - (icalendar--datetime-to-diary-date - dtstart) - start-t - (if end-t "-" "") (or end-t "")))) - (setq event-ok t)))) - ;; yearly - ((string-equal frequency "YEARLY") - (icalendar--dmsg "yearly") - (setq diary-string - (format - "%%%%(and (diary-anniversary %s))" - (icalendar--datetime-to-diary-date dtstart))) - (setq event-ok t)) - ;; FIXME: war auskommentiert: - ((and (string-equal frequency "DAILY") - ;;(not (string= start-d end-d)) - ;;(not start-t) - ;;(not end-t) - ) - (let ((ds (icalendar--datetime-to-diary-date - (icalendar--decode-isodatetime - (icalendar--get-event-property - e 'DTSTART)))) - (de (icalendar--datetime-to-diary-date - (icalendar--decode-isodatetime - until -1)))) - (setq diary-string - (format - "%%%%(and (diary-block %s %s))" - ds de))) - (setq event-ok t)))) - ;; Handle exceptions from recurrence rules - (let ((ex-dates (icalendar--get-event-properties e - 'EXDATE))) - (while ex-dates - (let* ((ex-start (icalendar--decode-isodatetime - (car ex-dates))) - (ex-d (icalendar--datetime-to-diary-date - ex-start))) - (setq diary-string - (icalendar--rris "^%%(\\(and \\)?" - (format - "%%%%(and (not (diary-date %s)) " - ex-d) - diary-string))) - (setq ex-dates (cdr ex-dates)))) - ;; FIXME: exception rules are not recognized - (if (icalendar--get-event-property e 'EXRULE) - (setq diary-string - (concat diary-string - "\n Exception rules: " - (icalendar--get-event-properties - e 'EXRULE))))) + (setq diary-string + (icalendar--convert-recurring-to-diary e dtstart-dec start-t + end-t)) + (setq event-ok t)) (rdate (icalendar--dmsg "rdate event") (setq diary-string "") @@ -1423,35 +1640,22 @@ written into the buffer ` *icalendar-errors*'." ;; non-recurring event ;; all-day event ((not (string= start-d end-d)) - (icalendar--dmsg "non-recurring event") - (let ((ds (icalendar--datetime-to-diary-date dtstart)) - (de (icalendar--datetime-to-diary-date dtend))) - (setq diary-string - (format "%%%%(and (diary-block %s %s))" - ds de))) + (setq diary-string + (icalendar--convert-non-recurring-all-day-to-diary + e start-d end-1-d)) (setq event-ok t)) ;; not all-day ((and start-t (or (not end-t) (not (string= start-t end-t)))) - (icalendar--dmsg "not all day event") - (cond (end-t - (setq diary-string - (format "%s %s-%s" - (icalendar--datetime-to-diary-date - dtstart "/") - start-t end-t))) - (t - (setq diary-string - (format "%s %s" - (icalendar--datetime-to-diary-date - dtstart "/") - start-t)))) + (setq diary-string + (icalendar--convert-non-recurring-not-all-day-to-diary + e dtstart-dec dtend-dec start-t end-t)) (setq event-ok t)) ;; all-day event (t (icalendar--dmsg "all day event") (setq diary-string (icalendar--datetime-to-diary-date - dtstart "/")) + dtstart-dec "/")) (setq event-ok t))) ;; add all other elements unless the user doesn't want to have ;; them @@ -1460,9 +1664,9 @@ written into the buffer ` *icalendar-errors*'." (setq diary-string (concat diary-string " " (icalendar--format-ical-event e))) - (if do-not-ask (setq subject nil)) + (if do-not-ask (setq summary nil)) (icalendar--add-diary-entry diary-string diary-file - non-marking subject)) + non-marking summary)) ;; event was not ok (setq found-error t) (setq error-string @@ -1475,33 +1679,259 @@ written into the buffer ` *icalendar-errors*'." (setq found-error t) (setq error-string (format "%s\n%s\nCannot handle this event: %s" error-val error-string e)) - (message error-string)))) + (message "%s" error-string)))) (if found-error (save-current-buffer - (set-buffer (get-buffer-create " *icalendar-errors*")) + (set-buffer (get-buffer-create "*icalendar-errors*")) (erase-buffer) (insert error-string))) (message "Converting icalendar...done") found-error)) +;; subroutines for importing +(defun icalendar--convert-recurring-to-diary (e dtstart-dec start-t end-t) + "Convert recurring icalendar event E to diary format. + +DTSTART-DEC is the DTSTART property of E. +START-T is the event's start time in diary format. +END-T is the event's end time in diary format." + (icalendar--dmsg "recurring event") + (let* ((rrule (icalendar--get-event-property e 'RRULE)) + (rrule-props (icalendar--split-value rrule)) + (frequency (cadr (assoc 'FREQ rrule-props))) + (until (cadr (assoc 'UNTIL rrule-props))) + (count (cadr (assoc 'COUNT rrule-props))) + (interval (read (or (cadr (assoc 'INTERVAL rrule-props)) "1"))) + (dtstart-conv (icalendar--datetime-to-diary-date dtstart-dec)) + (until-conv (icalendar--datetime-to-diary-date + (icalendar--decode-isodatetime until))) + (until-1-conv (icalendar--datetime-to-diary-date + (icalendar--decode-isodatetime until -1))) + (result "")) + + ;; FIXME FIXME interval!!!!!!!!!!!!! + + (when count + (if until + (message "Must not have UNTIL and COUNT -- ignoring COUNT element!") + (let ((until-1 0)) + (cond ((string-equal frequency "DAILY") + (setq until (icalendar--add-decoded-times + dtstart-dec + (list 0 0 0 (* (read count) interval) 0 0))) + (setq until-1 (icalendar--add-decoded-times + dtstart-dec + (list 0 0 0 (* (- (read count) 1) interval) + 0 0))) + ) + ((string-equal frequency "WEEKLY") + (setq until (icalendar--add-decoded-times + dtstart-dec + (list 0 0 0 (* (read count) 7 interval) 0 0))) + (setq until-1 (icalendar--add-decoded-times + dtstart-dec + (list 0 0 0 (* (- (read count) 1) 7 + interval) 0 0))) + ) + ((string-equal frequency "MONTHLY") + (setq until (icalendar--add-decoded-times + dtstart-dec (list 0 0 0 0 (* (- (read count) 1) + interval) 0))) + (setq until-1 (icalendar--add-decoded-times + dtstart-dec (list 0 0 0 0 (* (- (read count) 1) + interval) 0))) + ) + ((string-equal frequency "YEARLY") + (setq until (icalendar--add-decoded-times + dtstart-dec (list 0 0 0 0 0 (* (- (read count) 1) + interval)))) + (setq until-1 (icalendar--add-decoded-times + dtstart-dec + (list 0 0 0 0 0 (* (- (read count) 1) + interval)))) + ) + (t + (message "Cannot handle COUNT attribute for `%s' events." + frequency))) + (setq until-conv (icalendar--datetime-to-diary-date until)) + (setq until-1-conv (icalendar--datetime-to-diary-date until-1)) + )) + ) + (cond ((string-equal frequency "WEEKLY") + (if (not start-t) + (progn + ;; weekly and all-day + (icalendar--dmsg "weekly all-day") + (if until + (setq result + (format + (concat "%%%%(and " + "(diary-cyclic %d %s) " + "(diary-block %s %s))") + (* interval 7) + dtstart-conv + dtstart-conv + (if count until-1-conv until-conv) + )) + (setq result + (format "%%%%(and (diary-cyclic %d %s))" + (* interval 7) + dtstart-conv)))) + ;; weekly and not all-day + (let* ((byday (cadr (assoc 'BYDAY rrule-props))) + (weekday + (icalendar--get-weekday-number byday))) + (icalendar--dmsg "weekly not-all-day") + (if until + (setq result + (format + (concat "%%%%(and " + "(diary-cyclic %d %s) " + "(diary-block %s %s)) " + "%s%s%s") + (* interval 7) + dtstart-conv + dtstart-conv + until-conv + (or start-t "") + (if end-t "-" "") (or end-t ""))) + ;; no limit + ;; FIXME!!!! + ;; DTSTART;VALUE=DATE-TIME:20030919T090000 + ;; DTEND;VALUE=DATE-TIME:20030919T113000 + (setq result + (format + "%%%%(and (diary-cyclic %s %s)) %s%s%s" + (* interval 7) + dtstart-conv + (or start-t "") + (if end-t "-" "") (or end-t ""))))))) + ;; yearly + ((string-equal frequency "YEARLY") + (icalendar--dmsg "yearly") + (if until + (setq result (format + (concat "%%%%(and (diary-date %s %s t) " + "(diary-block %s %s)) %s%s%s") + (if european-calendar-style (nth 3 dtstart-dec) + (nth 4 dtstart-dec)) + (if european-calendar-style (nth 4 dtstart-dec) + (nth 3 dtstart-dec)) + dtstart-conv + until-conv + (or start-t "") + (if end-t "-" "") (or end-t ""))) + (setq result (format + "%%%%(and (diary-anniversary %s)) %s%s%s" + dtstart-conv + (or start-t "") + (if end-t "-" "") (or end-t ""))))) + ;; monthly + ((string-equal frequency "MONTHLY") + (icalendar--dmsg "monthly") + (setq result + (format + "%%%%(and (diary-date %s %s %s) (diary-block %s %s)) %s%s%s" + (if european-calendar-style (nth 3 dtstart-dec) "t") + (if european-calendar-style "t" (nth 3 dtstart-dec)) + "t" + dtstart-conv + (if until + until-conv + "1 1 9999") ;; FIXME: should be unlimited + (or start-t "") + (if end-t "-" "") (or end-t "")))) + ;; daily + ((and (string-equal frequency "DAILY")) + (if until + (setq result + (format + (concat "%%%%(and (diary-cyclic %s %s) " + "(diary-block %s %s)) %s%s%s") + interval dtstart-conv dtstart-conv + (if count until-1-conv until-conv) + (or start-t "") + (if end-t "-" "") (or end-t ""))) + (setq result + (format + "%%%%(and (diary-cyclic %s %s)) %s%s%s" + interval + dtstart-conv + (or start-t "") + (if end-t "-" "") (or end-t "")))))) + ;; Handle exceptions from recurrence rules + (let ((ex-dates (icalendar--get-event-properties e 'EXDATE))) + (while ex-dates + (let* ((ex-start (icalendar--decode-isodatetime + (car ex-dates))) + (ex-d (icalendar--datetime-to-diary-date + ex-start))) + (setq result + (icalendar--rris "^%%(\\(and \\)?" + (format + "%%%%(and (not (diary-date %s)) " + ex-d) + result))) + (setq ex-dates (cdr ex-dates)))) + ;; FIXME: exception rules are not recognized + (if (icalendar--get-event-property e 'EXRULE) + (setq result + (concat result + "\n Exception rules: " + (icalendar--get-event-properties + e 'EXRULE)))) + result)) + +(defun icalendar--convert-non-recurring-all-day-to-diary (event start-d end-d) + "Convert non-recurring icalendar EVENT to diary format. + +DTSTART is the decoded DTSTART property of E. +Argument START-D gives the first day. +Argument END-D gives the last day." + (icalendar--dmsg "non-recurring all-day event") + (format "%%%%(and (diary-block %s %s))" start-d end-d)) + +(defun icalendar--convert-non-recurring-not-all-day-to-diary (event dtstart-dec + dtend-dec + start-t + end-t) + "Convert recurring icalendar EVENT to diary format. + +DTSTART-DEC is the decoded DTSTART property of E. +DTEND-DEC is the decoded DTEND property of E. +START-T is the event's start time in diary format. +END-T is the event's end time in diary format." + (icalendar--dmsg "not all day event") + (cond (end-t + (format "%s %s-%s" + (icalendar--datetime-to-diary-date + dtstart-dec "/") + start-t end-t)) + (t + (format "%s %s" + (icalendar--datetime-to-diary-date + dtstart-dec "/") + start-t)))) + (defun icalendar--add-diary-entry (string diary-file non-marking - &optional subject) + &optional summary) "Add STRING to the diary file DIARY-FILE. STRING must be a properly formatted valid diary entry. NON-MARKING determines whether diary events are created as non-marking. If -SUBJECT is not nil it must be a string that gives the subject of the +SUMMARY is not nil it must be a string that gives the summary of the entry. In this case the user will be asked whether he wants to insert the entry." - (when (or (not subject) + (when (or (not summary) (y-or-n-p (format "Add appointment for `%s' to diary? " - subject))) - (when subject + summary))) + (when summary (setq non-marking (y-or-n-p (format "Make appointment non-marking? ")))) (save-window-excursion (unless diary-file (setq diary-file (read-file-name "Add appointment to this diary file: "))) + ;; Note: make-diary-entry will add a trailing blank char.... :( (make-diary-entry string non-marking diary-file)))) (provide 'icalendar)