1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-22 07:09:54 +00:00

Use completion-table-with-quoting for comint and pcomplete.

* lisp/comint.el (comint--unquote&requote-argument)
(comint--unquote-argument, comint--requote-argument): New functions.
(comint--unquote&expand-filename, comint-unquote-filename): Obsolete.
(comint-quote-filename): Use regexp-opt-charset.
(comint--common-suffix, comint--common-quoted-suffix)
(comint--table-subvert): Remove.
(comint-unquote-function, comint-requote-function): New vars.
(comint--complete-file-name-data): Use them with
completion-table-with-quoting.
* lisp/pcmpl-unix.el (pcomplete/scp): Use completion-table-subvert.
* lisp/pcomplete.el (pcomplete-arg-quote-list)
(pcomplete-quote-arg-hook, pcomplete-quote-argument): Obsolete.
(pcomplete-unquote-argument-function): Default to non-nil.
(pcomplete-unquote-argument): Simplify.
(pcomplete--common-quoted-suffix): Remove.
(pcomplete-requote-argument-function): New var.
(pcomplete--common-suffix): New function.
(pcomplete-completions-at-point): Use completion-table-with-quoting
and completion-table-subvert.
This commit is contained in:
Stefan Monnier 2012-04-25 14:53:57 -04:00
parent 79c4eeb450
commit b4ff4f1fcb
4 changed files with 129 additions and 193 deletions

View File

@ -1,5 +1,26 @@
2012-04-25 Stefan Monnier <monnier@iro.umontreal.ca>
Use completion-table-with-quoting for comint and pcomplete.
* comint.el (comint--unquote&requote-argument)
(comint--unquote-argument, comint--requote-argument): New functions.
(comint--unquote&expand-filename, comint-unquote-filename): Obsolete.
(comint-quote-filename): Use regexp-opt-charset.
(comint--common-suffix, comint--common-quoted-suffix)
(comint--table-subvert): Remove.
(comint-unquote-function, comint-requote-function): New vars.
(comint--complete-file-name-data): Use them with
completion-table-with-quoting.
* pcmpl-unix.el (pcomplete/scp): Use completion-table-subvert.
* pcomplete.el (pcomplete-arg-quote-list)
(pcomplete-quote-arg-hook, pcomplete-quote-argument): Obsolete.
(pcomplete-unquote-argument-function): Default to non-nil.
(pcomplete-unquote-argument): Simplify.
(pcomplete--common-quoted-suffix): Remove.
(pcomplete-requote-argument-function): New var.
(pcomplete--common-suffix): New function.
(pcomplete-completions-at-point): Use completion-table-with-quoting
and completion-table-subvert.
* minibuffer.el: Use completion-table-with-quoting for read-file-name.
(minibuffer--double-dollars): Preserve properties.
(completion--sifn-requote): New function.

View File

