diff --git a/ledger-exec.el b/ledger-exec.el index ff304a5b..ba85ef91 100644 --- a/ledger-exec.el +++ b/ledger-exec.el @@ -114,9 +114,11 @@ otherwise the error output is displayed and an error is raised." nil))))) ;;failure (defun ledger-check-version () - "Verify that ledger works and is modern enough." + "Verify that ledger works and is modern enough. + +Only runs in buffers visiting files." (interactive) - (if ledger-mode-should-check-version + (if (and buffer-file-name ledger-mode-should-check-version) (if (setq ledger-works (ledger-version-greater-p ledger-version-needed)) (message "Good Ledger Version") (message "Bad Ledger Version")))) diff --git a/ledger-reconcile.el b/ledger-reconcile.el index bcf7319f..8c32db5c 100644 --- a/ledger-reconcile.el +++ b/ledger-reconcile.el @@ -331,8 +331,11 @@ Return the number of uncleared xacts found." When called interactively, prompt for DATE, then XACT." (interactive - (list (ledger-read-date "Date: ") - (read-string "Transaction: " nil 'ledger-minibuffer-history))) + (let* ((date (ledger-read-date "Date: ")) + (xact-text + (with-current-buffer ledger-reconcile-ledger-buf + (ledger-read-transaction-text date)))) + (list date xact-text))) (with-current-buffer ledger-reconcile-ledger-buf (ledger-add-transaction (concat date " " xact))) (ledger-reconcile-refresh)) diff --git a/ledger-xact.el b/ledger-xact.el index a0ad30e6..4279e379 100644 --- a/ledger-xact.el +++ b/ledger-xact.el @@ -31,6 +31,7 @@ (require 'ledger-exec) (require 'ledger-post) (declare-function ledger-read-date "ledger-mode" (prompt)) +(declare-function ledger-mode "ledger-mode" ()) ;; TODO: This file depends on code in ledger-mode.el, which depends on this. @@ -46,6 +47,15 @@ When nil, `ledger-add-transaction' will not prompt twice." :package-version '(ledger-mode . "4.0.1") :group 'ledger) +(defcustom ledger-add-transaction-idle-preview t + "When non-nil, a live preview of the to-be-added transaction is shown. +Requires `ledger-add-transaction-prompt-for-text' to be non-nil." + :type '(choice (const :tag "Do not preview" nil) + (const :tag "Preview when idle" t) + (number :tag "Preview with custom delay")) + :package-version '(ledger-mode . "4.1") + :group 'ledger) + (defvar-local ledger-xact-highlight-overlay (list)) (defun ledger-highlight-make-overlay () @@ -172,55 +182,202 @@ Leave point on the first amount, if any, otherwise the first account." (defvar ledger-add-transaction-last-date nil "Last date entered using `ledger-read-transaction'.") +(defvar ledger-xact--preview-buffer-name "*ledger xact preview*") +(defvar-local ledger-xact--preview-timer nil) +(defvar-local ledger-xact--date nil + "In a minibuffer for the transaction text, the transaction date.") +(defvar-local ledger-xact--ledger-buf-file nil + "In a minibuffer for the transaction text, the input file. + +The original ledger buffer is written to this temporary file so it can +be read by ledger. This is quite a bit faster than passing in the input +via `process-send-region'.") + +(defun ledger-xact--preview (date args) + "Run \"ledger xact\" with DATE and ARGS and display the output. + +`ledger-xact--ledger-buf-file' is used as input to \"ledger xact\". + +Return the window displaying the output buffer, or nil if it was not +displayed." + (let ((preview-buf + (or (get-buffer ledger-xact--preview-buffer-name) + (with-current-buffer (get-buffer-create ledger-xact--preview-buffer-name) + ;; Enable `ledger-mode' just for syntax highlighting. Skip all minor + ;; modes except for `font-lock-mode'. + (delay-mode-hooks (ledger-mode)) + (font-lock-mode) + (setq buffer-read-only t) + (set-buffer-modified-p nil) + (current-buffer)))) + (input-file ledger-xact--ledger-buf-file) + window) + (with-current-buffer preview-buf + (with-silent-modifications + ;; Don't use `ledger-exec-ledger' because it pops up any error output in + ;; a separate buffer. For this use case, it is preferable to display + ;; the error in the preview buffer instead. + ;; + ;; Also, it uses `call-process-region', which behaves poorly with + ;; `while-no-input': if two input events arrive quickly, they may both + ;; be lost. (Try evaluating (while-no-input (call-process "sleep" nil + ;; nil nil "10")) and then typing "asdf"). + ;; + ;; Sadly, using `process-send-region' is quite a bit slower than + ;; `call-process-region'. + ;; + ;; TODO: Could we speed up the previews slightly by calling "ledger -f + ;; -" (even before the user has begun typing any input) and merely + ;; inputting "xact" commands at the REPL when the input changes? + (erase-buffer) + (while-no-input + (unwind-protect + (let ((proc (make-process + :name "ledger-xact-preview" + :buffer preview-buf + :command (append (list ledger-binary-path + "-f" input-file + "xact" date) + args) + :noquery t + :connection-type 'pipe + :sentinel #'ignore))) + (process-send-eof proc) + (while (accept-process-output proc))) + (when (get-buffer-process preview-buf) + (delete-process preview-buf)))) + (ledger-post-align-postings (point-min) (point-max)))) + (setq window + (display-buffer preview-buf + '((display-buffer-reuse-window display-buffer-at-bottom) + (window-height . fit-window-to-buffer)))) + ;; modeled after `internal-temp-output-buffer-show' + (when window + (setq minibuffer-scroll-window window) + (set-window-hscroll window 0) + (set-window-start window (point-min) t) + (set-window-point window (point-min))) + window)) + +(defun ledger-xact--preview-timer (minibuffer) + "Preview the ledger xact output from MINIBUFFER's current contents." + (setq ledger-xact--preview-timer nil) + ;; TODO: It would be more correct to use `minibufferp' and pass a non-nil LIVE + ;; argument, but that feature isn't available until Emacs 28.3. + (when (and (buffer-live-p minibuffer) + (eq minibuffer (window-buffer (active-minibuffer-window)))) + (with-current-buffer minibuffer + (let ((date ledger-xact--date)) + (when-let* ((args (ledger-parse-transaction-text (minibuffer-contents)))) + (ledger-xact--preview date args)))))) + +(defun ledger-xact--after-change-function (_beg _end _len) + "Added to `after-change-functions' in transaction-reading minibuffers." + (unless ledger-xact--preview-timer + (setq ledger-xact--preview-timer + (run-with-idle-timer + (if (numberp ledger-add-transaction-idle-preview) + ledger-add-transaction-idle-preview + 0.1) + nil #'ledger-xact--preview-timer (current-buffer))))) + +(defun ledger-xact--hide-preview-window () + "Similar to `minibuffer-restore-windows', for transaction-reading minibuffers." + ;; This variable was introduced in Emacs 28.1. The default, matching the + ;; behavior in previous versions of Emacs, is equivalent to non-nil. We only + ;; want to delete the window if the default window configuration restore logic + ;; wouldn't have. + (when (and (boundp 'read-minibuffer-restore-windows) + (not read-minibuffer-restore-windows)) + (when-let* ((window (get-buffer-window ledger-xact--preview-buffer-name))) + (delete-window window)))) + +(defun ledger-xact--delete-preview-temp-file () + (when ledger-xact--ledger-buf-file + (delete-file ledger-xact--ledger-buf-file))) + +(defun ledger-read-transaction-text (date) + "Read the text of a transaction with date DATE. + +The ledger buffer should be current when this function is called, since +it will be used as input for \"ledger xact\" for the sake of previewing +output." + (let ((ledger-buf (current-buffer)) + (ledger-buf-dir default-directory)) + (minibuffer-with-setup-hook + (lambda () + (when ledger-add-transaction-idle-preview + (setq ledger-xact--date date + ledger-xact--ledger-buf-file + (let* ((temporary-file-directory ledger-buf-dir) + (filename (make-temp-file "ldg-xact-preview" nil ".ldg"))) + (with-current-buffer ledger-buf + (save-restriction + (widen) + (write-region nil nil filename nil 'nomessage))) + filename)) + (add-hook 'after-change-functions #'ledger-xact--after-change-function nil t) + (add-hook 'minibuffer-exit-hook #'ledger-xact--hide-preview-window nil t) + (add-hook 'minibuffer-exit-hook #'ledger-xact--delete-preview-temp-file nil t))) + (read-string (concat "xact " date ": ") nil 'ledger-minibuffer-history)))) + (defun ledger-read-transaction () "Read the text of a transaction, which is at least the current date." (let ((date (ledger-read-date "Date: "))) (concat date " " (when ledger-add-transaction-prompt-for-text - (read-string (concat "xact " date ": ") nil 'ledger-minibuffer-history))))) + (ledger-read-transaction-text date))))) (defun ledger-parse-iso-date (date) "Try to parse DATE using `ledger-iso-date-regexp' and return a time value or nil." - (save-match-data - (when (string-match ledger-iso-date-regexp date) - (encode-time 0 0 0 (string-to-number (match-string 4 date)) - (string-to-number (match-string 3 date)) - (string-to-number (match-string 2 date)))))) + (when (string-match ledger-iso-date-regexp date) + (encode-time 0 0 0 (string-to-number (match-string 4 date)) + (string-to-number (match-string 3 date)) + (string-to-number (match-string 2 date))))) + +(defun ledger-parse-transaction-text (transaction-text) + "Parse TRANSACTION-TEXT as a date and maybe some arguments. + +Return (DATE . ARGS), a list of strings." + ;; TODO: This whole function could just be replaced with + ;; `split-string-shell-command' when the minimum supported Emacs version is + ;; Emacs 28. + (with-temp-buffer + (insert transaction-text) + (mapcar #'eval (eshell-parse-arguments (point-min) (point-max))))) (defun ledger-add-transaction (transaction-text &optional insert-at-point) "Use ledger xact TRANSACTION-TEXT to add a transaction to the buffer. -If INSERT-AT-POINT is non-nil insert the transaction there, -otherwise call `ledger-xact-find-slot' to insert it at the -correct chronological place in the buffer. -Interactively, the date is requested via `ledger-read-date' and -the \\[universal-argument] enables INSERT-AT-POINT." +If INSERT-AT-POINT is non-nil insert the transaction there, otherwise +call `ledger-xact-find-slot' to insert it at the correct chronological +place in the buffer. + +Interactively, the date is requested via `ledger-read-date' and the +\\[universal-argument] enables INSERT-AT-POINT." (interactive (list (ledger-read-transaction) current-prefix-arg)) - (let* ((args (with-temp-buffer - (insert transaction-text) - (eshell-parse-arguments (point-min) (point-max)))) + (let* ((args (ledger-parse-transaction-text transaction-text)) + (date (pop args)) (ledger-buf (current-buffer)) (separator "\n")) (unless insert-at-point - (let* ((date (car args)) - (parsed-date (ledger-parse-iso-date date))) + (let* ((parsed-date (ledger-parse-iso-date date))) (setq ledger-add-transaction-last-date parsed-date) (push-mark) ;; TODO: what about when it can't be parsed? (ledger-xact-find-slot (or parsed-date date)) (when (looking-at-p "\n*\\'") (setq separator "")))) - (if (cdr args) + (if args (save-excursion (insert (with-temp-buffer - (apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact" - (mapcar 'eval args)) + (apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact" date args) (goto-char (point-min)) (ledger-post-align-postings (point-min) (point-max)) (buffer-string)) separator)) - (insert (car args) " ") + (insert date " ") (save-excursion (insert "\n" separator))))) (provide 'ledger-xact) diff --git a/test/xact-test.el b/test/xact-test.el index f9bb05e6..91f82132 100644 --- a/test/xact-test.el +++ b/test/xact-test.el @@ -37,7 +37,7 @@ http://bugs.ledger-cli.org/show_bug.cgi?id=183" :tags '(xact regress) (ledger-tests-with-temp-file - "2013/05/01 foo + "2013/05/01 foo Expenses:Foo $10.00 Assets:Bar @@ -45,11 +45,11 @@ http://bugs.ledger-cli.org/show_bug.cgi?id=183" Expenses:Foo $10.00 Assets:Bar " - (goto-char (point-max)) ; end-of-buffer - (ledger-add-transaction "2013/05/02 foo") - (should - (equal (buffer-string) - "2013/05/01 foo + (goto-char (point-max)) ; end-of-buffer + (ledger-add-transaction "2013/05/02 foo") + (should + (equal (buffer-string) + "2013/05/01 foo Expenses:Foo $10.00 Assets:Bar @@ -69,7 +69,7 @@ http://bugs.ledger-cli.org/show_bug.cgi?id=526" :tags '(xact regress) (ledger-tests-with-temp-file - "2013/05/01 foo + "2013/05/01 foo Expenses:Foo 10,00 € Assets:Bar @@ -77,11 +77,11 @@ http://bugs.ledger-cli.org/show_bug.cgi?id=526" Expenses:Foo 10,00 € Assets:Bar " - (goto-char (point-max)) ; end-of-buffer - (ledger-add-transaction "2013/05/02 foo 16,02") - (should - (equal (buffer-string) - "2013/05/01 foo + (goto-char (point-max)) ; end-of-buffer + (ledger-add-transaction "2013/05/02 foo 16,02") + (should + (equal (buffer-string) + "2013/05/01 foo Expenses:Foo 10,00 € Assets:Bar @@ -101,7 +101,7 @@ https://github.com/ledger/ledger-mode/issues/307" :tags '(xact regress) (ledger-tests-with-temp-file - "2013/05/02=2013/05/03 foo + "2013/05/02=2013/05/03 foo Expenses:Foo $10.00 Assets:Bar @@ -109,11 +109,11 @@ https://github.com/ledger/ledger-mode/issues/307" Expenses:Foo $10.00 Assets:Bar " - (goto-char (point-max)) ; end-of-buffer - (ledger-add-transaction "2013/05/01 foo") - (should - (equal (buffer-string) - "2013/05/01 foo + (goto-char (point-max)) ; end-of-buffer + (ledger-add-transaction "2013/05/01 foo") + (should + (equal (buffer-string) + "2013/05/01 foo Expenses:Foo $10.00 Assets:Bar @@ -166,6 +166,58 @@ https://github.com/ledger/ledger-mode/issues/307" Assets:Bar ")))) +(ert-deftest ledger-xact/test-005 () + "Add xact with quoted/escaped arguments." + :tags '(xact) + + (ledger-tests-with-temp-file + "\ +2013/05/01 foo + Expenses:Foo $10.00 + Assets:Bar + +2013/05/02=2013/05/03 foo bar + Expenses:Bar $10.00 + Assets:Foo + +2013/05/03 foo + Expenses:Foo $10.00 + Assets:Bar +" + (save-buffer) + + ;; arguments are normally word-split + (ledger-add-transaction "2013/05/04 foo bar") + (should + (equal (thing-at-point 'paragraph) + " +2013/05/04 foo + Assets:Bar + Assets:Bar +")) + (revert-buffer t t) + + ;; word splitting can be inhibited by quoting... + (ledger-add-transaction "2013/05/04 \"foo bar\"") + (should + (equal (thing-at-point 'paragraph) + " +2013/05/04 foo bar + Expenses:Bar $10.00 + Assets:Foo +")) + (revert-buffer t t) + + ;; ...or backslash-escaping + (ledger-add-transaction "2013/05/04 foo\\ bar") + (should + (equal (thing-at-point 'paragraph) + " +2013/05/04 foo bar + Expenses:Bar $10.00 + Assets:Foo +")))) + (provide 'xact-test) ;;; xact-test.el ends here