diff options
author | Craig Earls <enderw88@gmail.com> | 2013-07-02 15:50:32 -0700 |
---|---|---|
committer | Craig Earls <enderw88@gmail.com> | 2013-07-02 15:50:32 -0700 |
commit | 0d4641acc2748f5f25a1e6207c4bc5ef86d0cba6 (patch) | |
tree | 986c85ff2ff3ef01f8bae6d5b962a36a7f5055a1 /lisp/ledger-exec.el | |
parent | b1edc38e428a36d803bb808d43052b5a7a402e41 (diff) | |
parent | 63ba45dbaab04722cd59bf610ae77b8334ca213d (diff) | |
download | fork-ledger-0d4641acc2748f5f25a1e6207c4bc5ef86d0cba6.tar.gz fork-ledger-0d4641acc2748f5f25a1e6207c4bc5ef86d0cba6.tar.bz2 fork-ledger-0d4641acc2748f5f25a1e6207c4bc5ef86d0cba6.zip |
Merge branch 'master' into ledger-mode-automatic-transactions
Conflicts:
lisp/ledger-init.el
lisp/ledger-mode.el
lisp/ledger-reconcile.el
lisp/ledger-schedule.el
Diffstat (limited to 'lisp/ledger-exec.el')
-rw-r--r-- | lisp/ledger-exec.el | 101 |
1 files changed, 101 insertions, 0 deletions
diff --git a/lisp/ledger-exec.el b/lisp/ledger-exec.el new file mode 100644 index 00000000..34757d99 --- /dev/null +++ b/lisp/ledger-exec.el @@ -0,0 +1,101 @@ +;;; ledger-exec.el --- Helper code for use with the "ledger" command-line tool + +;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) + +;; 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., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + + +;;; Commentary: +;; Code for executing ledger synchronously. + +;;; Code: + +(defconst ledger-version-needed "3.0.0" + "The version of ledger executable needed for interactive features.") + +(defvar ledger-works nil + "Flag showing whether the ledger binary can support `ledger-mode' interactive features.") + +(defgroup ledger-exec nil + "Interface to the Ledger command-line accounting program." + :group 'ledger) + +(defcustom ledger-binary-path "ledger" + "Path to the ledger executable." + :type 'file + :group 'ledger-exec) + +(defun ledger-exec-handle-error (ledger-output) + "Deal with ledger errors contained in LEDGER-OUTPUT." + (with-current-buffer (get-buffer-create "*Ledger Error*") + (insert-buffer-substring ledger-output) + (view-mode) + (setq buffer-read-only t))) + +(defun ledger-exec-success-p (ledger-output-buffer) + (with-current-buffer ledger-output-buffer + (goto-char (point-min)) + (if (and (> (buffer-size) 1) (looking-at (regexp-quote "While"))) + nil ;; failure, there is an error starting with "While" + ledger-output-buffer))) + +(defun ledger-exec-ledger (input-buffer &optional output-buffer &rest args) + "Run Ledger using INPUT-BUFFER and optionally capturing output in OUTPUT-BUFFER with ARGS." + (if (null ledger-binary-path) + (error "The variable `ledger-binary-path' has not been set") + (let ((buf (or input-buffer (current-buffer))) + (outbuf (or output-buffer + (generate-new-buffer " *ledger-tmp*")))) + (with-current-buffer buf + (let ((coding-system-for-write 'utf-8) + (coding-system-for-read 'utf-8)) + (apply #'call-process-region + (append (list (point-min) (point-max) + ledger-binary-path nil outbuf nil "-f" "-") + args))) + (if (ledger-exec-success-p outbuf) + outbuf + (ledger-exec-handle-error outbuf)))))) + +(defun ledger-version-greater-p (needed) + "Verify the ledger binary is usable for `ledger-mode' (version greater than NEEDED)." + (let ((buffer ledger-buf) + (version-strings '())) + (with-temp-buffer + (when (ledger-exec-ledger (current-buffer) (current-buffer) "--version") + (goto-char (point-min)) + (delete-horizontal-space) + (setq version-strings (split-string + (buffer-substring-no-properties (point) + (point-max)))) + (if (and (string-match (regexp-quote "Ledger") (car version-strings)) + (or (string= needed (cadr version-strings)) + (string< needed (cadr version-strings)))) + t ;; success + nil))))) ;;failure + +(defun ledger-check-version () + "Verify that ledger works and is modern enough." + (interactive) + (if (setq ledger-works (ledger-version-greater-p ledger-version-needed)) + (message "Good Ledger Version") + (message "Bad Ledger Version"))) + +(provide 'ledger-exec) + +;;; ledger-exec.el ends here |