ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

org-clock: Fix regression in Clock table 

* lisp/org-clock.el (org-clocktable-write-default): Do not raise an
  error when :maxlevel is 0.  Small refactoring.

* testing/lisp/test-org-clock.el (test-org-clock/clocktable): Split
into ...
(test-org-clock/clocktable/ranges):
(test-org-clock/clocktable/tags):
(test-org-clock/clocktable/scope):
(test-org-clock/clocktable/maxlevel):
(test-org-clock/clocktable/formula): ... these.  Add tests.

This fixes regression introduced in ccf832e83.

Reported-by: Christoph LANGE <math.semantic.web@gmail.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/112091>
This commit is contained in:
Nicolas Goaziou 2017-02-13 21:24:40 +01:00
parent 990fd09ca8
commit b897ab7223
2 changed files with 305 additions and 202 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

133
lisp/org-clock.el
View File

@ -2459,35 +2459,31 @@ from the dynamic block definition."
(block (plist-get params :block)) (block (plist-get params :block))
(sort (plist-get params :sort)) (sort (plist-get params :sort))
(header (plist-get params :header)) (header (plist-get params :header))
(narrow (plist-get params :narrow))
(ws (or (plist-get params :wstart) 1)) (ws (or (plist-get params :wstart) 1))
(ms (or (plist-get params :mstart) 1)) (ms (or (plist-get params :mstart) 1))
(link (plist-get params :link)) (link (plist-get params :link))
(maxlevel (or (plist-get params :maxlevel) 3))
(emph (plist-get params :emphasize))
(level-p (plist-get params :level))
(org-time-clocksum-use-effort-durations (org-time-clocksum-use-effort-durations
(plist-get params :effort-durations)) (plist-get params :effort-durations))
(maxlevel (or (plist-get params :maxlevel) 3))
(emph (plist-get params :emphasize))
(compact? (plist-get params :compact))
(narrow (or (plist-get params :narrow) (and compact? '40!)))
(level? (and (not compact?) (plist-get params :level)))
(timestamp (plist-get params :timestamp)) (timestamp (plist-get params :timestamp))
(properties (plist-get params :properties)) (properties (plist-get params :properties))
(ntcol (max 1 (or (plist-get params :tcolumns) 100))) (ntcol (if compact? 1
(indent (plist-get params :indent)) (max 1 (or (plist-get params :tcolumns) 100))))
(indent (or compact? (plist-get params :indent)))
(formula (plist-get params :formula)) (formula (plist-get params :formula))
(case-fold-search t) (case-fold-search t)
range-text total-time tbl level hlc range-text total-time recalc narrow-cut-p)
file-time entries entry headline
recalc narrow-cut-p)
;; Implement abbreviations ;; Some consistency test for parameters.
(when (plist-get params :compact)
(setq level nil indent t narrow (or narrow '40!) ntcol 1))
;; Some consistency test for parameters
(unless (integerp ntcol) (unless (integerp ntcol)
(setq params (plist-put params :tcolumns (setq ntcol 100)))) (setq params (plist-put params :tcolumns (setq ntcol 100))))
(when (and narrow (integerp narrow) link) (when (and narrow (integerp narrow) link)
;; We cannot have both integer narrow and link ;; We cannot have both integer narrow and link.
(message (message
"Using hard narrowing in clocktable to allow for links") "Using hard narrowing in clocktable to allow for links")
(setq narrow (intern (format "%d!" narrow)))) (setq narrow (intern (format "%d!" narrow))))
@ -2505,19 +2501,19 @@ from the dynamic block definition."
narrow)))) narrow))))
(when block (when block
;; Get the range text for the header ;; Get the range text for the header.
(setq range-text (nth 2 (org-clock-special-range block nil t ws ms)))) (setq range-text (nth 2 (org-clock-special-range block nil t ws ms))))
;; Compute the total time ;; Compute the total time.
(setq total-time (apply '+ (mapcar 'cadr tables))) (setq total-time (apply #'+ (mapcar #'cadr tables)))
;; Now we need to output this tsuff ;; Now we need to output this tsuff.
(goto-char ipos) (goto-char ipos)
;; Insert the text *before* the actual table ;; Insert the text *before* the actual table.
(insert-before-markers (insert-before-markers
(or header (or header
;; Format the standard header ;; Format the standard header.
(concat (concat
"#+CAPTION: " "#+CAPTION: "
(nth 9 lwords) " [" (nth 9 lwords) " ["
@ -2533,7 +2529,7 @@ from the dynamic block definition."
(insert-before-markers (insert-before-markers
"|" ;table line starter "|" ;table line starter
(if multifile "|" "") ;file column, maybe (if multifile "|" "") ;file column, maybe
(if level-p "|" "") ; level column, maybe (if level? "|" "") ;level column, maybe
(if timestamp "|" "") ;timestamp column, maybe (if timestamp "|" "") ;timestamp column, maybe
(if properties (make-string (length properties) ?|) "") ;properties columns, maybe (if properties (make-string (length properties) ?|) "") ;properties columns, maybe
(format "<%d>| |\n" narrow))) ; headline and time columns (format "<%d>| |\n" narrow))) ; headline and time columns
@ -2542,12 +2538,15 @@ from the dynamic block definition."
(insert-before-markers (insert-before-markers
"|" ;table line starter "|" ;table line starter
(if multifile (concat (nth 1 lwords) "|") "") ;file column, maybe (if multifile (concat (nth 1 lwords) "|") "") ;file column, maybe
(if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe (if level? (concat (nth 2 lwords) "|") "") ;level column, maybe
(if timestamp (concat (nth 3 lwords) "|") "") ;timestamp column, maybe (if timestamp (concat (nth 3 lwords) "|") "") ;timestamp column, maybe
(if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe (if properties ;properties columns, maybe
(concat (mapconcat #'identity properties "|") "|")
"")
(nth 4 lwords) "|" ;headline (nth 4 lwords) "|" ;headline
(nth 5 lwords) "|" ;time column (nth 5 lwords) "|" ;time column
(make-string (1- (min maxlevel (or ntcol 100))) ?|) (make-string (max 0 (1- (min maxlevel (or ntcol 100))))
?|) ;other time columns
(if (eq formula '%) "%|\n" "\n")) (if (eq formula '%) "%|\n" "\n"))
;; Insert the total time in the table ;; Insert the total time in the table
@ -2556,79 +2555,81 @@ from the dynamic block definition."
"|" ;table line starter "|" ;table line starter
(if multifile (concat "| " (nth 6 lwords) " ") "") (if multifile (concat "| " (nth 6 lwords) " ") "")
;file column, maybe ;file column, maybe
(if level-p "|" "") ; level column, maybe (if level? "|" "") ;level column, maybe
(if timestamp "|" "") ;timestamp column, maybe (if timestamp "|" "") ;timestamp column, maybe
(make-string (length properties) ?|) ;properties columns, maybe (make-string (length properties) ?|) ;properties columns, maybe
(concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline (concat (format org-clock-total-time-cell-format (nth 7 lwords))
"| ")
(format org-clock-total-time-cell-format (format org-clock-total-time-cell-format
(org-minutes-to-clocksum-string (or total-time 0))) ;time (org-minutes-to-clocksum-string (or total-time 0))) ;time
"|" "|"
(make-string (1- (min maxlevel (or ntcol 100))) ?|) (make-string (max 0 (1- (min maxlevel (or ntcol 100)))) ?|)
(cond ((not (eq formula '%)) "") (cond ((not (eq formula '%)) "")
((or (not total-time) (= total-time 0)) "0.0|") ((or (not total-time) (= total-time 0)) "0.0|")
(t "100.0|")) (t "100.0|"))
"\n") "\n")
;; Now iterate over the tables and insert the data ;; Now iterate over the tables and insert the data but only if any
;; but only if any time has been collected ;; time has been collected.
(when (and total-time (> total-time 0)) (when (and total-time (> total-time 0))
(pcase-dolist (`(,file-name ,file-time ,entries) tables)
(while (setq tbl (pop tables))
;; now tbl is the table resulting from one file.
(setq file-time (nth 1 tbl))
(when (or (and file-time (> file-time 0)) (when (or (and file-time (> file-time 0))
(not (plist-get params :fileskip0))) (not (plist-get params :fileskip0)))
(insert-before-markers "|-\n") ; a hline because a new file starts (insert-before-markers "|-\n") ;hline at new file
;; First the file time, if we have multiple files ;; First the file time, if we have multiple files.
(when multifile (when multifile
;; Summarize the time collected from this file ;; Summarize the time collected from this file.
(insert-before-markers (insert-before-markers
(format (concat "| %s %s | %s%s" (format (concat "| %s %s | %s%s"
(format org-clock-file-time-cell-format (nth 8 lwords)) (format org-clock-file-time-cell-format
(nth 8 lwords))
" | *%s*|\n") " | *%s*|\n")
(file-name-nondirectory (car tbl)) (file-name-nondirectory file-name)
(if level-p "| " "") ; level column, maybe (if level? "| " "") ;level column, maybe
(if timestamp "| " "") ;timestamp column, maybe (if timestamp "| " "") ;timestamp column, maybe
(if properties (make-string (length properties) ?|) "") ;properties columns, maybe (if properties ;properties columns, maybe
(org-minutes-to-clocksum-string (nth 1 tbl))))) ; the time (make-string (length properties) ?|)
"")
(org-minutes-to-clocksum-string file-time)))) ;time
;; Get the list of node entries and iterate over it ;; Get the list of node entries and iterate over it
(setq entries (nth 2 tbl)) (when (> maxlevel 0)
(while (setq entry (pop entries)) (pcase-dolist (`(,level ,headline ,ts ,time . ,props) entries)
(setq level (car entry)
headline (nth 1 entry)
hlc (if emph (or (cdr (assoc level hlchars)) "") ""))
(when narrow-cut-p (when narrow-cut-p
(if (and (string-match (concat "\\`" org-bracket-link-regexp (setq headline
"\\'") (if (and (string-match
(format "\\`%s\\'" org-bracket-link-regexp)
headline) headline)
(match-end 3)) (match-end 3))
(setq headline
(format "[[%s][%s]]" (format "[[%s][%s]]"
(match-string 1 headline) (match-string 1 headline)
(org-shorten-string (match-string 3 headline) (org-shorten-string (match-string 3 headline)
narrow))) narrow))
(setq headline (org-shorten-string headline narrow)))) (org-shorten-string headline narrow))))
(let ((hlc (if emph (or (cdr (assoc level hlchars)) "") "")))
(insert-before-markers (insert-before-markers
"|" ;start the table line "|" ;start the table line
(if multifile "|" "") ;free space for file name column? (if multifile "|" "") ;free space for file name column?
(if level-p (format "%d|" (car entry)) "") ; level, maybe (if level? (format "%d|" level) "") ;level, maybe
(if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe (if timestamp (concat ts "|") "") ;timestamp, maybe
(if properties (if properties ;properties columns, maybe
(concat (concat (mapconcat (lambda (p)
(mapconcat (or (cdr (assoc p props)) ""))
(lambda (p) (or (cdr (assoc p (nth 4 entry))) "")) properties
properties "|") "|") "") ;properties columns, maybe "|")
(if indent (org-clocktable-indent-string level) "") ; indentation "|")
"")
(if indent ;indentation
(org-clocktable-indent-string level)
"")
hlc headline hlc "|" ;headline hlc headline hlc "|" ;headline
(make-string (1- (min ntcol level)) ?|) ;empty fields for higher levels (make-string (1- (min ntcol level)) ?|) ;empty fields for higher levels
hlc (org-minutes-to-clocksum-string (nth 3 entry)) hlc ; time hlc (org-minutes-to-clocksum-string time) hlc ; time
(make-string (1+ (- maxlevel level)) ?|) (make-string (1+ (- maxlevel level)) ?|)
(if (eq formula '%) (if (eq formula '%)
(format "%.1f |" (* 100 (/ (nth 3 entry) (float total-time)))) (format "%.1f |" (* 100 (/ time (float total-time))))
"") "")
"\n" ; close line "\n")))))))
)))))
(delete-char -1) (delete-char -1)
(cond (cond
;; Possibly rescue old formula? ;; Possibly rescue old formula?
@ -2644,12 +2645,12 @@ from the dynamic block definition."
(setq recalc t)) (setq recalc t))
(t (t
(user-error "Invalid :formula parameter in clocktable"))) (user-error "Invalid :formula parameter in clocktable")))
;; Back to beginning, align the table, recalculate if necessary ;; Back to beginning, align the table, recalculate if necessary.
(goto-char ipos) (goto-char ipos)
(skip-chars-forward "^|") (skip-chars-forward "^|")
(org-table-align) (org-table-align)
(when org-hide-emphasis-markers (when org-hide-emphasis-markers
;; we need to align a second time ;; We need to align a second time.
(org-table-align)) (org-table-align))
(when sort (when sort
(save-excursion (save-excursion

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

@ -267,8 +267,8 @@ contents. The clocktable doesn't appear in the buffer."
;;; Clocktable ;;; Clocktable
(ert-deftest test-org-clock/clocktable () (ert-deftest test-org-clock/clocktable/ranges ()
"Test clocktable specifications." "Test ranges in Clock table."
;; Relative time: Previous two days. ;; Relative time: Previous two days.
(should (should
(equal (equal
@ -318,7 +318,10 @@ contents. The clocktable doesn't appear in the buffer."
(insert (org-test-clock-create-clock "-10y 15:00" "-10y 18:00")) (insert (org-test-clock-create-clock "-10y 15:00" "-10y 18:00"))
(insert (org-test-clock-create-clock "-2d 15:00" "-2d 18:00")) (insert (org-test-clock-create-clock "-2d 15:00" "-2d 18:00"))
(test-org-clock-clocktable-contents-at-point (test-org-clock-clocktable-contents-at-point
":block untilnow :indent nil")))) ":block untilnow :indent nil")))))
(ert-deftest test-org-clock/clocktable/tags ()
"Test \":tags\" parameter in Clock table."
;; Test tag filtering. ;; Test tag filtering.
(should (should
(equal (equal
@ -334,7 +337,10 @@ contents. The clocktable doesn't appear in the buffer."
(insert (org-test-clock-create-clock ". 2:00" ". 4:00")) (insert (org-test-clock-create-clock ". 2:00" ". 4:00"))
(goto-line 2) (goto-line 2)
(test-org-clock-clocktable-contents-at-point (test-org-clock-clocktable-contents-at-point
":tags \"tag\" :indent nil")))) ":tags \"tag\" :indent nil")))))
(ert-deftest test-org-clock/clocktable/scope ()
"Test \":scope\" parameter in Clock table."
;; Test `file-with-archives' scope. In particular, preserve "TBLFM" ;; Test `file-with-archives' scope. In particular, preserve "TBLFM"
;; line, and ignore "file" column. ;; line, and ignore "file" column.
(should (should
@ -359,7 +365,103 @@ CLOCK: [2012-03-29 Thu 16:40]--[2014-03-04 Thu 00:41] => 16905:01
(forward-line 2) (forward-line 2)
(buffer-substring-no-properties (buffer-substring-no-properties
(point) (progn (goto-char (point-max)) (point) (progn (goto-char (point-max))
(line-beginning-position -1)))))) (line-beginning-position -1)))))))
(ert-deftest test-org-clock/clocktable/maxlevel ()
"Test \":maxlevel\" parameter in Clock table."
(should
(equal "| Headline | Time | | |
|--------------+--------+------+---|
| *Total time* | *6:00* | | |
|--------------+--------+------+---|
| Foo | 6:00 | | |
| \\_ Bar | | 2:00 | |
"
(org-test-with-temp-text
"
* Foo
CLOCK: [2016-12-28 Wed 11:09]--[2016-12-28 Wed 15:09] => 4:00
** Bar
CLOCK: [2016-12-28 Wed 13:09]--[2016-12-28 Wed 15:09] => 2:00
* Report
<point>#+BEGIN: clocktable :maxlevel 3
#+END:"
(org-update-dblock)
(buffer-substring-no-properties
(line-beginning-position 3)
(progn (goto-char (point-max))
(line-beginning-position))))))
(should
(equal "| Headline | Time | |
|--------------+--------+------|
| *Total time* | *6:00* | |
|--------------+--------+------|
| Foo | 6:00 | |
| \\_ Bar | | 2:00 |
"
(org-test-with-temp-text
"
* Foo
CLOCK: [2016-12-28 Wed 11:09]--[2016-12-28 Wed 15:09] => 4:00
** Bar
CLOCK: [2016-12-28 Wed 13:09]--[2016-12-28 Wed 15:09] => 2:00
* Report
<point>#+BEGIN: clocktable :maxlevel 2
#+END:"
(org-update-dblock)
(buffer-substring-no-properties
(line-beginning-position 3)
(progn (goto-char (point-max))
(line-beginning-position))))))
(should
(equal "| Headline | Time |
|--------------+--------|
| *Total time* | *6:00* |
|--------------+--------|
| Foo | 6:00 |
"
(org-test-with-temp-text
"
* Foo
CLOCK: [2016-12-28 Wed 11:09]--[2016-12-28 Wed 15:09] => 4:00
** Bar
CLOCK: [2016-12-28 Wed 13:09]--[2016-12-28 Wed 15:09] => 2:00
* Report
<point>#+BEGIN: clocktable :maxlevel 1
#+END:"
(org-update-dblock)
(buffer-substring-no-properties
(line-beginning-position 3)
(progn (goto-char (point-max))
(line-beginning-position))))))
;; Special ":maxlevel 0" case: only report total file time.
(should
(equal "| Headline | Time |
|--------------+--------|
| *Total time* | *6:00* |
|--------------+--------|
"
(org-test-with-temp-text
"
* Foo
CLOCK: [2016-12-28 Wed 11:09]--[2016-12-28 Wed 15:09] => 4:00
** Bar
CLOCK: [2016-12-28 Wed 13:09]--[2016-12-28 Wed 15:09] => 2:00
* Report
<point>#+BEGIN: clocktable :maxlevel 0
#+END:"
(org-update-dblock)
(buffer-substring-no-properties
(line-beginning-position 3)
(progn (goto-char (point-max))
(line-beginning-position)))))))
(ert-deftest test-org-clock/clocktable/formula ()
"Test \":formula\" parameter in Clock table."
;; Test ":formula %". Handle various duration formats. ;; Test ":formula %". Handle various duration formats.
(should (should
(equal (equal