@ -104,6 +104,7 @@
(eval-when-compile (require 'cl))
(require 'ring)
(require 'ansi-color)
(require 'regexp-opt) ;For regexp-opt-charset.
;; Buffer Local Variables:
;;============================================================================
@ -3000,26 +3001,62 @@ interpreter (e.g., the percent notation of cmd.exe on Windows)."
See `comint-word'."
(comint-word comint-file-name-chars))
(defun comint--unquote&expand-filename (filename)
;; FIXME: The code below does unquote-then-expand which means that "\\$HOME"
;; gets expanded to the same as "$HOME"
(comint-substitute-in-file-name
(comint-unquote-filename filename)))
(defun comint--unquote&requote-argument (qstr &optional upos)
(unless upos (setq upos 0))
(let* ((qpos 0)
(dquotes nil)
(ustrs '())
(re (concat
"[\"']\\|\\\\\\(.\\)"
"\\|\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
"\\|{\\(?2:[^{}]+\\)}\\)"
(when (memq system-type '(ms-dos windows-nt))
"\\|%\\(?2:[^\\\\/]*\\)%")))
(qupos nil)
(push (lambda (str end)
(push str ustrs)
(setq upos (- upos (length str)))
(unless (or qupos (> upos 0))
(setq qupos (if (< end 0) (- end) (+ upos end))))))
match)
(while (setq match (string-match re qstr qpos))
(funcall push (substring qstr qpos match) match)
(cond
((match-beginning 1) (funcall push (match-string 1 qstr) (match-end 0)))
((match-beginning 2) (funcall push (getenv (match-string 2 qstr))
(- (match-end 0))))
((eq (aref qstr match) ?\") (setq dquotes (not dquotes)))
((eq (aref qstr match) ?\')
(cond
(dquotes (funcall push "'" (match-end 0)))
((< match (1+ (length qstr)))
(let ((end (string-match "'" qstr (1+ match))))
(funcall push (substring qstr (1+ match) end)
(or end (length qstr)))))
(t nil)))
(t (error "Unexpected case in comint--unquote&requote-argument!")))
(setq qpos (match-end 0)))
(funcall push (substring qstr qpos) (length qstr))
(list (mapconcat #'identity (nreverse ustrs) "")
qupos #'comint-quote-filename)))
(defun comint--unquote-argument (str)
(car (comint--unquote&requote-argument str)))
(define-obsolete-function-alias 'comint--unquote&expand-filename
#'comint--unquote-argument "24.2")
(defun comint-match-partial-filename ()
"Return the unquoted&expanded filename at point, or nil if none is found.
Environment variables are substituted. See `comint-word'."
(let ((filename (comint--match-partial-filename)))
(and filename (comint--unquote&expand-filename filename))))
(and filename (comint--unquote-argument filename))))
(defun comint-quote-filename (filename)
"Return FILENAME with magic characters quoted.
Magic characters are those in `comint-file-name-quote-list'."
(if (null comint-file-name-quote-list)
filename
(let ((regexp
(format "[%s]"
(mapconcat 'char-to-string comint-file-name-quote-list ""))))
(let ((regexp (regexp-opt-charset comint-file-name-quote-list)))
(save-match-data
(let ((i 0))
(while (string-match regexp filename i)
@ -3033,6 +3070,12 @@ Magic characters are those in `comint-file-name-quote-list'."
filename
(save-match-data
(replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t))))
(make-obsolete 'comint-unquote-filename nil "24.2")
(defun comint--requote-argument (upos qstr)
;; See `completion-table-with-quoting'.
(let ((res (comint--unquote&requote-argument qstr upos)))
(cons (nth 1 res) (nth 2 res))))
(defun comint-completion-at-point ()
(run-hook-with-args-until-success 'comint-dynamic-complete-functions))
@ -3066,87 +3109,6 @@ Returns t if successful."
(when (comint--match-partial-filename)
(comint--complete-file-name-data)))
;; FIXME: comint--common-suffix, comint--common-quoted-suffix, and
;; 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))))
;; Since S2 is expected to be the "unquoted/expanded" version of S1,
;; there shouldn't be any case difference, even if the completion is
;; case-insensitive.
(let ((case-fold-search nil))
(string-match ".*?\\(.*\\)\n.*\\1\\'" (concat s1 "\n" s2))
(- (match-end 1) (match-beginning 1))))
(defun comint--common-quoted-suffix (s1 s2)
;; FIXME: Copied in pcomplete.el.
"Find the common suffix between S1 and S2 where S1 is the expanded S2.
S1 is expected to be the unquoted and expanded version of S2.
Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that
S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and
SS1 = (unquote SS2)."
(let* ((cs (comint--common-suffix s1 s2))
(ss1 (substring s1 (- (length s1) cs)))
(qss1 (comint-quote-filename ss1))
qc s2b)
(if (and (not (equal ss1 qss1))
(setq qc (comint-quote-filename (substring ss1 0 1)))
(setq s2b (- (length s2) cs (length qc) -1))
(>= s2b 0) ;bug#11158.
(eq t (compare-strings s2 s2b (- (length s2) cs -1)
qc nil nil)))
;; The difference found is just that one char is quoted in S2
;; but not in S1, keep looking before this difference.
(comint--common-quoted-suffix
(substring s1 0 (- (length s1) cs))
(substring s2 0 s2b))
(cons (substring s1 0 (- (length s1) cs))
(substring s2 0 (- (length s2) cs))))))
(defun comint--table-subvert (table s1 s2 &optional quote-fun unquote-fun)
"Completion table that replaces the prefix S1 with S2 in STRING.
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)."
(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))
(if quote-fun (mapcar quote-fun res) res)
(let ((re (concat "\\`"
(regexp-quote (substring s2 (car bounds))))))
(delq nil
(mapcar (lambda (c)
(if (string-match re c)
(let ((str (substring c (match-end 0))))
(if quote-fun
(funcall quote-fun str) str))))
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))
(completion-file-name-table string pred action)
@ -3165,6 +3127,13 @@ the form (concat S2 S)."
res)))
(t (completion-file-name-table string pred action)))))
(defvar comint-unquote-function #'comint--unquote-argument
"Function to use for completion of quoted data.
See `completion-table-with-quoting' and `comint-requote-function'.")
(defvar comint-requote-function #'comint--requote-argument
"Function to use for completion of quoted data.
See `completion-table-with-quoting' and `comint-requote-function'.")
(defun comint--complete-file-name-data ()
"Return the completion data for file name at point."
(let* ((filesuffix (cond ((not comint-completion-addsuffix) "")
@ -3175,14 +3144,11 @@ the form (concat S2 S)."
(filename (comint--match-partial-filename))
(filename-beg (if filename (match-beginning 0) (point)))
(filename-end (if filename (match-end 0) (point)))
(unquoted (if filename (comint--unquote&expand-filename filename) ""))
(table
(let ((prefixes (comint--common-quoted-suffix
unquoted filename)))
(comint--table-subvert
#'comint-completion-file-name-table
(cdr prefixes) (car prefixes)
#'comint-quote-filename #'comint-unquote-filename))))
(completion-table-with-quoting
#'comint-completion-file-name-table
comint-unquote-function
comint-requote-function)))
(nconc
(list
filename-beg filename-end

View File

@ -205,8 +205,8 @@ Includes files as well as host names followed by a colon."
;; Avoid connecting to the remote host when we're
;; only completing the host name.
(list string)
(comint--table-subvert (pcomplete-all-entries)
"" "/ssh:")))
(completion-table-subvert (pcomplete-all-entries)
"" "/ssh:")))
((string-match "/" string) ; Local file name.
(pcomplete-all-entries))
(t ;Host name or local file name.

View File

@ -165,22 +165,8 @@ A non-nil value is useful if `pcomplete-autolist' is non-nil too."
:type 'boolean
:group 'pcomplete)
(defcustom pcomplete-arg-quote-list nil
"List of characters to quote when completing an argument."
:type '(choice (repeat character)
(const :tag "Don't quote" nil))
:group 'pcomplete)
(defcustom pcomplete-quote-arg-hook nil
"A hook which is run to quote a character within a filename.
Each function is passed both the filename to be quoted, and the index
to be considered. If the function wishes to provide an alternate
quoted form, it need only return the replacement string. If no
function provides a replacement, quoting shall proceed as normal,
using a backslash to quote any character which is a member of
`pcomplete-arg-quote-list'."
:type 'hook
:group 'pcomplete)
(define-obsolete-variable-alias
'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.2")
(defcustom pcomplete-man-function 'man
"A function to that will be called to display a manual page.
@ -370,48 +356,28 @@ 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 comint--table-subvert try to
;; work around this difficulty with heuristics, but it's
;; really a hack.
;; pcomplete--common-suffix and completion-table-subvert try to work around
;; this difficulty with heuristics, but it's really a hack.
(defvar pcomplete-unquote-argument-function nil)
(defvar pcomplete-unquote-argument-function #'comint--unquote-argument)
(defun pcomplete-unquote-argument (s)
(cond
(pcomplete-unquote-argument-function
(funcall pcomplete-unquote-argument-function s))
((null pcomplete-arg-quote-list) s)
(t
(replace-regexp-in-string "\\\\\\(.\\)" "\\1" s t))))
(defsubst pcomplete-unquote-argument (s)
(funcall pcomplete-unquote-argument-function s))
(defun pcomplete--common-quoted-suffix (s1 s2)
;; FIXME: Copied in comint.el.
"Find the common suffix between S1 and S2 where S1 is the expanded S2.
S1 is expected to be the unquoted and expanded version of S2.
Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that
S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and
SS1 = (unquote SS2)."
(let* ((cs (comint--common-suffix s1 s2))
(ss1 (substring s1 (- (length s1) cs)))
(qss1 (pcomplete-quote-argument ss1))
qc s2b)
(if (and (not (equal ss1 qss1))
(setq qc (pcomplete-quote-argument (substring ss1 0 1)))
(setq s2b (- (length s2) cs (length qc) -1))
(>= s2b 0) ;bug#11158.
(eq t (compare-strings s2 s2b (- (length s2) cs -1)
qc nil nil)))
;; The difference found is just that one char is quoted in S2
;; but not in S1, keep looking before this difference.
(pcomplete--common-quoted-suffix
(substring s1 0 (- (length s1) cs))
(substring s2 0 s2b))
(cons (substring s1 0 (- (length s1) cs))
(substring s2 0 (- (length s2) cs))))))
(defvar pcomplete-requote-argument-function #'comint--requote-argument)
(defun pcomplete--common-suffix (s1 s2)
;; Since S2 is expected to be the "unquoted/expanded" version of S1,
;; there shouldn't be any case difference, even if the completion is
;; case-insensitive.
(let ((case-fold-search nil))
(string-match
;; \x3FFF7F is just an arbitrary char among the ones Emacs accepts
;; that hopefully will never appear in normal text.
"\\(?:.\\|\n\\)*?\\(\\(?:.\\|\n\\)*\\)\x3FFF7F\\(?:.\\|\n\\)*\\1\\'"
(concat s1 "\x3FFF7F" s2))
(- (match-end 1) (match-beginning 1))))
;; 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
(defun pcomplete-completions-at-point ()
"Provide standard completion using pcomplete's completion tables.
Same as `pcomplete' but using the standard completion UI."
@ -442,34 +408,31 @@ 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 comint--table-subvert to construct a completion
;; use completion-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.
(beg (max (- (point) (length pcomplete-stub))
(pcomplete-begin)))
(buftext (buffer-substring beg (point))))
(buftext (pcomplete-unquote-argument
(buffer-substring beg (point)))))
(when completions
(let ((table
(cond
((not (equal pcomplete-stub buftext))
;; 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).
(let ((prefixes (pcomplete--common-quoted-suffix
(completion-table-with-quoting
(if (equal pcomplete-stub buftext)
completions
;; This may not always be strictly right, 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).
(let ((suf-len (pcomplete--common-suffix
pcomplete-stub buftext)))
(comint--table-subvert
completions (cdr prefixes) (car prefixes)
#'pcomplete-quote-argument #'pcomplete-unquote-argument)))
(t
(lambda (string pred action)
(let ((res (complete-with-action
action completions string pred)))
(if (stringp res)
(pcomplete-quote-argument res)
res))))))
(completion-table-subvert
completions
(substring buftext 0 (- (length buftext) suf-len))
(substring pcomplete-stub 0
(- (length pcomplete-stub) suf-len)))))
pcomplete-unquote-argument-function
pcomplete-requote-argument-function))
(pred
;; Pare it down, if applicable.
(when (and pcomplete-use-paring pcomplete-seen)
@ -828,22 +791,8 @@ this is `comint-dynamic-complete-functions'."
(throw 'pcompleted t)
pcomplete-args))))))
(defun pcomplete-quote-argument (filename)
"Return FILENAME with magic characters quoted.
Magic characters are those in `pcomplete-arg-quote-list'."
(if (null pcomplete-arg-quote-list)
filename
(let ((index 0))
(mapconcat (lambda (c)
(prog1
(or (run-hook-with-args-until-success
'pcomplete-quote-arg-hook filename index)
(when (memq c pcomplete-arg-quote-list)
(string ?\\ c))
(char-to-string c))
(setq index (1+ index))))
filename
""))))
(define-obsolete-function-alias
'pcomplete-quote-argument #'comint-quote-filename "24.2")
;; file-system completion lists
@ -1179,14 +1128,14 @@ Returns non-nil if a space was appended at the end."
(if (not pcomplete-ignore-case)
(insert-and-inherit (if raw-p
(substring entry (length stub))
(pcomplete-quote-argument
(comint-quote-filename
(substring entry (length stub)))))
;; the stub is not quoted at this time, so to determine the
;; 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-char (- (length (pcomplete-quote-argument stub))))
(delete-char (- (length (comint-quote-filename stub))))
;; if there is already a backslash present to handle the first
;; character, don't bother quoting it
(when (eq (char-before) ?\\)
@ -1194,7 +1143,7 @@ Returns non-nil if a space was appended at the end."
(setq entry (substring entry 1)))
(insert-and-inherit (if raw-p
entry
(pcomplete-quote-argument entry))))
(comint-quote-filename entry))))
(let (space-added)
(when (and (not (memq (char-before) pcomplete-suffix-list))
addsuffix)
@ -1204,7 +1153,7 @@ Returns non-nil if a space was appended at the end."
pcomplete-last-completion-stub stub)
space-added)))
;; selection of completions
;; Selection of completions.
(defun pcomplete-do-complete (stub completions)
"Dynamically complete at point using STUB and COMPLETIONS.