mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-26 07:33:47 +00:00
Code Issues Releases Activity

Try another approach even simpler.

Browse Source 
Perform all the operations directly in the completions buffer.
This commit is contained in:
Jimmy Aguilar Mena 2020-11-22 23:14:18 +01:00
parent 5dd563f053
commit c7c47e78e6
1 changed files with 80 additions and 152 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

232
lisp/zcomplete.el
View File

@ -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")
(let ((point (point))
(pmin (point-min))
(pmax (point-max))
prev next choice)
(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)))
;; 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))
(let* ((obeg (point))
(oend (next-single-property-change obeg 'mouse-face nil (point-max)))
(choice (buffer-substring-no-properties obeg oend)))
(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)))
(move-overlay zcomplete-overlay obeg oend)
(when zcomplete-set-suffix
(zcomplete--set-suffix choice))))
;; 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))
(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)))
(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))
(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)))
(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.")
(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--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-setup ()
(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)))
;; Autoselect candidate if enabled
(when zcomplete-autoselect
(with-selected-window (get-buffer-window (current-buffer) 0)
(next-completion 1)
(zcomplete-select-near)))))
(add-hook 'pre-command-hook
#'zcomplete-maybe-close-completions nil t)
;; Add zcomplete-minibuffer-map bindings to minibuffer
(use-local-map (make-composed-keymap
zcomplete-minibuffer-map (current-local-map))))
(add-hook 'pre-command-hook #'zcomplete--minibuffer-hook nil t)
;; 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)
(setq-local command-error-function #'zcomplete--hack)
(setq-local mode-line-format nil)
(use-local-map zcomplete-completions-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