From 7540647f012433cfdd3217dc4b77d1b2e9c2f764 Mon Sep 17 00:00:00 2001 From: Craig Earls Date: Wed, 5 Jun 2013 16:41:11 -0700 Subject: Dramatic improvements to account completion speeds. --- lisp/ldg-complete.el | 100 ++++++++++++++++++++++++++------------------------- 1 file changed, 51 insertions(+), 49 deletions(-) (limited to 'lisp/ldg-complete.el') diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el index 4b8b3beb..1bc7588c 100644 --- a/lisp/ldg-complete.el +++ b/lisp/ldg-complete.el @@ -34,8 +34,8 @@ ;; with pcomplete. See pcomplete-parse-arguments-function for ;; details (let* ((begin (save-excursion - (ledger-thing-at-point) ;; leave point at beginning of thing under point - (point))) + (ledger-thing-at-point) ;; leave point at beginning of thing under point + (point))) (end (point)) begins args) ;; to support end of line metadata @@ -65,8 +65,8 @@ (unless (and (>= origin (match-beginning 0)) (< origin (match-end 0))) (setq payees-list (cons (match-string-no-properties 3) - payees-list))))) ;; add the payee - ;; to the list + payees-list))))) ;; add the payee + ;; to the list (pcomplete-uniqify-list (nreverse payees-list)))) @@ -75,14 +75,16 @@ (let ((origin (point)) accounts (account-tree (list t)) - (account-elements nil)) + (account-elements nil) + (seed-regex (ledger-account-any-status-with-seed-regex + (regexp-quote (car pcomplete-args))))) (save-excursion (goto-char (point-min)) (dolist (account (delete-dups (progn - (while (re-search-forward ledger-account-any-status-regex nil t) + (while (re-search-forward seed-regex nil t) (unless (between origin (match-beginning 0) (match-end 0)) (setq accounts (cons (match-string-no-properties 2) accounts)))) accounts))) @@ -127,19 +129,19 @@ Return list." (setq prefix (concat prefix (and prefix ":") (car elements)) root (cdr xact)) - (setq root nil elements nil))) + (setq root nil elements nil))) (setq elements (cdr elements))) (setq root (delete (list (car elements) t) root)) (and root (sort (mapcar (function (lambda (x) - (let ((term (if prefix - (concat prefix ":" (car x)) - (car x)))) - (if (> (length (cdr x)) 1) - (concat term ":") - term)))) + (let ((term (if prefix + (concat prefix ":" (car x)) + (car x)))) + (if (> (length (cdr x)) 1) + (concat term ":") + term)))) (cdr root)) 'string-lessp)))) @@ -153,21 +155,21 @@ Return list." (delete (caar (ledger-parse-arguments)) (ledger-payees-in-buffer)) ;; this completes against payee names - (progn - (let ((text (buffer-substring-no-properties - (line-beginning-position) - (line-end-position)))) - (delete-region (line-beginning-position) - (line-end-position)) - (condition-case nil - (ledger-add-transaction text t) - (error nil))) - (forward-line) - (goto-char (line-end-position)) - (search-backward ";" (line-beginning-position) t) - (skip-chars-backward " \t0123456789.,") - (throw 'pcompleted t))) - (ledger-accounts))))) + (progn + (let ((text (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)))) + (delete-region (line-beginning-position) + (line-end-position)) + (condition-case nil + (ledger-add-transaction text t) + (error nil))) + (forward-line) + (goto-char (line-end-position)) + (search-backward ";" (line-beginning-position) t) + (skip-chars-backward " \t0123456789.,") + (throw 'pcompleted t))) + (ledger-accounts))))) (defun ledger-fully-complete-xact () "Completes a transaction if there is another matching payee in the buffer. @@ -225,30 +227,30 @@ ledger-magic-tab would cycle properly" (push (car (last pcomplete-current-completions)) pcomplete-current-completions) (setcdr (last pcomplete-current-completions 2) nil)) - (nconc pcomplete-current-completions - (list (car pcomplete-current-completions))) - (setq pcomplete-current-completions - (cdr pcomplete-current-completions))) + (nconc pcomplete-current-completions + (list (car pcomplete-current-completions))) + (setq pcomplete-current-completions + (cdr pcomplete-current-completions))) (pcomplete-insert-entry pcomplete-last-completion-stub (car pcomplete-current-completions) nil pcomplete-last-completion-raw)) - (setq pcomplete-current-completions nil - pcomplete-last-completion-raw nil) - (catch 'pcompleted - (let* ((pcomplete-stub) - pcomplete-seen pcomplete-norm-func - pcomplete-args pcomplete-last pcomplete-index - (pcomplete-autolist pcomplete-autolist) - (pcomplete-suffix-list pcomplete-suffix-list) - (completions (pcomplete-completions)) - (result (pcomplete-do-complete pcomplete-stub completions))) - (and result - (not (eq (car result) 'listed)) - (cdr result) - (pcomplete-insert-entry pcomplete-stub (cdr result) - (memq (car result) - '(sole shortest)) - pcomplete-last-completion-raw)))))) + (setq pcomplete-current-completions nil + pcomplete-last-completion-raw nil) + (catch 'pcompleted + (let* ((pcomplete-stub) + pcomplete-seen pcomplete-norm-func + pcomplete-args pcomplete-last pcomplete-index + (pcomplete-autolist pcomplete-autolist) + (pcomplete-suffix-list pcomplete-suffix-list) + (completions (pcomplete-completions)) + (result (pcomplete-do-complete pcomplete-stub completions))) + (and result + (not (eq (car result) 'listed)) + (cdr result) + (pcomplete-insert-entry pcomplete-stub (cdr result) + (memq (car result) + '(sole shortest)) + pcomplete-last-completion-raw)))))) (provide 'ldg-complete) -- cgit v1.2.3