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