ledger-reconcile.el (29280B)
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 136 It can also be any value accepted by ledger's --sort option." 137 :type '(choice 138 (const :tag "Date" "(date)") 139 (const :tag "Amount" "(amount)") 140 (const :tag "Payee" "(payee)") 141 (const :tag "No sorting (Ledger file order)" "(0)") 142 (string :tag "Custom --sort expression")) 143 :group 'ledger-reconcile) 144 145 (defcustom ledger-reconcile-insert-effective-date nil 146 "If t, prompt for effective date when clearing transactions. 147 148 If this is a function, it is called with no arguments with point 149 at the posting to be cleared. The return value is then used as 150 described above." 151 :type '(choice boolean function) 152 :group 'ledger-reconcile) 153 154 (defcustom ledger-reconcile-finish-force-quit nil 155 "If t, will force closing reconcile window after \\[ledger-reconcile-finish]." 156 :type 'boolean 157 :group 'ledger-reconcile) 158 159 (defvar-local ledger-reconcile-last-balance-message nil) 160 (defvar-local ledger-reconcile-last-balance-equals-target nil) 161 162 (defface ledger-reconcile-last-balance-equals-target-face 163 '((t :inherit header-line :foreground "green3")) 164 "Face used for header line when cleared-or-pending balance equals the target." 165 :group 'ledger-reconcile) 166 167 ;; s-functions below are copied from Magnars' s.el 168 ;; prefix ledger-reconcile- is added to not conflict with s.el 169 (defun ledger-reconcile-s-pad-left (len padding s) 170 "If S is shorter than LEN, pad it with PADDING on the left." 171 (let ((extra (max 0 (- len (length s))))) 172 (concat (make-string extra (string-to-char padding)) 173 s))) 174 (defun ledger-reconcile-s-pad-right (len padding s) 175 "If S is shorter than LEN, pad it with PADDING on the right." 176 (let ((extra (max 0 (- len (length s))))) 177 (concat s 178 (make-string extra (string-to-char padding))))) 179 (defun ledger-reconcile-s-left (len s) 180 "Return up to the LEN first chars of S." 181 (if (> (length s) len) 182 (substring s 0 len) 183 s)) 184 (defun ledger-reconcile-s-right (len s) 185 "Return up to the LEN last chars of S." 186 (let ((l (length s))) 187 (if (> l len) 188 (substring s (- l len) l) 189 s))) 190 191 (defun ledger-reconcile-truncate-right (str len) 192 "Truncate STR right side with max LEN characters, and pad with '…' if truncated." 193 (if (and (>= len 0) (> (length str) len)) 194 (ledger-reconcile-s-pad-right len "…" (ledger-reconcile-s-left (- len 1) str)) 195 str)) 196 197 (defun ledger-reconcile-truncate-left (str len) 198 "Truncate STR left side with max LEN characters, and pad with '…' if truncated." 199 (if (and (>= len 0) (> (length str) len)) 200 (ledger-reconcile-s-pad-left len "…" (ledger-reconcile-s-right (- len 1) str)) 201 str)) 202 203 (defun ledger-reconcile-get-cleared-or-pending-balance (buffer account) 204 "Use BUFFER to Calculate the cleared or pending balance of the ACCOUNT." 205 206 ;; these vars are buffer local, need to hold them for use in the 207 ;; temp buffer below 208 209 (with-temp-buffer 210 ;; note that in the line below, the --format option is 211 ;; separated from the actual format string. emacs does not 212 ;; split arguments like the shell does, so you need to 213 ;; specify the individual fields in the command line. 214 (ledger-exec-ledger buffer (current-buffer) 215 "balance" "--real" "--limit" "cleared or pending" "--empty" "--collapse" 216 "--format" "%(scrub(display_total))" account) 217 (ledger-split-commodity-string 218 (buffer-substring-no-properties (point-min) (point-max))))) 219 220 (defun ledger-display-balance () 221 "Display the cleared-or-pending balance. 222 And calculate the target-delta of the account being reconciled." 223 (interactive) 224 (when-let (pending (ledger-reconcile-get-cleared-or-pending-balance ledger-reconcile-ledger-buf ledger-reconcile-account)) 225 (let ((message 226 (if-let (diff (and ledger-reconcile-target (ledger-subtract-commodity ledger-reconcile-target pending))) 227 (progn 228 (setq ledger-reconcile-last-balance-equals-target (zerop (car diff))) 229 (format-message "Cleared and Pending balance: %s, Difference from target: %s" 230 (ledger-commodity-to-string pending) 231 (ledger-commodity-to-string diff))) 232 (format-message "Pending balance: %s" 233 (ledger-commodity-to-string pending))))) 234 (setq ledger-reconcile-last-balance-message message) 235 (message "%s" message)))) 236 237 (defun ledger-is-stdin (file) 238 "True if ledger FILE is standard input." 239 (or 240 (equal file "") 241 (equal file "<stdin>") 242 (equal file "/dev/stdin"))) 243 244 (defun ledger-reconcile-get-buffer (where) 245 "Return a buffer from WHERE the transaction is." 246 (if (bufferp (car where)) 247 (car where) 248 (error "Function ledger-reconcile-get-buffer: Buffer not set"))) 249 250 (defun ledger-reconcile-insert-effective-date () 251 "Prompt for an effective date and insert it at point, if enabled. 252 253 If the value of variable `ledger-reconcile-insert-effective-date' 254 is a function, it is called with the point where the effective 255 date would be inserted. If it returns non-nil, prompt for an 256 effective date and insert it at point. If it is not a function, 257 do the same if its value is non-nil." 258 (when (if (functionp ledger-reconcile-insert-effective-date) 259 (save-excursion (funcall ledger-reconcile-insert-effective-date)) 260 ledger-reconcile-insert-effective-date) 261 (ledger-insert-effective-date))) 262 263 (defun ledger-reconcile-toggle () 264 "Toggle the current transaction, and mark the reconcile window." 265 (interactive) 266 (beginning-of-line) 267 (let ((where (get-text-property (point) 'where)) 268 (inhibit-read-only t) 269 status) 270 (when (ledger-reconcile-get-buffer where) 271 (with-current-buffer (ledger-reconcile-get-buffer where) 272 (ledger-navigate-to-line (cdr where)) 273 (forward-char) 274 (setq status (ledger-toggle-current (if ledger-reconcile-toggle-to-pending 275 'pending 276 'cleared))) 277 ;; Ask for effective date & insert it, if enabled 278 (ledger-reconcile-insert-effective-date)) 279 ;; remove the existing face and add the new face 280 (remove-text-properties (line-beginning-position) 281 (line-end-position) 282 (list 'font-lock-face)) 283 (cond ((eq status 'pending) 284 (add-text-properties (line-beginning-position) 285 (line-end-position) 286 (list 'font-lock-face 'ledger-font-reconciler-pending-face ))) 287 ((eq status 'cleared) 288 (add-text-properties (line-beginning-position) 289 (line-end-position) 290 (list 'font-lock-face 'ledger-font-reconciler-cleared-face ))) 291 (t 292 (add-text-properties (line-beginning-position) 293 (line-end-position) 294 (list 'font-lock-face 'ledger-font-reconciler-uncleared-face ))))) 295 (forward-line) 296 (beginning-of-line) 297 (ledger-display-balance))) 298 299 (defun ledger-reconcile-refresh () 300 "Force the reconciliation window to refresh. 301 Return the number of uncleared xacts found." 302 (interactive) 303 (let ((inhibit-read-only t) 304 (line (count-lines (point-min) (point)))) 305 (erase-buffer) 306 (prog1 307 (ledger-do-reconcile ledger-reconcile-sort-key) 308 (set-buffer-modified-p t) 309 (ledger-reconcile-ensure-xacts-visible) 310 (ledger-display-balance) 311 (goto-char (point-min)) 312 (forward-line line)))) 313 314 (defun ledger-reconcile-refresh-after-save () 315 "Refresh the reconcile window after the ledger buffer is saved." 316 (let ((curbufwin (get-buffer-window (current-buffer))) 317 (curpoint (point)) 318 (reconcile-buf (get-buffer ledger-reconcile-buffer-name))) 319 (when (buffer-live-p reconcile-buf) 320 (with-current-buffer reconcile-buf 321 (ledger-reconcile-refresh) 322 (set-buffer-modified-p nil)) 323 (when curbufwin 324 (select-window curbufwin) 325 (goto-char curpoint) 326 (recenter) 327 (ledger-highlight-xact-under-point))))) 328 329 (defun ledger-reconcile-add (date xact) 330 "Use ledger xact to add a new transaction. 331 332 When called interactively, prompt for DATE, then XACT." 333 (interactive 334 (list (ledger-read-date "Date: ") 335 (read-string "Transaction: " nil 'ledger-minibuffer-history))) 336 (with-current-buffer ledger-reconcile-ledger-buf 337 (ledger-add-transaction (concat date " " xact))) 338 (ledger-reconcile-refresh)) 339 340 (defun ledger-reconcile-delete () 341 "Delete the transactions pointed to in the reconcile window." 342 (interactive) 343 (let ((where (get-text-property (point) 'where))) 344 (when (ledger-reconcile-get-buffer where) 345 (with-current-buffer (ledger-reconcile-get-buffer where) 346 (ledger-navigate-to-line (cdr where)) 347 (ledger-delete-current-transaction (point))) 348 (let ((inhibit-read-only t)) 349 (delete-region (line-beginning-position) 350 (min (1+ (line-end-position)) (point-max))) 351 (set-buffer-modified-p t)) 352 (ledger-reconcile-refresh) 353 (ledger-reconcile-visit t)))) 354 355 (defun ledger-reconcile-visit (&optional come-back) 356 "Recenter ledger buffer on transaction and COME-BACK if non-nil." 357 (interactive) 358 (beginning-of-line) 359 (let* ((where (get-text-property (1+ (point)) 'where)) 360 (target-buffer (if where 361 (ledger-reconcile-get-buffer where) 362 nil)) 363 (cur-win (get-buffer-window (get-buffer ledger-reconcile-buffer-name)))) 364 (when target-buffer 365 (switch-to-buffer-other-window target-buffer) 366 (ledger-navigate-to-line (cdr where)) 367 (forward-char) 368 (recenter) 369 (ledger-highlight-xact-under-point) 370 (forward-char -1) 371 (when (and come-back cur-win) 372 (select-window cur-win) 373 (get-buffer ledger-reconcile-buffer-name))))) 374 375 376 (defun ledger-reconcile-save () 377 "Save the ledger buffer." 378 (interactive) 379 (with-selected-window (selected-window) ; restoring window is needed because after-save-hook will modify window and buffers 380 (with-current-buffer ledger-reconcile-ledger-buf 381 (basic-save-buffer)))) 382 383 384 (defun ledger-reconcile-finish () 385 "Mark all pending posting or transactions as cleared. 386 Depends on ledger-clear-whole-transactions, save the buffers and 387 exit reconcile mode if `ledger-reconcile-finish-force-quit'" 388 (interactive) 389 (save-excursion 390 (goto-char (point-min)) 391 (while (not (eobp)) 392 (let ((where (get-text-property (point) 'where)) 393 (face (get-text-property (point) 'font-lock-face))) 394 (if (eq face 'ledger-font-reconciler-pending-face) 395 (with-current-buffer (ledger-reconcile-get-buffer where) 396 (ledger-navigate-to-line (cdr where)) 397 (ledger-toggle-current 'cleared)))) 398 (forward-line 1))) 399 (ledger-reconcile-save) 400 (when ledger-reconcile-finish-force-quit 401 (ledger-reconcile-quit))) 402 403 404 (defun ledger-reconcile-quit () 405 "Quit the reconcile window without saving ledger buffer." 406 (interactive) 407 (let ((reconcile-buf (get-buffer ledger-reconcile-buffer-name)) 408 buf) 409 (if reconcile-buf 410 (with-current-buffer reconcile-buf 411 (ledger-reconcile-quit-cleanup) 412 (setq buf ledger-reconcile-ledger-buf) 413 ;; Make sure you delete the window before you delete the buffer, 414 ;; otherwise, madness ensues 415 (delete-window (get-buffer-window reconcile-buf)) 416 (kill-buffer reconcile-buf) 417 (set-window-buffer (selected-window) buf))))) 418 419 (defun ledger-reconcile-quit-cleanup () 420 "Cleanup all hooks established by reconcile mode." 421 (interactive) 422 (let ((buf ledger-reconcile-ledger-buf)) 423 (if (buffer-live-p buf) 424 (with-current-buffer buf 425 (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t) 426 (when ledger-narrow-on-reconcile 427 (ledger-occur-mode -1) 428 (ledger-highlight-xact-under-point)))))) 429 430 (defun ledger-marker-where-xact-is (emacs-xact posting) 431 "Find the position of the EMACS-XACT in the `ledger-reconcile-ledger-buf'. 432 POSTING is used in `ledger-clear-whole-transactions' is nil." 433 (let ((buf (if (ledger-is-stdin (nth 0 emacs-xact)) 434 ledger-reconcile-ledger-buf 435 (find-file-noselect (nth 0 emacs-xact))))) 436 (cons 437 buf 438 (if (or ledger-clear-whole-transactions 439 ;; The posting might not be part of the ledger buffer. This can 440 ;; happen if the account to reconcile is the default account. In 441 ;; that case, we just behave as if ledger-clear-whole-transactions 442 ;; was turned on. See #58 for more info. 443 (= -1 (nth 0 posting))) 444 (nth 1 emacs-xact) ;; return line-no of xact 445 (nth 0 posting))))) ;; return line-no of posting 446 447 (defun ledger-reconcile-compile-format-string (fstr) 448 "Return a function that implements the format string in FSTR." 449 (let (fields 450 (start 0)) 451 (while (string-match "(\\(.*?\\))" fstr start) 452 (setq fields (cons (intern (match-string 1 fstr)) fields)) 453 (setq start (match-end 0))) 454 (setq fields (cl-list* 'format (replace-regexp-in-string "(.*?)" "" fstr) (nreverse fields))) 455 `(lambda (date code status payee account amount) 456 ,fields))) 457 458 459 460 (defun ledger-reconcile-format-posting (beg where fmt date code status payee account amount) 461 "Format posting for the reconcile buffer." 462 (insert (funcall fmt date code status payee account amount)) 463 464 ; Set face depending on cleared status 465 (if status 466 (if (eq status 'pending) 467 (set-text-properties beg (1- (point)) 468 (list 'font-lock-face 'ledger-font-reconciler-pending-face 469 'where where)) 470 (set-text-properties beg (1- (point)) 471 (list 'font-lock-face 'ledger-font-reconciler-cleared-face 472 'where where))) 473 (set-text-properties beg (1- (point)) 474 (list 'font-lock-face 'ledger-font-reconciler-uncleared-face 475 'where where)))) 476 477 (defun ledger-reconcile-format-xact (xact fmt) 478 "Format XACT using FMT." 479 (dolist (posting (nthcdr 5 xact)) 480 (let ((beg (point)) 481 (where (ledger-marker-where-xact-is xact posting))) 482 (ledger-reconcile-format-posting beg 483 where 484 fmt 485 (ledger-format-date 486 (nth 2 xact) 487 ledger-reconcile-default-date-format) ; date 488 (if (nth 3 xact) (nth 3 xact) "") ; code 489 (nth 3 posting) ; status 490 (ledger-reconcile-truncate-right 491 (nth 4 xact) ; payee 492 ledger-reconcile-buffer-payee-max-chars) 493 (ledger-reconcile-truncate-left 494 (nth 1 posting) ; account 495 ledger-reconcile-buffer-account-max-chars) 496 (nth 2 posting))))) ; amount 497 498 (defun ledger-do-reconcile (&optional sort) 499 "SORT the uncleared transactions in the account. 500 The sorted results are displayed in in the *Reconcile* buffer. 501 Return a count of the uncleared transactions." 502 (let* ((buf ledger-reconcile-ledger-buf) 503 (account ledger-reconcile-account) 504 (sort-by (if sort 505 sort 506 "(date)")) 507 (xacts 508 (with-temp-buffer 509 (ledger-exec-ledger buf (current-buffer) 510 "--uncleared" "--real" "emacs" "--sort" sort-by account) 511 (goto-char (point-min)) 512 (when (and (not (eobp)) (looking-at "(")) 513 (read (current-buffer))))) 514 (fmt (ledger-reconcile-compile-format-string ledger-reconcile-buffer-line-format))) 515 (if (null xacts) 516 (insert (concat "There are no uncleared entries for " account)) 517 (if ledger-reconcile-buffer-header 518 (insert (format ledger-reconcile-buffer-header account))) 519 (dolist (xact xacts) 520 (ledger-reconcile-format-xact xact fmt)) 521 (goto-char (point-max)) 522 (delete-char -1)) ;gets rid of the extra line feed at the bottom of the list 523 (goto-char (point-min)) 524 (set-buffer-modified-p nil) 525 (setq buffer-read-only t) 526 527 (length xacts))) 528 529 (defun ledger-reconcile-ensure-xacts-visible () 530 "Ensure the last of the visible transactions in the ledger buffer is visible. 531 This is achieved by placing that transaction at the bottom of the main window. 532 The key to this is to ensure the window is selected when the buffer point is 533 moved and recentered. If they aren't strange things happen." 534 (let ((reconcile-window (get-buffer-window (get-buffer ledger-reconcile-buffer-name)))) 535 (when reconcile-window 536 (fit-window-to-buffer reconcile-window) 537 (with-current-buffer ledger-reconcile-ledger-buf 538 (add-hook 'kill-buffer-hook 'ledger-reconcile-quit nil t) 539 (if (get-buffer-window ledger-reconcile-ledger-buf) 540 (select-window (get-buffer-window ledger-reconcile-ledger-buf))) 541 (recenter)) 542 (select-window reconcile-window) 543 (ledger-reconcile-visit t)) 544 (with-current-buffer ledger-reconcile-ledger-buf 545 (when ledger-occur-mode 546 (ledger-occur-refresh))) 547 (add-hook 'post-command-hook 'ledger-reconcile-track-xact nil t))) 548 549 (defun ledger-reconcile-track-xact () 550 "Recenter the ledger buffer on the transaction at point in the reconcile buffer." 551 (if (and ledger-buffer-tracks-reconcile-buffer 552 (member this-command (list 'next-line 553 'previous-line 554 'mouse-set-point 555 'ledger-reconcile-toggle 556 'end-of-buffer 557 'beginning-of-buffer))) 558 (save-excursion 559 (ledger-reconcile-visit t)))) 560 561 (defun ledger-reconcile-open-windows (buf rbuf) 562 "Ensure that the ledger buffer BUF is split by RBUF." 563 (if ledger-reconcile-force-window-bottom 564 ;;create the *Reconcile* window directly below the ledger buffer. 565 (set-window-buffer (split-window (get-buffer-window buf) nil nil) rbuf) 566 (pop-to-buffer rbuf))) 567 568 (defun ledger-reconcile-check-valid-account (account) 569 "Check to see if ACCOUNT exists in the ledger file." 570 (if (> (length account) 0) 571 (save-excursion 572 (goto-char (point-min)) 573 (search-forward account nil t)))) 574 575 (defun ledger-reconcile (&optional account target) 576 "Start reconciling, prompt for ACCOUNT. 577 578 If TARGET is non-nil, it is used as the initial target for 579 reconciliation, otherwise prompt for TARGET." 580 (interactive) 581 (let ((account (or account (ledger-read-account-with-prompt "Account to reconcile"))) 582 (buf (current-buffer)) 583 (rbuf (get-buffer ledger-reconcile-buffer-name))) 584 585 (when (ledger-reconcile-check-valid-account account) 586 (if rbuf ;; *Reconcile* already exists 587 (with-current-buffer rbuf 588 (setq ledger-reconcile-account account) 589 (when (not (eq buf rbuf)) 590 ;; called from some other ledger-mode buffer 591 (ledger-reconcile-quit-cleanup) 592 (setq ledger-reconcile-ledger-buf buf)) 593 594 (unless (get-buffer-window rbuf) 595 (ledger-reconcile-open-windows buf rbuf))) 596 597 ;; no reconcile-buffer, starting from scratch. 598 599 (with-current-buffer (setq rbuf 600 (get-buffer-create ledger-reconcile-buffer-name)) 601 (ledger-reconcile-open-windows buf rbuf) 602 (ledger-reconcile-mode) 603 (setq ledger-reconcile-ledger-buf buf) 604 (setq ledger-reconcile-account account))) 605 606 (add-hook 'after-save-hook 'ledger-reconcile-refresh-after-save nil t) 607 608 ;; Narrow the ledger buffer 609 (if ledger-narrow-on-reconcile 610 (ledger-occur (regexp-quote account))) 611 612 (setq ledger-reconcile-last-balance-message nil) 613 (setq ledger-reconcile-last-balance-equals-target nil) 614 615 (with-current-buffer rbuf 616 (if (> (ledger-reconcile-refresh) 0) 617 (ledger-reconcile-change-target target) 618 (ledger-display-balance)))))) 619 620 (defvar ledger-reconcile-mode-abbrev-table) 621 622 (defun ledger-reconcile-change-target (&optional target) 623 "Change the TARGET amount for the reconciliation process." 624 (interactive) 625 (setq ledger-reconcile-target (or target (ledger-read-commodity-string ledger-reconcile-target-prompt-string))) 626 (ledger-display-balance)) 627 628 (defmacro ledger-reconcile-change-sort-key-and-refresh (sort-by) 629 "Set the sort-key to SORT-BY." 630 `(lambda () 631 (interactive) 632 633 (setq ledger-reconcile-sort-key ,sort-by) 634 (ledger-reconcile-refresh))) 635 636 (defvar ledger-reconcile-mode-map 637 (let ((map (make-sparse-keymap))) 638 (define-key map (kbd "C-m") #'ledger-reconcile-visit) 639 (define-key map (kbd "<return>") #'ledger-reconcile-visit) 640 (define-key map (kbd "C-x C-s") #'ledger-reconcile-save) 641 (define-key map (kbd "C-l") #'ledger-reconcile-refresh) 642 (define-key map (kbd "C-c C-c") #'ledger-reconcile-finish) 643 (define-key map (kbd "SPC") #'ledger-reconcile-toggle) 644 (define-key map (kbd "a") #'ledger-reconcile-add) 645 (define-key map (kbd "d") #'ledger-reconcile-delete) 646 (define-key map (kbd "g") #'ledger-reconcile); 647 (define-key map (kbd "n") #'next-line) 648 (define-key map (kbd "p") #'previous-line) 649 (define-key map (kbd "t") #'ledger-reconcile-change-target) 650 (define-key map (kbd "s") #'ledger-reconcile-save) 651 (define-key map (kbd "q") #'ledger-reconcile-quit) 652 (define-key map (kbd "b") #'ledger-display-balance) 653 (define-key map (kbd "B") #'ledger-reconcile-display-balance-in-header-mode) 654 655 (define-key map (kbd "C-c C-o") (ledger-reconcile-change-sort-key-and-refresh "(0)")) 656 657 (define-key map (kbd "C-c C-a") (ledger-reconcile-change-sort-key-and-refresh "(amount)")) 658 659 (define-key map (kbd "C-c C-d") (ledger-reconcile-change-sort-key-and-refresh "(date)")) 660 661 (define-key map (kbd "C-c C-p") (ledger-reconcile-change-sort-key-and-refresh "(payee)")) 662 map) 663 "Keymap for `ledger-reconcile-mode'.") 664 665 (easy-menu-define ledger-reconcile-mode-menu ledger-reconcile-mode-map 666 "Ledger reconcile menu" 667 `("Reconcile" 668 ["Save" ledger-reconcile-save] 669 ["Refresh" ledger-reconcile-refresh] 670 ["Finish" ledger-reconcile-finish] 671 "---" 672 ["Reconcile New Account" ledger-reconcile] 673 "---" 674 ["Change Target Balance" ledger-reconcile-change-target] 675 ["Show Cleared Balance" ledger-display-balance] 676 "---" 677 ["Sort by payee" ,(ledger-reconcile-change-sort-key-and-refresh "(payee)")] 678 ["Sort by date" ,(ledger-reconcile-change-sort-key-and-refresh "(date)")] 679 ["Sort by amount" ,(ledger-reconcile-change-sort-key-and-refresh "(amount)")] 680 ["Sort by file order" ,(ledger-reconcile-change-sort-key-and-refresh "(0)")] 681 "---" 682 ["Toggle Entry" ledger-reconcile-toggle] 683 ["Add Entry" ledger-reconcile-add] 684 ["Delete Entry" ledger-reconcile-delete] 685 "---" 686 ["Next Entry" next-line] 687 ["Visit Source" ledger-reconcile-visit] 688 ["Previous Entry" previous-line] 689 "---" 690 ["Quit" ledger-reconcile-quit] 691 )) 692 693 (define-derived-mode ledger-reconcile-mode text-mode "Reconcile" 694 "A mode for reconciling ledger entries.") 695 696 (define-minor-mode ledger-reconcile-display-balance-in-header-mode 697 "When enabled, display the cleared-or-pending balance in the header." 698 :group 'ledger-reconcile 699 (if ledger-reconcile-display-balance-in-header-mode 700 (setq header-line-format '(ledger-reconcile-last-balance-equals-target 701 (:propertize 702 ledger-reconcile-last-balance-message 703 face ledger-reconcile-last-balance-equals-target-face) 704 ledger-reconcile-last-balance-message)) 705 (setq header-line-format nil))) 706 707 (provide 'ledger-reconcile) 708 709 ;;; ledger-reconcile.el ends here