Change `org-agenda-repeating-timestamp-show-all' targets
* lisp/org.el (org-closest-date): Rewrite function with less arguments. Improve readability. (org-time-string-to-absolute): Apply changes to `org-closest-date'. Improve docstring. * testing/lisp/test-org.el (test-org/closest-date): New test. This change implies specific repeaters (i.e., ".+" and "++") are no longer treated the same as regular one (i.e. "+") wrt `org-agenda-repeating-timestamp-show-all'. Indeed, only the latter represents multiple dates. The former represent another date only when TODO state changes, which could then skip some occurrences. This fixes issue raised at <http://permalink.gmane.org/gmane.emacs.orgmode/101884> and <http://article.gmane.org/gmane.emacs.orgmode/26154>.
This commit is contained in:
Nicolas Goaziou
parent
3beb530e50
commit
a427098b57
|
|
@ -9,6 +9,9 @@ See the end of the file for license conditions.
|
||||||
Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
|
Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
|
||||||
|
|
||||||
* Version 8.4
|
* Version 8.4
|
||||||
|
** Incompatible changes
|
||||||
|
*** ~org-agenda-repeating-timestamp-show-all~ is more selective
|
||||||
|
The variable only applies to ~+~ repeaters, not ~.+~ nor ~++~.
|
||||||
** New features
|
** New features
|
||||||
*** Org linter
|
*** Org linter
|
||||||
~org-lint~ can check syntax and report common issues in Org documents.
|
~org-lint~ can check syntax and report common issues in Org documents.
|
||||||
|
|
|
||||||
197
lisp/org.el
197
lisp/org.el
|
|
@ -17651,28 +17651,30 @@ days in order to avoid rounding problems."
|
||||||
(org-float-time (org-time-string-to-time s)))
|
(org-float-time (org-time-string-to-time s)))
|
||||||
|
|
||||||
(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos)
|
(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos)
|
||||||
"Convert a time stamp to an absolute day number.
|
"Convert time stamp S to an absolute day number.
|
||||||
If there is a specifier for a cyclic time stamp, get the closest
|
|
||||||
date to DAYNR.
|
If DAYNR in non-nil, and there is a specifier for a cyclic time
|
||||||
PREFER and SHOW-ALL are passed through to `org-closest-date'.
|
stamp, get the closest date to DAYNR. If PREFER is
|
||||||
The variable `date' is bound by the calendar when this is called."
|
`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.
|
||||||
|
|
||||||
|
The variable `date' is bound by the calendar when this is
|
||||||
|
called."
|
||||||
(cond
|
(cond
|
||||||
((and daynr (string-match "\\`%%\\((.*)\\)" s))
|
((and daynr (string-match "\\`%%\\((.*)\\)" s))
|
||||||
(if (org-diary-sexp-entry (match-string 1 s) "" date)
|
(if (org-diary-sexp-entry (match-string 1 s) "" date)
|
||||||
daynr
|
daynr
|
||||||
(+ daynr 1000)))
|
(+ daynr 1000)))
|
||||||
((and daynr (string-match "\\+\\([0-9]+\\)[hdwmy]" s)
|
((and daynr show-all) (org-closest-date s daynr prefer))
|
||||||
(> (string-to-number (match-string 1 s)) 0))
|
|
||||||
(org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr
|
|
||||||
(time-to-days (current-time))) (match-string 0 s)
|
|
||||||
prefer show-all))
|
|
||||||
(t (time-to-days
|
(t (time-to-days
|
||||||
(condition-case errdata
|
(condition-case errdata
|
||||||
(apply 'encode-time (org-parse-time-string s))
|
(apply #'encode-time (org-parse-time-string s))
|
||||||
(error (error "Bad timestamp `%s'%s\nError was: %s"
|
(error (error "Bad timestamp `%s'%s\nError was: %s"
|
||||||
s (if (not (and buffer pos))
|
s
|
||||||
""
|
(if (not (and buffer pos)) ""
|
||||||
(format-message " at %d in buffer `%s'" pos buffer))
|
(format-message " at %d in buffer `%s'" pos buffer))
|
||||||
(cdr errdata))))))))
|
(cdr errdata))))))))
|
||||||
|
|
||||||
(defun org-days-to-iso-week (days)
|
(defun org-days-to-iso-week (days)
|
||||||
|
|
@ -17752,87 +17754,98 @@ This uses the icalendar.el library."
|
||||||
(delete-file tmpfile)
|
(delete-file tmpfile)
|
||||||
rtn))
|
rtn))
|
||||||
|
|
||||||
(defun org-closest-date (start current change prefer show-all)
|
(defun org-closest-date (start current prefer)
|
||||||
"Find the date closest to CURRENT that is consistent with START and CHANGE.
|
"Return closest date to CURRENT starting from START.
|
||||||
When PREFER is `past', return a date that is either CURRENT or past.
|
|
||||||
When PREFER is `future', return a date that is either CURRENT or future.
|
|
||||||
When SHOW-ALL is nil, only return the current occurrence of a time stamp."
|
|
||||||
;; Make the proper lists from the dates
|
|
||||||
(catch 'exit
|
|
||||||
(let ((a1 '(("h" . hour)
|
|
||||||
("d" . day)
|
|
||||||
("w" . week)
|
|
||||||
("m" . month)
|
|
||||||
("y" . year)))
|
|
||||||
(shour (nth 2 (org-parse-time-string start)))
|
|
||||||
dn dw sday cday n1 n2 n0
|
|
||||||
d m y y1 y2 date1 date2 nmonths nm ny m2)
|
|
||||||
|
|
||||||
(setq start (org-date-to-gregorian start)
|
CURRENT and START are both time stamps.
|
||||||
current (org-date-to-gregorian
|
|
||||||
(if show-all
|
|
||||||
current
|
|
||||||
(time-to-days (current-time))))
|
|
||||||
sday (calendar-absolute-from-gregorian start)
|
|
||||||
cday (calendar-absolute-from-gregorian current))
|
|
||||||
|
|
||||||
(if (<= cday sday) (throw 'exit sday))
|
When PREFER is `past', return a date that is either CURRENT or
|
||||||
|
past. When PREFER is `future', return a date that is either
|
||||||
|
CURRENT or future.
|
||||||
|
|
||||||
(when (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change)
|
Only time stamps with a simple repeater (i.e., neither \"++\" nor
|
||||||
(setq dn (string-to-number (match-string 1 change))
|
\".+\") are modified. Any other time stamp stay unchanged. In
|
||||||
dw (cdr (assoc (match-string 2 change) a1))))
|
any case, return value is an absolute day number."
|
||||||
(unless (and dn (> dn 0))
|
(if (not (string-match "[^.+]\\+\\([0-9]+\\)\\([hdwmy]\\)" start))
|
||||||
(user-error "Invalid change specifier: %s" change))
|
;; No valid repeater. Do not shift time stamp.
|
||||||
(if (eq dw 'week) (setq dw 'day dn (* 7 dn)))
|
(time-to-days (apply #'encode-time (org-parse-time-string start)))
|
||||||
(cond
|
(let ((value (string-to-number (match-string 1 start)))
|
||||||
((eq dw 'hour)
|
(type (match-string 2 start)))
|
||||||
(let ((missing-hours
|
(if (= 0 value)
|
||||||
(mod (+ (- (* 24 (- cday sday)) shour) org-extend-today-until)
|
;; Repeater with a 0-value is considered as void.
|
||||||
dn)))
|
(time-to-days (apply #'encode-time (org-parse-time-string start)))
|
||||||
(setq n1 (if (zerop missing-hours) cday
|
(let* ((base (org-date-to-gregorian start))
|
||||||
(- cday (1+ (floor (/ missing-hours 24)))))
|
(target (org-date-to-gregorian current))
|
||||||
n2 (+ cday (floor (/ (- dn missing-hours) 24))))))
|
(sday (calendar-absolute-from-gregorian base))
|
||||||
((eq dw 'day)
|
(cday (calendar-absolute-from-gregorian target))
|
||||||
(setq n1 (+ sday (* dn (floor (/ (- cday sday) dn))))
|
n1 n2)
|
||||||
n2 (+ n1 dn)))
|
;; If START is already past CURRENT, just return START.
|
||||||
((eq dw 'year)
|
(if (<= cday sday) sday
|
||||||
(setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current))
|
;; Compute closest date before (N1) and closest date past
|
||||||
(setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1))
|
;; (N2) CURRENT.
|
||||||
(setq date1 (list m d y1)
|
(pcase type
|
||||||
n1 (calendar-absolute-from-gregorian date1)
|
("h"
|
||||||
date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn)))
|
(let ((missing-hours
|
||||||
n2 (calendar-absolute-from-gregorian date2)))
|
(mod (+ (- (* 24 (- cday sday))
|
||||||
((eq dw 'month)
|
(nth 2 (org-parse-time-string start)))
|
||||||
;; approx number of month between the two dates
|
org-extend-today-until)
|
||||||
(setq nmonths (floor (/ (- cday sday) 30.436875)))
|
value)))
|
||||||
;; How often does dn fit in there?
|
(setf n1 (if (= missing-hours 0) cday
|
||||||
(setq d (nth 1 start) m (car start) y (nth 2 start)
|
(- cday (1+ (/ missing-hours 24)))))
|
||||||
nm (* dn (max 0 (1- (floor (/ nmonths dn)))))
|
(setf n2 (+ cday (/ (- value missing-hours) 24)))))
|
||||||
m (+ m nm)
|
((or "d" "w")
|
||||||
ny (floor (/ m 12))
|
(let ((value (if (equal type "w") (* 7 value) value)))
|
||||||
y (+ y ny)
|
(setf n1 (+ sday (* value (/ (- cday sday) value))))
|
||||||
m (- m (* ny 12)))
|
(setf n2 (+ n1 value))))
|
||||||
(while (> m 12) (setq m (- m 12) y (1+ y)))
|
("m"
|
||||||
(setq n1 (calendar-absolute-from-gregorian (list m d y)))
|
(let* ((add-months
|
||||||
(setq m2 (+ m dn) y2 y)
|
(lambda (date n)
|
||||||
(if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
|
;; Add N months to gregorian DATE, i.e.,
|
||||||
(setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))
|
;; a list (MONTH DAY YEAR). Return a valid
|
||||||
(while (<= n2 cday)
|
;; gregorian date.
|
||||||
(setq n1 n2 m m2 y y2)
|
(let ((m (+ (nth 0 date) n)))
|
||||||
(setq m2 (+ m dn) y2 y)
|
(list (mod m 12)
|
||||||
(if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
|
(nth 1 date)
|
||||||
(setq n2 (calendar-absolute-from-gregorian (list m2 d y2))))))
|
(+ (/ m 12) (nth 2 date))))))
|
||||||
;; Make sure n1 is the earlier date
|
(months ; Complete months to TARGET.
|
||||||
(setq n0 n1 n1 (min n1 n2) n2 (max n0 n2))
|
(* (/ (+ (* 12 (- (nth 2 target) (nth 2 base)))
|
||||||
(if show-all
|
(- (nth 0 target) (nth 0 base))
|
||||||
(cond
|
;; If START's day is greater than
|
||||||
((eq prefer 'past) (if (= cday n2) n2 n1))
|
;; TARGET's, remove incomplete month.
|
||||||
((eq prefer 'future) (if (= cday n1) n1 n2))
|
(if (> (nth 1 target) (nth 1 base)) 0 -1))
|
||||||
(t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))
|
value)
|
||||||
(cond
|
value))
|
||||||
((eq prefer 'past) (if (= cday n2) n2 n1))
|
(before (funcall add-months base months)))
|
||||||
((eq prefer 'future) (if (= cday n1) n1 n2))
|
(setf n1 (calendar-absolute-from-gregorian before))
|
||||||
(t (if (= cday n1) n1 n2)))))))
|
(setf n2
|
||||||
|
(calendar-absolute-from-gregorian
|
||||||
|
(funcall add-months before value)))))
|
||||||
|
(_
|
||||||
|
(let* ((d (nth 1 base))
|
||||||
|
(m (nth 0 base))
|
||||||
|
(y (nth 2 base))
|
||||||
|
(years ; Complete years to TARGET.
|
||||||
|
(* (/ (- (nth 2 target)
|
||||||
|
y
|
||||||
|
;; If START's month and day are
|
||||||
|
;; greater than TARGET's, remove
|
||||||
|
;; incomplete year.
|
||||||
|
(if (or (> (nth 0 target) m)
|
||||||
|
(and (= (nth 0 target) m)
|
||||||
|
(> (nth 1 target) d)))
|
||||||
|
0
|
||||||
|
1))
|
||||||
|
value)
|
||||||
|
value))
|
||||||
|
(before (list m d (+ y years))))
|
||||||
|
(setf n1 (calendar-absolute-from-gregorian before))
|
||||||
|
(setf n2 (calendar-absolute-from-gregorian
|
||||||
|
(list m d (+ (nth 2 before) value)))))))
|
||||||
|
;; Handle PREFER parameter, if any.
|
||||||
|
(cond
|
||||||
|
((eq prefer 'past) (if (= cday n2) n2 n1))
|
||||||
|
((eq prefer 'future) (if (= cday n1) n1 n2))
|
||||||
|
(t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))))))))
|
||||||
|
|
||||||
(defun org-date-to-gregorian (date)
|
(defun org-date-to-gregorian (date)
|
||||||
"Turn any specification of DATE into a Gregorian date for the calendar."
|
"Turn any specification of DATE into a Gregorian date for the calendar."
|
||||||
|
|
|
||||||
|
|
@ -286,6 +286,95 @@
|
||||||
(should (equal (org-parse-time-string "<2012-03-29>" t)
|
(should (equal (org-parse-time-string "<2012-03-29>" t)
|
||||||
'(0 nil nil 29 3 2012 nil nil nil))))
|
'(0 nil nil 29 3 2012 nil nil nil))))
|
||||||
|
|
||||||
|
(ert-deftest test-org/closest-date ()
|
||||||
|
"Test `org-closest-date' specifications."
|
||||||
|
(require 'calendar)
|
||||||
|
;; Time stamps without a repeater are returned unchanged.
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
'(3 29 2012)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2012-03-29>" "<2014-03-04>" nil))))
|
||||||
|
;; Time stamps with a null repeater are returned unchanged.
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
'(3 29 2012)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2012-03-29 +0d>" "<2014-03-04>" nil))))
|
||||||
|
;; Time stamps with a special repeater type are returned unchanged.
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
'(3 29 2012)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2012-03-29 .+1d>" "<2014-03-04>" nil))))
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
'(3 29 2012)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2012-03-29 ++1d>" "<2014-03-04>" nil))))
|
||||||
|
;; if PREFER is set to `past' always return a date before, or equal
|
||||||
|
;; to CURRENT.
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
'(3 1 2014)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2012-03-29 +1m>" "<2014-03-04>" 'past))))
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
'(3 4 2014)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2012-03-04 +1m>" "<2014-03-04>" 'past))))
|
||||||
|
;; if PREFER is set to `future' always return a date before, or equal
|
||||||
|
;; to CURRENT.
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
'(3 29 2014)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2012-03-29 +1m>" "<2014-03-04>" 'future))))
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
'(3 4 2014)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2012-03-04 +1m>" "<2014-03-04>" 'future))))
|
||||||
|
;; If PREFER is neither `past' nor `future', select closest date.
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
'(3 1 2014)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2012-03-29 +1m>" "<2014-03-04>" nil))))
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
'(5 4 2014)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2012-03-04 +1m>" "<2014-04-28>" nil))))
|
||||||
|
;; Test "day" repeater.
|
||||||
|
(should
|
||||||
|
(equal '(3 8 2014)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2014-03-04 +2d>" "<2014-03-09>" 'past))))
|
||||||
|
(should
|
||||||
|
(equal '(3 10 2014)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2014-03-04 +2d>" "<2014-03-09>" 'future))))
|
||||||
|
;; Test "month" repeater.
|
||||||
|
(should
|
||||||
|
(equal '(1 5 2015)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2014-03-05 +2m>" "<2015-02-04>" 'past))))
|
||||||
|
(should
|
||||||
|
(equal '(3 29 2014)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2012-03-29 +2m>" "<2014-03-04>" 'future))))
|
||||||
|
;; Test "year" repeater.
|
||||||
|
(should
|
||||||
|
(equal '(3 5 2014)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2014-03-05 +2y>" "<2015-02-04>" 'past))))
|
||||||
|
(should
|
||||||
|
(equal '(3 29 2014)
|
||||||
|
(calendar-gregorian-from-absolute
|
||||||
|
(org-closest-date "<2012-03-29 +2y>" "<2014-03-04>" 'future)))))
|
||||||
|
|
||||||
|
|
||||||
;;; Drawers
|
;;; Drawers
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue