cgit.sxemacs.org Git - emoney/blob - emoney.el

   1 ;; emoney.el --- A home finance package.
   2
   3 ;; Copyright (C) 2003 - 2011 Steve Youngs
   4
   5 ;; Author:        Steve Youngs <steve@sxemacs.org>
   6 ;; Maintainer:    Steve Youngs <steve@sxemacs.org>
   7 ;; Created:       <2003-06-04>
   8 ;; Keywords:      money finance banking cash
   9
  10 ;; This file is part of eMoney.
  11
  12 ;; Redistribution and use in source and binary forms, with or without
  13 ;; modification, are permitted provided that the following conditions
  14 ;; are met:
  15 ;;
  16 ;; 1. Redistributions of source code must retain the above copyright
  17 ;;    notice, this list of conditions and the following disclaimer.
  18 ;;
  19 ;; 2. Redistributions in binary form must reproduce the above copyright
  20 ;;    notice, this list of conditions and the following disclaimer in the
  21 ;;    documentation and/or other materials provided with the distribution.
  22 ;;
  23 ;; 3. Neither the name of the author nor the names of any contributors
  24 ;;    may be used to endorse or promote products derived from this
  25 ;;    software without specific prior written permission.
  26 ;;
  27 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  28 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  29 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  30 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  31 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  32 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  33 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  34 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  35 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  36 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  37 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  38
  39 ;;; Commentary:
  40 ;;
  41 ;;  eMoney is based on balance.el, originally by Jason Baietto
  42 ;;  <jason@ssd.csd.harris.com> and later maintained by Bob Newell
  43 ;;  <bnewell@alum.mit.edu>.
  44 ;;
  45 ;;  eMoney tries to give the user a reasonably self-contained finance
  46 ;;  solution.  The target audience is the home user and possibly the
  47 ;;  small (very small) business operator.  It probably will never be
  48 ;;  compatible with any commercial finance packages available.
  49 ;;
  50 ;;  Right now, eMoney is nothing more than a very simple cash book
  51 ;;  program.  Use it to balance your cheque book.  See the "Todo:"
  52 ;;  section for a partial list of possible upcoming features.
  53 ;;
  54 ;;  Installation (from source):
  55 ;;
  56 ;;    tar zxf emoney-x.xx.tar.gz
  57 ;;    cd emoney-x.xx
  58 ;;    check the paths in Makefile
  59 ;;    make
  60 ;;    make install (you may need to be root for this)
  61 ;;
  62 ;;  Installation (from XEmacs package tarball):
  63 ;;
  64 ;;    cd /usr/local/share/sxemacs/site-packages
  65 ;;     (/usr/local/lib/xemacs/site-packages for XEmacs)
  66 ;;    tar zxf /path/to/emoney-x.xx-pkg.tar.gz
  67 ;;
  68 ;;  (Re)start (S)XEmacs and do `M-x emoney RET'
  69 ;;
  70 ;;  You can also invoke `emoney-mode' by simply visiting a file with a
  71 ;;  `.emy' extension.
  72 ;;
  73 ;; Please note that I use SXEmacs exclusively, I have no idea whether
  74 ;; or not this will run or even byte-compile with GNU/Emacs (it _will_
  75 ;; work fine with XEmacs).  Also, I have no desire or intentions of
  76 ;; making this package portable between XEmacs and GNU/Emacs.  Harsh
  77 ;; words?  No, not really, I simply don't have the time or resources to
  78 ;; invest in the extra work involved.  And also there is no way that
  79 ;; I'd be able to support GNU/Emacs users because I'm not familiar with
  80 ;; that flavour of Emacs.  If you want to port it, be my guest, this is
  81 ;; an Open Source project.
  82 ;;
  83 ;; Another note: This package uses correct English spelling wherever
  84 ;; possible.  For example, "cheque" instead of "check", "summarise"
  85 ;; instead of "summarize".  Although I welcome and encourage _ALL_
  86 ;; contributions, patches that s/que/ch/ or s/ise/ize/ will go straight
  87 ;; to /dev/null.
  88
  89 ;;; ChangeLog:
  90 ;;
  91 ;;  This is just a place holder so `emoney-commentary' will work
  92 ;;  properly.  See the ChangeLog file for changes.
  93
  94 ;;; Code:
  95
  96 ;; Drag in what we need.
  97 (eval-and-compile
  98   (autoload 'calc "calc" nil t)
  99   (autoload 'clear-rectangle "rect" nil t)
 100   (autoload 'completing-read "minibuf")
 101   (autoload 'customize-group "cus-edit")
 102   (autoload 'lm-commentary "lisp-mnt")
 103   (autoload 'sort-numeric-fields "sort" nil t)
 104   (autoload 'untabify "tabify" nil t)
 105   (autoload 'with-electric-help "ehelp")
 106   (require 'wid-edit))
 107
 108 (eval-when-compile
 109   (autoload 'eval-when "cl-macs" nil nil 'macro)
 110   (autoload 'calc-quit "calc" nil t)
 111   (require 'advice)
 112   (defvar calc-was-split)
 113   (autoload 'browse-url "browse-url" nil t)
 114   (autoload 'regexp-opt "regexp-opt"))
 115
 116 ;; Custom.
 117 (defgroup emoney nil
 118   "Customisations for `emoney-mode'."
 119   :prefix "emoney-"
 120   :group 'tools)
 121
 122 (defcustom emoney-accounts-buffer-width 35
 123   "How wide in columns for the accounts buffer."
 124   :type 'integer
 125   :group 'emoney)
 126
 127 (defcustom emoney-accounts-buffer-height 9
 128   "How high in lines for the accounts buffer."
 129   :type 'integer
 130   :group 'emoney)
 131
 132 (defcustom emoney-header-buffer-height 4
 133   "How high in lines for the header buffer."
 134   :type 'integer
 135   :group 'emoney)
 136
 137 (defcustom emoney-accounts-directory (file-name-as-directory
 138                                       (expand-file-name ".emoney"
 139                                                         (user-home-directory)))
 140   "*The directory where your eMoney account files are located."
 141   :type 'directory
 142   :group 'emoney)
 143
 144 (defcustom emoney-history-directory (file-name-as-directory
 145                                      (expand-file-name "history"
 146                                                        emoney-accounts-directory))
 147   "*Directory containing previous years account files."
 148   :type 'directory
 149   :group 'emoney)
 150
 151 (defcustom emoney-chart-of-accounts
 152   (if (file-directory-p emoney-accounts-directory)
 153       (directory-files emoney-accounts-directory nil "\\.emy$" nil t)
 154     nil)
 155   "*A list of eMoney accounts in `emoney-accounts-directory'."
 156   :type '(repeat
 157           (string :tag "Account Name"))
 158   :group 'emoney)
 159
 160 (defcustom emoney-default-account (or (car emoney-chart-of-accounts)
 161                                       "default.emy")
 162   "*The default eMoney account to use.
 163
 164 This is the account that has the focus when you start eMoney."
 165   :type 'string
 166   :group 'emoney)
 167
 168 (defcustom emoney-credit-transaction-types
 169   '("autotellcr" "atmcr" "bankcredit" "bcr" "deposit" "dep" "directcr"
 170     "dcr" "internetcr" "netcr" "phonecr" "phcr")
 171   "*List of valid credit transaction types.
 172
 173 The default types are:
 174
 175           autotellcr -- Automatic Teller Machine deposit
 176                atmcr -- short version of 'autotellcr'
 177
 178           bankcredit -- Bank initiated credits like interest etc
 179                  bcr -- short version of 'bankcredit'
 180
 181              deposit -- Manual, non-direct deposits
 182                  dep -- short version of 'deposit'
 183
 184             directcr -- Direct credit transactions
 185                  dcr -- short version of 'directcr'
 186
 187           internetcr -- Internet credit transactions
 188                netcr -- short version of 'internetcr'
 189
 190              phonecr -- Telephone credit transactions
 191                 phcr -- short version of 'phonecr'"
 192   :type '(repeat string)
 193   :group 'emoney)
 194
 195 (defcustom emoney-debit-transaction-types
 196   '("autotelldb" "atmdb" "bankfee" "fee" "directdb" "ddb" "eftpos"
 197     "eft" "internetdb" "netdb" "phonedb" "phdb" "withdrawal" "wdl")
 198   "*List of valid debit transaction types.
 199
 200 The default types are:
 201
 202           autotelldb -- Automatic Teller Machine transaction
 203                atmdb -- short version of 'autoteller'
 204
 205              bankfee -- Bank fees
 206                  fee -- short version of 'bankfee'
 207
 208             directdb -- Direct debit transactions
 209                  ddb -- short version of 'directdb'
 210
 211               eftpos -- Electronic Funds Transfer Point Of Sale
 212                  eft -- short version of 'eftpos'
 213
 214           internetdb -- Internet transactions
 215                netdb -- short version of 'internet'
 216
 217              phonedb -- Telephone transactions
 218                 phcr -- short version of 'phone'
 219
 220           withdrawal -- Over the counter withdrawal.
 221                  wdl -- short version of 'withdrawal'"
 222   :type '(repeat string)
 223   :group 'emoney)
 224
 225 (defcustom emoney-cr-transfer-transaction-type "xfrcr"
 226   "*Credit transfer transaction types."
 227   :type 'string
 228   :group 'emoney)
 229
 230 (defcustom emoney-db-transfer-transaction-type "xfrdb"
 231   "*Debit transfer transaction type."
 232   :type 'string
 233   :group 'emoney)
 234
 235 (defcustom emoney-date-format "%Y-%m-%d"
 236   "*The format that `emoney-mode' uses for dates."
 237   :type '(choice
 238           (const :tag "yyyy-mm-dd"
 239                  :value "%Y-%m-%d")
 240           (const :tag "yyyy/mm/dd"
 241                  :value "%Y/%m/%d")
 242           (const :tag "mm/dd/yy"
 243                  :value "%m/%d/%y")
 244           (const :tag "mm/dd/yyyy"
 245                  :value "%m/%d/%Y")
 246           (const :tag "mm-dd-yy"
 247                  :value "%m-%d-%y")
 248           (const :tag "mm-dd-yyyy"
 249                  :value "%m-%d-%Y")
 250           (const :tag "dd/mm/yy"
 251                  :value "%d/%m/%y")
 252           (const :tag "dd/mm/yyyy"
 253                  :value "%d/%m/%Y")
 254           (const :tag "dd-mm-yy"
 255                  :value "%d-%m-%y")
 256           (const :tag "dd-mm-yyyy"
 257                  :value "%d-%m-%Y")
 258           (const :tag "yy/mm/dd"
 259                  :value "%y/%m/%d")
 260           (const :tag "yy-mm-dd"
 261                  :value "%y-%m-%d"))
 262   :group 'emoney)
 263
 264 (defcustom emoney-uk-cheque-spelling t
 265   "*When non-nil, use UK spelling: \"chq\" instead of \"chk\"."
 266   :type 'boolean
 267   :group 'emoney)
 268
 269 (defcustom emoney-save-after-recalculate t
 270   "*If non-nil, save the buffer after a recalculate.
 271
 272 See `emoney-recalculate-buffer'."
 273   :type 'boolean
 274   :group 'emoney)
 275
 276 (defcustom emoney-recalculate-on-quit nil
 277   "*If non-nil, recalculate each eMoney account buffer when quitting eMoney."
 278   :type 'boolean
 279   :group 'emoney)
 280
 281 (defcustom emoney-use-new-frame nil
 282   "*If non-nil, eMoney will start in a new frame."
 283   :type 'boolean
 284   :group 'emoney)
 285
 286 (defcustom emoney-bank-url "unset"
 287   "The URL of your bank's web page."
 288   :type 'string
 289   :group 'emoney)
 290
 291 ;; Hooks
 292 (defgroup emoney-hooks nil
 293   "Various hooks for eMoney."
 294   :prefix "emoney-"
 295   :group 'emoney)
 296
 297 (defcustom emoney-mode-hooks nil
 298   "*Hooks run after `emoney-mode' is entered."
 299   :type 'hook
 300   :group 'emoney-hooks)
 301
 302 (defcustom emoney-switch-account-hook nil
 303   "*Hooks run after switching accounts."
 304   :type 'hook
 305   :group 'emoney-hooks)
 306
 307 (defcustom emoney-setup-accounts-buffer-hook nil
 308   "*Hooks run after setting up the accounts buffer."
 309   :type 'hook
 310   :group 'emoney-hooks)
 311
 312 (defcustom emoney-setup-header-buffer-hook nil
 313   "*Hooks run after setting up the header buffer."
 314   :type 'hook
 315   :group 'emoney-hooks)
 316
 317 (defcustom emoney-setup-control-buffer-hook nil
 318   "*Hooks run after setting up the control buffer."
 319   :type 'hook
 320   :group 'emoney-hooks)
 321
 322 (defcustom emoney-transaction-hook nil
 323   "*Hooks run after appending a new transaction.
 324
 325 These hooks are run after any new transaction, including cheque
 326 and transfers.  If you want to do additional things with cheque or
 327 transfer transactions, see `emoney-transaction-cheque-hook' &
 328 `emoney-transaction-transfer-hook'."
 329   :type 'hook
 330   :group 'emoney-hooks)
 331
 332 (defcustom emoney-transaction-cheque-hook nil
 333   "*Hooks run after appending a cheque transaction."
 334   :type 'hook
 335   :group 'emoney-hooks)
 336
 337 (defcustom emoney-transaction-transfer-hook nil
 338   "*Hooks run after appending a transfer transaction."
 339   :type 'hook
 340   :group 'emoney-hooks)
 341
 342 (defcustom emoney-recalculate-before-hook nil
 343   "*Hooks run just prior to recalculating an eMoney buffer.
 344
 345 See `emoney-recalculate-after-hook' for doing things after recalculating."
 346   :type 'hook
 347   :group 'emoney-hooks)
 348
 349 (defcustom emoney-recalculate-after-hook nil
 350   "*Hooks run just after recalculating an eMoney buffer.
 351
 352 See `emoney-recalculate-before-hook' for doing things before recalculating."
 353   :type 'hook
 354   :group 'emoney-hooks)
 355
 356 (defcustom emoney-summarise-cheques-hook nil
 357   "*Hooks run after doing `emoney-summarise-cheques'."
 358   :type 'hook
 359   :group 'emoney-hooks)
 360
 361 (defcustom emoney-new-account-hook nil
 362   "*Hooks run after creating a new account."
 363   :type 'hook
 364   :group 'emoney-hooks)
 365
 366 (defcustom emoney-quit-before-hook nil
 367   "*Hooks run just prior to eMoney exiting."
 368   :type 'hook
 369   :group 'emoney-hooks)
 370
 371 (defcustom emoney-quit-after-hook nil
 372   "*Hooks run as the last thing when eMoney exits."
 373   :type 'hook
 374   :group 'emoney-hooks)
 375
 376 ;; Faces
 377 (defgroup emoney-faces nil
 378   "eMoney faces."
 379   :prefix "emoney-"
 380   :group 'emoney)
 381
 382 (make-face 'emoney-account-name-face)
 383 (set-face-parent 'emoney-account-name-face 'font-lock-variable-name-face)
 384
 385 (make-face 'emoney-debit-face)
 386 (set-face-parent 'emoney-debit-face 'font-lock-warning-face)
 387
 388 (make-face 'emoney-credit-face)
 389 (set-face-parent 'emoney-credit-face 'font-lock-function-name-face)
 390
 391 (make-face 'emoney-date-face)
 392 (set-face-parent 'emoney-date-face 'font-lock-keyword-face)
 393
 394 (make-face 'emoney-clear-tran-face)
 395 (set-face-parent 'emoney-clear-tran-face 'font-lock-string-face)
 396
 397 (make-face 'emoney-unclear-tran-face)
 398 (set-face-parent 'emoney-unclear-tran-face 'font-lock-comment-face)
 399
 400 (make-face 'emoney-header-face)
 401 (set-face-parent 'emoney-header-face 'font-lock-comment-face)
 402
 403 (defcustom emoney-account-name-face 'emoney-account-name-face
 404   "Face for highlighting eMoney account names."
 405   :type 'face
 406   :group 'emoney-faces)
 407
 408 (defcustom emoney-debit-face 'emoney-debit-face
 409   "Face for highlighting debit amounts in eMoney."
 410   :type 'face
 411   :group 'emoney-faces)
 412
 413 (defcustom emoney-credit-face 'emoney-credit-face
 414   "Face for highlighting credit amounts in eMoney."
 415   :type 'face
 416   :group 'emoney-faces)
 417
 418 (defcustom emoney-date-face 'emoney-date-face
 419   "Face for highlighting dates in eMoney."
 420   :type 'face
 421   :group 'emoney-faces)
 422
 423 (defcustom emoney-clear-tran-face 'emoney-clear-tran-face
 424   "Face for highlighting cleared transactions in eMoney."
 425   :type 'face
 426   :group 'emoney-faces)
 427
 428 (defcustom emoney-unclear-tran-face 'emoney-unclear-tran-face
 429   "Face for highlighting uncleared transactions in eMoney."
 430   :type 'face
 431   :group 'emoney-faces)
 432
 433 (defcustom emoney-header-face 'emoney-header-face
 434   "Face for highlighting the column header in eMoney."
 435   :type 'face
 436   :group 'emoney-faces)
 437
 438 ;;; Internal variables
 439 (defconst emoney-codename "Finance"
 440   "The codename of the current version of eMoney.")
 441
 442 (defconst emoney-is-beta t
 443   "Non-nil if the current version of eMoney is beta.")
 444
 445 (eval-when (load eval)
 446   (unless (file-directory-p emoney-accounts-directory)
 447     (make-directory-path emoney-accounts-directory)))
 448
 449 (require 'emoney-version)
 450
 451 ;;;###autoload
 452 (defun emoney-version (&optional arg)
 453   "*Display the current version information for eMoney.
 454
 455 Prefix Argument ARG, print version information at point
 456 in the current buffer."
 457   (interactive "P")
 458   (let ((fmt-string "eMoney: %s, \"%s\""))
 459     (when emoney-is-beta
 460       (setq fmt-string (concat fmt-string " [Beta]")))
 461     (if arg
 462         (insert (format fmt-string emoney-version emoney-codename))
 463       (message fmt-string emoney-version emoney-codename))))
 464
 465
 466 ;;;###autoload
 467 (defun emoney-commentary ()
 468   "*Display the commentary section of emoney.el."
 469   (interactive)
 470   (with-electric-help
 471    '(lambda ()
 472       (insert
 473        (with-temp-buffer
 474          (erase-buffer)
 475          (insert (lm-commentary (locate-library "emoney.el")))
 476          (goto-char (point-min))
 477          (while (re-search-forward "^;+ ?" nil t)
 478            (replace-match "" nil nil))
 479          (buffer-string (current-buffer)))))
 480    "*eMoney Commentary*"))
 481
 482 ;;;###autoload
 483 (defun emoney-copyright ()
 484   "*Display the copyright notice for eMoney."
 485   (interactive)
 486   (with-electric-help
 487    '(lambda ()
 488       (insert
 489        (with-temp-buffer
 490          (erase-buffer)
 491          (insert-file-contents (locate-library "emoney.el"))
 492          (goto-char (point-min))
 493          (re-search-forward ";;; Commentary" nil t)
 494          (beginning-of-line)
 495          (narrow-to-region (point-min) (point))
 496          (while (re-search-backward "^;+ ?" nil t)
 497            (replace-match "" nil nil))
 498          (buffer-string (current-buffer)))))
 499    "*eMoney Copyright Notice*"))
 500
 501 (defvar emoney-frame nil
 502   "The frame where eMoney is displayed, if in a new frame.")
 503
 504 (defconst emoney-accounts-buffer "*eMoney A/C's*"
 505   "The buffer that holds the list of eMoney accounts.")
 506
 507 (defconst emoney-control-buffer "*eMoney Control*"
 508   "The buffer containing the eMoney control buttons.")
 509
 510 (defconst emoney-header-buffer "*eMoney Header*"
 511   "The buffer for the eMoney account register header line.")
 512
 513 (defvar emoney-current-account-name
 514   (file-name-sans-extension emoney-default-account))
 515
 516 (defun emoney-switch-to-account (account)
 517   "Switch to account, ACCOUNT."
 518   (interactive
 519    (list (emoney-completing-read "Switch to A/C: "
 520                                  emoney-chart-of-accounts nil t)))
 521   (select-window (get-buffer-window
 522                   (concat emoney-current-account-name ".emy")))
 523   (switch-to-buffer account)
 524   (goto-char (point-max))
 525   (setq emoney-current-account-name
 526         (file-name-sans-extension account))
 527   (select-window (get-buffer-window emoney-header-buffer))
 528   (emoney-setup-header-buffer)
 529   (switch-to-buffer emoney-header-buffer)
 530   (select-window (get-buffer-window
 531                   (concat emoney-current-account-name ".emy")))
 532   (run-hooks 'emoney-switch-account-hook))
 533
 534 (defun emoney-mouse-switch-to-account (event)
 535   "Switch to account under EVENT."
 536   (interactive "e")
 537   (save-excursion
 538     (set-buffer (window-buffer (event-window event)))
 539     (let ((switch-acc (extent-string (extent-at-event event))))
 540       (select-window (get-buffer-window
 541                       (concat emoney-current-account-name ".emy")))
 542       (switch-to-buffer (concat switch-acc ".emy"))
 543       (goto-char (point-max))
 544       (setq emoney-current-account-name switch-acc)
 545       (select-window (get-buffer-window emoney-header-buffer))
 546       (emoney-setup-header-buffer)
 547       (switch-to-buffer emoney-header-buffer)))
 548   (select-window (get-buffer-window
 549                   (concat emoney-current-account-name ".emy")))
 550   (run-hooks 'emoney-switch-account-hook))
 551
 552 (defconst emoney-accounts-buffer-map
 553   (let* ((map (make-sparse-keymap 'emoney-accounts-buffer-map)))
 554     (define-key map [button2] #'emoney-mouse-switch-to-account)
 555     map)
 556   "A keymap for the extents in eMoney Accounts buffer.")
 557
 558 (defconst emoney-largest-balance "999999999.99"
 559   "This is only used for formatting purposes.")
 560
 561 (defun emoney-setup-accounts-buffer ()
 562   "Set up the eMoney \"Accounts\" buffer."
 563   (let ((buf emoney-accounts-buffer)
 564         (accounts emoney-chart-of-accounts)
 565         help-msg cbal)
 566     (save-excursion
 567       (when (buffer-live-p (get-buffer-create buf))
 568         (kill-buffer buf))
 569       (set-buffer (get-buffer-create buf))
 570       (while accounts
 571         (setq help-msg (concat "Switch to A/C: "
 572                                (file-name-sans-extension (car accounts))))
 573         (insert (file-name-sans-extension (car accounts)))
 574         (set-extent-properties
 575          (make-extent (point-at-bol) (point))
 576          `(face emoney-account-name-face
 577                 mouse-face highlight
 578                 help-echo ,help-msg
 579                 balloon-help ,help-msg
 580                 keymap ,emoney-accounts-buffer-map))
 581         (with-current-buffer (car accounts)
 582           (goto-char (point-max))
 583           (re-search-backward "\\s-[\\+-=]\\s-" nil t)
 584           (setq cbal (nth 2 (emoney-parse-transaction-data
 585                              (buffer-substring (point) (point-at-eol))))))
 586           (move-to-column 18 'force)
 587         (if cbal
 588             (insert-face
 589              (format
 590               (concat "%"
 591                       (number-to-string (- (length emoney-largest-balance)
 592                                            (length (format "%.2f" cbal))))
 593                       "s$%.2f") "" cbal)
 594              (if (< cbal 0)
 595                  'emoney-debit-face
 596                'emoney-credit-face))
 597           (insert " Needs Recalc"))
 598         (insert "\n")
 599         (setq cbal nil)
 600         (setq accounts (cdr accounts)))
 601       (set-specifier horizontal-scrollbar-visible-p nil (current-buffer))
 602       (set-specifier has-modeline-p nil (current-buffer))
 603       (goto-char (point-min))
 604       (run-hooks 'emoney-setup-accounts-buffer-hook))))
 605
 606 (defconst emoney-header
 607   "Date       Type       C Description                         Amount      Balance
 608 ===============================================================================\n"
 609   "The header inserted at the top of a `emoney-mode' buffer.")
 610
 611 (defun emoney-setup-header-buffer ()
 612   "Set up the eMoney \"Account Register Header\" buffer."
 613   (let ((buf emoney-header-buffer))
 614     (save-excursion
 615       (when (buffer-live-p (get-buffer-create buf))
 616         (kill-buffer buf))
 617       (set-buffer (get-buffer-create buf))
 618       (center-line
 619        (insert-face (upcase emoney-current-account-name)
 620                     'emoney-header-face))
 621       (insert "\n\n")
 622       (insert-face emoney-header 'emoney-header-face)
 623       (set-specifier horizontal-scrollbar-visible-p nil (current-buffer))
 624       (set-specifier vertical-scrollbar-visible-p nil (current-buffer))
 625       (set-specifier has-modeline-p nil (current-buffer))
 626       (goto-char (point-min))
 627       (run-hooks 'emoney-setup-header-buffer-hook))))
 628
 629 ;;;###autoload
 630 (defun emoney-customise ()
 631   "*Convenience function to customise eMoney."
 632   (interactive)
 633   (customize-group 'emoney))
 634
 635 ;; Because lots of people in the world can't spell.
 636 ;;;###autoload
 637 (defalias 'emoney-customize 'emoney-customise)
 638
 639 (defvar emoney-transaction-types '("init" "")
 640   "A list of valid transaction types.
 641
 642 It is a combination of `emoney-credit-transaction-types',
 643 `emoney-debit-transaction-types', and a blank type.")
 644
 645 (defconst emoney-cheque-type
 646   (if emoney-uk-cheque-spelling
 647       "chq[ \t]+\\([0-9]+\\)"
 648     "chk[ \t]+\\([0-9]+\\)")
 649   "Type field for cheque transactions.
 650
 651 This is defined separately from the other transaction types because
 652 it is used by functions that perform special operations on cheque.
 653 transactions.")
 654
 655 (defconst emoney-date-column 0
 656   "Column where transaction date begins.")
 657
 658 (defconst emoney-type-column 11
 659   "Column where transaction type begins.")
 660
 661 (defconst emoney-clear-column 22
 662   "Column where status appears.")
 663
 664 (defconst emoney-description-column 24
 665   "Column where transaction description begins.")
 666
 667 (defconst emoney-sign-column 52
 668   "Column where transaction sign begins.")
 669
 670 (defconst emoney-amount-column 54
 671   "Column where transaction amount begins.")
 672
 673 (defconst emoney-current-balance-column 65
 674   "Column where current emoney begins.")
 675
 676 (defconst emoney-tab-stop-list
 677   (list
 678    emoney-date-column
 679    emoney-type-column
 680    emoney-clear-column
 681    emoney-description-column
 682    emoney-sign-column
 683    emoney-amount-column
 684    emoney-current-balance-column)
 685   "List of tab stops that define the start of all transaction fields.")
 686
 687 (defvar emoney-mode-map
 688   (let ((map (make-sparse-keymap 'emoney-mode-map)))
 689     (define-key map [(control c) (control b)] #'emoney-backward-field)
 690     (define-key map [(control c) (control c)] #'emoney-recalculate-buffer)
 691     (define-key map [(control c) (control d)] #'emoney-clear-current-field)
 692     (define-key map [(control c) (control f)] #'emoney-forward-field)
 693     (define-key map [(control c) (control n)] #'emoney-append-next-cheque)
 694     (define-key map [(control c) (control r)] #'emoney-summarise-cheques-region)
 695     (define-key map [(control c) (control s)] #'emoney-summarise-cheques-buffer)
 696     (define-key map [(control c) (control t)] #'emoney-append-transaction)
 697     (define-key map [(control c) (control x)] #'emoney-transfer-funds)
 698     (define-key map [tab]                     #'emoney-forward-field)
 699     (define-key map [iso-left-tab]            #'emoney-backward-field)
 700     (define-key map [(control c) b]           #'emoney-go-to-bank)
 701     (define-key map [(control c) c]           #'emoney-calc)
 702     (define-key map [(control c) s]           #'emoney-switch-to-account)
 703     (define-key map [(control c) q]           #'emoney-quit)
 704     (define-key map [(control c) (control q)] #'emoney-recalc-and-exit)
 705     map)
 706   "Keymap for emoney buffer.")
 707
 708 (defconst emoney-mode-menu
 709   '("eMoney"
 710     ["New A/C" emoney-new-account t]
 711     "---"
 712     [(concat "New "
 713              (if emoney-uk-cheque-spelling
 714                  "Cheque "
 715                "Check ")
 716              "Transaction") emoney-append-next-cheque t]
 717     ["New Transaction" emoney-append-transaction t]
 718     ["Transfer Funds" emoney-transfer-funds t]
 719     "---"
 720     ["Next Field" emoney-forward-field t]
 721     ["Previous Field" emoney-backward-field t]
 722     ["Clear Current Field" emoney-clear-current-field t]
 723     "---"
 724     [(concat "Summary of "
 725              (if emoney-uk-cheque-spelling
 726                  "cheques "
 727                "checks ")
 728              "(buffer)") emoney-summarise-cheques-buffer t]
 729     [(concat "Summary of "
 730              (if emoney-uk-cheque-spelling
 731                  "cheques "
 732                "checks ")
 733              "(region)") emoney-summarise-cheques-region t]
 734     "---"
 735     ["Recalculate Buffer" emoney-recalculate-buffer t]
 736     "---"
 737     ["Go To The Bank!" emoney-go-to-bank t]
 738     ["Calculator" emoney-calc t]
 739     "---"
 740     ["Recalc All A/C's and Exit" emoney-recalc-and-exit t]
 741     ["Exit eMoney" emoney-quit t])
 742   "Menu for `emoney-mode' buffers.")
 743
 744 (easy-menu-define
 745  emoney-mode-easymenu nil "eMoney" emoney-mode-menu)
 746
 747 (defvar emoney-credit-type-keywords
 748   (regexp-opt (append emoney-credit-transaction-types
 749                       (list emoney-cr-transfer-transaction-type)))
 750   "eMoney font lock keywords for credit tran types")
 751
 752 (defvar emoney-debit-type-keywords
 753   (regexp-opt (append emoney-debit-transaction-types
 754                       (list emoney-db-transfer-transaction-type)))
 755   "eMoney font lock keywords for debit tran types")
 756
 757 (defvar emoney-font-lock-keywords
 758   `(("x\\s-\\(.*\\)[\\+-]\\s-" (1 emoney-clear-tran-face))
 759     ("o\\s-\\(.*\\)[\\+-]\\s-" (1 emoney-unclear-tran-face))
 760     (,emoney-credit-type-keywords . emoney-credit-face)
 761     (,emoney-debit-type-keywords . emoney-debit-face)
 762     ("\\(^[0-9]+\\(-\\|\\/\\)[0-9]+\\(-\\|\\/\\)[0-9]+\\)"
 763      (1 emoney-date-face))
 764     ("-\\s-+\\([0-9]+\\.[0-9][0-9]\\)" (1 emoney-debit-face))
 765     ("-[0-9]+\\.[0-9]+" . emoney-debit-face)
 766     ("[^-]\\([0-9]+\\.[0-9]+$\\)" (1 emoney-credit-face))
 767     ("\\+\\s-+\\([0-9]+\\.[0-9][0-9]\\)" (1 emoney-credit-face)))
 768   "Font lock keywords for `emoney-mode'.")
 769
 770
 771 ;;;###autoload
 772 (defun emoney-mode ()
 773   "Major mode for editing a buffer containing financial transactions.
 774 The following bindings provide the main functionality of this mode:
 775
 776 \\{emoney-mode-map}
 777
 778 Transactions occur on a single line and have the following fields (in
 779 order):
 780
 781  date          The transaction date.  See `emoney-date-format'.
 782  type          This field must either be blank or match one of the
 783                expressions defined in `emoney-credit-transaction-types'
 784                and `emoney-debit-transaction-types'.
 785  clear         Status of transaction, 'o' is open, 'x' is cleared.  New
 786                transactions default to 'o'.
 787  description   A possibly blank transaction description.
 788  sign          This field must either be '+', '-' or '='.  '+' means
 789                credit, '-' means debit, and '=' resets balance.  eMoney
 790                will usually guess the correct sign to use.
 791  amount        The transaction amount.
 792  balance       The balance after this transaction.  This field will be
 793                computed upon recalculation, you _don't_ need to fill it
 794                in.  Just do: \\[emoney-recalculate-buffer].
 795
 796 Any line in the buffer that does not begin with a date will be
 797 considered a comment and ignored.  Among other things, this allows
 798 the transaction description to span several lines.
 799
 800 Changing any amount and recalculating again will update all visible
 801 balances.  Transactions may be commented out by putting a semi-colon
 802 \(or any other non-numerical character\) at the beginning of the line.
 803
 804 Entering `emoney-mode' runs the `emoney-mode-hooks' if any exist."
 805   (interactive)
 806   (kill-all-local-variables)
 807   (setq major-mode 'emoney-mode)
 808   (setq mode-name "eMoney")
 809   (use-local-map emoney-mode-map)
 810   (easy-menu-add emoney-mode-easymenu)
 811   (make-local-variable 'tab-stop-list)
 812   (setq tab-stop-list emoney-tab-stop-list)
 813   (make-local-variable 'indent-tabs-mode)
 814   (setq indent-tabs-mode nil)
 815   (setq indent-line-function 'emoney-forward-field)
 816   (overwrite-mode 1)
 817   (run-hooks 'emoney-mode-hooks))
 818
 819 (defun emoney-current-line ()
 820   "Return the current buffer line at point."
 821   (save-excursion
 822     (beginning-of-line)
 823     (count-lines (point-min) (point))))
 824
 825 (defun emoney-completing-read (prompt table &optional predicate require-match
 826                                initial-contents history default)
 827   "Like `completing-read', but also accepts strings.
 828
 829 Arguments PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-CONTENTS,
 830 HISTORY, DEFAULT are as per `completing-read'."
 831   (completing-read
 832    prompt
 833    (if (vectorp table)
 834        table
 835      (mapcar 'list table))
 836    predicate require-match initial-contents history default))
 837
 838 (defun emoney-forward-field ()
 839   "Move the cursor to the next field on the current line."
 840   (interactive)
 841   (move-to-tab-stop))
 842
 843 (defun emoney-go-to-bank ()
 844   "Open your bank's URL with `browse-url'."
 845   (interactive)
 846   (if (or (equal emoney-bank-url "unset")
 847           (not emoney-bank-url))
 848       (message-or-box "Please customise `emoney-bank-url'.")
 849     (browse-url emoney-bank-url)))
 850
 851 (defun emoney-calc ()
 852   "Wrapper around `calc' to get around \"window-edges bug\"."
 853   (interactive)
 854   (add-hook 'calc-end-hook #'(lambda ()
 855                                (setq calc-was-split nil)))
 856   (calc))
 857
 858 (defun emoney-last (list)
 859   "Return last element in LIST."
 860   (cond
 861    ((null list)
 862     '())
 863    ((null (cdr list))
 864     (car list))
 865    (t (emoney-last (cdr list)))))
 866
 867 (defun emoney-find-largest-less-than (list item)
 868   "Search a sorted LIST of numbers, return the largest number that is < ITEM."
 869   (let ((list-car (car list))
 870         (list-cdr (cdr list))
 871         (last nil))
 872     (while (and list-car (< list-car item))
 873       (setq last list-car)
 874       (setq list-car (car list-cdr))
 875       (setq list-cdr (cdr list-cdr)))
 876     last))
 877
 878 (defun emoney-find-largest-less-than-equal (list item)
 879   "Return cdr of LIST starting @ the largest number that is <= to ITEM."
 880   (let ((list-car (car list))
 881         (list-cdr (cdr list))
 882         (last nil))
 883     (while (and list-car (<= list-car item))
 884       (setq last (cons list-car list-cdr))
 885       (setq list-car (car list-cdr))
 886       (setq list-cdr (cdr list-cdr)))
 887     last))
 888
 889 (defun emoney-find-field (column)
 890   "Return a list of the start and end of the field around COLUMN.
 891
 892 End may be nil if column is after the last defined tab stop."
 893   (let ((field (emoney-find-largest-less-than-equal
 894                 emoney-tab-stop-list column)))
 895     (if (equal 1 (length field))
 896         (list (car field) nil)
 897       (list (nth 0 field) (nth 1 field)))))
 898
 899 (defun emoney-backward-field ()
 900   "Move the cursor to the previous entry field on the current line."
 901   (interactive)
 902   (let* ((col (current-column))
 903          (prev (emoney-find-largest-less-than emoney-tab-stop-list col)))
 904     (if prev
 905         (move-to-column prev)
 906       (move-to-column (emoney-last emoney-tab-stop-list)))))
 907
 908 (defun emoney-clear-current-field ()
 909   "Fill the field around point with spaces, leave point at start of field."
 910   (interactive)
 911   (let* ((field (emoney-find-field (current-column)))
 912          (line-start (progn (beginning-of-line) (point)))
 913          (line-end (progn
 914                      (end-of-line)
 915                      (untabify line-start (point))
 916                      (point)))
 917          (field-start (+ line-start (nth 0 field)))
 918          (field-end (if (nth 1 field)
 919                         (+ line-start (nth 1 field))
 920                       line-end)))
 921     (clear-rectangle field-start field-end)
 922     (goto-char field-start)))
 923
 924 (defsubst emoney-build-types-list ()
 925   "Dynamically build a list of transaction types.
 926
 927 This is done dynamically so that the user can change or add to the
 928 list of transaction types without having to reload eMoney."
 929   ;; Initialise to ("init" "").
 930   (setq emoney-transaction-types '("init" ""))
 931   ;; Load the debit and credit transaction types.
 932   (setq emoney-transaction-types
 933         (append emoney-transaction-types
 934                 emoney-debit-transaction-types
 935                 emoney-credit-transaction-types
 936                 (list emoney-cr-transfer-transaction-type)
 937                 (list emoney-db-transfer-transaction-type))))
 938
 939 ;; Stolen from Gnus' time-date.el
 940 (defun emoney-days-to-time (days)
 941   "Convert DAYS into a time value."
 942   (let* ((seconds (* 1.0 days 60 60 24))
 943          (rest (expt 2 16))
 944          (ms (condition-case nil (floor (/ seconds rest))
 945                (range-error (expt 2 16)))))
 946     (list ms (condition-case nil (round (- seconds (* ms rest)))
 947                (range-error (expt 2 16))))))
 948
 949 ;; Stolen from Gnus' time-date.el
 950 (defun emoney-time-add (t1 t2)
 951   "Add two time values.  One should represent a time difference."
 952   (let ((high (car t1))
 953         (low (if (consp (cdr t1)) (nth 1 t1) (cdr t1)))
 954         (micro (if (numberp (car-safe (cdr-safe (cdr t1))))
 955                    (nth 2 t1)
 956                  0))
 957         (high2 (car t2))
 958         (low2 (if (consp (cdr t2)) (nth 1 t2) (cdr t2)))
 959         (micro2 (if (numberp (car-safe (cdr-safe (cdr t2))))
 960                     (nth 2 t2)
 961                   0)))
 962     ;; Add
 963     (setq micro (+ micro micro2))
 964     (setq low (+ low low2))
 965     (setq high (+ high high2))
 966
 967     ;; Normalize
 968     ;; `/' rounds towards zero while `mod' returns a positive number,
 969     ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))).
 970     (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0)))
 971     (setq micro (mod micro 1000000))
 972     (setq high (+ high (/ low 65536) (if (< low 0) -1 0)))
 973     (setq low (logand low 65535))
 974
 975     (list high low micro)))
 976
 977 (defun emoney-append-transaction (&optional trans-type description amount)
 978   "Add a transaction to the end of current buffer using today's date."
 979   (interactive)
 980   (goto-char (point-max))
 981   (if (not (equal 0 (current-column)))
 982       (newline))
 983   (let* ((date-variance
 984           (read-number "Date (RET for current; -DAYS past; DAYS future): "
 985                        'integers-only "0"))
 986          (tran-date
 987           (format-time-string emoney-date-format
 988                               (emoney-time-add
 989                                (current-time)
 990                                (emoney-days-to-time date-variance)))))
 991     (insert tran-date))
 992   (move-to-tab-stop)
 993   (emoney-build-types-list)
 994   (let* ((type (or trans-type
 995                    (emoney-completing-read "Transaction type: "
 996                                            emoney-transaction-types))))
 997     (insert type)
 998     (move-to-tab-stop)
 999     (insert "o")
1000     (move-to-tab-stop)
1001     (let ((before-descript (point))
1002           (start-column (current-column))
1003           (fill-column (- emoney-sign-column
1004                           emoney-description-column
1005                           1)))
1006       (save-excursion
1007         (insert (or description
1008                     (read-string "Description: ")))
1009         (save-restriction
1010           (narrow-to-region before-descript (point))
1011           (goto-char before-descript)
1012           (while (progn (move-to-column fill-column) (not (eobp)))
1013             (search-forward " " nil t)
1014             (insert "\n"))
1015           (fill-paragraph 1)
1016           (goto-char before-descript)
1017           (forward-line 1)
1018           (while (progn (beginning-of-line) (not (eobp)))
1019             (indent-to-column start-column)
1020             (forward-line 1)))))
1021     (move-to-tab-stop)
1022     (cond ((or (member type emoney-credit-transaction-types)
1023                (string= type emoney-cr-transfer-transaction-type))
1024            (insert "+"))
1025           ((or (member type emoney-debit-transaction-types)
1026                (string= type emoney-db-transfer-transaction-type))
1027            (insert "-"))
1028           ((string= type "init")
1029            (insert "="))
1030           (t (if (y-or-n-p "Is this a credit transaction? ")
1031                  (insert "+")
1032                (if (y-or-n-p "Is this a debit transaction? ")
1033                    (insert "-")
1034                  (if (y-or-n-p "Is this an initialising transaction? ")
1035                      (insert "=")
1036                    (warn "Couldn't determine +/-/=, leaving blank"))))))
1037     (move-to-tab-stop)
1038     (insert (if amount
1039                 (number-to-string amount)
1040               (read-string "Amount: ")))
1041     (run-hooks 'emoney-transaction-hook)))
1042
1043 (defun emoney-append-next-cheque ()
1044   "Add a cheque transaction to the end of the current buffer using today's date.
1045
1046 Inserts the cheque number following the last cheque number written into the
1047 transaction type column.  Loses if you write cheques out of order."
1048   (interactive)
1049   (goto-char (point-max))
1050   (if (not (equal 0 (current-column)))
1051       (newline))
1052   (insert (format-time-string emoney-date-format))
1053   (move-to-tab-stop)
1054   (let (cheque cheque-number noinit)
1055     (save-excursion
1056       (if (search-backward-regexp emoney-cheque-type 0 t)
1057           (progn
1058             (setq cheque (buffer-substring (match-beginning 1) (match-end 1)))
1059             (setq noinit nil))
1060         (move-to-column emoney-type-column)
1061         (if (< (current-column) emoney-type-column)
1062             (indent-to-column emoney-type-column))
1063         (if emoney-uk-cheque-spelling
1064             (insert "chq 000001")
1065           (insert "chk 000001"))
1066         (setq noinit t)))
1067     (unless noinit
1068       (setq cheque-number (1+ (string-to-number cheque)))
1069       (move-to-column emoney-type-column)
1070       (if (< (current-column) emoney-type-column)
1071           (indent-to-column emoney-type-column))
1072       (if emoney-uk-cheque-spelling
1073           (insert (format "chq %06d" cheque-number))
1074         (insert (format "chk %06d" cheque-number))))
1075     (move-to-tab-stop)
1076     (insert "o")
1077     (move-to-tab-stop)
1078     (let ((before-descript (point))
1079           (start-column (current-column))
1080           (fill-column (- emoney-sign-column
1081                           emoney-description-column
1082                           1)))
1083       (save-excursion
1084         (insert (read-string "Payable To: "))
1085         (save-restriction
1086           (narrow-to-region before-descript (point))
1087           (goto-char before-descript)
1088           (while (progn (move-to-column fill-column) (not (eobp)))
1089             (search-forward " " nil t)
1090             (insert "\n"))
1091           (fill-paragraph 1)
1092           (goto-char before-descript)
1093           (forward-line 1)
1094           (while (progn (beginning-of-line) (not (eobp)))
1095             (indent-to-column start-column)
1096             (forward-line 1)))))
1097     (move-to-tab-stop)
1098     (insert "-")
1099     (move-to-tab-stop)
1100     (insert (read-string "Amount: "))
1101     (run-hooks 'emoney-transaction-hook)
1102     (run-hooks 'emoney-transaction-cheque-hook)))
1103
1104 (defvar emoney-transfer-account-history nil)
1105
1106 (defun emoney-transfer-funds (from to amount)
1107   "Transfer funds from one eMoney account to another.
1108
1109 Argument FROM is the account to transfer from.
1110 Argument To is the account to transfer to.
1111 Argument AMOUNT is how much to transfer."
1112   (interactive
1113    (list (emoney-completing-read "Transfer from: "
1114                                  emoney-chart-of-accounts nil t
1115                                  (concat emoney-current-account-name
1116                                          ".emy")
1117                                  emoney-transfer-account-history)
1118          (emoney-completing-read "Transfer to: "
1119                                  emoney-chart-of-accounts nil t nil
1120                                  emoney-transfer-account-history)
1121          (read-number "Amount: ")))
1122   (let ((current-ac (concat emoney-current-account-name ".emy")))
1123     (with-current-buffer from
1124       (emoney-append-transaction
1125        emoney-db-transfer-transaction-type
1126        (concat "T'fer to " (file-name-sans-extension to))
1127        amount))
1128     (with-current-buffer to
1129       (emoney-append-transaction
1130        emoney-cr-transfer-transaction-type
1131        (concat "T'fer from " (file-name-sans-extension from))
1132        amount))
1133     (loop for buf in '(from to)
1134       do (emoney-switch-to-account (symbol-value buf))
1135       do (emoney-recalculate-buffer))
1136     (run-hooks 'emoney-transaction-transfer-hook)
1137     (emoney-switch-to-account current-ac)))
1138
1139 (defsubst emoney-build-type-regexp ()
1140   "Return a regular expression that will match any valid transaction type.
1141
1142 This is done dynamically so users can redefine the valid transactions in
1143 their `user-init-file' even after this file has been loaded."
1144   (emoney-build-types-list)
1145   (let ((types (append emoney-transaction-types
1146                        (list emoney-cheque-type))))
1147     (concat
1148      "^\\("
1149      (mapconcat
1150       #'(lambda(x) x) types "\\|")
1151      "\\)[ \t]*$")))
1152
1153 (defun emoney-check-transaction-type (line-start)
1154   "Check to make sure a valid transaction type has been used.
1155
1156 Argument LINE-START is the starting point.
1157
1158 Please note that the word \"check\" here means \"verify\" and it has
1159 nothing to do with the American spelling of the word \"cheque\"."
1160   (let* ((type-regexp (emoney-build-type-regexp))
1161          (type-start (+ line-start emoney-type-column))
1162          (type-end (+ line-start emoney-clear-column))
1163          (type-string (buffer-substring type-start type-end)))
1164     (if (string-match type-regexp type-string)
1165         nil
1166       (error "Line %d, invalid type: %s"
1167              (1+ (emoney-current-line)) type-string))))
1168
1169 (defun emoney-find-next-transaction ()
1170   "Find the next line that is a complete transaction.
1171
1172 Return a list of the line start, numeric data start and line end
1173 points."
1174   (let ((found nil)
1175         (line-regexp
1176          "^\\([0-90-9]\\)+.*$")
1177         line-start
1178         line-end
1179         data-start)
1180     (while (and
1181             (not found)
1182             (search-forward-regexp line-regexp (point-max) t))
1183       (setq line-start (match-beginning 0))
1184       (setq line-end (progn (end-of-line) (point)))
1185       (setq data-start (+ line-start emoney-sign-column))
1186       (if (> line-end data-start)
1187           (setq found t)))
1188     (if found
1189         (list line-start data-start line-end)
1190       nil)))
1191
1192 (defun emoney-parse-transaction-data (data)
1193   "Return a list of floating point numbers from DATA.
1194
1195 DATA is a string representing the sign, amount and optionally balance of a
1196 transaction.  Balance is nil if not present."
1197   (let ((data-regexp "\\([-+=]\\)[ \t]*\\([0-9.]+\\)?[ \t]*\\([-]?[0-9.]+\\)?")
1198         (balance nil)
1199         (reset nil)
1200         string sign amount)
1201     (string-match data-regexp data)
1202     (if (match-beginning 1)
1203         (setq sign (substring data (match-beginning 1) (match-end 1)))
1204       (error "Line %d, missing sign" (1+ (emoney-current-line))))
1205     (if (equal "=" sign)
1206         (progn
1207           (setq sign "+")
1208           (setq reset t)))
1209     (if (match-beginning 2)
1210         (progn
1211           (setq string (substring data (match-beginning 2) (match-end 2)))
1212           (setq amount (string-to-number (concat sign string))))
1213       (error "Line %d, missing amount" (1+ (emoney-current-line))))
1214     (if (match-beginning 3)
1215         (progn
1216           (setq string (substring data (match-beginning 3) (match-end 3)))
1217           (setq balance (string-to-number string))))
1218     (if reset (setq sign "="))
1219     (list sign amount balance)))
1220
1221 (defun emoney-same (amount1 amount2)
1222   "Compare two dollar amounts, AMOUNT1 AMOUNT2, for equivalence."
1223   (let ((string1 (format "%10.2f" amount1))
1224         (string2 (format "%10.2f" amount2)))
1225     (equal string1 string2)))
1226
1227 (defun emoney-form-transaction-data (sign amount balance)
1228   "Given SIGN, AMOUNT and a BALANCE, return a string.
1229
1230 The string is suitable for placing in the numeric region of a
1231 transaction, based on the defined input columns."
1232   (let* ((amount (abs amount))
1233          (width1 (- emoney-amount-column emoney-sign-column))
1234          (width2 (- emoney-current-balance-column emoney-amount-column))
1235          (len (length emoney-largest-balance))
1236          (gap (- width2 len))
1237          (value (concat "%" (number-to-string len) ".2f"))
1238          (format-string (concat "%-" (number-to-string width1)
1239                                 "s" value
1240                                 "%" (number-to-string gap) "s" value)))
1241     (format format-string sign amount "" balance)))
1242
1243 (defun emoney-recalculate (start end)
1244   "Recalculate the balances for region START END.
1245
1246 The final balance, uncleared total, and the number of balances that
1247 changed, and the transaction count are returned in a list."
1248   (run-hooks 'emoney-recalculate-before-hook)
1249   (let ((current-balance 0)
1250         (changes 0)
1251         (uncleared 0)
1252         (transactions 0)
1253         line-points)
1254     (save-excursion
1255       (save-restriction
1256         (narrow-to-region start end)
1257         (untabify (point-min) (point-max))
1258         (goto-char (point-min))
1259         (while (setq line-points (emoney-find-next-transaction))
1260           (setq transactions (1+ transactions))
1261           (let* ((line-start (nth 0 line-points))
1262                  (data-start (nth 1 line-points))
1263                  (data-end (nth 2 line-points))
1264                  (clear-flag (buffer-substring
1265                               (+ line-start emoney-clear-column)
1266                               (+ 1 line-start emoney-clear-column)))
1267                  (data-string (buffer-substring data-start data-end))
1268                  (data-values (emoney-parse-transaction-data data-string))
1269                  (sign (nth 0 data-values))
1270                  (amount (nth 1 data-values))
1271                  (balance (nth 2 data-values))
1272                  (new-balance (if (equal sign "=")
1273                                   amount
1274                                 (+ current-balance amount)))
1275                  (new-uncleared (if (equal clear-flag "x")
1276                                     uncleared
1277                                   (+ uncleared amount)))
1278                  (new-string
1279                   (emoney-form-transaction-data sign amount new-balance)))
1280             (emoney-check-transaction-type line-start)
1281             (setq current-balance new-balance)
1282             (setq uncleared new-uncleared)
1283             (if (or (null balance) (not (emoney-same balance new-balance)))
1284                 (setq changes (1+ changes)))
1285             (if (not (equal data-string new-string))
1286                 (progn
1287                   (delete-region data-start data-end)
1288                   (goto-char data-start)
1289                   (insert new-string)))))
1290         (widen)))
1291     (run-hooks 'emoney-recalculate-after-hook)
1292     (list current-balance uncleared changes transactions)))
1293
1294 (defvar emoney-is-exiting nil
1295   "Non-nil when eMoney is in the process of quitting.")
1296
1297 (defun emoney-update-acc-buf-bal (account balance)
1298   "Update ACCOUNT BALANCE in accounts buffer."
1299   (with-current-buffer emoney-accounts-buffer
1300     (goto-char (point-min))
1301     (search-forward account)
1302     (kill-line)
1303     (move-to-column 18 'force)
1304     (insert-face
1305      (format (concat "%"
1306                      (number-to-string (- (length emoney-largest-balance)
1307                                           (length (format "%.2f" balance))))
1308                      "s$%.2f") "" balance)
1309      (if (< balance 0)
1310          'emoney-debit-face
1311        'emoney-credit-face))))
1312
1313 (defun emoney-recalculate-buffer ()
1314   "Recalculate the current buffer.
1315
1316 See `emoney-recalculate'."
1317   (interactive)
1318   (let* ((result (emoney-recalculate (point-min) (point-max)))
1319          (balance (nth 0 result))
1320          (uncleared (nth 1 result))
1321          (changes (nth 2 result))
1322          (total (nth 3 result)))
1323     (when emoney-save-after-recalculate
1324       (save-buffer (current-buffer)))
1325     (emoney-update-acc-buf-bal emoney-current-account-name balance)
1326     (if emoney-is-exiting
1327         (message
1328          (format "book bal %.2f unclrd %.2f bank bal %.2f (%d/%d recalcs)"
1329                  balance uncleared (- balance uncleared) changes total))
1330       (message-or-box
1331        (format "book bal %.2f unclrd %.2f bank bal %.2f (%d/%d recalcs)"
1332                balance uncleared (- balance uncleared) changes total)))
1333     (if (> changes 0)
1334         (end-of-line))))
1335
1336 (defun emoney-recalculate-region (start end)
1337   "Recalculate the current region, START END.
1338
1339 See `emoney-recalculate'."
1340   (interactive "r")
1341   (let* ((result (emoney-recalculate start end))
1342          (balance (nth 0 result))
1343          (uncleared (nth 1 result))
1344          (changes (nth 2 result))
1345          (total (nth 3 result)))
1346     (message-or-box (format "Region balance %.2f uncleared %.2f (%d/%d recalcs)"
1347                             balance uncleared changes total))
1348     (if (> changes 0)
1349         (end-of-line))))
1350
1351 (defun emoney-summarise-cheques (start end)
1352   "Create a buffer that lists only the cheques in the specified region.
1353
1354 The region is denoted by START END.
1355
1356 The list is sorted on cheque number.  Breaks in sequence are denoted by lines
1357 containing an asterisk between the cheques where the break occurs.  The buffer
1358 is also recalculated, thus showing to total of the cheques summarised."
1359   (let ((emoney-buffer (current-buffer))
1360         (summary-buffer (get-buffer-create "*cheque summary*"))
1361         (cheque-count 0)
1362         (sequence-breaks 0)
1363         line-points)
1364     (save-excursion
1365       (save-restriction
1366         (set-buffer summary-buffer)
1367         (delete-region (point-min) (point-max))
1368         (set-buffer emoney-buffer)
1369         (narrow-to-region start end)
1370         (goto-char (point-min))
1371         (while (setq line-points (emoney-find-next-transaction))
1372           (let* ((line-start (nth 0 line-points))
1373                  (line-end (nth 2 line-points))
1374                  (type-start (+ line-start emoney-type-column))
1375                  (type-end (+ line-start emoney-description-column))
1376                  (type-string (buffer-substring type-start type-end)))
1377             (if (string-match emoney-cheque-type type-string)
1378                 (progn
1379                   (append-to-buffer
1380                    summary-buffer line-start (1+ line-end))
1381                   (setq cheque-count (1+ cheque-count))))))
1382         (widen)
1383         (set-buffer summary-buffer)
1384         (sort-numeric-fields 3 (point-min) (point-max))
1385         (setq sequence-breaks (emoney-find-sequence-breaks))
1386         (goto-char (point-max))
1387         (insert (format "\n%d cheque%s summarised, %d sequence break%s\n"
1388                         cheque-count
1389                         (if (equal 1 cheque-count) "" "s")
1390                         sequence-breaks
1391                         (if (equal 1 sequence-breaks) "" "s")))
1392         (set-buffer emoney-buffer)))
1393     (with-electric-help
1394      '(lambda ()
1395         (insert
1396          (with-temp-buffer
1397            (erase-buffer)
1398            (insert-buffer summary-buffer)
1399            (buffer-string (current-buffer)))))
1400      "*cheque summary*"))
1401   (run-hooks 'emoney-summarise-cheques-hook))
1402
1403 (defun emoney-find-sequence-breaks ()
1404   "Find cheque sequence breaks in the current cheque summary buffer.
1405
1406 Mark breaks in sequence by inserting a line with an asterisk between
1407 the offending cheques.  Return the count of sequence breaks found."
1408   (let ((last-cheque nil)
1409         (sequence-breaks 0))
1410     (goto-char (point-min))
1411     (while (search-forward-regexp
1412             (concat "\\([0-9/]+\\)[ \t]+" emoney-cheque-type)
1413             (point-max) t)
1414       (let* ((cheque-start (match-beginning 2))
1415              (cheque-end (match-end 2))
1416              (cheque-string (buffer-substring cheque-start cheque-end))
1417              (cheque-number (string-to-int cheque-string)))
1418         (if (not last-cheque)
1419             (setq last-cheque cheque-number)
1420           (if (not (equal cheque-number (1+ last-cheque)))
1421               (progn
1422                 (setq sequence-breaks (1+ sequence-breaks))
1423                 (beginning-of-line)
1424                 (open-line 1)
1425                 (insert "*")
1426                 (next-line 2)))
1427           (setq last-cheque cheque-number))))
1428     sequence-breaks))
1429
1430 (defun emoney-summarise-cheques-buffer ()
1431   "Summarise the cheque transactions in the current buffer."
1432   (interactive)
1433   (emoney-summarise-cheques (point-min) (point-max))
1434   (emoney-recalculate (point-min) (point-max)))
1435
1436 (defun emoney-summarise-cheques-region (start end)
1437   "Summarise the cheque transactions in region START - END."
1438   (interactive "r")
1439   (emoney-summarise-cheques start end)
1440   (emoney-recalculate (point-min) (point-max)))
1441
1442 (defun emoney-new-account (new-acc bal)
1443   "*Create a new A/C named NEW-ACC with initial balance BAL."
1444   (interactive
1445    (list (concat (read-string "New A/C Name: ") ".emy")
1446          (read-number "Initial Balance: " nil 0)))
1447   (find-file-noselect
1448    (expand-file-name new-acc emoney-accounts-directory))
1449   (setq emoney-chart-of-accounts
1450         (push new-acc emoney-chart-of-accounts))
1451   (select-window (get-buffer-window
1452                   (concat emoney-current-account-name ".emy")))
1453   (switch-to-buffer new-acc)
1454   (setq emoney-current-account-name
1455         (file-name-sans-extension new-acc))
1456   (emoney-append-transaction "init" "Opening Balance" bal)
1457   (emoney-recalculate-buffer)
1458   (emoney-show-buffers)
1459   (switch-to-buffer new-acc)
1460   (goto-char (point-max))
1461   (run-hooks 'emoney-new-account-hook))
1462
1463 (defun emoney-setup-control-buffer ()
1464   "Set up the eMoney \"Control\" buffer."
1465   (let ((buf emoney-control-buffer))
1466     (save-excursion
1467       (when (buffer-live-p (get-buffer-create buf))
1468         (kill-buffer buf))
1469       (set-buffer (get-buffer-create buf))
1470       (widget-create 'push-button
1471                      :notify (lambda (&rest ignore)
1472                                (call-interactively 'emoney-new-account))
1473                      :help-echo "Create a new eMoney account."
1474                      " New A/C ")
1475       (widget-insert " ")
1476       (widget-create 'push-button
1477                      :notify (lambda (&rest ignore)
1478                                (save-excursion
1479                                  (set-buffer
1480                                   (concat emoney-current-account-name ".emy"))
1481                                  (emoney-append-transaction)))
1482                      :help-echo "Add a new transaction\n
1483 If you want to add a cheque transaction
1484 use \"Add Chq\" instead."
1485                      "Add Trans")
1486       (widget-insert " ")
1487       (widget-create 'push-button
1488                      :notify (lambda (&rest ignore)
1489                                (save-excursion
1490                                  (set-buffer
1491                                   (concat emoney-current-account-name ".emy"))
1492                                  (emoney-append-next-cheque)))
1493                      :help-echo (if emoney-uk-cheque-spelling
1494                                     "Add a new cheque transaction."
1495                                   "Add a new check transaction.")
1496                      (if emoney-uk-cheque-spelling
1497                          " Add Chq "
1498                        " Add Chk "))
1499       (widget-insert " ")
1500       (widget-create 'push-button
1501                      :notify (lambda (&rest ignore)
1502                                (save-excursion
1503                                  (set-buffer
1504                                   (concat emoney-current-account-name ".emy"))
1505                                  (emoney-recalculate-buffer)))
1506                      :help-echo "Record the last transaction.\n
1507 Also recalculates the buffer."
1508                      "End Trans")
1509       (widget-insert "\n\n")
1510       (widget-create 'push-button
1511                      :notify (lambda (&rest ignore)
1512                                (save-excursion
1513                                  (set-buffer
1514                                   (concat emoney-current-account-name ".emy"))
1515                                  (call-interactively 'emoney-transfer-funds)))
1516                      :help-echo "Transfer funds between accounts."
1517                      "Transfer ")
1518       (widget-insert " ")
1519       (widget-create 'push-button
1520                      :notify (lambda (&rest ignore)
1521                                (save-excursion
1522                                  (set-buffer
1523                                   (concat emoney-current-account-name ".emy"))
1524                                  (emoney-summarise-cheques-buffer)))
1525                      :help-echo (if emoney-uk-cheque-spelling
1526                                     "Display a summary of cheques."
1527                                   "Display a summary of checks.")
1528                      (if emoney-uk-cheque-spelling
1529                          " Chq Sum "
1530                        " Chk Sum "))
1531       (widget-insert " ")
1532       (widget-create 'push-button
1533                      :notify (lambda (&rest ignore)
1534                                (emoney-calc))
1535                      :help-echo "Start the Emacs Calculator.\n
1536 So you can count up all
1537 of your millions!"
1538                      "  Calc   ")
1539       (widget-insert " ")
1540       (widget-create 'push-button
1541                      :notify (lambda (&rest ignore)
1542                                (if emoney-is-beta
1543                                    (message-or-box
1544                                     "eMoney: %s, \"%s\" [Beta]"
1545                                     emoney-version emoney-codename)
1546                                  (message-or-box
1547                                   "eMoney: %s, \"%s\""
1548                                   emoney-version emoney-codename)))
1549                      :help-echo "Display eMoney version info."
1550                      " Version ")
1551       (widget-insert "\n\n")
1552       (widget-create 'push-button
1553                      :notify (lambda (&rest ignore)
1554                                (emoney-go-to-bank))
1555                      :help-echo "Open your bank's web site in your browser."
1556                      "  Bank   ")
1557       (widget-insert " ")
1558       (widget-create 'push-button
1559                      :notify (lambda (&rest ignore)
1560                                (emoney-quit))
1561                      :help-echo "Exit eMoney."
1562                      "  Exit   ")
1563       (set-specifier horizontal-scrollbar-visible-p nil (current-buffer))
1564       (set-specifier vertical-scrollbar-visible-p nil (current-buffer))
1565       (set-specifier has-modeline-p nil (current-buffer))
1566       (run-hooks 'emoney-setup-control-buffer-hook))))
1567
1568 (defun emoney-show-buffers ()
1569   "Display all the eMoney buffers."
1570   (emoney-setup-accounts-buffer)
1571   (emoney-setup-control-buffer)
1572   (emoney-setup-header-buffer)
1573   (delete-other-windows nil)
1574   (switch-to-buffer emoney-accounts-buffer)
1575   (split-window nil emoney-accounts-buffer-height)
1576   (split-window nil emoney-accounts-buffer-width t)
1577   (other-window 1)
1578   (switch-to-buffer emoney-control-buffer)
1579   (other-window 1)
1580   (switch-to-buffer emoney-header-buffer)
1581   (split-window nil emoney-header-buffer-height)
1582   (other-window 1))
1583
1584 (defun emoney-quit ()
1585   "*Exit from eMoney, optionally recalculating all accounts first.
1586
1587 To have all of your accounts recalculated before eMoney exits set
1588 `emoney-recalculate-on-quit' to `t'
1589
1590 If `emoney-save-after-recalculate' is also `t' the account buffers
1591 will be saved before eMoney exits."
1592   (interactive)
1593   (run-hooks 'emoney-quit-before-hook)
1594   (let ((accounts emoney-chart-of-accounts))
1595     (setq emoney-is-exiting t)
1596     (dolist (buf accounts)
1597       (when emoney-recalculate-on-quit
1598         (set-buffer buf)
1599         (emoney-recalculate-buffer))
1600       (kill-buffer buf))
1601     (kill-buffer emoney-accounts-buffer)
1602     (kill-buffer emoney-control-buffer)
1603     (kill-buffer emoney-header-buffer)
1604     (run-hooks 'emoney-quit-after-hook)
1605     (when (and emoney-use-new-frame
1606                (frame-live-p emoney-frame))
1607       (delete-frame emoney-frame))
1608     (setq emoney-frame nil)
1609     (unless emoney-use-new-frame
1610       (jump-to-register ?\$))
1611     (setq emoney-is-exiting nil)))
1612
1613 (defun emoney-recalc-and-exit ()
1614   "*Exit form eMoney, recalculating all accounts first."
1615   (interactive)
1616   (let ((old-recalc-val emoney-recalculate-on-quit))
1617     (setq emoney-recalculate-on-quit t)
1618     (emoney-quit)
1619     (setq emoney-recalculate-on-quit old-recalc-val)))
1620
1621 ;;;###autoload
1622 (defun emoney ()
1623   "*Start a new eMoney session."
1624   (interactive)
1625   (unless emoney-use-new-frame
1626     (window-configuration-to-register ?\$))
1627   (unless (frame-live-p emoney-frame)
1628     (setq emoney-frame
1629           (if emoney-use-new-frame
1630               ;; FIXME: make the frame props customisable
1631               (make-frame '((name . "eMoney")
1632                             (height . 40)
1633                             (width . 80)))
1634             (selected-frame))))
1635   (select-frame emoney-frame)
1636   (let ((accounts emoney-chart-of-accounts)
1637         (dir emoney-accounts-directory))
1638     (while accounts
1639       (find-file (expand-file-name (car accounts) dir))
1640       (unless (eq major-mode 'emoney-mode)
1641         (emoney-mode))
1642       (setq accounts (cdr accounts)))
1643     (setq emoney-current-account-name
1644           (file-name-sans-extension emoney-default-account))
1645     (emoney-show-buffers)
1646     (switch-to-buffer emoney-default-account)
1647     (goto-char (point-max)))
1648   (focus-frame emoney-frame))
1649
1650 ;; Work around a problem with Emacs calc.  If you start calc in a
1651 ;; frame with multiple buffers visible when calc exits it doesn't
1652 ;; return point to the place it was when you called calc.  These
1653 ;; advices overcome that.
1654 (defadvice calc (before em-calc-win-save first activate)
1655   "Before starting calc, save the window config.
1656 This is so we can restore the window config when calc exits because
1657 calc doesn't DTRT in this regard by itself."
1658   (push-window-configuration))
1659
1660 (defadvice calc-quit (after em-calc-win-restore last activate)
1661   "Restore the \"pre calc\" window config on calc exit."
1662   (pop-window-configuration))
1663
1664
1665 ;;;###autoload(add-to-list 'auto-mode-alist '("\\.emy$" . emoney-mode))
1666
1667 (provide 'emoney)
1668
1669 ;;; emoney.el ends here