;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 6.33x
+;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
(declare-function org-agenda-redo "org-agenda" ())
(declare-function org-agenda-do-context-action "org-agenda" ())
+(when (featurep 'xemacs)
+ (error "Do not load this file into XEmacs, use 'org-colview-xemacs.el'."))
+
;;; Column View
(defvar org-columns-overlays nil
(defun org-columns-new-overlay (beg end &optional string face)
"Create a new column overlay and add it to the list."
- (let ((ov (org-make-overlay beg end)))
- (org-overlay-put ov 'face (or face 'secondary-selection))
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face (or face 'secondary-selection))
(org-overlay-display ov string face)
(push ov org-columns-overlays)
ov))
(org-unmodified
(setq ov (org-columns-new-overlay
beg (setq beg (1+ beg)) string (if dateline face1 face)))
- (org-overlay-put ov 'keymap org-columns-map)
- (org-overlay-put ov 'org-columns-key property)
- (org-overlay-put ov 'org-columns-value (cdr ass))
- (org-overlay-put ov 'org-columns-value-modified modval)
- (org-overlay-put ov 'org-columns-pom pom)
- (org-overlay-put ov 'org-columns-format f))
+ (overlay-put ov 'keymap org-columns-map)
+ (overlay-put ov 'org-columns-key property)
+ (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 'line-prefix "")
+ (overlay-put ov 'wrap-prefix ""))
(if (or (not (char-after beg))
(equal (char-after beg) ?\n))
(let ((inhibit-read-only t))
;; 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)
+ (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 (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
- (org-overlay-put ov 'keymap org-columns-map)
+ (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
+ (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)))
(org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local)))
(defun org-columns-hscoll-title ()
- "Set the header-line-format so that it scrolls along with the table."
+ "Set the `header-line-format' so that it scrolls along with the table."
(sit-for .0001) ; need to force a redisplay to update window-hscroll
(when (not (= (window-hscroll) org-columns-previous-hscroll))
(setq header-line-format
(move-marker org-columns-begin-marker nil)
(move-marker org-columns-top-level-marker nil)
(org-unmodified
- (mapc 'org-delete-overlay org-columns-overlays)
+ (mapc 'delete-overlay org-columns-overlays)
(setq org-columns-overlays nil)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
((equal key "SCHEDULED")
(setq eval '(org-with-point-at pom
(call-interactively 'org-schedule))))
+ ((equal key "BEAMER_env")
+ (setq eval '(org-with-point-at pom
+ (call-interactively 'org-beamer-select-environment))))
(t
(setq allowed (org-property-get-allowed-values pom key 'table))
(if allowed
- (setq nval (org-icompleting-read "Value: " allowed nil t))
+ (setq nval (org-icompleting-read
+ "Value: " allowed nil
+ (not (get-text-property 0 'org-unrestricted
+ (caar allowed)))))
(setq nval (read-string "Edit: " value)))
(setq nval (org-trim nval))
(when (not (equal nval value))
(progn
(setq org-columns-overlays
(org-delete-all line-overlays org-columns-overlays))
- (mapc 'org-delete-overlay line-overlays)
+ (mapc 'delete-overlay line-overlays)
(org-columns-eval eval))
(org-columns-display-here)))
(org-move-to-column col)
(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))
(progn
(setq org-columns-overlays
(org-delete-all line-overlays org-columns-overlays))
- (mapc 'org-delete-overlay line-overlays)
+ (mapc 'delete-overlay line-overlays)
(org-columns-eval '(org-entry-put pom key nval)))
(org-columns-display-here)))
(org-move-to-column col)
("@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.
+interactive function `org-columns-new'.
operator string used in #+COLUMNS definition describing the
summary type
format symbol describing summary type selected interactively in
- org-columns-new and internally in
- org-columns-number-to-string and
- org-columns-string-to-number
+ `org-columns-new' and internally in
+ `org-columns-number-to-string' and
+ `org-columns-string-to-number'
function called with a list of values as argument to calculate
the summary value
-calc function called on every element before summarizing. This is
+calc function called on every element before summarizing. This is
optional and should only be specified if needed")
(defun org-columns-new (&optional prop title width op fmt fun &rest rest)
(let (fmt val pos)
(save-excursion
(mapc (lambda (ov)
- (when (equal (org-overlay-get ov 'org-columns-key) property)
- (setq pos (org-overlay-start ov))
+ (when (equal (overlay-get ov 'org-columns-key) property)
+ (setq pos (overlay-start ov))
(goto-char pos)
(when (setq val (cdr (assoc property
(get-text-property
(point-at-bol) 'org-summaries))))
- (setq fmt (org-overlay-get ov 'org-columns-format))
- (org-overlay-put ov 'org-columns-value val)
- (org-overlay-put ov 'display (format fmt val)))))
+ (setq fmt (overlay-get ov 'org-columns-format))
+ (overlay-put ov 'org-columns-value val)
+ (overlay-put ov 'display (format fmt val)))))
org-columns-overlays))))
(defun org-columns-compute (property)
(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))))))
(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)
format the output format for computed results, derived from operator
printf a printf format for computed values
fun the lisp function to compute summary values, derived from operator
-calc function to get values from base elements
-"
+calc function to get values from base elements"
(let ((start 0) width prop title op op-match f printf fun calc)
(setq org-columns-current-fmt-compiled nil)
(while (string-match
This will add overlays to the date lines, to show the summary for each day."
(let* ((fmt (mapcar (lambda (x)
(if (equal (car x) "CLOCKSUM")
- (list "CLOCKSUM" (nth 2 x) nil 'add_times nil '+ 'identity)
- (cdr x)))
+ (list "CLOCKSUM" (nth 1 x) (nth 2 x) ":" 'add_times
+ nil '+ nil)
+ x))
org-columns-current-fmt-compiled))
- line c c1 stype calc sumfunc props lsum entries prop v)
+ line c c1 stype calc sumfunc props lsum entries prop v title)
(catch 'exit
(when (delq nil (mapcar 'cadr fmt))
;; OK, at least one summation column, it makes sense to try this
(mapcar
(lambda (f)
(setq prop (car f)
- stype (nth 3 f)
- sumfunc (nth 5 f)
- calc (or (nth 6 f) 'identity))
+ title (nth 1 f)
+ stype (nth 4 f)
+ sumfunc (nth 6 f)
+ calc (or (nth 7 f) 'identity))
(cond
((equal prop "ITEM")
(cons prop (buffer-substring (point-at-bol)
(org-columns-compute (car fm)))))))))))
(defun org-format-time-period (interval)
- "Convert time in fractional days to days/hours/minutes/seconds"
+ "Convert time in fractional days to days/hours/minutes/seconds."
(if (numberp interval)
(let* ((days (floor interval))
(frac-hours (* 24 (- interval days)))
(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)
HCoop / bpt / emacs.git / blobdiff