From mboxrd@z Thu Jan 1 00:00:00 1970 From: Carsten Dominik Subject: Re: [PATCH] Add min/max/mean age operators to column view. Date: Wed, 28 Oct 2009 18:01:44 +0100 Message-ID: <4AD87891-4DD3-4B80-9FD3-2B6B65653E5B@gmail.com> References: <1256515485-28476-1-git-send-email-ahktenzero@mohorovi.cc> Mime-Version: 1.0 (Apple Message framework v936) Content-Type: text/plain; charset=US-ASCII; format=flowed; delsp=yes Content-Transfer-Encoding: 7bit Return-path: Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1N3BuI-0005mA-2F for emacs-orgmode@gnu.org; Wed, 28 Oct 2009 13:01:58 -0400 Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1N3BuC-0005gB-Mh for emacs-orgmode@gnu.org; Wed, 28 Oct 2009 13:01:56 -0400 Received: from [199.232.76.173] (port=33930 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1N3BuC-0005fc-3u for emacs-orgmode@gnu.org; Wed, 28 Oct 2009 13:01:52 -0400 Received: from mail-ew0-f228.google.com ([209.85.219.228]:45928) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1N3BuB-0004N8-1t for emacs-orgmode@gnu.org; Wed, 28 Oct 2009 13:01:51 -0400 Received: by ewy28 with SMTP id 28so1055836ewy.42 for ; Wed, 28 Oct 2009 10:01:50 -0700 (PDT) In-Reply-To: <1256515485-28476-1-git-send-email-ahktenzero@mohorovi.cc> List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: James TD Smith Cc: emacs-orgmode@gnu.org Hi James, hi everyone, this is a reasonably complex patch - could we get some volunteers putting this to the test? Thanks. - Carsten On Oct 26, 2009, at 1:04 AM, James TD Smith wrote: > I posted a patch to the list in July which added two new special > properties > intended for displaying the age of an entry in column view. After some > discussion with Bastien (who was maintainer at the time) we decided > I would > reimplement this functionality using column summary operators. It > took me a > while bit I've finally got a working version. > > The patch is also available in the misc-new-features branch at > git://yog-sothoth.mohorovi.cc/org-mode.git. > > --- > lisp/ChangeLog | 38 +++++++--- > lisp/org-colview.el | 198 +++++++++++++++++++++++++++++++ > +------------------- > lisp/org.el | 4 +- > 3 files changed, 156 insertions(+), 84 deletions(-) > > diff --git a/lisp/ChangeLog b/lisp/ChangeLog > index 1b5848e..5677058 100755 > --- a/lisp/ChangeLog > +++ b/lisp/ChangeLog > @@ -1,3 +1,27 @@ > +2009-10-25 James TD Smith > + > + * org-colview.el (org-format-time-period): Function to format > + times in fractional days for display. > + (org-columns-display-here): Add support for showing a calculated > + value in place of the property. > + (org-columns): Set `org-columns-time' to the current time so time > + difference calculations will work. > + (org-columns-time): Use to store the current time when column view > + is displayed, so all time differences will use the same reference > + point. > + (org-columns-compile-map): There is now an extra position in each > + entry specifying the function to use to calculate the displayed > + value for the non-calculated properties in the column, > + (org-columns-compute-all): Set `org-columns-time' to the current > + time so time difference calculations will work. > + (org-columns-compute): Handle column operators where the values > + used are calculated from the underlying property. > + (org-columns-number-to-string): Handle the 'age' column format > + (org-columns-string-to-number): Correct the function name (was > + org-column...). Add support for the 'age' column format. > + (org-columns-compile-format): Support the additional parameter in > + org-columns-compile-map. > + > 2009-10-25 Carsten Dominik > > * org-clock.el (org-clock-has-been-used): New variable. > @@ -1543,20 +1567,14 @@ > * org-exp.el (org-export-format-source-code-or-example): Fix > bad line numbering when exporting examples in HTML. > > -2009-07-12 James TD Smith > - > * org-colview.el (org-format-time-period): Formats a time in > fractional days as days, hours, mins, seconds. > (org-columns-display-here): Add special handling for SINCE and > SINCE_IA to format for display. > > - * org.el (org-time-since): Add a function to get the time since an > - org timestamp. > - (org-entry-properties): Add two new special properties: SINCE and > - SINCE_IA. These give the time since any active or inactive > - timestamp in an entry. > - (org-special-properties): Add SINCE, SINCE_IA. > - (org-tags-sort-function): Add custom declaration for tags > +2009-07-12 James TD Smith > + > + * org.el (org-tags-sort-function): Add custom declaration for tags > sorting function. > (org-set-tags): Sort tags if org-tags-sort-function is set > > @@ -4423,7 +4441,7 @@ > (org-agenda-change-all-lines, org-tags-sparse-tree) > (org-time-string-to-absolute, org-small-year-to-year) > (org-link-escape): Re-apply changes accidentially overwritten > - by last commit to Emacs. > + by last commit to Emacs > > 2008-11-23 Carsten Dominik > > diff --git a/lisp/org-colview.el b/lisp/org-colview.el > index 374d22a..87c1412 100644 > --- a/lisp/org-colview.el > +++ b/lisp/org-colview.el > @@ -111,8 +111,8 @@ This is the compiled version of the format.") > (org-defkey org-columns-map [(shift meta left)] 'org-columns-delete) > (dotimes (i 10) > (org-defkey org-columns-map (number-to-string i) > - `(lambda () (interactive) > - (org-columns-next-allowed-value nil ,i)))) > + `(lambda () (interactive) > + (org-columns-next-allowed-value nil ,i)))) > > (easy-menu-define org-columns-menu org-columns-map "Org Column Menu" > '("Column" > @@ -165,7 +165,7 @@ This is the compiled version of the format.") > (face1 (list color 'org-agenda-column-dateline ref-face)) > (pl (or (get-text-property (point-at-bol) 'prefix-length) 0)) > (cphr (get-text-property (point-at-bol) 'org-complex-heading- > regexp)) > - pom property ass width f string ov column val modval s2 title) > + pom property ass width f string ov column val modval s2 title calc) > ;; Check if the entry is in another buffer. > (unless props > (if (eq major-mode 'org-agenda-mode) > @@ -189,19 +189,25 @@ This is the compiled version of the format.") > (nth 2 column) > (length property)) > f (format "%%-%d.%ds | " width width) > + calc (nth 7 column) > val (or (cdr ass) "") > - modval (or (and org-columns-modify-value-for-display-function > - (functionp > - org-columns-modify-value-for-display-function) > - (funcall > - org-columns-modify-value-for-display-function > - title val)) > - (if (equal property "ITEM") > - (if (org-mode-p) > - (org-columns-cleanup-item > - val org-columns-current-fmt-compiled) > - (org-agenda-columns-cleanup-item > - val pl cphr org-columns-current-fmt-compiled))))) > + modval (cond ((and org-columns-modify-value-for-display-function > + (functionp > + org-columns-modify-value-for-display-function)) > + (funcall org-columns-modify-value-for-display-function > + title val)) > + ((equal property "ITEM") > + (if (org-mode-p) > + (org-columns-cleanup-item > + val org-columns-current-fmt-compiled) > + (org-agenda-columns-cleanup-item > + val pl cphr org-columns-current-fmt-compiled))) > + ((and calc (functionp calc) > + (not (get-text-property 0 'org-computed val))) > + (org-columns-number-to-string > + (funcall calc (org-columns-string-to-number > + val (nth 4 column))) > + (nth 4 column))))) > (setq s2 (org-columns-add-ellipses (or modval val) width)) > (setq string (format f s2)) > ;; Create the overlay > @@ -220,18 +226,18 @@ This is the compiled version of the format.") > (save-excursion > (goto-char beg) > (org-unmodified (insert " ")))))) ;; FIXME: add props and > remove later? > - ;; Make the rest of the line disappear. > - (org-unmodified > - (setq ov (org-columns-new-overlay beg (point-at-eol))) > - (org-overlay-put ov 'invisible t) > - (org-overlay-put ov 'keymap org-columns-map) > - (org-overlay-put ov 'intangible t) > - (push ov org-columns-overlays) > - (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at- > eol)))) > - (org-overlay-put ov 'keymap org-columns-map) > - (push ov org-columns-overlays) > - (let ((inhibit-read-only t)) > - (put-text-property (max (point-min) (1- (point-at-bol))) > + ;; Make the rest of the line disappear. > + (org-unmodified > + (setq ov (org-columns-new-overlay beg (point-at-eol))) > + (org-overlay-put ov 'invisible t) > + (org-overlay-put ov 'keymap org-columns-map) > + (org-overlay-put ov 'intangible t) > + (push ov org-columns-overlays) > + (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at- > eol)))) > + (org-overlay-put ov 'keymap org-columns-map) > + (push ov org-columns-overlays) > + (let ((inhibit-read-only t)) > + (put-text-property (max (point-min) (1- (point-at-bol))) > (min (point-max) (1+ (point-at-eol))) > 'read-only "Type `e' to edit property"))))) > > @@ -257,6 +263,7 @@ for the duration of the command.") > > (defvar header-line-format) > (defvar org-columns-previous-hscroll 0) > + > (defun org-columns-display-here-title () > "Overlay the newline before the current line with the table title." > (interactive) > @@ -347,6 +354,7 @@ for the duration of the command.") > s) > > (defvar org-agenda-columns-remove-prefix-from-item) > + > (defun org-agenda-columns-cleanup-item (item pl cphr fmt) > "Cleanup the time property for agenda column view. > See also the variable `org-agenda-columns-remove-prefix-from-item'." > @@ -366,6 +374,7 @@ See also the variable `org-agenda-columns-remove- > prefix-from-item'." > (message "Value is: %s" (or value "")))) > > (defvar org-agenda-columns-active) ;; defined in org-agenda.el > + > (defun org-columns-quit () > "Remove the column overlays and in this way exit column editing." > (interactive) > @@ -417,6 +426,7 @@ Where possible, use the standard interface for > changing this line." > (<= (overlay-start x) eol) > x)) > org-columns-overlays))) > + (org-columns-time (time-to-number-of-days (current-time))) > nval eval allowed) > (cond > ((equal key "CLOCKSUM") > @@ -661,7 +671,8 @@ around it." > (org-verify-version 'columns) > (org-columns-remove-overlays) > (move-marker org-columns-begin-marker (point)) > - (let (beg end fmt cache maxwidths) > + (let ((org-columns-time (time-to-number-of-days (current-time))) > + beg end fmt cache maxwidths) > (setq fmt (org-columns-get-format-and-top-level)) > (save-excursion > (goto-char org-columns-top-level-marker) > @@ -678,7 +689,7 @@ around it." > (narrow-to-region beg end) > (org-clock-sum)))) > (while (re-search-forward (concat "^" outline-regexp) end t) > - (if (and org-columns-skip-arrchived-trees > + (if (and org-columns-skip-archived-trees > (looking-at (concat ".*:" org-archive-tag ":"))) > (org-end-of-subtree t) > (push (cons (org-current-line) (org-entry-properties)) cache))) > @@ -698,20 +709,34 @@ around it." > (org-columns-display-here (cdr x))) > cache))))) > > +(eval-when-compile (defvar org-columns-time)) > + > (defvar org-columns-compile-map > - '(("none" none +) > - (":" add_times +) > - ("+" add_numbers +) > - ("$" currency +) > - ("X" checkbox +) > - ("X/" checkbox-n-of-m +) > - ("X%" checkbox-percent +) > - ("max" max_numbers max) > - ("min" min_numbers min) > - ("mean" mean_numbers (lambda (&rest x) (/ (apply '+ x) > (float (length x))))) > - (":max" max_times max) > - (":min" min_times min) > - (":mean" mean_times (lambda (&rest x) (/ (apply '+ x) > (float (length x)))))) > + '(("none" none + identity) > + (":" add_times + identity) > + ("+" add_numbers + identity) > + ("$" currency + identity) > + ("X" checkbox + identity) > + ("X/" checkbox-n-of-m + identity) > + ("X%" checkbox-percent + identity) > + ("max" max_numbers max identity) > + ("min" min_numbers min identity) > + ("mean" mean_numbers > + (lambda (&rest x) (/ (apply '+ x) (float (length x)))) > + identity) > + (":max" max_times max identity) > + (":min" min_times min identity) > + (":mean" mean_times > + (lambda (&rest x) (/ (apply '+ x) (float (length x)))) > + identity) > + ("@min" age min > + (lambda (x) (- org-columns-time x))) > + ("@max" age max > + (lambda (x) (- org-columns-time x))) > + ("@mean" age > + (lambda (&rest x) > + (/ (apply '+ x) (float (length x)))) > + (lambda (x) (- org-columns-time x))))) > "Operator <-> format,function map. > Used to compile/uncompile columns format and completing read in > interactive function org-columns-new.") > @@ -860,7 +885,9 @@ Don't set this, this is meant for dynamic > scoping.") > "Compute all columns that have operators defined." > (org-unmodified > (remove-text-properties (point-min) (point-max) '(org-summaries > t))) > - (let ((columns org-columns-current-fmt-compiled) col) > + (let ((columns org-columns-current-fmt-compiled) > + (org-columns-time (time-to-number-of-days (current-time))) > + col) > (while (setq col (pop columns)) > (when (nth 3 col) > (save-excursion > @@ -895,6 +922,7 @@ Don't set this, this is meant for dynamic > scoping.") > (format (nth 4 ass)) > (printf (nth 5 ass)) > (fun (nth 6 ass)) > + (calc (or (nth 7 ass) 'identity)) > (beg org-columns-top-level-marker) > last-level val valflag flag end sumpos sum-alist sum str str1 > useval) > (save-excursion > @@ -927,10 +955,12 @@ Don't set this, this is meant for dynamic > scoping.") > (list 'org-summaries sum-alist)))) > (when (and val (not (equal val (if flag str val)))) > (org-entry-put nil property (if flag str val))) > - ;; add current to current level accumulator > + ;; add current to current level accumulator > (when (or flag valflag) > - (push (if flag sum > - (org-column-string-to-number (if flag str val) format)) > + (push (if flag > + sum > + (funcall calc (org-columns-string-to-number > + (if flag str val) format))) > (aref lvals level)) > (aset lflag level t)) > ;; clear accumulators for deeper levels > @@ -940,8 +970,8 @@ Don't set this, this is meant for dynamic > scoping.") > ((>= level last-level) > ;; add what we have here to the accumulator for this level > (when valflag > - (push (org-column-string-to-number val format) > - (aref lvals level)) > + (push (funcall calc (org-columns-string-to-number val format)) > + (aref lvals level)) > (aset lflag level t))) > (t (error "This should not happen"))))))) > > @@ -967,7 +997,6 @@ Don't set this, this is meant for dynamic > scoping.") > (if (eq major-mode 'org-agenda-mode) > (error "This command is only allowed in Org-mode buffers"))) > > - > (defun org-string-to-number (s) > "Convert string to number, and interpret hh:mm:ss." > (if (not (string-match ":" s)) > @@ -994,6 +1023,8 @@ Don't set this, this is meant for dynamic > scoping.") > (printf (format printf n)) > ((eq fmt 'currency) > (format "%.2f" n)) > + ((eq fmt 'age) > + (org-format-time-period n)) > (t (number-to-string n)))) > > (defun org-nofm-to-completion (n m &optional percent) > @@ -1001,17 +1032,23 @@ Don't set this, this is meant for dynamic > scoping.") > (format "[%d/%d]" n m) > (format "[%d%%]"(floor (+ 0.5 (* 100. (/ (* 1.0 n) m))))))) > > -(defun org-column-string-to-number (s fmt) > +(defun org-columns-string-to-number (s fmt) > "Convert a column value to a number that can be used for column > computing." > - (cond > - ((string-match ":" s) > - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) > - (while l > - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) > - sum)) > - ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent)) > - (if (equal s "[X]") 1. 0.000001)) > - (t (string-to-number s)))) > + (if s > + (cond > + ((eq fmt 'age) > + (if (string= s "") > + org-columns-time > + (time-to-number-of-days (apply 'encode-time (org-parse-time- > string s t))))) > + ((string-match ":" s) > + (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) > + (while l > + (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) > + sum)) > + ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent)) > + (if (equal s "[X]") 1. 0.000001)) > + (t (string-to-number s))) > + 0)) > > (defun org-columns-uncompile-format (cfmt) > "Turn the compiled columns format back into a string > representation." > @@ -1045,7 +1082,9 @@ width the column width in characters, > can be nil for automatic > operator the operator if any > format the output format for computed results, derived from > operator > printf a printf format for computed values > -fun the lisp function to compute values, derived from > operator" > +fun the lisp function to compute summary values, derived > from operator > +calc function to get values from base elements > +" > (let ((start 0) width prop title op op-match f printf fun) > (setq org-columns-current-fmt-compiled nil) > (while (string-match > @@ -1058,15 +1097,18 @@ fun the lisp function to compute > values, derived from operator" > op (match-string 4 fmt) > f nil > printf nil > - fun '+) > + fun '+ > + calc nil) > (if width (setq width (string-to-number width))) > (when (and op (string-match ";" op)) > (setq printf (substring op (match-end 0)) > op (substring op 0 (match-beginning 0)))) > (when (setq op-match (assoc op org-columns-compile-map)) > (setq f (cadr op-match) > - fun (caddr op-match))) > - (push (list prop title width op f printf fun) org-columns- > current-fmt-compiled)) > + fun (caddr op-match) > + calc (cadddr op-match))) > + (push (list prop title width op f printf fun calc) > + org-columns-current-fmt-compiled)) > (setq org-columns-current-fmt-compiled > (nreverse org-columns-current-fmt-compiled)))) > > @@ -1121,18 +1163,18 @@ 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'. > + 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 <= that number. > + a hline before each level <= 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." > + When t, skip rows where all specifiers other than ITEM are empty." > (let ((pos (move-marker (make-marker) (point))) > (hlines (plist-get params :hlines)) > (vlines (plist-get params :vlines)) > @@ -1351,7 +1393,7 @@ This will add overlays to the date lines, to > show the summary for each day." > (mapc (lambda (x) > (setq v (cdr (assoc prop x))) > (if v (setq lsum (+ lsum > - (org-column-string-to-number > + (org-columns-string-to-number > v stype))))) > entries) > (setq lsum (org-columns-number-to-string lsum stype)) > @@ -1390,6 +1432,18 @@ This will add overlays to the date lines, to > show the summary for each day." > (equal (nth 4 a) (nth 4 fm))) > (org-columns-compute (car fm))))))))))) > > +(defun org-format-time-period (interval) > + "Convert time in fractional days to days/hours/minutes/seconds" > + (if (numberp interval) > + (let* ((days (floor interval)) > + (frac-hours (* 24 (- interval days))) > + (hours (floor frac-hours)) > + (minutes (floor (* 60 (- frac-hours hours)))) > + (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes))))) > + (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) > + "")) > + > + > (provide 'org-colview) > > ;; arch-tag: 61f5128d-747c-4983-9479-e3871fa3d73c > diff --git a/lisp/org.el b/lisp/org.el > index dad2e83..24907d8 100644 > --- a/lisp/org.el > +++ b/lisp/org.el > @@ -3346,8 +3346,8 @@ Instead, use the key `v' to cycle the archives- > mode in the agenda." > :group 'org-agenda-skip > :type 'boolean) > > -(defcustom org-columns-skip-arrchived-trees t > - "Non-nil means, irgnore archived trees when creating column view." > +(defcustom org-columns-skip-archived-trees t > + "Non-nil means, ignore archived trees when creating column view." > :group 'org-archive > :group 'org-properties > :type 'boolean) > -- > 1.6.3.3 > > > _______________________________________________ > Emacs-orgmode mailing list > Remember: use `Reply All' to send replies to the list. > Emacs-orgmode@gnu.org > http://lists.gnu.org/mailman/listinfo/emacs-orgmode - Carsten