Commit ef24141c authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/minibuffer.el: Add support for completion of quoted/escaped data.

(completion-table-with-quoting, completion-table-subvert): New funs.
(completion--twq-try, completion--twq-all): New functions.
(completion--nth-completion): New function.
(completion-try-completion, completion-all-completions): Use it.
parent daf75653
...@@ -169,6 +169,14 @@ still be supported for Emacs 24.x. ...@@ -169,6 +169,14 @@ still be supported for Emacs 24.x.
* Lisp changes in Emacs 24.2 * Lisp changes in Emacs 24.2
** Completion
*** New function `completion-table-with-quoting' to handle completion
in the presence of quoting, such as file completion in shell buffers.
*** New function `completion-table-subvert' to use an existing completion
table, but with a different prefix.
* Changes in Emacs 24.2 on non-free operating systems * Changes in Emacs 24.2 on non-free operating systems
......
2012-04-25 Stefan Monnier <monnier@iro.umontreal.ca>
* minibuffer.el: Add support for completion of quoted/escaped data.
(completion-table-with-quoting, completion-table-subvert): New funs.
(completion--twq-try, completion--twq-all): New functions.
(completion--nth-completion): New function.
(completion-try-completion, completion-all-completions): Use it.
2012-04-25 Chong Yidong <cyd@gnu.org> 2012-04-25 Chong Yidong <cyd@gnu.org>
* vc/diff-mode.el (diff-setup-whitespace): New function. * vc/diff-mode.el (diff-setup-whitespace): New function.
...@@ -16,32 +24,31 @@ ...@@ -16,32 +24,31 @@
2012-04-25 Alex Harsanyi <AlexHarsanyi@gmail.com> 2012-04-25 Alex Harsanyi <AlexHarsanyi@gmail.com>
Sync with soap-client repository. Support SOAP simpleType. (Bug#10331) Sync with soap-client repository. Support SOAP simpleType (Bug#10331).
* soap-client.el (soap-resolve-references-for-sequence-type) * soap-client.el (soap-resolve-references-for-sequence-type)
(soap-resolve-references-for-array-type): hack to prevent self (soap-resolve-references-for-array-type): Hack to prevent self
references, see Bug#9. references, see Bug#9.
(soap-parse-envelope): report the contents of the 'detail' node (soap-parse-envelope): Report the contents of the 'detail' node
when receiving a fault reply. when receiving a fault reply.
(soap-parse-envelope): report the contents of the entire 'detail' (soap-parse-envelope): Report the contents of the entire 'detail' node.
node.
* soap-inspect.el (soap-sample-value-for-simple-type) * soap-inspect.el (soap-sample-value-for-simple-type)
(soap-inspect-simple-type): new function (soap-inspect-simple-type): New function.
* soap-client.el (soap-simple-type): new struct * soap-client.el (soap-simple-type): New struct.
(soap-default-xsd-types, soap-default-soapenc-types) (soap-default-xsd-types, soap-default-soapenc-types)
(soap-decode-basic-type, soap-encode-basic-type): support (soap-decode-basic-type, soap-encode-basic-type):
unsignedInt and double basic types support unsignedInt and double basic types.
(soap-resolve-references-for-simple-type) (soap-resolve-references-for-simple-type)
(soap-parse-simple-type, soap-encode-simple-type): new function (soap-parse-simple-type, soap-encode-simple-type): New function.
(soap-parse-schema): parse xsd:simpleType declarations (soap-parse-schema): Parse xsd:simpleType declarations.
* soap-client.el (soap-default-xsd-types) * soap-client.el (soap-default-xsd-types)
(soap-default-soapenc-types): add integer, byte and anyURI types (soap-default-soapenc-types): Add integer, byte and anyURI types.
(soap-parse-complex-type-complex-content): use `soap-wk2l' to find (soap-parse-complex-type-complex-content): Use `soap-wk2l' to find
the local name of "soapenc:Array" the local name of "soapenc:Array".
(soap-decode-basic-type, soap-encode-basic-type): support encoding (soap-decode-basic-type, soap-encode-basic-type): Support encoding
decoding integer, byte and anyURI xsd types. decoding integer, byte and anyURI xsd types.
2012-04-25 Chong Yidong <cyd@gnu.org> 2012-04-25 Chong Yidong <cyd@gnu.org>
...@@ -161,8 +168,8 @@ ...@@ -161,8 +168,8 @@
* ispell.el (ispell-insert-word) Remove unneeded function using * ispell.el (ispell-insert-word) Remove unneeded function using
obsolete `translation-table-for-input'. obsolete `translation-table-for-input'.
(ispell-word, ispell-process-line, ispell-complete-word): Use (ispell-word, ispell-process-line, ispell-complete-word):
plain `insert' instead of removed `ispell-insert-word'. Use plain `insert' instead of removed `ispell-insert-word'.
2012-04-22 Chong Yidong <cyd@gnu.org> 2012-04-22 Chong Yidong <cyd@gnu.org>
...@@ -180,8 +187,8 @@ ...@@ -180,8 +187,8 @@
Move functions from C to Lisp. Make non-blocking method calls Move functions from C to Lisp. Make non-blocking method calls
the default. Implement further D-Bus standard interfaces. the default. Implement further D-Bus standard interfaces.
* net/dbus.el (dbus-message-internal): Declare function. Remove * net/dbus.el (dbus-message-internal): Declare function.
unneeded function declarations. Remove unneeded function declarations.
(defvar dbus-message-type-invalid, dbus-message-type-method-call) (defvar dbus-message-type-invalid, dbus-message-type-method-call)
(dbus-message-type-method-return, dbus-message-type-error) (dbus-message-type-method-return, dbus-message-type-error)
(dbus-message-type-signal): Declare variables. Remove local (dbus-message-type-signal): Declare variables. Remove local
...@@ -197,8 +204,8 @@ ...@@ -197,8 +204,8 @@
(dbus-register-signal, dbus-register-method): New defuns, moved (dbus-register-signal, dbus-register-method): New defuns, moved
from dbusbind.c from dbusbind.c
(dbus-call-method-handler, dbus-setenv) (dbus-call-method-handler, dbus-setenv)
(dbus-get-all-managed-objects, dbus-managed-objects-handler): New (dbus-get-all-managed-objects, dbus-managed-objects-handler):
defuns. New defuns.
(dbus-call-method-non-blocking): Make it an obsolete function. (dbus-call-method-non-blocking): Make it an obsolete function.
(dbus-unregister-object, dbus-unregister-service) (dbus-unregister-object, dbus-unregister-service)
(dbus-handle-event, dbus-register-property) (dbus-handle-event, dbus-register-property)
...@@ -323,8 +330,8 @@ ...@@ -323,8 +330,8 @@
2012-04-20 Chong Yidong <cyd@gnu.org> 2012-04-20 Chong Yidong <cyd@gnu.org>
* progmodes/gdb-mi.el (gdb-inferior-io--maybe-delete-pty): New * progmodes/gdb-mi.el (gdb-inferior-io--maybe-delete-pty):
function to call delete-process on the gdb-inferior buffer's pty. New function to call delete-process on the gdb-inferior buffer's pty.
(gdb-reset): Use it, instead of relying on kill-buffer to kill the (gdb-reset): Use it, instead of relying on kill-buffer to kill the
pty process (Bug#11273). pty process (Bug#11273).
(gdb-update): New arg to suppress talking to the gdb process. (gdb-update): New arg to suppress talking to the gdb process.
...@@ -355,8 +362,8 @@ ...@@ -355,8 +362,8 @@
(c-comment-indent, c-scan-conditionals, c-indent-defun) (c-comment-indent, c-scan-conditionals, c-indent-defun)
(c-context-line-break): Bind case-fold-search to nil. (c-context-line-break): Bind case-fold-search to nil.
* progmodes/cc-mode.el (c-font-lock-fontify-region): Bind * progmodes/cc-mode.el (c-font-lock-fontify-region):
case-fold-search to nil. Bind case-fold-search to nil.
2012-04-20 Chong Yidong <cyd@gnu.org> 2012-04-20 Chong Yidong <cyd@gnu.org>
...@@ -1107,8 +1114,8 @@ ...@@ -1107,8 +1114,8 @@
2012-03-30 Agustín Martín Domingo <agustin.martin@hispalinux.es> 2012-03-30 Agustín Martín Domingo <agustin.martin@hispalinux.es>
* ispell.el (ispell-get-extended-character-mode): Disable * ispell.el (ispell-get-extended-character-mode):
extended-char-mode for hunspell. hunspell does not support it Disable extended-char-mode for hunspell. hunspell does not support it
and treats ~word as ordinary words in pipe mode. and treats ~word as ordinary words in pipe mode.
2012-03-30 Glenn Morris <rgm@gnu.org> 2012-03-30 Glenn Morris <rgm@gnu.org>
......
...@@ -45,17 +45,6 @@ ...@@ -45,17 +45,6 @@
;; corresponding to the displayed completions because we only ;; corresponding to the displayed completions because we only
;; provide the start info but not the end info in ;; provide the start info but not the end info in
;; completion-base-position. ;; completion-base-position.
;; - quoting is problematic. E.g. the double-dollar quoting used in
;; substitute-in-file-name (and hence read-file-name-internal) bumps
;; into various bugs:
;; - choose-completion doesn't know how to quote the text it inserts.
;; E.g. it fails to double the dollars in file-name completion, or
;; to backslash-escape spaces and other chars in comint completion.
;; - when completing ~/tmp/fo$$o, the highlighting in *Completions*
;; is off by one position.
;; - all code like PCM which relies on all-completions to match
;; its argument gets confused because all-completions returns unquoted
;; texts (as desired for *Completions* output).
;; - C-x C-f ~/*/sr ? should not list "~/./src". ;; - C-x C-f ~/*/sr ? should not list "~/./src".
;; - minibuffer-force-complete completes ~/src/emacs/t<!>/lisp/minibuffer.el ;; - minibuffer-force-complete completes ~/src/emacs/t<!>/lisp/minibuffer.el
;; to ~/src/emacs/trunk/ and throws away lisp/minibuffer.el. ;; to ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
...@@ -66,12 +55,9 @@ ...@@ -66,12 +55,9 @@
;; - Make things like icomplete-mode or lightning-completion work with ;; - Make things like icomplete-mode or lightning-completion work with
;; completion-in-region-mode. ;; completion-in-region-mode.
;; - extend `metadata': ;; - extend `metadata':
;; - quoting/unquoting (so we can complete files names with envvars
;; and backslashes, and all-completion can list names without
;; quoting backslashes and dollars).
;; - indicate how to turn all-completion's output into ;; - indicate how to turn all-completion's output into
;; try-completion's output: e.g. completion-ignored-extensions. ;; try-completion's output: e.g. completion-ignored-extensions.
;; maybe that could be merged with the "quote" operation above. ;; maybe that could be merged with the "quote" operation.
;; - indicate that `all-completions' doesn't do prefix-completion ;; - indicate that `all-completions' doesn't do prefix-completion
;; but just returns some list that relates in some other way to ;; but just returns some list that relates in some other way to
;; the provided string (as is the case in filecache.el), in which ;; the provided string (as is the case in filecache.el), in which
...@@ -224,6 +210,42 @@ case sensitive instead." ...@@ -224,6 +210,42 @@ case sensitive instead."
(let ((completion-ignore-case (not dont-fold))) (let ((completion-ignore-case (not dont-fold)))
(complete-with-action action table string pred)))) (complete-with-action action table string pred))))
(defun completion-table-subvert (table s1 s2)
"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))
(concat s2 (substring string (length s1)))))
(res (if str (complete-with-action action table str pred))))
(when res
(cond
((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))))))
;; E.g. action=nil and it's the only completion.
(res))))))
(defun completion-table-with-context (prefix table string pred action) (defun completion-table-with-context (prefix table string pred action)
;; TODO: add `suffix' maybe? ;; TODO: add `suffix' maybe?
(let ((pred (let ((pred
...@@ -347,6 +369,186 @@ Note: TABLE needs to be a proper completion table which obeys predicates." ...@@ -347,6 +369,186 @@ Note: TABLE needs to be a proper completion table which obeys predicates."
(complete-with-action action table string pred)) (complete-with-action action table string pred))
tables))) tables)))
(defun completion-table-with-quoting (table unquote requote)
;; A difficult part of completion-with-quoting is to map positions in the
;; quoted string to equivalent positions in the unquoted string and
;; vice-versa. There is no efficient and reliable algorithm that works for
;; arbitrary quote and unquote functions.
;; So to map from quoted positions to unquoted positions, we simply assume
;; that `concat' and `unquote' commute (which tends to be the case).
;; And we ask `requote' to do the work of mapping from unquoted positions
;; back to quoted positions.
"Return a new completion table operating on quoted text.
TABLE operates on the unquoted text.
UNQUOTE is a function that takes a string and returns a new unquoted string.
REQUOTE is a function of 2 args (UPOS QSTR) where
QSTR is a string entered by the user (and hence indicating
the user's preferred form of quoting); and
UPOS is a position within the unquoted form of QSTR.
REQUOTE should return a pair (QPOS . QFUN) such that QPOS is the
position corresponding to UPOS but in QSTR, and QFUN is a function
of one argument (a string) which returns that argument appropriately quoted
for use at QPOS."
;; FIXME: One problem with the current setup is that `qfun' doesn't know if
;; its argument is "the end of the completion", so if the quoting used double
;; quotes (for example), we end up completing "fo" to "foobar and throwing
;; away the closing double quote.
(lambda (string pred action)
(cond
((eq action 'metadata)
(append (completion-metadata string table pred)
'((completion--unquote-requote . t))))
((eq action 'lambda) ;;test-completion
(let ((ustring (funcall unquote string)))
(test-completion ustring table pred)))
((eq (car-safe action) 'boundaries)
(let* ((ustring (funcall unquote string))
(qsuffix (cdr action))
(ufull (if (zerop (length qsuffix)) ustring
(funcall unquote (concat string qsuffix))))
(_ (assert (string-prefix-p ustring ufull)))
(usuffix (substring ufull (length ustring)))
(boundaries (completion-boundaries ustring table pred usuffix))
(qlboundary (car (funcall requote (car boundaries) string)))
(qrboundary (if (zerop (cdr boundaries)) 0 ;Common case.
(let* ((urfullboundary
(+ (cdr boundaries) (length ustring))))
(- (car (funcall requote urfullboundary
(concat string qsuffix)))
(length string))))))
(list* 'boundaries qlboundary qrboundary)))
((eq action nil) ;;try-completion
(let* ((ustring (funcall unquote string))
(completion (try-completion ustring table pred)))
;; Most forms of quoting allow several ways to quote the same string.
;; So here we could simply requote `completion' in a kind of
;; "canonical" quoted form without paying attention to the way
;; `string' was quoted. But since we have to solve the more complex
;; problems of "pay attention to the original quoting" for
;; all-completions, we may as well use it here, since it provides
;; a nicer behavior.
(if (not (stringp completion)) completion
(car (completion--twq-try
string ustring completion 0 unquote requote)))))
((eq action t) ;;all-completions
;; When all-completions is used for completion-try/all-completions
;; (e.g. for `pcm' style), we can't do the job properly here because
;; the caller will match our output against some pattern derived from
;; the user's (quoted) input, and we don't have access to that
;; pattern, so we can't know how to requote our output so that it
;; matches the quoting used in the pattern. It is to fix this
;; fundamental problem that we have to introduce the new
;; unquote-requote method so that completion-try/all-completions can
;; pass the unquoted string to the style functions.
(pcase-let*
((ustring (funcall unquote string))
(completions (all-completions ustring table pred))
(boundary (car (completion-boundaries ustring table pred ""))))
(completion--twq-all
string ustring completions boundary unquote requote)))
((eq action 'completion--unquote)
(let ((ustring (funcall unquote string))
(uprefix (funcall unquote (substring string 0 pred))))
;; We presume (more or less) that `concat' and `unquote' commute.
(assert (string-prefix-p uprefix ustring))
(list ustring table (length uprefix)
(lambda (unquoted-result op)
(pcase op
(`1 ;;try
(if (not (stringp (car-safe unquoted-result)))
unquoted-result
(completion--twq-try
string ustring
(car unquoted-result) (cdr unquoted-result)
unquote requote)))
(`2 ;;all
(let* ((last (last unquoted-result))
(base (or (cdr last) 0)))
(when last
(setcdr last nil)
(completion--twq-all string ustring
unquoted-result base
unquote requote))))))))))))
(defun completion--twq-try (string ustring completion point
unquote requote)
;; Basically two case: either the new result is
;; - commonprefix1 <point> morecommonprefix <qpos> suffix
;; - commonprefix <qpos> newprefix <point> suffix
(pcase-let*
((prefix (fill-common-string-prefix ustring completion))
(suffix (substring completion (max point (length prefix))))
(`(,qpos . ,qfun) (funcall requote (length prefix) string))
(qstr1 (if (> point (length prefix))
(funcall qfun (substring completion (length prefix) point))))
(qsuffix (funcall qfun suffix))
(qstring (concat (substring string 0 qpos) qstr1 qsuffix))
(qpoint
(cond
((zerop point) 0)
((> point (length prefix)) (+ qpos (length qstr1)))
(t (car (funcall requote point string))))))
;; Make sure `requote' worked.
(assert (equal (funcall unquote qstring) completion))
(cons qstring qpoint)))
(defun completion--twq-all (string ustring completions boundary
unquote requote)
(when completions
(pcase-let*
((prefix
(let ((completion-regexp-list nil))
(try-completion "" (cons (substring ustring boundary)
completions))))
(`(,qfullpos . ,qfun)
(funcall requote (+ boundary (length prefix)) string))
(qfullprefix (substring string 0 qfullpos))
(_ (assert (let ((uboundarystr (substring ustring 0 boundary)))
(equal (funcall unquote qfullprefix)
(concat uboundarystr prefix)))))
(qboundary (car (funcall requote boundary string)))
(_ (assert (<= qboundary qfullpos)))
;; FIXME: this split/quote/concat business messes up the carefully
;; placed completions-common-part and completions-first-difference
;; faces. We could try within the mapcar loop to search for the
;; boundaries of those faces, pass them to `requote' to find their
;; equivalent positions in the quoted output and re-add the faces:
;; this might actually lead to correct results but would be
;; pretty expensive.
;; The better solution is to not quote the *Completions* display,
;; which nicely circumvents the problem. The solution I used here
;; instead is to hope that `qfun' preserves the text-properties and
;; presume that the `first-difference' is not within the `prefix';
;; this presumption is not always true, but at least in practice it is
;; true in most cases.
(qprefix (propertize (substring qfullprefix qboundary)
'face 'completions-common-part)))
;; Here we choose to quote all elements returned, but a better option
;; would be to return unquoted elements together with a function to
;; requote them, so that *Completions* can show nicer unquoted values
;; which only get quoted when needed by choose-completion.
(nconc
(mapcar (lambda (completion)
(assert (string-prefix-p prefix completion))
(let* ((new (substring completion (length prefix)))
(qnew (funcall qfun new))
(qcompletion (concat qprefix qnew)))
(assert
(equal (funcall unquote
(concat (substring string 0 qboundary)
qcompletion))
(concat (substring ustring 0 boundary)
completion)))
qcompletion))
completions)
qboundary))))
;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b)) ;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b))
;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun)) ;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun))
(define-obsolete-function-alias (define-obsolete-function-alias
...@@ -535,21 +737,47 @@ completing buffer and file names, respectively." ...@@ -535,21 +737,47 @@ completing buffer and file names, respectively."
(delete-dups (append (cdr over) (copy-sequence completion-styles))) (delete-dups (append (cdr over) (copy-sequence completion-styles)))
completion-styles))) completion-styles)))
(defun completion--nth-completion (n string table pred point metadata)
"Call the Nth method of completion styles."
(unless metadata
(setq metadata
(completion-metadata (substring string 0 point) table pred)))
;; We provide special support for quoting/unquoting here because it cannot
;; reliably be done within the normal completion-table routines: Completion
;; styles such as `substring' or `partial-completion' need to match the
;; output of all-completions with the user's input, and since most/all
;; quoting mechanisms allow several equivalent quoted forms, the
;; completion-style can't do this matching (e.g. `substring' doesn't know
;; that "\a\b\e" is a valid (quoted) substring of "label").
;; The quote/unquote function needs to come from the completion table (rather
;; than from completion-extra-properties) because it may apply only to some
;; part of the string (e.g. substitute-in-file-name).
(let ((requote
(when (completion-metadata-get metadata 'completion--unquote-requote)
(let ((new (funcall table string point 'completion--unquote)))
(setq string (pop new))
(setq table (pop new))
(setq point (pop new))
(pop new))))
(result
(completion--some (lambda (style)
(funcall (nth n (assq style
completion-styles-alist))
string table pred point))
(completion--styles metadata))))
(if requote
(funcall requote result n)
result)))
(defun completion-try-completion (string table pred point &optional metadata) (defun completion-try-completion (string table pred point &optional metadata)
"Try to complete STRING using completion table TABLE. "Try to complete STRING using completion table TABLE.
Only the elements of table that satisfy predicate PRED are considered. Only the elements of table that satisfy predicate PRED are considered.
POINT is the position of point within STRING. POINT is the position of point within STRING.
The return value can be either nil to indicate that there is no completion, The return value can be either nil to indicate that there is no completion,
t to indicate that STRING is the only possible completion, t to indicate that STRING is the only possible completion,
or a pair (STRING . NEWPOINT) of the completed result string together with or a pair (NEWSTRING . NEWPOINT) of the completed result string together with
a new position for point." a new position for point."
(completion--some (lambda (style) (completion--nth-completion 1 string table pred point metadata))
(funcall (nth 1 (assq style completion-styles-alist))
string table pred point))
(completion--styles (or metadata
(completion-metadata
(substring string 0 point)
table pred)))))
(defun completion-all-completions (string table pred point &optional metadata) (defun completion-all-completions (string table pred point &optional metadata)
"List the possible completions of STRING in completion table TABLE. "List the possible completions of STRING in completion table TABLE.
...@@ -559,13 +787,7 @@ The return value is a list of completions and may contain the base-size ...@@ -559,13 +787,7 @@ The return value is a list of completions and may contain the base-size
in the last `cdr'." in the last `cdr'."
;; FIXME: We need to additionally return the info needed for the ;; FIXME: We need to additionally return the info needed for the
;; second part of completion-base-position. ;; second part of completion-base-position.
(completion--some (lambda (style) (completion--nth-completion 2 string table pred point metadata))
(funcall (nth 2 (assq style completion-styles-alist))
string table pred point))
(completion--styles (or metadata
(completion-metadata
(substring string 0 point)
table pred)))))
(defun minibuffer--bitset (modified completions exact) (defun minibuffer--bitset (modified completions exact)
(logior (if modified 4 0) (logior (if modified 4 0)
......
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