ledger-exec.el (5091B)
1 ;;; ledger-exec.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 ;; Code for executing ledger synchronously. 25 26 ;;; Code: 27 28 (require 'ledger-init) ;for `ledger-default-date-format' 29 30 (declare-function ledger-master-file "ledger-report" ()) 31 32 (defconst ledger-version-needed "3.0.0" 33 "The version of ledger executable needed for interactive features.") 34 35 (defvar ledger-works nil 36 "Non-nil if the ledger binary can support `ledger-mode' interactive features.") 37 38 (defgroup ledger-exec nil 39 "Interface to the Ledger command-line accounting program." 40 :group 'ledger) 41 42 (defcustom ledger-mode-should-check-version t 43 "Should Ledger-mode verify that the executable is working?" 44 :type 'boolean 45 :group 'ledger-exec) 46 47 (defcustom ledger-binary-path "ledger" 48 "Path to the ledger executable." 49 :type 'file 50 :risky t 51 :group 'ledger-exec) 52 53 (defun ledger-exec-handle-error (ledger-errfile) 54 "Deal with ledger errors contained in LEDGER-ERRFILE." 55 (with-current-buffer (get-buffer-create "*Ledger Error*") 56 (let ((buffer-read-only nil)) 57 (delete-region (point-min) (point-max)) 58 (insert-file-contents ledger-errfile)) 59 (view-mode) 60 (setq buffer-read-only t) 61 (current-buffer))) 62 63 (defun ledger-exec-success-p (exit-code ledger-output-buffer) 64 "Return non-nil if EXIT-CODE and LEDGER-OUTPUT-BUFFER indicate success." 65 (and (zerop exit-code) 66 (with-current-buffer ledger-output-buffer 67 (goto-char (point-min)) 68 (not (and (> (buffer-size) 1) (looking-at (regexp-quote "While"))))))) 69 70 (defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args) 71 "Run Ledger using INPUT-BUFFER. 72 Optionally capture output in OUTPUT-BUFFER, and pass ARGS on the 73 command line. Returns OUTPUT-BUFFER if ledger succeeded, 74 otherwise the error output is displayed and an error is raised." 75 (unless (and ledger-binary-path 76 (or (and (file-exists-p ledger-binary-path) 77 (file-executable-p ledger-binary-path)) 78 (executable-find ledger-binary-path))) 79 (error "`ledger-binary-path' (value: %s) is not executable" ledger-binary-path)) 80 (let ((buf (or input-buffer (find-file-noselect (ledger-master-file)))) 81 (outbuf (or output-buffer 82 (generate-new-buffer " *ledger-tmp*"))) 83 (errfile (make-temp-file "ledger-errors"))) 84 (unwind-protect 85 (with-current-buffer buf 86 (let ((exit-code 87 (let ((coding-system-for-write 'utf-8) 88 (coding-system-for-read 'utf-8)) 89 (apply #'call-process-region 90 (append (list (point-min) (point-max) 91 ledger-binary-path nil (list outbuf errfile) nil "-f" "-") 92 (list "--date-format" ledger-default-date-format) 93 args))))) 94 (if (ledger-exec-success-p exit-code outbuf) 95 outbuf 96 (display-buffer (ledger-exec-handle-error errfile)) 97 (error "Ledger execution failed")))) 98 (delete-file errfile)))) 99 100 (defun ledger-version-greater-p (needed) 101 "Verify the ledger binary version is at least NEEDED." 102 (let ((version-strings '())) 103 (with-temp-buffer 104 (when (ledger-exec-ledger (current-buffer) (current-buffer) "--version") 105 (goto-char (point-min)) 106 (delete-horizontal-space) 107 (setq version-strings (split-string 108 (buffer-substring-no-properties (point) 109 (point-max)))) 110 (if (and (string-match (regexp-quote "Ledger") (car version-strings)) 111 (or (string= needed (cadr version-strings)) 112 (string< needed (cadr version-strings)))) 113 t ;; success 114 nil))))) ;;failure 115 116 (defun ledger-check-version () 117 "Verify that ledger works and is modern enough." 118 (interactive) 119 (if ledger-mode-should-check-version 120 (if (setq ledger-works (ledger-version-greater-p ledger-version-needed)) 121 (message "Good Ledger Version") 122 (message "Bad Ledger Version")))) 123 124 (provide 'ledger-exec) 125 126 ;;; ledger-exec.el ends here