diff options
Diffstat (limited to 'lisp/ledger-post.el')
| -rw-r--r-- | lisp/ledger-post.el | 130 |
1 files changed, 50 insertions, 80 deletions
diff --git a/lisp/ledger-post.el b/lisp/ledger-post.el index ac040bb2..e0c7aaee 100644 --- a/lisp/ledger-post.el +++ b/lisp/ledger-post.el @@ -1,6 +1,6 @@ ;;; ledger-post.el --- Helper code for use with the "ledger" command-line tool -;; Copyright (C) 2003-2014 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. @@ -42,7 +42,7 @@ :group 'ledger-post) (defcustom ledger-post-use-completion-engine :built-in - "Which completion engine to use, :iswitchb or :ido chose those engines, + "Which completion engine to use, :iswitchb or :ido chose those engines. :built-in uses built-in Ledger-mode completion" :type '(radio (const :tag "built in completion" :built-in) (const :tag "ido completion" :ido) @@ -82,9 +82,8 @@ point at beginning of the commodity." (- (or (match-end 4) (match-end 3)) (point))))) - (defun ledger-next-account (&optional end) - "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END. + "Move to the beginning of the posting, or status marker, limit to END. Return the column of the beginning of the account and leave point at beginning of account" (if (> end (point)) @@ -96,13 +95,13 @@ at beginning of account" (current-column)))) (defun ledger-post-align-xact (pos) - (interactive "d") - (let ((bounds (ledger-find-xact-extents pos))) + "Align all the posting in the xact at POS." + (interactive "d") + (let ((bounds (ledger-navigate-find-xact-extents pos))) (ledger-post-align-postings (car bounds) (cadr bounds)))) (defun ledger-post-align-postings (&optional beg end) - "Align all accounts and amounts within region, if there is no -region align the posting on the current line." + "Align all accounts and amounts between BEG and END, or the current line." (interactive) (save-excursion @@ -110,62 +109,51 @@ region align the posting on the current line." (not (use-region-p))) (set-mark (point))) - (let* ((inhibit-modification-hooks t) - (mark-first (< (mark) (point))) - (begin-region (if beg - beg - (if mark-first (mark) (point)))) - (end-region (if end - end - (if mark-first (point) (mark)))) - acct-start-column acct-end-column acct-adjust amt-width amt-adjust - (lines-left 1)) - ;; Condition point and mark to the beginning and end of lines - (goto-char end-region) - (setq end-region (line-end-position)) - (goto-char begin-region) - (goto-char - (setq begin-region - (line-beginning-position))) - - (untabify begin-region end-region) - - (goto-char end-region) - (setq end-region (line-end-position)) - (goto-char begin-region) - (goto-char - (setq begin-region - (line-beginning-position))) - - ;; This is the guts of the alignment loop - (while (and (or (setq acct-start-column (ledger-next-account (line-end-position))) - lines-left) - (< (point) end-region)) - (when acct-start-column - (setq acct-end-column (save-excursion - (goto-char (match-end 2)) - (current-column))) - (when (/= (setq acct-adjust (- ledger-post-account-alignment-column acct-start-column)) 0) - (setq acct-end-column (+ acct-end-column acct-adjust)) ;;adjust the account ending column - (if (> acct-adjust 0) - (insert (make-string acct-adjust ? )) - (delete-char acct-adjust))) - (when (setq amt-width (ledger-next-amount (line-end-position))) - (if (/= 0 (setq amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width) - (+ 2 acct-end-column)) - ledger-post-amount-alignment-column ;;we have room - (+ acct-end-column 2 amt-width)) - amt-width - (current-column)))) - (if (> amt-adjust 0) - (insert (make-string amt-adjust ? )) - (delete-char amt-adjust))))) - (forward-line) - (setq lines-left (not (eobp)))) + (let ((inhibit-modification-hooks t) + (mark-first (< (mark) (point))) + acct-start-column acct-end-column acct-adjust amt-width amt-adjust + (lines-left 1)) + + (unless beg (setq beg (if mark-first (mark) (point)))) + (unless end (setq end (if mark-first (mark) (point)))) + + ;; Extend region to whole lines + (let ((start-marker (set-marker (make-marker) (save-excursion + (goto-char beg) + (line-beginning-position)))) + (end-marker (set-marker (make-marker) (save-excursion + (goto-char end) + (line-end-position))))) + (untabify start-marker end-marker) + (goto-char start-marker) + + ;; This is the guts of the alignment loop + (while (and (or (setq acct-start-column (ledger-next-account (line-end-position))) + lines-left) + (< (point) end-marker)) + (when acct-start-column + (setq acct-end-column (save-excursion + (goto-char (match-end 2)) + (current-column))) + (when (/= (setq acct-adjust (- ledger-post-account-alignment-column acct-start-column)) 0) + (setq acct-end-column (+ acct-end-column acct-adjust)) ;;adjust the account ending column + (if (> acct-adjust 0) + (insert (make-string acct-adjust ? )) + (delete-char acct-adjust))) + (when (setq amt-width (ledger-next-amount (line-end-position))) + (if (/= 0 (setq amt-adjust (- (if (> (- ledger-post-amount-alignment-column amt-width) + (+ 2 acct-end-column)) + ledger-post-amount-alignment-column ;;we have room + (+ acct-end-column 2 amt-width)) + amt-width + (current-column)))) + (if (> amt-adjust 0) + (insert (make-string amt-adjust ? )) + (delete-char amt-adjust))))) + (forward-line) + (setq lines-left (not (eobp))))) (setq inhibit-modification-hooks nil)))) - - (defun ledger-post-edit-amount () "Call 'calc-mode' and push the amount in the posting to the top of stack." (interactive) @@ -186,24 +174,6 @@ region align the posting on the current line." (insert " ")) (calc)))))) -(defun ledger-post-prev-xact () - "Move point to the previous transaction." - (interactive) - (backward-paragraph) - (when (re-search-backward ledger-xact-line-regexp nil t) - (goto-char (match-beginning 0)) - (re-search-forward ledger-post-line-regexp) - (goto-char (match-end ledger-regex-post-line-group-account)))) - -(defun ledger-post-next-xact () - "Move point to the next transaction." - (interactive) - (when (re-search-forward ledger-xact-line-regexp nil t) - (goto-char (match-beginning 0)) - (re-search-forward ledger-post-line-regexp) - (goto-char (match-end ledger-regex-post-line-group-account)))) - - (provide 'ledger-post) |