Clocktables including archives.

doc/org.texi

@@ -4542,6 +4542,8 @@ new table.  The @samp{BEGIN} line can specify options:
              tree       @r{the surrounding level 1 tree}
              agenda     @r{all agenda files}
              ("file"..) @r{scan these files}
+             file-with-archives    @r{current file and its archives}
+             agenda-with-archives  @r{all agenda files, including archives}
 :block       @r{The time block to consider.  This block is specified either}
              @r{absolute, or relative to the current time and may be any of}
              @r{these formats:}

lisp/org-archive.el

@@ -87,6 +87,64 @@ information."
 	  (const :tag "Outline path" olpath)
 	  (const :tag "Local tags" ltags)))
 
+(defun org-get-local-archive-location ()
+  "Get the archive location applicable at point."
+  (let ((re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
+	prop)
+    (save-excursion
+      (save-restriction
+	(widen)
+	(setq prop (org-entry-get nil "ARCHIVE" 'inherit))
+	(cond
+	 ((and prop (string-match "\\S-" prop))
+	  prop)
+	 ((or (re-search-backward re nil t)
+	      (re-search-forward re nil t))
+	  (match-string 1))
+	 (t org-archive-location (match-string 1)))))))
+
+(defun org-add-archive-files (files)
+  "Splice the archive files into the list f files.
+This implies visiting all these files and finding out what the
+archive file is."
+  (apply
+   'append
+   (mapcar
+    (lambda (f)
+      (if (not (file-exists-p f))
+	  nil
+	(with-current-buffer (org-get-agenda-file-buffer f)
+	  (cons f (org-all-archive-files)))))
+    files)))
+
+(defun org-all-archive-files ()
+  "Get a list of all archive files used in the current buffer."
+  (let (file files)
+    (save-excursion
+      (save-restriction
+	(goto-char (point-min))
+	(while (re-search-forward 
+		"^\\(#\\+\\|[ \t]*:\\)ARCHIVE:[ \t]+\\(.*\\)"
+		nil t)
+	  (setq file (org-extract-archive-file (match-string 2)))
+	  (and file (> (length file) 0) (file-exists-p file)
+	       (add-to-list 'files file)))))
+    (setq files (nreverse files))
+    (setq file (org-extract-archive-file))
+    (and file (> (length file) 0) (file-exists-p file)
+	 (add-to-list 'files file))
+    files))
+
+(defun org-extract-archive-file (&optional location)
+  (setq location (or location org-archive-location))
+  (if (string-match "\\(.*\\)::\\(.*\\)" location)
+      (format (match-string 1 location) buffer-file-name)))
+
+(defun org-extract-archive-heading (&optional location)
+  (setq location (or location org-archive-location))
+  (if (string-match "\\(.*\\)::\\(.*\\)" location)
+      (match-string 2 location)))
+
 (defun org-archive-subtree (&optional find-done)
   "Move the current subtree to the archive.
 The archive can be a certain top-level heading in the current file, or in
@@ -111,8 +169,6 @@ this heading."
 	  (tr-org-todo-line-regexp org-todo-line-regexp)
 	  (tr-org-odd-levels-only org-odd-levels-only)
 	  (this-buffer (current-buffer))
-	  (org-archive-location org-archive-location)
-	  (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
           ;; start of variables that will be used for saving context
 	  ;; The compiler complains about them - keep them anyway!
 	  (file (abbreviate-file-name (buffer-file-name)))
@@ -120,28 +176,17 @@ this heading."
 	  (time (format-time-string
 		 (substring (cdr org-time-stamp-formats) 1 -1)
 		 (current-time)))
-	  afile heading buffer level newfile-p
-	  category todo priority
-          ;; start of variables that will be used for savind context
-          ltags itags prop)
+	  category todo priority ltags itags
+          ;; end of variables that will be used for saving context
+	  location afile heading buffer level newfile-p)
 
-      ;; Try to find a local archive location
-      (save-excursion
-	(save-restriction
-	  (widen)
-	  (setq prop (org-entry-get nil "ARCHIVE" 'inherit))
-	  (if (and prop (string-match "\\S-" prop))
-	      (setq org-archive-location prop)
-	    (if (or (re-search-backward re nil t)
-		    (re-search-forward re nil t))
-		(setq org-archive-location (match-string 1))))))
-
-      (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location)
-	  (progn
-	    (setq afile (format (match-string 1 org-archive-location)
-				(file-name-nondirectory buffer-file-name))
-		  heading (match-string 2 org-archive-location)))
+      ;; Find the local archive location
+      (setq location (org-get-local-archive-location)
+	    afile (org-extract-archive-file location)
+	    heading (org-extract-archive-heading location))
+      (unless afile
 	(error "Invalid `org-archive-location'"))
+
       (if (> (length afile) 0)
 	  (setq newfile-p (not (file-exists-p afile))
 		buffer (find-file-noselect afile))

lisp/org-clock.el

@@ -592,7 +592,7 @@ the currently selected interval size."
 	   (block (plist-get params :block))
 	   (link (plist-get params :link))
 	   ipos time p level hlc hdl
-	   cc beg end pos tbl tbl1 range-text)
+	   cc beg end pos tbl tbl1 range-text rm-file-column)
       (setq org-clock-file-total-minutes nil)
       (when step
 	(org-clocktable-steps params)
@@ -616,8 +616,17 @@ the currently selected interval size."
 
       ;; Get the right scope
       (setq pos (point))
-      (if (and scope (listp scope) (symbolp (car scope)))
-	  (setq scope (eval scope)))
+      (cond
+       ((and scope (listp scope) (symbolp (car scope)))
+	(setq scope (eval scope)))
+       ((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 (org-add-archive-files (list (buffer-file-name)))
+	      rm-file-column t)))
       (save-restriction
 	(cond
 	 ((not scope))
@@ -635,8 +644,8 @@ the currently selected interval size."
 	      (if (<= (org-reduced-level (funcall outline-level)) level)
 		  (throw 'exit nil))))
 	  (org-narrow-to-subtree))
-	 ((or (listp scope) (eq scope 'agenda))
-	  (let* ((files (if (listp scope) scope (org-agenda-files t)))
+	 ((listp scope)
+	  (let* ((files scope)
 		 (scope 'agenda)
 		 (p1 (copy-sequence params))
 		 file)
@@ -649,7 +658,7 @@ the currently selected interval size."
 		(setq tbl1 (org-dblock-write:clocktable p1))
 		(when tbl1
 		  (push (org-clocktable-add-file
-			 file 
+			 file
 			 (concat "| |*File time*|*"
 				 (org-minutes-to-hh:mm-string
 				  org-clock-file-total-minutes)
@@ -659,7 +668,7 @@ the currently selected interval size."
 				      org-clock-file-total-minutes))))))))
 	(goto-char pos)
 
-	(unless (or (eq scope 'agenda) (listp scope))
+	(unless (listp scope)
 	  (org-clock-sum ts te)
 	  (goto-char (point-min))
 	  (while (setq p (next-single-property-change (point) :org-clock-minutes))
@@ -701,12 +710,12 @@ the currently selected interval size."
 		"]"
 		(if block (concat ", for " range-text ".") "")
 		"\n\n"))
-	   (if (or (eq scope 'agenda) (listp scope)) "|File" "")
+	   (if (listp scope) "|File" "")
 	   "|L|Headline|Time|\n")
 	  (setq total-time (or total-time org-clock-file-total-minutes))
 	  (insert-before-markers
 	   "|-\n|"
-	   (if (or (eq scope 'agenda) (listp scope)) "|" "")
+	   (if (listp scope) "|" "")
 	   "|"
 	   "*Total time*| *"
 	   (org-minutes-to-hh:mm-string (or total-time 0))
@@ -717,11 +726,14 @@ the currently selected interval size."
 	      (pop tbl))
 	  (insert-before-markers (mapconcat
 				  'identity (delq nil tbl)
-				  (if (eq scope 'agenda) "\n|-\n" "\n")))
+				  (if (listp scope) "\n|-\n" "\n")))
 	  (backward-delete-char 1)
 	  (goto-char ipos)
 	  (skip-chars-forward "^|")
-	  (org-table-align))))))
+	  (org-table-align)
+	  (when rm-file-column
+	    (forward-char 1)
+	    (org-table-delete-column)))))))
 
 (defun org-clocktable-steps (params)
   (let* ((p1 (copy-sequence params))

lisp/org.el

@@ -2532,8 +2532,10 @@ collapsed state."
 
 (defalias 'org-advertized-archive-subtree 'org-archive-subtree)
 
-(org-autoload "org-archive"
-  '(org-archive-subtree org-archive-to-archive-sibling org-toggle-archive-tag))
+(eval-and-compile
+  (org-autoload "org-archive"
+   '(org-add-archive-files org-archive-subtree
+     org-archive-to-archive-sibling org-toggle-archive-tag)))
 
 ;; Autoload Column View Code
 
@@ -12882,29 +12884,6 @@ really on, so that the block visually is on the match."
      (mapcar (lambda (x) (or (get-file-buffer x) (find-file-noselect x))) files)
      regexp)))
 
-(defun org-add-archive-files (files)
-  "Splice the archive files into the list f files.
-This implies visiting all these files and finding out what the
-archive file is."
-  (let (afile)
-    (apply
-     'append
-     (mapcar
-      (lambda (f)
-	(if (not (file-exists-p f))
-	  nil
-	  (with-current-buffer (or (get-file-buffer f)
-				   (find-file-noselect f))
-
-	    (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location)
-		(setq afile (format (match-string 1 org-archive-location)
-				    buffer-file-name))
-	      (setq afile nil))
-	    (if (and afile (file-exists-p afile))
-		(list f afile)
-	      (list f)))))
-      files))))
-
 (if (boundp 'occur-mode-find-occurrence-hook)
     ;; Emacs 23
     (add-hook 'occur-mode-find-occurrence-hook