From mboxrd@z Thu Jan 1 00:00:00 1970 From: Myles English Subject: Re: Remaining work/progress report: nearly useful, help needed Date: Sat, 13 Oct 2012 02:48:10 +0100 Message-ID: <877gqvjg6d.fsf@ed.ac.uk> References: <87fw5mjv31.fsf@ed.ac.uk>, <87d30pjjz2.fsf@ed.ac.uk>, <878vbbk6ph.fsf@ed.ac.uk> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([208.118.235.92]:32996) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TMqiN-0002e5-5w for emacs-orgmode@gnu.org; Fri, 12 Oct 2012 21:40:32 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1TMqiK-0004p4-U0 for emacs-orgmode@gnu.org; Fri, 12 Oct 2012 21:40:31 -0400 Received: from mail-wg0-f41.google.com ([74.125.82.41]:45733) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TMqiK-0004nR-Gg for emacs-orgmode@gnu.org; Fri, 12 Oct 2012 21:40:28 -0400 Received: by mail-wg0-f41.google.com with SMTP id ds1so62661wgb.0 for ; Fri, 12 Oct 2012 18:40:27 -0700 (PDT) In-reply-to: <878vbbk6ph.fsf@ed.ac.uk> List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Emacs Org mode --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=my-progress.el Content-Transfer-Encoding: quoted-printable (defun my-progress-rename-properties () "For TOC style columnview table. Don't want to include DONE items in the TODO Effort column so copy Effort to Old_Effort property" (interactive) ( when (string=3D (org-get-todo-state) "DONE") (member (org-get-todo-state) org-done-keywords) ;; check if changing to DONE (org-entry-put nil "Old_Effort" (org-get-effort)) (org-entry-put nil "Old_Remaining" (my-progress-get-remaining)) ;; get the :Effort: property ;;(message (format "Got: %s when changin to %s" ( org-get-effort ) (org= -get-todo-state))) (setq org-clock-effort (org-get-effort)) (org-entry-delete nil "Effort") (org-entry-delete nil "Remaining")) ( when (string=3D (org-get-todo-state) "TODO") (member (org-get-todo-state) org-done-keywords) ;; check if changing to DONE (org-entry-put nil "Effort" (org-entry-get pom "Old_Effort")) (org-entry-put nil "Remaining" (org-entry-get pom "Old_Remaining")) (setq org-clock-effort (org-get-effort)) (org-entry-delete nil "Old_Effort") (org-entry-delete nil "Old_Remaining"))) (defun my-progress-org-mode-ask-effort () "Ask for an effort estimate when clocking in. From http://nflath.com/201= 0/03/" (unless (org-entry-get (point) "Effort")=20 (let ((effort (completing-read "Effort: " (org-entry-get-multivalued-property (point) "Effort")))) (unless (equal effort "") (org-set-property "Effort" effort))))) (defun my-get-clock-sum (&optional pom) "Get the CLOCKSUM for the current entry." (org-clock-sum) (org-entry-get pom "CLOCKSUM")) (defcustom my-progress-remaining-property "Remaining" "The property that is being used to keep track of remaining effort \(estimated\) to be expended. Automatically calculated. Has the format H:MM." :group 'my-progress :type '(string :tag "Remaining")) (defun my-progress-get-remaining (&optional pom) "Get the Remaining estimate for the current entry." (org-entry-get pom my-progress-remaining-property)) (provide 'my-progress) (defun toc-alist () (let ( (ascii (org-export-as 'my-progress-toc)) (mylist nil) (newcons "")) (dolist (bb (split-string ascii "\n")) (when (string-match "^\\(\.*\\( \\)*[.1-9]+\\) \\([a-z].*\\)$" bb) (setq newcons (cons (match-string 3 bb) (match-string 1 bb))) (add-to-list 'mylist newcons))) mylist)) (defun org-dblock-write:columnview-toc (params) "Write the column view table. PARAMS is a property list of parameters: :width enforce same column widths with specifiers. :id the :ID: property of the entry where the columns view should be built. When the symbol `local', call locally. When `global' call column view with the cursor at the beginning of the buffer (usually this means that the whole buffer switches to column view). When \"file:path/to/file.org\", invoke column view at the start of that file. Otherwise, the ID is located using `org-id-find'. :hlines When t, insert a hline before each item. When a number, insert a hline before each level <=3D that number. :vlines When t, make each column a colgroup to enforce vertical lines. :maxlevel When set to a number, don't capture headlines below this level. :skip-empty-rows When t, skip rows where all specifiers other than ITEM are empt= y." (require 'org-timer) (let ((pos (move-marker (make-marker) (point))) (hlines (plist-get params :hlines)) (vlines (plist-get params :vlines)) (maxlevel (plist-get params :maxlevel)) (content-lines (org-split-string (plist-get params :content) "\n"= )) (skip-empty-rows (plist-get params :skip-empty-rows)) tbl id idpos nfields tmp recalc line id-as-string view-file view-pos mytoc) (when (setq id (plist-get params :id)) (setq id-as-string (cond ((numberp id) (number-to-string id)) ((symbolp id) (symbol-name id)) ((stringp id) id) (t ""))) (cond ((not id) nil) ((eq id 'global) (setq view-pos (point-min))) ((eq id 'local)) ((string-match "^file:\\(.*\\)" id-as-string) (setq view-file (match-string 1 id-as-string) view-pos 1) (unless (file-exists-p view-file) (error "No such file: \"%s\"" id-as-string))) ((setq idpos (org-find-entry-with-id id)) (setq view-pos idpos)) ((setq idpos (org-id-find id)) (setq view-file (car idpos)) (setq view-pos (cdr idpos))) (t (error "Cannot find entry with :ID: %s" id)))) (with-current-buffer (if view-file (get-file-buffer view-file) (current-buffer)) ;; do everything in a copy of the current buffer (org-export-with-current-buffer-copy (org-export-expand-include-keyword) (save-excursion (setq mytoc (reverse (toc-alist)))) (save-excursion (save-restriction (widen) (goto-char (or view-pos (point))) (org-columns) (setq tbl (org-columns-capture-view maxlevel skip-empty-rows)) (setq nfields (length (car tbl))) (org-columns-quit))))) (goto-char pos) (move-marker pos nil) (when tbl (when (plist-get params :hlines) (setq tmp nil) (while tbl (if (eq (car tbl) 'hline) (push (pop tbl) tmp) (if (string-match "\\` *\\(\\*+\\)" (caar tbl)) (if (and (not (eq (car tmp) 'hline)) (or (eq hlines t) (and (numberp hlines) (<=3D (- (match-end 1) (match-beginning= 1)) hlines)))) (push 'hline tmp))) (push (pop tbl) tmp))) (setq tbl (nreverse tmp))) (when vlines (setq tbl (mapcar (lambda (x) (if (eq 'hline x) x (cons "" x))) tbl)) (setq tbl (append tbl (list (cons "/" (make-list nfields "<>"))))= )) (setq pos (point)) (when content-lines (while (string-match "^#" (car content-lines)) (insert (pop content-lines) "\n"))) (setq tmptbl (org-listtable-to-string tbl)) ;; swap half of the line for the numbers in the TOC (let ((shline "") (keya "") (nline "") (lenline 1) (task "") (was-dash nil) (first-char ".") (effort-accum 0) (remaining-accum 0)) (dolist (shline (split-string tmptbl "\n")) (let ((is-dash (string=3D "|-|" shline)) (writeline t)) (if (and (string-match "^|\\([*]*\\) \\(.*\\)" shline) (> (length (match-string 1 shline)) 12)) (progn (setq task (match-string 2 shline)) (when (string-match "\\(TODO \\|NEXT \\)" task) (setq task (replace-match "" nil t task 0)) (setq shline (concat "|" first-char (make-string lenline ?\s) tas= k "|"))) (when (string-match "DONE " task) (setq shline "DEL")))) ;; if it is a first level heading then accumulate the time va= lue ;; e.g. "|* XX |49:30:2|" (when (string-match "^|[*][ ]+.*|\\([0-9]*:*[0-9]*:*[0-9]+\\)= |\\([0-9]*:*[0-9]*:*[0-9]+\\)|\\([0-9]*:*[0-9]*:*[0-9]+\\)|" shline) (let ((effort-time (match-string 1 shline)) (remaining-time (match-string 3 shline))) (when effort-time ;; found a time (message (format "found effort-time: %s in shline: %s= " effort-time shline)) (setq effort-accum (+ effort-accum (org-timer-hms-to-secs (org-timer-fix-incomplete ;; assume times are HH:MM and so append :00 = seconds (concat effort-time ":00")))))) (when remaining-time ;; found a time (message (format "found remaining-time: %s in shline:= %s" remaining-time shline)) (setq remaining-accum (+ remaining-accum (org-timer-hms-to-secs (org-timer-fix-incomplete ;; assume times are HH:MM and so append :00 = seconds (concat remaining-time ":00")))))))) ;; if it is a headline, add the section number to the start (when (string-match "^|\\(.*[*] \\)\\(.*?\\)[ ]*|.*" shline) (setq keya (match-string 2 shline)) (setq toc-num (cdr (assoc-string keya mytoc))) ;; if the heading had an entry in the toc then include the ;; heading and replace with the toc section number, otherwi= se ;; don't include the line at all, this will effectively exc= lude ;; headings not for export (if toc-num (progn (setq mstr (concat first-char toc-num " ")) (message (format "shline: %s keya: %s mstr: %s" shlin= e keya mstr)) (setq lenline (length mstr)) (setq shline (replace-match mstr nil t shline 1)) (setq mytoc (remove (assoc-string keya mytoc) mytoc )= )) (setq shline "DEL"))) ;; add back in (if (string-match "\\(^|[*]* END.*\\|^DEL\\)" shline) (progn (message (concat " org-dblock-write:columnview-toc : Excluding" shline)) (setq writeline nil))) ;; don't want two dashed rows next to each other (if is-dash (progn (when was-dash (setq writeline nil)) (setq was-dash t)) ;; if writeline is false then leave was-dash untouched (when writeline (setq was-dash nil))) (when writeline (setq nline (concat nline shline "\n"))))) ;; add a row for the the accumulated time ;; how many rows? (setq effort-accum-hms (org-timer-secs-to-hms effort-accum)) (string-match "^\\([0-9]+:[0-9]+\\)\\(:[0-9]+\\)" effort-accum-hms) (message effort-accum-hms) (setq effort-accum-hm (match-string 1 effort-accum-hms)) (setq remaining-accum-hms (org-timer-secs-to-hms remaining-accum)) (string-match "^\\([0-9]+:[0-9]+\\)\\(:[0-9]+\\)" remaining-accum-h= ms) (message remaining-accum-hms) (setq remaining-accum-hm (match-string 1 remaining-accum-hms)) ;;(match-string 1 shline) (setq nline (concat nline ;; "|Total time: |" (org-timer-secs-to-hms effort-accum) = "|\n")) "|-|-|\n|Total time [H:M]: |" effort-accum-hm "| |" remaining-accum-hm "|\n")) (setq tmptbl nline)) ;; ----------- (end swap) --------- (insert tmptbl) (when (plist-get params :width) (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x))) org-columns-current-widths "|"))) (while (setq line (pop content-lines)) (when (string-match "^#" line) (insert "\n" line) (when (string-match "^[ \t]*#\\+TBLFM" line) (setq recalc t)))) (if recalc (progn (goto-char pos) (org-table-recalculate 'all)) (goto-char pos) (org-table-align))))) (defun my-progress-ascii-toc-template (contents info) "Return complete document string after ASCII conversion. CONTENTS is the transcoded contents string. INFO is a plist holding export options. Cookie cut from org-e-ascii-template. " (org-element-normalize-string (org-e-ascii--indent-string (let ((text-width (- org-e-ascii-text-width org-e-ascii-global-margin))) (concat (let ((depth (plist-get info :with-toc))) (when depth (concat (org-e-ascii--build-toc info (and (wholenump depth) depth)) "\n\n\n"))))) org-e-ascii-global-margin))) (require 'org-e-ascii) (org-export-define-derived-backend my-progress-toc e-ascii :translate-alist ((template . my-progress-ascii-toc-template))) (defun my-progress-remove-toc-heading (output backend info) (when (and (memq backend '(my-progress-toc)) (string-match "Table of Contents\n_________________\n\n" output)) (replace-match "" nil nil output))) ;;(add-to-list 'org-export-filter-final-output-functions 'my-progress-remov= e-toc-heading) --=-=-= Content-Type: text/plain I have a solution that does everything I need apart from exclude DONE items from the CLOCKSUM property. Writing it here for posterity. I get a table like this (Note: the "0:08" is from a DONE task that is excluded from the table and the other property columns): #+BEGIN: columnview-toc :id file:a.org | ITEM | Effort | CLOCKSUM | Remaining | | |----------------------------------------------------+--------+----------+-----------+---| | .1 Heading One | 3:28 | 1:13 | 2:23 | | | ... 1.1 First heading | | | | | | ... 1.2 A sub heading | | 0:08 | | | | ... 1.3 Another sub heading | | 1:05 | | | | . Write this bit | 1:20 | 0:50 | 0:30 | | | . Do something | 1:23 | 0:05 | 1:18 | | | . This bit too | 0:45 | 0:10 | 0:35 | | | ... 1.4 Heading with no inline tasks | | | | | | ...... 1.4.1 a | | | | | | .2 Heading Two | 0:40 | 0:12 | 0:33 | | | . Finish writing under heading two | | | | | | ... 2.1 Sub heading that will show up in the table | 0:20 | 0:05 | 0:14 | | | ...... 2.1.1 Will this one? | 0:20 | 0:05 | 0:14 | | | . Test | 0:20 | 0:05 | 0:14 | | | ... 2.2 Yet another subheading | 0:20 | 0:07 | 0:19 | | | ...... 2.2.1 A sub sub heading | | 0:07 | | | | . Do an inline thing | 0:20 | 0:07 | 0:19 | | | ...... 2.2.2 Another sub sub heading | | | | | | .3 Heading Three of main doc | 2:28 | 1:00 | 0:30 | | | ... 3.1 An included sub heading | | | | | | ... 3.2 Yet another included subheading | 2:28 | 1:00 | 0:30 | | | ...... 3.2.1 An included sub sub heading | | 1:00 | | | | . Yet More Do an included inline thing | 1:30 | 1:00 | 0:30 | | | .4 Heading Four | | 0:06 | | | | . Finish writing under included heading two | | | | | | . Somethingorother | 0:58 | 0:06 | | | | .5 Progress table | | | | | |----------------------------------------------------+--------+----------+-----------+---| | Total time [H:M]: | 6:36 | | 3:26 | | #+END: By using the attached library (my-progress.el), having these columns defined: #+COLUMNS: %5ITEM %5Effort{:} %5CLOCKSUM %5Remaining{:} and using this config: ;; ----------------------------- BEGIN my-progress.el -------- (add-to-list 'load-path "~/lib/lisp") (require 'my-progress) (add-to-list 'org-export-filter-final-output-functions 'my-progress-remove-toc-heading) (add-to-list 'org-properties-postprocess-alist '("Remaining" lambda(value) (let ((clocksum (org-duration-string-to-minutes (my-get-clock-sum))) (effort (org-duration-string-to-minutes (org-entry-get (point) "Effort")))) (org-minutes-to-hh:mm-string (- effort clocksum))))) (add-hook 'org-clock-in-prepare-hook 'my-progress-org-mode-ask-effort 'append) (add-hook 'org-clock-out-hook (lambda () (org-set-property my-progress-remaining-property 0)) 'append) (add-hook 'org-after-todo-state-change-hook 'my-progress-rename-properties) ;; ----------------------------- END my-progress.el ---------- Myles --=-=-=--