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 ":")
(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))))
@ -144,21 +145,24 @@ Return list."
(if (eq (save-excursion
(ledger-thing-at-point)) 'transaction)
(if (null current-prefix-arg)
(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)))))
(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)))))
(defun ledger-fully-complete-xact ()
"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"
(interactive "p")
(if (and interactively
pcomplete-cycle-completions
pcomplete-current-completions
(memq last-command '(ledger-magic-tab
ledger-pcomplete
pcomplete-expand-and-complete
pcomplete-reverse)))
pcomplete-cycle-completions
pcomplete-current-completions
(memq last-command '(ledger-magic-tab
ledger-pcomplete
pcomplete-expand-and-complete
pcomplete-reverse)))
(progn
(delete-backward-char pcomplete-last-completion-length)
(if (eq this-command 'pcomplete-reverse)
(progn
(delete-backward-char pcomplete-last-completion-length)
(if (eq this-command 'pcomplete-reverse)
(progn
(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)))
(pcomplete-insert-entry pcomplete-last-completion-stub
(setcdr (last pcomplete-current-completions 2) nil))
(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))
nil pcomplete-last-completion-raw))
(setq pcomplete-current-completions nil
pcomplete-last-completion-raw 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))))))
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)