config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

ledger-reconcile.el (28865B)


      1 ;;; ledger-reconcile.el --- Helper code for use with the "ledger" command-line tool  -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2003-2016 John Wiegley (johnw AT gnu DOT org)
      4 
      5 ;; This file is not part of GNU Emacs.
      6 
      7 ;; This is free software; you can redistribute it and/or modify it under
      8 ;; the terms of the GNU General Public License as published by the Free
      9 ;; Software Foundation; either version 2, or (at your option) any later
     10 ;; version.
     11 ;;
     12 ;; This is distributed in the hope that it will be useful, but WITHOUT
     13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
     14 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
     15 ;; for more details.
     16 ;;
     17 ;; You should have received a copy of the GNU General Public License
     18 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
     19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
     20 ;; MA 02110-1301 USA.
     21 
     22 ;; Reconcile mode
     23 
     24 
     25 ;;; Commentary:
     26 ;; Code to handle reconciling Ledger files with outside sources
     27 
     28 ;;; Code:
     29 
     30 (require 'easymenu)
     31 (require 'ledger-init)
     32 
     33 (require 'ledger-xact)
     34 (require 'ledger-occur)
     35 (require 'ledger-commodities)
     36 (require 'ledger-exec)
     37 (require 'ledger-navigate)
     38 (require 'ledger-state)
     39 (declare-function ledger-insert-effective-date "ledger-mode" (&optional date))
     40 (declare-function ledger-read-account-with-prompt "ledger-mode" (prompt))
     41 (declare-function ledger-read-date "ledger-mode" (prompt))
     42 
     43 (defvar-local ledger-reconcile-ledger-buf nil
     44   "Buffer from which the current reconcile buffer was created.")
     45 
     46 (defvar-local ledger-reconcile-account nil
     47   "Account being reconciled in the current buffer.")
     48 
     49 (defvar-local ledger-reconcile-target nil
     50   "Target amount for this reconciliation process.")
     51 
     52 (defgroup ledger-reconcile nil
     53   "Options for Ledger-mode reconciliation"
     54   :group 'ledger)
     55 
     56 (define-obsolete-variable-alias
     57   'ledger-recon-buffer-name
     58   'ledger-reconcile-buffer-name
     59   "2023-12-15")
     60 
     61 (defcustom ledger-reconcile-buffer-name "*Reconcile*"
     62   "Name to use for reconciliation buffer."
     63   :type 'string
     64   :group 'ledger-reconcile)
     65 
     66 (defcustom ledger-narrow-on-reconcile t
     67   "If t, show only transactions matching the reconcile regex in the main buffer."
     68   :type 'boolean
     69   :group 'ledger-reconcile)
     70 
     71 (defcustom ledger-buffer-tracks-reconcile-buffer t
     72   "If t, move point in the ledger buffer when it moves in the reconcile buffer.
     73 When the cursor is moved to a new transaction in the reconcile
     74 buffer then that transaction will be shown in its source buffer."
     75   :type 'boolean
     76   :group 'ledger-reconcile)
     77 
     78 (defcustom ledger-reconcile-force-window-bottom nil
     79   "If t, show the reconcile window below the register window and resize."
     80   :type 'boolean
     81   :group 'ledger-reconcile)
     82 
     83 (defcustom ledger-reconcile-toggle-to-pending t
     84   "If t, then toggle between uncleared and pending.
     85 reconcile-finish will mark all pending posting cleared."
     86   :type 'boolean
     87   :group 'ledger-reconcile)
     88 
     89 (defcustom ledger-reconcile-default-date-format ledger-default-date-format
     90   "Date format for the reconcile buffer.
     91 Default is `ledger-default-date-format'."
     92   :type 'string
     93   :group 'ledger-reconcile)
     94 
     95 (defcustom ledger-reconcile-target-prompt-string "Target amount for reconciliation "
     96   "Prompt for reconcile target."
     97   :type 'string
     98   :group 'ledger-reconcile)
     99 
    100 (defcustom ledger-reconcile-buffer-header "Reconciling account %s\n\n"
    101   "Default header string for the reconcile buffer.
    102 
    103 If non-nil, the name of the account being reconciled will be substituted
    104         into the '%s'.  If nil, no header will be displayed."
    105   :type 'string
    106   :group 'ledger-reconcile)
    107 
    108 (defcustom ledger-reconcile-buffer-line-format "%(date)s %-4(code)s %-50(payee)s %-30(account)s %15(amount)s\n"
    109   "Format string for the ledger reconcile posting format.
    110 Available fields are date, status, code, payee, account,
    111 amount.  The format for each field is %WIDTH(FIELD), WIDTH can be
    112 preceded by a minus sign which mean to left justify and pad the
    113 field.  WIDTH is the minimum number of characters to display;
    114 if string is longer, it is not truncated unless
    115 `ledger-reconcile-buffer-payee-max-chars' or
    116 `ledger-reconcile-buffer-account-max-chars' is defined."
    117   :type 'string
    118   :group 'ledger-reconcile)
    119 
    120 (defcustom ledger-reconcile-buffer-payee-max-chars -1
    121   "If positive, truncate payee name right side to max number of characters."
    122   :type 'integer
    123   :group 'ledger-reconcile)
    124 
    125 (defcustom ledger-reconcile-buffer-account-max-chars -1
    126   "If positive, truncate account name left side to max number of characters."
    127   :type 'integer
    128   :group 'ledger-reconcile)
    129 
    130 (defcustom ledger-reconcile-sort-key "(0)"
    131   "Key for sorting reconcile buffer.
    132 
    133 Possible values are \"(date)\", \"(amount)\", \"(payee)\" or \"(0)\" for
    134 no sorting, i.e. using ledger file order."
    135   :type 'string
    136   :group 'ledger-reconcile)
    137 
    138 (defcustom ledger-reconcile-insert-effective-date nil
    139   "If t, prompt for effective date when clearing transactions.
    140 
    141 If this is a function, it is called with no arguments with point
    142 at the posting to be cleared.  The return value is then used as
    143 described above."
    144   :type '(choice boolean function)
    145   :group 'ledger-reconcile)
    146 
    147 (defcustom ledger-reconcile-finish-force-quit nil
    148   "If t, will force closing reconcile window after \\[ledger-reconcile-finish]."
    149   :type 'boolean
    150   :group 'ledger-reconcile)
    151 
    152 (defvar-local ledger-reconcile-last-balance-message nil)
    153 (defvar-local ledger-reconcile-last-balance-equals-target nil)
    154 
    155 (defface ledger-reconcile-last-balance-equals-target-face
    156   '((t :inherit header-line :foreground "green3"))
    157   "Face used for header line when cleared-or-pending balance equals the target."
    158   :group 'ledger-reconcile)
    159 
    160 ;; s-functions below are copied from Magnars' s.el
    161 ;; prefix ledger-reconcile- is added to not conflict with s.el
    162 (defun ledger-reconcile-s-pad-left (len padding s)
    163   "If S is shorter than LEN, pad it with PADDING on the left."
    164   (let ((extra (max 0 (- len (length s)))))
    165     (concat (make-string extra (string-to-char padding))
    166             s)))
    167 (defun ledger-reconcile-s-pad-right (len padding s)
    168   "If S is shorter than LEN, pad it with PADDING on the right."
    169   (let ((extra (max 0 (- len (length s)))))
    170     (concat s
    171             (make-string extra (string-to-char padding)))))
    172 (defun ledger-reconcile-s-left (len s)
    173   "Return up to the LEN first chars of S."
    174   (if (> (length s) len)
    175       (substring s 0 len)
    176     s))
    177 (defun ledger-reconcile-s-right (len s)
    178   "Return up to the LEN last chars of S."
    179   (let ((l (length s)))
    180     (if (> l len)
    181         (substring s (- l len) l)
    182       s)))
    183 
    184 (defun ledger-reconcile-truncate-right (str len)
    185   "Truncate STR right side with max LEN characters, and pad with '…' if truncated."
    186   (if (and (>= len 0) (> (length str) len))
    187       (ledger-reconcile-s-pad-right len "…" (ledger-reconcile-s-left (- len 1) str))
    188     str))
    189 
    190 (defun ledger-reconcile-truncate-left (str len)
    191   "Truncate STR left side with max LEN characters, and pad with '…' if truncated."
    192   (if (and (>= len 0) (> (length str) len))
    193       (ledger-reconcile-s-pad-left len "…" (ledger-reconcile-s-right (- len 1) str))
    194     str))
    195 
    196 (defun ledger-reconcile-get-cleared-or-pending-balance (buffer account)
    197   "Use BUFFER to Calculate the cleared or pending balance of the ACCOUNT."
    198 
    199   ;; these vars are buffer local, need to hold them for use in the
    200   ;; temp buffer below
    201 
    202   (with-temp-buffer
    203     ;; note that in the line below, the --format option is
    204     ;; separated from the actual format string.  emacs does not
    205     ;; split arguments like the shell does, so you need to
    206     ;; specify the individual fields in the command line.
    207     (ledger-exec-ledger buffer (current-buffer)
    208                         "balance" "--real" "--limit" "cleared or pending" "--empty" "--collapse"
    209                         "--format" "%(scrub(display_total))" account)
    210     (ledger-split-commodity-string
    211      (buffer-substring-no-properties (point-min) (point-max)))))
    212 
    213 (defun ledger-display-balance ()
    214   "Display the cleared-or-pending balance.
    215 And calculate the target-delta of the account being reconciled."
    216   (interactive)
    217   (when-let (pending (ledger-reconcile-get-cleared-or-pending-balance ledger-reconcile-ledger-buf ledger-reconcile-account))
    218     (let ((message
    219            (if-let (diff (and ledger-reconcile-target (ledger-subtract-commodity ledger-reconcile-target pending)))
    220                (progn
    221                  (setq ledger-reconcile-last-balance-equals-target (zerop (car diff)))
    222                  (format-message "Cleared and Pending balance: %s,   Difference from target: %s"
    223                                  (ledger-commodity-to-string pending)
    224                                  (ledger-commodity-to-string diff)))
    225              (format-message "Pending balance: %s"
    226                              (ledger-commodity-to-string pending)))))
    227       (setq ledger-reconcile-last-balance-message message)
    228       (message "%s" message))))
    229 
    230 (defun ledger-is-stdin (file)
    231   "True if ledger FILE is standard input."
    232   (or
    233    (equal file "")
    234    (equal file "<stdin>")
    235    (equal file "/dev/stdin")))
    236 
    237 (defun ledger-reconcile-get-buffer (where)
    238   "Return a buffer from WHERE the transaction is."
    239   (if (bufferp (car where))
    240       (car where)
    241     (error "Function ledger-reconcile-get-buffer: Buffer not set")))
    242 
    243 (defun ledger-reconcile-insert-effective-date ()
    244   "Prompt for an effective date and insert it at point, if enabled.
    245 
    246 If the value of variable `ledger-reconcile-insert-effective-date'
    247 is a function, it is called with the point where the effective
    248 date would be inserted.  If it returns non-nil, prompt for an
    249 effective date and insert it at point.  If it is not a function,
    250 do the same if its value is non-nil."
    251   (when (if (functionp ledger-reconcile-insert-effective-date)
    252             (save-excursion (funcall ledger-reconcile-insert-effective-date))
    253           ledger-reconcile-insert-effective-date)
    254     (ledger-insert-effective-date)))
    255 
    256 (defun ledger-reconcile-toggle ()
    257   "Toggle the current transaction, and mark the reconcile window."
    258   (interactive)
    259   (beginning-of-line)
    260   (let ((where (get-text-property (point) 'where))
    261         (inhibit-read-only t)
    262         status)
    263     (when (ledger-reconcile-get-buffer where)
    264       (with-current-buffer (ledger-reconcile-get-buffer where)
    265         (ledger-navigate-to-line (cdr where))
    266         (forward-char)
    267         (setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending
    268                                                 'pending
    269                                               'cleared)))
    270         ;; Ask for effective date & insert it, if enabled
    271         (ledger-reconcile-insert-effective-date))
    272       ;; remove the existing face and add the new face
    273       (remove-text-properties (line-beginning-position)
    274                               (line-end-position)
    275                               (list 'font-lock-face))
    276       (cond ((eq status 'pending)
    277              (add-text-properties (line-beginning-position)
    278                                   (line-end-position)
    279                                   (list 'font-lock-face 'ledger-font-reconciler-pending-face )))
    280             ((eq status 'cleared)
    281              (add-text-properties (line-beginning-position)
    282                                   (line-end-position)
    283                                   (list 'font-lock-face 'ledger-font-reconciler-cleared-face )))
    284             (t
    285              (add-text-properties (line-beginning-position)
    286                                   (line-end-position)
    287                                   (list 'font-lock-face 'ledger-font-reconciler-uncleared-face )))))
    288     (forward-line)
    289     (beginning-of-line)
    290     (ledger-display-balance)))
    291 
    292 (defun ledger-reconcile-refresh ()
    293   "Force the reconciliation window to refresh.
    294 Return the number of uncleared xacts found."
    295   (interactive)
    296   (let ((inhibit-read-only t)
    297         (line (count-lines (point-min) (point))))
    298     (erase-buffer)
    299     (prog1
    300         (ledger-do-reconcile ledger-reconcile-sort-key)
    301       (set-buffer-modified-p t)
    302       (ledger-reconcile-ensure-xacts-visible)
    303       (ledger-display-balance)
    304       (goto-char (point-min))
    305       (forward-line line))))
    306 
    307 (defun ledger-reconcile-refresh-after-save ()
    308   "Refresh the reconcile window after the ledger buffer is saved."
    309   (let ((curbufwin (get-buffer-window (current-buffer)))
    310         (curpoint (point))
    311         (reconcile-buf (get-buffer ledger-reconcile-buffer-name)))
    312     (when (buffer-live-p reconcile-buf)
    313       (with-current-buffer reconcile-buf
    314         (ledger-reconcile-refresh)
    315         (set-buffer-modified-p nil))
    316       (when curbufwin
    317         (select-window curbufwin)
    318         (goto-char curpoint)
    319         (recenter)
    320         (ledger-highlight-xact-under-point)))))
    321 
    322 (defun ledger-reconcile-add (date xact)
    323   "Use ledger xact to add a new transaction.
    324 
    325 When called interactively, prompt for DATE, then XACT."
    326   (interactive
    327    (list (ledger-read-date "Date: ")
    328          (read-string "Transaction: " nil 'ledger-minibuffer-history)))
    329   (with-current-buffer ledger-reconcile-ledger-buf
    330     (ledger-add-transaction (concat date " " xact)))
    331   (ledger-reconcile-refresh))
    332 
    333 (defun ledger-reconcile-delete ()
    334   "Delete the transactions pointed to in the reconcile window."
    335   (interactive)
    336   (let ((where (get-text-property (point) 'where)))
    337     (when (ledger-reconcile-get-buffer where)
    338       (with-current-buffer (ledger-reconcile-get-buffer where)
    339         (ledger-navigate-to-line (cdr where))
    340         (ledger-delete-current-transaction (point)))
    341       (let ((inhibit-read-only t))
    342         (delete-region (line-beginning-position)
    343                        (min (1+ (line-end-position)) (point-max)))
    344         (set-buffer-modified-p t))
    345       (ledger-reconcile-refresh)
    346       (ledger-reconcile-visit t))))
    347 
    348 (defun ledger-reconcile-visit (&optional come-back)
    349   "Recenter ledger buffer on transaction and COME-BACK if non-nil."
    350   (interactive)
    351   (beginning-of-line)
    352   (let* ((where (get-text-property (1+ (point)) 'where))
    353          (target-buffer (if where
    354                             (ledger-reconcile-get-buffer where)
    355                           nil))
    356          (cur-win (get-buffer-window (get-buffer ledger-reconcile-buffer-name))))
    357     (when target-buffer
    358       (switch-to-buffer-other-window target-buffer)
    359       (ledger-navigate-to-line (cdr where))
    360       (forward-char)
    361       (recenter)
    362       (ledger-highlight-xact-under-point)
    363       (forward-char -1)
    364       (when (and come-back cur-win)
    365         (select-window cur-win)
    366         (get-buffer ledger-reconcile-buffer-name)))))
    367 
    368 
    369 (defun ledger-reconcile-save ()
    370   "Save the ledger buffer."
    371   (interactive)
    372   (with-selected-window (selected-window) ; restoring window is needed because after-save-hook will modify window and buffers
    373     (with-current-buffer ledger-reconcile-ledger-buf
    374       (basic-save-buffer))))
    375 
    376 
    377 (defun ledger-reconcile-finish ()
    378   "Mark all pending posting or transactions as cleared.
    379 Depends on ledger-clear-whole-transactions, save the buffers and
    380 exit reconcile mode if `ledger-reconcile-finish-force-quit'"
    381   (interactive)
    382   (save-excursion
    383     (goto-char (point-min))
    384     (while (not (eobp))
    385       (let ((where (get-text-property (point) 'where))
    386             (face  (get-text-property (point) 'font-lock-face)))
    387         (if (eq face 'ledger-font-reconciler-pending-face)
    388             (with-current-buffer (ledger-reconcile-get-buffer where)
    389               (ledger-navigate-to-line (cdr where))
    390               (ledger-toggle-current 'cleared))))
    391       (forward-line 1)))
    392   (ledger-reconcile-save)
    393   (when ledger-reconcile-finish-force-quit
    394     (ledger-reconcile-quit)))
    395 
    396 
    397 (defun ledger-reconcile-quit ()
    398   "Quit the reconcile window without saving ledger buffer."
    399   (interactive)
    400   (let ((reconcile-buf (get-buffer ledger-reconcile-buffer-name))
    401         buf)
    402     (if reconcile-buf
    403         (with-current-buffer reconcile-buf
    404           (ledger-reconcile-quit-cleanup)
    405           (setq buf ledger-reconcile-ledger-buf)
    406           ;; Make sure you delete the window before you delete the buffer,
    407           ;; otherwise, madness ensues
    408           (delete-window (get-buffer-window reconcile-buf))
    409           (kill-buffer reconcile-buf)
    410           (set-window-buffer (selected-window) buf)))))
    411 
    412 (defun ledger-reconcile-quit-cleanup ()
    413   "Cleanup all hooks established by reconcile mode."
    414   (interactive)
    415   (let ((buf ledger-reconcile-ledger-buf))
    416     (if (buffer-live-p buf)
    417         (with-current-buffer buf
    418           (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)
    419           (when ledger-narrow-on-reconcile
    420             (ledger-occur-mode -1)
    421             (ledger-highlight-xact-under-point))))))
    422 
    423 (defun ledger-marker-where-xact-is (emacs-xact posting)
    424   "Find the position of the EMACS-XACT in the `ledger-reconcile-ledger-buf'.
    425 POSTING is used in `ledger-clear-whole-transactions' is nil."
    426   (let ((buf (if (ledger-is-stdin (nth 0 emacs-xact))
    427                  ledger-reconcile-ledger-buf
    428                (find-file-noselect (nth 0 emacs-xact)))))
    429     (cons
    430      buf
    431      (if (or ledger-clear-whole-transactions
    432              ;; The posting might not be part of the ledger buffer. This can
    433              ;; happen if the account to reconcile is the default account. In
    434              ;; that case, we just behave as if ledger-clear-whole-transactions
    435              ;; was turned on. See #58 for more info.
    436              (= -1 (nth 0 posting)))
    437          (nth 1 emacs-xact)  ;; return line-no of xact
    438        (nth 0 posting))))) ;; return line-no of posting
    439 
    440 (defun ledger-reconcile-compile-format-string (fstr)
    441   "Return a function that implements the format string in FSTR."
    442   (let (fields
    443         (start 0))
    444     (while (string-match "(\\(.*?\\))" fstr start)
    445       (setq fields (cons (intern (match-string 1 fstr)) fields))
    446       (setq start (match-end 0)))
    447     (setq fields (cl-list* 'format (replace-regexp-in-string "(.*?)" "" fstr) (nreverse fields)))
    448     `(lambda (date code status payee account amount)
    449        ,fields)))
    450 
    451 
    452 
    453 (defun ledger-reconcile-format-posting (beg where fmt date code status payee account amount)
    454   "Format posting for the reconcile buffer."
    455   (insert (funcall fmt date code status payee account amount))
    456 
    457                                         ; Set face depending on cleared status
    458   (if status
    459       (if (eq status 'pending)
    460           (set-text-properties beg (1- (point))
    461                                (list 'font-lock-face 'ledger-font-reconciler-pending-face
    462                                      'where where))
    463         (set-text-properties beg (1- (point))
    464                              (list 'font-lock-face 'ledger-font-reconciler-cleared-face
    465                                    'where where)))
    466     (set-text-properties beg (1- (point))
    467                          (list 'font-lock-face 'ledger-font-reconciler-uncleared-face
    468                                'where where))))
    469 
    470 (defun ledger-reconcile-format-xact (xact fmt)
    471   "Format XACT using FMT."
    472   (dolist (posting (nthcdr 5 xact))
    473     (let ((beg (point))
    474           (where (ledger-marker-where-xact-is xact posting)))
    475       (ledger-reconcile-format-posting beg
    476                                        where
    477                                        fmt
    478                                        (ledger-format-date (nth 2 xact))  ; date
    479                                        (if (nth 3 xact) (nth 3 xact) "")  ; code
    480                                        (nth 3 posting)  ; status
    481                                        (ledger-reconcile-truncate-right
    482                                         (nth 4 xact)  ; payee
    483                                         ledger-reconcile-buffer-payee-max-chars)
    484                                        (ledger-reconcile-truncate-left
    485                                         (nth 1 posting)  ; account
    486                                         ledger-reconcile-buffer-account-max-chars)
    487                                        (nth 2 posting)))))  ; amount
    488 
    489 (defun ledger-do-reconcile (&optional sort)
    490   "SORT the uncleared transactions in the account.
    491 The sorted results are displayed in in the *Reconcile* buffer.
    492 Return a count of the uncleared transactions."
    493   (let* ((buf ledger-reconcile-ledger-buf)
    494          (account ledger-reconcile-account)
    495          (sort-by (if sort
    496                       sort
    497                     "(date)"))
    498          (xacts
    499           (with-temp-buffer
    500             (ledger-exec-ledger buf (current-buffer)
    501                                 "--uncleared" "--real" "emacs" "--sort" sort-by account)
    502             (goto-char (point-min))
    503             (when (and (not (eobp)) (looking-at "("))
    504               (read (current-buffer)))))
    505          (fmt (ledger-reconcile-compile-format-string ledger-reconcile-buffer-line-format)))
    506     (if (null xacts)
    507         (insert (concat "There are no uncleared entries for " account))
    508       (if ledger-reconcile-buffer-header
    509           (insert (format ledger-reconcile-buffer-header account)))
    510       (dolist (xact xacts)
    511         (ledger-reconcile-format-xact xact fmt))
    512       (goto-char (point-max))
    513       (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list
    514     (goto-char (point-min))
    515     (set-buffer-modified-p nil)
    516     (setq buffer-read-only t)
    517 
    518     (length xacts)))
    519 
    520 (defun ledger-reconcile-ensure-xacts-visible ()
    521   "Ensure the last of the visible transactions in the ledger buffer is visible.
    522 This is achieved by placing that transaction at the bottom of the main window.
    523 The key to this is to ensure the window is selected when the buffer point is
    524 moved and recentered.  If they aren't strange things happen."
    525   (let ((reconcile-window (get-buffer-window (get-buffer ledger-reconcile-buffer-name))))
    526     (when reconcile-window
    527       (fit-window-to-buffer reconcile-window)
    528       (with-current-buffer ledger-reconcile-ledger-buf
    529         (add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t)
    530         (if (get-buffer-window ledger-reconcile-ledger-buf)
    531             (select-window (get-buffer-window ledger-reconcile-ledger-buf)))
    532         (recenter))
    533       (select-window reconcile-window)
    534       (ledger-reconcile-visit t))
    535     (with-current-buffer ledger-reconcile-ledger-buf
    536       (when ledger-occur-mode
    537         (ledger-occur-refresh)))
    538     (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t)))
    539 
    540 (defun ledger-reconcile-track-xact ()
    541   "Recenter the ledger buffer on the transaction at point in the reconcile buffer."
    542   (if (and ledger-buffer-tracks-reconcile-buffer
    543            (member this-command (list 'next-line
    544                                       'previous-line
    545                                       'mouse-set-point
    546                                       'ledger-reconcile-toggle
    547                                       'end-of-buffer
    548                                       'beginning-of-buffer)))
    549       (save-excursion
    550         (ledger-reconcile-visit t))))
    551 
    552 (defun ledger-reconcile-open-windows (buf rbuf)
    553   "Ensure that the ledger buffer BUF is split by RBUF."
    554   (if ledger-reconcile-force-window-bottom
    555       ;;create the *Reconcile* window directly below the ledger buffer.
    556       (set-window-buffer (split-window (get-buffer-window buf) nil nil) rbuf)
    557     (pop-to-buffer rbuf)))
    558 
    559 (defun ledger-reconcile-check-valid-account (account)
    560   "Check to see if ACCOUNT exists in the ledger file."
    561   (if (> (length account) 0)
    562       (save-excursion
    563         (goto-char (point-min))
    564         (search-forward account nil t))))
    565 
    566 (defun ledger-reconcile (&optional account target)
    567   "Start reconciling, prompt for ACCOUNT.
    568 
    569 If TARGET is non-nil, it is used as the initial target for
    570 reconciliation, otherwise prompt for TARGET."
    571   (interactive)
    572   (let ((account (or account (ledger-read-account-with-prompt "Account to reconcile")))
    573         (buf (current-buffer))
    574         (rbuf (get-buffer ledger-reconcile-buffer-name)))
    575 
    576     (when (ledger-reconcile-check-valid-account account)
    577       (if rbuf ;; *Reconcile* already exists
    578           (with-current-buffer rbuf
    579             (setq ledger-reconcile-account account)
    580             (when (not (eq buf rbuf))
    581               ;; called from some other ledger-mode buffer
    582               (ledger-reconcile-quit-cleanup)
    583               (setq ledger-reconcile-ledger-buf buf))
    584 
    585             (unless (get-buffer-window rbuf)
    586               (ledger-reconcile-open-windows buf rbuf)))
    587 
    588         ;; no reconcile-buffer, starting from scratch.
    589 
    590         (with-current-buffer (setq rbuf
    591                                    (get-buffer-create ledger-reconcile-buffer-name))
    592           (ledger-reconcile-open-windows buf rbuf)
    593           (ledger-reconcile-mode)
    594           (setq ledger-reconcile-ledger-buf buf)
    595           (setq ledger-reconcile-account account)))
    596 
    597       (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t)
    598 
    599       ;; Narrow the ledger buffer
    600       (if ledger-narrow-on-reconcile
    601           (ledger-occur (regexp-quote account)))
    602 
    603       (setq ledger-reconcile-last-balance-message nil)
    604       (setq ledger-reconcile-last-balance-equals-target nil)
    605 
    606       (with-current-buffer rbuf
    607         (if (> (ledger-reconcile-refresh) 0)
    608             (ledger-reconcile-change-target target)
    609           (ledger-display-balance))))))
    610 
    611 (defvar ledger-reconcile-mode-abbrev-table)
    612 
    613 (defun ledger-reconcile-change-target (&optional target)
    614   "Change the TARGET amount for the reconciliation process."
    615   (interactive)
    616   (setq ledger-reconcile-target (or target (ledger-read-commodity-string ledger-reconcile-target-prompt-string)))
    617   (ledger-display-balance))
    618 
    619 (defmacro ledger-reconcile-change-sort-key-and-refresh (sort-by)
    620   "Set the sort-key to SORT-BY."
    621   `(lambda ()
    622      (interactive)
    623 
    624      (setq ledger-reconcile-sort-key ,sort-by)
    625      (ledger-reconcile-refresh)))
    626 
    627 (defvar ledger-reconcile-mode-map
    628   (let ((map (make-sparse-keymap)))
    629     (define-key map (kbd "C-m") #'ledger-reconcile-visit)
    630     (define-key map (kbd "<return>") #'ledger-reconcile-visit)
    631     (define-key map (kbd "C-x C-s") #'ledger-reconcile-save)
    632     (define-key map (kbd "C-l") #'ledger-reconcile-refresh)
    633     (define-key map (kbd "C-c C-c") #'ledger-reconcile-finish)
    634     (define-key map (kbd "SPC") #'ledger-reconcile-toggle)
    635     (define-key map (kbd "a") #'ledger-reconcile-add)
    636     (define-key map (kbd "d") #'ledger-reconcile-delete)
    637     (define-key map (kbd "g") #'ledger-reconcile);
    638     (define-key map (kbd "n") #'next-line)
    639     (define-key map (kbd "p") #'previous-line)
    640     (define-key map (kbd "t") #'ledger-reconcile-change-target)
    641     (define-key map (kbd "s") #'ledger-reconcile-save)
    642     (define-key map (kbd "q") #'ledger-reconcile-quit)
    643     (define-key map (kbd "b") #'ledger-display-balance)
    644     (define-key map (kbd "B") #'ledger-reconcile-display-balance-in-header-mode)
    645 
    646     (define-key map (kbd "C-c C-o") (ledger-reconcile-change-sort-key-and-refresh "(0)"))
    647 
    648     (define-key map (kbd "C-c C-a") (ledger-reconcile-change-sort-key-and-refresh "(amount)"))
    649 
    650     (define-key map (kbd "C-c C-d") (ledger-reconcile-change-sort-key-and-refresh "(date)"))
    651 
    652     (define-key map (kbd "C-c C-p") (ledger-reconcile-change-sort-key-and-refresh "(payee)"))
    653     map)
    654   "Keymap for `ledger-reconcile-mode'.")
    655 
    656 (easy-menu-define ledger-reconcile-mode-menu ledger-reconcile-mode-map
    657   "Ledger reconcile menu"
    658   `("Reconcile"
    659     ["Save" ledger-reconcile-save]
    660     ["Refresh" ledger-reconcile-refresh]
    661     ["Finish" ledger-reconcile-finish]
    662     "---"
    663     ["Reconcile New Account" ledger-reconcile]
    664     "---"
    665     ["Change Target Balance" ledger-reconcile-change-target]
    666     ["Show Cleared Balance" ledger-display-balance]
    667     "---"
    668     ["Sort by payee" ,(ledger-reconcile-change-sort-key-and-refresh "(payee)")]
    669     ["Sort by date" ,(ledger-reconcile-change-sort-key-and-refresh "(date)")]
    670     ["Sort by amount" ,(ledger-reconcile-change-sort-key-and-refresh "(amount)")]
    671     ["Sort by file order" ,(ledger-reconcile-change-sort-key-and-refresh "(0)")]
    672     "---"
    673     ["Toggle Entry" ledger-reconcile-toggle]
    674     ["Add Entry" ledger-reconcile-add]
    675     ["Delete Entry" ledger-reconcile-delete]
    676     "---"
    677     ["Next Entry" next-line]
    678     ["Visit Source" ledger-reconcile-visit]
    679     ["Previous Entry" previous-line]
    680     "---"
    681     ["Quit" ledger-reconcile-quit]
    682     ))
    683 
    684 (define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
    685   "A mode for reconciling ledger entries.")
    686 
    687 (define-minor-mode ledger-reconcile-display-balance-in-header-mode
    688   "When enabled, display the cleared-or-pending balance in the header."
    689   :group 'ledger-reconcile
    690   (if ledger-reconcile-display-balance-in-header-mode
    691       (setq header-line-format '(ledger-reconcile-last-balance-equals-target
    692                                  (:propertize
    693                                   ledger-reconcile-last-balance-message
    694                                   face ledger-reconcile-last-balance-equals-target-face)
    695                                  ledger-reconcile-last-balance-message))
    696     (setq header-line-format nil)))
    697 
    698 (provide 'ledger-reconcile)
    699 
    700 ;;; ledger-reconcile.el ends here