From 4deaeb02c9dfb3f1bf51e998b85b0a433ac9f212 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 24 Aug 2014 18:37:24 -0700 Subject: Set up fontification independent of font-lock. Basic functionality in place. need to test further and expand detail fortification. --- lisp/ledger-regex.el | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) (limited to 'lisp/ledger-regex.el') diff --git a/lisp/ledger-regex.el b/lisp/ledger-regex.el index bb080b94..49a2b114 100644 --- a/lisp/ledger-regex.el +++ b/lisp/ledger-regex.el @@ -329,7 +329,27 @@ ledger-iso-date-regexp "\\([ *!]+\\)" ;; mark "\\((.*)\\)?" ;; code - "\\(.*\\)" ;; desc + "\\([[:word:] ]+\\)" ;; desc "\\)")) +(defconst ledger-xact-start-regex + (concat ledger-iso-date-regexp ;; subexp 1 + " ?\\([ *!]\\)" ;; mark, subexp 5 + " ?\\((.*)\\)?" ;; code, subexp 6 + " ?\\([[:word:] ]+\\)" ;; desc, subexp 7 + "\\(\n\\|;.*\\)" ;; comment, subexp 8 + )) + +(defconst ledger-posting-regex + (concat "^[ \t]+" ;; initial white space + "\\(" + "\\([[:word:]: ]*?\n?\\) " ;; account, subexpr 2 + "\\(.*?\\)" ;; amount, subexpr 3 + "\\(\n\\|\\(;.*\\)\\)" ;; comment, subexpr 5 + "\\)")) + +(defconst ledger-directive-start-regex + "[=~;#%|\\*[A-Za-z]") + + (provide 'ledger-regex) -- cgit v1.2.3 From 4a003b5828fadd47cbea4144ca5352bf6ad4941c Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Sun, 24 Aug 2014 21:38:29 -0700 Subject: fontifying xact starts and postings. initial testing looks better than previous font-lock methods. Need run time and performance testing. --- lisp/ledger-fontify.el | 41 ++++++++++++++++++++++++++++------------- lisp/ledger-regex.el | 14 ++++++++------ 2 files changed, 36 insertions(+), 19 deletions(-) (limited to 'lisp/ledger-regex.el') diff --git a/lisp/ledger-fontify.el b/lisp/ledger-fontify.el index ff194649..1023cd85 100644 --- a/lisp/ledger-fontify.el +++ b/lisp/ledger-fontify.el @@ -53,17 +53,7 @@ (interactive) (if (string= (format-mode-line 'mode-name) "Ledger") (progn - (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))) + (add-hook 'post-command-hook 'ledger-fontify-buffer-part)))) (defun ledger-fontify-buffer-part () (save-excursion @@ -85,10 +75,13 @@ (ledger-fontify-set-face extents 'ledger-font-xact-pending-face))) (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" (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) (interactive "d") @@ -107,6 +100,28 @@ (ledger-fontify-set-face (list (match-beginning 8) (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) (interactive "d") (let ((extents (ledger-find-xact-extents position)) diff --git a/lisp/ledger-regex.el b/lisp/ledger-regex.el index 49a2b114..bc7e926b 100644 --- a/lisp/ledger-regex.el +++ b/lisp/ledger-regex.el @@ -341,12 +341,14 @@ )) (defconst ledger-posting-regex - (concat "^[ \t]+" ;; initial white space - "\\(" - "\\([[:word:]: ]*?\n?\\) " ;; account, subexpr 2 - "\\(.*?\\)" ;; amount, subexpr 3 - "\\(\n\\|\\(;.*\\)\\)" ;; comment, subexpr 5 - "\\)")) + (concat "^[ \t]+ ?" ;; initial white space + "\\([*!]\\)? ?" ;; state, subexpr 1 + "\\([[:word:]: ]+\\(\n\\|[ \t][ \t]\\)\\)" ;; account, subexpr 2 + "\\([^;\n]*\\)" ;; amount, subexpr 4 + "\\(.*\\)" ;; comment, subexpr 5 + )) + + (defconst ledger-directive-start-regex "[=~;#%|\\*[A-Za-z]") -- cgit v1.2.3 From 403ca4f1a5b4a11eb4168e2e62709f4a09c3c202 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Tue, 26 Aug 2014 18:33:41 -0700 Subject: Not working well, try something else on new-fontification-scheme-2 --- lisp/ledger-fontify.el | 20 +++++++++++++++++--- lisp/ledger-mode.el | 12 ++++++++---- lisp/ledger-regex.el | 2 +- 3 files changed, 26 insertions(+), 8 deletions(-) (limited to 'lisp/ledger-regex.el') diff --git a/lisp/ledger-fontify.el b/lisp/ledger-fontify.el index 1023cd85..83c8753c 100644 --- a/lisp/ledger-fontify.el +++ b/lisp/ledger-fontify.el @@ -38,6 +38,7 @@ (defun ledger-fontify-whole-buffer () (interactive) (save-excursion + (message "Ledger fontify whole buffer") (goto-char (point-min)) (while (not (eobp)) (cond ((looking-at ledger-xact-start-regex) @@ -53,13 +54,26 @@ (interactive) (if (string= (format-mode-line 'mode-name) "Ledger") (progn - (add-hook 'post-command-hook 'ledger-fontify-buffer-part)))) + (add-hook 'after-change-functions 'ledger-fontify-buffer-part) +; (add-hook 'before-change-functions 'ledger-fontify-ensure-activation) + (message "ledger-fontify-activate called")))) -(defun ledger-fontify-buffer-part () +(defun ledger-fontify-ensure-activation (beg end) + (if (string= (format-mode-line 'mode-name) "Ledger") + (add-hook 'after-change-functions 'ledger-fontify-buffer-part))) + +(defun ledger-fontify-buffer-part (beg end len) (save-excursion + (message (concat "ledger-fontify-buffer-part: " + (int-to-string beg) " " + (int-to-string end) " " + (int-to-string len) + )) +; (goto-char beg) (backward-paragraph) (forward-char) - (cond ((looking-at ledger-xact-start-regex) + (cond ((or (looking-at ledger-xact-start-regex) + (looking-at ledger-posting-regex)) (ledger-fontify-xact-at (point))) ((looking-at ledger-directive-start-regex) (ledger-fontify-directive-at (point)))))) diff --git a/lisp/ledger-mode.el b/lisp/ledger-mode.el index 9291bf8f..18928fe0 100644 --- a/lisp/ledger-mode.el +++ b/lisp/ledger-mode.el @@ -320,8 +320,8 @@ With a prefix argument, remove the effective date. " (add-hook 'completion-at-point-functions 'pcomplete-completions-at-point nil t) (add-hook 'after-save-hook 'ledger-report-redo) - (ledger-fontify-whole-buffer) - (ledger-fontify-activate) + ;(ledger-fontify-whole-buffer) + ;(ledger-fontify-activate) ;(add-hook 'after-save-hook) (add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t) @@ -329,8 +329,12 @@ With a prefix argument, remove the effective date. " (ledger-init-load-init-file) - (set (make-local-variable 'indent-region-function) 'ledger-post-align-postings) - (run-mode-hooks)) + (setq font-lock-defaults + '(nil t nil nil nil + (font-lock-fontify-buffer-function . ledger-fontify-whole-buffer) + (font-lock-fontify-region-function . ledger-fontify-buffer-part))) + + (set (make-local-variable 'indent-region-function) 'ledger-post-align-postings)) (defun ledger-set-year (newyear) diff --git a/lisp/ledger-regex.el b/lisp/ledger-regex.el index bc7e926b..460b50ce 100644 --- a/lisp/ledger-regex.el +++ b/lisp/ledger-regex.el @@ -336,7 +336,7 @@ (concat ledger-iso-date-regexp ;; subexp 1 " ?\\([ *!]\\)" ;; mark, subexp 5 " ?\\((.*)\\)?" ;; code, subexp 6 - " ?\\([[:word:] ]+\\)" ;; desc, subexp 7 + " ?\\([^;\n]+\\)" ;; desc, subexp 7 "\\(\n\\|;.*\\)" ;; comment, subexp 8 )) -- cgit v1.2.3