From mboxrd@z Thu Jan 1 00:00:00 1970 From: Myles English Subject: Re: Remaining Work Report Date: Mon, 26 Mar 2012 11:49:49 +0100 Message-ID: <877gy7skky.fsf@gmail.com> References: <80ehsog1gi.fsf@somewhere.org> <87limshfif.fsf@gmail.com> Reply-To: emacs-orgmode@gnu.org, Myles English Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([208.118.235.92]:44916) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SC7Qi-0003vu-0h for emacs-orgmode@gnu.org; Mon, 26 Mar 2012 06:45:45 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1SC7QZ-0004tg-C2 for emacs-orgmode@gnu.org; Mon, 26 Mar 2012 06:45:39 -0400 Received: from mail-wg0-f49.google.com ([74.125.82.49]:64053) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SC7QY-0004t6-QS for emacs-orgmode@gnu.org; Mon, 26 Mar 2012 06:45:31 -0400 Received: by wgbdr1 with SMTP id dr1so2797621wgb.30 for ; Mon, 26 Mar 2012 03:45:27 -0700 (PDT) In-Reply-To: (Manish's message of "Sat, 24 Mar 2012 19:58:46 +0530") 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: Manish , emacs-orgmode Mode --=-=-= >> On Sat, 24 Mar 2012 19:58:46 +0530, Manish said: >> Unlike your example I made heavy use of inline tasks and also >> wanted heading numbers instead of asterisks, so that the final >> table looks like a table of contents with estimated times >> remaining. I had to do some more things to achieve this and can >> elaborate if you like. >> > This is a very nice solution. Please do elaborate on the other > steps when you have time. > Cheers! -- Manish I hope this is not too OT for the OP. The functions I used are in the attached file and used like this: #+BEGIN: columnview-toc :id file:myfile.org #+END: And that gives you a TOC plus inline tasks and times. The accumulation of inline task times didn't work until a patch was applied by Bastian at the weekend. The solution uses the older org-export-as-ascii which is why I had not shared it until now, but if someone has the time... Myles --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=myfuncs.el Content-Transfer-Encoding: quoted-printable (provide 'myfuncs) (defun my-get-toc (arg &optional hidden ext-plist to-buffer pub-dir) "A modified org-export-as-ascii. Export the outline as a pretty ASCII file. If there is an active region, export only the region. The prefix ARG specifies how many levels of the outline should become underlined headlines, default is 3. Lower levels will become bulleted lists. When HIDDEN is non-nil, don't display the ASCII buffer. EXT-PLIST is a property list with external parameters overriding org-mode's default settings, but still inferior to file-local settings. When TO-BUFFER is non-nil, create a buffer with that name and export to that buffer. If TO-BUFFER is the symbol `string', don't leave any buffer behind but just return the resulting ASCII as a string. When PUB-DIR is set, use this as the publishing directory." (interactive "P") (run-hooks 'org-export-first-hook) (setq-default org-todo-line-regexp org-todo-line-regexp) (let* ((opt-plist (org-combine-plists (org-default-export-plist) ext-plist (org-infile-export-plist))) (region-p (org-region-active-p)) (rbeg (and region-p (region-beginning))) (rend (and region-p (region-end))) (subtree-p (if (plist-get opt-plist :ignore-subtree-p) nil (when region-p (save-excursion (goto-char rbeg) (and (org-at-heading-p) (>=3D (org-end-of-subtree t t) rend)))))) (level-offset (if subtree-p (save-excursion (goto-char rbeg) (+ (funcall outline-level) (if org-odd-levels-only 1 0))) 0)) (opt-plist (setq org-export-opt-plist (if subtree-p (org-export-add-subtree-options opt-plist r= beg) opt-plist))) ;; The following two are dynamically scoped into other ;; routines below. (org-current-export-dir (or (org-export-directory :html opt-plist))) (org-current-export-file buffer-file-name) (custom-times org-display-custom-times) (org-ascii-current-indentation '(0 . 0)) (level 0) line txt (umax nil) (umax-toc nil) (case-fold-search nil) (bfname (buffer-file-name (or (buffer-base-buffer) (current-buff= er)))) (filename (if to-buffer nil (concat (file-name-as-directory (or pub-dir (org-export-directory :ascii opt-plist)= )) (file-name-sans-extension (or (and subtree-p (org-entry-get (region-beginning) "EXPORT_FILE_NAME" = t)) (file-name-nondirectory bfname))) ".txt"))) (filename (and filename (if (equal (file-truename filename) (file-truename bfname)) (concat filename ".txt") filename))) (buffer (if to-buffer (cond ((eq to-buffer 'string) (get-buffer-create "*Org ASCII Export*")) (t (get-buffer-create to-buffer))) (find-file-noselect filename))) (org-levels-open (make-vector org-level-max nil)) (odd org-odd-levels-only) (date (plist-get opt-plist :date)) (author (plist-get opt-plist :author)) (title (or (and subtree-p (org-export-get-title-from-subtree)) (plist-get opt-plist :title) (and (not (plist-get opt-plist :skip-before-1st-heading)) (org-export-grab-title-from-buffer)) (and (buffer-file-name) (file-name-sans-extension (file-name-nondirectory bfname))) "UNTITLED")) (email (plist-get opt-plist :email)) (language (plist-get opt-plist :language)) (quote-re0 (concat "^\\(" org-quote-string "\\)\\( +\\|[ \t]*$\\= )")) (todo nil) (lang-words nil) (region (buffer-substring (if (org-region-active-p) (region-beginning) (point-min)) (if (org-region-active-p) (region-end) (point-max)))) (org-export-footnotes-seen nil) (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) (lines (org-split-string (org-export-preprocess-string region :for-backend 'ascii :skip-before-1st-heading (plist-get opt-plist :skip-before-1st-heading) :drawers (plist-get opt-plist :drawers) :tags (plist-get opt-plist :tags) :priority (plist-get opt-plist :priority) :footnotes (plist-get opt-plist :footnotes) :timestamps (plist-get opt-plist :timestamps) :todo-keywords (plist-get opt-plist :todo-keywords) :tasks (plist-get opt-plist :tasks) :verbatim-multiline t :select-tags (plist-get opt-plist :select-tags) :exclude-tags (plist-get opt-plist :exclude-tags) :archived-trees (plist-get opt-plist :archived-trees) :add-text (plist-get opt-plist :text)) "\n")) thetoc have-headings first-heading-pos table-open table-buffer link-buffer link type path desc desc0 rp= l wrap fnc) (let ((inhibit-read-only t)) (org-unmodified (remove-text-properties (point-min) (point-max) '(:org-license-to-kill t)))) =20=20 (setq org-min-level (org-get-min-level lines level-offset)) (setq org-last-level org-min-level) (org-init-section-numbers) (setq lang-words (or (assoc language org-export-language-setup) (assoc "en" org-export-language-setup))) (set-buffer buffer) (erase-buffer) (fundamental-mode) (org-install-letbind) ;; create local variables for all options, to make sure all called ;; functions get the correct information (mapc (lambda (x) (set (make-local-variable (nth 2 x)) (plist-get opt-plist (car x)))) org-export-plist-vars) (org-set-local 'org-odd-levels-only odd) (setq umax (if arg (prefix-numeric-value arg) org-export-headline-levels)) (setq umax-toc (if (integerp org-export-with-toc) (min org-export-with-toc umax) umax)) =20=20 ;; File header =20=20=20=20=20=20 (progn (mapc #'(lambda (line) (if (string-match org-todo-line-regexp line) ;; This is a headline (progn (setq have-headings t) (setq level (- (match-end 1) (match-beginning 1) level-offset) level (org-tr-level level) txt (match-string 3 line) todo (or (and org-export-mark-todo-in-toc (match-beginning 2) (not (member (match-string 2 line) org-done-keywords))) ; TODO, not DONE (and org-export-mark-todo-in-toc (=3D level umax-toc) (org-search-todo-below line lines level)))) (setq txt (org-html-expand-for-ascii txt)) =20=20 (while (string-match org-bracket-link-regexp txt) (setq txt (replace-match (match-string (if (match-end 2) 3 1) tx= t) t t txt))) =20=20 (if (and (memq org-export-with-tags '(not-in-toc= nil)) (string-match (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t= ]*$") txt)) (setq txt (replace-match "" t t txt))) (if (string-match quote-re0 txt) (setq txt (replace-match "" t t txt 1))) =20=20 (if org-export-with-section-numbers (setq txt (concat (org-section-number level) " " txt))) (if (<=3D level umax-toc) (progn (push (concat (make-string (* (max 0 (- level org-min-level)) 4) ?= \ ) (format (if todo "%s (*)\n" "%s\n") txt)) thetoc) (setq org-last-level level)) )))) lines) (setq thetoc (if have-headings (nreverse thetoc) nil))) =20=20 (normal-mode) =20=20 ;; insert the table of contents (when thetoc (goto-char (point-min)) (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil = t) (progn (goto-char (match-beginning 0)) (replace-match ""))) (mapc 'insert thetoc)) =20=20 ;; Convert whitespace place holders (goto-char (point-min)) (let (beg end) (while (setq beg (next-single-property-change (point) 'org-whitespa= ce)) (setq end (next-single-property-change beg 'org-whitespace)) (goto-char beg) (delete-region beg end) (insert (make-string (- end beg) ?\ )))) =20=20 ;; remove display and invisible chars (let (beg end) (goto-char (point-min)) (while (setq beg (next-single-property-change (point) 'display)) (setq end (next-single-property-change beg 'display)) (delete-region beg end) (goto-char beg) (insert "=3D>")) (goto-char (point-min)) (while (setq beg (next-single-property-change (point) 'org-cwidth)) (setq end (next-single-property-change beg 'org-cwidth)) (delete-region beg end) (goto-char beg))) (run-hooks 'org-export-ascii-final-hook) (or to-buffer (save-buffer)) (goto-char (point-min)) (or (org-export-push-to-kill-ring "ASCII") (message "Exporting... done")) ;; Return the buffer or a string, according to how this function was = called (if (eq to-buffer 'string) (prog1 (buffer-substring (point-min) (point-max)) (kill-buffer (current-buffer))) (current-buffer)))) (defun toc-alist () (let ( (ascii (my-get-toc nil nil nil 'string)) (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-columns-capture-view-toc (&optional maxlevel skip-empty-rows) "Get the column view of the current buffer or subtree. The first optional argument MAXLEVEL sets the level limit. A second optional argument SKIP-EMPTY-ROWS tells whether to skip empty rows, an empty row being one where all the column view specifiers except ITEM are empty. This function returns a list containing the title row and all other rows. Each row is a list of fields." (save-excursion (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled)) (re-comment (format org-heading-keyword-regexp-format org-comment-string)) (re-archive (concat ".*:" org-archive-tag ":")) (n (length title)) row tbl) (goto-char (point-min)) (while (re-search-forward org-heading-regexp nil t) (catch 'next (when (and (or (null maxlevel) (>=3D maxlevel (if org-odd-levels-only (/ (1+ (length (match-string 1))) 2) (length (match-string 1))))) (get-char-property (match-beginning 0) 'org-columns-ke= y)) (when (save-excursion (goto-char (point-at-bol)) (or (looking-at re-comment) (looking-at re-archive))) (org-end-of-subtree t) (throw 'next t)) (setq row nil) (loop for i from 0 to (1- n) do (push (org-quote-vert (or (get-char-property (+ (match-beginning 0) i) 'org-c= olumns-value-modified) (get-char-property (+ (match-beginning 0) i) 'org-c= olumns-value) "")) row)) (setq row (nreverse row)) (unless (and skip-empty-rows (eq 1 (length (delete "" (delete-dups (copy-sequen= ce row)))))) (push row tbl))))) (append (list title 'hline) (nreverse tbl))))) (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 empty." (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)) (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-toc 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 ".") (accum-time 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) task "|"))) (when (string-match "DONE " task) (setq shline "DEL"))) ;; if it is a first level heading then accumulate the time value ;; e.g. "|* XX |49:30:2|" (when (string-match "^|[*][ ]+.*|\\([0-9]*:*[0-9]*:*[0-9]+\\)|" shli= ne) (let ((str-time (match-string 1 shline))) (when str-time ;; found a time (setq accum-time (+ accum-time (org-timer-hms-to-secs (org-timer-fix-incomplete ;; assume times are HH:MM and so append :00 seconds (concat (match-string 1 shline) ":00")))))))) ;; if it is a headline, add the section number to the start (when (string-match "^|\\(.*[*] \\)\\(.*?\\)[ ]*|.*" shline) =09=09 (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, otherwise ;; don't include the line at all, this will effectively exclude ;; headings not for export (if toc-num (progn (setq mstr (concat first-char toc-num " ")) (message (format "shline: %s keya: %s mstr: %s" shline 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 accum-time-hms (org-timer-secs-to-hms accum-time)) (string-match "^\\([0-9]+:[0-9]+\\)\\(:[0-9]+\\)" accum-time-hms) (message accum-time-hms) (setq accum-time-hm (match-string 1 accum-time-hms)) ;;(match-string 1 shline) (setq nline (concat nline ;; "|Total time: |" (org-timer-secs-to-hms accum-time) "|\n")) "|-|-|\n|Total time [H:M]: |" accum-time-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))))) (require 'org) (defun my-move-effort-if-done () "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)) ;; get the :Effort: property ;(message (format "Got: %s when changin to %s" ( org-get-effort ) (or= g-get-todo-state))) (setq org-clock-effort (org-get-effort)) (org-entry-delete nil "Effort"))) (setq org-after-todo-state-change-hook nil) (add-hook 'org-after-todo-state-change-hook 'my-move-effort-if-done) ;;(when (string-match "^|\\(.*[*] \\)\\(.*?\\)[ ]*|.*" shline) ;; ;; if it is a first level heading then accumulate the time value ;; ;; e.g. "|* XX |49:30:2|" ;; (when (string-match "^|[*][ ]+.*|\\([0-9]*:*[0-9]*:*[0-9]+\\)|" shline) ;; (let ((str-time (match-string 1 shline))) ;; (when str-time ;; found a time ;; (setq accum-time ;; (+ accum-time ;; (org-timer-hms-to-secs ;; (org-timer-fix-incomplete (match-string 1 shline)))))))) --=-=-=--