ledger-post.el (10379B)
1 ;;; ledger-post.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 23 ;;; Commentary: 24 ;; Utility functions for dealing with postings. 25 26 (require 'ledger-regex) 27 (require 'ledger-navigate) 28 29 (declare-function calc-renumber-stack "calc" ()) 30 (declare-function ledger-add-commodity "ledger-commodities" (c1 c2)) 31 (declare-function ledger-commodity-to-string "ledger-commodities" (c1)) 32 (declare-function ledger-negate-commodity "ledger-commodities" (c)) 33 (declare-function ledger-split-commodity-string "ledger-commodities" (str)) 34 (declare-function ledger-string-to-number "ledger-commodities" (str &optional decimal-comma)) 35 36 ;;; Code: 37 38 (defgroup ledger-post nil 39 "Options for controlling how Ledger-mode deals with postings and completion" 40 :group 'ledger) 41 42 (defcustom ledger-post-account-alignment-column 4 43 "The column Ledger-mode attempts to align accounts to." 44 :type 'integer 45 :group 'ledger-post 46 :safe 'integerp) 47 48 (defcustom ledger-post-amount-alignment-column 52 49 "The column Ledger-mode attempts to align amounts to." 50 :type 'integer 51 :group 'ledger-post 52 :safe 'integerp) 53 54 (defcustom ledger-post-amount-alignment-at :end 55 "Position at which the amount is aligned. 56 57 Can be :end to align on the last number of the amount (can be 58 followed by unaligned commodity) or :decimal to align at the 59 decimal separator." 60 :type '(radio (const :tag "align at the end of amount" :end) 61 (const :tag "align at the decimal separator" :decimal)) 62 :group 'ledger-post 63 :safe (lambda (x) (memq x '(:end :decimal)))) 64 65 (defcustom ledger-post-auto-align t 66 "When non-nil, realign post amounts when indenting or completing." 67 :type 'boolean 68 :group 'ledger-post 69 :package-version '(ledger-mode . "4.0.0") 70 :safe 'booleanp) 71 72 (defun ledger-next-amount (&optional end) 73 "Move point to the next amount, as long as it is not past END. 74 Return the width of the amount field as an integer and leave 75 point at beginning of the commodity." 76 ;;(beginning-of-line) 77 (let ((case-fold-search nil)) 78 (when (re-search-forward ledger-amount-regex end t) 79 (goto-char (match-beginning 0)) 80 (skip-syntax-forward " ") 81 (cond 82 ((eq ledger-post-amount-alignment-at :end) 83 (- (or (match-end 4) (match-end 3)) (point))) 84 ((eq ledger-post-amount-alignment-at :decimal) 85 (- (match-end 3) (point))))))) 86 87 (defun ledger-next-account (&optional end) 88 "Move to the beginning of the posting, or status marker. 89 Return the column of the beginning of the account and leave point 90 at beginning of account. 91 Looks only as far as END, if supplied, otherwise `point-max'." 92 (let ((end (or end (point-max)))) 93 (if (> end (point)) 94 (when (re-search-forward ledger-account-any-status-regex (1+ end) t) 95 ;; the 1+ is to make sure we can catch the newline 96 (if (match-beginning 1) 97 (goto-char (match-beginning 1)) 98 (goto-char (match-beginning 2))) 99 (current-column))))) 100 101 (defun ledger-post-align-xact (pos) 102 "Align all the posting in the xact at POS." 103 (interactive "d") 104 (let ((bounds (ledger-navigate-find-xact-extents pos))) 105 (ledger-post-align-postings (car bounds) (cadr bounds)))) 106 107 (defun ledger-post-align-postings (beg end) 108 "Align all accounts and amounts between BEG and END. 109 The current region is used, or, if no region, the current line." 110 (interactive "r") 111 (save-match-data 112 (save-excursion 113 (let ((inhibit-modification-hooks t) 114 ;; Extend region to whole lines 115 (beg (save-excursion (goto-char beg) (line-beginning-position))) 116 (end (save-excursion (goto-char end) (move-end-of-line 1) (point-marker)))) 117 (untabify beg end) 118 (goto-char beg) 119 (while (< (point) end) 120 (when (looking-at-p " ") 121 ;; fix spaces at beginning of line: 122 (just-one-space ledger-post-account-alignment-column) 123 ;; fix spaces before amount if any: 124 (when (re-search-forward "\t\\| \\| \t" (line-end-position) t) 125 (goto-char (match-beginning 0)) 126 (let ((acct-end-column (current-column)) 127 (amt-width (ledger-next-amount (line-end-position))) 128 amt-adjust) 129 (when amt-width 130 (if (/= 0 (setq amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width) 131 (+ 2 acct-end-column)) 132 ledger-post-amount-alignment-column ;;we have room 133 (+ acct-end-column 2 amt-width)) 134 amt-width 135 (current-column)))) 136 (if (> amt-adjust 0) 137 (insert (make-string amt-adjust ? )) 138 (delete-char amt-adjust))))))) 139 (forward-line 1)))))) 140 141 (defun ledger-indent-line () 142 "Indent the current line." 143 ;; Ensure indent if the previous line was indented 144 (let ((indent-level (save-excursion (if (and (zerop (forward-line -1)) 145 (memq (ledger-thing-at-point) '(transaction posting))) 146 ledger-post-account-alignment-column 147 0)))) 148 (unless (= (current-indentation) indent-level) 149 (back-to-indentation) 150 (delete-horizontal-space t) 151 (indent-to indent-level))) 152 (when ledger-post-auto-align 153 (ledger-post-align-postings (line-beginning-position) (line-end-position)))) 154 155 (defun ledger-post-align-dwim () 156 "Align all the posting of the current xact or the current region. 157 158 If the point is in a comment, fill the comment paragraph as 159 regular text." 160 (interactive) 161 (cond 162 ((nth 4 (syntax-ppss)) 163 (call-interactively 'ledger-post-align-postings) 164 (fill-paragraph)) 165 ((use-region-p) (call-interactively 'ledger-post-align-postings)) 166 (t (call-interactively 'ledger-post-align-xact)))) 167 168 (defun ledger-post-edit-amount () 169 "Call `calc' and push the amount in the posting to the top of stack, if any. 170 171 In the calc buffer, press y to use the top value in the stack as 172 the amount and return to ledger." 173 (interactive) 174 (beginning-of-line) 175 (when (re-search-forward ledger-post-line-regexp (line-end-position) t) 176 (goto-char (match-end ledger-regex-post-line-group-account)) ;; go to the end of the account 177 ;; determine if there is an amount to edit 178 (if (re-search-forward ledger-amount-regexp (line-end-position) t) 179 (let ((val-string (match-string 0))) 180 (goto-char (match-beginning 0)) 181 (delete-region (match-beginning 0) (match-end 0)) 182 (push-mark (point) 'nomsg) 183 (calc) 184 ;; edit the amount, first removing thousands separators and converting 185 ;; decimal commas to calc's input format 186 (calc-eval (number-to-string (ledger-string-to-number val-string)) 'push) 187 (calc-renumber-stack)) 188 ;; make sure there are two spaces after the account name and go to calc 189 (if (search-backward " " (- (point) 3) t) 190 (end-of-line) 191 (insert " ")) 192 (push-mark (point) 'nomsg) 193 (calc)))) 194 195 (defun ledger-post-xact-total () 196 "Return (TOTAL . MISSING-POSITIONS) for the transaction at point. 197 198 TOTAL is a commoditized amount representing the total amount of 199 the postings in the transaction. 200 201 MISSING-POSITIONS is a list of positions in the buffer where the 202 transaction do not have an amount specified (such postings do not 203 contribute to TOTAL). Specifically, the positions are at the end 204 of the account name on such posting lines. 205 206 Error if the commodities do not match." 207 (save-excursion 208 (pcase-let ((`(,begin ,end) (ledger-navigate-find-xact-extents (point)))) 209 (goto-char begin) 210 (cl-loop 211 while (re-search-forward ledger-post-line-regexp end t) 212 for account-end = (match-end ledger-regex-post-line-group-account) 213 for amount-string = (when-let ((amount-string (match-string ledger-regex-post-line-group-amount))) 214 (unless (string-empty-p (string-trim amount-string)) 215 amount-string)) 216 if (not amount-string) 217 collect account-end into missing-positions 218 else 219 collect (ledger-split-commodity-string amount-string) into amounts 220 finally return (cons (if amounts 221 (cl-reduce #'ledger-add-commodity amounts) 222 '(0 nil)) 223 missing-positions))))) 224 225 (defun ledger-post-fill () 226 "Find a posting with no amount and insert it. 227 228 Even if ledger allows for one missing amount per transaction, you 229 might want to insert it anyway." 230 (interactive) 231 (pcase-let* ((`(,total . ,missing-positions) (ledger-post-xact-total)) 232 (missing-amount (ledger-negate-commodity total)) 233 (amounts-balance (< (abs (car missing-amount)) 0.0001))) 234 (pcase missing-positions 235 ('() (unless amounts-balance 236 (user-error "Postings do not balance, but no posting to fill"))) 237 (`(,missing-pos) 238 (if amounts-balance 239 (user-error "Missing amount but amounts balance already") 240 (goto-char missing-pos) 241 (insert " " (ledger-commodity-to-string missing-amount)) 242 (ledger-post-align-xact (point)))) 243 (_ (user-error "More than one posting with missing amount"))))) 244 245 (provide 'ledger-post) 246 247 248 249 ;;; ledger-post.el ends here