forked from mirrors/org-mode
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:
parent
6e6b19bc96
commit
e6ac458988
|
@ -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
|
||||
|
|
21
lisp/org.el
21
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
|
||||
|
|
Loading…
Reference in New Issue