[Orgmode] Re: SOLVED: elisp formulas in column view (without converting to tables)

[news]

<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