diff options
| -rw-r--r-- | lisp/ChangeLog | 21 | ||||
| -rw-r--r-- | lisp/comint.el | 160 | ||||
| -rw-r--r-- | lisp/pcmpl-unix.el | 4 | ||||
| -rw-r--r-- | lisp/pcomplete.el | 145 |
4 files changed, 133 insertions, 197 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8a21f5966c7..dc56bf3c1e2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -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. diff --git a/lisp/comint.el b/lisp/comint.el index 10981675971..2f8d7bd850c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -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 diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el index 3af22c82dfb..ae4bd270b09 100644 --- a/lisp/pcmpl-unix.el +++ b/lisp/pcmpl-unix.el @@ -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. diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index cad2ffb2a2c..c9961a67f3d 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -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. - -(defvar pcomplete-unquote-argument-function nil) - -(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)))) - -(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)))))) - -;; 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 +;; 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 #'comint--unquote-argument) + +(defsubst pcomplete-unquote-argument (s) + (funcall pcomplete-unquote-argument-function s)) + +(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)))) + (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. |