;; sum-schedule.el - functions for calculating bracketed hours sums
;; for outline mode schedules
;; 2003/8/1 checker
;;
;; M-x checker-outline-sum-tree to sum for a single entry's tree
;; M-x checker-outline-sum-level to sum all siblings at a level
;;
;; @todo this lives in climbing but is copied to ~/lisp, which is lame
(defun checker-outline-in-emacs-local-variables (find-beginning)
(let ((cur (point)) res)
(if find-beginning (progn (outline-ascend-to-depth 1) (outline-beginning-of-current-entry)))
(setq res (and (= 1 (outline-current-depth)) (looking-at "emacs local variables")))
(if find-beginning (goto-char cur))
res))
(defun checker-format-float (v)
(if (= v (round v))
;; yes, v is an integer
(format "%d" v)
;; no, there's a fractional part, find out how many significant digits
(let* ((rem (mod v 1.0))
(rem2 (mod (* rem 10.0) 1.0)))
(if (< rem2 1e-1)
;; one significant digit
(format "%.1f" v)
;; more than one significant digit
(format "%.2f" v)
))
))
(defun checker-make-brackets-string (est spent)
;; the format is [ est : spent ]
;; @todo where est|spent are cur / done / tot
(format (if (= spent 0) " [%s]" " [%s : %s]")
(checker-format-float est)
(checker-format-float spent)))
(defun checker-outline-do-sum-level (do-siblings)
"internal function - call checker-outline-sum-* interactively"
(let ((siblings-est-sum 0) (siblings-spent-sum 0)
(more-siblings t))
;; do all the siblings at this level
(while more-siblings
(let* ( ;; there's a bug with the 0 depth entry, so these positions/depths have to be done in this order
(end-of-entry (progn
(outline-end-of-current-entry)
(outline-beginning-of-current-entry)
(outline-end-of-current-entry)
(point)))
(start-of-entry (progn
(outline-beginning-of-current-entry)
(point)))
(current-depth (outline-current-depth))
(children-est-sum 0.0) (children-spent-sum 0.0)
(done (let ((old case-fold-search) done)
(setq case-fold-search nil)
(setq done (looking-at "D:"))
(setq case-fold-search old)
done))
)
;; skip done entries @todo want to accumulate done time as well
(if (not done)
;; try to descend to test if we have children, building children sums
(if (outline-descend-to-depth (+ 1 current-depth))
;; yes, recurse to get children sum
(progn
(let ((tmp (checker-outline-do-sum-level t))) ; pattern matching would be useful here
(setq children-est-sum (nth 0 tmp))
(setq children-spent-sum (nth 1 tmp))
)
;; insert new children sum values into end brackets
(goto-char end-of-entry)
(beginning-of-line) ; we want the biggest match possible, but only on last line
;; eat trailing whitespace and optional current brackets; this shouldn't be able to fail
(re-search-forward "\\s *\\(\\[[0-9.: /]*\\]\\)?\\s *$" end-of-entry)
;; got a match for the hours brackets and/or whitespace, replace them with new hours
(replace-match (checker-make-brackets-string children-est-sum children-spent-sum)))
;; no children, so grab our entry's hours
(goto-char end-of-entry)
(beginning-of-line) ; we want biggest match possible, but only on last line
;; get all the trailing whitespace and brackets, if present; shouldn't be able to fail
(re-search-forward "\\s *\\(\\[\\([0-9.: ]+\\)?\\]\\)?\\s *$" end-of-entry)
(let ((all-of-it (match-string-no-properties 0))
(brackets (match-string-no-properties 1))
(brackets-point (match-beginning 1))
(hours (match-string-no-properties 2)))
;; toast the current brackets and whitespace
(replace-match "")
(if (and brackets hours)
;; yes, we have brackets with hours
(if (string-match "^\\([0-9.]+\\)\\(\\s *:\\s *\\([0-9.]+\\)\\)?$" hours)
;; yes, we have some correctly formatted numerical data in hours
(progn
(setq children-est-sum (string-to-number (match-string-no-properties 1 hours)))
(let ((spent-string (match-string-no-properties 3 hours)))
(setq children-spent-sum (if spent-string (string-to-number spent-string) 0)))
;; write out new brackets
(insert (checker-make-brackets-string children-est-sum children-spent-sum)))
;; no, non-numerical data, must be an error, reinsert it
(insert all-of-it)
(error "Bad hours bracket \"%s\" at position %d." brackets brackets-point)
)
;; no, no brackets or no data inside them
(insert " []")
))
)
)
;; accumulate, go to the next sibling, if possible, unless it's "emacs local variables" at the top level
(setq siblings-est-sum (+ siblings-est-sum children-est-sum))
(setq siblings-spent-sum (+ siblings-spent-sum children-spent-sum))
(setq more-siblings (and do-siblings
(outline-forward-current-level 1)
(not (checker-outline-in-emacs-local-variables nil))))
)
)
(list siblings-est-sum siblings-spent-sum)
)
)
(defun checker-outline-sum-level (&optional skip-siblings)
"sum up the bracket hours in an outline including all siblings at the current level"
(interactive)
(save-excursion
(if (not (checker-outline-in-emacs-local-variables t))
(checker-outline-do-sum-level (not skip-siblings))
(error "In emacs local variables.")
)
)
)
(defun checker-outline-sum-tree (arg)
"sum up the bracket hours in an outline only for the current entry and below\nwith a prefix, ascend to depth, default 1"
(interactive "P")
(save-excursion
(if (not (checker-outline-in-emacs-local-variables t))
(progn
(if arg
(if (numberp arg)
(outline-ascend-to-depth arg)
(outline-ascend-to-depth 1)))
(checker-outline-do-sum-level nil))
(error "In emacs local variables.")
)
)
)