ledger-mode.el (13533B)
1 ;;; ledger-mode.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 ;; Package-Requires: ((emacs "25.1")) 8 9 ;; This is free software; you can redistribute it and/or modify it under 10 ;; the terms of the GNU General Public License as published by the Free 11 ;; Software Foundation; either version 2, or (at your option) any later 12 ;; version. 13 ;; 14 ;; This is distributed in the hope that it will be useful, but WITHOUT 15 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 16 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 17 ;; for more details. 18 ;; 19 ;; You should have received a copy of the GNU General Public License 20 ;; along with GNU Emacs; see the file COPYING. If not, write to the 21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, 22 ;; MA 02110-1301 USA. 23 24 ;;; Commentary: 25 ;; This Emacs library provides a major mode for editing files in the format used 26 ;; by the `ledger' command-line accounting system. 27 28 ;; It also provides automated support for some `ledger' workflows, such as 29 ;; reconciling transactions, or running certain reports. 30 31 ;;; Code: 32 33 (require 'ledger-regex) 34 (require 'org) 35 (require 'ledger-commodities) 36 (require 'ledger-complete) 37 (require 'ledger-context) 38 (require 'ledger-exec) 39 (require 'ledger-fonts) 40 (require 'ledger-fontify) 41 (require 'ledger-init) 42 (require 'ledger-navigate) 43 (require 'ledger-occur) 44 (require 'ledger-post) 45 (require 'ledger-reconcile) 46 (require 'ledger-report) 47 (require 'ledger-sort) 48 (require 'ledger-state) 49 (require 'ledger-test) 50 (require 'ledger-texi) 51 (require 'ledger-xact) 52 (require 'ledger-schedule) 53 (require 'ledger-check) 54 55 (declare-function custom-group-members "cus-edit" (symbol groups-only)) 56 57 ;;; Code: 58 59 (defgroup ledger nil 60 "Interface to the Ledger command-line accounting program." 61 :group 'data) 62 63 (defconst ledger-version "3.0" 64 "The version of ledger.el currently loaded.") 65 66 (defconst ledger-mode-version "4.0.0") 67 68 (defun ledger-mode-dump-variable (var) 69 "Format VAR for dump to buffer." 70 (if var 71 (insert (format " %s: %S\n" (symbol-name var) (eval var))))) 72 73 (defun ledger-mode-dump-group (group) 74 "Dump GROUP customizations to current buffer." 75 (require 'cus-edit) 76 (let ((members (custom-group-members group nil))) 77 (dolist (member members) 78 (cond ((eq (cadr member) 'custom-group) 79 (insert (format "Group %s:\n" (symbol-name (car member)))) 80 (ledger-mode-dump-group (car member))) 81 ((eq (cadr member) 'custom-variable) 82 (ledger-mode-dump-variable (car member))))))) 83 84 (defun ledger-mode-dump-configuration () 85 "Dump all customizations." 86 (interactive) 87 (find-file "ledger-mode-dump") 88 (ledger-mode-dump-group 'ledger)) 89 90 (defun ledger-read-account-with-prompt (prompt) 91 "Read an account from the minibuffer with PROMPT." 92 (let* ((context (ledger-context-at-point)) 93 (account (ledger-context-field-value context 'account))) 94 (ledger-completing-read-with-default prompt 95 (when account 96 (regexp-quote account)) 97 (ledger-accounts-list)))) 98 99 (defun ledger-read-date (prompt) 100 "Return user-supplied date after `PROMPT', defaults to today. 101 This uses `org-read-date', which see." 102 (ledger-format-date (let ((org-read-date-prefer-future nil)) 103 (org-read-date nil t nil prompt)))) 104 105 (defun ledger-get-minibuffer-prompt (prompt default) 106 "Return a minibuffer prompt string composing PROMPT and DEFAULT." 107 (concat prompt 108 (if default 109 (concat " (" default "): ") 110 ": "))) 111 112 (defun ledger-completing-read-with-default (prompt default collection) 113 "Return a user-supplied string after PROMPT. 114 Use the given DEFAULT, while providing completions from COLLECTION." 115 (completing-read (ledger-get-minibuffer-prompt prompt default) 116 collection nil nil nil 'ledger-minibuffer-history default)) 117 118 (defun ledger-read-string-with-default (prompt default) 119 "Return user supplied string after PROMPT, or DEFAULT." 120 (read-string (ledger-get-minibuffer-prompt prompt default) 121 nil 'ledger-minibuffer-history default)) 122 123 (defun ledger-display-balance-at-point (&optional arg) 124 "Display the cleared-or-pending balance. 125 And calculate the target-delta of the account being reconciled. 126 127 With ARG (\\[universal-argument]) ask for the target commodity and convert 128 the balance into that." 129 (interactive "P") 130 (let* ((account (ledger-read-account-with-prompt "Account balance to show")) 131 (target-commodity (when arg (ledger-read-commodity-with-prompt "Target commodity: "))) 132 (buffer (find-file-noselect (ledger-master-file))) 133 (balance (with-temp-buffer 134 (apply 'ledger-exec-ledger buffer (current-buffer) "cleared" account 135 (when target-commodity (list "-X" target-commodity))) 136 (if (> (buffer-size) 0) 137 (buffer-substring-no-properties (point-min) (1- (point-max))) 138 (concat account " is empty."))))) 139 (when balance 140 (display-message-or-buffer balance)))) 141 142 (defun ledger-display-ledger-stats () 143 "Display some summary statistics about the current ledger file." 144 (interactive) 145 (let* ((buffer (find-file-noselect (ledger-master-file))) 146 (balance (with-temp-buffer 147 (ledger-exec-ledger buffer (current-buffer) "stats") 148 (buffer-substring-no-properties (point-min) (1- (point-max)))))) 149 (when balance 150 (message balance)))) 151 152 (defvar ledger-mode-abbrev-table) 153 154 (defvar ledger-date-string-today (ledger-format-date)) 155 156 (defun ledger-remove-effective-date () 157 "Remove the effective date from a transaction or posting." 158 (interactive) 159 (let ((context (car (ledger-context-at-point)))) 160 (save-excursion 161 (save-restriction 162 (narrow-to-region (line-beginning-position) (line-end-position)) 163 (beginning-of-line) 164 (cond ((eq 'xact context) 165 (re-search-forward ledger-iso-date-regexp) 166 (when (= (char-after) ?=) 167 (let ((eq-pos (point))) 168 (delete-region 169 eq-pos 170 (re-search-forward ledger-iso-date-regexp))))) 171 ((eq 'acct-transaction context) 172 ;; Match "; [=date]" & delete string 173 (when (re-search-forward 174 (concat ledger-comment-regex 175 "\\[=" ledger-iso-date-regexp "\\]") 176 nil 'noerr) 177 (replace-match "")))))))) 178 179 (defun ledger-insert-effective-date (&optional date) 180 "Insert effective date `DATE' to the transaction or posting. 181 182 If `DATE' is nil, prompt the user a date. 183 184 Replace the current effective date if there's one in the same 185 line. 186 187 With a prefix argument, remove the effective date." 188 (interactive) 189 (if (and (listp current-prefix-arg) 190 (= 4 (prefix-numeric-value current-prefix-arg))) 191 (ledger-remove-effective-date) 192 (let* ((context (car (ledger-context-at-point))) 193 (date-string (or date (ledger-read-date "Effective date: ")))) 194 (save-restriction 195 (narrow-to-region (line-beginning-position) (line-end-position)) 196 (cond 197 ((eq 'xact context) 198 (beginning-of-line) 199 (re-search-forward ledger-iso-date-regexp) 200 (when (= (char-after) ?=) 201 (ledger-remove-effective-date)) 202 (insert "=" date-string)) 203 ((eq 'acct-transaction context) 204 (end-of-line) 205 (ledger-remove-effective-date) 206 (insert " ; [=" date-string "]"))))))) 207 208 (defun ledger-mode-remove-extra-lines () 209 "Get rid of multiple empty lines." 210 (goto-char (point-min)) 211 (while (re-search-forward "\n\n\\(\n\\)+" nil t) 212 (replace-match "\n\n"))) 213 214 (defun ledger-mode-clean-buffer () 215 "Indent, remove multiple line feeds and sort the buffer." 216 (interactive) 217 (let ((start (point-min-marker)) 218 (end (point-max-marker)) 219 (distance-in-xact (- (point) (ledger-navigate-beginning-of-xact)))) 220 (let ((target (buffer-substring (line-beginning-position) (line-end-position)))) 221 (goto-char start) 222 (untabify start end) 223 (ledger-sort-buffer) 224 (ledger-post-align-postings start end) 225 (ledger-mode-remove-extra-lines) 226 (goto-char start) 227 (search-forward target) 228 (beginning-of-line) 229 (forward-char distance-in-xact)))) 230 231 (defvar ledger-mode-syntax-table 232 (let ((table (make-syntax-table text-mode-syntax-table))) 233 (modify-syntax-entry ?\; "<" table) 234 (modify-syntax-entry ?\n ">" table) 235 table) 236 "Syntax table in use in `ledger-mode' buffers.") 237 238 (defvar ledger-mode-map 239 (let ((map (make-sparse-keymap))) 240 (define-key map (kbd "C-c C-a") #'ledger-add-transaction) 241 (define-key map (kbd "C-c C-b") #'ledger-post-edit-amount) 242 (define-key map (kbd "C-c C-c") #'ledger-toggle-current) 243 (define-key map (kbd "C-c C-d") #'ledger-delete-current-transaction) 244 (define-key map (kbd "C-c C-e") #'ledger-toggle-current-transaction) 245 (define-key map (kbd "C-c C-f") #'ledger-occur) 246 (define-key map (kbd "C-c C-k") #'ledger-copy-transaction-at-point) 247 (define-key map (kbd "C-c C-r") #'ledger-reconcile) 248 (define-key map (kbd "C-c C-s") #'ledger-sort-region) 249 (define-key map (kbd "C-c C-t") #'ledger-insert-effective-date) 250 (define-key map (kbd "C-c C-u") #'ledger-schedule-upcoming) 251 (define-key map (kbd "C-c C-p") #'ledger-display-balance-at-point) 252 (define-key map (kbd "C-c C-l") #'ledger-display-ledger-stats) 253 (define-key map (kbd "C-c C-q") #'ledger-post-align-xact) 254 255 (define-key map (kbd "C-TAB") #'ledger-post-align-xact) 256 (define-key map (kbd "C-c TAB") #'ledger-fully-complete-xact) 257 (define-key map (kbd "C-c C-i") #'ledger-fully-complete-xact) 258 259 (define-key map (kbd "C-c C-o C-a") #'ledger-report-redo) 260 (define-key map (kbd "C-c C-o C-e") #'ledger-report-edit-report) 261 (define-key map (kbd "C-c C-o C-g") #'ledger-report-goto) 262 (define-key map (kbd "C-c C-o C-k") #'ledger-report-quit) 263 (define-key map (kbd "C-c C-o C-r") #'ledger-report) 264 (define-key map (kbd "C-c C-o C-s") #'ledger-report-save) 265 266 (define-key map (kbd "M-p") #'ledger-navigate-prev-xact-or-directive) 267 (define-key map (kbd "M-n") #'ledger-navigate-next-xact-or-directive) 268 (define-key map (kbd "M-q") #'ledger-post-align-dwim) 269 270 ;; Reset the `text-mode' override of this standard binding 271 (define-key map (kbd "C-M-i") 'completion-at-point) 272 map) 273 "Keymap for `ledger-mode'.") 274 275 (easy-menu-define ledger-mode-menu ledger-mode-map 276 "Ledger menu" 277 '("Ledger" 278 ["Narrow to REGEX" ledger-occur] 279 ["Show all transactions" ledger-occur-mode ledger-occur-mode] 280 ["Ledger Statistics" ledger-display-ledger-stats ledger-works] 281 "---" 282 ["Show upcoming transactions" ledger-schedule-upcoming] 283 ["Add Transaction (ledger xact)" ledger-add-transaction ledger-works] 284 ["Complete Transaction" ledger-fully-complete-xact] 285 ["Delete Transaction" ledger-delete-current-transaction] 286 "---" 287 ["Calc on Amount" ledger-post-edit-amount] 288 "---" 289 ["Check Balance" ledger-display-balance-at-point ledger-works] 290 ["Reconcile Account" ledger-reconcile ledger-works] 291 "---" 292 ["Toggle Current Transaction" ledger-toggle-current-transaction] 293 ["Toggle Current Posting" ledger-toggle-current] 294 ["Copy Trans at Point" ledger-copy-transaction-at-point] 295 "---" 296 ["Clean-up Buffer" ledger-mode-clean-buffer] 297 ["Check Buffer" ledger-check-buffer ledger-works] 298 ["Align Region" ledger-post-align-postings mark-active] 299 ["Align Xact" ledger-post-align-xact] 300 ["Sort Region" ledger-sort-region mark-active] 301 ["Sort Buffer" ledger-sort-buffer] 302 ["Mark Sort Beginning" ledger-sort-insert-start-mark] 303 ["Mark Sort End" ledger-sort-insert-end-mark] 304 ["Set effective date" ledger-insert-effective-date] 305 "---" 306 ["Customize Ledger Mode" (lambda () (interactive) (customize-group 'ledger))] 307 "---" 308 ["Run Report" ledger-report ledger-works] 309 ["Goto Report" ledger-report-goto ledger-works] 310 ["Re-run Report" ledger-report-redo ledger-works] 311 ["Save Report" ledger-report-save ledger-works] 312 ["Edit Report" ledger-report-edit-report ledger-works] 313 ["Quit Report" ledger-report-quit ledger-works])) 314 315 ;;;###autoload 316 (define-derived-mode ledger-mode text-mode "Ledger" 317 "A mode for editing ledger data files." 318 (ledger-check-version) 319 (setq font-lock-defaults 320 '(ledger-font-lock-keywords t nil nil nil)) 321 (add-hook 'font-lock-extend-region-functions 'ledger-fontify-extend-region) 322 (add-hook 'completion-at-point-functions #'ledger-complete-at-point nil t) 323 (add-hook 'after-save-hook 'ledger-report-redo nil t) 324 325 (add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t) 326 327 (ledger-init-load-init-file) 328 (setq-local comment-start ";") 329 (setq-local indent-line-function #'ledger-indent-line) 330 (setq-local indent-region-function 'ledger-post-align-postings) 331 (setq-local beginning-of-defun-function #'ledger-navigate-beginning-of-xact) 332 (setq-local end-of-defun-function #'ledger-navigate-end-of-xact)) 333 334 ;;;###autoload 335 (add-to-list 'auto-mode-alist '("\\.ledger\\'" . ledger-mode)) 336 337 (provide 'ledger-mode) 338 339 ;;; ledger-mode.el ends here