diff options
Diffstat (limited to 'lisp/ledger-xact.el')
| -rw-r--r-- | lisp/ledger-xact.el | 130 |
1 files changed, 67 insertions, 63 deletions
diff --git a/lisp/ledger-xact.el b/lisp/ledger-xact.el index 25413e43..35b0d62c 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-2014 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: @@ -36,7 +36,8 @@ :group 'ledger :safe t) -(defvar highlight-overlay (list)) +(defvar ledger-xact-highlight-overlay (list)) +(make-variable-buffer-local 'ledger-xact-highlight-overlay) (defun ledger-find-xact-extents (pos) "Return point for beginning of xact and and of xact containing position. @@ -46,28 +47,28 @@ within the transaction." (save-excursion (goto-char pos) (list (progn - (backward-paragraph) - (if (/= (point) (point-min)) - (forward-line)) - (line-beginning-position)) - (progn - (forward-paragraph) - (line-beginning-position))))) + (backward-paragraph) + (if (/= (point) (point-min)) + (forward-line)) + (line-beginning-position)) + (progn + (forward-paragraph) + (line-beginning-position))))) (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)))) + (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 100)))) (defun ledger-xact-payee () "Return the payee of the transaction containing point or nil." @@ -77,7 +78,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." @@ -93,7 +94,7 @@ MOMENT is an encoded date" (function (lambda (start date mark desc) (if (ledger-time-less-p moment date) - (throw 'found t))))))) + (throw 'found t))))))) (defun ledger-xact-iterate-transactions (callback) "Iterate through each transaction call CALLBACK for each." @@ -105,19 +106,19 @@ 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) @@ -128,29 +129,30 @@ MOMENT is an encoded date" (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-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) (re-search-forward ledger-iso-date-regexp) (replace-match date) - (ledger-next-amount))) + (ledger-next-amount) + (if (re-search-forward "[-0-9]") + (goto-char (match-beginning 0))))) (defun ledger-delete-current-transaction (pos) "Delete the transaction surrounging point." @@ -164,7 +166,9 @@ 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)))) @@ -179,20 +183,20 @@ 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))) + (buffer-string))) + "\n")) + (progn + (insert (car args) " \n\n") + (end-of-line -1))))) (provide 'ledger-xact) |