From 2b5ce1ef012a537bbf86846f9f323d2984bf8659 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Thu, 13 Jun 2024 20:07:27 +0200 Subject: [PATCH] Maintain a stack of minibuffer partial completion inputs --- doc/emacs/mini.texi | 19 +- doc/lispref/minibuf.texi | 5 - doc/misc/eshell.texi | 4 +- doc/misc/rcirc.texi | 3 - lisp/icomplete.el | 84 +++-- lisp/minibuffer.el | 545 +++++++++++++-------------------- lisp/net/rcirc.el | 16 - lisp/progmodes/verilog-mode.el | 3 - lisp/simple.el | 27 +- lisp/subr.el | 1 - lisp/window.el | 1 - test/lisp/minibuffer-tests.el | 19 +- 12 files changed, 264 insertions(+), 463 deletions(-) diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 84997224664..f71402f0de3 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -988,24 +988,7 @@ option @code{completion-auto-select} to @code{t}, which changes the behavior of @key{TAB} when Emacs pops up the completions: pressing @kbd{@key{TAB}} will switch to the completion list buffer, and you can then move to a candidate by cursor motion commands and select it with -@kbd{@key{RET}}. If the value of @code{completion-auto-select} is -@code{second-tab}, then the first @kbd{@key{TAB}} will pop up the -completions list buffer, and the second one will switch to it. - -@vindex completion-cycle-threshold - If @code{completion-cycle-threshold} is non-@code{nil}, completion -commands such as @kbd{@key{TAB}} can cycle through completion -alternatives. Normally, if there is more than one completion -alternative for the text in the minibuffer, a completion command -completes up to the longest common substring. If you change -@code{completion-cycle-threshold} to @code{t}, the completion command -instead behaves like @kbd{C-o} (@code{minibuffer-cycle-completion}): -it completes to the first of those completion alternatives; each -subsequent invocation of the completion command replaces that with the -next completion alternative, in a cyclic manner. If you give -@code{completion-cycle-threshold} a numeric value @var{n}, completion -commands switch to this cycling behavior only when there are @var{n} -or fewer alternatives. +@kbd{@key{RET}}. @vindex completions-format When displaying completions, Emacs will normally pop up a new buffer diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index b031d1c27c4..268d5f06693 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1871,11 +1871,6 @@ supported: @item styles The value should be a list of completion styles (symbols). -@item cycle -The value should be a value for @code{completion-cycle-threshold} -(@pxref{Completion Options,,, emacs, The GNU Emacs Manual}) for this -category. - @item cycle-sort-function The function to sort entries when cycling. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 69f94fab469..8c6a5286619 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -2452,8 +2452,8 @@ glob patterns, the pattern will be removed from the input line, and replaced by the completion. @kindex M-? -If you want to see the entire list of possible completions (e.g. when it's -below the @code{completion-cycle-threshold}), press @kbd{M-?}. +If you want to see the entire list of possible completions, press +@kbd{M-?}. @subsection pcomplete Pcomplete, short for programmable completion, is the completion diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index 9ae4bb4a17c..34b1d887e82 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -154,11 +154,8 @@ deego: fsbot rules! @cindex nick completion @cindex completion of nicks -@vindex rcirc-cycle-completion-flag @kindex TAB Since this is so common, you can use @key{TAB} to do nick completion. -By default rcirc will use the default completion system, but you can -enable @code{rcirc-cycle-completion-flag} to cycle nicks in place. @node Getting started with rcirc @section Getting started with rcirc diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 44bbe9772e4..9e793f77d3d 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -171,6 +171,11 @@ icompletion is occurring." Used to implement the option `icomplete-show-matches-on-no-input'.") (defun icomplete-post-command-hook () + (setq completion-all-sorted-completions + (and (memq this-command + '(icomplete-forward-completions + icomplete-backward-completions)) + completion-all-sorted-completions)) (let ((non-essential t)) ;E.g. don't prompt for password! (icomplete-exhibit))) @@ -219,9 +224,7 @@ the default otherwise." completion-all-sorted-completions) (if (window-minibuffer-p) (minibuffer-force-complete-and-exit) - (minibuffer-force-complete (icomplete--field-beg) - (icomplete--field-end) - 'dont-cycle) + (minibuffer-force-complete (icomplete--field-beg) (icomplete--field-end)) (completion-in-region-mode -1)) ;; Otherwise take the faster route... (if (window-minibuffer-p) @@ -236,10 +239,8 @@ the default otherwise." (interactive) ;; We're not at all interested in cycling here (bug#34077). (if (window-minibuffer-p) - (minibuffer-force-complete nil nil 'dont-cycle) - (minibuffer-force-complete (icomplete--field-beg) - (icomplete--field-end) - 'dont-cycle))) + (minibuffer-force-complete) + (minibuffer-force-complete (icomplete--field-beg) (icomplete--field-end)))) ;; Apropos `icomplete-scroll', we implement "scrolling icomplete" ;; within classic icomplete, which is "rotating", by contrast. @@ -270,17 +271,17 @@ Second entry becomes the first and can be selected with `icomplete-force-complete-and-exit'. Return non-nil if something was stepped." (interactive) - (let* ((beg (icomplete--field-beg)) - (end (icomplete--field-end)) - (comps (completion-all-sorted-completions beg end))) - (when (consp (cdr comps)) - (cond (icomplete-scroll - (push (pop comps) icomplete--scrolled-past) - (setq icomplete--scrolled-completions comps)) - (t - (let ((last (last comps))) - (setcdr (last comps) (cons (pop comps) (cdr last)))))) - (completion--cache-all-sorted-completions beg end comps)))) + (when (consp (cdr completion-all-sorted-completions)) + (cond (icomplete-scroll + (push (pop completion-all-sorted-completions) + icomplete--scrolled-past) + (setq icomplete--scrolled-completions + completion-all-sorted-completions)) + (t + (let ((last (last completion-all-sorted-completions))) + (setcdr (last completion-all-sorted-completions) + (cons (pop completion-all-sorted-completions) + (cdr last)))))))) (defun icomplete-backward-completions () "Step backward completions by one entry. @@ -288,20 +289,15 @@ Last entry becomes the first and can be selected with `icomplete-force-complete-and-exit'. Return non-nil if something was stepped." (interactive) - (let* ((beg (icomplete--field-beg)) - (end (icomplete--field-end)) - (comps (completion-all-sorted-completions beg end)) - last-but-one) - (prog1 - (cond ((and icomplete-scroll icomplete--scrolled-past) - (push (pop icomplete--scrolled-past) comps) - (setq icomplete--scrolled-completions comps)) - ((and (not icomplete-scroll) - (consp (cdr (setq last-but-one (last comps 2))))) - ;; At least two elements in comps - (push (car (cdr last-but-one)) comps) - (setcdr last-but-one (cdr (cdr last-but-one))))) - (completion--cache-all-sorted-completions beg end comps)))) + (let* (last-but-one) + (cond ((and icomplete-scroll icomplete--scrolled-past) + (push (pop icomplete--scrolled-past) completion-all-sorted-completions) + (setq icomplete--scrolled-completions completion-all-sorted-completions)) + ((and (not icomplete-scroll) + (consp (cdr (setq last-but-one (last completion-all-sorted-completions 2))))) + ;; At least two elements in comps + (push (car (cdr last-but-one)) completion-all-sorted-completions) + (setcdr last-but-one (cdr (cdr last-but-one))))))) (defun icomplete-vertical-goto-first () "Go to first completions entry when `icomplete-scroll' is non-nil." @@ -346,15 +342,11 @@ require user confirmation." (delete-file path) t)))) (t (error "Sorry, don't know how to kill things for `%s'" cat))))) - (when (let (;; Allow `yes-or-no-p' to work and don't let it - ;; `icomplete-exhibit' anything. - (enable-recursive-minibuffers t) - (icomplete-mode nil)) - (funcall action)) - (completion--cache-all-sorted-completions - (icomplete--field-beg) - (icomplete--field-end) - (cdr all))) + (let (;; Allow `yes-or-no-p' to work and don't let it + ;; `icomplete-exhibit' anything. + (enable-recursive-minibuffers t) + (icomplete-mode nil)) + (funcall action)) (message nil))))) (defun icomplete-fido-delete-char () @@ -656,9 +648,7 @@ Usually run by inclusion in `minibuffer-setup-hook'." while (consp (cdr l)) for comp = (cadr l) when (funcall fn comp) - do (setf (cdr l) (cddr l)) - and return - (completion--cache-all-sorted-completions beg end (cons comp all)))) + do (setf (cdr l) (cddr l)))) finally return all))) (defvar-keymap icomplete-vertical-mode-minibuffer-map @@ -835,7 +825,7 @@ by `group-function''s second \"transformation\" protocol." ;; - both nil, there is no manual scroll; ;; - both non-nil, there is a healthy manual scroll that doesn't need ;; to be readjusted (user just moved around the minibuffer, for - ;; example)l + ;; example) ;; - non-nil and nil, respectively, a refiltering took place and we ;; may need to readjust them to the new filtered `comps'. (when (and icomplete-scroll @@ -847,10 +837,6 @@ by `group-function''s second \"transformation\" protocol." do (setq icomplete--scrolled-past preds comps (cons comp rest)) - (completion--cache-all-sorted-completions - (icomplete--field-beg) - (icomplete--field-end) - comps) and return nil do (push comp preds) finally (setq icomplete--scrolled-completions nil))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 23fd69303ae..1bb9042d3af 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1138,11 +1138,6 @@ and DOC describes the way this style of completion works.") `(repeat :tag "insert a new menu to add more styles" (choice :convert-widget completion--update-styles-options))) -(defconst completion--cycling-threshold-type - '(choice (const :tag "No cycling" nil) - (const :tag "Always cycle" t) - (integer :tag "Threshold"))) - (defcustom completion-styles ;; First, use `basic' because prefix completion has been the standard ;; for "ever" and works well in most cases, so using it first @@ -1182,7 +1177,6 @@ styles for specific categories, such as files, buffers, etc." Each entry has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. -- `cycle': the `completion-cycle-threshold' to use for that category. - `sort-function': function to sort entries when cycling. - `group-function': function for grouping the completion candidates. - `annotation-function': function to add annotations in *Completions*. @@ -1200,7 +1194,6 @@ Also see `completion-category-overrides'.") Each override has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. -- `cycle': the `completion-cycle-threshold' to use for that category. - `sort-function': function to sort entries when cycling. function from metadata, or if that is nil, fall back to `completions-sort'; `identity' disables sorting and keeps the original order; and other @@ -1227,9 +1220,6 @@ overrides the default specified in `completion-category-defaults'." :value-type (set :tag "Properties to override" (cons :tag "Completion Styles" (const styles) ,completion--styles-type) - (cons :tag "Cycling threshold" - (const cycle) - ,completion--cycling-threshold-type) (cons :tag "Sort order" (const sort-function) (choice @@ -1461,17 +1451,10 @@ Moves point to the end of the new text." (delete-region (point) (+ (point) length))) (forward-char suffix-len))) -(defcustom completion-cycle-threshold nil - "Number of completion candidates below which cycling is used. -Depending on this setting `completion-in-region' may use cycling, -whereby invoking a completion command several times in a row -completes to each of the candidates in turn, in a cyclic manner. -If nil, cycling is never used. -If t, cycling is always used. -If an integer, cycling is used so long as there are not more -completion candidates than this number." - :version "24.1" - :type completion--cycling-threshold-type) +(defvar completion-cycle-threshold nil + "This variable is obsolete and no longer used.") + +(make-obsolete-variable 'completion-cycle-threshold nil "30.1") (defcustom completions-sort 'alphabetical "Sort candidates in the *Completions* buffer. @@ -1537,15 +1520,8 @@ pair of a group title string and a list of group candidate strings." "Face used for the separator lines between the candidate groups." :version "28.1") -(defun completion--cycle-threshold (metadata) - (let* ((cat (completion-metadata-get metadata 'category)) - (over (completion--category-override cat 'cycle))) - (if over (cdr over) completion-cycle-threshold))) - (defvar-local completion-all-sorted-completions nil) -(defvar-local completion--all-sorted-completions-location nil) -(defvar-local completion--input nil) -(defvar completion-cycling nil) ;Function that takes down the cycling map. +(defvar-local completion-history nil) (defvar completion-tab-width nil) (defvar completion-fail-discreetly nil @@ -1707,61 +1683,20 @@ when the buffer's text is already an exact match." ;; It did find a match. Do we match some possibility exactly now? (let* ((exact (test-completion completion minibuffer-completion-table - minibuffer-completion-predicate)) - (threshold (completion--cycle-threshold md)) - (comps - ;; Check to see if we want to do cycling. We do it - ;; here, after having performed the normal completion, - ;; so as to take advantage of the difference between - ;; try-completion and all-completions, for things - ;; like completion-ignored-extensions. - (when (and threshold - ;; Check that the completion didn't make - ;; us jump to a different boundary. - (or (not completed) - (< (car (completion-boundaries - (substring completion 0 comp-pos) - minibuffer-completion-table - minibuffer-completion-predicate - "")) - comp-pos))) - (completion-all-sorted-completions beg end)))) - (completion--flush-all-sorted-completions) + minibuffer-completion-predicate))) (cond - ((and (consp (cdr comps)) ;; There's something to cycle. - (not (ignore-errors - ;; This signal an (intended) error if comps is too - ;; short or if completion-cycle-threshold is t. - (consp (nthcdr threshold comps))))) - ;; Not more than completion-cycle-threshold remaining - ;; completions: let's cycle. - (setq completed t exact t) - (completion--cache-all-sorted-completions beg end comps) - (minibuffer-force-complete beg end)) (completed - (cond - ((pcase completion-auto-help - ('visible (get-buffer-window completions-buffer-name 0)) - ('always t)) - (minibuffer-completion-help beg end)) - (t (minibuffer-hide-completions) - (when (minibufferp) - (let ((base-size - (car (completion-boundaries - string - minibuffer-completion-table - minibuffer-completion-predicate "")))) - (minibuffer--cache-completion-input - (substring string base-size) - (buffer-substring-no-properties - (minibuffer-prompt-end) - (+ (minibuffer-prompt-end) base-size))))) - (when exact - ;; If completion did not put point at end of field, - ;; it's a sign that completion is not finished. - (completion--done completion - (if (< comp-pos (length completion)) - 'exact 'unknown)))))) + (if (pcase completion-auto-help + ('visible (get-buffer-window completions-buffer-name 0)) + ('always t)) + (minibuffer-completion-help beg end) + (minibuffer-hide-completions) + (when exact + ;; If completion did not put point at end of field, + ;; it's a sign that completion is not finished. + (completion--done completion + (if (< comp-pos (length completion)) + 'exact 'unknown))))) ;; Show the completion table, if requested. ((not exact) (if (pcase completion-auto-help @@ -1784,88 +1719,63 @@ when the buffer's text is already an exact match." (minibuffer--bitset completed t exact)))))))) +(defun minibuffer-restore-completion-input () + "Restore the state of the minibuffer prior to last completion command." + (interactive "" minibuffer-mode) + (if-let ((record (pop completion-history)) + (contents (car record)) + (point (cdr record))) + (if (and (equal contents (minibuffer-contents)) + (equal point (point))) + (minibuffer-message "Popped completion history") + (completion--replace (minibuffer-prompt-end) + (point-max) + contents) + (goto-char point) + (when (get-buffer-window completions-buffer-name 0) + ;; Refresh *Completions* buffer, if already visible. + (minibuffer-completion-help))) + (user-error "Empty completion history"))) + +(defmacro minibuffer-record-completion-input (&rest body) + "Execute BODY and record the prior minibuffer state if BODY changed it." + (declare (indent 0) (debug t)) + (let ((cnt (make-symbol "contents")) + (pos (make-symbol "position")) + (res (make-symbol "result"))) + `(let ((,cnt (minibuffer-contents)) + (,pos (point)) + (,res (progn ,@body))) + (unless (and (equal ,cnt (minibuffer-contents)) + (equal ,pos (point))) + (push (cons ,cnt ,pos) completion-history)) + ,res))) + (defun minibuffer-complete () "Complete the minibuffer contents as far as possible. Return nil if there is no valid completion, else t. If no characters can be completed, display a list of possible completions. If you repeat this command after it displayed such a list, scroll the window of possible completions." - (interactive) - (completion-in-region (minibuffer--completion-prompt-end) (point-max) - minibuffer-completion-table - minibuffer-completion-predicate)) + (interactive "" minibuffer-mode) + (minibuffer-record-completion-input + (completion-in-region (minibuffer--completion-prompt-end) (point-max) + minibuffer-completion-table + minibuffer-completion-predicate))) (define-obsolete-function-alias 'minibuffer-complete-word 'minibuffer-complete "30.1") (defun completion--in-region-1 (beg end) - ;; If the previous command was not this, - ;; mark the completion buffer obsolete. - (setq this-command 'completion-at-point) - (unless (eq 'completion-at-point last-command) - (completion--flush-all-sorted-completions) - (setq minibuffer-scroll-window nil)) - - (cond - ;; If there's a fresh completion window with a live buffer, - ;; and this command is repeated, scroll that window. - ((and (window-live-p minibuffer-scroll-window) - (eq t (frame-visible-p (window-frame minibuffer-scroll-window)))) - (let ((window minibuffer-scroll-window)) - (with-current-buffer (window-buffer window) - (cond - ;; Here this is possible only when second-tab, but instead of - ;; scrolling the completion list window, switch to it below, - ;; outside of `with-current-buffer'. - ((eq completion-auto-select 'second-tab)) - ;; Reverse tab - ((equal (this-command-keys) [backtab]) - (if (pos-visible-in-window-p (point-min) window) - ;; If beginning is in view, scroll up to the end. - (set-window-point window (point-max)) - ;; Else scroll down one screen. - (with-selected-window window (scroll-down)))) - ;; Normal tab - (t - (if (pos-visible-in-window-p (point-max) window) - ;; If end is in view, scroll up to the end. - (set-window-start window (point-min) nil) - ;; Else scroll down one screen. - (with-selected-window window (scroll-up)))))) - (when (eq completion-auto-select 'second-tab) - (switch-to-completions)) - nil)) - ;; If we're cycling, keep on cycling. - ((and completion-cycling completion-all-sorted-completions) - (minibuffer-force-complete beg end) - t) - (t (prog1 (pcase (completion--do-completion beg end) - (#b000 nil) - (_ t)) - (if (window-live-p minibuffer-scroll-window) - (and (eq completion-auto-select t) - (eq t (frame-visible-p (window-frame minibuffer-scroll-window))) - ;; When the completion list window was displayed, select it. - (switch-to-completions)) - (completion-in-region-mode -1)))))) - -(defun completion--cache-all-sorted-completions (beg end comps) - (add-hook 'after-change-functions - #'completion--flush-all-sorted-completions nil t) - (setq completion--all-sorted-completions-location - (cons (copy-marker beg) (copy-marker end))) - (setq completion-all-sorted-completions comps)) - -(defun completion--flush-all-sorted-completions (&optional start end _len) - (unless (and start end - (or (> start (cdr completion--all-sorted-completions-location)) - (< end (car completion--all-sorted-completions-location)))) - (remove-hook 'after-change-functions - #'completion--flush-all-sorted-completions t) - ;; Remove the transient map if applicable. - (when completion-cycling - (funcall (prog1 completion-cycling (setq completion-cycling nil)))) - (setq completion-all-sorted-completions nil))) + (prog1 (pcase (completion--do-completion beg end) + (#b000 nil) + (_ t)) + (if (window-live-p minibuffer-scroll-window) + (and (eq completion-auto-select t) + (eq t (frame-visible-p (window-frame minibuffer-scroll-window))) + ;; When the completion list window was displayed, select it. + (switch-to-completions)) + (completion-in-region-mode -1)))) (defun completion--metadata (string base md-at-point table pred) ;; Like completion-metadata, but for the specific case of getting the @@ -1939,63 +1849,51 @@ include as `sort-function' in completion metadata." (mapcan #'cdr groups))) (defun completion-all-sorted-completions (&optional start end) - (or completion-all-sorted-completions - (let* ((start (or start (minibuffer-prompt-end))) - (end (or end (point-max))) - (string (buffer-substring start end)) - (md (completion--field-metadata start)) - (all (completion-all-completions - string - minibuffer-completion-table - minibuffer-completion-predicate - (- (point) start) - md)) - (last (last all)) - (base-size (or (cdr last) 0)) - (all-md (completion--metadata (buffer-substring-no-properties - start (point)) - base-size md - minibuffer-completion-table - minibuffer-completion-predicate)) - (sort-fun - (or minibuffer-completions-sort-function - (completion-metadata-get all-md 'sort-function) - (pcase completions-sort - ('nil #'identity) - ('alphabetical #'minibuffer-sort-alphabetically) - ('historical #'minibuffer-sort-by-history) - (_ completions-sort)))) - (full-base (substring string 0 base-size)) - (minibuffer-completion-base - (funcall (or (alist-get 'adjust-base-function all-md) #'identity) - full-base))) - (when last - (setcdr last nil) - - ;; Delete duplicates: do it after setting last's cdr to nil (so - ;; it's a proper list), and be careful to reset `last' since it - ;; may be a different cons-cell. - (setq all (delete-dups all)) - (setq last (last all)) - - (when sort-fun (setq all (funcall sort-fun all))) - - ;; Cache input for `minibuffer-restore-completion-input', - ;; unless STRING is an exact and sole completion. - (let ((input (substring string base-size))) - (and (minibufferp) - (or (consp (cdr all)) ; not sole - (not (equal input (car all)))) ; not exact - (minibuffer--cache-completion-input - input (buffer-substring (minibuffer-prompt-end) - (+ (minibuffer-prompt-end) - base-size))))) - - ;; Cache the result. This is not just for speed, but also so that - ;; repeated calls to minibuffer-force-complete can cycle through - ;; all possibilities. - (completion--cache-all-sorted-completions - start end (nconc all base-size)))))) + (let* ((start (or start (minibuffer-prompt-end))) + (end (or end (point-max))) + (string (buffer-substring start end)) + (md (completion--field-metadata start)) + (all (completion-all-completions + string + minibuffer-completion-table + minibuffer-completion-predicate + (- (point) start) + md)) + (last (last all)) + (base-size (or (cdr last) 0)) + (all-md (completion--metadata (buffer-substring-no-properties + start (point)) + base-size md + minibuffer-completion-table + minibuffer-completion-predicate)) + (sort-fun + (or minibuffer-completions-sort-function + (completion-metadata-get all-md 'sort-function) + (pcase completions-sort + ('nil #'identity) + ('alphabetical #'minibuffer-sort-alphabetically) + ('historical #'minibuffer-sort-by-history) + (_ completions-sort)))) + (full-base (substring string 0 base-size)) + (minibuffer-completion-base + (funcall (or (alist-get 'adjust-base-function all-md) #'identity) + full-base))) + (when last + (setcdr last nil) + + ;; Delete duplicates: do it after setting last's cdr to nil (so + ;; it's a proper list), and be careful to reset `last' since it + ;; may be a different cons-cell. + (setq all (delete-dups all)) + (setq last (last all)) + + (when sort-fun (setq all (funcall sort-fun all))) + + (let ((result (nconc all base-size))) + ;; Cache the result. This is not just for speed, but also so that + ;; repeated calls to minibuffer-force-complete can cycle through + ;; all possibilities. + (setq completion-all-sorted-completions result))))) (defun minibuffer-toggle-completion-ignore-case () "Toggle completion case-sensitively for the current minibuffer." @@ -2019,7 +1917,6 @@ instead of \\[minibuffer-cycle-completion] followed by \ \\[exit-minibuffer] when you know you want the first completion even before cycling to it." (interactive "" minibuffer-mode) - (completion--flush-all-sorted-completions) (if-let ((beg (minibuffer-prompt-end)) (end (cdr (minibuffer--completion-boundaries))) (all (completion-all-sorted-completions beg end))) @@ -2034,15 +1931,14 @@ completion even before cycling to it." (defun completion-switch-cycling-direction () "Switch completion cycling from forward to backward and vice versa." - (setq completion-all-sorted-completions - (let* ((all completion-all-sorted-completions) - (last (last all)) - (base (cdr last))) - (when last (setcdr last nil)) - (setq all (nreverse all)) - (setq last (last all)) - (when last (setcdr last (cons (car all) base))) - (cdr all)))) + (let* ((all completion-all-sorted-completions) + (last (last all)) + (base (cdr last))) + (when last (setcdr last nil)) + (setq all (nreverse all)) + (setq last (last all)) + (when last (setcdr last (cons (car all) base))) + (setq completion-all-sorted-completions (cdr all)))) (defun minibuffer-cycle-completion (arg) "Cycle minibuffer input to the ARGth next completion. @@ -2052,98 +1948,84 @@ If ARG is 0, change cycling direction. Interactively, ARG is the prefix argument, and it defaults to 1." (interactive "p" minibuffer-mode) - (let* ((times (abs arg))) + (let ((times (abs arg))) (when (< arg 1) (completion-switch-cycling-direction)) (if (< 0 times) - (dotimes (_ times) (minibuffer-force-complete)) + (dotimes (_ times) (minibuffer-cycle-completion-further)) (completion--message "Switched cycling direction")) (when (< arg 0) (completion-switch-cycling-direction)))) -(defun minibuffer-restore-completion-input () - "Restore minibuffer contents to last input used for completion." +(defun minibuffer--highlight-in-completions (cand) + (when-let ((win (get-buffer-window completions-buffer-name 0)) + (pm (with-current-buffer completions-buffer-name + (save-excursion + (goto-char (point-min)) + (when-let ((pm (text-property-search-forward + 'completion--string cand t))) + (setq-local + cursor-face-highlight-nonselected-window t) + (goto-char (prop-match-beginning pm)) + (text-property-search-forward 'cursor-face)))))) + (set-window-point win (prop-match-beginning pm)))) + +(defun minibuffer-cycle-completion-further () + "Cycle to next completion candidate." + (if-let* ((all completion-all-sorted-completions) + (cur (car all)) + (beg (minibuffer-prompt-end))) + (progn + (completion--replace (+ beg (or (cdr (last all)) 0)) + (point-max) cur) + (completion--done (buffer-substring-no-properties beg (point-max)) 'sole) + (minibuffer--highlight-in-completions cur) + ;; Rotate cached `completion-all-sorted-completions'. + (let ((last (last all))) + (setcdr last (cons (car all) (cdr last))) + (setq completion-all-sorted-completions (cdr all)))) + (minibuffer-force-complete))) + +(defun minibuffer-force-complete (&optional start end _) + "Complete text between START and END to an exact match." + (declare (advertised-calling-convention (&optional start end) "30.1")) (interactive "" minibuffer-mode) - (let* ((string (car completion--input)) - (base (cdr completion--input)) - (base-size (length base)) - (prompt-end (minibuffer-prompt-end))) - (setq completion--input nil) - (unless (and string (< (+ prompt-end base-size) (point-max)) - ;; Don't restore if the base part has changed. - (equal base (buffer-substring-no-properties - prompt-end (+ prompt-end base-size)))) - (user-error "No partial completion input to restore")) - (completion--replace (+ prompt-end base-size) (point-max) string) - (when (get-buffer-window completions-buffer-name 0) - ;; Refresh *Completions* buffer, if already visible. - (minibuffer-completion-help)))) - -(defun minibuffer-force-complete (&optional start end dont-cycle) - "Complete the minibuffer to an exact match. -Repeated uses step through the possible completions. -DONT-CYCLE tells the function not to setup cycling." - (interactive) - (setq minibuffer-scroll-window nil) ;; FIXME: Need to deal with the extra-size issue here as well. ;; FIXME: ~/src/emacs/t/lisp/minibuffer.el completes to ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el. - (let* ((start (copy-marker (or start (minibuffer--completion-prompt-end)))) + (let* ((start (or start (minibuffer-prompt-end))) (end (or end (point-max))) - ;; (md (completion--field-metadata start)) (all (completion-all-sorted-completions start end)) + (cur (car all)) (base (+ start (or (cdr (last all)) 0)))) - (cond - ((not (consp all)) - (completion--message - (if all "No more completions" "No completions"))) - ((not (consp (cdr all))) - (let ((done (equal (car all) (buffer-substring-no-properties base end)))) - (unless done (completion--replace base end (car all))) - (completion--done (buffer-substring-no-properties start (point)) - 'finished (when done "Sole completion")))) - (t - (completion--replace base end (car all)) - (setq end (+ base (length (car all)))) - (completion--done (buffer-substring-no-properties start (point)) 'sole) - (setq this-command 'completion-at-point) ;For completion-in-region. - ;; Set cycling after modifying the buffer since the flush hook resets it. - (unless dont-cycle - ;; If *Completions* is visible, highlight the current candidate. - (when-let ((win (get-buffer-window completions-buffer-name 0)) - (pm (with-current-buffer completions-buffer-name - (save-excursion - (goto-char (point-min)) - (when-let ((pm (text-property-search-forward - 'completion--string (car all) t))) - (setq-local - cursor-face-highlight-nonselected-window t) - (goto-char (prop-match-beginning pm)) - (text-property-search-forward 'cursor-face)))))) - (set-window-point win (prop-match-beginning pm))) - ;; If completing file names, (car all) may be a directory, so we'd now - ;; have a new set of possible completions and might want to reset - ;; completion-all-sorted-completions to nil, but we prefer not to, - ;; so that repeated calls minibuffer-force-complete still cycle - ;; through the previous possible completions. + (minibuffer-record-completion-input + (cond + ((atom all) (completion--message "No completions")) + ((atom (cdr all)) + (let ((done (equal (car all) (buffer-substring-no-properties base end)))) + (unless done (completion--replace base end cur)) + (completion--done (buffer-substring-no-properties start (point)) + 'finished (when done "Sole completion")) + (setq completion-all-sorted-completions nil))) + (t + (completion--replace base end cur) + (setq end (+ base (length cur))) + (completion--done (buffer-substring-no-properties start (point)) 'sole) + (minibuffer--highlight-in-completions cur) (let ((last (last all))) - (setcdr last (cons (car all) (cdr last))) - (completion--cache-all-sorted-completions start end (cdr all))) - ;; Make sure repeated uses cycle, even though completion--done might - ;; have added a space or something that moved us outside of the field. - ;; (bug#12221). - (let* ((table minibuffer-completion-table) - (pred minibuffer-completion-predicate) - (extra-prop completion-extra-properties) - (cmd - (lambda () "Cycle through the possible completions." - (interactive) - (let ((completion-extra-properties extra-prop)) - (completion-in-region start (point) table pred))))) - (setq completion-cycling - (set-transient-map - (let ((map (make-sparse-keymap))) - (define-key map [remap completion-at-point] cmd) - (define-key map (vector last-command-event) cmd) - map))))))))) + (setcdr last (cons cur (cdr last))) + (setq completion-all-sorted-completions (cdr all))) + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map (vector last-command-event) + #'minibuffer-cycle-completion) + map) + (lambda () + (member this-command + '(universal-argument + negative-argument + digit-argument + minibuffer-cycle-completion))) + (lambda () + (setq completion-all-sorted-completions nil)))))))) (defvar minibuffer-confirm-exit-commands '(completion-at-point minibuffer-complete) @@ -2175,19 +2057,20 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', #'exit-minibuffer)) (defun completion-complete-and-exit (beg end exit-function) - (completion--complete-and-exit - beg end exit-function - (lambda () - (pcase (condition-case nil - (completion--do-completion beg end - nil 'expect-exact) - (error 1)) - ((or #b001 #b011) (funcall exit-function)) - (#b111 (if (not minibuffer-completion-confirm) - (funcall exit-function) - (minibuffer-message "Confirm") - nil)) - (_ nil))))) + (minibuffer-record-completion-input + (completion--complete-and-exit + beg end exit-function + (lambda () + (pcase (condition-case nil + (completion--do-completion beg end + nil 'expect-exact) + (error 1)) + ((or #b001 #b011) (funcall exit-function)) + (#b111 (if (not minibuffer-completion-confirm) + (funcall exit-function) + (minibuffer-message "Confirm") + nil)) + (_ nil)))))) (defun completion--complete-and-exit (beg end exit-function completion-function) @@ -2294,6 +2177,7 @@ completions." (defvar-local completions-ignore-case nil) (defvar-local completions-action nil) (defvar-local completions-style nil) +(defvar-local completions-minibuffer-state nil) (defvar completions-header-count '(completions-candidates @@ -2947,10 +2831,6 @@ completions list." (ngettext "" "s" (length styles)) (mapconcat #'symbol-name styles "', `")))) -(defun minibuffer--cache-completion-input (string base) - "Record STRING and BASE for `minibuffer-restore-completion-input'." - (setq completion--input (cons string base))) - (defcustom minibuffer-completion-annotations t "Whether to display annotations for completion candidates." :type 'boolean @@ -3020,8 +2900,7 @@ completions list." (cpred minibuffer-completion-predicate) (ctable minibuffer-completion-table) (action (minibuffer-completion-action))) - (minibuffer--cache-completion-input (substring string base-size) - full-base) + (when last (setcdr last nil)) ;; Maybe highilight previously used completions. @@ -3121,6 +3000,8 @@ completions list." :base-prefix base-prefix :ignore-case completion-ignore-case :annotations minibuffer-completion-annotations + :minibuffer-state (when (minibufferp) + (cons (minibuffer-contents) (point))) :insert-choice-function (let ((cprops completion-extra-properties)) (lambda (start end choice) @@ -3229,7 +3110,8 @@ PLIST is a property list with optional extra information about COMPLETIONS." completions-predicate (plist-get plist :predicate) completions-exceptional-candidates (plist-get plist :exceptional-candidates) completions-ignore-case (plist-get plist :ignore-case) - completions-action (plist-get plist :action))) + completions-action (plist-get plist :action) + completions-minibuffer-state (plist-get plist :minibuffer-state))) (run-hooks 'completion-setup-hook) (display-buffer buf `((display-buffer-reuse-window display-buffer-at-bottom) @@ -3367,13 +3249,12 @@ Also respects the obsolete wrapper hook `completion-in-region-functions'. (defvar-keymap completion-in-region-mode-map :doc "Keymap activated during `completion-in-region'." - ;; FIXME: Only works if completion-in-region-mode was activated via - ;; completion-at-point called directly. - "M-?" #'completion-help-at-point - "TAB" #'completion-at-point - "M-" #'minibuffer-previous-completion - "M-" #'minibuffer-next-completion - "M-RET" #'minibuffer-choose-completion) + "M-?" #'completion-help-at-point + "M-" #'minibuffer-previous-line-completion + "M-" #'minibuffer-next-line-completion + "M-" #'minibuffer-previous-completion + "M-" #'minibuffer-next-completion + "M-RET" #'minibuffer-choose-completion) ;; It is difficult to know when to exit completion-in-region-mode (i.e. hide ;; the *Completions*). Here's how previous packages did it: @@ -3574,7 +3455,6 @@ The completion method is determined by `completion-at-point-functions'." :doc "Local keymap for minibuffer input with completion." :parent minibuffer-local-map "TAB" #'minibuffer-complete - "" #'minibuffer-complete "C-o" #'minibuffer-cycle-completion "C-l" #'minibuffer-restore-completion-input "C-S-a" #'minibuffer-toggle-completion-ignore-case @@ -6173,11 +6053,9 @@ This applies to `completions-auto-update-mode', which see." (defun completions-auto-update () "Update the *Completions* buffer, if it is visible." (when (get-buffer-window completions-buffer-name 0) - ;; Preserve current `completion--input'. - (let ((completion--input completion--input)) - (if completion-in-region-mode - (completion-help-at-point) - (minibuffer-completion-help)))) + (if completion-in-region-mode + (completion-help-at-point) + (minibuffer-completion-help))) (setq completions-auto-update-timer nil)) (defun completions-auto-update-start-timer () @@ -6224,8 +6102,7 @@ This applies to `completions-auto-update-mode', which see." :type 'float) (defun minibuffer-hint () - (if-let ((all (let ((completion--input completion--input) - (completion-lazy-hilit t) + (if-let ((all (let ((completion-lazy-hilit t) completion-all-sorted-completions) (completion-all-sorted-completions)))) (let ((minibuffer-message-timeout)) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index f16bc2cd4a0..b1721e8647b 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -439,20 +439,6 @@ will be killed." :version "28.1" :type 'boolean) -(defcustom rcirc-cycle-completion-flag nil - "Non-nil means to use cycling for completion in rcirc buffers. -See the Info node `(emacs) Completion Options' for background on -what cycling completion means." - :version "29.1" - :set (lambda (sym val) - (dolist (buf (match-buffers '(major-mode . rcirc-mode))) - (with-current-buffer buf - (if val - (setq-local completion-cycle-threshold t) - (kill-local-variable 'completion-cycle-threshold)))) - (set-default sym val)) - :type 'boolean) - (defvar-local rcirc-nick nil "The nickname used for the current connection.") @@ -1552,8 +1538,6 @@ PROCESS is the process object used for communication. (add-hook 'completion-at-point-functions 'rcirc-completion-at-point nil 'local) - (when rcirc-cycle-completion-flag - (setq-local completion-cycle-threshold t)) (setq-local electric-pair-inhibit-predicate #'rcirc--electric-pair-inhibit) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index a83bad0e8ed..192f4bd7e74 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -8072,9 +8072,6 @@ Region is defined by B and ENDPOS." Repeated use of \\[verilog-complete-word] will show you all of them. Normally, when there is more than one possible completion, it displays a list of all possible completions.") -(when (boundp 'completion-cycle-threshold) - (make-obsolete-variable - 'verilog-toggle-completions 'completion-cycle-threshold "26.1")) (defvar verilog-type-keywords diff --git a/lisp/simple.el b/lisp/simple.el index 36b99983b5b..4ddfe923d75 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9920,15 +9920,10 @@ for the commands bound to the TAB key." "If non-nil, automatically select the window showing the *Completions* buffer. When the value is t, pressing TAB will switch to the completion list buffer when Emacs pops up a window showing that buffer. -If the value is `second-tab', then the first TAB will pop up the -window showing the completions list buffer, and the next TAB will -select that window. See `completion-auto-help' for controlling when the window showing the completions is popped up and down." :type '(choice (const :tag "Don't auto-select completions window" nil) - (const :tag "Select completions window on first TAB" t) - (const :tag "Select completions window on second TAB" - second-tab)) + (const :tag "Select completions window on first TAB" t)) :version "29.1" :group 'completion) @@ -10168,14 +10163,18 @@ minibuffer, but don't quit the completions window." (error "Destination buffer is dead")) (unless no-quit (quit-window nil (posn-window (event-start event)))) - - (with-current-buffer buffer - (choose-completion-string - choice buffer - (or base-position - ;; If all else fails, just guess. - (list (choose-completion-guess-base-position choice))) - insert-function))))) + (let ((mstate completions-minibuffer-state)) + (with-current-buffer buffer + (choose-completion-string + choice buffer + (or base-position + ;; If all else fails, just guess. + (list (choose-completion-guess-base-position choice))) + insert-function) + (or (null mstate) + (equal mstate (car completion-history)) + (push mstate completion-history)))) + (setq completions-minibuffer-state nil)))) ;; Delete the longest partial match for STRING ;; that can be found before POINT. diff --git a/lisp/subr.el b/lisp/subr.el index 05ce7c281af..cc1e9702edc 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4938,7 +4938,6 @@ in which case `save-window-excursion' cannot help." (when window (unless (eq frame (selected-frame)) (make-frame-visible frame)) - (setq minibuffer-scroll-window window) (set-window-hscroll window 0) ;; Don't try this with NOFORCE non-nil! (set-window-start window (point-min) t) diff --git a/lisp/window.el b/lisp/window.el index 3094ebd7ba9..f184ab4d424 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -135,7 +135,6 @@ to `display-buffer'." ;; We used to raise the window's frame here. Do not do that ;; since it would override an `inhibit-switch-frame' entry ;; specified for the action alist used by `display-buffer'. - (setq minibuffer-scroll-window window) (set-window-hscroll window 0) (with-selected-window window (run-hooks 'temp-buffer-window-show-hook) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 7e167e80a77..05c1a1a1480 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -426,20 +426,6 @@ (should (and (get-buffer-window completions-buffer-name 0) (eq (current-buffer) (get-buffer " *Minibuf-1*")))) (execute-kbd-macro (kbd "S-TAB")) - (should (and completion-reference-buffer - (get-buffer-window (buffer-local-value 'completions-buffer-name - completion-reference-buffer) - 0) - (eq (current-buffer) - (get-buffer (buffer-local-value 'completions-buffer-name - completion-reference-buffer))))))) - (let ((completion-auto-select 'second-tab)) - (completing-read-with-minibuffer-setup - '("aa" "ab" "ac") - (execute-kbd-macro (kbd "a TAB")) - (should (and (get-buffer-window completions-buffer-name 0) - (not (eq (current-buffer) (get-buffer completions-buffer-name))))) - (execute-kbd-macro (kbd "TAB TAB")) (should (and completion-reference-buffer (get-buffer-window (buffer-local-value 'completions-buffer-name completion-reference-buffer) @@ -666,9 +652,8 @@ (ert-deftest completion-cycle () (completing-read-with-minibuffer-setup '("aaa" "bbb" "ccc") - (let ((completion-cycle-threshold t)) - (execute-kbd-macro (kbd "TAB TAB TAB")) - (should (equal (minibuffer-contents) "ccc"))))) + (execute-kbd-macro (kbd "C-o C-o C-o")) + (should (equal (minibuffer-contents) "ccc")))) (ert-deftest minibuffer-next-completion () (let ((default-directory (ert-resource-directory))) -- 2.39.2