branch: externals/vertico
commit 3dd5288c0d3b5da329d2f28c56e531aff15e410f
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
More robust vertico-multiform and vertico-buffer
---
README.org | 2 +-
extensions/vertico-buffer.el | 14 +++----
extensions/vertico-multiform.el | 87 ++++++++++++++++++++++-------------------
3 files changed, 54 insertions(+), 49 deletions(-)
diff --git a/README.org b/README.org
index fbff202ed1..fc6baa572d 100644
--- a/README.org
+++ b/README.org
@@ -302,7 +302,7 @@ turn on the mode and -1 to turn off the mode.
#+begin_src emacs-lisp
;; Configure `consult-outline' as a scaled down TOC in a separate buffer
(setq vertico-multiform-command-modes
- '((consult-outline buffer (lambda (_) (text-scale-decrease 1)))))
+ '((consult-outline buffer (lambda (_) (text-scale-set -1)))))
#+end_src
Furthermore you can tune buffer-local settings per command (or category).
diff --git a/extensions/vertico-buffer.el b/extensions/vertico-buffer.el
index f547aaddae..516985f735 100644
--- a/extensions/vertico-buffer.el
+++ b/extensions/vertico-buffer.el
@@ -97,18 +97,18 @@
(set-window-buffer vertico-buffer--window (current-buffer))
(kill-buffer temp))
(let ((sym (make-symbol "vertico-buffer--destroy"))
- (mbwin (active-minibuffer-window))
(depth (recursion-depth))
(now (window-parameter vertico-buffer--window 'no-other-window))
(ndow (window-parameter vertico-buffer--window
'no-delete-other-windows)))
(fset sym (lambda ()
(when (= depth (recursion-depth))
- (when (window-live-p vertico-buffer--window)
- (set-window-parameter vertico-buffer--window
'no-other-window now)
- (set-window-parameter vertico-buffer--window
'no-delete-other-windows ndow))
- (when vertico-buffer-hide-prompt
- (set-window-vscroll mbwin 0))
- (remove-hook 'minibuffer-exit-hook sym))))
+ (with-selected-window (active-minibuffer-window)
+ (when (window-live-p vertico-buffer--window)
+ (set-window-parameter vertico-buffer--window
'no-other-window now)
+ (set-window-parameter vertico-buffer--window
'no-delete-other-windows ndow))
+ (when vertico-buffer-hide-prompt
+ (set-window-vscroll nil 0))
+ (remove-hook 'minibuffer-exit-hook sym)))))
;; NOTE: We cannot use a buffer-local minibuffer-exit-hook here.
;; The hook will not be called when abnormally exiting the minibuffer
;; from another buffer via `keyboard-escape-quit'.
diff --git a/extensions/vertico-multiform.el b/extensions/vertico-multiform.el
index c2c7df6bd7..dce1b30a4d 100644
--- a/extensions/vertico-multiform.el
+++ b/extensions/vertico-multiform.el
@@ -74,55 +74,60 @@ Has lower precedence than
`vertico-multiform-command-settings'."
:type '(alist :key-type symbol
:value-type (alist :key-type symbol :value-type sexp)))
+(defvar vertico-multiform--stack nil)
+
+(defun vertico-multiform--toggle (arg)
+ "Toggle modes from stack depending on ARG."
+ (when-let (win (active-minibuffer-window))
+ (with-selected-window win
+ (dolist (f (car vertico-multiform--stack))
+ (funcall f arg)))))
+
+(defun vertico-multiform--setup ()
+ "Enable modes at minibuffer setup."
+ (let ((cat (completion-metadata-get
+ (completion-metadata
+ (buffer-substring (minibuffer-prompt-end)
+ (max (minibuffer-prompt-end) (point)))
+ minibuffer-completion-table
+ minibuffer-completion-predicate)
+ 'category))
+ (exit (make-symbol "vertico-multiform--exit"))
+ (depth (recursion-depth)))
+ (fset exit (lambda ()
+ (when (= depth (recursion-depth))
+ (remove-hook 'minibuffer-exit-hook exit)
+ (vertico-multiform--toggle -1)
+ (pop vertico-multiform--stack))))
+ (add-hook 'minibuffer-exit-hook exit)
+ (dolist (x (or (and cat (alist-get cat
vertico-multiform-category-settings))
+ (alist-get this-command
vertico-multiform-command-settings)))
+ (set (make-local-variable (car x)) (cdr x)))
+ (push (mapcar (lambda (m)
+ (let ((v (intern (format "vertico-%s-mode" m))))
+ (if (fboundp v) v m)))
+ (or (and cat (alist-get cat
vertico-multiform-category-modes))
+ (alist-get this-command
vertico-multiform-command-modes)))
+ vertico-multiform--stack)
+ (vertico-multiform--toggle 1)
+ (vertico--setup)))
+
(defun vertico-multiform--advice (&rest app)
- "Advice for `vertico--advice' switching modes on and off.
+ "Override advice for `vertico--advice' switching modes on and off.
APP is the original function call."
- (let ((modes 'init)
- (setup (make-symbol "vertico-multiform--setup"))
- (exit (make-symbol "vertico-multiform--exit"))
- (depth (1+ (recursion-depth))))
- (fset setup
- (lambda ()
- (when (eq modes 'init)
- (let ((cat (completion-metadata-get
- (completion-metadata
- (buffer-substring (minibuffer-prompt-end)
- (max (minibuffer-prompt-end)
(point)))
- minibuffer-completion-table
- minibuffer-completion-predicate)
- 'category)))
- (dolist (setting (or (and cat (alist-get cat
vertico-multiform-category-settings))
- (alist-get this-command
vertico-multiform-command-settings)))
- (set (make-local-variable (car setting)) (cdr setting)))
- (setq modes
- (mapcar (lambda (m)
- (let ((v (intern (format "vertico-%s-mode"
m))))
- (if (fboundp v) v m)))
- (or (and cat (alist-get cat
vertico-multiform-category-modes))
- (alist-get this-command
vertico-multiform-command-modes))))))
- (pcase (- (recursion-depth) depth)
- (0 (mapc (lambda (f) (funcall f 1)) modes))
- (1 (mapc (lambda (f) (funcall f -1)) modes)))))
- (fset exit
- (lambda ()
- (pcase (- (recursion-depth) depth)
- (0 (mapc (lambda (f) (funcall f -1)) modes))
- (1 (mapc (lambda (f) (funcall f 1)) modes)))))
- ;; NOTE: The setup/exit nesting is only correct for shallow recursions.
- ;; Hopefully nobody is crazy enough to work at recursion level 99.
- (add-hook 'minibuffer-setup-hook setup (+ -99 depth))
- (add-hook 'minibuffer-exit-hook exit (- 99 depth))
- (unwind-protect
- (apply app)
- (remove-hook 'minibuffer-setup-hook setup)
- (remove-hook 'minibuffer-exit-hook exit))))
+ (unwind-protect
+ (progn
+ (vertico-multiform--toggle -1)
+ (minibuffer-with-setup-hook #'vertico-multiform--setup
+ (apply app)))
+ (vertico-multiform--toggle 1)))
;;;###autoload
(define-minor-mode vertico-multiform-mode
"Configure Vertico in various forms per command."
:global t :group 'vertico
(if vertico-multiform-mode
- (advice-add #'vertico--advice :around #'vertico-multiform--advice)
+ (advice-add #'vertico--advice :override #'vertico-multiform--advice)
(advice-remove #'vertico--advice #'vertico-multiform--advice)))
(provide 'vertico-multiform)
