diff options
Diffstat (limited to 'lisp/ledger-state.el')
| -rw-r--r-- | lisp/ledger-state.el | 179 |
1 files changed, 96 insertions, 83 deletions
diff --git a/lisp/ledger-state.el b/lisp/ledger-state.el index 121e97ca..47805f15 100644 --- a/lisp/ledger-state.el +++ b/lisp/ledger-state.el @@ -1,6 +1,6 @@ ;;; ledger-state.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: @@ -54,16 +54,26 @@ "Return the char representation of STATE." (if state (if (eq state 'pending) - "!" - "*") - "")) + "!" + "*") + "")) (defun ledger-state-from-char (state-char) "Get state from STATE-CHAR." (cond ((eql state-char ?\!) 'pending) - ((eql state-char ?\*) 'cleared) - ((eql state-char ?\;) 'comment) - (t nil))) + ((eql state-char ?\*) 'cleared) + ((eql state-char ?\;) 'comment) + (t nil))) + + +(defun ledger-state-from-string (state-string) + "Get state from STATE-CHAR." + (when state-string + (cond + ((string-match "\\!" state-string) 'pending) + ((string-match "\\*" state-string) 'cleared) + ((string-match ";" state-string) 'comment) + (t nil)))) (defun ledger-toggle-current-posting (&optional style) "Toggle the cleared status of the transaction under point. @@ -77,16 +87,17 @@ achieved more certainly by passing the xact to ledger for formatting, but doing so causes inline math expressions to be dropped." (interactive) - (let ((bounds (ledger-find-xact-extents (point))) + (let ((bounds (ledger-navigate-find-xact-extents (point))) new-status cur-status) ;; Uncompact the xact, to make it easier to toggle the ;; transaction (save-excursion ;; this excursion checks state of entire - ;; transaction and unclears if marked + ;; transaction and unclears if marked (goto-char (car bounds)) ;; beginning of xact - (skip-chars-forward "0-9./=\\- \t") ;; skip the date + (skip-chars-forward "0-9./=\\-") ;; skip the date + (skip-chars-forward " \t") ;; skip the white space after the date (setq cur-status (and (member (char-after) '(?\* ?\!)) - (ledger-state-from-char (char-after)))) + (ledger-state-from-char (char-after)))) ;;if cur-status if !, or * then delete the marker (when cur-status (let ((here (point))) @@ -97,15 +108,16 @@ dropped." (if (search-forward " " (line-end-position) t) (insert (make-string width ? )))))) (forward-line) - ;; Shift the cleared/pending status to the postings + ;; Shift the cleared/pending status to the postings (while (looking-at "[ \t]") (skip-chars-forward " \t") - (when (not (eq (ledger-state-from-char (char-after)) 'comment)) - (insert (ledger-char-from-state cur-status) " ") - (if (search-forward " " (line-end-position) t) - (delete-char 2))) - (forward-line)) - (setq new-status nil))) + (when (not (eq (ledger-state-from-char (char-after)) 'comment)) + (insert (ledger-char-from-state cur-status) " ") + (if (and (search-forward " " (line-end-position) t) + (looking-at " ")) + (delete-char 2))) + (forward-line)) + (setq new-status nil))) ;;this excursion toggles the posting status (save-excursion @@ -113,40 +125,40 @@ dropped." (goto-char (line-beginning-position)) (when (looking-at "[ \t]") - (skip-chars-forward " \t") - (let ((here (point)) - (cur-status (ledger-state-from-char (char-after)))) - (skip-chars-forward "*! ") - (let ((width (- (point) here))) - (when (> width 0) - (delete-region here (point)) - (save-excursion - (if (search-forward " " (line-end-position) t) - (insert (make-string width ? )))))) - (let (inserted) - (if cur-status - (if (and style (eq style 'cleared)) - (progn - (insert "* ") - (setq inserted 'cleared))) - (if (and style (eq style 'pending)) - (progn - (insert "! ") - (setq inserted 'pending)) - (progn - (insert "* ") - (setq inserted 'cleared)))) - (if (and inserted - (re-search-forward "\\(\t\\| [ \t]\\)" - (line-end-position) t)) - (cond - ((looking-at "\t") - (delete-char 1)) - ((looking-at " [ \t]") - (delete-char 2)) - ((looking-at " ") - (delete-char 1)))) - (setq new-status inserted)))) + (skip-chars-forward " \t") + (let ((here (point)) + (cur-status (ledger-state-from-char (char-after)))) + (skip-chars-forward "*! ") + (let ((width (- (point) here))) + (when (> width 0) + (delete-region here (point)) + (save-excursion + (if (search-forward " " (line-end-position) t) + (insert (make-string width ? )))))) + (let (inserted) + (if cur-status + (if (and style (eq style 'cleared)) + (progn + (insert "* ") + (setq inserted 'cleared))) + (if (and style (eq style 'pending)) + (progn + (insert "! ") + (setq inserted 'pending)) + (progn + (insert "* ") + (setq inserted 'cleared)))) + (if (and inserted + (re-search-forward "\\(\t\\| [ \t]\\)" + (line-end-position) t)) + (cond + ((looking-at "\t") + (delete-char 1)) + ((looking-at " [ \t]") + (delete-char 2)) + ((looking-at " ") + (delete-char 1)))) + (setq new-status inserted)))) (setq inhibit-modification-hooks nil)) ;; This excursion cleans up the xact so that it displays @@ -161,12 +173,12 @@ dropped." (while (and (not hetero) (looking-at "[ \t]")) (skip-chars-forward " \t") (let ((cur-status (ledger-state-from-char (char-after)))) - (if (not (eq cur-status 'comment)) - (if first - (setq state cur-status - first nil) - (if (not (eq state cur-status)) - (setq hetero t))))) + (if (not (eq cur-status 'comment)) + (if first + (setq state cur-status + first nil) + (if (not (eq state cur-status)) + (setq hetero t))))) (forward-line)) (when (and (not hetero) (not (eq state nil))) (goto-char (car bounds)) @@ -183,18 +195,19 @@ dropped." (insert (make-string width ? )))))) (forward-line)) (goto-char (car bounds)) - (skip-chars-forward "0-9./=\\- \t") + (skip-chars-forward "0-9./=\\-") ;; Skip the date + (skip-chars-forward " \t") ;; Skip the white space (insert (ledger-char-from-state state) " ") - (setq new-status state) + (setq new-status state) (if (re-search-forward "\\(\t\\| [ \t]\\)" (line-end-position) t) (cond - ((looking-at "\t") - (delete-char 1)) - ((looking-at " [ \t]") - (delete-char 2)) - ((looking-at " ") - (delete-char 1))))))) + ((looking-at "\t") + (delete-char 1)) + ((looking-at " [ \t]") + (delete-char 2)) + ((looking-at " ") + (delete-char 1))))))) new-status)) (defun ledger-toggle-current (&optional style) @@ -214,30 +227,30 @@ dropped." (forward-line) (goto-char (line-beginning-position)))) (ledger-toggle-current-transaction style)) - (ledger-toggle-current-posting style))) + (ledger-toggle-current-posting style))) (defun ledger-toggle-current-transaction (&optional style) "Toggle the transaction at point using optional STYLE." (interactive) (save-excursion (when (or (looking-at "^[0-9]") - (re-search-backward "^[0-9]" nil t)) + (re-search-backward "^[0-9]" nil t)) (skip-chars-forward "0-9./=\\-") (delete-horizontal-space) (if (or (eq (ledger-state-from-char (char-after)) 'pending) - (eq (ledger-state-from-char (char-after)) 'cleared)) - (progn - (delete-char 1) - (when (and style (eq style 'cleared)) - (insert " *") - 'cleared)) - (if (and style (eq style 'pending)) - (progn - (insert " ! ") - 'pending) - (progn - (insert " * ") - 'cleared)))))) + (eq (ledger-state-from-char (char-after)) 'cleared)) + (progn + (delete-char 1) + (when (and style (eq style 'cleared)) + (insert " *") + 'cleared)) + (if (and style (eq style 'pending)) + (progn + (insert " ! ") + 'pending) + (progn + (insert " * ") + 'cleared)))))) (provide 'ledger-state) |