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>
This commit is contained in:
Nicolas Goaziou 2015-10-31 18:52:13 +01:00
parent 6e6b19bc96
commit e6ac458988
2 changed files with 33 additions and 13 deletions

View File

@ -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

View File

@ -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