mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

Implement `month' and `year' steps in clock tables 

* doc/org-manual.org (The clock table): Update manual.
* lisp/org-clock.el (org-clocktable-steps): Rewrite function.  Add
  `month' and `year' steps.
* testing/lisp/test-org-clock.el (test-org-clock/clocktable/step): Add
  tests.
This commit is contained in:
Nicolas Goaziou 2018-10-13 16:22:43 +02:00
parent 5341312b79
commit 100edaccd1
4 changed files with 189 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
doc/org-manual.org
View File

@ -6616,8 +6616,9 @@ be selected:
- =:step= ::
Set to ~week~ or ~day~ to split the table into chunks. To use
this, ~:block~ or ~:tstart~, ~:tend~ are needed.
Set to =day=, =week=, =month= or =year= to split the table into
chunks. To use this, either =:block=, or =:tstart= and =:tend=
are required.
- =:stepskip0= ::

1
etc/ORG-NEWS
View File

@ -47,6 +47,7 @@ system than the main Org document. For example:
,#+INCLUDE: "myfile.cmd" src cmd :coding cp850-dos
#+end_example
*** New values in clock tables' step: =month= and =year=
*** New cell movement functions in tables
~S-<UP>~, ~S-<DOWN>~, ~S-<RIGHT>~, and ~S-<LEFT>~ now move cells in
the corresponding direction by swapping with the adjacent cell.

142
lisp/org-clock.el
View File

