;;;; balance.el --- editing balance sheets
;;;; Jim Blandy <jimb@cyclic.com> --- March 1996
;;;; Copyright (C) 1996 Jim Blandy

(require 'cl)

(defvar balance-mode-map (make-sparse-keymap))
(define-key balance-mode-map "\C-c=" 'bal-update)

(defvar bal-interest-rate 0.0
  "The interest rate for use with N@V entries.
This is a simple factor, by which the balance in V is multiplied
to yield the interest payment. Thus, if your interest entries are
monthly, you will need to set this to the twelfth root of your
annual interest rate.")
(put 'bal-interest-rate 'safe-local-variable 'bal-safe-interest-rate-p)

(defvar bal-credits-account-name "CREDITS"
  "*Special account name in which all credits are accumulated; users
  should only write this in an \"=\" expression.")

(defvar bal-debits-account-name "DEBITS"
  "*Special account name in which all debits are accumulated; users
  should only write this in an \"=\" expression.")

(defconst bal-regexp "\\(-?[0-9]*\\.[0-9][0-9]\\)\\([+-@=]\\)\\(\\S-+\\)")
(defconst bal-bankrupt-face 'bal-red)
(if (eq window-system 'x)
    (progn
      (copy-face 'default 'bal-red)
      (set-face-foreground 'bal-red "red")))

(defun bal-round (value)
  "Return VALUE, rounded to the nearest cent."
  (/ (round (* value 100)) 100.0))

(defun bal-replace (value start end)
  ;; We need to replace the right number of columns each time.  The
  ;; `8' in there is a crock; there should be a variable specifying
  ;; the format to use for totals, and this function should compute
  ;; its width.
  (goto-char end)
  (let ((end-col (current-column)))
    (skip-chars-backward "-0-9. \t")
    (delete-region (point) end)
    (indent-to-column (- end-col 8))
    (insert (if (numberp value)
		(let ((text (format "%8.2f" value)))
		  (if (< value 0) (put-text-property 0 (length text)
						     'face bal-bankrupt-face
						     text))
		  text)
	      "  -0.00"))))

(defun bal-make-table ()
  (list 'bal-table))

(defun bal-find-account (table name)
  "Return the pair from TABLE whose cdr is the value of the account named NAME."
  (let* ((sym (intern name))
	 (pair (assq sym (cdr table))))
    (unless pair
      (setq pair (cons sym 0))
      (push pair (cdr table)))
    pair))

(defun bal-check-name (name)
  "If NAME is one of the reserved account names, raise an error."
  (mapc (lambda (rsvd)
          (if (string-equal name rsvd)
              (error "The special account name \"%s\" is reserved." rsvd)))
        (list bal-credits-account-name bal-debits-account-name)))

(defun bal-accumulate-internal (table name amount)
  (let ((pair (bal-find-account table name)))
    (setcdr pair (+ (cdr pair) amount))
    (cdr pair)))

(defun bal-accumulate (table name amount)
  (bal-check-name name)
  ;; Accumulate the amount in the named account...
  (bal-accumulate-internal table name amount)
  ;; ... and accumulate it in the appropriate grand-total account, too.
  (cond ((> amount 0)
         (bal-accumulate-internal table bal-credits-account-name amount))
        ((< amount 0)
         (bal-accumulate-internal table bal-debits-account-name amount))))

(defun bal-interest (table name start end)
  (bal-check-name name)
  (let* ((pair (bal-find-account table name))
         (principal (cdr pair))
         (interest (if (< principal 0)
                       (bal-round (* (cdr pair) bal-interest-rate))
                     0)))
    (bal-replace interest start end)
    (setcdr pair (+ (cdr pair) interest))))

(defun bal-safe-interest-rate-p (value)
  (numberp value))

(defun bal-value (table name)
  (let* ((sym (intern name))
	 (pair (assq sym (cdr table))))
    (cdr pair)))

(defun bal-update ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let ((accounts (bal-make-table)))
      (while (re-search-forward bal-regexp nil t)
	(let ((amount (string-to-number (match-string 1)))
	      (op (char-after (match-beginning 2)))
	      (account (match-string 3)))
	  (cond
	   ((eq op ?+) (bal-accumulate accounts account amount))
	   ((eq op ?-) (bal-accumulate accounts account (- amount)))
           ((eq op ?@) (bal-interest accounts account
                                     (match-beginning 1) (match-end 1)))
	   ((eq op ?=) (bal-replace (bal-value accounts account)
				    (match-beginning 1)
				    (match-end 1)))))))))


(define-minor-mode balance-mode
  "Minor mode for editing balance sheets.
The buffer can contain arbitrary text, marked up with tags that denote
credits, debits, and where to show the current total.
\\<balance-mode-map>
In the following explanation,
N denotes a monetary amount --- any number of digits followed by a
	decimal point, and then exactly two digits.
A denotes an account name --- any string of non-whitespace characters.

Credits have the form ``N+A'', meaning \"add N to A.\"
Debits have the form ``N-A'', meaning \"subtract N from A.\"
Reports have the form ``N=A'', meaning that \\[bal-update] should
   replace N with the current balance of account A, according to the
   credits and debits that precede it in the buffer's text.
Interest payments have the form ``N@A'', meaning that
   \\[bal-update] should replace N with the interest due on the
   balance of account A, and add that amount to A. The interest
   rate is the value of the buffer-local variable bal-interest-rate;
   this is a simple factor by which the balance is multiplied;
   so, if you are paying interest monthly, then this should be
   the twelfth root of the yearly rate."
  nil " Bal" balance-mode-map)