Commit 915a9b64 authored by Stefan Monnier's avatar Stefan Monnier

* lisp/pcmpl-unix.el (pcomplete/scp): Don't assume pcomplete-all-entries

returns a list.  Add remote file name completion.
* lisp/comint.el (comint--table-subvert): Curry and get quote&unquote
functions as arguments.
(comint--complete-file-name-data): Adjust call accordingly.
* lisp/pcomplete.el (pcomplete--table-subvert): Remove.
(pcomplete-completions-at-point): Use comint--table-subvert instead.

Fixes: debbugs:9554
parent 3dc61a09
2011-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
* pcmpl-unix.el (pcomplete/scp): Don't assume pcomplete-all-entries
returns a list (bug#9554). Add remote file name completion.
* comint.el (comint--table-subvert): Curry and get quote&unquote
functions as arguments.
(comint--complete-file-name-data): Adjust call accordingly.
* pcomplete.el (pcomplete--table-subvert): Remove.
(pcomplete-completions-at-point): Use comint--table-subvert instead.
* minibuffer.el (completion-table-case-fold): Use currying.
(completion--styles-type, completion--cycling-threshold-type):
New constants.
......
......@@ -3040,8 +3040,9 @@ Returns t if successful."
(comint--complete-file-name-data)))
;; FIXME: comint--common-suffix, comint--common-quoted-suffix, and
;; comint--table-subvert copied from pcomplete. And they don't fully solve
;; the problem, since selecting a file from *Completions* won't quote it.
;; comint--table-subvert don't fully solve the problem, since
;; selecting a file from *Completions* won't quote it, among several
;; other problems.
(defun comint--common-suffix (s1 s2)
(assert (not (or (string-match "\n" s1) (string-match "\n" s2))))
......@@ -3076,43 +3077,45 @@ SS1 = (unquote SS2)."
(cons (substring s1 0 (- (length s1) cs))
(substring s2 0 (- (length s2) cs))))))
(defun comint--table-subvert (table s1 s2 string pred action)
(defun comint--table-subvert (table s1 s2 &optional quote-fun unquote-fun)
"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 (comint-unquote-filename
(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)
;; FIXME: Adjust because of quoting/unquoting.
(+ 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 (comint-quote-filename
(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))))))
;; E.g. action=nil and it's the only completion.
(res)))))
(lambda (string pred action)
(let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
completion-ignore-case))
(let ((rest (substring string (length s1))))
(concat s2 (if unquote-fun
(funcall unquote-fun rest) rest)))))
(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)
;; FIXME: Adjust because of quoting/unquoting.
(+ 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))
(let ((rest (substring res (length s2))))
(concat s1 (if quote-fun (funcall quote-fun rest) rest)))))
((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))))))
;; E.g. action=nil and it's the only completion.
(res))))))
(defun comint-completion-file-name-table (string pred action)
(if (not (file-name-absolute-p string))
......@@ -3146,10 +3149,10 @@ in the same way as TABLE completes strings of the form (concat S2 S)."
(table
(let ((prefixes (comint--common-quoted-suffix
unquoted filename)))
(apply-partially
#'comint--table-subvert
(comint--table-subvert
#'comint-completion-file-name-table
(cdr prefixes) (car prefixes)))))
(cdr prefixes) (car prefixes)
#'comint-quote-filename #'comint-unquote-filename))))
(nconc
(list
filename-beg filename-end
......
......@@ -193,10 +193,25 @@ Uses both `pcmpl-ssh-config-file' and `pcmpl-ssh-known-hosts-file'."
"Completion rules for the `scp' command.
Includes files as well as host names followed by a colon."
(pcomplete-opt "1246BCpqrvcFiloPS")
(while t (pcomplete-here (append (pcomplete-all-entries)
(mapcar (lambda (host)
(concat host ":"))
(pcmpl-ssh-hosts))))))
(while t (pcomplete-here
(lambda (string pred action)
(let ((table
(cond
((string-match "\\`[^:/]+:" string) ; Remote file name.
(if (and (eq action 'lambda)
(eq (match-end 0) (length string)))
;; Avoid connecting to the remote host when we're
;; only completing the host name.
(list string)
(comint--table-subvert (pcomplete-all-entries)
"" "/ssh:")))
((string-match "/" string) ; Local file name.
(pcomplete-all-entries))
(t ;Host name or local file name.
(append (all-completions string (pcomplete-all-entries))
(mapcar (lambda (host) (concat host ":"))
(pcmpl-ssh-hosts)))))))
(complete-with-action action table string pred))))))
(provide 'pcmpl-unix)
......
......@@ -370,7 +370,7 @@ modified to be an empty string, or the desired separation string."
;; it pretty much impossible to have completion other than
;; prefix-completion.
;;
;; pcomplete--common-quoted-suffix and pcomplete--table-subvert try to
;; pcomplete--common-quoted-suffix and comint--table-subvert try to
;; work around this difficulty with heuristics, but it's
;; really a hack.
......@@ -408,45 +408,6 @@ SS1 = (unquote SS2)."
(cons (substring s1 0 (- (length s1) cs))
(substring s2 0 (- (length s2) cs))))))
(defun pcomplete--table-subvert (table s1 s2 string pred action)
;; FIXME: Copied in comint.el.
"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 (pcomplete-unquote-argument
(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)
;; FIXME: Adjust because of quoting/unquoting.
(+ 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 (pcomplete-quote-argument
(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))))))
;; E.g. action=nil and it's the only completion.
(res)))))
;; I don't think such commands are usable before first setting up buffer-local
;; variables to parse args, so there's no point autoloading it.
;; ;;;###autoload
......@@ -480,7 +441,7 @@ Same as `pcomplete' but using the standard completion UI."
;; pcomplete-stub and works from the buffer's text instead,
;; we need to trick minibuffer-complete, into using
;; pcomplete-stub without its knowledge. To that end, we
;; use pcomplete--table-subvert to construct a completion
;; use comint--table-subvert to construct a completion
;; table which expects strings using a prefix from the
;; buffer's text but internally uses the corresponding
;; prefix from pcomplete-stub.
......@@ -498,9 +459,9 @@ Same as `pcomplete' but using the standard completion UI."
;; practice it should work just fine (fingers crossed).
(let ((prefixes (pcomplete--common-quoted-suffix
pcomplete-stub buftext)))
(apply-partially #'pcomplete--table-subvert
completions
(cdr prefixes) (car prefixes))))
(comint--table-subvert
completions (cdr prefixes) (car prefixes)
#'pcomplete-quote-argument #'pcomplete-unquote-argument)))
(t
(lambda (string pred action)
(let ((res (complete-with-action
......
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