From d015144058263e6c087184c68999113798afc4e5 Mon Sep 17 00:00:00 2001 From: Jimmy Aguilar Mena Date: Wed, 26 Aug 2020 07:46:26 +0200 Subject: [PATCH] Add completions-highlight-mode initial implementation. New mode to highlight candidates in *Completions* buffer and improve navigation. * lisp/completions-highlight.el : New file with the initial working implementation. This is an initial version but functional for the moment. --- lisp/completions-highlight.el | 291 ++++++++++++++++++++++++++++++++++ 1 file changed, 291 insertions(+) create mode 100644 lisp/completions-highlight.el diff --git a/lisp/completions-highlight.el b/lisp/completions-highlight.el new file mode 100644 index 00000000000..d601f17703e --- /dev/null +++ b/lisp/completions-highlight.el @@ -0,0 +1,291 @@ +;;; icomplete.el --- minibuffer completion incremental feedback -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Jimmy Aguilar Mena +;; Created: Aug 2020 Jimmy Aguilar Mena spacibba@aol.com +;; Keywords: help, abbrev + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Enabling this package implements more dynamic interaction with the +;; *Completions* buffer to give the user a similar experience than +;; interacting with Zle from zsh shell. + +;; The package intents to implement such functionalities without using +;; hacks or complex functions. And using the default Emacs Completion +;; infrastructure. + + +;;; Code: + +;; minibuffer part + +;; (defcustom minibuffer-tab-go-completion t +;; "If a second `TAB' jump to completion buffer." +;; :type 'boolean +;; :version "28.1" +;; :group 'completion) + +(require 'simple) +(require 'minibuffer) + +(defvar completions-highlight-overlay nil + "Overlay to use when `completion-highlight-mode' is enabled.") + +(defvar minibuffer-tab-through-completions-function-save nil + "Saves the the original value of completion-in-minibuffer-scroll-window.") + +(defun completions-highlight-this-completion (&optional n) + "Highlight the completion under point or near. +N is set to 1 if not specified." + (setq n (or (and n (/ n (abs n))) + 1)) + (next-completion n) + (completions-highlight-next-completion (* -1 n))) + +;; *Completions* side commands + +(defun completions-highlight-next-completion (n) + "Move to and highlight 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") + (next-completion n) + + (let* ((obeg (point)) + (oend (next-single-property-change obeg 'mouse-face nil (point-max))) + (choice (buffer-substring-no-properties obeg oend))) + + (move-overlay completions-highlight-overlay obeg oend) + (minibuffer-completion-set-suffix choice) + + ;; Return the current completion + choice)) + +(defun completions-highlight-previous-completion (n) + "Move to the previous N item in the completion list. +See `completions-highlight-next-completion' for more details." + (interactive "p") + (completions-highlight-next-completion (- n))) + +(defun completions-highlight-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) + (completions-highlight-this-completion arg)) + +(defun completions-highlight-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") + (completions-highlight-next-line-completion (- arg) try-vscroll)) + + +;; Minibuffer side commands + +(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 `completions-highlight-next-completion' in *Completions*. +The argument N is passed directly to +`completions-highlight-next-completion', the command is executed +in another window, but cursor stays in minibuffer." + (interactive "p") + (with-minibuffer-scroll-window + (completions-highlight-next-completion n))) + + +(defun minibuffer-previous-completion (n) + "Execute `completions-highlight-previous-completion' in *Completions*. +The argument N is passed directly to +`completions-highlight-previous-completion', the command is +executed in another window, but cursor stays in minibuffer." + (interactive "p") + (with-minibuffer-scroll-window + (completions-highlight-previous-completion n))) + + +(defun minibuffer-next-line-completion (n) + "Execute `completions-highlight-next-line-completion' in *Completions*. +The argument N is passed directly to +`completions-highlight-next-line-completion', the command is +executed in another window, but cursor stays in minibuffer." + (interactive "p") + (with-minibuffer-scroll-window + (completions-highlight-next-line-completion n))) + + +(defun minibuffer-previous-line-completion (n) + "Execute `completions-highlight-previous-line-completion' in *Completions*. +The argument N is passed directly to +`completions-highlight-previous-line-completion', the command is +executed in another window, but cursor stays in minibuffer." + (interactive "p") + (with-minibuffer-scroll-window + (completions-highlight-previous-line-completion n))) + +;; General commands + +(defun minibuffer-completion-set-suffix (choice) + "Set CHOICE suffix to current completion. +It uses `completion-base-position' to determine the cursor +position. If choice is the empty string the command removes the +suffix." + (let* ((obase-position completion-base-position) + (minibuffer-window (active-minibuffer-window)) + (minibuffer-buffer (window-buffer minibuffer-window)) + (completion-no-auto-exit t)) + + (with-selected-window minibuffer-window + (with-current-buffer minibuffer-buffer + (let* ((prompt-end (minibuffer-prompt-end)) + (cursor-pos (if obase-position + (cadr obase-position) + (choose-completion-guess-base-position choice))) + (prefix-len (- cursor-pos prompt-end)) + (suffix (if (< prefix-len (length choice)) + (substring choice prefix-len) + "")) + (suffix-len (string-width suffix))) + + (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)))))) + +(defmacro completions-highlight-minibufer-bindings (set) + "Add extra/remove keybindings to `minibuffer-local-must-match-map'. +When SET is nil the bindings are removed." + `(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)))) + + +(defmacro completions-highlight-completion-bindings (set) + "Add extra keybindings to `completion-list-mode-map'. +When SET is nil the bindings are removed." + `(progn + (define-key completion-list-mode-map "\C-g" ,(and set ''quit-window)) + + (define-key completion-list-mode-map [up] ,(and set ''completions-highlight-previous-line-completion)) + (define-key completion-list-mode-map "\C-p" ,(and set ''completions-highlight-previous-line-completion)) + (define-key completion-list-mode-map [down] ,(and set ''completions-highlight-next-line-completion)) + (define-key completion-list-mode-map "\C-n" ,(and set ''completions-highlight-next-line-completion)) + + (define-key completion-list-mode-map [right] ,(and set ''completions-highlight-next-completion)) + (define-key completion-list-mode-map "\C-f" ,(and set ''completions-highlight-next-completion)) + (define-key completion-list-mode-map [left] ,(and set ''completions-highlight-previous-completion)) + (define-key completion-list-mode-map "\C-b" ,(and set ''completions-highlight-previous-completion)))) + + +(defun completions-highlight-minibuffer-tab-through-completions () + "Default action in `minibuffer-scroll-window' WINDOW. +This is called when *Completions* window is already visible and +should be assigned to completion-in-minibuffer-scroll-window." + (let ((window minibuffer-scroll-window)) + (with-current-buffer (window-buffer window) + (if (pos-visible-in-window-p (point-max) window) + (if (pos-visible-in-window-p (point-min) window) + ;; If all completions are shown point-min and point-max + ;; are both visible. Then do the highlight. + (minibuffer-next-completion 1) + ;; Else the buffer is too long, so better just scroll it to + ;; the beginning as default behavior. + (set-window-start window (point-min) nil)) + ;; Then point-max is not visible the buffer is too long and we + ;; can scroll. + (with-selected-window window (scroll-up)))))) + +(defun completions-highlight-completions-pre-command-hook () + "Function `pre-command-hook' to use only in the *Completions." + (move-overlay completions-highlight-overlay 0 0) + (minibuffer-completion-set-suffix "")) + +(defun completions-highlight-minibuffer-pre-command-hook () + "Function `pre-command-hook' to use only in the minibuffer." + (unless (eq this-command 'minibuffer-complete-and-exit) + (minibuffer-completion-set-suffix ""))) + +(defun completions-highlight-setup () + "Function to call when enabling the `completion-highlight-mode' mode. +It is called when showing the *Completions* buffer." + + (with-current-buffer standard-output + (when (string= (buffer-name) "*Completions*") + (unless (overlayp completions-highlight-overlay) + (setq completions-highlight-overlay (make-overlay 0 0)) + (overlay-put completions-highlight-overlay 'face 'highlight)) + + (add-hook 'pre-command-hook + #'completions-highlight-completions-pre-command-hook nil t) + (add-hook 'isearch-mode-end-hook + #'completions-highlight-this-completion nil t))) + + (add-hook 'pre-command-hook + #'completions-highlight-minibuffer-pre-command-hook nil t) + + (completions-highlight-minibufer-bindings t)) + +(defun completions-highlight-exit () + "Function to call when disabling the `completion-highlight-mode' mode. +It is called when hiding the *Completions* buffer." + (completions-highlight-minibufer-bindings nil)) + +(define-minor-mode completions-highlight-mode + "Completion highlight mode to enable candidates highlight in the minibuffer." + :global t + :group 'minibuffer + + (if completions-highlight-mode + (progn + (setq minibuffer-tab-through-completions-function-save + minibuffer-tab-through-completions-function) + + (setq minibuffer-tab-through-completions-function + #'completions-highlight-minibuffer-tab-through-completions) + + (add-hook 'completion-setup-hook #'completions-highlight-setup t) + (add-hook 'minibuffer-hide-completions-hook #'completions-highlight-exit) + ) + + ;; Restore the default completion-in-minibuffer-scroll-window + (setq minibuffer-tab-through-completions-function + minibuffer-tab-through-completions-function-save) + + (remove-hook 'completion-setup-hook #'completions-highlight-setup) + (remove-hook 'minibuffer-hide-completions-hook #'completions-highlight-exit) + + (completions-highlight-completion-bindings nil))) + +(provide 'completions-highlight) +;;; completions-highlight.el ends here -- 2.39.5