aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2013-09-06 18:46:44 -0400
committerStefan Monnier2013-09-06 18:46:44 -0400
commit67982e2b74ad72987459a6995f34161053a1dbfb (patch)
tree373ee631b05b07ea3e9572b2068b6af48c5edd58
parente17d94a507d3ab2b2998880861b28badf8ecf0e7 (diff)
downloademacs-67982e2b74ad72987459a6995f34161053a1dbfb.tar.gz
emacs-67982e2b74ad72987459a6995f34161053a1dbfb.zip
* lisp/minibuffer.el: Make minibuffer-complete call completion-in-region
rather than other way around. (completion--some, completion-pcm--find-all-completions): Don't delay signals when debugging. (minibuffer-completion-contents): Beware fields within the minibuffer contents. (completion-all-sorted-completions): Use defvar-local. (completion--do-completion, completion--cache-all-sorted-completions) (completion-all-sorted-completions, minibuffer-force-complete): Add args `beg' and `end'. (completion--in-region-1): New fun, extracted from minibuffer-complete. (minibuffer-complete): Use completion-in-region. (completion-complete-and-exit): New fun, extracted from minibuffer-complete-and-exit. (minibuffer-complete-and-exit): Use it. (completion--complete-and-exit): Rename from minibuffer--complete-and-exit. (completion-in-region--single-word): New function, extracted from minibuffer-complete-word. (minibuffer-complete-word): Use it. (display-completion-list): Make `common-substring' argument obsolete. (completion--in-region): Call completion--in-region-1 instead of minibuffer-complete. (completion-help-at-point): Pass boundaries to minibuffer-completion-help as args rather than via an overlay. (completion-pcm--string->pattern): Use `any-delim'. (completion-pcm--optimize-pattern): New function. (completion-pcm--pattern->regex): Handle `any-delim'. * lisp/icomplete.el (icomplete-forward-completions) (icomplete-backward-completions, icomplete-completions): Adjust calls to completion-all-sorted-completions and completion--cache-all-sorted-completions. (icomplete-with-completion-tables): Default to t. * lisp/emacs-lisp/crm.el (crm--current-element): Rename from crm--select-current-element. Don't put an overlay but return the boundaries instead. (crm--completion-command): Take two new args to bind to the boundaries. (crm-completion-help): Adjust accordingly. (crm-complete): Use completion-in-region. (crm-complete-word): Use completion-in-region--single-word. (crm-complete-and-exit): Use completion-complete-and-exit.
-rw-r--r--etc/NEWS9
-rw-r--r--lisp/ChangeLog44
-rw-r--r--lisp/emacs-lisp/crm.el62
-rw-r--r--lisp/icomplete.el24
-rw-r--r--lisp/minibuffer.el225
5 files changed, 231 insertions, 133 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 72d7f8164c1..ad061a040f1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -172,6 +172,10 @@ You can pick the name of the function and the variables with `C-x 4 a'.
172 172
173* Changes in Specialized Modes and Packages in Emacs 24.4 173* Changes in Specialized Modes and Packages in Emacs 24.4
174 174
175** Icomplete-mode by defaults applies to all forms of minibuffer completion.
176(setq icomplete-with-completion-tables '(internal-complete-buffer))
177will revert to the old behavior.
178
175** The debugger's `e' command evaluates the code in the context at point. 179** The debugger's `e' command evaluates the code in the context at point.
176This includes using the lexical environment at point, which means that 180This includes using the lexical environment at point, which means that
177`e' now lets you access lexical variables as well. 181`e' now lets you access lexical variables as well.
@@ -756,6 +760,11 @@ used in place of the 9th element of `file-attributes'.
756`preserve-extended-attributes' as it now handles both SELinux context 760`preserve-extended-attributes' as it now handles both SELinux context
757and ACL entries. 761and ACL entries.
758 762
763** The `common-substring' argument of display-completion-list is obsolete.
764Either use `completion-all-completions' which already returns highlighted
765strings (including for partial or substring completion) or call
766`completion-hilit-commonality' to add the highlight.
767
759** Changes to the Emacs Lisp Coding Conventions in Emacs 24.4 768** Changes to the Emacs Lisp Coding Conventions in Emacs 24.4
760 769
761*** The package descriptor and name of global variables, constants, 770*** The package descriptor and name of global variables, constants,
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4b6245d5791..eb5861bb21d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,49 @@
12013-09-06 Stefan Monnier <monnier@iro.umontreal.ca> 12013-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * minibuffer.el: Make minibuffer-complete call completion-in-region
4 rather than other way around.
5 (completion--some, completion-pcm--find-all-completions):
6 Don't delay signals when debugging.
7 (minibuffer-completion-contents): Beware fields within the
8 minibuffer contents.
9 (completion-all-sorted-completions): Use defvar-local.
10 (completion--do-completion, completion--cache-all-sorted-completions)
11 (completion-all-sorted-completions, minibuffer-force-complete):
12 Add args `beg' and `end'.
13 (completion--in-region-1): New fun, extracted from minibuffer-complete.
14 (minibuffer-complete): Use completion-in-region.
15 (completion-complete-and-exit): New fun, extracted from
16 minibuffer-complete-and-exit.
17 (minibuffer-complete-and-exit): Use it.
18 (completion--complete-and-exit): Rename from
19 minibuffer--complete-and-exit.
20 (completion-in-region--single-word): New function, extracted from
21 minibuffer-complete-word.
22 (minibuffer-complete-word): Use it.
23 (display-completion-list): Make `common-substring' argument obsolete.
24 (completion--in-region): Call completion--in-region-1 instead of
25 minibuffer-complete.
26 (completion-help-at-point): Pass boundaries to
27 minibuffer-completion-help as args rather than via an overlay.
28 (completion-pcm--string->pattern): Use `any-delim'.
29 (completion-pcm--optimize-pattern): New function.
30 (completion-pcm--pattern->regex): Handle `any-delim'.
31 * icomplete.el (icomplete-forward-completions)
32 (icomplete-backward-completions, icomplete-completions):
33 Adjust calls to completion-all-sorted-completions and
34 completion--cache-all-sorted-completions.
35 (icomplete-with-completion-tables): Default to t.
36 * emacs-lisp/crm.el (crm--current-element): Rename from
37 crm--select-current-element. Don't put an overlay but return the
38 boundaries instead.
39 (crm--completion-command): Take two new args to bind to the boundaries.
40 (crm-completion-help): Adjust accordingly.
41 (crm-complete): Use completion-in-region.
42 (crm-complete-word): Use completion-in-region--single-word.
43 (crm-complete-and-exit): Use completion-complete-and-exit.
44
452013-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
46
3 * dired-x.el (dired-mark-sexp): Bind the vars lexically rather 47 * dired-x.el (dired-mark-sexp): Bind the vars lexically rather
4 than dynamically. 48 than dynamically.
5 49
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index b8e327625e7..750e0709591 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -157,33 +157,32 @@ Functions'."
157 predicate 157 predicate
158 flag))) 158 flag)))
159 159
160(defun crm--select-current-element () 160(defun crm--current-element ()
161 "Parse the minibuffer to find the current element. 161 "Parse the minibuffer to find the current element.
162Place an overlay on the element, with a `field' property, and return it." 162Return the element's boundaries as (START . END)."
163 (let* ((bob (minibuffer-prompt-end)) 163 (let ((bob (minibuffer-prompt-end)))
164 (start (save-excursion 164 (cons (save-excursion
165 (if (re-search-backward crm-separator bob t) 165 (if (re-search-backward crm-separator bob t)
166 (match-end 0) 166 (match-end 0)
167 bob))) 167 bob))
168 (end (save-excursion 168 (save-excursion
169 (if (re-search-forward crm-separator nil t) 169 (if (re-search-forward crm-separator nil t)
170 (match-beginning 0) 170 (match-beginning 0)
171 (point-max)))) 171 (point-max))))))
172 (ol (make-overlay start end nil nil t))) 172
173 (overlay-put ol 'field (make-symbol "crm")) 173(defmacro crm--completion-command (beg end &rest body)
174 ol)) 174 "Run BODY with BEG and END bound to the current element's boundaries."
175 175 (declare (indent 2) (debug (sexp sexp &rest body)))
176(defmacro crm--completion-command (command) 176 `(let* ((crm--boundaries (crm--current-element))
177 "Make COMMAND a completion command for `completing-read-multiple'." 177 (,beg (car crm--boundaries))
178 `(let ((ol (crm--select-current-element))) 178 (,end (cdr crm--boundaries)))
179 (unwind-protect 179 ,@body))
180 ,command
181 (delete-overlay ol))))
182 180
183(defun crm-completion-help () 181(defun crm-completion-help ()
184 "Display a list of possible completions of the current minibuffer element." 182 "Display a list of possible completions of the current minibuffer element."
185 (interactive) 183 (interactive)
186 (crm--completion-command (minibuffer-completion-help)) 184 (crm--completion-command beg end
185 (minibuffer-completion-help beg end))
187 nil) 186 nil)
188 187
189(defun crm-complete () 188(defun crm-complete ()
@@ -192,13 +191,18 @@ If no characters can be completed, display a list of possible completions.
192 191
193Return t if the current element is now a valid match; otherwise return nil." 192Return t if the current element is now a valid match; otherwise return nil."
194 (interactive) 193 (interactive)
195 (crm--completion-command (minibuffer-complete))) 194 (crm--completion-command beg end
195 (completion-in-region beg end
196 minibuffer-completion-table
197 minibuffer-completion-predicate)))
196 198
197(defun crm-complete-word () 199(defun crm-complete-word ()
198 "Complete the current element at most a single word. 200 "Complete the current element at most a single word.
199Like `minibuffer-complete-word' but for `completing-read-multiple'." 201Like `minibuffer-complete-word' but for `completing-read-multiple'."
200 (interactive) 202 (interactive)
201 (crm--completion-command (minibuffer-complete-word))) 203 (crm--completion-command beg end
204 (completion-in-region--single-word
205 beg end minibuffer-completion-table minibuffer-completion-predicate)))
202 206
203(defun crm-complete-and-exit () 207(defun crm-complete-and-exit ()
204 "If all of the minibuffer elements are valid completions then exit. 208 "If all of the minibuffer elements are valid completions then exit.
@@ -211,16 +215,14 @@ This function is modeled after `minibuffer-complete-and-exit'."
211 (goto-char (minibuffer-prompt-end)) 215 (goto-char (minibuffer-prompt-end))
212 (while 216 (while
213 (and doexit 217 (and doexit
214 (let ((ol (crm--select-current-element))) 218 (crm--completion-command beg end
215 (goto-char (overlay-end ol)) 219 (let ((end (copy-marker end t)))
216 (unwind-protect 220 (goto-char end)
217 (catch 'exit 221 (setq doexit nil)
218 (minibuffer-complete-and-exit) 222 (completion-complete-and-exit beg end
219 ;; This did not throw `exit', so there was a problem. 223 (lambda () (setq doexit t)))
220 (setq doexit nil)) 224 (goto-char end)
221 (goto-char (overlay-end ol)) 225 (not (eobp))))
222 (delete-overlay ol))
223 (not (eobp)))
224 (looking-at crm-separator)) 226 (looking-at crm-separator))
225 ;; Skip to the next element. 227 ;; Skip to the next element.
226 (goto-char (match-end 0))) 228 (goto-char (match-end 0)))
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 104e3363831..9aec829cd97 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -158,11 +158,13 @@ minibuffer completion.")
158(add-hook 'icomplete-post-command-hook 'icomplete-exhibit) 158(add-hook 'icomplete-post-command-hook 'icomplete-exhibit)
159 159
160;;;_ = icomplete-with-completion-tables 160;;;_ = icomplete-with-completion-tables
161(defvar icomplete-with-completion-tables '(internal-complete-buffer) 161(defcustom icomplete-with-completion-tables t
162 "Specialized completion tables with which icomplete should operate. 162 "Specialized completion tables with which icomplete should operate.
163 163
164Icomplete does not operate with any specialized completion tables 164Icomplete does not operate with any specialized completion tables
165except those on this list.") 165except those on this list."
166 :type '(choice (const :tag "All" t)
167 (repeat function)))
166 168
167(defvar icomplete-minibuffer-map 169(defvar icomplete-minibuffer-map
168 (let ((map (make-sparse-keymap))) 170 (let ((map (make-sparse-keymap)))
@@ -177,24 +179,28 @@ except those on this list.")
177Second entry becomes the first and can be selected with 179Second entry becomes the first and can be selected with
178`minibuffer-force-complete-and-exit'." 180`minibuffer-force-complete-and-exit'."
179 (interactive) 181 (interactive)
180 (let* ((comps (completion-all-sorted-completions)) 182 (let* ((beg (minibuffer-prompt-end))
183 (end (point-max))
184 (comps (completion-all-sorted-completions beg end))
181 (last (last comps))) 185 (last (last comps)))
182 (when comps 186 (when comps
183 (setcdr last (cons (car comps) (cdr last))) 187 (setcdr last (cons (car comps) (cdr last)))
184 (completion--cache-all-sorted-completions (cdr comps))))) 188 (completion--cache-all-sorted-completions beg end (cdr comps)))))
185 189
186(defun icomplete-backward-completions () 190(defun icomplete-backward-completions ()
187 "Step backward completions by one entry. 191 "Step backward completions by one entry.
188Last entry becomes the first and can be selected with 192Last entry becomes the first and can be selected with
189`minibuffer-force-complete-and-exit'." 193`minibuffer-force-complete-and-exit'."
190 (interactive) 194 (interactive)
191 (let* ((comps (completion-all-sorted-completions)) 195 (let* ((beg (minibuffer-prompt-end))
196 (end (point-max))
197 (comps (completion-all-sorted-completions beg end))
192 (last-but-one (last comps 2)) 198 (last-but-one (last comps 2))
193 (last (cdr last-but-one))) 199 (last (cdr last-but-one)))
194 (when (consp last) ; At least two elements in comps 200 (when (consp last) ; At least two elements in comps
195 (setcdr last-but-one (cdr last)) 201 (setcdr last-but-one (cdr last))
196 (push (car last) comps) 202 (push (car last) comps)
197 (completion--cache-all-sorted-completions comps)))) 203 (completion--cache-all-sorted-completions beg end comps))))
198 204
199;;;_ > icomplete-mode (&optional prefix) 205;;;_ > icomplete-mode (&optional prefix)
200;;;###autoload 206;;;###autoload
@@ -263,7 +269,8 @@ and `minibuffer-setup-hook'."
263 "Insert icomplete completions display. 269 "Insert icomplete completions display.
264Should be run via minibuffer `post-command-hook'. See `icomplete-mode' 270Should be run via minibuffer `post-command-hook'. See `icomplete-mode'
265and `minibuffer-setup-hook'." 271and `minibuffer-setup-hook'."
266 (when (and icomplete-mode (icomplete-simple-completing-p)) 272 (when (and icomplete-mode
273 (icomplete-simple-completing-p)) ;Shouldn't be necessary.
267 (save-excursion 274 (save-excursion
268 (goto-char (point-max)) 275 (goto-char (point-max))
269 ; Insert the match-status information: 276 ; Insert the match-status information:
@@ -319,7 +326,8 @@ matches exist. \(Keybindings for uniquely matched commands
319are exhibited within the square braces.)" 326are exhibited within the square braces.)"
320 327
321 (let* ((md (completion--field-metadata (field-beginning))) 328 (let* ((md (completion--field-metadata (field-beginning)))
322 (comps (completion-all-sorted-completions)) 329 (comps (completion-all-sorted-completions
330 (minibuffer-prompt-end) (point-max)))
323 (last (if (consp comps) (last comps))) 331 (last (if (consp comps) (last comps)))
324 (base-size (cdr last)) 332 (base-size (cdr last))
325 (open-bracket (if require-match "(" "[")) 333 (open-bracket (if require-match "(" "["))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e07d28a54d0..c505a74c23d 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -38,7 +38,7 @@
38 38
39;;; Bugs: 39;;; Bugs:
40 40
41;; - completion-all-sorted-completions list all the completions, whereas 41;; - completion-all-sorted-completions lists all the completions, whereas
42;; it should only lists the ones that `try-completion' would consider. 42;; it should only lists the ones that `try-completion' would consider.
43;; E.g. it should honor completion-ignored-extensions. 43;; E.g. it should honor completion-ignored-extensions.
44;; - choose-completion can't automatically figure out the boundaries 44;; - choose-completion can't automatically figure out the boundaries
@@ -145,7 +145,7 @@ Like CL's `some'."
145 (let ((firsterror nil) 145 (let ((firsterror nil)
146 res) 146 res)
147 (while (and (not res) xs) 147 (while (and (not res) xs)
148 (condition-case err 148 (condition-case-unless-debug err
149 (setq res (funcall fun (pop xs))) 149 (setq res (funcall fun (pop xs)))
150 (error (unless firsterror (setq firsterror err)) nil))) 150 (error (unless firsterror (setq firsterror err)) nil)))
151 (or res 151 (or res
@@ -623,7 +623,8 @@ If ARGS are provided, then pass MESSAGE through `format'."
623 (message nil))) 623 (message nil)))
624 ;; Clear out any old echo-area message to make way for our new thing. 624 ;; Clear out any old echo-area message to make way for our new thing.
625 (message nil) 625 (message nil)
626 (setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message)) 626 (setq message (if (and (null args)
627 (string-match-p "\\` *\\[.+\\]\\'" message))
627 ;; Make sure we can put-text-property. 628 ;; Make sure we can put-text-property.
628 (copy-sequence message) 629 (copy-sequence message)
629 (concat " [" message "]"))) 630 (concat " [" message "]")))
@@ -651,7 +652,7 @@ If ARGS are provided, then pass MESSAGE through `format'."
651 "Return the user input in a minibuffer before point as a string. 652 "Return the user input in a minibuffer before point as a string.
652In Emacs-22, that was what completion commands operated on." 653In Emacs-22, that was what completion commands operated on."
653 (declare (obsolete nil "24.4")) 654 (declare (obsolete nil "24.4"))
654 (buffer-substring (field-beginning) (point))) 655 (buffer-substring (minibuffer-prompt-end) (point)))
655 656
656(defun delete-minibuffer-contents () 657(defun delete-minibuffer-contents ()
657 "Delete all user input in a minibuffer. 658 "Delete all user input in a minibuffer.
@@ -670,8 +671,7 @@ If the value is t the *Completion* buffer is displayed whenever completion
670is requested but cannot be done. 671is requested but cannot be done.
671If the value is `lazy', the *Completions* buffer is only displayed after 672If the value is `lazy', the *Completions* buffer is only displayed after
672the second failed attempt to complete." 673the second failed attempt to complete."
673 :type '(choice (const nil) (const t) (const lazy)) 674 :type '(choice (const nil) (const t) (const lazy)))
674 :group 'minibuffer)
675 675
676(defconst completion-styles-alist 676(defconst completion-styles-alist
677 '((emacs21 677 '((emacs21
@@ -750,7 +750,6 @@ The available styles are listed in `completion-styles-alist'.
750Note that `completion-category-overrides' may override these 750Note that `completion-category-overrides' may override these
751styles for specific categories, such as files, buffers, etc." 751styles for specific categories, such as files, buffers, etc."
752 :type completion--styles-type 752 :type completion--styles-type
753 :group 'minibuffer
754 :version "23.1") 753 :version "23.1")
755 754
756(defcustom completion-category-overrides 755(defcustom completion-category-overrides
@@ -880,7 +879,7 @@ Moves point to the end of the new text."
880 879
881(defcustom completion-cycle-threshold nil 880(defcustom completion-cycle-threshold nil
882 "Number of completion candidates below which cycling is used. 881 "Number of completion candidates below which cycling is used.
883Depending on this setting `minibuffer-complete' may use cycling, 882Depending on this setting `completion-in-region' may use cycling,
884like `minibuffer-force-complete'. 883like `minibuffer-force-complete'.
885If nil, cycling is never used. 884If nil, cycling is never used.
886If t, cycling is always used. 885If t, cycling is always used.
@@ -894,8 +893,7 @@ completion candidates than this number."
894 (over (assq 'cycle (cdr (assq cat completion-category-overrides))))) 893 (over (assq 'cycle (cdr (assq cat completion-category-overrides)))))
895 (if over (cdr over) completion-cycle-threshold))) 894 (if over (cdr over) completion-cycle-threshold)))
896 895
897(defvar completion-all-sorted-completions nil) 896(defvar-local completion-all-sorted-completions nil)
898(make-variable-buffer-local 'completion-all-sorted-completions)
899(defvar-local completion--all-sorted-completions-location nil) 897(defvar-local completion--all-sorted-completions-location nil)
900(defvar completion-cycling nil) 898(defvar completion-cycling nil)
901 899
@@ -906,8 +904,8 @@ completion candidates than this number."
906 (if completion-show-inline-help 904 (if completion-show-inline-help
907 (minibuffer-message msg))) 905 (minibuffer-message msg)))
908 906
909(defun completion--do-completion (&optional try-completion-function 907(defun completion--do-completion (beg end &optional
910 expect-exact) 908 try-completion-function expect-exact)
911 "Do the completion and return a summary of what happened. 909 "Do the completion and return a summary of what happened.
912M = completion was performed, the text was Modified. 910M = completion was performed, the text was Modified.
913C = there were available Completions. 911C = there were available Completions.
@@ -926,9 +924,7 @@ E = after completion we now have an Exact match.
926TRY-COMPLETION-FUNCTION is a function to use in place of `try-completion'. 924TRY-COMPLETION-FUNCTION is a function to use in place of `try-completion'.
927EXPECT-EXACT, if non-nil, means that there is no need to tell the user 925EXPECT-EXACT, if non-nil, means that there is no need to tell the user
928when the buffer's text is already an exact match." 926when the buffer's text is already an exact match."
929 (let* ((beg (field-beginning)) 927 (let* ((string (buffer-substring beg end))
930 (end (field-end))
931 (string (buffer-substring beg end))
932 (md (completion--field-metadata beg)) 928 (md (completion--field-metadata beg))
933 (comp (funcall (or try-completion-function 929 (comp (funcall (or try-completion-function
934 'completion-try-completion) 930 'completion-try-completion)
@@ -963,7 +959,8 @@ when the buffer's text is already an exact match."
963 (if unchanged 959 (if unchanged
964 (goto-char end) 960 (goto-char end)
965 ;; Insert in minibuffer the chars we got. 961 ;; Insert in minibuffer the chars we got.
966 (completion--replace beg end completion)) 962 (completion--replace beg end completion)
963 (setq end (+ beg (length completion))))
967 ;; Move point to its completion-mandated destination. 964 ;; Move point to its completion-mandated destination.
968 (forward-char (- comp-pos (length completion))) 965 (forward-char (- comp-pos (length completion)))
969 966
@@ -972,7 +969,8 @@ when the buffer's text is already an exact match."
972 ;; whether this is a unique completion or not, so try again using 969 ;; whether this is a unique completion or not, so try again using
973 ;; the real case (this shouldn't recurse again, because the next 970 ;; the real case (this shouldn't recurse again, because the next
974 ;; time try-completion will return either t or the exact string). 971 ;; time try-completion will return either t or the exact string).
975 (completion--do-completion try-completion-function expect-exact) 972 (completion--do-completion beg end
973 try-completion-function expect-exact)
976 974
977 ;; It did find a match. Do we match some possibility exactly now? 975 ;; It did find a match. Do we match some possibility exactly now?
978 (let* ((exact (test-completion completion 976 (let* ((exact (test-completion completion
@@ -995,7 +993,7 @@ when the buffer's text is already an exact match."
995 minibuffer-completion-predicate 993 minibuffer-completion-predicate
996 "")) 994 ""))
997 comp-pos))) 995 comp-pos)))
998 (completion-all-sorted-completions)))) 996 (completion-all-sorted-completions beg end))))
999 (completion--flush-all-sorted-completions) 997 (completion--flush-all-sorted-completions)
1000 (cond 998 (cond
1001 ((and (consp (cdr comps)) ;; There's something to cycle. 999 ((and (consp (cdr comps)) ;; There's something to cycle.
@@ -1006,8 +1004,8 @@ when the buffer's text is already an exact match."
1006 ;; Not more than completion-cycle-threshold remaining 1004 ;; Not more than completion-cycle-threshold remaining
1007 ;; completions: let's cycle. 1005 ;; completions: let's cycle.
1008 (setq completed t exact t) 1006 (setq completed t exact t)
1009 (completion--cache-all-sorted-completions comps) 1007 (completion--cache-all-sorted-completions beg end comps)
1010 (minibuffer-force-complete)) 1008 (minibuffer-force-complete beg end))
1011 (completed 1009 (completed
1012 ;; We could also decide to refresh the completions, 1010 ;; We could also decide to refresh the completions,
1013 ;; if they're displayed (and assuming there are 1011 ;; if they're displayed (and assuming there are
@@ -1024,14 +1022,14 @@ when the buffer's text is already an exact match."
1024 (if (pcase completion-auto-help 1022 (if (pcase completion-auto-help
1025 (`lazy (eq this-command last-command)) 1023 (`lazy (eq this-command last-command))
1026 (_ completion-auto-help)) 1024 (_ completion-auto-help))
1027 (minibuffer-completion-help) 1025 (minibuffer-completion-help beg end)
1028 (completion--message "Next char not unique"))) 1026 (completion--message "Next char not unique")))
1029 ;; If the last exact completion and this one were the same, it 1027 ;; If the last exact completion and this one were the same, it
1030 ;; means we've already given a "Complete, but not unique" message 1028 ;; means we've already given a "Complete, but not unique" message
1031 ;; and the user's hit TAB again, so now we give him help. 1029 ;; and the user's hit TAB again, so now we give him help.
1032 (t 1030 (t
1033 (if (and (eq this-command last-command) completion-auto-help) 1031 (if (and (eq this-command last-command) completion-auto-help)
1034 (minibuffer-completion-help)) 1032 (minibuffer-completion-help beg end))
1035 (completion--done completion 'exact 1033 (completion--done completion 'exact
1036 (unless expect-exact 1034 (unless expect-exact
1037 "Complete, but not unique")))) 1035 "Complete, but not unique"))))
@@ -1045,6 +1043,11 @@ If no characters can be completed, display a list of possible completions.
1045If you repeat this command after it displayed such a list, 1043If you repeat this command after it displayed such a list,
1046scroll the window of possible completions." 1044scroll the window of possible completions."
1047 (interactive) 1045 (interactive)
1046 (completion-in-region (minibuffer-prompt-end) (point-max)
1047 minibuffer-completion-table
1048 minibuffer-completion-predicate))
1049
1050(defun completion--in-region-1 (beg end)
1048 ;; If the previous command was not this, 1051 ;; If the previous command was not this,
1049 ;; mark the completion buffer obsolete. 1052 ;; mark the completion buffer obsolete.
1050 (setq this-command 'completion-at-point) 1053 (setq this-command 'completion-at-point)
@@ -1067,17 +1070,17 @@ scroll the window of possible completions."
1067 nil))) 1070 nil)))
1068 ;; If we're cycling, keep on cycling. 1071 ;; If we're cycling, keep on cycling.
1069 ((and completion-cycling completion-all-sorted-completions) 1072 ((and completion-cycling completion-all-sorted-completions)
1070 (minibuffer-force-complete) 1073 (minibuffer-force-complete beg end)
1071 t) 1074 t)
1072 (t (pcase (completion--do-completion) 1075 (t (pcase (completion--do-completion beg end)
1073 (#b000 nil) 1076 (#b000 nil)
1074 (_ t))))) 1077 (_ t)))))
1075 1078
1076(defun completion--cache-all-sorted-completions (comps) 1079(defun completion--cache-all-sorted-completions (beg end comps)
1077 (add-hook 'after-change-functions 1080 (add-hook 'after-change-functions
1078 'completion--flush-all-sorted-completions nil t) 1081 'completion--flush-all-sorted-completions nil t)
1079 (setq completion--all-sorted-completions-location 1082 (setq completion--all-sorted-completions-location
1080 (cons (copy-marker (field-beginning)) (copy-marker (field-end)))) 1083 (cons (copy-marker beg) (copy-marker end)))
1081 (setq completion-all-sorted-completions comps)) 1084 (setq completion-all-sorted-completions comps))
1082 1085
1083(defun completion--flush-all-sorted-completions (&optional start end _len) 1086(defun completion--flush-all-sorted-completions (&optional start end _len)
@@ -1097,10 +1100,10 @@ scroll the window of possible completions."
1097 (if (eq (car bounds) base) md-at-point 1100 (if (eq (car bounds) base) md-at-point
1098 (completion-metadata (substring string 0 base) table pred)))) 1101 (completion-metadata (substring string 0 base) table pred))))
1099 1102
1100(defun completion-all-sorted-completions () 1103(defun completion-all-sorted-completions (start end)
1101 (or completion-all-sorted-completions 1104 (or completion-all-sorted-completions
1102 (let* ((start (field-beginning)) 1105 (let* ((start (or start (minibuffer-prompt-end)))
1103 (end (field-end)) 1106 (end (or end (point-max)))
1104 (string (buffer-substring start end)) 1107 (string (buffer-substring start end))
1105 (md (completion--field-metadata start)) 1108 (md (completion--field-metadata start))
1106 (all (completion-all-completions 1109 (all (completion-all-completions
@@ -1138,18 +1141,20 @@ scroll the window of possible completions."
1138 ;; Cache the result. This is not just for speed, but also so that 1141 ;; Cache the result. This is not just for speed, but also so that
1139 ;; repeated calls to minibuffer-force-complete can cycle through 1142 ;; repeated calls to minibuffer-force-complete can cycle through
1140 ;; all possibilities. 1143 ;; all possibilities.
1141 (completion--cache-all-sorted-completions (nconc all base-size)))))) 1144 (completion--cache-all-sorted-completions
1145 start end (nconc all base-size))))))
1142 1146
1143(defun minibuffer-force-complete-and-exit () 1147(defun minibuffer-force-complete-and-exit ()
1144 "Complete the minibuffer with first of the matches and exit." 1148 "Complete the minibuffer with first of the matches and exit."
1145 (interactive) 1149 (interactive)
1146 (minibuffer-force-complete) 1150 (minibuffer-force-complete)
1147 (minibuffer--complete-and-exit 1151 (completion--complete-and-exit
1152 (minibuffer-prompt-end) (point-max) #'exit-minibuffer
1148 ;; If the previous completion completed to an element which fails 1153 ;; If the previous completion completed to an element which fails
1149 ;; test-completion, then we shouldn't exit, but that should be rare. 1154 ;; test-completion, then we shouldn't exit, but that should be rare.
1150 (lambda () (minibuffer-message "Incomplete")))) 1155 (lambda () (minibuffer-message "Incomplete"))))
1151 1156
1152(defun minibuffer-force-complete () 1157(defun minibuffer-force-complete (&optional start end)
1153 "Complete the minibuffer to an exact match. 1158 "Complete the minibuffer to an exact match.
1154Repeated uses step through the possible completions." 1159Repeated uses step through the possible completions."
1155 (interactive) 1160 (interactive)
@@ -1157,10 +1162,10 @@ Repeated uses step through the possible completions."
1157 ;; FIXME: Need to deal with the extra-size issue here as well. 1162 ;; FIXME: Need to deal with the extra-size issue here as well.
1158 ;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to 1163 ;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to
1159 ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el. 1164 ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
1160 (let* ((start (copy-marker (field-beginning))) 1165 (let* ((start (copy-marker (or start (minibuffer-prompt-end))))
1161 (end (field-end)) 1166 (end (or end (point-max)))
1162 ;; (md (completion--field-metadata start)) 1167 ;; (md (completion--field-metadata start))
1163 (all (completion-all-sorted-completions)) 1168 (all (completion-all-sorted-completions start end))
1164 (base (+ start (or (cdr (last all)) 0)))) 1169 (base (+ start (or (cdr (last all)) 0))))
1165 (cond 1170 (cond
1166 ((not (consp all)) 1171 ((not (consp all))
@@ -1173,10 +1178,11 @@ Repeated uses step through the possible completions."
1173 'finished (when done "Sole completion")))) 1178 'finished (when done "Sole completion"))))
1174 (t 1179 (t
1175 (completion--replace base end (car all)) 1180 (completion--replace base end (car all))
1181 (setq end (+ base (length (car all))))
1176 (completion--done (buffer-substring-no-properties start (point)) 'sole) 1182 (completion--done (buffer-substring-no-properties start (point)) 'sole)
1177 ;; Set cycling after modifying the buffer since the flush hook resets it. 1183 ;; Set cycling after modifying the buffer since the flush hook resets it.
1178 (setq completion-cycling t) 1184 (setq completion-cycling t)
1179 (setq this-command 'completion-at-point) ;For minibuffer-complete. 1185 (setq this-command 'completion-at-point) ;For completion-in-region.
1180 ;; If completing file names, (car all) may be a directory, so we'd now 1186 ;; If completing file names, (car all) may be a directory, so we'd now
1181 ;; have a new set of possible completions and might want to reset 1187 ;; have a new set of possible completions and might want to reset
1182 ;; completion-all-sorted-completions to nil, but we prefer not to, 1188 ;; completion-all-sorted-completions to nil, but we prefer not to,
@@ -1184,7 +1190,7 @@ Repeated uses step through the possible completions."
1184 ;; through the previous possible completions. 1190 ;; through the previous possible completions.
1185 (let ((last (last all))) 1191 (let ((last (last all)))
1186 (setcdr last (cons (car all) (cdr last))) 1192 (setcdr last (cons (car all) (cdr last)))
1187 (completion--cache-all-sorted-completions (cdr all))) 1193 (completion--cache-all-sorted-completions start end (cdr all)))
1188 ;; Make sure repeated uses cycle, even though completion--done might 1194 ;; Make sure repeated uses cycle, even though completion--done might
1189 ;; have added a space or something that moved us outside of the field. 1195 ;; have added a space or something that moved us outside of the field.
1190 ;; (bug#12221). 1196 ;; (bug#12221).
@@ -1223,27 +1229,32 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
1223 `minibuffer-confirm-exit-commands', and accept the input 1229 `minibuffer-confirm-exit-commands', and accept the input
1224 otherwise." 1230 otherwise."
1225 (interactive) 1231 (interactive)
1226 (minibuffer--complete-and-exit 1232 (completion-complete-and-exit (minibuffer-prompt-end) (point-max)
1233 #'exit-minibuffer))
1234
1235(defun completion-complete-and-exit (beg end exit-function)
1236 (completion--complete-and-exit
1237 beg end exit-function
1227 (lambda () 1238 (lambda ()
1228 (pcase (condition-case nil 1239 (pcase (condition-case nil
1229 (completion--do-completion nil 'expect-exact) 1240 (completion--do-completion beg end
1241 nil 'expect-exact)
1230 (error 1)) 1242 (error 1))
1231 ((or #b001 #b011) (exit-minibuffer)) 1243 ((or #b001 #b011) (funcall exit-function))
1232 (#b111 (if (not minibuffer-completion-confirm) 1244 (#b111 (if (not minibuffer-completion-confirm)
1233 (exit-minibuffer) 1245 (funcall exit-function)
1234 (minibuffer-message "Confirm") 1246 (minibuffer-message "Confirm")
1235 nil)) 1247 nil))
1236 (_ nil))))) 1248 (_ nil)))))
1237 1249
1238(defun minibuffer--complete-and-exit (completion-function) 1250(defun completion--complete-and-exit (beg end
1251 exit-function completion-function)
1239 "Exit from `require-match' minibuffer. 1252 "Exit from `require-match' minibuffer.
1240COMPLETION-FUNCTION is called if the current buffer's content does not 1253COMPLETION-FUNCTION is called if the current buffer's content does not
1241appear to be a match." 1254appear to be a match."
1242 (let ((beg (field-beginning))
1243 (end (field-end)))
1244 (cond 1255 (cond
1245 ;; Allow user to specify null string 1256 ;; Allow user to specify null string
1246 ((= beg end) (exit-minibuffer)) 1257 ((= beg end) (funcall exit-function))
1247 ((test-completion (buffer-substring beg end) 1258 ((test-completion (buffer-substring beg end)
1248 minibuffer-completion-table 1259 minibuffer-completion-table
1249 minibuffer-completion-predicate) 1260 minibuffer-completion-predicate)
@@ -1269,7 +1280,7 @@ appear to be a match."
1269 ;; that file. 1280 ;; that file.
1270 (= (length string) (length compl))) 1281 (= (length string) (length compl)))
1271 (completion--replace beg end compl)))) 1282 (completion--replace beg end compl))))
1272 (exit-minibuffer)) 1283 (funcall exit-function))
1273 1284
1274 ((memq minibuffer-completion-confirm '(confirm confirm-after-completion)) 1285 ((memq minibuffer-completion-confirm '(confirm confirm-after-completion))
1275 ;; The user is permitted to exit with an input that's rejected 1286 ;; The user is permitted to exit with an input that's rejected
@@ -1280,13 +1291,13 @@ appear to be a match."
1280 ;; catches most minibuffer typos). 1291 ;; catches most minibuffer typos).
1281 (and (eq minibuffer-completion-confirm 'confirm-after-completion) 1292 (and (eq minibuffer-completion-confirm 'confirm-after-completion)
1282 (not (memq last-command minibuffer-confirm-exit-commands)))) 1293 (not (memq last-command minibuffer-confirm-exit-commands))))
1283 (exit-minibuffer) 1294 (funcall exit-function)
1284 (minibuffer-message "Confirm") 1295 (minibuffer-message "Confirm")
1285 nil)) 1296 nil))
1286 1297
1287 (t 1298 (t
1288 ;; Call do-completion, but ignore errors. 1299 ;; Call do-completion, but ignore errors.
1289 (funcall completion-function))))) 1300 (funcall completion-function))))
1290 1301
1291(defun completion--try-word-completion (string table predicate point md) 1302(defun completion--try-word-completion (string table predicate point md)
1292 (let ((comp (completion-try-completion string table predicate point md))) 1303 (let ((comp (completion-try-completion string table predicate point md)))
@@ -1381,9 +1392,18 @@ After one word is completed as much as possible, a space or hyphen
1381is added, provided that matches some possible completion. 1392is added, provided that matches some possible completion.
1382Return nil if there is no valid completion, else t." 1393Return nil if there is no valid completion, else t."
1383 (interactive) 1394 (interactive)
1384 (pcase (completion--do-completion 'completion--try-word-completion) 1395 (completion-in-region--single-word
1396 (minibuffer-prompt-end) (point-max)
1397 minibuffer-completion-table minibuffer-completion-predicate))
1398
1399(defun completion-in-region--single-word (beg end collection
1400 &optional predicate)
1401 (let ((minibuffer-completion-table collection)
1402 (minibuffer-completion-predicate predicate))
1403 (pcase (completion--do-completion beg end
1404 #'completion--try-word-completion)
1385 (#b000 nil) 1405 (#b000 nil)
1386 (_ t))) 1406 (_ t))))
1387 1407
1388(defface completions-annotations '((t :inherit italic)) 1408(defface completions-annotations '((t :inherit italic))
1389 "Face to use for annotations in the *Completions* buffer.") 1409 "Face to use for annotations in the *Completions* buffer.")
@@ -1395,7 +1415,6 @@ in columns in the *Completions* buffer.
1395If the value is `horizontal', display completions sorted 1415If the value is `horizontal', display completions sorted
1396horizontally in alphabetical order, rather than down the screen." 1416horizontally in alphabetical order, rather than down the screen."
1397 :type '(choice (const horizontal) (const vertical)) 1417 :type '(choice (const horizontal) (const vertical))
1398 :group 'minibuffer
1399 :version "23.2") 1418 :version "23.2")
1400 1419
1401(defun completion--insert-strings (strings) 1420(defun completion--insert-strings (strings)
@@ -1504,15 +1523,13 @@ See also `display-completion-list'.")
1504 1523
1505(defface completions-first-difference 1524(defface completions-first-difference
1506 '((t (:inherit bold))) 1525 '((t (:inherit bold)))
1507 "Face added on the first uncommon character in completions in *Completions* buffer." 1526 "Face added on the first uncommon character in completions in *Completions* buffer.")
1508 :group 'completion)
1509 1527
1510(defface completions-common-part '((t nil)) 1528(defface completions-common-part '((t nil))
1511 "Face added on the common prefix substring in completions in *Completions* buffer. 1529 "Face added on the common prefix substring in completions in *Completions* buffer.
1512The idea of `completions-common-part' is that you can use it to 1530The idea of `completions-common-part' is that you can use it to
1513make the common parts less visible than normal, so that the rest 1531make the common parts less visible than normal, so that the rest
1514of the differing parts is, by contrast, slightly highlighted." 1532of the differing parts is, by contrast, slightly highlighted.")
1515 :group 'completion)
1516 1533
1517(defun completion-hilit-commonality (completions prefix-len base-size) 1534(defun completion-hilit-commonality (completions prefix-len base-size)
1518 (when completions 1535 (when completions
@@ -1555,12 +1572,8 @@ alternative, the second serves as annotation.
1555The actual completion alternatives, as inserted, are given `mouse-face' 1572The actual completion alternatives, as inserted, are given `mouse-face'
1556properties of `highlight'. 1573properties of `highlight'.
1557At the end, this runs the normal hook `completion-setup-hook'. 1574At the end, this runs the normal hook `completion-setup-hook'.
1558It can find the completion buffer in `standard-output'. 1575It can find the completion buffer in `standard-output'."
1559 1576 (declare (advertised-calling-convention (completions) "24.4"))
1560The obsolete optional arg COMMON-SUBSTRING, if non-nil, should be a string
1561specifying a common substring for adding the faces
1562`completions-first-difference' and `completions-common-part' to
1563the completions buffer."
1564 (if common-substring 1577 (if common-substring
1565 (setq completions (completion-hilit-commonality 1578 (setq completions (completion-hilit-commonality
1566 completions (length common-substring) 1579 completions (length common-substring)
@@ -1647,19 +1660,19 @@ variables.")
1647 (equal pre-msg (and exit-fun (current-message)))) 1660 (equal pre-msg (and exit-fun (current-message))))
1648 (completion--message message)))) 1661 (completion--message message))))
1649 1662
1650(defun minibuffer-completion-help () 1663(defun minibuffer-completion-help (&optional start end)
1651 "Display a list of possible completions of the current minibuffer contents." 1664 "Display a list of possible completions of the current minibuffer contents."
1652 (interactive) 1665 (interactive)
1653 (message "Making completion list...") 1666 (message "Making completion list...")
1654 (let* ((start (field-beginning)) 1667 (let* ((start (or start (minibuffer-prompt-end)))
1655 (end (field-end)) 1668 (end (or end (point-max)))
1656 (string (field-string)) 1669 (string (buffer-substring start end))
1657 (md (completion--field-metadata start)) 1670 (md (completion--field-metadata start))
1658 (completions (completion-all-completions 1671 (completions (completion-all-completions
1659 string 1672 string
1660 minibuffer-completion-table 1673 minibuffer-completion-table
1661 minibuffer-completion-predicate 1674 minibuffer-completion-predicate
1662 (- (point) (field-beginning)) 1675 (- (point) start)
1663 md))) 1676 md)))
1664 (message nil) 1677 (message nil)
1665 (if (or (null completions) 1678 (if (or (null completions)
@@ -1811,7 +1824,6 @@ exit."
1811 (if (memq system-type '(ms-dos windows-nt darwin cygwin)) 1824 (if (memq system-type '(ms-dos windows-nt darwin cygwin))
1812 t nil) 1825 t nil)
1813 "Non-nil means when reading a file name completion ignores case." 1826 "Non-nil means when reading a file name completion ignores case."
1814 :group 'minibuffer
1815 :type 'boolean 1827 :type 'boolean
1816 :version "22.1") 1828 :version "22.1")
1817 1829
@@ -1821,22 +1833,15 @@ exit."
1821 ;; completions" operation as well. 1833 ;; completions" operation as well.
1822 completion-in-region-functions (start end collection predicate) 1834 completion-in-region-functions (start end collection predicate)
1823 (let ((minibuffer-completion-table collection) 1835 (let ((minibuffer-completion-table collection)
1824 (minibuffer-completion-predicate predicate) 1836 (minibuffer-completion-predicate predicate))
1825 (ol (make-overlay start end nil nil t)))
1826 (overlay-put ol 'field 'completion)
1827 ;; HACK: if the text we are completing is already in a field, we 1837 ;; HACK: if the text we are completing is already in a field, we
1828 ;; want the completion field to take priority (e.g. Bug#6830). 1838 ;; want the completion field to take priority (e.g. Bug#6830).
1829 (overlay-put ol 'priority 100)
1830 (when completion-in-region-mode-predicate 1839 (when completion-in-region-mode-predicate
1831 (completion-in-region-mode 1) 1840 (completion-in-region-mode 1)
1832 (setq completion-in-region--data 1841 (setq completion-in-region--data
1833 (list (if (markerp start) start (copy-marker start)) 1842 (list (if (markerp start) start (copy-marker start))
1834 (copy-marker end) collection))) 1843 (copy-marker end) collection)))
1835 ;; FIXME: `minibuffer-complete' should call `completion-in-region' rather 1844 (completion--in-region-1 start end))))
1836 ;; than the other way around!
1837 (unwind-protect
1838 (call-interactively 'minibuffer-complete)
1839 (delete-overlay ol)))))
1840 1845
1841(defvar completion-in-region-mode-map 1846(defvar completion-in-region-mode-map
1842 (let ((map (make-sparse-keymap))) 1847 (let ((map (make-sparse-keymap)))
@@ -2001,19 +2006,14 @@ The completion method is determined by `completion-at-point-functions'."
2001 (lambda () 2006 (lambda ()
2002 ;; We're still in the same completion field. 2007 ;; We're still in the same completion field.
2003 (let ((newstart (car-safe (funcall hookfun)))) 2008 (let ((newstart (car-safe (funcall hookfun))))
2004 (and newstart (= newstart start))))) 2009 (and newstart (= newstart start))))))
2005 (ol (make-overlay start end nil nil t)))
2006 ;; FIXME: We should somehow (ab)use completion-in-region-function or 2010 ;; FIXME: We should somehow (ab)use completion-in-region-function or
2007 ;; introduce a corresponding hook (plus another for word-completion, 2011 ;; introduce a corresponding hook (plus another for word-completion,
2008 ;; and another for force-completion, maybe?). 2012 ;; and another for force-completion, maybe?).
2009 (overlay-put ol 'field 'completion)
2010 (overlay-put ol 'priority 100)
2011 (completion-in-region-mode 1) 2013 (completion-in-region-mode 1)
2012 (setq completion-in-region--data 2014 (setq completion-in-region--data
2013 (list start (copy-marker end) collection)) 2015 (list start (copy-marker end) collection))
2014 (unwind-protect 2016 (minibuffer-completion-help start end)))
2015 (call-interactively 'minibuffer-completion-help)
2016 (delete-overlay ol))))
2017 (`(,hookfun . ,_) 2017 (`(,hookfun . ,_)
2018 ;; The hook function already performed completion :-( 2018 ;; The hook function already performed completion :-(
2019 ;; Not much we can do at this point. 2019 ;; Not much we can do at this point.
@@ -2308,7 +2308,6 @@ the minibuffer empty.
2308For some commands, exiting with an empty minibuffer has a special meaning, 2308For some commands, exiting with an empty minibuffer has a special meaning,
2309such as making the current buffer visit no file in the case of 2309such as making the current buffer visit no file in the case of
2310`set-visited-file-name'." 2310`set-visited-file-name'."
2311 :group 'minibuffer
2312 :type 'boolean) 2311 :type 'boolean)
2313 2312
2314;; Not always defined, but only called if next-read-file-uses-dialog-p says so. 2313;; Not always defined, but only called if next-read-file-uses-dialog-p says so.
@@ -2701,7 +2700,6 @@ expression (not containing character ranges like `a-z')."
2701 ;; Refresh other vars. 2700 ;; Refresh other vars.
2702 (completion-pcm--prepare-delim-re value)) 2701 (completion-pcm--prepare-delim-re value))
2703 :initialize 'custom-initialize-reset 2702 :initialize 'custom-initialize-reset
2704 :group 'minibuffer
2705 :type 'string) 2703 :type 'string)
2706 2704
2707(defcustom completion-pcm-complete-word-inserts-delimiters nil 2705(defcustom completion-pcm-complete-word-inserts-delimiters nil
@@ -2734,7 +2732,8 @@ or a symbol, see `completion-pcm--merge-completions'."
2734 (completion-pcm--string->pattern suffix))) 2732 (completion-pcm--string->pattern suffix)))
2735 (let* ((pattern nil) 2733 (let* ((pattern nil)
2736 (p 0) 2734 (p 0)
2737 (p0 p)) 2735 (p0 p)
2736 (pending nil))
2738 2737
2739 (while (and (setq p (string-match completion-pcm--delim-wild-regex 2738 (while (and (setq p (string-match completion-pcm--delim-wild-regex
2740 string p)) 2739 string p))
@@ -2751,18 +2750,49 @@ or a symbol, see `completion-pcm--merge-completions'."
2751 ;; This is determined by the presence of a submatch-1 which delimits 2750 ;; This is determined by the presence of a submatch-1 which delimits
2752 ;; the prefix. 2751 ;; the prefix.
2753 (if (match-end 1) (setq p (match-end 1))) 2752 (if (match-end 1) (setq p (match-end 1)))
2754 (push (substring string p0 p) pattern) 2753 (unless (= p0 p)
2754 (if pending (push pending pattern))
2755 (push (substring string p0 p) pattern))
2756 (setq pending nil)
2755 (if (eq (aref string p) ?*) 2757 (if (eq (aref string p) ?*)
2756 (progn 2758 (progn
2757 (push 'star pattern) 2759 (push 'star pattern)
2758 (setq p0 (1+ p))) 2760 (setq p0 (1+ p)))
2759 (push 'any pattern) 2761 (push 'any pattern)
2760 (setq p0 p)) 2762 (if (match-end 1)
2761 (cl-incf p)) 2763 (setq p0 p)
2762 2764 (push (substring string p (match-end 0)) pattern)
2765 ;; `any-delim' is used so that "a-b" also finds "array->beginning".
2766 (setq pending 'any-delim)
2767 (setq p0 (match-end 0))))
2768 (setq p p0))
2769
2770 (when (> (length string) p0)
2771 (if pending (push pending pattern))
2772 (push (substring string p0) pattern))
2763 ;; An empty string might be erroneously added at the beginning. 2773 ;; An empty string might be erroneously added at the beginning.
2764 ;; It should be avoided properly, but it's so easy to remove it here. 2774 ;; It should be avoided properly, but it's so easy to remove it here.
2765 (delete "" (nreverse (cons (substring string p0) pattern)))))) 2775 (delete "" (nreverse pattern)))))
2776
2777(defun completion-pcm--optimize-pattern (p)
2778 ;; Remove empty strings in a separate phase since otherwise a ""
2779 ;; might prevent some other optimization, as in '(any "" any).
2780 (setq p (delete "" p))
2781 (let ((n '()))
2782 (while p
2783 (pcase p
2784 (`(,(and s1 (pred stringp)) ,(and s2 (pred stringp)) . ,rest)
2785 (setq p (cons (concat s1 s2) rest)))
2786 (`(,(and p1 (pred symbolp)) ,(and p2 (guard (eq p1 p2))) . ,_)
2787 (setq p (cdr p)))
2788 (`(star ,(pred symbolp) . ,rest) (setq p `(star . ,rest)))
2789 (`(,(pred symbolp) star . ,rest) (setq p `(star . ,rest)))
2790 (`(point ,(or `any `any-delim) . ,rest) (setq p `(point . ,rest)))
2791 (`(,(or `any `any-delim) point . ,rest) (setq p `(point . ,rest)))
2792 (`(any ,(or `any `any-delim) . ,rest) (setq p `(any . ,rest)))
2793 (`(,(pred symbolp)) (setq p nil)) ;Implicit terminating `any'.
2794 (_ (push (pop p) n))))
2795 (nreverse n)))
2766 2796
2767(defun completion-pcm--pattern->regex (pattern &optional group) 2797(defun completion-pcm--pattern->regex (pattern &optional group)
2768 (let ((re 2798 (let ((re
@@ -2771,8 +2801,13 @@ or a symbol, see `completion-pcm--merge-completions'."
2771 (lambda (x) 2801 (lambda (x)
2772 (cond 2802 (cond
2773 ((stringp x) (regexp-quote x)) 2803 ((stringp x) (regexp-quote x))
2774 ((if (consp group) (memq x group) group) "\\(.*?\\)") 2804 (t
2775 (t ".*?"))) 2805 (let ((re (if (eq x 'any-delim)
2806 (concat completion-pcm--delim-wild-regex "*?")
2807 ".*?")))
2808 (if (if (consp group) (memq x group) group)
2809 (concat "\\(" re "\\)")
2810 re)))))
2776 pattern 2811 pattern
2777 "")))) 2812 ""))))
2778 ;; Avoid pathological backtracking. 2813 ;; Avoid pathological backtracking.
@@ -2846,11 +2881,11 @@ filter out additional entries (because TABLE might not obey PRED)."
2846 (setq string (substring string (car bounds) (+ point (cdr bounds)))) 2881 (setq string (substring string (car bounds) (+ point (cdr bounds))))
2847 (let* ((relpoint (- point (car bounds))) 2882 (let* ((relpoint (- point (car bounds)))
2848 (pattern (completion-pcm--string->pattern string relpoint)) 2883 (pattern (completion-pcm--string->pattern string relpoint))
2849 (all (condition-case err 2884 (all (condition-case-unless-debug err
2850 (funcall filter 2885 (funcall filter
2851 (completion-pcm--all-completions 2886 (completion-pcm--all-completions
2852 prefix pattern table pred)) 2887 prefix pattern table pred))
2853 (error (unless firsterror (setq firsterror err)) nil)))) 2888 (error (setq firsterror err) nil))))
2854 (when (and (null all) 2889 (when (and (null all)
2855 (> (car bounds) 0) 2890 (> (car bounds) 0)
2856 (null (ignore-errors (try-completion prefix table pred)))) 2891 (null (ignore-errors (try-completion prefix table pred))))