forked from mirrors/org-mode
Clocktables including archives.
This commit is contained in:
Carsten Dominik
parent
8b79f0b650
commit
f35c6615a5
|
|
@ -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:}
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
29
lisp/org.el
29
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue