X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1099930585662f32278796f9943ac8b50a1179f1..e4920bc99dfcee02c3bb83b46a761b0893f76626:/lisp/org/org-colview.el diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index 8e45fdf3e3..0f6fc0bed6 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -1,12 +1,11 @@ ;;; org-colview.el --- Column View in Org-mode -;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 2004-2011 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -171,7 +170,6 @@ This is the compiled version of the format.") (color (list :foreground (face-attribute ref-face :foreground))) (face (list color 'org-column ref-face)) (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 calc) ;; Check if the entry is in another buffer. @@ -187,11 +185,17 @@ This is the compiled version of the format.") title (nth 1 column) ass (if (equal property "ITEM") (cons "ITEM" - (save-match-data + ;; When in a buffer, get the whole line, + ;; we'll clean it later… + (if (org-mode-p) + (save-match-data + (org-no-properties + (org-remove-tabs + (buffer-substring-no-properties + (point-at-bol) (point-at-eol))))) + ;; In agenda, just get the `txt' property (org-no-properties - (org-remove-tabs - (buffer-substring-no-properties - (point-at-bol) (point-at-eol)))))) + (org-get-at-bol 'txt)))) (assoc property props)) width (or (cdr (assoc property org-columns-current-maxwidths)) (nth 2 column) @@ -207,9 +211,7 @@ This is the compiled version of the format.") ((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))) + val org-columns-current-fmt-compiled))) ((and calc (functionp calc) (not (string= val "")) (not (get-text-property 0 'org-computed val))) @@ -228,7 +230,9 @@ This is the compiled version of the format.") (overlay-put ov 'org-columns-value (cdr ass)) (overlay-put ov 'org-columns-value-modified modval) (overlay-put ov 'org-columns-pom pom) - (overlay-put ov 'org-columns-format f)) + (overlay-put ov 'org-columns-format f) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "")) (if (or (not (char-after beg)) (equal (char-after beg) ?\n)) (let ((inhibit-read-only t)) @@ -241,6 +245,8 @@ This is the compiled version of the format.") (overlay-put ov 'invisible t) (overlay-put ov 'keymap org-columns-map) (overlay-put ov 'intangible t) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "") (push ov org-columns-overlays) (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) (overlay-put ov 'keymap org-columns-map) @@ -362,20 +368,6 @@ for the duration of the command.") t t s))) 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'." - (let* ((org-complex-heading-regexp cphr) - (prefix (substring item 0 pl)) - (rest (substring item pl)) - (fake (concat "* " rest)) - (cleaned (org-trim (substring (org-columns-cleanup-item fake fmt) 1)))) - (if org-agenda-columns-remove-prefix-from-item - cleaned - (concat prefix cleaned)))) - (defun org-columns-show-value () "Show the full value of the property." (interactive) @@ -464,7 +456,7 @@ Where possible, use the standard interface for changing this line." (call-interactively 'org-schedule)))) ((equal key "BEAMER_env") (setq eval '(org-with-point-at pom - (call-interactively 'org-beamer-set-environment-tag)))) + (call-interactively 'org-beamer-select-environment)))) (t (setq allowed (org-property-get-allowed-values pom key 'table)) (if allowed @@ -482,7 +474,7 @@ Where possible, use the standard interface for changing this line." ((equal major-mode 'org-agenda-mode) (org-columns-eval eval) ;; The following let preserves the current format, and makes sure - ;; that in only a single file things need to be upated. + ;; that in only a single file things need to be updated. (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) (buffer (marker-buffer pom)) (org-agenda-contributing-files @@ -515,7 +507,7 @@ Where possible, use the standard interface for changing this line." (txt (match-string 3)) (post "") txt2) - (if (string-match (org-re "[ \t]+:[[:alnum:]:_@]+:[ \t]*$") txt) + (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt) (setq post (match-string 0 txt) txt (substring txt 0 (match-beginning 0)))) (setq txt2 (read-string "Edit: " txt)) @@ -613,7 +605,7 @@ an integer, select that value." ((equal major-mode 'org-agenda-mode) (org-columns-eval '(org-entry-put pom key nval)) ;; The following let preserves the current format, and makes sure - ;; that in only a single file things need to be upated. + ;; that in only a single file things need to be updated. (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) (buffer (marker-buffer pom)) (org-agenda-contributing-files @@ -703,7 +695,7 @@ around it." (save-restriction (narrow-to-region beg end) (org-clock-sum)))) - (while (re-search-forward (concat "^" outline-regexp) end t) + (while (re-search-forward org-outline-regexp-bol end t) (if (and org-columns-skip-archived-trees (looking-at (concat ".*:" org-archive-tag ":"))) (org-end-of-subtree t) @@ -746,7 +738,8 @@ around it." ("@max" max_age max (lambda (x) (- org-columns-time x))) ("@mean" mean_age (lambda (&rest x) (/ (apply '+ x) (float (length x)))) - (lambda (x) (- org-columns-time x)))) + (lambda (x) (- org-columns-time x))) + ("est+" estimate org-estimate-combine)) "Operator <-> format,function,calc map. Used to compile/uncompile columns format and completing read in interactive function `org-columns-new'. @@ -935,7 +928,7 @@ Don't set this, this is meant for dynamic scoping.") (defun org-columns-compute (property) "Sum the values of property PROPERTY hierarchically, for the entire buffer." (interactive) - (let* ((re (concat "^" outline-regexp)) + (let* ((re org-outline-regexp-bol) (lmax 30) ; Does anyone use deeper levels??? (lvals (make-vector lmax nil)) (lflag (make-vector lmax nil)) @@ -1031,6 +1024,7 @@ Don't set this, this is meant for dynamic scoping.") (defun org-columns-number-to-string (n fmt &optional printf) "Convert a computed column number to a string value, according to FMT." (cond + ((memq fmt '(estimate)) (org-estimate-print n printf)) ((not (numberp n)) "") ((memq fmt '(add_times max_times min_times mean_times)) (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h)))))) @@ -1054,28 +1048,30 @@ 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-columns-string-to-number (s fmt) "Convert a column value to a number that can be used for column computing." (if s (cond ((memq fmt '(min_age max_age mean_age)) - (cond ((string= s "") org-columns-time) - ((string-match - "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" - s) - (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s))) - (string-to-number (match-string 2 s)))) - (string-to-number (match-string 3 s)))) - (string-to-number (match-string 4 s)))) - (t (time-to-number-of-days (apply 'encode-time - (org-parse-time-string s t)))))) + (cond ((string= s "") org-columns-time) + ((string-match + "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" + s) + (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s))) + (string-to-number (match-string 2 s)))) + (string-to-number (match-string 3 s)))) + (string-to-number (match-string 4 s)))) + (t (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)) + (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)) + (if (equal s "[X]") 1. 0.000001)) + ((memq fmt '(estimate)) (org-string-to-estimate s)) (t (string-to-number s))))) (defun org-columns-uncompile-format (cfmt) @@ -1491,9 +1487,44 @@ This will add overlays to the date lines, to show the summary for each day." (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) "")) +(defun org-estimate-mean-and-var (v) + "Return the mean and variance of an estimate." + (let* ((low (float (car v))) + (high (float (cadr v))) + (mean (/ (+ low high) 2.0)) + (var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0))) + (list mean var))) + +(defun org-estimate-combine (&rest el) + "Combine a list of estimates, using mean and variance. +The mean and variance of the result will be the sum of the means +and variances (respectively) of the individual estimates." + (let ((mean 0) + (var 0)) + (mapc (lambda (e) + (let ((stats (org-estimate-mean-and-var e))) + (setq mean (+ mean (car stats))) + (setq var (+ var (cadr stats))))) + el) + (let ((stdev (sqrt var))) + (list (- mean stdev) (+ mean stdev))))) + +(defun org-estimate-print (e &optional fmt) + "Prepare a string representation of an estimate. +This formats these numbers as two numbers with a \"-\" between them." + (if (null fmt) (set 'fmt "%.0f")) + (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-"))) + +(defun org-string-to-estimate (s) + "Convert a string to an estimate. +The string should be two numbers joined with a \"-\"." + (if (string-match "\\(.*\\)-\\(.*\\)" s) + (list (string-to-number (match-string 1 s)) + (string-to-number(match-string 2 s))) + (list (string-to-number s) (string-to-number s)))) (provide 'org-colview) -;; arch-tag: 61f5128d-747c-4983-9479-e3871fa3d73c + ;;; org-colview.el ends here