Browse Source

org-agenda: Fix diary sexp timestamps

* lisp/org-agenda.el (org-agenda--timestamp-to-absolute): New function.
(org-agenda-get-timestamps):
(org-agenda-get-deadlines):
(org-agenda-get-scheduled): Use new function.

* lisp/org.el (org-diary-sexp-no-match): New error.
(org-time-string-to-absolute): Raise an error when a diary sexp cannot
match instead of returning a nonsensical value.

Reported-by: "Stefan-W. Hahn" <stefan.hahn@s-hahn.de>
<http://permalink.gmane.org/gmane.emacs.orgmode/102417>
Nicolas Goaziou 9 years ago
parent
commit
e6ac458988
2 changed files with 33 additions and 13 deletions
  1. 18 7
      lisp/org-agenda.el
  2. 15 6
      lisp/org.el

+ 18 - 7
lisp/org-agenda.el

@@ -5307,6 +5307,16 @@ function from a program - use `org-agenda-get-day-entries' instead."
 
 ;;; Agenda entry finders
 
+(defun org-agenda--timestamp-to-absolute (&rest args)
+  "Call `org-time-string-to-absolute' with ARGS.
+However, throw `:skip' whenever an error is raised."
+  (condition-case e
+      (apply #'org-time-string-to-absolute args)
+    (org-diary-sexp-no-match (throw :skip nil))
+    (error
+     (message "%s; Skipping entry" (error-message-string e))
+     (throw :skip nil))))
+
 (defun org-agenda-get-day-entries (file date &rest args)
   "Does the work for `org-diary' and `org-agenda'.
 FILE is the path to a file to be checked for entries.  DATE is date like
@@ -5608,7 +5618,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
 	(and (org-at-date-range-p) (throw :skip nil))
 	(org-agenda-skip)
 	(if (and (match-end 1)
-		 (not (= d1 (org-time-string-to-absolute
+		 (not (= d1 (org-agenda--timestamp-to-absolute
 			     (match-string 1) d1 nil show-all
 			     (current-buffer) b0))))
 	    (throw :skip nil))
@@ -6062,7 +6072,7 @@ specification like [h]h:mm."
 	      show-all (or (eq org-agenda-repeating-timestamp-show-all t)
 			   (member todo-state
 				   org-agenda-repeating-timestamp-show-all))
-	      d2 (org-time-string-to-absolute
+	      d2 (org-agenda--timestamp-to-absolute
 		  s d1 'past show-all (current-buffer) pos)
 	      diff (- d2 d1))
 	(setq suppress-prewarning
@@ -6083,7 +6093,7 @@ specification like [h]h:mm."
 		 ((eq org-agenda-skip-deadline-prewarning-if-scheduled
 		      'pre-scheduled)
 		  ;; Set prewarning to no earlier than scheduled.
-		  (min (- d2 (org-time-string-to-absolute
+		  (min (- d2 (org-agenda--timestamp-to-absolute
 			      ds d1 'past show-all (current-buffer) pos))
 		       org-deadline-warning-days))
 		 ;; Set prewarning to deadline.
@@ -6136,7 +6146,8 @@ specification like [h]h:mm."
 			 ;; time difference since date S, not since
 			 ;; closest repeater.
 			 (let ((diff (if (< (org-today) d1) diff
-				       (- (org-time-string-to-absolute s) d1))))
+				       (- (org-agenda--timestamp-to-absolute s)
+					  d1))))
 			   (cond ((= diff 0) dl0)
 				 ((> diff 0)
 				  (if (functionp dl1)
@@ -6214,9 +6225,9 @@ scheduled items with an hour specification like [h]h:mm."
 	       ;; contains a repeater and SHOW-ALL is non-nil,
 	       ;; LAST-REPEAT is the repeat closest to CURRENT.
 	       ;; Otherwise, LAST-REPEAT is equal to SCHEDULE.
-	       (last-repeat (org-time-string-to-absolute
+	       (last-repeat (org-agenda--timestamp-to-absolute
 			     s current 'past show-all (current-buffer) pos))
-	       (schedule (org-time-string-to-absolute s))
+	       (schedule (org-agenda--timestamp-to-absolute s current))
 	       (diff (- last-repeat current))
 	       (warntime (get-text-property (point) 'org-appt-warntime))
 	       (pastschedp (< schedule (org-today)))
@@ -6237,7 +6248,7 @@ scheduled items with an hour specification like [h]h:mm."
 		    ;; DEADLINE has a repeater, compare last schedule
 		    ;; repeat and last deadline repeat.
 		    (min (- last-repeat
-			    (org-time-string-to-absolute
+			    (org-agenda--timestamp-to-absolute
 			     deadline current 'past show-all
 			     (current-buffer)
 			     (save-excursion

+ 15 - 6
lisp/org.el

@@ -17646,6 +17646,8 @@ days in order to avoid rounding problems."
   "Convert a timestamp string to a number of seconds."
   (org-float-time (org-time-string-to-time s)))
 
+(org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp")
+
 (defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos)
   "Convert time stamp S to an absolute day number.
 
@@ -17654,15 +17656,22 @@ stamp, get the closest date to DAYNR.  If PREFER is
 `past' (respectively `future') return a date past (respectively
 after) or equal to DAYNR.
 
-POS is the location of time stamp S, as a buffer position.
+POS is the location of time stamp S, as a buffer position in
+BUFFER.
 
-The variable `date' is bound by the calendar when this is
-called."
+Diary sexp timestamps are matched against DAYNR, when non-nil.
+If matching fails or DAYNR is nil, `org-diary-sexp-no-match' is
+signalled."
   (cond
-   ((and daynr (string-match "\\`%%\\((.*)\\)" s))
-    (if (org-diary-sexp-entry (match-string 1 s) "" date)
+   ((string-match "\\`%%\\((.*)\\)" s)
+    ;; Sexp timestamp: try to match DAYNR, if available, since we're
+    ;; only able to match individual dates.  If it fails, raise an
+    ;; error.
+    (if (and daynr
+	     (org-diary-sexp-entry
+	      (match-string 1 s) "" (calendar-gregorian-from-absolute daynr)))
 	daynr
-      (+ daynr 1000)))
+      (signal 'org-diary-sexp-no-match (list s))))
    ((and daynr show-all) (org-closest-date s daynr prefer))
    (t (time-to-days
        (condition-case errdata