diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2015-10-31 18:52:13 +0100 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2015-10-31 22:26:13 +0100 |
commit | e6ac458988f586f6f3080ea487382aefcb4b0e9e (patch) | |
tree | 3d1914269429799f23b5cb18284268820f5ef68a | |
parent | 6e6b19bc96cde727e1a9ff6ca112f41ef37df1ab (diff) | |
download | org-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.el | 25 | ||||
-rwxr-xr-x | lisp/org.el | 21 |
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 |