diff options
Diffstat (limited to 'lisp/ledger-xact.el')
| -rw-r--r-- | lisp/ledger-xact.el | 168 |
1 files changed, 81 insertions, 87 deletions
diff --git a/lisp/ledger-xact.el b/lisp/ledger-xact.el index e6269580..0eb9386a 100644 --- a/lisp/ledger-xact.el +++ b/lisp/ledger-xact.el @@ -1,6 +1,6 @@ ;;; ledger-xact.el --- Helper code for use with the "ledger" command-line tool -;; Copyright (C) 2003-2013 John Wiegley (johnw AT gnu DOT org) +;; Copyright (C) 2003-2015 John Wiegley (johnw AT gnu DOT org) ;; This file is not part of GNU Emacs. @@ -16,8 +16,8 @@ ;; ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +;; MA 02110-1301 USA. ;;; Commentary: @@ -25,6 +25,11 @@ ;;; Code: +(require 'eshell) +(require 'ledger-regex) +(require 'ledger-navigate) +;; TODO: This file depends on code in ledger-mode.el, which depends on this. + (defcustom ledger-highlight-xact-under-point t "If t highlight xact under point." :type 'boolean @@ -36,38 +41,23 @@ :group 'ledger :safe t) -(defvar highlight-overlay (list)) - -(defun ledger-find-xact-extents (pos) - "Return point for beginning of xact and and of xact containing position. -Requires empty line separating xacts. Argument POS is a location -within the transaction." - (interactive "d") - (save-excursion - (goto-char pos) - (list (progn - (backward-paragraph) - (if (/= (point) (point-min)) - (forward-line)) - (line-beginning-position)) - (progn - (forward-paragraph) - (line-beginning-position))))) +(defvar ledger-xact-highlight-overlay (list)) +(make-variable-buffer-local 'ledger-xact-highlight-overlay) (defun ledger-highlight-xact-under-point () "Move the highlight overlay to the current transaction." (if ledger-highlight-xact-under-point - (let ((exts (ledger-find-xact-extents (point))) - (ovl highlight-overlay)) - (if (not highlight-overlay) - (setq ovl - (setq highlight-overlay - (make-overlay (car exts) - (cadr exts) - (current-buffer) t nil))) - (move-overlay ovl (car exts) (cadr exts))) - (overlay-put ovl 'face 'ledger-font-xact-highlight-face) - (overlay-put ovl 'priority 100)))) + (let ((exts (ledger-navigate-find-element-extents (point))) + (ovl ledger-xact-highlight-overlay)) + (if (not ledger-xact-highlight-overlay) + (setq ovl + (setq ledger-xact-highlight-overlay + (make-overlay (car exts) + (cadr exts) + (current-buffer) t nil))) + (move-overlay ovl (car exts) (cadr exts))) + (overlay-put ovl 'face 'ledger-font-xact-highlight-face) + (overlay-put ovl 'priority '(nil . 99))))) (defun ledger-xact-payee () "Return the payee of the transaction containing point or nil." @@ -77,7 +67,7 @@ within the transaction." (let ((context-info (ledger-context-other-line i))) (if (eq (ledger-context-line-type context-info) 'xact) (ledger-context-field-value context-info 'payee) - nil)))) + nil)))) (defun ledger-time-less-p (t1 t2) "Say whether time value T1 is less than time value T2." @@ -88,12 +78,20 @@ within the transaction." (defun ledger-xact-find-slot (moment) "Find the right place in the buffer for a transaction at MOMENT. MOMENT is an encoded date" - (catch 'found - (ledger-xact-iterate-transactions - (function - (lambda (start date mark desc) - (if (ledger-time-less-p moment date) - (throw 'found t))))))) + (let (last-xact-start) + (catch 'found + (ledger-xact-iterate-transactions + (function + (lambda (start date mark desc) + (setq last-xact-start start) + (if (ledger-time-less-p moment date) + (throw 'found t)))))) + (when (and (eobp) last-xact-start) + (let ((end (cadr (ledger-navigate-find-xact-extents last-xact-start)))) + (goto-char end) + (if (eobp) + (insert "\n") + (forward-line)))))) (defun ledger-xact-iterate-transactions (callback) "Iterate through each transaction call CALLBACK for each." @@ -105,49 +103,43 @@ MOMENT is an encoded date" (let ((found-y-p (match-string 2))) (if found-y-p (setq current-year (string-to-number found-y-p)) ;; a Y directive was found - (let ((start (match-beginning 0)) - (year (match-string 4)) - (month (string-to-number (match-string 5))) - (day (string-to-number (match-string 6))) - (mark (match-string 7)) - (code (match-string 8)) - (desc (match-string 9))) - (if (and year (> (length year) 0)) - (setq year (string-to-number year))) - (funcall callback start - (encode-time 0 0 0 day month - (or year current-year)) - mark desc))))) + (let ((start (match-beginning 0)) + (year (match-string 4)) + (month (string-to-number (match-string 5))) + (day (string-to-number (match-string 6))) + (mark (match-string 7)) + (code (match-string 8)) + (desc (match-string 9))) + (if (and year (> (length year) 0)) + (setq year (string-to-number year))) + (funcall callback start + (encode-time 0 0 0 day month + (or year current-year)) + mark desc))))) (forward-line)))) -(defsubst ledger-goto-line (line-number) - "Rapidly move point to line LINE-NUMBER." - (goto-char (point-min)) - (forward-line (1- line-number))) - (defun ledger-year-and-month () (let ((sep (if ledger-use-iso-dates "-" "/"))) - (concat ledger-year sep ledger-month sep))) + (concat ledger-year sep ledger-month sep))) (defun ledger-copy-transaction-at-point (date) "Ask for a new DATE and copy the transaction under point to that date. Leave point on the first amount." (interactive (list - (read-string "Copy to date: " (ledger-year-and-month) - 'ledger-minibuffer-history))) + (ledger-read-date "Copy to date: "))) (let* ((here (point)) - (extents (ledger-find-xact-extents (point))) - (transaction (buffer-substring-no-properties (car extents) (cadr extents))) - encoded-date) + (extents (ledger-navigate-find-xact-extents (point))) + (transaction (buffer-substring-no-properties (car extents) (cadr extents))) + encoded-date) (if (string-match ledger-iso-date-regexp date) - (setq encoded-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))))) + (setq encoded-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))))) (ledger-xact-find-slot encoded-date) (insert transaction "\n") - (backward-paragraph 2) + (ledger-navigate-beginning-of-xact) (re-search-forward ledger-iso-date-regexp) (replace-match date) (ledger-next-amount) @@ -155,18 +147,20 @@ MOMENT is an encoded date" (goto-char (match-beginning 0))))) (defun ledger-delete-current-transaction (pos) - "Delete the transaction surrounging point." + "Delete the transaction surrounging POS." (interactive "d") - (let ((bounds (ledger-find-xact-extents pos))) + (let ((bounds (ledger-navigate-find-xact-extents pos))) (delete-region (car bounds) (cadr bounds)))) (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 +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." (interactive (list - (read-string "Transaction: " (ledger-year-and-month)))) + ;; Note: This isn't "just" the date - it can contain + ;; other text too + (ledger-read-date "Transaction: "))) (let* ((args (with-temp-buffer (insert transaction-text) (eshell-parse-arguments (point-min) (point-max)))) @@ -181,21 +175,21 @@ correct chronological place in the buffer." (string-to-number (match-string 2 date))))) (ledger-xact-find-slot date))) (if (> (length args) 1) - (save-excursion - (insert - (with-temp-buffer - (setq exit-code - (apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact" - (mapcar 'eval args))) - (goto-char (point-min)) - (if (looking-at "Error: ") - (error (concat "Error in ledger-add-transaction: " (buffer-string))) - (buffer-string))) - "\n")) - (progn - (insert (car args) " \n\n") - (end-of-line -1))))) - + (save-excursion + (insert + (with-temp-buffer + (setq exit-code + (apply #'ledger-exec-ledger ledger-buf (current-buffer) "xact" + (mapcar 'eval args))) + (goto-char (point-min)) + (if (looking-at "Error: ") + (error (concat "Error in ledger-add-transaction: " (buffer-string))) + (ledger-post-align-postings (point-min) (point-max)) + (buffer-string))) + "\n")) + (progn + (insert (car args) " \n\n") + (end-of-line -1))))) (provide 'ledger-xact) |