diff options
| author | Stefan Monnier | 2013-09-06 18:46:44 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2013-09-06 18:46:44 -0400 |
| commit | 67982e2b74ad72987459a6995f34161053a1dbfb (patch) | |
| tree | 373ee631b05b07ea3e9572b2068b6af48c5edd58 | |
| parent | e17d94a507d3ab2b2998880861b28badf8ecf0e7 (diff) | |
| download | emacs-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/NEWS | 9 | ||||
| -rw-r--r-- | lisp/ChangeLog | 44 | ||||
| -rw-r--r-- | lisp/emacs-lisp/crm.el | 62 | ||||
| -rw-r--r-- | lisp/icomplete.el | 24 | ||||
| -rw-r--r-- | lisp/minibuffer.el | 225 |
5 files changed, 231 insertions, 133 deletions
| @@ -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)) | ||
| 177 | will 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. |
| 176 | This includes using the lexical environment at point, which means that | 180 | This 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 |
| 757 | and ACL entries. | 761 | and ACL entries. |
| 758 | 762 | ||
| 763 | ** The `common-substring' argument of display-completion-list is obsolete. | ||
| 764 | Either use `completion-all-completions' which already returns highlighted | ||
| 765 | strings (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 @@ | |||
| 1 | 2013-09-06 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2013-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 | |||
| 45 | 2013-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. |
| 162 | Place an overlay on the element, with a `field' property, and return it." | 162 | Return 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 | ||
| 193 | Return t if the current element is now a valid match; otherwise return nil." | 192 | Return 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. |
| 199 | Like `minibuffer-complete-word' but for `completing-read-multiple'." | 201 | Like `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 | ||
| 164 | Icomplete does not operate with any specialized completion tables | 164 | Icomplete does not operate with any specialized completion tables |
| 165 | except those on this list.") | 165 | except 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.") | |||
| 177 | Second entry becomes the first and can be selected with | 179 | Second 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. |
| 188 | Last entry becomes the first and can be selected with | 192 | Last 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. |
| 264 | Should be run via minibuffer `post-command-hook'. See `icomplete-mode' | 270 | Should be run via minibuffer `post-command-hook'. See `icomplete-mode' |
| 265 | and `minibuffer-setup-hook'." | 271 | and `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 | |||
| 319 | are exhibited within the square braces.)" | 326 | are 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. |
| 652 | In Emacs-22, that was what completion commands operated on." | 653 | In 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 | |||
| 670 | is requested but cannot be done. | 671 | is requested but cannot be done. |
| 671 | If the value is `lazy', the *Completions* buffer is only displayed after | 672 | If the value is `lazy', the *Completions* buffer is only displayed after |
| 672 | the second failed attempt to complete." | 673 | the 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'. | |||
| 750 | Note that `completion-category-overrides' may override these | 750 | Note that `completion-category-overrides' may override these |
| 751 | styles for specific categories, such as files, buffers, etc." | 751 | styles 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. |
| 883 | Depending on this setting `minibuffer-complete' may use cycling, | 882 | Depending on this setting `completion-in-region' may use cycling, |
| 884 | like `minibuffer-force-complete'. | 883 | like `minibuffer-force-complete'. |
| 885 | If nil, cycling is never used. | 884 | If nil, cycling is never used. |
| 886 | If t, cycling is always used. | 885 | If 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. |
| 912 | M = completion was performed, the text was Modified. | 910 | M = completion was performed, the text was Modified. |
| 913 | C = there were available Completions. | 911 | C = there were available Completions. |
| @@ -926,9 +924,7 @@ E = after completion we now have an Exact match. | |||
| 926 | TRY-COMPLETION-FUNCTION is a function to use in place of `try-completion'. | 924 | TRY-COMPLETION-FUNCTION is a function to use in place of `try-completion'. |
| 927 | EXPECT-EXACT, if non-nil, means that there is no need to tell the user | 925 | EXPECT-EXACT, if non-nil, means that there is no need to tell the user |
| 928 | when the buffer's text is already an exact match." | 926 | when 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. | |||
| 1045 | If you repeat this command after it displayed such a list, | 1043 | If you repeat this command after it displayed such a list, |
| 1046 | scroll the window of possible completions." | 1044 | scroll 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. |
| 1154 | Repeated uses step through the possible completions." | 1159 | Repeated 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. |
| 1240 | COMPLETION-FUNCTION is called if the current buffer's content does not | 1253 | COMPLETION-FUNCTION is called if the current buffer's content does not |
| 1241 | appear to be a match." | 1254 | appear 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 | |||
| 1381 | is added, provided that matches some possible completion. | 1392 | is added, provided that matches some possible completion. |
| 1382 | Return nil if there is no valid completion, else t." | 1393 | Return 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. | |||
| 1395 | If the value is `horizontal', display completions sorted | 1415 | If the value is `horizontal', display completions sorted |
| 1396 | horizontally in alphabetical order, rather than down the screen." | 1416 | horizontally 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. |
| 1512 | The idea of `completions-common-part' is that you can use it to | 1530 | The idea of `completions-common-part' is that you can use it to |
| 1513 | make the common parts less visible than normal, so that the rest | 1531 | make the common parts less visible than normal, so that the rest |
| 1514 | of the differing parts is, by contrast, slightly highlighted." | 1532 | of 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. | |||
| 1555 | The actual completion alternatives, as inserted, are given `mouse-face' | 1572 | The actual completion alternatives, as inserted, are given `mouse-face' |
| 1556 | properties of `highlight'. | 1573 | properties of `highlight'. |
| 1557 | At the end, this runs the normal hook `completion-setup-hook'. | 1574 | At the end, this runs the normal hook `completion-setup-hook'. |
| 1558 | It can find the completion buffer in `standard-output'. | 1575 | It can find the completion buffer in `standard-output'." |
| 1559 | 1576 | (declare (advertised-calling-convention (completions) "24.4")) | |
| 1560 | The obsolete optional arg COMMON-SUBSTRING, if non-nil, should be a string | ||
| 1561 | specifying a common substring for adding the faces | ||
| 1562 | `completions-first-difference' and `completions-common-part' to | ||
| 1563 | the 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. | |||
| 2308 | For some commands, exiting with an empty minibuffer has a special meaning, | 2308 | For some commands, exiting with an empty minibuffer has a special meaning, |
| 2309 | such as making the current buffer visit no file in the case of | 2309 | such 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)))) |