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

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