summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRobert Irelan <rmirelan@google.com>2018-04-30 17:18:16 -0700
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2018-06-27 08:31:38 +0200
commitfda1d276108ce7fa502c8cc16a3e9ab9ca3667c3 (patch)
tree3ade73def3a91b08803f3630db3f43e87e67bf01
parentcad692c27622ddcaeb72fdeb7170471db8b5bf86 (diff)
downloadorg-mode-fda1d276108ce7fa502c8cc16a3e9ab9ca3667c3.tar.gz
org-clock: Properly handle `org-extend-today-until' in clock tables
* lisp/org-clock.el (org-clock-special-range): Handle non-default `org-extend-today-until' when generating a clock table with the `:block` directive. Reported-by: Robert Irelan <rirelan@gmail.com> <http://lists.gnu.org/archive/html/emacs-orgmode/2018-04/msg00294.html>
-rw-r--r--lisp/org-clock.el18
1 files changed, 12 insertions, 6 deletions
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index b769a4f..f2562fb 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -2200,13 +2200,17 @@ have priority."
(`lastq (setq key 'quarter shift -1))))
;; Prepare start and end times depending on KEY's type.
(pcase key
- ((or `day `today) (setq m 0 h 0 h1 24 d (+ d shift)))
+ ((or `day `today) (setq m 0
+ h org-extend-today-until
+ h1 (+ 24 org-extend-today-until)
+ d (+ d shift)))
((or `week `thisweek)
(let* ((ws (or wstart 1))
(diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws)))))
- (setq m 0 h 0 d (- d diff) d1 (+ 7 d))))
+ (setq m 0 h org-extend-today-until d (- d diff) d1 (+ 7 d))))
((or `month `thismonth)
- (setq h 0 m 0 d (or mstart 1) month (+ month shift) month1 (1+ month)))
+ (setq h org-extend-today-until m 0 d (or mstart 1)
+ month (+ month shift) month1 (1+ month)))
((or `quarter `thisq)
;; Compute if this shift remains in this year. If not, compute
;; how many years and quarters we have to shift (via floor*) and
@@ -2224,14 +2228,16 @@ have priority."
(setq shiftedy (- y (+ 1 (nth 0 tmp)))
shiftedm (- 13 (* 3 (nth 1 tmp)))
shiftedq (- 5 (nth 1 tmp)))))
- (setq m 0 h 0 d 1 month shiftedm month1 (+ 3 shiftedm) y shiftedy))
+ (setq m 0 h org-extend-today-until d 1
+ month shiftedm month1 (+ 3 shiftedm) y shiftedy))
((> (+ q shift) 0) ; Shift is within this year.
(setq shiftedq (+ q shift))
(setq shiftedy y)
(let ((qshift (* 3 (1- (+ q shift)))))
- (setq m 0 h 0 d 1 month (+ 1 qshift) month1 (+ 4 qshift))))))
+ (setq m 0 h org-extend-today-until d 1
+ month (+ 1 qshift) month1 (+ 4 qshift))))))
((or `year `thisyear)
- (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
+ (setq m 0 h org-extend-today-until d 1 month 1 y (+ y shift) y1 (1+ y)))
((or `interactive `untilnow)) ; Special cases, ignore them.
(_ (user-error "No such time block %s" key)))
;; Format start and end times according to AS-STRINGS.