Try another approach even simpler.feature/completions-highlight-modifications

Perform all the operations directly in the completions buffer.

1 files changed, 85 insertions, 157 deletions

diff --git a/lisp/zcomplete.el b/lisp/zcomplete.el
index aa88ad8e47a..b5af6099297 100644
--- a/lisp/zcomplete.el
+++ b/lisp/zcomplete.el
@@ -61,17 +61,6 @@
   :version "28.1"
   :group 'completion)
 
-(defcustom zcomplete-autoselect nil
-  "Select first candidate without extra tab.
-
-When this variable is nil an extra tab is required to select and
-highlight the first candidate in the *Completions* buffer.  When
-the value is non-nil the candidate is selected every time the
-buffer is shown and updated."
-  :type 'boolean
-  :group 'zcomplete
-  :version "28.1")
-
 (defcustom zcomplete-set-suffix t
   "Insert completion candidate in minibuffer
 
@@ -101,56 +90,35 @@ otherwise it goes to the next completion. "
 (defvar zcomplete-overlay (make-overlay 0 0)
   "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.")
-
 ;; *Completions* side commands
 (defun zcomplete-select-near ()
   "Move to and highlight closer item in the completion list."
   (interactive "p")
-
-  (next-completion -1)
-  (next-completion 1)
-  ;; Try to find the closest completion if not in one
-  (cond
-   ((eobp) (next-completion -1))
-   ((bobp) (next-completion 1)))
-
-  (let* ((obeg (point))
-         (oend (next-single-property-change obeg 'mouse-face nil (point-max)))
-         (choice (buffer-substring-no-properties obeg oend)))
-
-    (move-overlay zcomplete-overlay obeg oend)
-    (when zcomplete-set-suffix
-      (zcomplete--set-suffix choice))))
-
-(defsubst zcomplete-completions-visible-p ()
-  "Return t if *Completions* is visible."
-  (and (windowp minibuffer-scroll-window)
-       (window-live-p minibuffer-scroll-window)
-       (eq t (frame-visible-p (window-frame minibuffer-scroll-window)))))
-
-(defun zcomplete-from-minibuffer (&optional command)
-  (interactive)
-  (and (zcomplete-completions-visible-p)
-       (with-selected-window minibuffer-scroll-window
-         (when-let ((command (or command
-                                 (lookup-key (current-active-maps)
-                                             (this-single-command-keys))
-                                 (lookup-key (current-active-maps)
-                                             (lookup-key local-function-key-map
-                                                         (this-single-command-keys))))))
-           (call-interactively command)
-           (run-hooks 'post-command-hook)))))
-
-;; Maybe this may be done with an advise?
-(defun minibuffer-choose-completion ()
-  "Execute `choose-completion' in *Completions*."
-  (interactive)
-  (if (and (zcomplete-completions-visible-p)
-           (overlay-buffer zcomplete-overlay))
-      (call-interactively #'zcomplete-from-minibuffer)
-    (minibuffer-complete-and-exit)))
+  (let ((point (point))
+        (pmin (point-min))
+        (pmax (point-max))
+        prev next choice)
+
+    ;; Try to find the closest completion if not in one
+    (if (get-text-property point 'mouse-face)
+        (unless isearch-mode ;; assert we are in the beginning
+          (next-completion -1)
+          (next-completion 1))
+
+      (setq prev (previous-single-property-change (min pmax (1+ point)) 'mouse-face nil pmin))
+      (setq next (next-single-property-change point 'mouse-face nil pmax))
+      (if (or (eobp)
+              (< (- point prev) (- next point)))
+          (next-completion -1)
+        (next-completion 1)))
+
+    ;; Select region
+    (setq point (point))
+    (setq next (next-single-property-change point 'mouse-face nil (point-max)))
+    (setq choice (buffer-substring-no-properties point next))
+
+    (move-overlay zcomplete-overlay point next)
+    (zcomplete--set-suffix choice)))
 
 ;; General commands
 (defun zcomplete--set-suffix (choice)
@@ -158,107 +126,82 @@ otherwise it goes to the next 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
-      (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)))))
-
-(defun zcomplete--clear-suffix()
-  "Clear completion suffix if set."
-  (zcomplete--set-suffix ""))
-
-(defvar zcomplete-minibuffer-map
-  (let ((map (make-sparse-keymap)))
-    (set-keymap-parent map minibuffer-local-must-match-map)
-    (dolist (key '(up down left right backtab))
-      (define-key map `[(,key)] #'zcomplete-from-minibuffer))
-
-    (define-key map [remap minibuffer-complete-and-exit] #'minibuffer-choose-completion)
-    map)
-  "Keymap used in minibuffer while *Completions* is active.")
+  (when zcomplete-set-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
+        (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))))))
 
 (defvar zcomplete-completions-map
   (let ((map (make-sparse-keymap)))
-    (set-keymap-parent map completion-list-mode-map)
+    (define-key map [mouse-2] 'choose-completion)
+    (define-key map [follow-link] 'mouse-face)
+    (define-key map [down-mouse-2] nil)
+    (define-key map "\C-m" 'choose-completion)
+    (define-key map "\e\e\e" 'delete-completion-window)
+    (define-key map [left] 'previous-completion)
+    (define-key map [right] 'next-completion)
+    (define-key map [?\t] 'next-completion)
+    (define-key map [backtab] 'previous-completion)
     (define-key map "\C-g" #'quit-window)
     map)
   "Keymap used in *Completions* while highlighting candidates.")
 
-(defun zcomplete--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 zcomplete-tab-no-scroll
-          (zcomplete-from-minibuffer #'next-completion)
-        (if (pos-visible-in-window-p (point-max) window) ;; scroll o go to next
-            (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.
-                (zcomplete-from-minibuffer #'next-completion)
-              ;; 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 zcomplete-maybe-close-completions ()
+(defun zcomplete--minibuffer-hook ()
   "Close *Completions* buffer when the command is not in the map."
-  (zcomplete--clear-suffix)
-  (unless (lookup-key zcomplete-minibuffer-map
+  (zcomplete--set-suffix "")
+  (unless (lookup-key minibuffer-local-must-match-map
                       (this-single-command-keys))
     (minibuffer-hide-completions)))
 
-(defun zcomplete--hide-completions-advise ()
-  "Function to advise minibuffer-hide-completions."
-  (remove-hook 'pre-command-hook
-               #'zcomplete-maybe-close-completions t))
-
-(defun zcomplete-setup ()
+(defun zcomplete--completions-pre-hook ()
+  "Close *Completions* buffer when the command is not in the map."
+  (zcomplete--set-suffix "")
+  (when (eq this-command 'self-insert-command)
+    (call-interactively #'quit-window)))
+
+(defun zcomplete--hack (data context signal)
+  "Alternative to command-error-default-function.
+This will exit the *Completions* if the error is buffer-read-only."
+  (if (eq (car data) 'buffer-read-only)
+      (call-interactively #'quit-window)
+    (command-error-default-function data context signal)))
+
+(defun zcomplete--completions-setup-hook ()
   "Function to call when enabling the `completion-highlight-mode' mode.
 It is called when showing the *Completions* buffer."
   (delete-overlay zcomplete-overlay)
 
-  (with-current-buffer standard-output
-    (when (string= (buffer-name) "*Completions*")
-
-      (add-hook 'pre-command-hook #'zcomplete--clear-suffix nil t)
-      (add-hook 'post-command-hook #'zcomplete-select-near nil t)
-
-      ;; Add zcomplete-completions-map to *Completions*
-      (use-local-map (make-composed-keymap
-                      zcomplete-completions-map (current-local-map)))
+  ;; Add zcomplete-minibuffer-map bindings to minibuffer
+  (add-hook 'pre-command-hook #'zcomplete--minibuffer-hook nil t)
 
-      ;; Autoselect candidate if enabled
-      (when zcomplete-autoselect
-        (with-selected-window (get-buffer-window (current-buffer) 0)
-          (next-completion 1)
-          (zcomplete-select-near)))))
+  ;; After this commands are for Completions
+  (call-interactively #'switch-to-completions)
+  (add-hook 'pre-command-hook #'zcomplete--completions-pre-hook nil t)
+  (add-hook 'post-command-hook #'zcomplete-select-near nil t)
 
-  (add-hook 'pre-command-hook
-            #'zcomplete-maybe-close-completions nil t)
+  (setq-local command-error-function #'zcomplete--hack)
+  (setq-local mode-line-format nil)
+  (use-local-map zcomplete-completions-map)
 
-  ;; Add zcomplete-minibuffer-map bindings to minibuffer
-  (use-local-map (make-composed-keymap
-                  zcomplete-minibuffer-map (current-local-map))))
+  ;; Autoselect candidate if enabled
+  (zcomplete-select-near))
 
 ;;;###autoload
 (define-minor-mode zcomplete-mode
@@ -269,24 +212,9 @@ It is called when showing the *Completions* buffer."
   (if zcomplete-mode
       (progn
         (overlay-put zcomplete-overlay 'face 'zcomplete)
+        (add-hook 'completion-setup-hook #'zcomplete--completions-setup-hook t))
 
-        (setq minibuffer-tab-through-completions-function-save
-              minibuffer-tab-through-completions-function)
-
-        (setq minibuffer-tab-through-completions-function
-              #'zcomplete--minibuffer-tab-through-completions)
-
-        (add-hook 'completion-setup-hook #'zcomplete-setup t)
-        (advice-add 'minibuffer-hide-completions
-                    :before #'zcomplete--hide-completions-advise))
-
-    ;; 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 #'zcomplete-setup)
-    (advice-remove 'minibuffer-hide-completions
-                   #'zcomplete--hide-completions-advise)))
+    (remove-hook 'completion-setup-hook #'zcomplete--completions-setup-hook)))
 
 (provide 'zcomplete)
 ;;; zcomplete.el ends here