ledger-check.el

;;; 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