summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBastien Guerry <bzg@altern.org>2013-03-15 10:17:12 (GMT)
committer Bastien Guerry <bzg@altern.org>2013-03-15 10:17:12 (GMT)
commit6ae1718df56c5c44a000a9027514f6f9286f6e15 (patch)
treedad7ca023d70aa7ead93c66db08e5cbf26f7c0d3
parent3ec38f5c064c3270f54876ba33c5ca1097b46853 (diff)
downloadorg-mode-6ae1718df56c5c44a000a9027514f6f9286f6e15.zip
org-mode-6ae1718df56c5c44a000a9027514f6f9286f6e15.tar.gz
org-clock.el: New :mstart parameter for clocktables
* doc/org.texi (The clock table): Document :mstart. * lisp/org-clock.el (org-clocktable-defaults): Add :mstart parameter. (org-clock-special-range): New argument mstart. (org-dblock-write:clocktable, org-dblock-write:clocktable) (org-clocktable-write-default, org-clocktable-steps) (org-clock-get-table-data): Handle the :mstart parameter. Thanks to Peder Stray for coming up with this idea and for proposing a first implementation.
-rw-r--r--doc/org.texi2
-rw-r--r--lisp/org-clock.el56
2 files changed, 37 insertions, 21 deletions
diff --git a/doc/org.texi b/doc/org.texi
index 08a63c6..2ebc408 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -6352,6 +6352,8 @@ be selected:
@r{Relative times like @code{"<now>"} can also be used. See}
@r{@ref{Matching tags and properties} for relative time syntax.}
:wstart @r{The starting day of the week. The default is 1 for monday.}
+:mstart @r{The starting day of the month. The default 1 is for the first}
+ @r{day of the month.}
:step @r{@code{week} or @code{day}, to split the table into chunks.}
@r{To use this, @code{:block} or @code{:tstart}, @code{:tend} are needed.}
:stepskip0 @r{Do not show steps that have zero time.}
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index 912f0f3..fd0758b 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -278,6 +278,7 @@ string as argument."
:scope 'file
:block nil
:wstart 1
+ :mstart 1
:tstart nil
:tend nil
:step nil
@@ -1993,22 +1994,27 @@ buffer and update it."
((> startday 4)
(list 39 startday year)))))))
-(defun org-clock-special-range (key &optional time as-strings wstart)
+(defun org-clock-special-range (key &optional time as-strings wstart mstart)
"Return two times bordering a special time range.
Key is a symbol specifying the range and can be one of `today', `yesterday',
`thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'.
By default, a week starts Monday 0:00 and ends Sunday 24:00.
-The range is determined relative to TIME. TIME defaults to the current time.
+The range is determined relative to TIME, which defaults to current time.
The return value is a cons cell with two internal times like the ones
-returned by `current time' or `encode-time'. If AS-STRINGS is non-nil,
-the returned times will be formatted strings. If WSTART is non-nil,
-use this number to specify the starting day of a week (monday is 1)."
+returned by `current time' or `encode-time'.
+If AS-STRINGS is non-nil, the returned times will be formatted strings.
+If WSTART is non-nil, use this number to specify the starting day of a
+week (monday is 1).
+If MSTART is non-nil, use this number to specify the starting day of a
+month (1 is the first day of the month).
+If you can combine both, the month starting day will have priority."
(if (integerp key) (setq key (intern (number-to-string key))))
(let* ((tm (decode-time (or time (current-time))))
(s 0) (m (nth 1 tm)) (h (nth 2 tm))
(d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm))
(dow (nth 6 tm))
(ws (or wstart 1))
+ (ms (or mstart 1))
(skey (symbol-name key))
(shift 0)
(q (cond ((>= (nth 4 tm) 10) 4)
@@ -2066,17 +2072,18 @@ use this number to specify the starting day of a week (monday is 1)."
(setq diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws)))
m 0 h 0 d (- d diff) d1 (+ 7 d)))
((memq key '(month thismonth))
- (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0))
+ (setq d (or ms 1) h 0 m 0 d1 (or ms 1)
+ month (+ month shift) month1 (1+ month) h1 0 m1 0))
((memq key '(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 compute the shifted years, months and quarters
+ ;; Compute if this shift remains in this year. If not, compute
+ ;; how many years and quarters we have to shift (via floor*) and
+ ;; compute the shifted years, months and quarters.
(cond
((< (+ (- q 1) shift) 0) ; shift not in this year
(setq interval (* -1 (+ (- q 1) shift)))
- ; set tmp to ((years to shift) (quarters to shift))
+ ;; Set tmp to ((years to shift) (quarters to shift)).
(setq tmp (org-floor* interval 4))
- ; due to the use of floor, 0 quarters actually means 4
+ ;; Due to the use of floor, 0 quarters actually means 4.
(if (= 0 (nth 1 tmp))
(setq shiftedy (- y (nth 0 tmp))
shiftedm 1
@@ -2106,8 +2113,7 @@ use this number to specify the starting day of a week (monday is 1)."
((memq key '(year thisyear))
(setq txt (format-time-string "the year %Y" ts)))
((memq key '(quarter thisq))
- (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))))
- )
+ (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))))
(if as-strings
(list (format-time-string fm ts) (format-time-string fm te) txt)
(list ts te txt))))
@@ -2213,6 +2219,7 @@ the currently selected interval size."
(link (plist-get params :link))
(maxlevel (or (plist-get params :maxlevel) 3))
(ws (plist-get params :wstart))
+ (ms (plist-get params :mstart))
(step (plist-get params :step))
(timestamp (plist-get params :timestamp))
(formatter (or (plist-get params :formatter)
@@ -2223,7 +2230,7 @@ the currently selected interval size."
;; Check if we need to do steps
(when block
;; Get the range text for the header
- (setq cc (org-clock-special-range block nil t ws)
+ (setq cc (org-clock-special-range block nil t ws ms)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(when step
;; Write many tables, in steps
@@ -2313,6 +2320,7 @@ from the dynamic block definition."
(header (plist-get params :header))
(narrow (plist-get params :narrow))
(ws (or (plist-get params :wstart) 1))
+ (ms (or (plist-get params :mstart) 1))
(link (plist-get params :link))
(maxlevel (or (plist-get params :maxlevel) 3))
(emph (plist-get params :emphasize))
@@ -2357,7 +2365,7 @@ from the dynamic block definition."
(when block
;; Get the range text for the header
- (setq range-text (nth 2 (org-clock-special-range block nil t ws))))
+ (setq range-text (nth 2 (org-clock-special-range block nil t ws ms))))
;; Compute the total time
(setq total-time (apply '+ (mapcar 'cadr tables)))
@@ -2541,13 +2549,14 @@ from the dynamic block definition."
(ts (plist-get p1 :tstart))
(te (plist-get p1 :tend))
(ws (plist-get p1 :wstart))
+ (ms (plist-get p1 :mstart))
(step0 (plist-get p1 :step))
(step (cdr (assoc step0 '((day . 86400) (week . 604800)))))
(stepskip0 (plist-get p1 :stepskip0))
(block (plist-get p1 :block))
- cc range-text step-time)
+ cc range-text step-time tsb)
(when block
- (setq cc (org-clock-special-range block nil t ws)
+ (setq cc (org-clock-special-range block nil t ws ms)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(cond
((numberp ts)
@@ -2565,17 +2574,21 @@ from the dynamic block definition."
(te
(setq te (org-float-time
(apply 'encode-time (org-parse-time-string te))))))
+ (setq tsb
+ (if (eq step0 'week)
+ (- ts (* 86400 (- (nth (abs (- 7 ws)) (decode-time (seconds-to-time ts))) 1)))
+ ts))
(setq p1 (plist-put p1 :header ""))
(setq p1 (plist-put p1 :step nil))
(setq p1 (plist-put p1 :block nil))
- (while (< ts te)
+ (while (< tsb te)
(or (bolp) (insert "\n"))
(setq p1 (plist-put p1 :tstart (format-time-string
(org-time-stamp-format nil t)
- (seconds-to-time ts))))
+ (seconds-to-time (max tsb ts)))))
(setq p1 (plist-put p1 :tend (format-time-string
(org-time-stamp-format nil t)
- (seconds-to-time (setq ts (+ ts step))))))
+ (seconds-to-time (min te (setq tsb (+ tsb step)))))))
(insert "\n" (if (eq step0 'day) "Daily report: "
"Weekly report starting on: ")
(plist-get p1 :tstart) "\n")
@@ -2618,6 +2631,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(ts (plist-get params :tstart))
(te (plist-get params :tend))
(ws (plist-get params :wstart))
+ (ms (plist-get params :mstart))
(block (plist-get params :block))
(link (plist-get params :link))
(tags (plist-get params :tags))
@@ -2629,7 +2643,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(setq org-clock-file-total-minutes nil)
(when block
- (setq cc (org-clock-special-range block nil t ws)
+ (setq cc (org-clock-special-range block nil t ws ms)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts)))
(when (integerp te) (setq te (calendar-gregorian-from-absolute te)))