Mercurial > emacs
changeset 105709:e044a3c6a7e6
Allow the use of completion-tables.
(pcomplete-std-complete): New command.
(pcomplete-dirs-or-entries): Use a single call to pcomplete-entries.
(pcomplete--here): Use a function for `form' rather than an expression,
so it can be byte-compiled.
(pcomplete-here, pcomplete-here*): Adjust accordingly.
Add edebug declaration.
(pcomplete-show-completions): Remove unused var `curbuf'.
(pcomplete-do-complete, pcomplete-stub):
Don't assume `completions' is a list of strings any more.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Thu, 22 Oct 2009 15:17:48 +0000 |
| parents | 911f2739a953 |
| children | eb03599b0d98 |
| files | lisp/ChangeLog lisp/pcomplete.el |
| diffstat | 2 files changed, 185 insertions(+), 136 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Thu Oct 22 09:42:22 2009 +0000 +++ b/lisp/ChangeLog Thu Oct 22 15:17:48 2009 +0000 @@ -1,3 +1,16 @@ +2009-10-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * pcomplete.el: Allow the use of completion-tables. + (pcomplete-std-complete): New command. + (pcomplete-dirs-or-entries): Use a single call to pcomplete-entries. + (pcomplete--here): Use a function for `form' rather than an expression, + so it can be byte-compiled. + (pcomplete-here, pcomplete-here*): Adjust accordingly. + Add edebug declaration. + (pcomplete-show-completions): Remove unused var `curbuf'. + (pcomplete-do-complete, pcomplete-stub): + Don't assume `completions' is a list of strings any more. + 2009-10-22 Juanma Barranquero <lekktu@gmail.com> * find-dired.el (find-name-arg): Fix typo in docstring.
--- a/lisp/pcomplete.el Thu Oct 22 09:42:22 2009 +0000 +++ b/lisp/pcomplete.el Thu Oct 22 15:17:48 2009 +0000 @@ -60,8 +60,9 @@ ;; it means no completions were available. ;; ;; @ In order to provide completions, they must throw the tag -;; `pcomplete-completions'. The value must be the list of possible -;; completions for the final argument. +;; `pcomplete-completions'. The value must be a completion table +;; (i.e. a table that can be passed to try-completion and friends) +;; for the final argument. ;; ;; @ To simplify completion function logic, the tag `pcompleted' may ;; be thrown with a value of nil in order to abort the function. It @@ -118,7 +119,7 @@ ;;; Code: -(provide 'pcomplete) +(eval-when-compile (require 'cl)) (defgroup pcomplete nil "Programmable completion." @@ -373,7 +374,7 @@ (setq pcomplete-current-completions (cdr pcomplete-current-completions))) (pcomplete-insert-entry pcomplete-last-completion-stub - (car pcomplete-current-completions) + (car pcomplete-current-completions) nil pcomplete-last-completion-raw)) (setq pcomplete-current-completions nil pcomplete-last-completion-raw nil) @@ -393,6 +394,41 @@ '(sole shortest)) pcomplete-last-completion-raw)))))) +(defun pcomplete-std-complete () + "Provide standard completion using pcomplete's completion tables. +Same as `pcomplete' but using the standard completion UI." + (interactive) + ;; FIXME: it fails to unquote/requote the arguments. + ;; FIXME: it doesn't implement paring. + ;; FIXME: when we bring up *Completions* we never bring it back down. + (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) + ;; Apparently the vars above are global vars modified by + ;; side-effects, whereas pcomplete-completions is the core + ;; function that finds the chunk of text to complete + ;; (returned indirectly in pcomplete-stub) and the set of + ;; possible completions. + (completions (pcomplete-completions)) + ;; The pcomplete code seems to presume that pcomplete-stub + ;; is always the text before point. + (ol (make-overlay (- (point) (length pcomplete-stub)) + (point) nil nil t)) + (minibuffer-completion-table + ;; Add a space at the end of completion. Use a terminator-regexp + ;; that never matches since the terminator cannot appear + ;; within the completion field anyway. + (apply-partially 'completion-table-with-terminator + '(" " . "\\`a\\`") completions)) + (minibuffer-completion-predicate nil)) + (overlay-put ol 'field 'pcomplete) + (unwind-protect + (call-interactively 'minibuffer-complete) + (delete-overlay ol))))) + ;;;###autoload (defun pcomplete-reverse () "If cycling completion is in use, cycle backwards." @@ -424,12 +460,12 @@ (pcomplete-expand-only-p t)) (pcomplete) (when (and pcomplete-current-completions - (> (length pcomplete-current-completions) 0)) + (> (length pcomplete-current-completions) 0)) ;?? (delete-backward-char pcomplete-last-completion-length) (while pcomplete-current-completions (unless (pcomplete-insert-entry "" (car pcomplete-current-completions) t - pcomplete-last-completion-raw) + pcomplete-last-completion-raw) (insert-and-inherit pcomplete-termination-string)) (setq pcomplete-current-completions (cdr pcomplete-current-completions)))))) @@ -599,7 +635,7 @@ ;;;###autoload (defun pcomplete-shell-setup () - "Setup shell-mode to use pcomplete." + "Setup `shell-mode' to use pcomplete." (pcomplete-comint-setup 'shell-dynamic-complete-functions)) (declare-function comint-bol "comint" (&optional arg)) @@ -699,13 +735,15 @@ (defsubst pcomplete-dirs-or-entries (&optional regexp predicate) "Return either directories, or qualified entries." - (append (let ((pcomplete-stub pcomplete-stub)) - (pcomplete-entries - regexp (or predicate - (function - (lambda (path) - (not (file-directory-p path))))))) - (pcomplete-entries nil 'file-directory-p))) + ;; FIXME: pcomplete-entries doesn't return a list any more. + (pcomplete-entries + nil + (lexical-let ((re regexp) + (pred predicate)) + (lambda (f) + (or (file-directory-p f) + (and (if (not re) t (string-match re f)) + (if (not pred) t (funcall pred f)))))))) (defun pcomplete-entries (&optional regexp predicate) "Complete against a list of directory candidates. @@ -873,7 +911,7 @@ (setq pcomplete-seen nil) (unless (eq paring t) (let ((arg (pcomplete-arg))) - (unless (not (stringp arg)) + (when (stringp arg) (setq pcomplete-seen (cons (if paring (funcall paring arg) @@ -891,12 +929,17 @@ (setq pcomplete-norm-func (or paring 'file-truename))) (unless form-only (run-hooks 'pcomplete-try-first-hook)) - (throw 'pcomplete-completions (eval form)))) + (throw 'pcomplete-completions + (if (functionp form) + (funcall form) + ;; Old calling convention, might still be used by files + ;; byte-compiled with the older code. + (eval form))))) (defmacro pcomplete-here (&optional form stub paring form-only) "Complete against the current argument, if at the end. -If completion is to be done here, evaluate FORM to generate the list -of strings which will be used for completion purposes. If STUB is a +If completion is to be done here, evaluate FORM to generate the completion +table which will be used for completion purposes. If STUB is a string, use it as the completion stub instead of the default (which is the entire text of the current argument). @@ -904,7 +947,7 @@ argument text is 'long-path-name/', you don't want the completions list display to be cluttered by 'long-path-name/' appearing at the beginning of every alternative. Not only does this make things less -intelligle, but it is also inefficient. Yet, if the completion list +intelligible, but it is also inefficient. Yet, if the completion list does not begin with this string for every entry, the current argument won't complete correctly. @@ -923,11 +966,14 @@ If FORM-ONLY is non-nil, only the result of FORM will be used to generate the completions list. This means that the hook `pcomplete-try-first-hook' will not be run." - `(pcomplete--here (quote ,form) ,stub ,paring ,form-only)) + (declare (debug t)) + `(pcomplete--here (lambda () ,form) ,stub ,paring ,form-only)) + (defmacro pcomplete-here* (&optional form stub form-only) "An alternate form which does not participate in argument paring." - `(pcomplete-here ,form ,stub t ,form-only)) + (declare (debug t)) + `(pcomplete-here (lambda () ,form) ,stub t ,form-only)) ;; display support @@ -958,44 +1004,43 @@ (defun pcomplete-show-completions (completions) "List in help buffer sorted COMPLETIONS. Typing SPC flushes the help buffer." - (let* ((curbuf (current-buffer))) - (when pcomplete-window-restore-timer - (cancel-timer pcomplete-window-restore-timer) - (setq pcomplete-window-restore-timer nil)) - (unless pcomplete-last-window-config - (setq pcomplete-last-window-config (current-window-configuration))) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list completions)) - (message "Hit space to flush") - (let (event) - (prog1 - (catch 'done - (while (with-current-buffer (get-buffer "*Completions*") - (setq event (pcomplete-read-event))) - (cond - ((pcomplete-event-matches-key-specifier-p event ?\s) - (set-window-configuration pcomplete-last-window-config) - (setq pcomplete-last-window-config nil) - (throw 'done nil)) - ((or (pcomplete-event-matches-key-specifier-p event 'tab) - ;; Needed on a terminal - (pcomplete-event-matches-key-specifier-p event 9)) - (let ((win (or (get-buffer-window "*Completions*" 0) - (display-buffer "*Completions*" - 'not-this-window)))) - (with-selected-window win - (if (pos-visible-in-window-p (point-max)) - (goto-char (point-min)) - (scroll-up)))) - (message "")) - (t - (setq unread-command-events (list event)) - (throw 'done nil))))) - (if (and pcomplete-last-window-config - pcomplete-restore-window-delay) - (setq pcomplete-window-restore-timer - (run-with-timer pcomplete-restore-window-delay nil - 'pcomplete-restore-windows))))))) + (when pcomplete-window-restore-timer + (cancel-timer pcomplete-window-restore-timer) + (setq pcomplete-window-restore-timer nil)) + (unless pcomplete-last-window-config + (setq pcomplete-last-window-config (current-window-configuration))) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list completions)) + (message "Hit space to flush") + (let (event) + (prog1 + (catch 'done + (while (with-current-buffer (get-buffer "*Completions*") + (setq event (pcomplete-read-event))) + (cond + ((pcomplete-event-matches-key-specifier-p event ?\s) + (set-window-configuration pcomplete-last-window-config) + (setq pcomplete-last-window-config nil) + (throw 'done nil)) + ((or (pcomplete-event-matches-key-specifier-p event 'tab) + ;; Needed on a terminal + (pcomplete-event-matches-key-specifier-p event 9)) + (let ((win (or (get-buffer-window "*Completions*" 0) + (display-buffer "*Completions*" + 'not-this-window)))) + (with-selected-window win + (if (pos-visible-in-window-p (point-max)) + (goto-char (point-min)) + (scroll-up)))) + (message "")) + (t + (setq unread-command-events (list event)) + (throw 'done nil))))) + (if (and pcomplete-last-window-config + pcomplete-restore-window-delay) + (setq pcomplete-window-restore-timer + (run-with-timer pcomplete-restore-window-delay nil + 'pcomplete-restore-windows)))))) ;; insert completion at point @@ -1043,40 +1088,25 @@ (message "No completions of %s" stub) (message "No completions"))) ;; pare it down, if applicable - (if (and pcomplete-use-paring pcomplete-seen) - (let* ((arg (pcomplete-arg)) - (prefix - (file-name-as-directory - (funcall pcomplete-norm-func - (substring arg 0 (- (length arg) - (length pcomplete-stub))))))) - (setq pcomplete-seen - (mapcar 'directory-file-name pcomplete-seen)) - (let ((p pcomplete-seen)) - (while p - (add-to-list 'pcomplete-seen - (funcall pcomplete-norm-func (car p))) - (setq p (cdr p)))) - (setq completions - (mapcar - (function - (lambda (elem) - (file-relative-name elem prefix))) - (pcomplete-pare-list - (mapcar - (function - (lambda (elem) - (expand-file-name elem prefix))) - completions) - pcomplete-seen - (function - (lambda (elem) - (member (directory-file-name - (funcall pcomplete-norm-func elem)) - pcomplete-seen)))))))) + (when (and pcomplete-use-paring pcomplete-seen) + (setq pcomplete-seen + (mapcar 'directory-file-name pcomplete-seen)) + (dolist (p pcomplete-seen) + (add-to-list 'pcomplete-seen + (funcall pcomplete-norm-func p))) + (setq completions + (apply-partially 'completion-table-with-predicate + completions + (lambda (f) + (not (member + (funcall pcomplete-norm-func + (directory-file-name f)) + pcomplete-seen))) + 'strict))) ;; OK, we've got a list of completions. (if pcomplete-show-list - (pcomplete-show-completions completions) + ;; FIXME: pay attention to boundaries. + (pcomplete-show-completions (all-completions stub completions)) (pcomplete-stub stub completions)))) (defun pcomplete-stub (stub candidates &optional cycle-p) @@ -1093,43 +1123,47 @@ See also `pcomplete-filename'." (let* ((completion-ignore-case pcomplete-ignore-case) - (candidates (mapcar 'list candidates)) - (completions (all-completions stub candidates))) - (let (result entry) - (cond - ((null completions) - (if (and stub (> (length stub) 0)) - (message "No completions of %s" stub) - (message "No completions"))) - ((= 1 (length completions)) - (setq entry (car completions)) - (if (string-equal entry stub) - (message "Sole completion")) - (setq result 'sole)) - ((and pcomplete-cycle-completions - (or cycle-p - (not pcomplete-cycle-cutoff-length) - (<= (length completions) - pcomplete-cycle-cutoff-length))) - (setq entry (car completions) - pcomplete-current-completions completions)) - (t ; There's no unique completion; use longest substring - (setq entry (try-completion stub candidates)) - (cond ((and pcomplete-recexact - (string-equal stub entry) - (member entry completions)) - ;; It's not unique, but user wants shortest match. - (message "Completed shortest") - (setq result 'shortest)) - ((or pcomplete-autolist - (string-equal stub entry)) - ;; It's not unique, list possible completions. - (pcomplete-show-completions completions) - (setq result 'listed)) - (t - (message "Partially completed") - (setq result 'partial))))) - (cons result entry)))) + (completions (all-completions stub candidates)) + (entry (try-completion stub candidates)) + result) + (cond + ((null entry) + (if (and stub (> (length stub) 0)) + (message "No completions of %s" stub) + (message "No completions"))) + ((eq entry t) + (setq entry stub) + (message "Sole completion") + (setq result 'sole)) + ((= 1 (length completions)) + (setq result 'sole)) + ((and pcomplete-cycle-completions + (or cycle-p + (not pcomplete-cycle-cutoff-length) + (<= (length completions) + pcomplete-cycle-cutoff-length))) + (let ((bound (car (completion-boundaries stub candidates nil "")))) + (unless (zerop bound) + (setq completions (mapcar (lambda (c) (concat (substring stub 0 bound) c)) + completions))) + (setq entry (car completions) + pcomplete-current-completions completions))) + ((and pcomplete-recexact + (string-equal stub entry) + (member entry completions)) + ;; It's not unique, but user wants shortest match. + (message "Completed shortest") + (setq result 'shortest)) + ((or pcomplete-autolist + (string-equal stub entry)) + ;; It's not unique, list possible completions. + ;; FIXME: pay attention to boundaries. + (pcomplete-show-completions completions) + (setq result 'listed)) + (t + (message "Partially completed") + (setq result 'partial))) + (cons result entry))) ;; context sensitive help @@ -1194,14 +1228,16 @@ ;; create a set of aliases which allow completion functions to be not ;; quite so verbose -;; jww (1999-10-20): are these a good idea? -; (defalias 'pc-here 'pcomplete-here) -; (defalias 'pc-test 'pcomplete-test) -; (defalias 'pc-opt 'pcomplete-opt) -; (defalias 'pc-match 'pcomplete-match) -; (defalias 'pc-match-string 'pcomplete-match-string) -; (defalias 'pc-match-beginning 'pcomplete-match-beginning) -; (defalias 'pc-match-end 'pcomplete-match-end) +;;; jww (1999-10-20): are these a good idea? +;; (defalias 'pc-here 'pcomplete-here) +;; (defalias 'pc-test 'pcomplete-test) +;; (defalias 'pc-opt 'pcomplete-opt) +;; (defalias 'pc-match 'pcomplete-match) +;; (defalias 'pc-match-string 'pcomplete-match-string) +;; (defalias 'pc-match-beginning 'pcomplete-match-beginning) +;; (defalias 'pc-match-end 'pcomplete-match-end) + +(provide 'pcomplete) ;; arch-tag: ae32ef2d-dbed-4244-8b0f-cf5a2a3b07a4 ;;; pcomplete.el ends here