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

Smash a bug that cause the status on a posting with no amount to bleed into the next line.

Browse source
This commit is contained in:
Craig Earls 2014-11-11 19:54:43 -07:00
parent e54d7392bf
commit a3f3aa304f
3 changed files with 53 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
lisp/ledger-fontify.el
View file

@ -63,6 +63,7 @@
(defun ledger-fontify-xact-by-line (extents) (defun ledger-fontify-xact-by-line (extents)
"do line-by-line detailed fontification of xact" "do line-by-line detailed fontification of xact"
(interactive)
(save-excursion (save-excursion
(ledger-fontify-xact-start (car extents)) (ledger-fontify-xact-start (car extents))
(while (< (point) (cadr extents)) (while (< (point) (cadr extents))
@ -92,27 +93,55 @@ Fontify the first line of an xact"
(ledger-fontify-set-face (list (match-beginning 8) (ledger-fontify-set-face (list (match-beginning 8)
(match-end 8)) 'ledger-font-comment-face))) (match-end 8)) 'ledger-font-comment-face)))
(defun ledger-fontify-posting (pos) (defun ledger-fontify-posting (pos)
(let ((state nil)) (let* ((state nil)
(re-search-forward ledger-posting-regex) (end-of-line-comment nil)
(end (progn (end-of-line)
(point)))
(start (progn (beginning-of-line)
(point))))
;; Look for a posting status flag
(save-match-data ;; must use save-match-data to shadow the search
;; results. If there is no status flag then the
;; search below will fail and NOT clear the match
;; data. So if the previous line did have a
;; status flag it is still sitting in the match
;; data, causing the current line to be fontified
;; like the previous line. Don't ask how long
;; that took to figure out
(re-search-forward " \\([*!]\\) " end t)
(if (match-string 1) (if (match-string 1)
(save-match-data (setq state (ledger-state-from-string (s-trim (match-string 1)))))) (setq state (ledger-state-from-string (s-trim (match-string 1))))))
(ledger-fontify-set-face (list (match-beginning 0) (match-end 2)) (beginning-of-line)
(re-search-forward "[[:graph:]]\\([ \t][ \t]\\)" end 'end) ;; find the end of the account, or end of line
(when (<= (point) end) ;; we are still on the line
(ledger-fontify-set-face (list start (point))
(cond ((eq state 'cleared) (cond ((eq state 'cleared)
'ledger-font-posting-account-cleared-face) 'ledger-font-posting-account-cleared-face)
((eq state 'pending) ((eq state 'pending)
'ledger-font-posting-account-pending-face) 'ledger-font-posting-account-pending-face)
(t (t
'ledger-font-posting-account-face))) 'ledger-font-posting-account-face)))
(ledger-fontify-set-face (list (match-beginning 4) (match-end 4))
(when (< (point) end) ;; there is still more to fontify
(setq start (point)) ;; update start of next font region
(setq end-of-line-comment (re-search-forward ";" end 'end)) ;; find the end of the line, or start of a comment
(ledger-fontify-set-face (list start (point) )
(cond ((eq state 'cleared) (cond ((eq state 'cleared)
'ledger-font-posting-amount-cleared-face) 'ledger-font-posting-amount-cleared-face)
((eq state 'pending) ((eq state 'pending)
'ledger-font-posting-amount-pending-face) 'ledger-font-posting-amount-pending-face)
(t (t
'ledger-font-posting-amount-face))) 'ledger-font-posting-amount-face)))
(ledger-fontify-set-face (list (match-beginning 5) (match-end 5)) (when end-of-line-comment
'ledger-font-comment-face))) (setq start (point))
(end-of-line)
(ledger-fontify-set-face (list (- start 1) (point)) ;; subtract 1 from start because we passed the semi-colon
'ledger-font-comment-face))))))
(defun ledger-fontify-directive-at (position) (defun ledger-fontify-directive-at (position)
(let ((extents (ledger-navigate-find-element-extents position)) (let ((extents (ledger-navigate-find-element-extents position))

2
lisp/ledger-navigate.el
View file

@ -65,7 +65,7 @@ beginning with whitespace"
(interactive) (interactive)
;; need to start at the beginning of a line incase we are in the first line of an xact already. ;; need to start at the beginning of a line incase we are in the first line of an xact already.
(beginning-of-line) (beginning-of-line)
(let ((sreg (concat "\\(~\\|" ledger-iso-date-regexp "\\)"))) (let ((sreg (concat "^\\(~\\|" ledger-iso-date-regexp "\\)")))
(unless (looking-at sreg) (unless (looking-at sreg)
(re-search-backward sreg nil t) (re-search-backward sreg nil t)
(beginning-of-line))) (beginning-of-line)))

5
lisp/ledger-regex.el
View file

@ -333,7 +333,8 @@
"\\)")) "\\)"))
(defconst ledger-xact-start-regex (defconst ledger-xact-start-regex
(concat ledger-iso-date-regexp ;; subexp 1 (concat "^" ledger-iso-date-regexp ;; subexp 1
;; "\\(=" ledger-iso-date-regexp "\\)?"
" ?\\([ *!]\\)" ;; mark, subexp 5 " ?\\([ *!]\\)" ;; mark, subexp 5
" ?\\((.*)\\)?" ;; code, subexp 6 " ?\\((.*)\\)?" ;; code, subexp 6
" ?\\([^;\n]+\\)" ;; desc, subexp 7 " ?\\([^;\n]+\\)" ;; desc, subexp 7
@ -343,7 +344,7 @@
(defconst ledger-posting-regex (defconst ledger-posting-regex
(concat "^[ \t]+ ?" ;; initial white space (concat "^[ \t]+ ?" ;; initial white space
"\\([*!]\\)? ?" ;; state, subexpr 1 "\\([*!]\\)? ?" ;; state, subexpr 1
"\\(.+?\\(\n\\|[ \t][ \t]\\)\\)" ;; account, subexpr 2 "\\([[:print:]]+\\([ \t][ \t]\\)\\)" ;; account, subexpr 2
"\\([^;\n]*\\)" ;; amount, subexpr 4 "\\([^;\n]*\\)" ;; amount, subexpr 4
"\\(.*\\)" ;; comment, subexpr 5 "\\(.*\\)" ;; comment, subexpr 5
)) ))