[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Orgmode] Re: SOLVED: elisp formulas in column view (without converting
From: |
news |
Subject: |
[Orgmode] Re: SOLVED: elisp formulas in column view (without converting to tables) |
Date: |
Mon, 16 Mar 2009 20:15:13 +0000 |
<address@hidden> writes:
> Hi,
> I have rewritten the org-columns-compute function to allow elisp
> formulas in column view.
> It allows you to specify how to accumulate values from child headers,
> and how to specify the value for the current header, based on other
> columns.
Have since discovered that my new version doesn't work with checkbox
formulas. The solution is to use the old version of org-columns-compute
if the formula is not an elisp formula. Rename the old function to
org-columns-compute-orig, and then use this code for
org-columns-compute:
(defun org-columns-compute (property)
"Sum the values of property PROPERTY hierarchically, for the entire buffer."
(interactive)
(let* ((re (concat "^" outline-regexp))
(lmax 30) ; Does anyone use deeper levels???
(level 0)
(ass (assoc property org-columns-current-fmt-compiled))
;; parse elisp form if there is one
(form (nth 3 ass))
(uselisp (and (> (length form) 1)
(or (equal "(" (substring form 0 1))
(equal "(" (substring form 1 2)))))
(form (if uselisp
(replace-regexp-in-string
"\$\\([^()\" ]+\\)"
"(string-to-number (or (org-entry-get nil \"\\1\") \"0\"))"
(nth 3 ass) t)))
;; vector to hold running totals for each level
(lsum (make-vector lmax (if uselisp nil 0)))
(format (nth 4 ass))
(printf (nth 5 ass))
(beg org-columns-top-level-marker)
last-level val valflag end sumpos sum-alist str str1 useval prevtotal
curtotal newvals)
(if uselisp
(save-excursion
;; Find the region to compute
(goto-char beg)
(setq end (condition-case nil (org-end-of-subtree t) (error
(point-max))))
(goto-char end)
;; Walk the tree from the back and do the computations
(while (re-search-backward re beg t)
(setq sumpos (match-beginning 0)
last-level level
level (org-outline-level)
;; total from children, or nil if there were none
prevtotal (if (< level last-level) (aref lsum last-level) nil)
;; total at this level
curtotal (aref lsum level)
;; current property value as string
val (org-entry-get nil property)
;; is it non-empty?
valflag (and val (string-match "\\S-" val))
;; current property value as number (or nil if empty)
curval (if valflag (org-column-string-to-number val format)
nil)
;; get values to replace current value and running total
newvals (if uselisp (eval-expression (read form))
(list (or prevtotal curval 0)
(+ curtotal (or prevtotal curval 0)))))
(cond
((< level last-level) ; we have moved up to a parent
(setq
;; new value, as string
str (if (nth 0 newvals) (org-columns-number-to-string (nth 0
newvals) format printf) nil)
;; add text properties to it
useval (org-add-props (copy-sequence str) nil 'org-computed t
'face 'bold)
;; get current text properties
sum-alist (get-text-property sumpos 'org-summaries))
;; put new value here as a text property
(if (assoc property sum-alist)
(setcdr (assoc property sum-alist) useval)
(push (cons property useval) sum-alist)
(org-unmodified
(add-text-properties sumpos (1+ sumpos)
(list 'org-summaries sum-alist))))
;; put new org property value
(if (nth 0 newvals) (org-entry-put nil property str))
;; set value for current level total
(when (or prevtotal valflag)
(aset lsum level (nth 1 newvals)))
;; clear totals for deeper levels
(loop for l from (1+ level) to (1- lmax) do
(aset lsum l (if uselisp nil 0))))
((>= level last-level) ; we have not moved up to a parent
;; set new org property value and add to total for this level
(org-entry-put nil property (org-columns-number-to-string (nth 0
newvals) format printf))
(aset lsum level (nth 1 newvals)))
(t (error "This should not happen")))))
(org-columns-compute-orig property))))
--
aleblanc