ledger-reconcile.el (28980B)
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 479 (nth 2 xact) 480 ledger-reconcile-default-date-format) ; date 481 (if (nth 3 xact) (nth 3 xact) "") ; code 482 (nth 3 posting) ; status 483 (ledger-reconcile-truncate-right 484 (nth 4 xact) ; payee 485 ledger-reconcile-buffer-payee-max-chars) 486 (ledger-reconcile-truncate-left 487 (nth 1 posting) ; account 488 ledger-reconcile-buffer-account-max-chars) 489 (nth 2 posting))))) ; amount 490 491 (defun ledger-do-reconcile (&optional sort) 492 "SORT the uncleared transactions in the account. 493 The sorted results are displayed in in the *Reconcile* buffer. 494 Return a count of the uncleared transactions." 495 (let* ((buf ledger-reconcile-ledger-buf) 496 (account ledger-reconcile-account) 497 (sort-by (if sort 498 sort 499 "(date)")) 500 (xacts 501 (with-temp-buffer 502 (ledger-exec-ledger buf (current-buffer) 503 "--uncleared" "--real" "emacs" "--sort" sort-by account) 504 (goto-char (point-min)) 505 (when (and (not (eobp)) (looking-at "(")) 506 (read (current-buffer))))) 507 (fmt (ledger-reconcile-compile-format-string ledger-reconcile-buffer-line-format))) 508 (if (null xacts) 509 (insert (concat "There are no uncleared entries for " account)) 510 (if ledger-reconcile-buffer-header 511 (insert (format ledger-reconcile-buffer-header account))) 512 (dolist (xact xacts) 513 (ledger-reconcile-format-xact xact fmt)) 514 (goto-char (point-max)) 515 (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list 516 (goto-char (point-min)) 517 (set-buffer-modified-p nil) 518 (setq buffer-read-only t) 519 520 (length xacts))) 521 522 (defun ledger-reconcile-ensure-xacts-visible () 523 "Ensure the last of the visible transactions in the ledger buffer is visible. 524 This is achieved by placing that transaction at the bottom of the main window. 525 The key to this is to ensure the window is selected when the buffer point is 526 moved and recentered. If they aren't strange things happen." 527 (let ((reconcile-window (get-buffer-window (get-buffer ledger-reconcile-buffer-name)))) 528 (when reconcile-window 529 (fit-window-to-buffer reconcile-window) 530 (with-current-buffer ledger-reconcile-ledger-buf 531 (add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t) 532 (if (get-buffer-window ledger-reconcile-ledger-buf) 533 (select-window (get-buffer-window ledger-reconcile-ledger-buf))) 534 (recenter)) 535 (select-window reconcile-window) 536 (ledger-reconcile-visit t)) 537 (with-current-buffer ledger-reconcile-ledger-buf 538 (when ledger-occur-mode 539 (ledger-occur-refresh))) 540 (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t))) 541 542 (defun ledger-reconcile-track-xact () 543 "Recenter the ledger buffer on the transaction at point in the reconcile buffer." 544 (if (and ledger-buffer-tracks-reconcile-buffer 545 (member this-command (list 'next-line 546 'previous-line 547 'mouse-set-point 548 'ledger-reconcile-toggle 549 'end-of-buffer 550 'beginning-of-buffer))) 551 (save-excursion 552 (ledger-reconcile-visit t)))) 553 554 (defun ledger-reconcile-open-windows (buf rbuf) 555 "Ensure that the ledger buffer BUF is split by RBUF." 556 (if ledger-reconcile-force-window-bottom 557 ;;create the *Reconcile* window directly below the ledger buffer. 558 (set-window-buffer (split-window (get-buffer-window buf) nil nil) rbuf) 559 (pop-to-buffer rbuf))) 560 561 (defun ledger-reconcile-check-valid-account (account) 562 "Check to see if ACCOUNT exists in the ledger file." 563 (if (> (length account) 0) 564 (save-excursion 565 (goto-char (point-min)) 566 (search-forward account nil t)))) 567 568 (defun ledger-reconcile (&optional account target) 569 "Start reconciling, prompt for ACCOUNT. 570 571 If TARGET is non-nil, it is used as the initial target for 572 reconciliation, otherwise prompt for TARGET." 573 (interactive) 574 (let ((account (or account (ledger-read-account-with-prompt "Account to reconcile"))) 575 (buf (current-buffer)) 576 (rbuf (get-buffer ledger-reconcile-buffer-name))) 577 578 (when (ledger-reconcile-check-valid-account account) 579 (if rbuf ;; *Reconcile* already exists 580 (with-current-buffer rbuf 581 (setq ledger-reconcile-account account) 582 (when (not (eq buf rbuf)) 583 ;; called from some other ledger-mode buffer 584 (ledger-reconcile-quit-cleanup) 585 (setq ledger-reconcile-ledger-buf buf)) 586 587 (unless (get-buffer-window rbuf) 588 (ledger-reconcile-open-windows buf rbuf))) 589 590 ;; no reconcile-buffer, starting from scratch. 591 592 (with-current-buffer (setq rbuf 593 (get-buffer-create ledger-reconcile-buffer-name)) 594 (ledger-reconcile-open-windows buf rbuf) 595 (ledger-reconcile-mode) 596 (setq ledger-reconcile-ledger-buf buf) 597 (setq ledger-reconcile-account account))) 598 599 (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) 600 601 ;; Narrow the ledger buffer 602 (if ledger-narrow-on-reconcile 603 (ledger-occur (regexp-quote account))) 604 605 (setq ledger-reconcile-last-balance-message nil) 606 (setq ledger-reconcile-last-balance-equals-target nil) 607 608 (with-current-buffer rbuf 609 (if (> (ledger-reconcile-refresh) 0) 610 (ledger-reconcile-change-target target) 611 (ledger-display-balance)))))) 612 613 (defvar ledger-reconcile-mode-abbrev-table) 614 615 (defun ledger-reconcile-change-target (&optional target) 616 "Change the TARGET amount for the reconciliation process." 617 (interactive) 618 (setq ledger-reconcile-target (or target (ledger-read-commodity-string ledger-reconcile-target-prompt-string))) 619 (ledger-display-balance)) 620 621 (defmacro ledger-reconcile-change-sort-key-and-refresh (sort-by) 622 "Set the sort-key to SORT-BY." 623 `(lambda () 624 (interactive) 625 626 (setq ledger-reconcile-sort-key ,sort-by) 627 (ledger-reconcile-refresh))) 628 629 (defvar ledger-reconcile-mode-map 630 (let ((map (make-sparse-keymap))) 631 (define-key map (kbd "C-m") #'ledger-reconcile-visit) 632 (define-key map (kbd "<return>") #'ledger-reconcile-visit) 633 (define-key map (kbd "C-x C-s") #'ledger-reconcile-save) 634 (define-key map (kbd "C-l") #'ledger-reconcile-refresh) 635 (define-key map (kbd "C-c C-c") #'ledger-reconcile-finish) 636 (define-key map (kbd "SPC") #'ledger-reconcile-toggle) 637 (define-key map (kbd "a") #'ledger-reconcile-add) 638 (define-key map (kbd "d") #'ledger-reconcile-delete) 639 (define-key map (kbd "g") #'ledger-reconcile); 640 (define-key map (kbd "n") #'next-line) 641 (define-key map (kbd "p") #'previous-line) 642 (define-key map (kbd "t") #'ledger-reconcile-change-target) 643 (define-key map (kbd "s") #'ledger-reconcile-save) 644 (define-key map (kbd "q") #'ledger-reconcile-quit) 645 (define-key map (kbd "b") #'ledger-display-balance) 646 (define-key map (kbd "B") #'ledger-reconcile-display-balance-in-header-mode) 647 648 (define-key map (kbd "C-c C-o") (ledger-reconcile-change-sort-key-and-refresh "(0)")) 649 650 (define-key map (kbd "C-c C-a") (ledger-reconcile-change-sort-key-and-refresh "(amount)")) 651 652 (define-key map (kbd "C-c C-d") (ledger-reconcile-change-sort-key-and-refresh "(date)")) 653 654 (define-key map (kbd "C-c C-p") (ledger-reconcile-change-sort-key-and-refresh "(payee)")) 655 map) 656 "Keymap for `ledger-reconcile-mode'.") 657 658 (easy-menu-define ledger-reconcile-mode-menu ledger-reconcile-mode-map 659 "Ledger reconcile menu" 660 `("Reconcile" 661 ["Save" ledger-reconcile-save] 662 ["Refresh" ledger-reconcile-refresh] 663 ["Finish" ledger-reconcile-finish] 664 "---" 665 ["Reconcile New Account" ledger-reconcile] 666 "---" 667 ["Change Target Balance" ledger-reconcile-change-target] 668 ["Show Cleared Balance" ledger-display-balance] 669 "---" 670 ["Sort by payee" ,(ledger-reconcile-change-sort-key-and-refresh "(payee)")] 671 ["Sort by date" ,(ledger-reconcile-change-sort-key-and-refresh "(date)")] 672 ["Sort by amount" ,(ledger-reconcile-change-sort-key-and-refresh "(amount)")] 673 ["Sort by file order" ,(ledger-reconcile-change-sort-key-and-refresh "(0)")] 674 "---" 675 ["Toggle Entry" ledger-reconcile-toggle] 676 ["Add Entry" ledger-reconcile-add] 677 ["Delete Entry" ledger-reconcile-delete] 678 "---" 679 ["Next Entry" next-line] 680 ["Visit Source" ledger-reconcile-visit] 681 ["Previous Entry" previous-line] 682 "---" 683 ["Quit" ledger-reconcile-quit] 684 )) 685 686 (define-derived-mode ledger-reconcile-mode text-mode "Reconcile" 687 "A mode for reconciling ledger entries.") 688 689 (define-minor-mode ledger-reconcile-display-balance-in-header-mode 690 "When enabled, display the cleared-or-pending balance in the header." 691 :group 'ledger-reconcile 692 (if ledger-reconcile-display-balance-in-header-mode 693 (setq header-line-format '(ledger-reconcile-last-balance-equals-target 694 (:propertize 695 ledger-reconcile-last-balance-message 696 face ledger-reconcile-last-balance-equals-target-face) 697 ledger-reconcile-last-balance-message)) 698 (setq header-line-format nil))) 699 700 (provide 'ledger-reconcile) 701 702 ;;; ledger-reconcile.el ends here