From 6bb815ce266b8e16993246b53a98bee40d7ebe77 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Mon, 10 Feb 2025 19:57:40 +0100 Subject: [PATCH] Fix next/previous-line-completion --- lisp/minibuffer.el | 39 +++++++++-------- lisp/simple.el | 102 ++++++++++++++++----------------------------- 2 files changed, 57 insertions(+), 84 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index d2faa58b526..2054dd86ed8 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2220,12 +2220,11 @@ If the value is nil, no highlighting is performed." (defcustom completions-format 'horizontal "Define the appearance and sorting of completions. -If the value is `vertical', display completions sorted vertically -in columns in the *Completions* buffer. -If the value is `horizontal', display completions sorted in columns -horizontally in alphabetical order, rather than down the screen. -If the value is `one-column', display completions down the screen -in one column." +If the value is `vertical', display completions sorted vertically in +columns in the *Completions* buffer. If the value is `horizontal', +display completions sorted in columns horizontally, rather than down the +screen. If the value is `one-column', display completions down the +screen in one column." :type '(choice (const horizontal) (const vertical) (const one-column)) :version "23.2") @@ -2462,7 +2461,8 @@ function as described in the documentation of `completion-metadata'." colwidth _columns) (let ((column 0) (first t) - (last-title nil)) + (last-title nil) + (colid 0)) (dolist (str strings) (when group-fun (let ((title (funcall group-fun (if (consp str) (car str) str) nil))) @@ -2470,7 +2470,7 @@ function as described in the documentation of `completion-metadata'." (setq last-title title) (when title (insert (if first "" "\n") (format completions-group-format title) "\n") - (setq column 0 + (setq column 0 colid 0 first t))))) (unless first ;; FIXME: `string-width' doesn't pay attention to @@ -2480,7 +2480,7 @@ function as described in the documentation of `completion-metadata'." (apply #'+ (mapcar #'string-width str)) (string-width str))))) ;; No space for `str' at point, move to next line. - (progn (insert "\n") (setq column 0)) + (progn (insert "\n") (setq column 0 colid 0)) (insert " \t") ;; Leave the space unpropertized so that in the case we're ;; already past the goal column, there is still @@ -2489,11 +2489,12 @@ function as described in the documentation of `completion-metadata'." `(display (space :align-to ,column))) nil)) (setq first nil) - (completion--insert str group-fun) + (completion--insert str group-fun colid) ;; Next column to align to. (setq column (+ column ;; Round up to a whole number of columns. - (* colwidth (ceiling length colwidth))))))) + (* colwidth (ceiling length colwidth))) + colid (1+ colid))))) (defun completion--insert-vertical (strings group-fun _length _wwidth @@ -2501,6 +2502,7 @@ function as described in the documentation of `completion-metadata'." (while strings (let ((group nil) (column 0) + (colid 0) (row 0) (rows)) (if group-fun @@ -2527,7 +2529,7 @@ function as described in the documentation of `completion-metadata'." (dolist (str group) (when (> row rows) (forward-line (- -1 rows)) - (setq row 0 column (+ column colwidth))) + (setq row 0 column (+ column colwidth) colid (1+ colid))) (when (> column 0) (end-of-line) (while (> (current-column) column) @@ -2538,7 +2540,7 @@ function as described in the documentation of `completion-metadata'." (insert " \t") (set-text-properties (1- (point)) (point) `(display (space :align-to ,column)))) - (completion--insert str group-fun) + (completion--insert str group-fun colid) (if (> column 0) (forward-line) (insert "\n")) @@ -2553,11 +2555,11 @@ function as described in the documentation of `completion-metadata'." (setq last-title title) (when title (insert (format completions-group-format title) "\n"))))) - (completion--insert str group-fun) + (completion--insert str group-fun 0) (insert "\n")) (delete-char -1))) -(defun completion--insert (str group-fun) +(defun completion--insert (str group-fun &optional column) (if (not (consp str)) (add-text-properties (point) @@ -2567,7 +2569,10 @@ function as described in the documentation of `completion-metadata'." (funcall group-fun str 'transform) str)) (point)) - `(mouse-face highlight cursor-face ,completions-highlight-face completion--string ,str)) + `( mouse-face highlight + cursor-face ,completions-highlight-face + completion--string ,str + completion--column ,column)) ;; If `str' is a list that has 2 elements, ;; then the second element is a suffix annotation. ;; If `str' has 3 elements, then the second element @@ -2578,7 +2583,7 @@ function as described in the documentation of `completion-metadata'." (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 column) (let ((beg (point)) (end (progn (insert suffix) (point)))) (add-text-properties beg end `(mouse-face nil completion--string ,(car str))) diff --git a/lisp/simple.el b/lisp/simple.el index 13319f8fa37..78fb3f5d368 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9965,78 +9965,46 @@ Also see the `completion-auto-wrap' variable." With prefix argument N, move N lines forward (negative N means move backward). Also see the `completion-auto-wrap' variable." - (interactive "p") - (let (line column pos found) - (when (and (bobp) - (> n 0) - (get-text-property (point) 'mouse-face) - (not (get-text-property (point) 'first-completion))) - (let ((inhibit-read-only t)) - (add-text-properties (point) (1+ (point)) '(first-completion t))) - (setq n (1- n))) - - (if (get-text-property (point) 'mouse-face) - ;; If in a completion, move to the start of it. - (completion--move-to-candidate-start) - ;; Try to move to the previous completion. - (setq pos (previous-single-property-change (point) 'mouse-face)) - (if pos - ;; Move to the start of the previous completion. - (progn - (goto-char pos) - (unless (get-text-property (point) 'mouse-face) - (goto-char (previous-single-property-change - (point) 'mouse-face nil (point-min))))) - (cond ((> n 0) (setq n (1- n)) (first-completion)) - ((< n 0) (first-completion))))) - + (interactive "p" completion-list-mode) + (when (and (bobp) + (> n 0) + (get-text-property (point) 'mouse-face) + (not (get-text-property (point) 'first-completion))) + (let ((inhibit-read-only t)) + (add-text-properties (point) (1+ (point)) '(first-completion t))) + (setq n (1- n))) + (if (get-text-property (point) 'mouse-face) + ;; If in a completion, move to the start of it. + (completion--move-to-candidate-start) + ;; Try to move to the previous completion. + (if-let* ((pos (previous-single-property-change (point) 'mouse-face))) + ;; Move to the start of the previous completion. + (progn + (goto-char pos) + (unless (get-text-property (point) 'mouse-face) + (goto-char (previous-single-property-change + (point) 'mouse-face nil (point-min))))) + (cond ((> n 0) (setq n (1- n)) (first-completion)) + ((< n 0) (first-completion))))) + (let ((colid (get-text-property (point) 'completion--column))) (while (> n 0) - (setq found nil pos nil column (current-column) line (line-number-at-pos)) - (completion--move-to-candidate-end) - (while (and (not found) - (eq (forward-line 1) 0) - (not (eobp)) - (move-to-column column)) - (when (get-text-property (point) 'mouse-face) - (setq found t))) - (when (not found) + (if-let* ((match (text-property-search-forward 'completion--column colid t t))) + (goto-char (prop-match-beginning match)) (if (not completion-auto-wrap) - (last-completion) - (save-excursion - (goto-char (point-min)) - (when (and (eq (move-to-column column) column) - (get-text-property (point) 'mouse-face)) - (setq pos (point))) - (while (and (not pos) (> line (line-number-at-pos))) - (forward-line 1) - (when (and (eq (move-to-column column) column) - (get-text-property (point) 'mouse-face)) - (setq pos (point))))) - (if pos (goto-char pos)))) + (user-error "No completion at this column of the next line") + (goto-char (point-min)) + (unless (equal colid (get-text-property (point) 'completion--column)) + (goto-char (prop-match-beginning + (text-property-search-forward 'completion--column colid t t)))))) (setq n (1- n))) - (while (< n 0) - (setq found nil pos nil column (current-column) line (line-number-at-pos)) - (completion--move-to-candidate-start) - (while (and (not found) - (eq (forward-line -1) 0) - (move-to-column column)) - (when (get-text-property (point) 'mouse-face) - (setq found t))) - (when (not found) + (if-let* ((match (text-property-search-backward 'completion--column colid t t))) + (goto-char (prop-match-beginning match)) (if (not completion-auto-wrap) - (first-completion) - (save-excursion - (goto-char (point-max)) - (when (and (eq (move-to-column column) column) - (get-text-property (point) 'mouse-face)) - (setq pos (point))) - (while (and (not pos) (< line (line-number-at-pos))) - (forward-line -1) - (when (and (eq (move-to-column column) column) - (get-text-property (point) 'mouse-face)) - (setq pos (point))))) - (if pos (goto-char pos)))) + (user-error "No previous line") + (goto-char (point-max)) + (goto-char (prop-match-beginning + (text-property-search-backward 'completion--column colid t t))))) (setq n (1+ n))))) (defun choose-completion (&optional event no-exit no-quit) -- 2.39.5