sfos/ledger
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fixes Bug 897. toggle now works correctly if there are comment lines in the xact

Browse source
This commit is contained in:
Craig Earls 2013-02-15 08:54:04 -07:00
parent 8116ef4781
commit 9d2b2e3ceb
1 changed files with 20 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
lisp/ldg-state.el
View file

@ -73,6 +73,8 @@
'pending) 'pending)
((eql state-char ?\*) ((eql state-char ?\*)
'cleared) 'cleared)
((eql state-char ?\;)
'comment)
(t (t
nil))) nil)))
@ -92,7 +94,8 @@ dropped."
new-status cur-status) new-status cur-status)
;; Uncompact the entry, to make it easier to toggle the ;; Uncompact the entry, to make it easier to toggle the
;; transaction ;; transaction
(save-excursion ;; this excursion unclears the posting (save-excursion ;; this excursion checks state of entire
;; transaction and unclears if marked
(goto-char (car bounds)) ;; beginning of xact (goto-char (car bounds)) ;; beginning of xact
(skip-chars-forward "0-9./= \t") ;; skip the date (skip-chars-forward "0-9./= \t") ;; skip the date
(setq cur-status (and (member (char-after) '(?\* ?\!)) (setq cur-status (and (member (char-after) '(?\* ?\!))
@ -107,15 +110,17 @@ dropped."
(if (search-forward " " (line-end-position) t) (if (search-forward " " (line-end-position) t)
(insert (make-string width ? )))))) (insert (make-string width ? ))))))
(forward-line) (forward-line)
;; Shift the cleared/pending status to the postings
(while (looking-at "[ \t]") (while (looking-at "[ \t]")
(skip-chars-forward " \t") (skip-chars-forward " \t")
(insert (ledger-char-from-state cur-status) " ") (when (not (eq (ledger-state-from-char (char-after)) 'comment))
(if (search-forward " " (line-end-position) t) (insert (ledger-char-from-state cur-status) " ")
(delete-char 2)) (if (search-forward " " (line-end-position) t)
(forward-line)) (delete-char 2)))
(forward-line))
(setq new-status nil))) (setq new-status nil)))
;;this excursion marks the posting pending or cleared ;;this excursion toggles the posting status
(save-excursion (save-excursion
(goto-char (line-beginning-position)) (goto-char (line-beginning-position))
(when (looking-at "[ \t]") (when (looking-at "[ \t]")
@ -154,7 +159,9 @@ dropped."
(delete-char 1)))) (delete-char 1))))
(setq new-status inserted))))) (setq new-status inserted)))))
;; This excursion cleans up the entry so that it displays minimally ;; This excursion cleans up the entry so that it displays
;; minimally. This means that if all posts are cleared, remove
;; the marks and clear the entire transaction.
(save-excursion (save-excursion
(goto-char (car bounds)) (goto-char (car bounds))
(forward-line) (forward-line)
@ -164,11 +171,12 @@ dropped."
(while (and (not hetero) (looking-at "[ \t]")) (while (and (not hetero) (looking-at "[ \t]"))
(skip-chars-forward " \t") (skip-chars-forward " \t")
(let ((cur-status (ledger-state-from-char (char-after)))) (let ((cur-status (ledger-state-from-char (char-after))))
(if first (if (not (eq cur-status 'comment))
(setq state cur-status (if first
first nil) (setq state cur-status
(if (not (eq state cur-status)) first nil)
(setq hetero t)))) (if (not (eq state cur-status))
(setq hetero t)))))
(forward-line)) (forward-line))
(when (and (not hetero) (not (eq state nil))) (when (and (not hetero) (not (eq state nil)))
(goto-char (car bounds)) (goto-char (car bounds))