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