:type 'string
:group 'icalendar)
+(defcustom icalendar-export-sexp-enumeration-days
+ 14
+ "Number of days over which a sexp diary entry is enumerated.
+In general sexp entries cannot be translated to icalendar format.
+They are therefore enumerated, i.e. explicitly evaluated for a
+certain number of days, and then exported. The enumeration starts
+on the current day and continues for the number of days given here.
+
+See `icalendar-export-sexp-enumerate-all' for a list of sexp
+entries which by default are NOT enumerated."
+ :type 'integer
+ :group 'icalendar)
+
+(defcustom icalendar-export-sexp-enumerate-all
+ nil
+ "Determines whether ALL sexp diary entries are enumerated.
+If non-nil all sexp diary entries are enumerated for
+`icalendar-export-sexp-enumeration-days' days instead of
+translating into an icalendar equivalent. This affects the
+following sexp diary entries: `diary-anniversary',
+`diary-cyclic', `diary-date', `diary-float',`diary-block'. All
+other sexp entries are enumerated in any case."
+ :type 'boolean
+ :group 'icalendar)
+
(defvar icalendar-debug nil
"Enable icalendar debug messages.")
(condition-case error-val
(progn
- (setq contents-n-summary
+ (setq cns-cons-or-list
(icalendar--convert-to-ical nonmarker entry-main))
(setq other-elements (icalendar--parse-summary-and-rest
entry-full))
- (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)))
- (uid (cdr (assoc 'uid 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 header (concat "\nBEGIN:VEVENT\nUID:"
- (or uid
- (icalendar--create-uid entry-full
- contents)))))
- (setq result (concat result header contents "\nEND:VEVENT")))
+ (mapc (lambda (contents-n-summary)
+ (setq contents (concat (car contents-n-summary)
+ "\nSUMMARY:"
+ (cdr 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)))
+ (uid (cdr (assoc 'uid 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 header (concat "\nBEGIN:VEVENT\nUID:"
+ (or uid
+ (icalendar--create-uid
+ entry-full contents)))))
+ (setq result (concat result header contents
+ "\nEND:VEVENT")))
+ (if (consp cns-cons-or-list)
+ (list cns-cons-or-list)
+ cns-cons-or-list)))
;; handle errors
(error
(setq found-error t)
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)
+ (unless icalendar-export-sexp-enumerate-all
+ (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
(- time 230000)))
(setq endisostring1 endisostring)) )))
- (list (concat "\nDTSTART;"
+ (cons (concat "\nDTSTART;"
(if starttimestring "VALUE=DATE-TIME:"
"VALUE=DATE:")
startisostring
starttimestring))))
(setq endtimestring (format "T%06d"
(+ 10000 time))))))
- (list (concat "\nDTSTART;"
+ (cons (concat "\nDTSTART;"
(if starttimestring
"VALUE=DATE-TIME:"
"VALUE=DATE:")
starttimestring))))
(setq endtimestring (format "T%06d"
(+ 10000 time))))))
- (list (concat "\nDTSTART;"
+ (cons (concat "\nDTSTART;"
(if starttimestring "VALUE=DATE-TIME:"
"VALUE=DATE:")
(format "1900%02d%02d" month day)
;; no match
nil))
-(defun icalendar--convert-sexp-to-ical (nonmarker entry-main)
- "Convert complex sexp diary entry to iCalendar format -- unsupported!
+(defun icalendar--convert-sexp-to-ical (nonmarker entry-main &optional start)
+ "Convert sexp diary entry to iCalendar format.
+Enumerate the evaluated sexp entry for the next
+`icalendar-export-sexp-enumeration-days' days. NONMARKER is a
+regular expression matching the start of non-marking entries.
+ENTRY-MAIN is the first line of the diary entry.
-FIXME!
-
-NONMARKER is a regular expression matching the start of non-marking
-entries. ENTRY-MAIN is the first line of the diary entry."
+Optional argument START determines the first day of the
+enumeration, given as a time value, in same format as returned by
+`current-time' -- used for test purposes."
(cond ((string-match (concat nonmarker
"%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$")
entry-main)
(substring entry-main (match-beginning 1) (match-end 1))
(substring entry-main (match-beginning 2) (match-end 2)))))
((string-match (concat nonmarker
- "%%([^)]+)\\s-*.*")
+ "%%\\(([^)]+)\\)\\s-*\\(.*\\)")
entry-main)
+ ;; regular sexp entry
(icalendar--dmsg "diary-sexp %s" entry-main)
- (error "Sexp-entries are not supported yet"))
+ (let ((p1 (substring entry-main (match-beginning 1) (match-end 1)))
+ (p2 (substring entry-main (match-beginning 2) (match-end 2)))
+ (now (or start (current-time))))
+ (delete nil
+ (mapcar
+ (lambda (offset)
+ (let* ((day (decode-time (time-add now
+ (seconds-to-time
+ (* offset 60 60 24)))))
+ (d (nth 3 day))
+ (m (nth 4 day))
+ (y (nth 5 day))
+ (se (diary-sexp-entry p1 p2 (list m d y)))
+ (see (cond ((stringp se) se)
+ ((consp se) (cdr se))
+ (t nil))))
+ (cond ((null see)
+ nil)
+ ((stringp see)
+ (let ((calendar-date-style 'iso))
+ (icalendar--convert-ordinary-to-ical
+ nonmarker (format "%4d/%02d/%02d %s" y m d see))))
+ (;TODO:
+ (error (format "Unsopported Sexp-entry: %s"
+ entry-main))))))
+ (number-sequence
+ 0 (- icalendar-export-sexp-enumeration-days 1))))))
(t
;; no match
nil)))
(+ 10000 time))))))
(if starttimestring
;; with time -> write rrule
- (list (concat "\nDTSTART;VALUE=DATE-TIME:"
+ (cons (concat "\nDTSTART;VALUE=DATE-TIME:"
startisostring
starttimestring
"\nDTEND;VALUE=DATE-TIME:"
endisostring)
summary)
;; no time -> write long event
- (list (concat "\nDTSTART;VALUE=DATE:" startisostring
+ (cons (concat "\nDTSTART;VALUE=DATE:" startisostring
"\nDTEND;VALUE=DATE:" endisostring+1)
summary)))
;; no match
(icalendar--dmsg "diary-float %s" entry-main)
(error "Don't know if or how to implement day in `diary-float'")))
- (list (concat
+ (cons (concat
;;Start today (yes this is an arbitrary choice):
"\nDTSTART;VALUE=DATE:"
(format-time-string "%Y%m%d" (current-time))
starttimestring))))
(setq endtimestring (format "T%06d"
(+ 10000 time))))))
- (list (concat "\nDTSTART;"
+ (cons (concat "\nDTSTART;"
(if starttimestring "VALUE=DATE-TIME:"
"VALUE=DATE:")
startisostring
starttimestring))))
(setq endtimestring (format "T%06d"
(+ 10000 time))))))
- (list (concat "\nDTSTART;"
+ (cons (concat "\nDTSTART;"
(if starttimestring "VALUE=DATE-TIME:"
"VALUE=DATE:")
startisostring
result)
(setq result (icalendar--convert-anniversary-to-ical
"" "%%(diary-anniversary 1964 6 30) g"))
- (should (= 2 (length result)))
+ (should (consp result))
(should (string= (concat
"\nDTSTART;VALUE=DATE:19640630"
"\nDTEND;VALUE=DATE:19640701"
"\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=06;BYMONTHDAY=30")
(car result)))
- (should (string= "g" (cadr result)))))
+ (should (string= "g" (cdr result)))))
(ert-deftest icalendar--convert-cyclic-to-ical ()
"Test method for `icalendar--convert-cyclic-to-ical'."
result)
(setq result (icalendar--convert-block-to-ical
"" "%%(diary-block 2004 7 19 2004 8 27) Sommerferien"))
- (should (= 2 (length result)))
+ (should (consp result))
(should (string= (concat
"\nDTSTART;VALUE=DATE:20040719"
"\nDTEND;VALUE=DATE:20040828")
(car result)))
- (should (string= "Sommerferien" (cadr result)))))
+ (should (string= "Sommerferien" (cdr result)))))
(ert-deftest icalendar--convert-block-to-ical ()
"Test method for `icalendar--convert-block-to-ical'."
result)
(setq result (icalendar--convert-block-to-ical
"" "%%(diary-block 2004 7 19 2004 8 27) Sommerferien"))
- (should (= 2 (length result)))
+ (should (consp result))
(should (string= (concat
"\nDTSTART;VALUE=DATE:20040719"
"\nDTEND;VALUE=DATE:20040828")
(car result)))
- (should (string= "Sommerferien" (cadr result)))))
+ (should (string= "Sommerferien" (cdr result)))))
(ert-deftest icalendar--convert-yearly-to-ical ()
"Test method for `icalendar--convert-yearly-to-ical'."
["January" "February" "March" "April" "May" "June" "July" "August"
"September" "October" "November" "December"]))
(setq result (icalendar--convert-yearly-to-ical "" "May 1 Tag der Arbeit"))
- (should (= 2 (length result)))
+ (should (consp result))
(should (string= (concat
"\nDTSTART;VALUE=DATE:19000501"
"\nDTEND;VALUE=DATE:19000502"
"\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=5;BYMONTHDAY=1")
(car result)))
- (should (string= "Tag der Arbeit" (cadr result)))))
+ (should (string= "Tag der Arbeit" (cdr result)))))
(ert-deftest icalendar--convert-weekly-to-ical ()
"Test method for `icalendar--convert-weekly-to-ical'."
["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday"
"Saturday"]))
(setq result (icalendar--convert-weekly-to-ical "" "Monday 8:30 subject"))
- (should (= 2 (length result)))
+ (should (consp result))
(should (string= (concat "\nDTSTART;VALUE=DATE-TIME:20050103T083000"
"\nDTEND;VALUE=DATE-TIME:20050103T093000"
"\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=MO")
(car result)))
- (should (string= "subject" (cadr result)))))
+ (should (string= "subject" (cdr result)))))
+
+(ert-deftest icalendar--convert-sexp-to-ical ()
+ "Test method for `icalendar--convert-sexp-to-ical'."
+ (let* (result
+ (icalendar-export-sexp-enumeration-days 3))
+ ;; test case %%(diary-hebrew-date)
+ (setq result (icalendar--convert-sexp-to-ical "" "%%(diary-hebrew-date)"))
+ (should (consp result))
+ (should (eq icalendar-export-sexp-enumeration-days (length result)))
+ (mapc (lambda (i)
+ (should (consp i))
+ (should (string-match "Hebrew date (until sunset): .*" (cdr i))))
+ result)))
+
+(ert-deftest icalendar--convert-to-ical ()
+ "Test method for `icalendar--convert-to-ical'."
+ (let* (result
+ (icalendar-export-sexp-enumerate-all t)
+ (icalendar-export-sexp-enumeration-days 3)
+ (calendar-date-style 'iso))
+ ;; test case: %%(diary-anniversary 1642 12 25) Newton
+ ;; forced enumeration not matching the actual day --> empty
+ (setq result (icalendar--convert-sexp-to-ical
+ "" "%%(diary-anniversary 1642 12 25) Newton's birthday"
+ (encode-time 1 1 1 6 12 2014)))
+ (should (null result))
+ ;; test case: %%(diary-anniversary 1642 12 25) Newton
+ ;; enumeration does match the actual day -->
+ (setq result (icalendar--convert-sexp-to-ical
+ "" "%%(diary-anniversary 1642 12 25) Newton's birthday"
+ (encode-time 1 1 1 24 12 2014)))
+ (should (= 1 (length result)))
+ (should (consp (car result)))
+ (should (string-match
+ "\nDTSTART;VALUE=DATE:20141225\nDTEND;VALUE=DATE:20141226"
+ (car (car result))))
+ (should (string-match "Newton's birthday" (cdr (car result))))))
(ert-deftest icalendar--parse-vtimezone ()
"Test method for `icalendar--parse-vtimezone'."
result)
;; without time
(setq result (icalendar--convert-ordinary-to-ical "&?" "2010 2 15 subject"))
- (should (= 2 (length result)))
+ (should (consp result))
(should (string= "\nDTSTART;VALUE=DATE:20100215\nDTEND;VALUE=DATE:20100216"
(car result)))
- (should (string= "subject" (cadr result)))
+ (should (string= "subject" (cdr result)))
;; with start time
(setq result (icalendar--convert-ordinary-to-ical
"&?" "&2010 2 15 12:34 s"))
- (should (= 2 (length result)))
+ (should (consp result))
(should (string= (concat "\nDTSTART;VALUE=DATE-TIME:20100215T123400"
"\nDTEND;VALUE=DATE-TIME:20100215T133400")
(car result)))
- (should (string= "s" (cadr result)))
+ (should (string= "s" (cdr result)))
;; with time
(setq result (icalendar--convert-ordinary-to-ical
"&?" "&2010 2 15 12:34-23:45 s"))
- (should (= 2 (length result)))
+ (should (consp result))
(should (string= (concat "\nDTSTART;VALUE=DATE-TIME:20100215T123400"
"\nDTEND;VALUE=DATE-TIME:20100215T234500")
(car result)))
- (should (string= "s" (cadr result)))
+ (should (string= "s" (cdr result)))
;; with time, again -- test bug#5549
(setq result (icalendar--convert-ordinary-to-ical
"x?" "x2010 2 15 0:34-1:45 s"))
- (should (= 2 (length result)))
+ (should (consp result))
(should (string= (concat "\nDTSTART;VALUE=DATE-TIME:20100215T003400"
"\nDTEND;VALUE=DATE-TIME:20100215T014500")
(car result)))
- (should (string= "s" (cadr result)))))
+ (should (string= "s" (cdr result)))))
(ert-deftest icalendar--diarytime-to-isotime ()
"Test method for `icalendar--diarytime-to-isotime'."
projects / emacs.git / commitdiff