@ -2682,69 +2682,87 @@ LEVEL is an integer. Indent by two spaces per level above 1."
(concat "\\_" (make-string (* 2 (1- level)) ?\s))))
(defun org-clocktable-steps (params)
"Step through the range to make a number of clock tables."
(let* ((ts (plist-get params :tstart))
(te (plist-get params :tend))
(ws (plist-get params :wstart))
(ms (plist-get params :mstart))
(step0 (plist-get params :step))
(step (cdr (assq step0 '((day . 86400) (week . 604800)))))
(stepskip0 (plist-get params :stepskip0))
(block (plist-get params :block))
cc tsb)
(when block
(setq cc (org-clock-special-range block nil t ws ms)
ts (car cc)
te (nth 1 cc)))
(cond
((numberp ts)
;; If ts is a number, it's an absolute day number from
;; org-agenda.
(pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute ts)))
(setq ts (float-time (encode-time 0 0 0 day month year)))))
(ts
(setq ts (float-time (apply #'encode-time (org-parse-time-string ts))))))
(cond
((numberp te)
;; Likewise for te.
(pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute te)))
(setq te (float-time (encode-time 0 0 0 day month year)))))
(te
(setq te (float-time (apply #'encode-time (org-parse-time-string te))))))
(setq tsb
(if (eq step0 'week)
(let ((dow (nth 6 (decode-time (seconds-to-time ts)))))
(if (<= dow ws) ts
(- ts (* 86400 (- dow ws)))))
ts))
(while (< tsb te)
"Create one ore more clock tables, according to PARAMS.
Step through the range specifications in plist PARAMS to make
a number of clock tables."
(let* ((ignore-empty-tables (plist-get params :stepskip0))
(step (plist-get params :step))
(step-header
(pcase step
(`day "Daily report: ")
(`week "Weekly report starting on: ")
(`month "Monthly report starting on: ")
(`year "Annual report starting on: ")
(_ (user-error "Unknown `:step' specification: %S" step))))
(week-start (or (plist-get params :wstart) 1))
(month-start (or (plist-get params :mstart) 1))
(range
(pcase (plist-get params :block)
(`nil nil)
(range
(org-clock-special-range range nil t week-start month-start))))
;; For both START and END, any number is an absolute day
;; number from Agenda. Otherwise, consider value to be an Org
;; timestamp string. The `:block' property has precedence
;; over `:tstart' and `:tend'.
(start
(apply #'encode-time
(pcase (if range (car range) (plist-get params :tstart))
((and (pred numberp) n)
(pcase-let
((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
(list 0 0 org-extend-today-until d m y)))
(timestamp (org-parse-time-string timestamp)))))
(end
(apply #'encode-time
(pcase (if range (nth 1 range) (plist-get params :tend))
((and (pred numberp) n)
(pcase-let
((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
(list 0 0 org-extend-today-until d m y)))
(timestamp (org-parse-time-string timestamp))))))
(while (time-less-p start end)
(unless (bolp) (insert "\n"))
(let ((start-time (seconds-to-time (max tsb ts))))
(cl-incf tsb (let ((dow (nth 6 (decode-time (seconds-to-time tsb)))))
(if (or (eq step0 'day)
(= dow ws))
step
(* 86400 (- ws dow)))))
(insert "\n"
(if (eq step0 'day) "Daily report: "
"Weekly report starting on: ")
(format-time-string (org-time-stamp-format nil t) start-time)
"\n")
(let ((table-begin (line-beginning-position 0))
(step-time
(org-dblock-write:clocktable
(org-combine-plists
params
(list
:header "" :step nil :block nil
:tstart (format-time-string (org-time-stamp-format t t)
start-time)
:tend (format-time-string (org-time-stamp-format t t)
(seconds-to-time (min te tsb))))))))
(re-search-forward "^[ \t]*#\\+END:")
(when (and stepskip0 (equal step-time 0))
;; Remove the empty table
(delete-region (line-beginning-position) table-begin))))
;; Insert header before each clock table.
(insert "\n"
step-header
(format-time-string (org-time-stamp-format nil t) start)
"\n")
;; Compute NEXT, which is the end of the current clock table,
;; according to step.
(let* ((next
(apply #'encode-time
(pcase-let
((`(,_ ,_ ,_ ,d ,m ,y ,dow . ,_) (decode-time start)))
(pcase step
(`day (list 0 0 org-extend-today-until (1+ d) m y))
(`week
(let ((offset (if (= dow week-start) 7
(mod (- week-start dow) 7))))
(list 0 0 org-extend-today-until (+ d offset) m y)))
(`month (list 0 0 0 month-start (1+ m) y))
(`year (list 0 0 org-extend-today-until 1 1 (1+ y)))))))
(table-begin (line-beginning-position 0))
(step-time
;; Write clock table between START and NEXT.
(org-dblock-write:clocktable
(org-combine-plists
params (list :header ""
:step nil
:block nil
:tstart (format-time-string
(org-time-stamp-format t t)
start)
:tend (format-time-string
(org-time-stamp-format t t)
;; Never include clocks past END.
(if (time-less-p end next) end next)))))))
(let ((case-fold-search t)) (re-search-forward "^[ \t]*#\\+END:"))
;; Remove the table if it is empty and `:stepskip0' is
;; non-nil.
(when (and ignore-empty-tables (equal step-time 0))
(delete-region (line-beginning-position) table-begin))
(setq start next))
(end-of-line 0))))
(defun org-clock-get-table-data (file params)

106
testing/lisp/test-org-clock.el
View File

@ -977,7 +977,111 @@ CLOCK: [2017-12-27 Wed 08:00]--[2017-12-27 Wed 16:00] => 8:00"
(let ((system-time-locale "en_US"))
(test-org-clock-clocktable-contents
(concat ":step day :tstart \"<2017-12-25 Mon>\" "
":tend \"<2017-12-27 Wed 23:59>\" :stepskip0 t")))))))
":tend \"<2017-12-27 Wed 23:59>\" :stepskip0 t"))))))
;; Test :step week", without or with ":wstart" parameter.
(should
(equal "
Weekly report starting on: [2012-03-26 Mon]
| Headline | Time |
|--------------+--------|
| *Total time* | *8:00* |
|--------------+--------|
| Foo | 8:00 |
Weekly report starting on: [2012-04-02 Mon]
| Headline | Time |
|--------------+--------|
| *Total time* | *8:00* |
|--------------+--------|
| Foo | 8:00 |
"
(org-test-with-temp-text
"* Foo
CLOCK: [2012-03-29 Thu 08:00]--[2012-03-29 Thu 16:00] => 8:00
CLOCK: [2012-04-03 Thu 08:00]--[2012-04-03 Thu 16:00] => 8:00"
(let ((system-time-locale "en_US"))
(test-org-clock-clocktable-contents
":step week :block 2012 :stepskip0 t")))))
(should
(equal "
Weekly report starting on: [2012-03-29 Thu]
| Headline | Time |
|--------------+---------|
| *Total time* | *16:00* |
|--------------+---------|
| Foo | 16:00 |
"
(org-test-with-temp-text
"* Foo
CLOCK: [2012-03-29 Thu 08:00]--[2012-03-29 Thu 16:00] => 8:00
CLOCK: [2012-04-03 Thu 08:00]--[2012-04-03 Thu 16:00] => 8:00"
(let ((system-time-locale "en_US"))
(test-org-clock-clocktable-contents
":step week :wstart 4 :block 2012 :stepskip0 t")))))
;; Test ":step month" without and with ":mstart".
(should
(equal "
Monthly report starting on: [2014-03-01 Sat]
| Headline | Time |
|--------------+--------|
| *Total time* | *8:00* |
|--------------+--------|
| Foo | 8:00 |
Monthly report starting on: [2014-04-01 Tue]
| Headline | Time |
|--------------+--------|
| *Total time* | *8:00* |
|--------------+--------|
| Foo | 8:00 |
"
(org-test-with-temp-text
"* Foo
CLOCK: [2014-03-04 Tue 08:00]--[2014-03-04 Tue 16:00] => 8:00
CLOCK: [2014-04-03 Thu 08:00]--[2014-04-03 Thu 16:00] => 8:00"
(let ((system-time-locale "en_US"))
(test-org-clock-clocktable-contents
":step month :block 2014 :stepskip0 t")))))
(should
(equal "
Monthly report starting on: [2014-03-04 Tue]
| Headline | Time |
|--------------+---------|
| *Total time* | *16:00* |
|--------------+---------|
| Foo | 16:00 |
"
(org-test-with-temp-text
"* Foo
CLOCK: [2014-03-04 Tue 08:00]--[2014-03-04 Tue 16:00] => 8:00
CLOCK: [2014-04-03 Thu 08:00]--[2014-04-03 Thu 16:00] => 8:00"
(let ((system-time-locale "en_US"))
(test-org-clock-clocktable-contents
":step month :mstart 4 :block 2014 :stepskip0 t")))))
;; Test ":step year".
(should
(equal "
Annual report starting on: [2012-01-01 Sun]
| Headline | Time |
|--------------+--------|
| *Total time* | *8:00* |
|--------------+--------|
| Foo | 8:00 |
Annual report starting on: [2014-01-01 Wed]
| Headline | Time |
|--------------+--------|
| *Total time* | *8:00* |
|--------------+--------|
| Foo | 8:00 |
"
(org-test-with-temp-text
"* Foo
CLOCK: [2012-03-29 Thu 08:00]--[2012-03-29 Thu 16:00] => 8:00
CLOCK: [2014-03-04 Tue 08:00]--[2014-03-04 Tue 16:00] => 8:00"
(let ((system-time-locale "en_US"))
(test-org-clock-clocktable-contents
":step year :block untilnow :stepskip0 t"))))))
(ert-deftest test-org-clock/clocktable/extend-today-until ()
"Test assignment of clock time to days in presence of \"org-extend-today-until\"."