diff options
| author | Stefan Monnier | 2012-06-22 23:48:18 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2012-06-22 23:48:18 -0400 |
| commit | e33c6771f66d18f0c4c104f50e668cbe82b7e2de (patch) | |
| tree | 2a358dac6c400df732d4e99a7625f4268e405d0b | |
| parent | 7117e105bb5cb268e5d6b233b284e8401134ad09 (diff) | |
| download | emacs-e33c6771f66d18f0c4c104f50e668cbe82b7e2de.tar.gz emacs-e33c6771f66d18f0c4c104f50e668cbe82b7e2de.zip | |
* lisp/minibuffer.el (completion--twq-try): Try to fail more gracefully when
the requote function doesn't work properly.
Fixes: debbugs:11714
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/minibuffer.el | 21 |
2 files changed, 21 insertions, 5 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2763234e05a..4f7f8a2d300 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2012-06-23 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * minibuffer.el (completion--twq-try): Try to fail more gracefully when | ||
| 4 | the requote function doesn't work properly (bug#11714). | ||
| 5 | |||
| 1 | 2012-06-23 Glenn Morris <rgm@gnu.org> | 6 | 2012-06-23 Glenn Morris <rgm@gnu.org> |
| 2 | 7 | ||
| 3 | * pcmpl-rpm.el (pcmpl-rpm-packages): Give status messages. | 8 | * pcmpl-rpm.el (pcmpl-rpm-packages): Give status messages. |
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index a084ed9fb4d..e5151cd8148 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el | |||
| @@ -488,7 +488,7 @@ for use at QPOS." | |||
| 488 | 488 | ||
| 489 | (defun completion--twq-try (string ustring completion point | 489 | (defun completion--twq-try (string ustring completion point |
| 490 | unquote requote) | 490 | unquote requote) |
| 491 | ;; Basically two case: either the new result is | 491 | ;; Basically two cases: either the new result is |
| 492 | ;; - commonprefix1 <point> morecommonprefix <qpos> suffix | 492 | ;; - commonprefix1 <point> morecommonprefix <qpos> suffix |
| 493 | ;; - commonprefix <qpos> newprefix <point> suffix | 493 | ;; - commonprefix <qpos> newprefix <point> suffix |
| 494 | (pcase-let* | 494 | (pcase-let* |
| @@ -505,8 +505,13 @@ for use at QPOS." | |||
| 505 | ((> point (length prefix)) (+ qpos (length qstr1))) | 505 | ((> point (length prefix)) (+ qpos (length qstr1))) |
| 506 | (t (car (funcall requote point string)))))) | 506 | (t (car (funcall requote point string)))))) |
| 507 | ;; Make sure `requote' worked. | 507 | ;; Make sure `requote' worked. |
| 508 | (assert (equal (funcall unquote qstring) completion)) | 508 | (if (equal (funcall unquote qstring) completion) |
| 509 | (cons qstring qpoint))) | 509 | (cons qstring qpoint) |
| 510 | ;; If requote failed (e.g. because sifn-requote did not handle | ||
| 511 | ;; Tramp's "/foo:/bar//baz -> /foo:/baz" truncation), then at least | ||
| 512 | ;; try requote properly. | ||
| 513 | (let ((qstr (funcall qfun completion))) | ||
| 514 | (cons qstr (length qstr)))))) | ||
| 510 | 515 | ||
| 511 | (defun completion--string-equal-p (s1 s2) | 516 | (defun completion--string-equal-p (s1 s2) |
| 512 | (eq t (compare-strings s1 nil nil s2 nil nil 'ignore-case))) | 517 | (eq t (compare-strings s1 nil nil s2 nil nil 'ignore-case))) |
| @@ -2130,6 +2135,12 @@ same as `substitute-in-file-name'." | |||
| 2130 | ;; find the position corresponding to UPOS in QSTR, but | 2135 | ;; find the position corresponding to UPOS in QSTR, but |
| 2131 | ;; substitute-in-file-name can do anything, depending on file-name-handlers. | 2136 | ;; substitute-in-file-name can do anything, depending on file-name-handlers. |
| 2132 | ;; Kind of like in rfn-eshadow-update-overlay, only worse. | 2137 | ;; Kind of like in rfn-eshadow-update-overlay, only worse. |
| 2138 | ;; FIXME: example of thing we do not handle: Tramp's makes | ||
| 2139 | ;; (substitute-in-file-name "/foo:~/bar//baz") -> "/scpc:foo:/baz". | ||
| 2140 | ;; FIXME: One way to try and handle "all" cases is to require | ||
| 2141 | ;; substitute-in-file-name to preserve text-properties, so we could | ||
| 2142 | ;; apply text-properties to the input string and then look for them in | ||
| 2143 | ;; the output to understand what comes from where. | ||
| 2133 | (let ((qpos 0)) | 2144 | (let ((qpos 0)) |
| 2134 | ;; Handle substitute-in-file-name's truncation behavior. | 2145 | ;; Handle substitute-in-file-name's truncation behavior. |
| 2135 | (let (tpos) | 2146 | (let (tpos) |
| @@ -2824,14 +2835,14 @@ filter out additional entries (because TABLE might not obey PRED)." | |||
| 2824 | 2835 | ||
| 2825 | (defun completion--sreverse (str) | 2836 | (defun completion--sreverse (str) |
| 2826 | "Like `reverse' but for a string STR rather than a list." | 2837 | "Like `reverse' but for a string STR rather than a list." |
| 2827 | (apply 'string (nreverse (mapcar 'identity str)))) | 2838 | (apply #'string (nreverse (mapcar 'identity str)))) |
| 2828 | 2839 | ||
| 2829 | (defun completion--common-suffix (strs) | 2840 | (defun completion--common-suffix (strs) |
| 2830 | "Return the common suffix of the strings STRS." | 2841 | "Return the common suffix of the strings STRS." |
| 2831 | (completion--sreverse | 2842 | (completion--sreverse |
| 2832 | (try-completion | 2843 | (try-completion |
| 2833 | "" | 2844 | "" |
| 2834 | (mapcar 'completion--sreverse strs)))) | 2845 | (mapcar #'completion--sreverse strs)))) |
| 2835 | 2846 | ||
| 2836 | (defun completion-pcm--merge-completions (strs pattern) | 2847 | (defun completion-pcm--merge-completions (strs pattern) |
| 2837 | "Extract the commonality in STRS, with the help of PATTERN. | 2848 | "Extract the commonality in STRS, with the help of PATTERN. |