Browse Source

org-clock: Fix clock table with `file-with-archives' scope

* lisp/org-clock.el (org-dblock-write:clocktable): Small refactoring.
(org-clocktable-write-default): Avoid writing a "File" column when using
`file-with-archives' scope instead of deleting it at the end of the
process.

* testing/lisp/test-org-clock.el (test-org-clock/clocktable): Add test.

Reported-by: Dale <dale@codefu.org>
<http://permalink.gmane.org/gmane.emacs.orgmode/109856>
Nicolas Goaziou 8 years ago
parent
commit
33f8f8adaa
2 changed files with 79 additions and 63 deletions
  1. 53 62
      lisp/org-clock.el
  2. 26 1
      testing/lisp/test-org-clock.el

+ 53 - 62
lisp/org-clock.el

@@ -2356,6 +2356,15 @@ the currently selected interval size."
   (setq params (org-combine-plists org-clocktable-defaults params))
   (catch 'exit
     (let* ((scope (plist-get params :scope))
+	   (files (pcase scope
+		    (`agenda
+		     (org-agenda-files t))
+		    (`agenda-with-archives
+		     (org-add-archive-files (org-agenda-files t)))
+		    (`file-with-archives
+		     (and buffer-file-name
+			  (org-add-archive-files (list buffer-file-name))))
+		    (_ (or (buffer-file-name) (current-buffer)))))
 	   (block (plist-get params :block))
 	   (ts (plist-get params :tstart))
 	   (te (plist-get params :tend))
@@ -2365,7 +2374,7 @@ the currently selected interval size."
 	   (formatter (or (plist-get params :formatter)
 			  org-clock-clocktable-formatter
 			  'org-clocktable-write-default))
-	   cc ipos one-file-with-archives scope-is-list tbls level)
+	   cc)
       ;; Check if we need to do steps
       (when block
 	;; Get the range text for the header
@@ -2379,62 +2388,49 @@ the currently selected interval size."
 	(org-clocktable-steps params)
 	(throw 'exit nil))
 
-      (setq ipos (point)) ; remember the insertion position
-
-      ;; Get the right scope
-      (cond
-       ((eq scope 'agenda)
-	(setq scope (org-agenda-files t)))
-       ((eq scope 'agenda-with-archives)
-	(setq scope (org-agenda-files t))
-	(setq scope (org-add-archive-files scope)))
-       ((eq scope 'file-with-archives)
-	(setq scope (and buffer-file-name
-			 (org-add-archive-files (list buffer-file-name)))
-	      one-file-with-archives t)))
-      (setq scope-is-list (and scope (listp scope)))
-      (if scope-is-list
-	  ;; we collect from several files
-	  (let* ((files scope)
-		 file)
-	    (org-agenda-prepare-buffers files)
-	    (while (setq file (pop files))
-	      (with-current-buffer (find-buffer-visiting file)
-		(save-excursion
-		  (save-restriction
-		    (push (org-clock-get-table-data file params) tbls))))))
-	;; Just from the current file
-	(save-restriction
-	  ;; get the right range into the restriction
-	  (org-agenda-prepare-buffers (list (or (buffer-file-name)
-						(current-buffer))))
-	  (cond
-	   ((not scope))  ; use the restriction as it is now
-	   ((eq scope 'file) (widen))
-	   ((eq scope 'subtree) (org-narrow-to-subtree))
-	   ((eq scope 'tree)
-	    (while (org-up-heading-safe))
-	    (org-narrow-to-subtree))
-	   ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$"
-					       (symbol-name scope)))
-	    (setq level (string-to-number (match-string 1 (symbol-name scope))))
-	    (catch 'exit
-	      (while (org-up-heading-safe)
-		(looking-at org-outline-regexp)
-		(if (<= (org-reduced-level (funcall outline-level)) level)
-		    (throw 'exit nil))))
-	    (org-narrow-to-subtree)))
-	  ;; do the table, with no file name.
-	  (push (org-clock-get-table-data nil params) tbls)))
-
-      ;; OK, at this point we tbls as a list of tables, one per file
-      (setq tbls (nreverse tbls))
-
-      (setq params (plist-put params :multifile scope-is-list))
-      (setq params (plist-put params :one-file-with-archives
-			      one-file-with-archives))
-
-      (funcall formatter ipos tbls params))))
+      (org-agenda-prepare-buffers (if (consp files) files (list files)))
+
+      (let ((origin (point))
+	    (tables
+	     (if (consp files)
+		 (mapcar (lambda (file)
+			   (with-current-buffer (find-buffer-visiting file)
+			     (save-excursion
+			       (save-restriction
+				 (org-clock-get-table-data file params)))))
+			 files)
+	       ;; Get the right restriction for the scope.
+	       (cond
+		((not scope))	     ;use the restriction as it is now
+		((eq scope 'file) (widen))
+		((eq scope 'subtree) (org-narrow-to-subtree))
+		((eq scope 'tree)
+		 (while (org-up-heading-safe))
+		 (org-narrow-to-subtree))
+		((and (symbolp scope)
+		      (string-match "\\`tree\\([0-9]+\\)\\'"
+				    (symbol-name scope)))
+		 (let ((level (string-to-number
+			       (match-string 1 (symbol-name scope)))))
+		   (catch 'exit
+		     (while (org-up-heading-safe)
+		       (looking-at org-outline-regexp)
+		       (when (<= (org-reduced-level (funcall outline-level))
+				 level)
+			 (throw 'exit nil))))
+		   (org-narrow-to-subtree))))
+	       (list (org-clock-get-table-data nil params))))
+	    (multifile
+	     ;; Even though `file-with-archives' can consist of
+	     ;; multiple files, we consider this is one extended file
+	     ;; instead.
+	     (cond ((eq scope 'file-with-archives) nil)
+		   ((consp files)))))
+
+	(funcall formatter
+		 origin
+		 tables
+		 (org-combine-plists params `(:multifile ,multifile)))))))
 
 (defun org-clocktable-write-default (ipos tables params)
   "Write out a clock table at position IPOS in the current buffer.
@@ -2468,7 +2464,6 @@ from the dynamic block definition."
 	 (timestamp (plist-get params :timestamp))
 	 (properties (plist-get params :properties))
 	 (ntcol (max 1 (or (plist-get params :tcolumns) 100)))
-	 (rm-file-column (plist-get params :one-file-with-archives))
 	 (indent (plist-get params :indent))
 	 (case-fold-search t)
 	 range-text total-time tbl level hlc formula pcol
@@ -2673,10 +2668,6 @@ from the dynamic block definition."
 	    (org-table-goto-column pcol nil 'force)
 	    (insert "%")))
       (org-table-recalculate 'all))
-    (when rm-file-column
-      ;; The file column is actually not wanted
-      (forward-char 1)
-      (org-table-delete-column))
     total-time))
 
 (defun org-clocktable-indent-string (level)

+ 26 - 1
testing/lisp/test-org-clock.el

@@ -334,7 +334,32 @@ contents.  The clocktable doesn't appear in the buffer."
       (insert (org-test-clock-create-clock ". 2:00" ". 4:00"))
       (goto-line 2)
       (test-org-clock-clocktable-contents-at-point
-       ":tags \"tag\" :indent nil")))))
+       ":tags \"tag\" :indent nil"))))
+  ;; Test `file-with-archives' scope.  In particular, preserve "TBLFM"
+  ;; line, and ignore "file" column.
+  (should
+   (equal
+    "| Headline     | Time        |     |
+|--------------+-------------+-----|
+| *Total time* | *704d 9:01* | foo |
+|--------------+-------------+-----|
+| Test         | 704d 9:01   | foo |
+"
+    (org-test-with-temp-text-in-file
+	"* Test
+CLOCK: [2012-03-29 Thu 16:40]--[2014-03-04 Thu 00:41] => 16905:01
+
+#+BEGIN: clocktable :scope file-with-archives
+#+TBLFM: $3=string(\"foo\")
+#+END:
+"
+      (search-forward "#+begin:")
+      (beginning-of-line)
+      (org-update-dblock)
+      (forward-line 2)
+      (buffer-substring-no-properties
+       (point) (progn (goto-char (point-max))
+		      (line-beginning-position -1)))))))
 
 (provide 'test-org-clock)
 ;;; test-org-clock.el end here