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

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