diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 641a2e5315..cdc1e18708 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -753,6 +753,12 @@ minibuffer-message-clear-timeout (integer :tag "Wait for the number of seconds" 2)) :version "27.1") +(defcustom minibuffer-tab-go-completion t + "If a second `TAB' jump to completion buffer." + :type 'boolean + :version "28.1" + :group 'completion) + (defvar minibuffer-message-timer nil) (defvar minibuffer-message-overlay nil) @@ -940,6 +946,8 @@ completion-styles :type completion--styles-type :version "23.1") + + (defvar completion-category-defaults '((buffer (styles . (basic substring))) (unicode-name (styles . (basic substring))) @@ -1272,6 +1280,122 @@ minibuffer-complete minibuffer-completion-table minibuffer-completion-predicate))) +(defmacro with-minibuffer-scroll-window (&rest body) + "Execute BODY in *Completions* buffer and return to `minibuffer'. +The command is only executed if the `minibuffer-scroll-window' is +alive and active." + `(and (window-live-p minibuffer-scroll-window) + (eq t (frame-visible-p (window-frame minibuffer-scroll-window))) + (with-selected-window minibuffer-scroll-window + (with-current-buffer (window-buffer minibuffer-scroll-window) + ,@body)))) + +(defun minibuffer-next-completion (n) + "Execute `next-completion' in *Completions*. +The argument N is passed directly to `next-completion', the +command is executed in another window, but cursor stays in +minibuffer." + (interactive "p") + (with-minibuffer-scroll-window (next-completion n))) + +(defun minibuffer-previous-completion (n) + "Execute `previous-completion' in *Completions*. +The argument N is passed directly to `previous-completion', the +command is executed in another window, but cursor stays in +minibuffer." + (interactive "p") + (with-minibuffer-scroll-window (previous-completion n))) + +(defun minibuffer-next-line-completion (n) + "Execute `next-line-completion' in *Completions*. +The argument N is passed directly to `next-line-completion', the +command is executed in another window, but cursor stays in +minibuffer." + (interactive "p") + (with-minibuffer-scroll-window (next-line-completion n))) + +(defun minibuffer-previous-line-completion (n) + "Execute `previous-line-completion' in *Completions*. +The argument N is passed directly to `previous-line-completion', +the command is executed in another window, but cursor stays in +minibuffer." + (interactive "p") + (with-minibuffer-scroll-window (previous-line-completion n))) + +(defun minibuffer-completion-set-suffix (choice) + "Set CHOICE suffix to current completion. +It uses `completion-base-position' to determine the cursor position" + (let* ((base-position (or completion-base-position + (list (minibuffer-prompt-end) + (choose-completion-guess-base-position choice)))) + (cursor-pos (cadr base-position)) + (prefix-len (- cursor-pos + (car base-position))) + (minibuffer-window (active-minibuffer-window)) + (minibuffer-buffer (window-buffer minibuffer-window)) + (completion-no-auto-exit t) + (suffix (if (< prefix-len (length choice)) + (substring choice prefix-len) + "")) + (suffix-len (string-width suffix))) + + (with-selected-window minibuffer-window + (with-current-buffer minibuffer-buffer + + (choose-completion-string suffix minibuffer-buffer + (list cursor-pos (point-max))) + (add-face-text-property cursor-pos (+ cursor-pos suffix-len) 'shadow) + (goto-char cursor-pos))))) + +(defun minibuffer-completion-unset-suffix () + "Remove suffix to current completion. +It uses `completion-base-position' to determine the cursor position" + (minibuffer-completion-set-suffix "")) + +(defmacro completions-highlight-minibufer-bindings (set) + "Add extra/remove keybindings to `minibuffer-local-must-match-map'." + `(progn + (define-key minibuffer-local-must-match-map [right] ,(and set ''minibuffer-next-completion)) + (define-key minibuffer-local-must-match-map [left] ,(and set ''minibuffer-previous-completion)) + (define-key minibuffer-local-must-match-map [down] ,(and set ''minibuffer-next-line-completion)) + (define-key minibuffer-local-must-match-map [up] ,(and set ''minibuffer-previous-line-completion)))) + +(defun completions-highlight-unset-minibuffer-bindings () + "Remove extra keybindings from `minibuffer-local-must-match-map'." + (completions-highlight-minibufer-bindings nil)) + +(defmacro completions-highlight-completion-bindings (set) + "Add extra keybindings to `completion-list-mode-map'." + `(progn + (define-key completion-list-mode-map "\C-g" ,(and set ''quit-window)) + (define-key completion-list-mode-map [up] ,(and set ''previous-line-completion)) + (define-key completion-list-mode-map "\C-p" ,(and set ''previous-line-completion)) + (define-key completion-list-mode-map [down] ,(and set ''next-line-completion)) + (define-key completion-list-mode-map "\C-n" ,(and set ''next-line-completion)))) + +(defun completions-highlight-unset-completion-bindings () + "Remove extra keybindings from `completion-list-mode-map'." + (completions-highlight-completion-bindings nil)) + +(defun completions-highlight-minibuffer-complete-setup () + "Add extra functionalities for minibuffer when completions are enabled. +This is called from `completion-setup-function'" + (when (and completion-highlight-candidate + (minibufferp)) + (add-hook 'pre-command-hook + (lambda () + ;; TODO: probably we need an alist here + ;; (message "Precommand %s" (current-local-map)) + (unless (eq this-command 'minibuffer-complete-and-exit) + (minibuffer-completion-unset-suffix)) + ) + nil t) + (add-hook 'minibuffer-hide-completions-hook + #'completions-highlight-unset-minibuffer-bindings) + + (completions-highlight-minibufer-bindings t) + (completions-highlight-completion-bindings t))) + (defun completion--in-region-1 (beg end) ;; If the previous command was not this, ;; mark the completion buffer obsolete. @@ -1288,8 +1412,12 @@ completion--in-region-1 (let ((window minibuffer-scroll-window)) (with-current-buffer (window-buffer window) (if (pos-visible-in-window-p (point-max) window) - ;; If end is in view, scroll up to the beginning. - (set-window-start window (point-min) nil) + (if (and minibuffer-tab-go-completion + (pos-visible-in-window-p (point-min) window)) + (minibuffer-next-completion 1) + ;; If all completions are visible use tab completion + ;; If end is in view, scroll up to the beginning. + (set-window-start window (point-min) nil)) ;; Else scroll down one screen. (with-selected-window window (scroll-up))) @@ -1776,6 +1904,12 @@ completion-setup-hook The completion list buffer is available as the value of `standard-output'. See also `display-completion-list'.") +(defvar minibuffer-hide-completions-hook nil + "Normal hook run at the end of completion-hide-completions. +The hook is called from the minibuffer after hide completions. +When this hook is run, the current buffer is the minibuffer and +the *Completions* buffer is already hidden.") + (defface completions-first-difference '((t (:inherit bold))) "Face for the first character after point in completions. @@ -2040,7 +2174,6 @@ minibuffer-completion-help (completion--done result (if (eq (car bounds) (length result)) 'exact 'finished))))))) - (display-completion-list completions))))) nil))) nil)) @@ -2050,7 +2183,9 @@ minibuffer-hide-completions ;; FIXME: We could/should use minibuffer-scroll-window here, but it ;; can also point to the minibuffer-parent-window, so it's a bit tricky. (let ((win (get-buffer-window "*Completions*" 0))) - (if win (with-selected-window win (bury-buffer))))) + (when win + (with-selected-window win (bury-buffer)) + (run-hooks 'minibuffer-hide-completions-hook)))) (defun exit-minibuffer () "Terminate this minibuffer argument." @@ -2318,6 +2453,7 @@ completion-help-at-point (setq completion-in-region--data `(,start ,(copy-marker end t) ,collection ,(plist-get plist :predicate))) + (completion-in-region-mode 1) (minibuffer-completion-help start end))) (`(,hookfun . ,_) @@ -3754,7 +3890,7 @@ completing-read-default require-match)) (minibuffer--require-match require-match) (base-keymap (if require-match - minibuffer-local-must-match-map + minibuffer-local-must-match-map minibuffer-local-completion-map)) (keymap (if (memq minibuffer-completing-file-name '(nil lambda)) base-keymap diff --git a/lisp/simple.el b/lisp/simple.el index fa6e154004..27dc87217b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8368,6 +8368,12 @@ set-variable ;; Define the major mode for lists of completions. +(defcustom completion-highlight-candidate t + "Non-nil means show help message in *Completions* buffer." + :type 'boolean + :version "28.1" + :group 'completion) + (defvar completion-list-mode-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'choose-completion) @@ -8381,6 +8387,12 @@ completion-list-mode-map (define-key map [backtab] 'previous-completion) (define-key map "q" 'quit-window) (define-key map "z" 'kill-current-buffer) + + (define-key map "\C-g" 'quit-window) + (define-key map [up] 'previous-line-completion) + (define-key map "\C-p" 'previous-line-completion) + (define-key map [down] 'next-line-completion) + (define-key map "\C-n" 'next-line-completion) map) "Local map for completion list buffers.") @@ -8419,6 +8431,10 @@ completion-base-size If nil, Emacs determines which part of the tail end of the buffer's text is involved in completion by comparing the text directly.") + +(defvar completion-overlay nil + "Highlight to use when `completion-highlight-candidate' is non nil.") + (make-obsolete-variable 'completion-base-size 'completion-base-position "23.2") (defun delete-completion-window () @@ -8432,15 +8448,9 @@ delete-completion-window (if (get-buffer-window buf) (select-window (get-buffer-window buf)))))) -(defun previous-completion (n) - "Move to the previous item in the completion list." - (interactive "p") - (next-completion (- n))) - -(defun next-completion (n) +(defun goto-next-completion (n) "Move to the next item in the completion list. With prefix argument N, move N items (negative N means move backward)." - (interactive "p") (let ((beg (point-min)) (end (point-max))) (while (and (> n 0) (not (eobp))) ;; If in a completion, move to the end of it. @@ -8465,6 +8475,46 @@ next-completion (point) 'mouse-face nil beg)) (setq n (1+ n)))))) +(defun next-completion (n) + "Move to the next item in the completion list. +With prefix argument N, move N items (negative N means move backward). +If completion highlight is enabled, highlights the selected candidate. +Returns the completion string if available." + (interactive "p") + (goto-next-completion n) + + (let* ((obeg (point)) + (oend (next-single-property-change obeg 'mouse-face nil (point-max))) + (choice (buffer-substring-no-properties obeg oend))) + + (when completion-highlight-candidate + (move-overlay completion-overlay obeg oend) + (minibuffer-completion-set-suffix choice)) + + ;; Return the current completion + choice)) + +(defun previous-completion (n) + "Move to the previous N item in the completion list see `next-completion'." + (interactive "p") + (next-completion (- n))) + +(defun next-line-completion (&optional arg try-vscroll) + "Go to completion candidate in line above current. +With prefix argument ARG, move to ARG candidate bellow current. +TRY-VSCROLL is passed straight to `line-move'" + (interactive "^p\np") + (line-move arg t nil try-vscroll) + (goto-next-completion 1) + (next-completion -1)) + +(defun previous-line-completion (&optional arg try-vscroll) + "Go to completion candidate in line above current. +With prefix argument ARG, move to ARG candidate above current. +TRY-VSCROLL is passed straight to `line-move'" + (interactive "^p\np") + (next-line-completion (- arg) try-vscroll)) + (defun choose-completion (&optional event) "Choose the completion at point. If EVENT, use EVENT's position to determine the starting position." @@ -8646,6 +8696,12 @@ completion-show-help :version "22.1" :group 'completion) + +(defun completions-highlight-completions-pre-command-hook () + "Function `pre-command-hook' to use only in the minibuffer." + (move-overlay completion-overlay 0 0) + (minibuffer-completion-unset-suffix)) + ;; This function goes in completion-setup-hook, so that it is called ;; after the text of the completion list buffer is written. (defun completion-setup-function () @@ -8684,7 +8740,22 @@ completion-setup-function (insert "Click on a completion to select it.\n")) (insert (substitute-command-keys "In this buffer, type \\[choose-completion] to \ -select the completion near point.\n\n")))))) +select the completion near point.\n\n"))) + + (when (and completion-highlight-candidate + (string= (buffer-name) "*Completions*")) + + (set (make-local-variable 'completion-overlay) (make-overlay 0 0)) + (overlay-put completion-overlay 'face 'highlight) + + (add-hook 'pre-command-hook #'completions-highlight-completions-pre-command-hook nil t) + (add-hook 'isearch-mode-end-hook (lambda () + (goto-next-completion -1) + (next-completion 1)) nil t) + (completions-highlight-completion-bindings t))) + + (completions-highlight-minibuffer-complete-setup))) + (add-hook 'completion-setup-hook #'completion-setup-function)