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

Implement more efficient completion algorithm. Thanks Thierry! Also remove multi-comment font-locking for performance reasons.

Browse source
This commit is contained in:
Craig Earls 2013-05-06 11:28:35 -07:00
parent 6b10e2e909
commit fdbae766c1
3 changed files with 38 additions and 61 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
lisp/ldg-complete.el
View file

@ -69,31 +69,36 @@
;; to the list
(pcomplete-uniqify-list (nreverse payees-list))))
(defun ledger-find-accounts-in-buffer ()
"Search through buffer and build tree of accounts.
Return tree structure"
(let ((origin (point))
(account-tree (list t))
(account-elements nil))
(save-excursion
(goto-char (point-min))
(while (re-search-forward
ledger-account-or-metadata-regex nil t)
(unless (and (>= origin (match-beginning 0))
(< origin (match-end 0)))
(interactive)
(let ((origin (point))
accounts
(account-tree (list t))
(account-elements nil))
(save-excursion
(goto-char (point-min))
(dolist (account
(delete-dups
(progn
(while (re-search-forward ledger-account-or-metadata-regex nil t)
(unless (between origin (match-beginning 0) (match-end 0))
(setq accounts (cons (match-string-no-properties 2) accounts))))
accounts)))
(let ((root account-tree))
(setq account-elements
(split-string
(match-string-no-properties 2) ":"))
(let ((root account-tree))
(while account-elements
(let ((xact (assoc (car account-elements) root)))
(if xact
(setq root (cdr xact))
(setq xact (cons (car account-elements) (list t)))
(nconc root (list xact))
(setq root (cdr xact))))
(setq account-elements (cdr account-elements)))))))
account-tree))
(split-string
account ":"))
(while account-elements
(let ((xact (assoc (car account-elements) root)))
(if xact
(setq root (cdr xact))
(setq xact (cons (car account-elements) (list t)))
(nconc root (list xact))
(setq root (cdr xact))))
(setq account-elements (cdr account-elements))))))
account-tree))
(defun ledger-find-metadata-in-buffer ()
"Search through buffer and build list of metadata.
@ -177,7 +182,7 @@ Does not use ledger xact"
;; Search backward for a matching payee
(when (re-search-backward
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.*"
(regexp-quote name) ".*\\)" ) nil t)
(regexp-quote name) ".*\\)" ) nil t)
(setq rest-of-name (match-string 3))
;; Start copying the postings
(forward-line)

43
lisp/ldg-fonts.el
View file

@ -111,54 +111,27 @@
(defvar ledger-font-lock-keywords
`( ;; (,ledger-other-entries-regex 1
`( ;; (,ledger-other-entries-regex 1
;; ledger-font-other-face)
(,ledger-comment-regex 0
'ledger-font-comment-face)
(,ledger-multiline-comment-regex 0 'ledger-font-comment-face)
(,ledger-payee-pending-regex 2
(,ledger-payee-pending-regex 2
'ledger-font-payee-pending-face) ; Works
(,ledger-payee-cleared-regex 2
(,ledger-payee-cleared-regex 2
'ledger-font-payee-cleared-face) ; Works
(,ledger-payee-uncleared-regex 2
(,ledger-payee-uncleared-regex 2
'ledger-font-payee-uncleared-face) ; Works
(,ledger-account-cleared-regex 2
(,ledger-account-cleared-regex 2
'ledger-font-posting-account-cleared-face) ; Works
(,ledger-account-pending-regex 2
(,ledger-account-pending-regex 2
'ledger-font-posting-account-pending-face) ; Works
(,ledger-account-any-status-regex 2
(,ledger-account-any-status-regex 2
'ledger-font-posting-account-face) ; Works
(,ledger-other-entries-regex 1
(,ledger-other-entries-regex 1
'ledger-font-other-face))
"Expressions to highlight in Ledger mode.")
(defun ledger-extend-region-multiline-comment ()
"Adjusts the variables font-lock-beg and font-lock-end if they
fall within a multiline comment. Returns non-nil if an
adjustment is made."
(let (beg end)
;; fix beg
(save-excursion
(goto-char font-lock-beg)
(end-of-line)
(when (re-search-backward ledger-multiline-comment-start-regex nil t)
(setq beg (point))
(re-search-forward ledger-multiline-comment-regex nil t)
(if (and (>= (point) font-lock-beg)
(/= beg font-lock-beg))
(setq font-lock-beg beg)
(setq beg nil))))
;; fix end
(save-excursion
(goto-char font-lock-end)
(end-of-line)
(when (re-search-backward ledger-multiline-comment-start-regex nil t)
(re-search-forward ledger-multiline-comment-regex nil t)
(setq end (point))
(if (> end font-lock-end)
(setq font-lock-end end)
(setq end nil))))
(or beg end)))
(provide 'ldg-fonts)

3
lisp/ldg-mode.el
View file

@ -124,8 +124,7 @@ Can indent, complete or align depending on context."
(set (make-local-variable 'font-lock-defaults)
'(ledger-font-lock-keywords nil t)))
(setq font-lock-extend-region-functions
(list #'font-lock-extend-region-wholelines
#'ledger-extend-region-multiline-comment))
(list #'font-lock-extend-region-wholelines))
(setq font-lock-multiline nil)
(set (make-local-variable 'pcomplete-parse-arguments-function)