;; 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.") ) ) )