From 64c08696755c29d2d9125734865ef93af6833fef Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Sun, 15 Oct 2023 16:47:16 -0400 Subject: [PATCH] Keep point on the same completion in the completions buffer Currently if the user re-runs minibuffer-completion-help, point is reset to the beginning of the buffer. This throws away information unnecessarily; let's keep point on the same completion the user previously selected. We move setting cursor-face-highlight-nonselected-window to completion-setup-function so that the selected completion continues to be highlighted after minibuffer-completion-help, which creates a new *Completions* buffer. * lisp/minibuffer.el (completion--insert-strings) (completion--selected-posn, completion--insert-horizontal) (completion--insert-vertical, completion--insert-one-column) (completion--insert, display-completion-list): Add SELECTED argument. (minibuffer-next-completion): Don't set cursor-face-highlight-nonselected-window. (minibuffer-completion-help): Calculate current-completion and pass it to display-completion-list. * lisp/simple.el (completions--get-posn): Add. (choose-completion): Call completions--get-posn. (completion-setup-function): Set cursor-face-highlight-nonselected-window. --- lisp/minibuffer.el | 64 +++++++++++++++++++++++++++++++--------------- lisp/simple.el | 41 ++++++++++++++++------------- 2 files changed, 66 insertions(+), 39 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 2120e31775e..998ef9f05a9 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2034,12 +2034,17 @@ completions-header-format (string :tag "Format string for heading line")) :version "29.1") -(defun completion--insert-strings (strings &optional group-fun) +(defvar completion--selected-posn) + +(defun completion--insert-strings (strings &optional group-fun selected) "Insert a list of STRINGS into the current buffer. The candidate strings are inserted into the buffer depending on the completions format as specified by the variable `completions-format'. Runs of equal candidate strings are eliminated. GROUP-FUN is a -`group-function' used for grouping the completion candidates." +`group-function' used for grouping the completion candidates. + +If SELECTED exists in STRINGS, point is set to its first +instance; otherwise, it's set to `point-min'." (when (consp strings) (let* ((length (apply #'max (mapcar (lambda (s) @@ -2055,18 +2060,20 @@ completion--insert-strings ;; Don't allocate more columns than we can fill. ;; Windows can't show less than 3 lines anyway. (max 1 (/ (length strings) 2)))) - (colwidth (/ wwidth columns))) + (colwidth (/ wwidth columns)) + completion--selected-posn) (unless (or tab-stop-list (null completion-tab-width) (zerop (mod colwidth completion-tab-width))) ;; Align to tab positions for the case ;; when the caller uses tabs inside prefix. (setq colwidth (- colwidth (mod colwidth completion-tab-width)))) (funcall (intern (format "completion--insert-%s" completions-format)) - strings group-fun length wwidth colwidth columns)))) + strings group-fun length wwidth colwidth columns selected) + (goto-char (or completion--selected-posn (point-min)))))) (defun completion--insert-horizontal (strings group-fun length wwidth - colwidth _columns) + colwidth _columns selected) (let ((column 0) (first t) (last-title nil) @@ -2103,7 +2110,7 @@ completion--insert-horizontal `(display (space :align-to ,column))) nil)) (setq first nil) - (completion--insert str group-fun) + (completion--insert str group-fun selected) ;; Next column to align to. (setq column (+ column ;; Round up to a whole number of columns. @@ -2111,7 +2118,7 @@ completion--insert-horizontal (defun completion--insert-vertical (strings group-fun _length _wwidth - colwidth columns) + colwidth columns selected) (while strings (let ((group nil) (column 0) @@ -2155,13 +2162,15 @@ completion--insert-vertical (insert " \t") (set-text-properties (1- (point)) (point) `(display (space :align-to ,column)))) - (completion--insert str group-fun) + (completion--insert str group-fun selected) (if (> column 0) (forward-line) (insert "\n")) (setq row (1+ row))))))) -(defun completion--insert-one-column (strings group-fun &rest _) +(defun completion--insert-one-column (strings group-fun + _length _wwidth + _colwidth _columns selected) (let ((last-title nil) (last-string nil)) (dolist (str strings) (unless (equal last-string str) ; Remove (consecutive) duplicates. @@ -2172,11 +2181,14 @@ completion--insert-one-column (setq last-title title) (when title (insert (format completions-group-format title) "\n"))))) - (completion--insert str group-fun) + (completion--insert str group-fun selected) (insert "\n"))) (delete-char -1))) -(defun completion--insert (str group-fun) +(defun completion--insert (str group-fun selected) + (when (and (not completion--selected-posn) + (equal (or (car-safe str) str) selected)) + (setq completion--selected-posn (point))) (if (not (consp str)) (add-text-properties (point) @@ -2197,7 +2209,7 @@ completion--insert (let ((beg (point)) (end (progn (insert prefix) (point)))) (add-text-properties beg end `(mouse-face nil completion--string ,(car str))))) - (completion--insert (car str) group-fun) + (completion--insert (car str) group-fun selected) (let ((beg (point)) (end (progn (insert suffix) (point)))) (add-text-properties beg end `(mouse-face nil completion--string ,(car str))) @@ -2267,7 +2279,7 @@ completion-hilit-commonality completions) base-size)))) -(defun display-completion-list (completions &optional common-substring group-fun) +(defun display-completion-list (completions &optional common-substring group-fun selected) "Display the list of completions, COMPLETIONS, using `standard-output'. Each element may be just a symbol or string or may be a list of two strings to be printed as if concatenated. @@ -2276,6 +2288,8 @@ display-completion-list `standard-output' must be a buffer. The actual completion alternatives, as inserted, are given `mouse-face' properties of `highlight'. +If SELECTED exists in COMPLETIONS, point is set to its first +instance; otherwise, it's set to `point-min'. At the end, this runs the normal hook `completion-setup-hook'. It can find the completion buffer in `standard-output'. GROUP-FUN is a `group-function' used for grouping the completion @@ -2299,9 +2313,15 @@ display-completion-list (goto-char (point-max)) (when completions-header-format (insert (format completions-header-format (length completions)))) - (completion--insert-strings completions group-fun))) - - (run-hooks 'completion-setup-hook) + (completion--insert-strings completions group-fun selected))) + + ;; Make sure point stays at SELECTED. + (let ((marker + (when (bufferp standard-output) + (with-current-buffer standard-output (point-marker))))) + (run-hooks 'completion-setup-hook) + (when marker + (with-current-buffer standard-output (goto-char marker)))) nil) (defvar completion-extra-properties nil @@ -2421,7 +2441,10 @@ minibuffer-completion-help ;; window, mark it as softly-dedicated, so bury-buffer in ;; minibuffer-hide-completions will know whether to ;; delete the window or not. - (display-buffer-mark-dedicated 'soft)) + (display-buffer-mark-dedicated 'soft) + (current-completion + (when-let ((buf (get-buffer "*Completions*"))) + (with-current-buffer buf (completions--get-posn (point)))))) (with-current-buffer-window "*Completions*" ;; This is a copy of `display-buffer-fallback-action' @@ -2440,7 +2463,7 @@ minibuffer-completion-help ,(when temp-buffer-resize-mode '(preserve-size . (nil . t))) (body-function - . ,#'(lambda (_window) + . ,#'(lambda (window) (with-current-buffer mainbuf ;; Remove the base-size tail because `sort' requires a properly ;; nil-terminated list. @@ -2527,7 +2550,8 @@ minibuffer-completion-help (if (eq (car bounds) (length result)) 'exact 'finished))))))) - (display-completion-list completions nil group-fun))))) + (display-completion-list completions nil group-fun current-completion) + (set-window-point window (with-current-buffer standard-output (point))))))) nil))) nil)) @@ -4496,8 +4520,6 @@ minibuffer-next-completion (interactive "p") (let ((auto-choose minibuffer-completion-auto-choose)) (with-minibuffer-completions-window - (when completions-highlight-face - (setq-local cursor-face-highlight-nonselected-window t)) (next-completion (or n 1)) (when auto-choose (let ((completion-use-base-affixes t)) diff --git a/lisp/simple.el b/lisp/simple.el index ec14bec9e07..3ab8b783659 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10000,6 +10000,25 @@ next-completion (when (/= 0 n) (switch-to-minibuffer)))) +(defun completions--get-posn (position) + "Return the completion at POSITION as a string." + (save-excursion + (goto-char position) + (let (beg) + (cond + ((and (not (eobp)) + (get-text-property (point) 'completion--string)) + (setq beg (1+ (point)))) + ((and (not (bobp)) + (get-text-property (1- (point)) 'completion--string)) + (setq beg (point)))) + (when beg + (setq beg (or (previous-single-property-change + beg 'completion--string) + beg)) + (substring-no-properties + (get-text-property beg 'completion--string)))))) + (defun choose-completion (&optional event no-exit no-quit) "Choose the completion at point. If EVENT, use EVENT's position to determine the starting position. @@ -10019,24 +10038,8 @@ choose-completion (base-affixes completion-base-affixes) (insert-function completion-list-insert-choice-function) (completion-no-auto-exit (if no-exit t completion-no-auto-exit)) - (choice - (save-excursion - (goto-char (posn-point (event-start event))) - (let (beg) - (cond - ((and (not (eobp)) - (get-text-property (point) 'completion--string)) - (setq beg (1+ (point)))) - ((and (not (bobp)) - (get-text-property (1- (point)) 'completion--string)) - (setq beg (point))) - (t (error "No completion here"))) - (setq beg (or (previous-single-property-change - beg 'completion--string) - beg)) - (substring-no-properties - (get-text-property beg 'completion--string)))))) - + (choice (or (completions--get-posn (posn-point (event-start event))) + (error "No completion here")))) (unless (buffer-live-p buffer) (error "Destination buffer is dead")) (unless no-quit @@ -10208,6 +10211,8 @@ completion-setup-function (base-affixes completion-base-affixes) (insert-fun completion-list-insert-choice-function)) (completion-list-mode) + (when completions-highlight-face + (setq-local cursor-face-highlight-nonselected-window t)) (setq-local completion-base-position base-position) (setq-local completion-base-affixes base-affixes) (setq-local completion-list-insert-choice-function insert-fun)) -- 2.41.0