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

fontifying xact starts and postings.

Browse source 
initial testing looks better than previous font-lock methods.  Need run time and performance testing.
This commit is contained in:
Craig Earls 2014-08-24 21:38:29 -07:00
parent 4deaeb02c9
commit 4a003b5828
2 changed files with 36 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
lisp/ledger-fontify.el
View file

@ -53,17 +53,7 @@
(interactive) (interactive)
(if (string= (format-mode-line 'mode-name) "Ledger") (if (string= (format-mode-line 'mode-name) "Ledger")
(progn (progn
(add-hook 'post-command-hook 'ledger-fontify-buffer-part) (add-hook 'post-command-hook 'ledger-fontify-buffer-part))))
;; this is a silly work around to emacs bug 16796 wherein
;; after-change-functions is randomly reset to nil. Before
;; each change make sure after-change-functions is properly
;; set.
; (add-hook 'before-change-functions 'ledger-fontify-ensure-after-change-hook)
)))
;; (defun ledger-fontify-ensure-after-change-hook (beg end)
;; (if (string= (format-mode-line 'mode-name) "Ledger")
;; (add-hook 'after-change-functions 'ledger-fontify-buffer-part)))
(defun ledger-fontify-buffer-part () (defun ledger-fontify-buffer-part ()
(save-excursion (save-excursion
@ -85,10 +75,13 @@
(ledger-fontify-set-face extents 'ledger-font-xact-pending-face))) (ledger-fontify-set-face extents 'ledger-font-xact-pending-face)))
(ledger-fontify-xact-by-line extents)))) (ledger-fontify-xact-by-line extents))))
(defun ledger-fontify-xact-by-line (extends) (defun ledger-fontify-xact-by-line (extents)
"do line-by-line detailed fontification of xact" "do line-by-line detailed fontification of xact"
(save-excursion (save-excursion
(ledger-fontify-xact-start (car extents)))) (ledger-fontify-xact-start (car extents))
(while (< (point) (cadr extents))
(ledger-fontify-posting (point))
(forward-line))))
(defun ledger-fontify-xact-start (pos) (defun ledger-fontify-xact-start (pos)
(interactive "d") (interactive "d")
@ -107,6 +100,28 @@
(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)
(let ((state nil))
(re-search-forward ledger-posting-regex)
(if (match-string 1)
(save-match-data (setq state (ledger-state-from-string (s-trim (match-string 1))))))
(ledger-fontify-set-face (list (match-beginning 0) (match-end 2))
(cond ((eq state 'cleared)
'ledger-font-posting-account-cleared-face)
((eq state 'pending)
'ledger-font-posting-account-pending-face)
(t
'ledger-font-posting-account-face)))
(ledger-fontify-set-face (list (match-beginning 4) (match-end 4))
(cond ((eq state 'cleared)
'ledger-font-posting-account-cleared-face)
((eq state 'cleared)
'ledger-font-posting-account-pending-face)
(t
'ledger-font-posting-amount-face)))
(ledger-fontify-set-face (list (match-beginning 5) (match-end 5))
'ledger-font-comment-face)))
(defun ledger-fontify-directive-at (position) (defun ledger-fontify-directive-at (position)
(interactive "d") (interactive "d")
(let ((extents (ledger-find-xact-extents position)) (let ((extents (ledger-find-xact-extents position))

14
lisp/ledger-regex.el
View file

@ -341,12 +341,14 @@
)) ))
(defconst ledger-posting-regex (defconst ledger-posting-regex
(concat "^[ \t]+" ;; initial white space (concat "^[ \t]+ ?" ;; initial white space
"\\(" "\\([*!]\\)? ?" ;; state, subexpr 1
"\\([[:word:]: ]*?\n?\\) " ;; account, subexpr 2 "\\([[:word:]: ]+\\(\n\\|[ \t][ \t]\\)\\)" ;; account, subexpr 2
"\\(.*?\\)" ;; amount, subexpr 3 "\\([^;\n]*\\)" ;; amount, subexpr 4
"\\(\n\\|\\(;.*\\)\\)" ;; comment, subexpr 5 "\\(.*\\)" ;; comment, subexpr 5
"\\)")) ))
(defconst ledger-directive-start-regex (defconst ledger-directive-start-regex
"[=~;#%|\\*[A-Za-z]") "[=~;#%|\\*[A-Za-z]")