Commit 48feed59 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(pcomplete-common-suffix, pcomplete-table-subvert): New funs.

(pcomplete-std-complete): Use them.  Obey pcomplete-termination-string.
(pcomplete-comint-setup): Don't modify a global var via
accidental side-effects.
(pcomplete-shell-setup): Adjust call accordingly.
(pcomplete-parse-comint-arguments): Use push.
parent e8903e00
2009-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
* pcomplete.el (pcomplete-common-suffix, pcomplete-table-subvert):
New funs.
(pcomplete-std-complete): Use them. Obey pcomplete-termination-string.
(pcomplete-comint-setup): Don't modify a global var via
accidental side-effects.
(pcomplete-shell-setup): Adjust call accordingly.
(pcomplete-parse-comint-arguments): Use push.
2009-10-23 Chong Yidong <cyd@stupidchicken.com> 2009-10-23 Chong Yidong <cyd@stupidchicken.com>
* emacs-lisp/checkdoc.el (checkdoc-proper-noun-region-engine): * emacs-lisp/checkdoc.el (checkdoc-proper-noun-region-engine):
......
...@@ -139,6 +139,8 @@ ...@@ -139,6 +139,8 @@
:group 'pcomplete) :group 'pcomplete)
(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin)) (defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin))
;; FIXME: the doc mentions file-name completion, but the code
;; seems to apply it to all completions.
"If non-nil, ignore case when doing filename completion." "If non-nil, ignore case when doing filename completion."
:type 'boolean :type 'boolean
:group 'pcomplete) :group 'pcomplete)
...@@ -394,6 +396,46 @@ completion functions list (it should occur fairly early in the list)." ...@@ -394,6 +396,46 @@ completion functions list (it should occur fairly early in the list)."
'(sole shortest)) '(sole shortest))
pcomplete-last-completion-raw)))))) pcomplete-last-completion-raw))))))
(defun pcomplete-common-suffix (s1 s2)
(assert (not (or (string-match "\n" s1) (string-match "\n" s2))))
(let ((case-fold-search pcomplete-ignore-case))
(string-match ".*?\\(.*\\)\n.*\\1\\'" (concat s1 "\n" s2))
(- (match-end 1) (match-beginning 1))))
(defun pcomplete-table-subvert (table s1 s2 string pred action)
"Completion table that replaces the prefix S1 with S2 in STRING.
When TABLE, S1 and S2 are provided by `apply-partially', the result
is a completion table which completes strings of the form (concat S1 S)
in the same way as TABLE completes strings of the form (concat S2 S)."
(let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
completion-ignore-case))
(concat s2 (substring string (length s1)))))
(res (if str (complete-with-action action table str pred))))
(when res
(cond
((and (eq (car-safe action) 'boundaries))
(let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))
(list* 'boundaries
(max (length s1)
(+ beg (- (length s1) (length s2))))
(and (eq (car-safe res) 'boundaries) (cddr res)))))
((stringp res)
(if (eq t (compare-strings res 0 (length s2) s2 nil nil
completion-ignore-case))
(concat s1 (substring res (length s2)))))
((eq action t)
(let ((bounds (completion-boundaries str table pred "")))
(if (>= (car bounds) (length s2))
res
(let ((re (concat "\\`"
(regexp-quote (substring s2 (car bounds))))))
(delq nil
(mapcar (lambda (c)
(if (string-match re c)
(substring c (match-end 0))))
res))))))))))
(defun pcomplete-std-complete () (defun pcomplete-std-complete ()
"Provide standard completion using pcomplete's completion tables. "Provide standard completion using pcomplete's completion tables.
Same as `pcomplete' but using the standard completion UI." Same as `pcomplete' but using the standard completion UI."
...@@ -413,21 +455,55 @@ Same as `pcomplete' but using the standard completion UI." ...@@ -413,21 +455,55 @@ Same as `pcomplete' but using the standard completion UI."
;; (returned indirectly in pcomplete-stub) and the set of ;; (returned indirectly in pcomplete-stub) and the set of
;; possible completions. ;; possible completions.
(completions (pcomplete-completions)) (completions (pcomplete-completions))
;; The pcomplete code seems to presume that pcomplete-stub ;; Usually there's some close connection between pcomplete-stub
;; is always the text before point. ;; and the text before point. But depending on what
(ol (make-overlay (- (point) (length pcomplete-stub)) ;; pcomplete-parse-arguments-function does, that connection
(point) nil nil t)) ;; might not be that close. E.g. in eshell,
(minibuffer-completion-table ;; pcomplete-parse-arguments-function expands envvars.
;; Add a space at the end of completion. Use a terminator-regexp ;;
;; that never matches since the terminator cannot appear ;; Since we use minibuffer-complete, which doesn't know
;; within the completion field anyway. ;; pcomplete-stub and works from the buffer's text instead,
(apply-partially 'completion-table-with-terminator ;; we need to trick minibuffer-complete, into using
'(" " . "\\`a\\`") completions)) ;; pcomplete-stub without its knowledge. To that end, we
(minibuffer-completion-predicate nil)) ;; use pcomplete-table-subvert to construct a completion
(overlay-put ol 'field 'pcomplete) ;; table which expects strings using a prefix from the
(unwind-protect ;; buffer's text but internally uses the corresponding
(call-interactively 'minibuffer-complete) ;; prefix from pcomplete-stub.
(delete-overlay ol))))) (beg (max (- (point) (length pcomplete-stub))
;; Rather than `point-min' we should use the
;; beginning position of the current arg.
(point-min)))
(buftext (buffer-substring beg (point)))
;; This isn't always strictly right (e.g. if
;; FOO="toto/$FOO", then completion of /$FOO/bar may
;; result in something incorrect), but given the lack of
;; any other info, it's about as good as it gets, and in
;; practice it should work just fine (fingers crossed).
(suflen (pcomplete-common-suffix pcomplete-stub buftext)))
(unless (= suflen (length pcomplete-stub))
(setq completions
(apply-partially
'pcomplete-table-subvert
completions
(substring buftext 0 (- (length buftext) suflen))
(substring pcomplete-stub
0 (- (length pcomplete-stub) suflen)))))
(let ((ol (make-overlay beg (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.
(if (zerop (length pcomplete-termination-string))
completions
(apply-partially 'completion-table-with-terminator
(cons pcomplete-termination-string
"\\`a\\`")
completions)))
(minibuffer-completion-predicate nil))
(overlay-put ol 'field 'pcomplete)
(unwind-protect
(call-interactively 'minibuffer-complete)
(delete-overlay ol))))))
;;;###autoload ;;;###autoload
(defun pcomplete-reverse () (defun pcomplete-reverse ()
...@@ -625,7 +701,8 @@ dynamic-complete-functions are kept. For comint mode itself, ...@@ -625,7 +701,8 @@ dynamic-complete-functions are kept. For comint mode itself,
this is `comint-dynamic-complete-functions'." this is `comint-dynamic-complete-functions'."
(set (make-local-variable 'pcomplete-parse-arguments-function) (set (make-local-variable 'pcomplete-parse-arguments-function)
'pcomplete-parse-comint-arguments) 'pcomplete-parse-comint-arguments)
(make-local-variable completef-sym) (set (make-local-variable completef-sym)
(copy-sequence (symbol-value completef-sym)))
(let* ((funs (symbol-value completef-sym)) (let* ((funs (symbol-value completef-sym))
(elem (or (memq 'comint-dynamic-complete-filename funs) (elem (or (memq 'comint-dynamic-complete-filename funs)
(memq 'shell-dynamic-complete-filename funs)))) (memq 'shell-dynamic-complete-filename funs))))
...@@ -636,7 +713,7 @@ this is `comint-dynamic-complete-functions'." ...@@ -636,7 +713,7 @@ this is `comint-dynamic-complete-functions'."
;;;###autoload ;;;###autoload
(defun pcomplete-shell-setup () (defun pcomplete-shell-setup ()
"Setup `shell-mode' to use pcomplete." "Setup `shell-mode' to use pcomplete."
(pcomplete-comint-setup 'shell-dynamic-complete-functions)) (pcomplete-comint-setup 'comint-dynamic-complete-functions))
(declare-function comint-bol "comint" (&optional arg)) (declare-function comint-bol "comint" (&optional arg))
...@@ -649,17 +726,16 @@ this is `comint-dynamic-complete-functions'." ...@@ -649,17 +726,16 @@ this is `comint-dynamic-complete-functions'."
(goto-char begin) (goto-char begin)
(while (< (point) end) (while (< (point) end)
(skip-chars-forward " \t\n") (skip-chars-forward " \t\n")
(setq begins (cons (point) begins)) (push (point) begins)
(let ((skip t)) (let ((skip t))
(while skip (while skip
(skip-chars-forward "^ \t\n") (skip-chars-forward "^ \t\n")
(if (eq (char-before) ?\\) (if (eq (char-before) ?\\)
(skip-chars-forward " \t\n") (skip-chars-forward " \t\n")
(setq skip nil)))) (setq skip nil))))
(setq args (cons (buffer-substring-no-properties (push (buffer-substring-no-properties (car begins) (point))
(car begins) (point)) args))
args))) (cons (nreverse args) (nreverse begins)))))
(cons (reverse args) (reverse begins)))))
(defun pcomplete-parse-arguments (&optional expand-p) (defun pcomplete-parse-arguments (&optional expand-p)
"Parse the command line arguments. Most completions need this info." "Parse the command line arguments. Most completions need this info."
...@@ -672,9 +748,9 @@ this is `comint-dynamic-complete-functions'." ...@@ -672,9 +748,9 @@ this is `comint-dynamic-complete-functions'."
pcomplete-stub (pcomplete-arg 'last)) pcomplete-stub (pcomplete-arg 'last))
(let ((begin (pcomplete-begin 'last))) (let ((begin (pcomplete-begin 'last)))
(if (and pcomplete-cycle-completions (if (and pcomplete-cycle-completions
(listp pcomplete-stub) (listp pcomplete-stub) ;??
(not pcomplete-expand-only-p)) (not pcomplete-expand-only-p))
(let* ((completions pcomplete-stub) (let* ((completions pcomplete-stub) ;??
(common-stub (car completions)) (common-stub (car completions))
(c completions) (c completions)
(len (length common-stub))) (len (length common-stub)))
...@@ -723,9 +799,9 @@ Magic characters are those in `pcomplete-arg-quote-list'." ...@@ -723,9 +799,9 @@ Magic characters are those in `pcomplete-arg-quote-list'."
(cond (cond
(replacement (replacement
(setq result (concat result replacement))) (setq result (concat result replacement)))
((and (setq char (aref filename index)) ((memq (setq char (aref filename index))
(memq char pcomplete-arg-quote-list)) pcomplete-arg-quote-list)
(setq result (concat result "\\" (char-to-string char)))) (setq result (concat result (string "\\" char))))
(t (t
(setq result (concat result (char-to-string char))))) (setq result (concat result (char-to-string char)))))
(setq index (1+ index))) (setq index (1+ index)))
...@@ -1055,6 +1131,9 @@ Returns non-nil if a space was appended at the end." ...@@ -1055,6 +1131,9 @@ Returns non-nil if a space was appended at the end."
(substring entry (length stub))))) (substring entry (length stub)))))
;; the stub is not quoted at this time, so to determine the ;; the stub is not quoted at this time, so to determine the
;; length of what should be in the buffer, we must quote it ;; length of what should be in the buffer, we must quote it
;; FIXME: Here we presume that quoting `stub' gives us the exact
;; text in the buffer before point, which is not guaranteed;
;; e.g. it is not the case in eshell when completing ${FOO}tm[TAB].
(delete-backward-char (length (pcomplete-quote-argument stub))) (delete-backward-char (length (pcomplete-quote-argument stub)))
;; if there is already a backslash present to handle the first ;; if there is already a backslash present to handle the first
;; character, don't bother quoting it ;; character, don't bother quoting it
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment