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