summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2015-10-31 18:52:13 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2015-10-31 22:26:13 +0100
commite6ac458988f586f6f3080ea487382aefcb4b0e9e (patch)
tree3d1914269429799f23b5cb18284268820f5ef68a
parent6e6b19bc96cde727e1a9ff6ca112f41ef37df1ab (diff)
downloadorg-mode-e6ac458988f586f6f3080ea487382aefcb4b0e9e.tar.gz
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>
-rw-r--r--lisp/org-agenda.el25
-rwxr-xr-xlisp/org.el21
2 files changed, 33 insertions, 13 deletions
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index c2a1f93..59aa2a5 100644
--- a/lisp/org-agenda.el
+++ b/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
diff --git a/lisp/org.el b/lisp/org.el
index 30c27d3..6c72b25 100755
--- a/lisp/org.el
+++ b/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