147 lines
5.2 KiB
EmacsLisp
147 lines
5.2 KiB
EmacsLisp
;;; ledger-check.el --- Helper code for use with the "ledger" command-line tool -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2015 Craig Earls (enderw88 AT gmail DOT com)
|
|
|
|
;; This file is not part of GNU Emacs.
|
|
|
|
;; This is free software; you can redistribute it and/or modify it under
|
|
;; the terms of the GNU General Public License as published by the Free
|
|
;; Software Foundation; either version 2, or (at your option) any later
|
|
;; version.
|
|
;;
|
|
;; This is distributed in the hope that it will be useful, but WITHOUT
|
|
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
;; for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
|
|
;; MA 02110-1301 USA.
|
|
|
|
;;; Commentary:
|
|
;; Provide secial mode to correct errors in ledger when running with --strict and --explicit
|
|
;;
|
|
;; Adapted to ledger mode by Craig Earls <enderw88 at gmail dot com>
|
|
|
|
;;; Code:
|
|
|
|
(require 'easymenu)
|
|
(require 'ledger-navigate)
|
|
(require 'ledger-report) ; for ledger-master-file
|
|
|
|
|
|
(defvar ledger-check-buffer-name "*Ledger Check*")
|
|
(defvar-local ledger-check--original-window-configuration nil)
|
|
|
|
|
|
|
|
|
|
(defvar ledger-check-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map (kbd "RET") #'ledger-report-visit-source)
|
|
(define-key map (kbd "q") #'ledger-check-quit)
|
|
map)
|
|
"Keymap for `ledger-check-mode'.")
|
|
|
|
(easy-menu-define ledger-check-mode-menu ledger-check-mode-map
|
|
"Ledger check menu."
|
|
'("Check"
|
|
;; ["Re-run Check" ledger-check-redo]
|
|
"---"
|
|
["Visit Source" ledger-report-visit-source]
|
|
"---"
|
|
["Quit" ledger-check-quit]
|
|
))
|
|
|
|
(define-derived-mode ledger-check-mode text-mode "Ledger-Check"
|
|
"A mode for viewing ledger errors and warnings.")
|
|
|
|
|
|
(defun ledger-do-check ()
|
|
"Run a check command ."
|
|
(goto-char (point-min))
|
|
(let ((data-pos (point))
|
|
(have-warnings nil))
|
|
(shell-command
|
|
;; ledger balance command will just return empty if you give it
|
|
;; an account name that doesn't exist. I will assume that no
|
|
;; one will ever have an account named "e342asd2131". If
|
|
;; someones does, this will probably still work for them.
|
|
;; I should only highlight error and warning lines.
|
|
"ledger bal e342asd2131 --strict --explicit "
|
|
t nil)
|
|
(goto-char data-pos)
|
|
|
|
;; format check report to make it navigate the file
|
|
|
|
(while (re-search-forward "^.*: \"\\(.*\\)\", line \\([0-9]+\\)" nil t)
|
|
(let ((file (match-string 1))
|
|
(line (string-to-number (match-string 2))))
|
|
(when file
|
|
(set-text-properties (line-beginning-position) (line-end-position)
|
|
(list 'ledger-source (cons file (save-window-excursion
|
|
(save-excursion
|
|
(find-file file)
|
|
(widen)
|
|
(ledger-navigate-to-line line)
|
|
(point-marker))))))
|
|
(add-text-properties (line-beginning-position) (line-end-position)
|
|
(list 'font-lock-face 'ledger-font-report-clickable-face))
|
|
(setq have-warnings 'true)
|
|
(end-of-line))))
|
|
(if (not have-warnings)
|
|
(insert "No errors or warnings reported."))))
|
|
|
|
(defun ledger-check-goto ()
|
|
"Goto the ledger check buffer."
|
|
(interactive)
|
|
(let ((rbuf (get-buffer ledger-check-buffer-name)))
|
|
(if (not rbuf)
|
|
(error "There is no ledger check buffer"))
|
|
(pop-to-buffer rbuf)
|
|
(shrink-window-if-larger-than-buffer)))
|
|
|
|
(defun ledger-check-quit ()
|
|
"Quit the ledger check buffer."
|
|
(interactive)
|
|
(ledger-check-goto)
|
|
(set-window-configuration ledger-check--original-window-configuration)
|
|
(kill-buffer (get-buffer ledger-check-buffer-name)))
|
|
|
|
(defun ledger-check-buffer (&optional interactive)
|
|
"Check the current buffer for errors.
|
|
|
|
Runs ledger with --explicit and --strict report errors and assist
|
|
with fixing them.
|
|
|
|
The output buffer will be in `ledger-check-mode', which defines
|
|
commands for navigating the buffer to the errors found, etc.
|
|
|
|
When INTERACTIVE is non-nil (i.e., when called interactively),
|
|
prompt to save if the current buffer is modified."
|
|
(interactive "p")
|
|
(when (and interactive
|
|
(buffer-modified-p)
|
|
(y-or-n-p "Buffer modified, save it? "))
|
|
(save-buffer))
|
|
(let ((_buf (find-file-noselect (ledger-master-file)))
|
|
(cbuf (get-buffer ledger-check-buffer-name))
|
|
(wcfg (current-window-configuration)))
|
|
(if cbuf
|
|
(kill-buffer cbuf))
|
|
(with-current-buffer
|
|
(pop-to-buffer (get-buffer-create ledger-check-buffer-name))
|
|
(ledger-check-mode)
|
|
(setq ledger-check--original-window-configuration wcfg)
|
|
(ledger-do-check)
|
|
(shrink-window-if-larger-than-buffer)
|
|
(set-buffer-modified-p nil)
|
|
(setq buffer-read-only t)
|
|
(message "q to quit; r to redo; k to kill"))))
|
|
|
|
|
|
(provide 'ledger-check)
|
|
|
|
;;; ledger-check.el ends here
|