From: Ulf Jasper Date: Sun, 10 Aug 2014 17:48:51 +0000 (+0200) Subject: iCalendar export: Enumerate evaluated sexp diary entries (Bug#7911). X-Git-Tag: emacs-25.0.90~2635^2~679^2~489 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d4ed7004f510237849d080000930889c4a54e73d;p=emacs.git iCalendar export: Enumerate evaluated sexp diary entries (Bug#7911). 2014-08-10 Ulf Jasper Enumerate evaluated sexp diary entries (Bug#7911). * calendar/icalendar.el (icalendar-export-sexp-enumerate-all) (icalendar-export-sexp-enumeration-days): New (icalendar-export-region): `icalendar--convert-to-ical' now returns a cons cell or a list of cons cells. (icalendar--convert-to-ical): Take care of `icalendar-export-sexp-enumerate-all'. Return (a list of) cons cells. (icalendar--convert-ordinary-to-ical), (icalendar--convert-weekly-to-ical), (icalendar--convert-yearly-to-ical), (icalendar--convert-block-to-ical), (icalendar--convert-block-to-ical), (icalendar--convert-float-to-ical), (icalendar--convert-cyclic-to-ical), (icalendar--convert-anniversary-to-ical): Return cons cell. (icalendar--convert-sexp-to-ical): Enumerate evaluated sexp entries. Return (list of) cons cells. 2014-08-10 Ulf Jasper Enumerate evaluated sexp diary entries (Bug#7911). * automated/icalendar-tests.el (icalendar--convert-anniversary-to-ical), (icalendar--convert-cyclic-to-ical), (icalendar--convert-block-to-ical), (icalendar--convert-yearly-to-ical), (icalendar--convert-weekly-to-ical), (icalendar--convert-ordinary-to-ical): Returns cons cell now. (icalendar--convert-to-ical), (icalendar--convert-sexp-to-ical): New tests. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b0a0e0c95a0..8cf5e0f54c9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,25 @@ +2014-08-10 Ulf Jasper + + Enumerate evaluated sexp diary entries (Bug#7911). + + * calendar/icalendar.el (icalendar-export-sexp-enumerate-all) + (icalendar-export-sexp-enumeration-days): New + (icalendar-export-region): `icalendar--convert-to-ical' now + returns a cons cell or a list of cons cells. + (icalendar--convert-to-ical): Take care of + `icalendar-export-sexp-enumerate-all'. Return (a list of) cons + cells. + (icalendar--convert-ordinary-to-ical), + (icalendar--convert-weekly-to-ical), + (icalendar--convert-yearly-to-ical), + (icalendar--convert-block-to-ical), + (icalendar--convert-block-to-ical), + (icalendar--convert-float-to-ical), + (icalendar--convert-cyclic-to-ical), + (icalendar--convert-anniversary-to-ical): Return cons cell. + (icalendar--convert-sexp-to-ical): Enumerate evaluated sexp + entries. Return (list of) cons cells. + 2014-08-09 Juri Linkov * vc/vc-annotate.el (vc-annotate-background-mode): Add :set diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index ba4ff1c1fa8..8881796c94b 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -240,6 +240,31 @@ code for the event, and your personal domain name." :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.") @@ -1027,40 +1052,48 @@ FExport diary data into iCalendar file: ") (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) @@ -1092,16 +1125,18 @@ FExport diary data into iCalendar file: ") 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 @@ -1300,7 +1335,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." (- time 230000))) (setq endisostring1 endisostring)) ))) - (list (concat "\nDTSTART;" + (cons (concat "\nDTSTART;" (if starttimestring "VALUE=DATE-TIME:" "VALUE=DATE:") startisostring @@ -1381,7 +1416,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." starttimestring)))) (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (list (concat "\nDTSTART;" + (cons (concat "\nDTSTART;" (if starttimestring "VALUE=DATE-TIME:" "VALUE=DATE:") @@ -1468,7 +1503,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." 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) @@ -1489,13 +1524,16 @@ entries. ENTRY-MAIN is the first line of the diary entry." ;; 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) @@ -1508,10 +1546,37 @@ entries. ENTRY-MAIN is the first line of the diary entry." (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))) @@ -1576,7 +1641,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." (+ 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:" @@ -1586,7 +1651,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." 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 @@ -1622,7 +1687,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." (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)) @@ -1727,7 +1792,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." starttimestring)))) (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (list (concat "\nDTSTART;" + (cons (concat "\nDTSTART;" (if starttimestring "VALUE=DATE-TIME:" "VALUE=DATE:") startisostring @@ -1796,7 +1861,7 @@ entries. ENTRY-MAIN is the first line of the diary entry." starttimestring)))) (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (list (concat "\nDTSTART;" + (cons (concat "\nDTSTART;" (if starttimestring "VALUE=DATE-TIME:" "VALUE=DATE:") startisostring diff --git a/test/ChangeLog b/test/ChangeLog index 9ca9353a72f..9dcc91d3646 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,18 @@ +2014-08-10 Ulf Jasper + + Enumerate evaluated sexp diary entries (Bug#7911). + + * automated/icalendar-tests.el + (icalendar--convert-anniversary-to-ical), + (icalendar--convert-cyclic-to-ical), + (icalendar--convert-block-to-ical), + (icalendar--convert-yearly-to-ical), + (icalendar--convert-weekly-to-ical), + (icalendar--convert-ordinary-to-ical): Returns cons cell now. + (icalendar--convert-to-ical), + (icalendar--convert-sexp-to-ical): New tests. + + 2014-08-07 Glenn Morris * automated/Makefile.in (check-tar): Remove, hydra recipe does it now. diff --git a/test/automated/icalendar-tests.el b/test/automated/icalendar-tests.el index a3971989831..9598e89ca22 100644 --- a/test/automated/icalendar-tests.el +++ b/test/automated/icalendar-tests.el @@ -98,13 +98,13 @@ 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'." @@ -112,12 +112,12 @@ 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'." @@ -125,12 +125,12 @@ 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'." @@ -140,13 +140,13 @@ ["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'." @@ -156,12 +156,49 @@ ["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'." @@ -215,37 +252,37 @@ END: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'."