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