aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2005-02-11 01:02:56 +0000
committerGlenn Morris2005-02-11 01:02:56 +0000
commit74692b14eeee02abfd795fa8f1737394b30d9d78 (patch)
treecbf8494a2c8f60fd968280490d08ae590d4e6676
parentea66d5e0c443e5003f4fd37c597db52a80781995 (diff)
downloademacs-74692b14eeee02abfd795fa8f1737394b30d9d78.tar.gz
emacs-74692b14eeee02abfd795fa8f1737394b30d9d78.zip
From Ulf Jasper <ulf.jasper@web.de>:
(icalendar--get-event-property): Doc fix. (icalendar--get-event-property-attributes) (icalendar--get-event-properties) (icalendar--datetime-to-diary-date): New functions. (icalendar--split-value): Doc fix. (icalendar--datetime-to-noneuropean-date) (icalendar--datetime-to-european-date): New optional argument SEPARATOR. Return result as a string instead of a list. (icalendar--get-weekday-number): Check if ABBREVWEEKDAY is nil. (icalendar--convert-string-for-export): Rename arg S to STRING. (icalendar-export-region): Doc fix. Change name of error buffer. Save output buffer. (icalendar-import-file): Add blank at end of prompt. (icalendar-import-buffer): Doc fix. Do not switch to error buffer. Indicate status in return value. (icalendar--convert-ical-to-diary): Doc fix. Change name of error buffer. Save output buffer. Handle exception from recurrence rules (EXDATE, EXRULE). Handle start- and end-date of recurring events. Fix problems with weekly all-day events.
-rw-r--r--lisp/calendar/icalendar.el421
1 files changed, 279 insertions, 142 deletions
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index dc3bf016053..2f0be116ed1 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -1,6 +1,6 @@
1;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*- 1;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
2 2
3;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Ulf Jasper <ulf.jasper@web.de> 5;; Author: Ulf Jasper <ulf.jasper@web.de>
6;; Created: August 2002 6;; Created: August 2002
@@ -90,7 +90,7 @@
90 90
91;;; Code: 91;;; Code:
92 92
93(defconst icalendar-version 0.08 93(defconst icalendar-version 0.09
94 "Version number of icalendar.el.") 94 "Version number of icalendar.el.")
95 95
96;; ====================================================================== 96;; ======================================================================
@@ -268,7 +268,7 @@ it finds"
268;; (car (cddr event))) 268;; (car (cddr event)))
269 269
270(defun icalendar--get-event-property (event prop) 270(defun icalendar--get-event-property (event prop)
271 "For the given EVENT return the value of the property PROP." 271 "For the given EVENT return the value of the first occurence of PROP."
272 (catch 'found 272 (catch 'found
273 (let ((props (car (cddr event))) pp) 273 (let ((props (car (cddr event))) pp)
274 (while props 274 (while props
@@ -278,6 +278,27 @@ it finds"
278 (setq props (cdr props)))) 278 (setq props (cdr props))))
279 nil)) 279 nil))
280 280
281(defun icalendar--get-event-property-attributes (event prop)
282 "For the given EVENT return attributes of the first occurence of PROP."
283 (catch 'found
284 (let ((props (car (cddr event))) pp)
285 (while props
286 (setq pp (car props))
287 (if (eq (car pp) prop)
288 (throw 'found (cadr pp)))
289 (setq props (cdr props))))
290 nil))
291
292(defun icalendar--get-event-properties (event prop)
293 "For the given EVENT return a list of all values of the property PROP."
294 (let ((props (car (cddr event))) pp result)
295 (while props
296 (setq pp (car props))
297 (if (eq (car pp) prop)
298 (setq result (cons (car (cddr pp)) result)))
299 (setq props (cdr props)))
300 result))
301
281;; (defun icalendar--set-event-property (event prop new-value) 302;; (defun icalendar--set-event-property (event prop new-value)
282;; "For the given EVENT set the property PROP to the value NEW-VALUE." 303;; "For the given EVENT set the property PROP to the value NEW-VALUE."
283;; (catch 'found 304;; (catch 'found
@@ -319,7 +340,7 @@ children."
319 (icalendar--get-children (car icalendar) 'VEVENT)) 340 (icalendar--get-children (car icalendar) 'VEVENT))
320 341
321(defun icalendar--split-value (value-string) 342(defun icalendar--split-value (value-string)
322 "Splits VALUE-STRING at ';='." 343 "Split VALUE-STRING at ';='."
323 (let ((result '()) 344 (let ((result '())
324 param-name param-value) 345 param-name param-value)
325 (when value-string 346 (when value-string
@@ -424,13 +445,11 @@ multiple comma-separated values should be allowed!"
424 (if (match-beginning 11) 445 (if (match-beginning 11)
425 (setq seconds (read (substring isodurationstring 446 (setq seconds (read (substring isodurationstring
426 (match-beginning 12) 447 (match-beginning 12)
427 (match-end 12))))) 448 (match-end 12))))))
428 )
429 ((match-beginning 13) ;weeks only 449 ((match-beginning 13) ;weeks only
430 (setq days (* 7 (read (substring isodurationstring 450 (setq days (* 7 (read (substring isodurationstring
431 (match-beginning 14) 451 (match-beginning 14)
432 (match-end 14)))))) 452 (match-end 14)))))))
433 )
434 (list seconds minutes hours days months years))) 453 (list seconds minutes hours days months years)))
435 ;; isodatetimestring == nil 454 ;; isodatetimestring == nil
436 nil)) 455 nil))
@@ -452,27 +471,45 @@ valid (year > 1900 or something)."
452 ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME? 471 ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
453 ))) 472 )))
454 473
455(defun icalendar--datetime-to-noneuropean-date (datetime) 474(defun icalendar--datetime-to-noneuropean-date (datetime &optional separator)
456 "Convert the decoded DATETIME to non-european-style format. 475 "Convert the decoded DATETIME to non-european-style format.
457Non-European format: (month day year)." 476Optional argument SEPARATOR gives the separator between month,
477day, and year. If nil a blank character is used as separator.
478Non-European format: \"month day year\"."
458 (if datetime 479 (if datetime
459 (list (nth 4 datetime) ;month 480 (format "%d%s%d%s%d" (nth 4 datetime) ;month
460 (nth 3 datetime) ;day 481 (or separator " ")
461 (nth 5 datetime)) ;year 482 (nth 3 datetime) ;day
483 (or separator " ")
484 (nth 5 datetime)) ;year
462 ;; datetime == nil 485 ;; datetime == nil
463 nil)) 486 nil))
464 487
465(defun icalendar--datetime-to-european-date (datetime) 488(defun icalendar--datetime-to-european-date (datetime &optional separator)
466 "Convert the decoded DATETIME to European format. 489 "Convert the decoded DATETIME to European format.
490Optional argument SEPARATOR gives the separator between month,
491day, and year. If nil a blank character is used as separator.
467European format: (day month year). 492European format: (day month year).
468FIXME" 493FIXME"
469 (if datetime 494 (if datetime
470 (format "%d %d %d" (nth 3 datetime) ; day 495 (format "%d%s%d%s%d" (nth 3 datetime) ;day
496 (or separator " ")
471 (nth 4 datetime) ;month 497 (nth 4 datetime) ;month
498 (or separator " ")
472 (nth 5 datetime)) ;year 499 (nth 5 datetime)) ;year
473 ;; datetime == nil 500 ;; datetime == nil
474 nil)) 501 nil))
475 502
503(defun icalendar--datetime-to-diary-date (datetime &optional separator)
504 "Convert the decoded DATETIME to diary format.
505Optional argument SEPARATOR gives the separator between month,
506day, and year. If nil a blank character is used as separator.
507Call icalendar--datetime-to-(non)-european-date according to
508value of `european-calendar-style'."
509 (if european-calendar-style
510 (icalendar--datetime-to-european-date datetime separator)
511 (icalendar--datetime-to-noneuropean-date datetime separator)))
512
476(defun icalendar--datetime-to-colontime (datetime) 513(defun icalendar--datetime-to-colontime (datetime)
477 "Extract the time part of a decoded DATETIME into 24-hour format. 514 "Extract the time part of a decoded DATETIME into 24-hour format.
478Note that this silently ignores seconds." 515Note that this silently ignores seconds."
@@ -495,15 +532,16 @@ Note that this silently ignores seconds."
495 532
496(defun icalendar--get-weekday-number (abbrevweekday) 533(defun icalendar--get-weekday-number (abbrevweekday)
497 "Return the number for the ABBREVWEEKDAY." 534 "Return the number for the ABBREVWEEKDAY."
498 (catch 'found 535 (if abbrevweekday
499 (let ((num 0) 536 (catch 'found
500 (aw (downcase abbrevweekday))) 537 (let ((num 0)
501 (mapc (lambda (day) 538 (aw (downcase abbrevweekday)))
502 (let ((d (downcase day))) 539 (mapc (lambda (day)
503 (if (string-equal d aw) 540 (let ((d (downcase day)))
504 (throw 'found num)) 541 (if (string-equal d aw)
505 (setq num (1+ num)))) 542 (throw 'found num))
506 icalendar--weekday-array)) 543 (setq num (1+ num))))
544 icalendar--weekday-array)))
507 ;; Error: 545 ;; Error:
508 -1)) 546 -1))
509 547
@@ -605,9 +643,9 @@ would be \"pm\"."
605 (format "T%04d00" starttimenum)) 643 (format "T%04d00" starttimenum))
606 nil)) 644 nil))
607 645
608(defun icalendar--convert-string-for-export (s) 646(defun icalendar--convert-string-for-export (string)
609 "Escape comma and other critical characters in string S." 647 "Escape comma and other critical characters in STRING."
610 (icalendar--rris "," "\\\\," s)) 648 (icalendar--rris "," "\\\\," string))
611 649
612(defun icalendar--convert-string-for-import (string) 650(defun icalendar--convert-string-for-import (string)
613 "Remove escape chars for comma, semicolon etc. from STRING." 651 "Remove escape chars for comma, semicolon etc. from STRING."
@@ -641,9 +679,9 @@ Finto iCalendar file: ")
641All diary entries in the region from MIN to MAX in the current buffer are 679All diary entries in the region from MIN to MAX in the current buffer are
642converted to iCalendar format. The result is appended to the file 680converted to iCalendar format. The result is appended to the file
643ICAL-FILENAME. 681ICAL-FILENAME.
644 682This function attempts to return t if something goes wrong. In this
645Returns non-nil if an error occurred. In this case an error message is 683case an error string which describes all the errors and problems is
646written to the buffer ` *icalendar-errors*'." 684written into the buffer `*icalendar-errors*'."
647 (interactive "r 685 (interactive "r
648FExport diary data into iCalendar file: ") 686FExport diary data into iCalendar file: ")
649 (let ((result "") 687 (let ((result "")
@@ -659,6 +697,7 @@ FExport diary data into iCalendar file: ")
659 (save-current-buffer 697 (save-current-buffer
660 (set-buffer (get-buffer-create " *icalendar-errors*")) 698 (set-buffer (get-buffer-create " *icalendar-errors*"))
661 (erase-buffer)) 699 (erase-buffer))
700
662 ;; here we go 701 ;; here we go
663 (save-excursion 702 (save-excursion
664 (goto-char min) 703 (goto-char min)
@@ -699,13 +738,15 @@ FExport diary data into iCalendar file: ")
699 ;; but korganizer seems to expect this... ;( 738 ;; but korganizer seems to expect this... ;(
700 ;; and evolution doesn't understand it... :( 739 ;; and evolution doesn't understand it... :(
701 ;; so... who is wrong?! 740 ;; so... who is wrong?!
702 ";BYMONTH=" (substring startisostring 4 6) 741 ";BYMONTH="
703 ";BYMONTHDAY=" (substring startisostring 6 8) 742 (substring startisostring 4 6)
704 ))) 743 ";BYMONTHDAY="
744 (substring startisostring 6 8))))
705 (unless (string= entry-rest "") 745 (unless (string= entry-rest "")
706 (setq contents (concat contents "\nDESCRIPTION:" 746 (setq contents
707 (icalendar--convert-string-for-export 747 (concat contents "\nDESCRIPTION:"
708 entry-rest))))) 748 (icalendar--convert-string-for-export
749 entry-rest)))))
709 ;; cyclic events 750 ;; cyclic events
710 ;; %%(diary-cyclic ) 751 ;; %%(diary-cyclic )
711 ((string-match 752 ((string-match
@@ -734,9 +775,10 @@ FExport diary data into iCalendar file: ")
734 ;; BYSOMETHING here... 775 ;; BYSOMETHING here...
735 ))) 776 )))
736 (unless (string= entry-rest "") 777 (unless (string= entry-rest "")
737 (setq contents (concat contents "\nDESCRIPTION:" 778 (setq contents
738 (icalendar--convert-string-for-export 779 (concat contents "\nDESCRIPTION:"
739 entry-rest))))) 780 (icalendar--convert-string-for-export
781 entry-rest)))))
740 ;; diary-date -- FIXME 782 ;; diary-date -- FIXME
741 ((string-match 783 ((string-match
742 (concat nonmarker 784 (concat nonmarker
@@ -754,13 +796,16 @@ FExport diary data into iCalendar file: ")
754 ;; block events 796 ;; block events
755 ((string-match 797 ((string-match
756 (concat nonmarker 798 (concat nonmarker
757 "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +" 799 "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)"
758 "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") 800 " +\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*"
801 "\\(.*\\)")
759 entry-main) 802 entry-main)
760 (icalendar--dmsg "diary-block %s" entry-main) 803 (icalendar--dmsg "diary-block %s" entry-main)
761 (let* ((startstring (substring entry-main (match-beginning 1) 804 (let* ((startstring (substring entry-main
805 (match-beginning 1)
762 (match-end 1))) 806 (match-end 1)))
763 (endstring (substring entry-main (match-beginning 2) 807 (endstring (substring entry-main
808 (match-beginning 2)
764 (match-end 2))) 809 (match-end 2)))
765 (summary (icalendar--convert-string-for-export 810 (summary (icalendar--convert-string-for-export
766 (substring entry-main (match-beginning 3) 811 (substring entry-main (match-beginning 3)
@@ -772,12 +817,12 @@ FExport diary data into iCalendar file: ")
772 (setq contents 817 (setq contents
773 (concat "\nDTSTART;VALUE=DATE:" startisostring 818 (concat "\nDTSTART;VALUE=DATE:" startisostring
774 "\nDTEND;VALUE=DATE:" endisostring 819 "\nDTEND;VALUE=DATE:" endisostring
775 "\nSUMMARY:" summary 820 "\nSUMMARY:" summary))
776 ))
777 (unless (string= entry-rest "") 821 (unless (string= entry-rest "")
778 (setq contents (concat contents "\nDESCRIPTION:" 822 (setq contents
779 (icalendar--convert-string-for-export 823 (concat contents "\nDESCRIPTION:"
780 entry-rest)))))) 824 (icalendar--convert-string-for-export
825 entry-rest))))))
781 ;; other sexp diary entries -- FIXME 826 ;; other sexp diary entries -- FIXME
782 ((string-match 827 ((string-match
783 (concat nonmarker 828 (concat nonmarker
@@ -790,14 +835,17 @@ FExport diary data into iCalendar file: ")
790 ((and (string-match 835 ((and (string-match
791 (concat nonmarker 836 (concat nonmarker
792 "\\([a-z]+\\)\\s-+" 837 "\\([a-z]+\\)\\s-+"
793 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" 838 "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)"
839 "\\([ap]m\\)?"
794 "\\(-0?" 840 "\\(-0?"
795 "\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" 841 "\\([1-9][0-9]?:[0-9][0-9]\\)"
842 "\\([ap]m\\)?\\)?"
796 "\\)?" 843 "\\)?"
797 "\\s-*\\(.*\\)$") 844 "\\s-*\\(.*\\)$")
798 entry-main) 845 entry-main)
799 (icalendar--get-weekday-abbrev 846 (icalendar--get-weekday-abbrev
800 (substring entry-main (match-beginning 1) (match-end 1)))) 847 (substring entry-main (match-beginning 1)
848 (match-end 1))))
801 (icalendar--dmsg "weekly %s" entry-main) 849 (icalendar--dmsg "weekly %s" entry-main)
802 (let* ((day (icalendar--get-weekday-abbrev 850 (let* ((day (icalendar--get-weekday-abbrev
803 (substring entry-main (match-beginning 1) 851 (substring entry-main (match-beginning 1)
@@ -829,9 +877,11 @@ FExport diary data into iCalendar file: ")
829 (match-end 8))))) 877 (match-end 8)))))
830 (when starttimestring 878 (when starttimestring
831 (unless endtimestring 879 (unless endtimestring
832 (let ((time (read (icalendar--rris "^T0?" "" 880 (let ((time (read
833 starttimestring)))) 881 (icalendar--rris "^T0?" ""
834 (setq endtimestring (format "T%06d" (+ 10000 time)))))) 882 starttimestring))))
883 (setq endtimestring (format "T%06d"
884 (+ 10000 time))))))
835 (setq contents 885 (setq contents
836 (concat "\nDTSTART;" 886 (concat "\nDTSTART;"
837 (if starttimestring 887 (if starttimestring
@@ -854,12 +904,13 @@ FExport diary data into iCalendar file: ")
854 (if endtimestring 2 3))) 904 (if endtimestring 2 3)))
855 (or endtimestring "") 905 (or endtimestring "")
856 "\nSUMMARY:" summary 906 "\nSUMMARY:" summary
857 "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day 907 "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY="
858 ))) 908 day)))
859 (unless (string= entry-rest "") 909 (unless (string= entry-rest "")
860 (setq contents (concat contents "\nDESCRIPTION:" 910 (setq contents
861 (icalendar--convert-string-for-export 911 (concat contents "\nDESCRIPTION:"
862 entry-rest))))) 912 (icalendar--convert-string-for-export
913 entry-rest)))))
863 ;; yearly by day 914 ;; yearly by day
864 ;; 1 May Tag der Arbeit 915 ;; 1 May Tag der Arbeit
865 ((string-match 916 ((string-match
@@ -878,10 +929,12 @@ FExport diary data into iCalendar file: ")
878 (icalendar--dmsg "yearly %s" entry-main) 929 (icalendar--dmsg "yearly %s" entry-main)
879 (let* ((daypos (if european-calendar-style 1 2)) 930 (let* ((daypos (if european-calendar-style 1 2))
880 (monpos (if european-calendar-style 2 1)) 931 (monpos (if european-calendar-style 2 1))
881 (day (read (substring entry-main (match-beginning daypos) 932 (day (read (substring entry-main
933 (match-beginning daypos)
882 (match-end daypos)))) 934 (match-end daypos))))
883 (month (icalendar--get-month-number 935 (month (icalendar--get-month-number
884 (substring entry-main (match-beginning monpos) 936 (substring entry-main
937 (match-beginning monpos)
885 (match-end monpos)))) 938 (match-end monpos))))
886 (starttimestring (icalendar--diarytime-to-isotime 939 (starttimestring (icalendar--diarytime-to-isotime
887 (if (match-beginning 4) 940 (if (match-beginning 4)
@@ -910,9 +963,11 @@ FExport diary data into iCalendar file: ")
910 (match-end 9))))) 963 (match-end 9)))))
911 (when starttimestring 964 (when starttimestring
912 (unless endtimestring 965 (unless endtimestring
913 (let ((time (read (icalendar--rris "^T0?" "" 966 (let ((time (read
914 starttimestring)))) 967 (icalendar--rris "^T0?" ""
915 (setq endtimestring (format "T%06d" (+ 10000 time)))))) 968 starttimestring))))
969 (setq endtimestring (format "T%06d"
970 (+ 10000 time))))))
916 (setq contents 971 (setq contents
917 (concat "\nDTSTART;" 972 (concat "\nDTSTART;"
918 (if starttimestring "VALUE=DATE-TIME:" 973 (if starttimestring "VALUE=DATE-TIME:"
@@ -924,19 +979,20 @@ FExport diary data into iCalendar file: ")
924 "VALUE=DATE:") 979 "VALUE=DATE:")
925 ;; end is not included! shift by one day 980 ;; end is not included! shift by one day
926 (icalendar--date-to-isodate 981 (icalendar--date-to-isodate
927 (list month day 1900) (if endtimestring 0 1)) 982 (list month day 1900)
983 (if endtimestring 0 1))
928 (or endtimestring "") 984 (or endtimestring "")
929 "\nSUMMARY:" 985 "\nSUMMARY:"
930 summary 986 summary
931 "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=" 987 "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH="
932 (format "%2d" month) 988 (format "%2d" month)
933 ";BYMONTHDAY=" 989 ";BYMONTHDAY="
934 (format "%2d" day) 990 (format "%2d" day))))
935 )))
936 (unless (string= entry-rest "") 991 (unless (string= entry-rest "")
937 (setq contents (concat contents "\nDESCRIPTION:" 992 (setq contents
938 (icalendar--convert-string-for-export 993 (concat contents "\nDESCRIPTION:"
939 entry-rest))))) 994 (icalendar--convert-string-for-export
995 entry-rest)))))
940 ;; "ordinary" events, start and end time given 996 ;; "ordinary" events, start and end time given
941 ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich 997 ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich
942 ((string-match 998 ((string-match
@@ -982,9 +1038,11 @@ FExport diary data into iCalendar file: ")
982 (error "Could not parse date")) 1038 (error "Could not parse date"))
983 (when starttimestring 1039 (when starttimestring
984 (unless endtimestring 1040 (unless endtimestring
985 (let ((time (read (icalendar--rris "^T0?" "" 1041 (let ((time
986 starttimestring)))) 1042 (read (icalendar--rris "^T0?" ""
987 (setq endtimestring (format "T%06d" (+ 10000 time)))))) 1043 starttimestring))))
1044 (setq endtimestring (format "T%06d"
1045 (+ 10000 time))))))
988 (setq contents (concat 1046 (setq contents (concat
989 "\nDTSTART;" 1047 "\nDTSTART;"
990 (if starttimestring "VALUE=DATE-TIME:" 1048 (if starttimestring "VALUE=DATE-TIME:"
@@ -1004,9 +1062,10 @@ FExport diary data into iCalendar file: ")
1004 summary)) 1062 summary))
1005 ;; could not parse the date 1063 ;; could not parse the date
1006 (unless (string= entry-rest "") 1064 (unless (string= entry-rest "")
1007 (setq contents (concat contents "\nDESCRIPTION:" 1065 (setq contents
1008 (icalendar--convert-string-for-export 1066 (concat contents "\nDESCRIPTION:"
1009 entry-rest)))))) 1067 (icalendar--convert-string-for-export
1068 entry-rest))))))
1010 ;; everything else 1069 ;; everything else
1011 (t 1070 (t
1012 ;; Oops! what's that? 1071 ;; Oops! what's that?
@@ -1023,14 +1082,17 @@ FExport diary data into iCalendar file: ")
1023 entry-main)))))) 1082 entry-main))))))
1024 1083
1025 ;; we're done, insert everything into the file 1084 ;; we're done, insert everything into the file
1026 (let ((coding-system-for-write 'utf8)) 1085 (save-current-buffer
1027 (set-buffer (find-file ical-filename)) 1086 (let ((coding-system-for-write 'utf8))
1028 (goto-char (point-max)) 1087 (set-buffer (find-file ical-filename))
1029 (insert "BEGIN:VCALENDAR") 1088 (goto-char (point-max))
1030 (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN") 1089 (insert "BEGIN:VCALENDAR")
1031 (insert "\nVERSION:2.0") 1090 (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN")
1032 (insert result) 1091 (insert "\nVERSION:2.0")
1033 (insert "\nEND:VCALENDAR\n"))) 1092 (insert result)
1093 (insert "\nEND:VCALENDAR\n")
1094 ;; save the diary file
1095 (save-buffer))))
1034 found-error)) 1096 found-error))
1035 1097
1036;; ====================================================================== 1098;; ======================================================================
@@ -1046,7 +1108,7 @@ Argument DIARY-FILENAME input `diary-file'.
1046Optional argument NON-MARKING determines whether events are created as 1108Optional argument NON-MARKING determines whether events are created as
1047non-marking or not." 1109non-marking or not."
1048 (interactive "fImport iCalendar data from file: 1110 (interactive "fImport iCalendar data from file:
1049Finto diary file: 1111Finto diary file:
1050p") 1112p")
1051 ;; clean up the diary file 1113 ;; clean up the diary file
1052 (save-current-buffer 1114 (save-current-buffer
@@ -1070,8 +1132,9 @@ DO-NOT-ASK is set to t, so that you are asked fore each event.
1070NON-MARKING determines whether diary events are created as 1132NON-MARKING determines whether diary events are created as
1071non-marking. 1133non-marking.
1072 1134
1073This function attempts to notify about problems that occur when 1135Return code t means that importing worked well, return code nil
1074reading, parsing, or converting iCalendar data!" 1136means that an error has occured. Error messages will be in the
1137buffer `*icalendar-errors*'."
1075 (interactive) 1138 (interactive)
1076 (save-current-buffer 1139 (save-current-buffer
1077 ;; prepare ical 1140 ;; prepare ical
@@ -1097,13 +1160,12 @@ reading, parsing, or converting iCalendar data!"
1097 (set-buffer (find-buffer-visiting diary-file)) 1160 (set-buffer (find-buffer-visiting diary-file))
1098 (save-buffer))) 1161 (save-buffer)))
1099 (message "Converting icalendar...done") 1162 (message "Converting icalendar...done")
1100 (if (and ical-errors (y-or-n-p 1163 ;; return t if no error occured
1101 (concat "Something went wrong -- " 1164 (not ical-errors))
1102 "do you want to see the "
1103 "error log? ")))
1104 (switch-to-buffer " *icalendar-errors*")))
1105 (message 1165 (message
1106 "Current buffer does not contain icalendar contents!")))) 1166 "Current buffer does not contain icalendar contents!")
1167 ;; return nil, i.e. import did not work
1168 nil)))
1107 1169
1108(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) 1170(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
1109(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) 1171(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
@@ -1163,10 +1225,8 @@ written into the buffer ` *icalendar-errors*'."
1163 (condition-case error-val 1225 (condition-case error-val
1164 (let* ((dtstart (icalendar--decode-isodatetime 1226 (let* ((dtstart (icalendar--decode-isodatetime
1165 (icalendar--get-event-property e 'DTSTART))) 1227 (icalendar--get-event-property e 'DTSTART)))
1166 (start-d (calendar-date-string 1228 (start-d (icalendar--datetime-to-diary-date
1167 (icalendar--datetime-to-noneuropean-date 1229 dtstart))
1168 dtstart)
1169 t t))
1170 (start-t (icalendar--datetime-to-colontime dtstart)) 1230 (start-t (icalendar--datetime-to-colontime dtstart))
1171 (dtend (icalendar--decode-isodatetime 1231 (dtend (icalendar--decode-isodatetime
1172 (icalendar--get-event-property e 'DTEND))) 1232 (icalendar--get-event-property e 'DTEND)))
@@ -1179,6 +1239,13 @@ written into the buffer ` *icalendar-errors*'."
1179 (rdate (icalendar--get-event-property e 'RDATE)) 1239 (rdate (icalendar--get-event-property e 'RDATE))
1180 (duration (icalendar--get-event-property e 'DURATION))) 1240 (duration (icalendar--get-event-property e 'DURATION)))
1181 (icalendar--dmsg "%s: %s" start-d subject) 1241 (icalendar--dmsg "%s: %s" start-d subject)
1242 ;; check whether start-time is missing
1243 (if (and (icalendar--get-event-property-attributes
1244 e 'DTSTART)
1245 (string= (cadr (icalendar--get-event-property-attributes
1246 e 'DTSTART))
1247 "DATE"))
1248 (setq start-t nil))
1182 (when duration 1249 (when duration
1183 (let ((dtend2 (icalendar--add-decoded-times 1250 (let ((dtend2 (icalendar--add-decoded-times
1184 dtstart 1251 dtstart
@@ -1188,10 +1255,7 @@ written into the buffer ` *icalendar-errors*'."
1188 subject)) 1255 subject))
1189 (setq dtend dtend2))) 1256 (setq dtend dtend2)))
1190 (setq end-d (if dtend 1257 (setq end-d (if dtend
1191 (calendar-date-string 1258 (icalendar--datetime-to-diary-date dtend)
1192 (icalendar--datetime-to-noneuropean-date
1193 dtend)
1194 t t)
1195 start-d)) 1259 start-d))
1196 (setq end-t (if dtend 1260 (setq end-t (if dtend
1197 (icalendar--datetime-to-colontime dtend) 1261 (icalendar--datetime-to-colontime dtend)
@@ -1202,51 +1266,96 @@ written into the buffer ` *icalendar-errors*'."
1202 (rrule 1266 (rrule
1203 (icalendar--dmsg "recurring event") 1267 (icalendar--dmsg "recurring event")
1204 (let* ((rrule-props (icalendar--split-value rrule)) 1268 (let* ((rrule-props (icalendar--split-value rrule))
1205 (frequency (car (cdr (assoc 'FREQ rrule-props)))) 1269 (frequency (cadr (assoc 'FREQ rrule-props)))
1206 (until (car (cdr (assoc 'UNTIL rrule-props)))) 1270 (until (cadr (assoc 'UNTIL rrule-props)))
1207 (interval (read (car (cdr (assoc 'INTERVAL 1271 (interval (read (cadr (assoc 'INTERVAL rrule-props)))))
1208 rrule-props))))))
1209 (cond ((string-equal frequency "WEEKLY") 1272 (cond ((string-equal frequency "WEEKLY")
1210 (if (not start-t) 1273 (if (not start-t)
1211 (progn 1274 (progn
1212 ;; weekly and all-day 1275 ;; weekly and all-day
1213 (icalendar--dmsg "weekly all-day") 1276 (icalendar--dmsg "weekly all-day")
1277 (if until
1278 (let ((fro
1279 (icalendar--datetime-to-diary-date
1280 (icalendar--decode-isodatetime
1281 (icalendar--get-event-property
1282 e
1283 'DTSTART))))
1284 (unt
1285 (icalendar--datetime-to-diary-date
1286 (icalendar--decode-isodatetime
1287 until))))
1214 (setq diary-string 1288 (setq diary-string
1215 (format 1289 (format
1216 "%%%%(diary-cyclic %d %s)" 1290 (concat "%%%%(and "
1291 "(diary-cyclic %d %s) "
1292 "(diary-block %s %s))")
1217 (* interval 7) 1293 (* interval 7)
1218 (icalendar--datetime-to-european-date 1294 (icalendar--datetime-to-diary-date
1219 dtstart)))) 1295 dtstart)
1296 (icalendar--datetime-to-diary-date
1297 dtstart)
1298 (icalendar--datetime-to-diary-date
1299 (icalendar--decode-isodatetime
1300 until)))))
1301 (setq diary-string
1302 (format "%%%%(and (diary-cyclic %d %s))"
1303 (* interval 7)
1304 (icalendar--datetime-to-diary-date
1305 dtstart))))
1306 (setq event-ok t))
1220 ;; weekly and not all-day 1307 ;; weekly and not all-day
1221 (let* ((byday (cadr (assoc 'BYDAY rrule-props))) 1308 (let* ((byday (cadr (assoc 'BYDAY rrule-props)))
1222 (weekday 1309 (weekday
1223 (icalendar--get-weekday-number byday))) 1310 (icalendar--get-weekday-number byday)))
1224 (icalendar--dmsg "weekly not-all-day") 1311 (icalendar--dmsg "weekly not-all-day")
1225 (if (> weekday -1) 1312 (if until
1226 (setq diary-string 1313 (let ((fro
1227 (format "%s %s%s%s" 1314 (icalendar--datetime-to-diary-date
1228 (aref calendar-day-name-array 1315 (icalendar--decode-isodatetime
1229 weekday) 1316 (icalendar--get-event-property
1230 start-t (if end-t "-" "") 1317 e
1231 (or end-t ""))) 1318 'DTSTART))))
1319 (unt
1320 (icalendar--datetime-to-diary-date
1321 (icalendar--decode-isodatetime
1322 until))))
1323 (setq diary-string
1324 (format
1325 (concat "%%%%(and "
1326 "(diary-cyclic %d %s) "
1327 "(diary-block %s %s)) "
1328 "%s%s%s")
1329 (* interval 7)
1330 (icalendar--datetime-to-diary-date
1331 dtstart)
1332 (icalendar--datetime-to-diary-date
1333 dtstart)
1334 (icalendar--datetime-to-diary-date
1335 (icalendar--decode-isodatetime
1336 until))
1337 start-t
1338 (if end-t "-" "") (or end-t ""))))
1339 ;; no limit
1232 ;; FIXME!!!! 1340 ;; FIXME!!!!
1233 ;; DTSTART;VALUE=DATE-TIME:20030919T090000 1341 ;; DTSTART;VALUE=DATE-TIME:20030919T090000
1234 ;; DTEND;VALUE=DATE-TIME:20030919T113000 1342 ;; DTEND;VALUE=DATE-TIME:20030919T113000
1235 (setq diary-string 1343 (setq diary-string
1236 (format 1344 (format
1237 "%%%%(diary-cyclic %s %s) %s%s%s" 1345 "%%%%(and (diary-cyclic %s %s)) %s%s%s"
1238 (* interval 7) 1346 (* interval 7)
1239 (icalendar--datetime-to-european-date 1347 (icalendar--datetime-to-diary-date
1240 dtstart) 1348 dtstart)
1241 start-t (if end-t "-" "") (or end-t "")))) 1349 start-t
1350 (if end-t "-" "") (or end-t ""))))
1242 (setq event-ok t)))) 1351 (setq event-ok t))))
1243 ;; yearly 1352 ;; yearly
1244 ((string-equal frequency "YEARLY") 1353 ((string-equal frequency "YEARLY")
1245 (icalendar--dmsg "yearly") 1354 (icalendar--dmsg "yearly")
1246 (setq diary-string 1355 (setq diary-string
1247 (format 1356 (format
1248 "%%%%(diary-anniversary %s)" 1357 "%%%%(and (diary-anniversary %s))"
1249 (icalendar--datetime-to-european-date dtstart))) 1358 (icalendar--datetime-to-diary-date dtstart)))
1250 (setq event-ok t)) 1359 (setq event-ok t))
1251 ;; FIXME: war auskommentiert: 1360 ;; FIXME: war auskommentiert:
1252 ((and (string-equal frequency "DAILY") 1361 ((and (string-equal frequency "DAILY")
@@ -1254,20 +1363,40 @@ written into the buffer ` *icalendar-errors*'."
1254 ;;(not start-t) 1363 ;;(not start-t)
1255 ;;(not end-t) 1364 ;;(not end-t)
1256 ) 1365 )
1257 (let ((ds (icalendar--datetime-to-noneuropean-date 1366 (let ((ds (icalendar--datetime-to-diary-date
1258 (icalendar--decode-isodatetime 1367 (icalendar--decode-isodatetime
1259 (icalendar--get-event-property e 1368 (icalendar--get-event-property
1260 'DTSTART)))) 1369 e 'DTSTART))))
1261 (de (icalendar--datetime-to-noneuropean-date 1370 (de (icalendar--datetime-to-diary-date
1262 (icalendar--decode-isodatetime 1371 (icalendar--decode-isodatetime
1263 until)))) 1372 until))))
1264 (setq diary-string 1373 (setq diary-string
1265 (format 1374 (format
1266 "%%%%(diary-block %d %d %d %d %d %d)" 1375 "%%%%(and (diary-block %s %s))"
1267 (nth 1 ds) (nth 0 ds) (nth 2 ds) 1376 ds de)))
1268 (nth 1 de) (nth 0 de) (nth 2 de)))) 1377 (setq event-ok t))))
1269 (setq event-ok t))) 1378 ;; Handle exceptions from recurrence rules
1270 )) 1379 (let ((ex-dates (icalendar--get-event-properties e
1380 'EXDATE)))
1381 (while ex-dates
1382 (let* ((ex-start (icalendar--decode-isodatetime
1383 (car ex-dates)))
1384 (ex-d (icalendar--datetime-to-diary-date
1385 ex-start)))
1386 (setq diary-string
1387 (icalendar--rris "^%%(\\(and \\)?"
1388 (format
1389 "%%%%(and (not (diary-date %s)) "
1390 ex-d)
1391 diary-string)))
1392 (setq ex-dates (cdr ex-dates))))
1393 ;; FIXME: exception rules are not recognized
1394 (if (icalendar--get-event-property e 'EXRULE)
1395 (setq diary-string
1396 (concat diary-string
1397 "\n Exception rules: "
1398 (icalendar--get-event-properties
1399 e 'EXRULE)))))
1271 (rdate 1400 (rdate
1272 (icalendar--dmsg "rdate event") 1401 (icalendar--dmsg "rdate event")
1273 (setq diary-string "") 1402 (setq diary-string "")
@@ -1280,28 +1409,34 @@ written into the buffer ` *icalendar-errors*'."
1280 ;; long event 1409 ;; long event
1281 ((not (string= start-d end-d)) 1410 ((not (string= start-d end-d))
1282 (icalendar--dmsg "non-recurring event") 1411 (icalendar--dmsg "non-recurring event")
1283 (let ((ds (icalendar--datetime-to-noneuropean-date dtstart)) 1412 (let ((ds (icalendar--datetime-to-diary-date dtstart))
1284 (de (icalendar--datetime-to-noneuropean-date dtend))) 1413 (de (icalendar--datetime-to-diary-date dtend)))
1285 (setq diary-string 1414 (setq diary-string
1286 (format "%%%%(diary-block %d %d %d %d %d %d)" 1415 (format "%%%%(and (diary-block %s %s))"
1287 (nth 1 ds) (nth 0 ds) (nth 2 ds) 1416 ds de)))
1288 (nth 1 de) (nth 0 de) (nth 2 de))))
1289 (setq event-ok t)) 1417 (setq event-ok t))
1290 ;; not all-day 1418 ;; not all-day
1291 ((and start-t (or (not end-t) 1419 ((and start-t (or (not end-t)
1292 (not (string= start-t end-t)))) 1420 (not (string= start-t end-t))))
1293 (icalendar--dmsg "not all day event") 1421 (icalendar--dmsg "not all day event")
1294 (cond (end-t 1422 (cond (end-t
1295 (setq diary-string (format "%s %s-%s" start-d 1423 (setq diary-string
1296 start-t end-t))) 1424 (format "%s %s-%s"
1425 (icalendar--datetime-to-diary-date
1426 dtstart "/")
1427 start-t end-t)))
1297 (t 1428 (t
1298 (setq diary-string (format "%s %s" start-d 1429 (setq diary-string
1299 start-t)))) 1430 (format "%s %s"
1431 (icalendar--datetime-to-diary-date
1432 dtstart "/")
1433 start-t))))
1300 (setq event-ok t)) 1434 (setq event-ok t))
1301 ;; all-day event 1435 ;; all-day event
1302 (t 1436 (t
1303 (icalendar--dmsg "all day event") 1437 (icalendar--dmsg "all day event")
1304 (setq diary-string start-d) 1438 (setq diary-string (icalendar--datetime-to-diary-date
1439 dtstart "/"))
1305 (setq event-ok t))) 1440 (setq event-ok t)))
1306 ;; add all other elements unless the user doesn't want to have 1441 ;; add all other elements unless the user doesn't want to have
1307 ;; them 1442 ;; them
@@ -1318,12 +1453,14 @@ written into the buffer ` *icalendar-errors*'."
1318 (setq error-string 1453 (setq error-string
1319 (format "%s\nCannot handle this event:%s" 1454 (format "%s\nCannot handle this event:%s"
1320 error-string e)))) 1455 error-string e))))
1456 ;; FIXME: inform user about ignored event properties
1321 ;; handle errors 1457 ;; handle errors
1322 (error 1458 (error
1323 (message "Ignoring event \"%s\"" e) 1459 (message "Ignoring event \"%s\"" e)
1324 (setq found-error t) 1460 (setq found-error t)
1325 (setq error-string (format "%s\nCannot handle this event: %s" 1461 (setq error-string (format "%s\n%s\nCannot handle this event: %s"
1326 error-string e))))) 1462 error-val error-string e))
1463 (message error-string))))
1327 (if found-error 1464 (if found-error
1328 (save-current-buffer 1465 (save-current-buffer
1329 (set-buffer (get-buffer-create " *icalendar-errors*")) 1466 (set-buffer (get-buffer-create " *icalendar-errors*"))
@@ -1340,7 +1477,7 @@ determines whether diary events are created as non-marking. If
1340SUBJECT is not nil it must be a string that gives the subject of the 1477SUBJECT is not nil it must be a string that gives the subject of the
1341entry. In this case the user will be asked whether he wants to insert 1478entry. In this case the user will be asked whether he wants to insert
1342the entry." 1479the entry."
1343 (when (or (not subject) ; 1480 (when (or (not subject)
1344 (y-or-n-p (format "Add appointment for `%s' to diary? " 1481 (y-or-n-p (format "Add appointment for `%s' to diary? "
1345 subject))) 1482 subject)))
1346 (when subject 1483 (when subject