From: Carsten Dominik <carsten.dominik@gmail.com>
To: James TD Smith <ahktenzero@mohorovi.cc>
Cc: emacs-orgmode@gnu.org
Subject: Re: [PATCH] Add min/max/mean age operators to column view.
Date: Wed, 28 Oct 2009 18:01:44 +0100 [thread overview]
Message-ID: <4AD87891-4DD3-4B80-9FD3-2B6B65653E5B@gmail.com> (raw)
In-Reply-To: <1256515485-28476-1-git-send-email-ahktenzero@mohorovi.cc>
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 <ahktenzero@mohorovi.cc>
> +
> + * 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 <carsten.dominik@gmail.com>
>
> * 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 <ahktenzero@mohorovi.cc>
> -
> * 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 <ahktenzero@mohorovi.cc>
> +
> + * 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 <carsten.dominik@gmail.com>
>
> 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 <N> 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
next prev parent reply other threads:[~2009-10-28 17:01 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2009-10-26 0:04 [PATCH] Add min/max/mean age operators to column view James TD Smith
2009-10-28 17:01 ` Carsten Dominik [this message]
2009-10-28 19:36 ` James TD Smith
2009-10-29 11:12 ` Mikael Fornius
2009-10-29 13:17 ` Mikael Fornius
2009-10-29 20:10 ` Mikael Fornius
2009-10-30 3:36 ` James TD Smith
2009-10-29 21:15 ` James TD Smith
2009-10-31 13:41 ` Mikael Fornius
2009-11-01 17:24 ` Carsten Dominik
2009-11-01 18:59 ` James TD Smith
2009-12-30 11:32 ` Manish
2009-12-30 14:01 ` James TD Smith
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=4AD87891-4DD3-4B80-9FD3-2B6B65653E5B@gmail.com \
--to=carsten.dominik@gmail.com \
--cc=ahktenzero@mohorovi.cc \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).