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

Fix payees and accounts matching to themselves

Browse source 
This would sometimes cause a double tab to be necessary for completion,
although did also provide an accidental "feature" that repeated tabs would
cycle all the way back to the original input
This commit is contained in:
George Kettleborough 2013-04-16 16:12:30 +01:00
parent 2c07d4152a
commit a052898b60
1 changed files with 56 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

108
lisp/ldg-complete.el
View file

@ -122,18 +122,19 @@ Return list."
(setq prefix (concat prefix (and prefix ":") (setq prefix (concat prefix (and prefix ":")
(car elements)) (car elements))
root (cdr xact)) root (cdr xact))
(setq root nil elements nil))) (setq root nil elements nil)))
(setq elements (cdr elements))) (setq elements (cdr elements)))
(setq root (delete (list (car elements) t) root))
(and root (and root
(sort (sort
(mapcar (function (mapcar (function
(lambda (x) (lambda (x)
(let ((term (if prefix (let ((term (if prefix
(concat prefix ":" (car x)) (concat prefix ":" (car x))
(car x)))) (car x))))
(if (> (length (cdr x)) 1) (if (> (length (cdr x)) 1)
(concat term ":") (concat term ":")
term)))) term))))
(cdr root)) (cdr root))
'string-lessp)))) 'string-lessp))))
@ -144,21 +145,24 @@ Return list."
(if (eq (save-excursion (if (eq (save-excursion
(ledger-thing-at-point)) 'transaction) (ledger-thing-at-point)) 'transaction)
(if (null current-prefix-arg) (if (null current-prefix-arg)
(ledger-payees-in-buffer) ;; this completes against payee names (delete
(progn (caar (ledger-parse-arguments))
(let ((text (buffer-substring-no-properties (line-beginning-position) (ledger-payees-in-buffer)) ;; this completes against payee names
(line-end-position)))) (progn
(delete-region (line-beginning-position) (let ((text (buffer-substring-no-properties
(line-end-position)) (line-beginning-position)
(condition-case nil (line-end-position))))
(ledger-add-transaction text t) (delete-region (line-beginning-position)
(error nil))) (line-end-position))
(forward-line) (condition-case nil
(goto-char (line-end-position)) (ledger-add-transaction text t)
(search-backward ";" (line-beginning-position) t) (error nil)))
(skip-chars-backward " \t0123456789.,") (forward-line)
(throw 'pcompleted t))) (goto-char (line-end-position))
(ledger-accounts))))) (search-backward ";" (line-beginning-position) t)
(skip-chars-backward " \t0123456789.,")
(throw 'pcompleted t)))
(ledger-accounts)))))
(defun ledger-fully-complete-xact () (defun ledger-fully-complete-xact ()
"Completes a transaction if there is another matching payee in the buffer. "Completes a transaction if there is another matching payee in the buffer.
@ -203,43 +207,43 @@ ledger-magic-tab in the previous commands list so that
ledger-magic-tab would cycle properly" ledger-magic-tab would cycle properly"
(interactive "p") (interactive "p")
(if (and interactively (if (and interactively
pcomplete-cycle-completions pcomplete-cycle-completions
pcomplete-current-completions pcomplete-current-completions
(memq last-command '(ledger-magic-tab (memq last-command '(ledger-magic-tab
ledger-pcomplete ledger-pcomplete
pcomplete-expand-and-complete pcomplete-expand-and-complete
pcomplete-reverse))) pcomplete-reverse)))
(progn (progn
(delete-backward-char pcomplete-last-completion-length) (delete-backward-char pcomplete-last-completion-length)
(if (eq this-command 'pcomplete-reverse) (if (eq this-command 'pcomplete-reverse)
(progn (progn
(push (car (last pcomplete-current-completions)) (push (car (last pcomplete-current-completions))
pcomplete-current-completions) pcomplete-current-completions)
(setcdr (last pcomplete-current-completions 2) nil)) (setcdr (last pcomplete-current-completions 2) nil))
(nconc pcomplete-current-completions (nconc pcomplete-current-completions
(list (car pcomplete-current-completions))) (list (car pcomplete-current-completions)))
(setq pcomplete-current-completions (setq pcomplete-current-completions
(cdr pcomplete-current-completions))) (cdr pcomplete-current-completions)))
(pcomplete-insert-entry pcomplete-last-completion-stub (pcomplete-insert-entry pcomplete-last-completion-stub
(car pcomplete-current-completions) (car pcomplete-current-completions)
nil pcomplete-last-completion-raw)) nil pcomplete-last-completion-raw))
(setq pcomplete-current-completions nil (setq pcomplete-current-completions nil
pcomplete-last-completion-raw nil) pcomplete-last-completion-raw nil)
(catch 'pcompleted (catch 'pcompleted
(let* ((pcomplete-stub) (let* ((pcomplete-stub)
pcomplete-seen pcomplete-norm-func pcomplete-seen pcomplete-norm-func
pcomplete-args pcomplete-last pcomplete-index pcomplete-args pcomplete-last pcomplete-index
(pcomplete-autolist pcomplete-autolist) (pcomplete-autolist pcomplete-autolist)
(pcomplete-suffix-list pcomplete-suffix-list) (pcomplete-suffix-list pcomplete-suffix-list)
(completions (pcomplete-completions)) (completions (pcomplete-completions))
(result (pcomplete-do-complete pcomplete-stub completions))) (result (pcomplete-do-complete pcomplete-stub completions)))
(and result (and result
(not (eq (car result) 'listed)) (not (eq (car result) 'listed))
(cdr result) (cdr result)
(pcomplete-insert-entry pcomplete-stub (cdr result) (pcomplete-insert-entry pcomplete-stub (cdr result)
(memq (car result) (memq (car result)
'(sole shortest)) '(sole shortest))
pcomplete-last-completion-raw)))))) pcomplete-last-completion-raw))))))
(provide 'ldg-complete) (provide 'ldg-complete)