Move feature/popup => ui/popup

And move settings to ui/popup/init.el
This commit is contained in:
Henrik Lissner 2018-05-14 01:20:53 +02:00
parent 40bd1da5a5
commit 83118dc65c
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
6 changed files with 68 additions and 67 deletions

277
modules/ui/popup/+hacks.el Normal file
View file

@ -0,0 +1,277 @@
;;; ui/popup/+hacks.el -*- lexical-binding: t; -*-
;; What follows are all the hacks needed to get various parts of Emacs and other
;; plugins to cooperate with the popup management system. Essentially, it comes
;; down to:
;;
;; 1. Making plugins that control their own window environment less greedy (e.g.
;; org agenda, which tries to reconfigure the entire frame (by deleting all
;; other windows) just to pop up one tiny window).
;; 2. Forcing plugins to use `display-buffer' and `pop-to-buffer' instead of
;; `switch-to-buffer' (which is unaffected by `display-buffer-alist', which
;; this module heavily relies on).
;; 3. Closing popups (temporarily) before functions that are highly destructive
;; to the illusion of popup control get run (with the use of the
;; `save-popups!' macro).
;;
;; Keep in mind, all this black magic may break in future updates, and will need
;; to be watched carefully for corner cases. Also, once this file is loaded, its
;; changes are irreversible without restarting Emacs! I don't like it either,
;; but I will address this over time.
;;
;; Hacks should be kept in alphabetical order, named after the feature they
;; modify, and should follow a ;; `package-name' header line.
;;
;; Core functions
;;
;; Don't try to resize popup windows
(advice-add #'balance-windows :around #'+popup*save)
;;
;; External functions
;;
;; `company'
(after! company
(defun +popup*dont-select-me (orig-fn &rest args)
(let ((+popup--inhibit-select t))
(apply orig-fn args)))
(advice-add #'company-show-doc-buffer :around #'+popup*dont-select-me))
;; `eshell'
(after! eshell
(setq eshell-destroy-buffer-when-process-dies t)
;; When eshell runs a visual command (see `eshell-visual-commands'), it spawns
;; a term buffer to run it in, but where it spawns it is the problem...
(defun +popup*eshell-undedicate-popup (orig-fn &rest args)
"Force spawned term buffer to share with the eshell popup (if necessary)."
(when (+popup-window-p)
(set-window-dedicated-p nil nil)
(add-transient-hook! #'eshell-query-kill-processes :after
(set-window-dedicated-p nil t)))
(apply orig-fn args))
(advice-add #'eshell-exec-visual :around #'+popup*eshell-undedicate-popup))
;; `evil'
(after! evil
(defun +popup*evil-command-window (hist cmd-key execute-fn)
"The evil command window has a mind of its own (uses `switch-to-buffer'). We
monkey patch it to use pop-to-buffer, and to remember the previous window."
(when (eq major-mode 'evil-command-window-mode)
(user-error "Cannot recursively open command line window"))
(dolist (win (window-list))
(when (equal (buffer-name (window-buffer win))
"*Command Line*")
(kill-buffer (window-buffer win))
(delete-window win)))
(setq evil-command-window-current-buffer (current-buffer))
(ignore-errors (kill-buffer "*Command Line*"))
(with-current-buffer (pop-to-buffer "*Command Line*")
(setq-local evil-command-window-execute-fn execute-fn)
(setq-local evil-command-window-cmd-key cmd-key)
(evil-command-window-mode)
(evil-command-window-insert-commands hist)))
(defun +popup*evil-command-window-execute ()
"Execute the command under the cursor in the appropriate buffer, rather than
the command buffer."
(interactive)
(let ((result (buffer-substring (line-beginning-position)
(line-end-position)))
(execute-fn evil-command-window-execute-fn)
(execute-window (get-buffer-window evil-command-window-current-buffer))
(popup (selected-window)))
(if execute-window
(select-window execute-window)
(user-error "Originating buffer is no longer active"))
;; (kill-buffer "*Command Line*")
(delete-window popup)
(funcall execute-fn result)
(setq evil-command-window-current-buffer nil)))
;; Make evil-mode cooperate with popups
(advice-add #'evil-command-window :override #'+popup*evil-command-window)
(advice-add #'evil-command-window-execute :override #'+popup*evil-command-window-execute)
;; Don't mess with popups
(advice-add #'+evil--window-swap :around #'+popup*save)
(advice-add #'evil-window-move-very-bottom :around #'+popup*save)
(advice-add #'evil-window-move-very-top :around #'+popup*save)
(advice-add #'evil-window-move-far-left :around #'+popup*save)
(advice-add #'evil-window-move-far-right :around #'+popup*save))
;; `help-mode'
(after! help-mode
(defun doom--switch-from-popup (location)
(let (origin)
(save-popups!
(switch-to-buffer (car location) nil t)
(if (not (cdr location))
(message "Unable to find location in file")
(goto-char (cdr location))
(recenter)
(setq origin (selected-window))))
(select-window origin)))
;; Help buffers use `pop-to-window' to decide where to open followed links,
;; which can be unpredictable. It should *only* replace the original buffer we
;; opened the popup from. To fix this these three button types need to be
;; redefined to set aside the popup before following a link.
(define-button-type 'help-function-def
:supertype 'help-xref
'help-function
(lambda (fun file)
(require 'find-func)
(when (eq file 'C-source)
(setq file (help-C-file-name (indirect-function fun) 'fun)))
(doom--switch-from-popup (find-function-search-for-symbol fun nil file))))
(define-button-type 'help-variable-def
:supertype 'help-xref
'help-function
(lambda (var &optional file)
(when (eq file 'C-source)
(setq file (help-C-file-name var 'var)))
(doom--switch-from-popup (find-variable-noselect var file))))
(define-button-type 'help-face-def
:supertype 'help-xref
'help-function
(lambda (fun file)
(require 'find-func)
(doom--switch-from-popup (find-function-search-for-symbol fun 'defface file)))))
;; `helpful'
(after! helpful
(defun +popup*helpful--navigate (button)
(let ((path (substring-no-properties (button-get button 'path)))
origin)
(save-popups!
(find-file path)
;; We use `get-text-property' to work around an Emacs 25 bug:
;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=f7c4bad17d83297ee9a1b57552b1944020f23aea
(-when-let (pos (get-text-property button 'position
(marker-buffer button)))
(goto-char pos))
(setq origin (selected-window))
(recenter))
(select-window origin)))
(advice-add #'helpful--navigate :override #'+popup*helpful--navigate))
;; `Info'
(defun +popup*switch-to-info-window (&rest _)
(when-let* ((win (get-buffer-window "*info*")))
(when (+popup-window-p win)
(select-window win))))
(advice-add #'info-lookup-symbol :after #'+popup*switch-to-info-window)
;; `neotree'
(after! neotree
(advice-add #'neo-util--set-window-width :override #'ignore)
(advice-remove #'balance-windows #'ad-Advice-balance-windows))
;; `org'
(after! org
;; Org has a scorched-earth window management system I'm not fond of. i.e. it
;; kills all windows and monopolizes the frame. No thanks. We can do better
;; ourselves.
(defun +popup*suppress-delete-other-windows (orig-fn &rest args)
(if +popup-mode
(cl-letf (((symbol-function 'delete-other-windows)
(symbol-function 'ignore)))
(apply orig-fn args))
(apply orig-fn args)))
(advice-add #'org-add-log-note :around #'+popup*suppress-delete-other-windows)
(advice-add #'org-capture-place-template :around #'+popup*suppress-delete-other-windows)
(advice-add #'org-export--dispatch-ui :around #'+popup*suppress-delete-other-windows)
(defun +popup*org-src-pop-to-buffer (orig-fn buffer context)
"Hand off the src-block window to the popup system by using `display-buffer'
instead of switch-to-buffer-*."
(if +popup-mode
(if (eq org-src-window-setup 'switch-invisibly) ; for internal calls
(set-buffer buffer)
(display-buffer buffer))
(funcall orig-fn buffer context)))
(advice-add #'org-src-switch-to-buffer :around #'+popup*org-src-pop-to-buffer)
(setq org-src-window-setup 'other-window)
;; Ensure todo, agenda, and other minor popups are delegated to the popup system.
(defun +popup*org-pop-to-buffer (orig-fn buf &optional norecord)
"Use `pop-to-buffer' instead of `switch-to-buffer' to open buffer.'"
(if +popup-mode
(pop-to-buffer
(cond ((stringp buf) (get-buffer-create buf))
((bufferp buf) buf)
(t (error "Invalid buffer %s" buf))))
(funcall orig-fn buf norecord)))
(advice-add #'org-switch-to-buffer-other-window :around #'+popup*org-pop-to-buffer)
;; `org-agenda'
(setq org-agenda-window-setup 'other-window
org-agenda-restore-windows-after-quit nil)
;; Don't monopolize frame!
(advice-add #'org-agenda :around #'+popup*suppress-delete-other-windows))
;; `persp-mode'
(progn
(defun +popup*persp-mode-restore-popups (&rest _)
"Restore popup windows when loading a perspective from file."
(dolist (window (window-list))
(when (+popup-parameter 'popup window)
(+popup--init window nil))))
(advice-add #'persp-load-state-from-file :after #'+popup*persp-mode-restore-popups))
;; `multi-term'
(after! multi-term
(setq multi-term-buffer-name "doom terminal"))
;; `wgrep'
(progn
;; close the popup after you're done with a wgrep buffer
(advice-add #'wgrep-abort-changes :after #'+popup*close)
(advice-add #'wgrep-finish-edit :after #'+popup*close))
;; `which-key'
(setq which-key-popup-type 'custom
which-key-custom-popup-max-dimensions-function (lambda (_) (which-key--side-window-max-dimensions))
which-key-custom-hide-popup-function #'which-key--hide-buffer-side-window
which-key-custom-show-popup-function
(lambda (act-popup-dim)
(cl-letf (((symbol-function 'display-buffer-in-side-window)
(lambda (buffer alist)
(+popup-display-buffer
buffer (append '((vslot . -9999)) alist)))))
(which-key--show-buffer-side-window act-popup-dim))))
;; `windmove'
(progn
;; Users should be about to hop into popups easily, but Elisp shouldn't.
(defun doom*ignore-window-parameters (orig-fn &rest args)
"Allow *interactive* window moving commands to traverse popups."
(cl-letf (((symbol-function #'windmove-find-other-window)
(lambda (dir &optional arg window)
(window-in-direction
(pcase dir (`up 'above) (`down 'below) (_ dir))
window (bound-and-true-p +popup-mode) arg windmove-wrap-around t))))
(apply orig-fn args)))
(advice-add #'windmove-up :around #'doom*ignore-window-parameters)
(advice-add #'windmove-down :around #'doom*ignore-window-parameters)
(advice-add #'windmove-left :around #'doom*ignore-window-parameters)
(advice-add #'windmove-right :around #'doom*ignore-window-parameters))

140
modules/ui/popup/README.org Normal file
View file

@ -0,0 +1,140 @@
#+TITLE: :feature popup
This module provides a highly customizable popup window management system.
#+begin_quote
Not all windows are created equally. Some are less important. Some I want gone
once they have served their purpose, like code output or a help buffer. Others I
want to stick around, like a scratch buffer or org-capture popup.
More than that, popups ought to be be the second class citizens of my editor;
spawned off to the side, discarded with the simple push of a button
(Escape/C-g), and easily restored if I want to see them again. Of course, this
system should clean up after itself and kill off buffers I mark as transient.
#+end_quote
* Table of Contents :TOC:
- [[#configuration][Configuration]]
- [[#the-popup-setting][The ~:popup~ setting]]
- [[#disabling-aggressive-mode-line-hiding-in-popups][Disabling aggressive mode-line hiding in popups]]
- [[#appendix][Appendix]]
- [[#commands][Commands]]
- [[#library][Library]]
- [[#hacks][Hacks]]
* Configuration
** The ~:popup~ setting
This module has one setting for defining your own rules for popups:
#+BEGIN_SRC emacs-lisp
(set! :popup CONDITION &optional ALIST PARAMETERS)
#+END_SRC
+ ~CONDITION~ can be a function or regexp string. If the function returns
non-nil, or the regexp string matches the buffer's name, it will be opened in
a popup window.
+ ~ALIST~ dictates the characteristics of the popup, such as what side to spawn
it on and what size to make it. See ~display-buffer~'s documentation to see
what parameters are supported.
This supports one custom parameter: ~size~, which will map to ~window-width~
or ~window-height~ depending on what ~side~ you (or the defaults) specify.
+ ~PARAMETERS~ dictate what window parameters are set on the popup window. See
~+popup-window-parameters~'s documentation and the [[https://www.gnu.org/software/emacs/manual/html_node/elisp/Window-Parameters.html#Window-Parameters][Window Parameters section
of the Emacs manual]] for what parameters are supported.
This supports four custom parameters: =transient=, =quit=, =select= and
=modeline=. For details on these, look at the documentation for
~+popup-window-parameters.~
Rules are added to ~display-buffer-alist~, which instructs ~display-buffer~
calls on how to set up windows for buffers that meet certain conditions.
#+begin_quote
The ~switch-to-buffer~ command (and its ~switch-to-buffer-*~ variants) are not
affected by ~display-buffer-alist~.
#+end_quote
Here are a couple example rules:
#+BEGIN_SRC emacs-lisp
(set! :popup "^ \\*" '((slot . -1))) ; fallback rule for special buffers
(set! :popup "^\\*" nil '((select . t)))
(set! :popup "^\\*Completions" '((slot . -1)) '((transient . 0)))
(set! :popup "^\\*\\(?:scratch\\|Messages\\)" nil '((transient)))
(set! :popup "^\\*Help"
'((slot . -1) (size . 0.2))
'((select . t)))
(set! :popup "^\\*doom:"
'((size . 0.35))
'((select . t) (modeline . t) (quit) (transient)))
#+END_SRC
Omitted parameters in a ~:popup~ rule will use the defaults set in
~+popup-default-alist~ and ~+popup-default-parameters~.
** Disabling aggressive mode-line hiding in popups
There are two ways to go about this. You can turn on modelines by changing the
default ~'modeline~ window parameter in ~+popup-default-parameters~:
#+BEGIN_SRC emacs-lisp
;; put in private/$USER/config.el
(map-put +popup-default-parameters 'modeline t)
#+END_SRC
This will ensure all popups have a modeline /by default/, but allows you to override this on a per-popup basis.
*Alternatively*, you can disable modeline-hiding entirely:
#+BEGIN_SRC emacs-lisp
;; put in private/$USER/config.el
(remove-hook '+popup-buffer-mode-hook '+popup|set-modeline)
#+END_SRC
* Appendix
** Commands
+ ~+popup/other~ (aliased to ~other-popup~, bound to ~C-x p~)
+ ~+popup/toggle~
+ ~+popup/close~
+ ~+popup/close-all~
+ ~+popup/toggle~
+ ~+popup/restore~
+ ~+popup/raise~
** Library
+ Functions
+ ~+popup-window-p WINDOW~
+ ~+popup-buffer-p BUFFER~
+ ~+popup-buffer BUFFER &optional ALIST~
+ ~+popup-parameter PARAMETER &optional WINDOW~
+ ~+popup-parameter-fn PARAMETER &optional WINDOW~
+ ~+popup-windows~
+ Macros
+ ~without-popups!~
+ ~save-popups!~
+ Hooks
+ ~+popup|adjust-fringes~
+ ~+popup|set-modeline~
+ ~+popup|close-on-escape~
+ ~+popup|cleanup-rules~
+ Minor modes
+ ~+popup-mode~
+ ~+popup-buffer-mode~
** Hacks
+ =help-mode= has been advised to follow file links in the buffer you were in
before entering the popup, rather than in a new window.
+ =wgrep= buffers are advised to close themselves when aborting or committing
changes.
+ =persp-mode= is advised to restore popup windows when loading a session from
file.
+ Interactive calls to ~windmove-*~ commands (used by ~evil-window-*~ commands)
will ignore the ~no-other-window~ window parameter, allowing you to switch to
popup windows as if they're ordinary windows.
+ ~balance-windows~ has been advised to close popups while it does its business,
then restores them afterwards.
+ =neotree= advises ~balance-windows~, which causes major slow-downs when paired
with our ~balance-window~ advice, so we removes neotree's advice.
+ =org-mode= is an ongoing (and huge) effort. It has a scorched-earth window
management system I'm not fond of. ie. it kills all windows and monopolizes
the frame. On top of that, it /really/ likes to use ~switch-to-buffer~ for
most of its buffer management, which completely bypasses
~display-buffer-alist~.

View file

@ -0,0 +1,683 @@
;;; ui/popup/autoload.el -*- lexical-binding: t; -*-
(defvar +popup--populate-wparams (not EMACS26+))
(defvar +popup--inhibit-transient nil)
(defvar +popup--inhibit-select nil)
(defvar +popup--old-display-buffer-alist nil)
(defvar +popup--remember-last t)
(defvar +popup--last nil)
(defvar-local +popup--timer nil)
(defun +popup--remember (windows)
"Remember WINDOWS (a list of windows) for later restoration."
(cl-assert (cl-every #'windowp windows) t)
(setq +popup--last
(cl-loop for w in windows
collect (cons (window-buffer w)
(window-state-get w)))))
(defun +popup--kill-buffer (buffer ttl)
"Tries to kill BUFFER, as was requested by a transient timer. If it fails, eg.
the buffer is visible, then set another timer and try again later."
(when (buffer-live-p buffer)
(let ((inhibit-quit t)
(kill-buffer-hook (remq '+popup|kill-buffer-hook kill-buffer-hook)))
(cond ((eq ttl 0)
(kill-buffer buffer))
((get-buffer-window buffer)
(with-current-buffer buffer
(setq +popup--timer
(run-at-time ttl nil #'+popup--kill-buffer buffer ttl))))
((with-demoted-errors "Error killing transient buffer: %s"
(let (confirm-kill-processes)
(when-let* ((process (get-buffer-process (current-buffer))))
(kill-process process)))
(kill-buffer buffer)))))))
(defun +popup--init (window &optional alist)
"Initializes a popup window. Run any time a popup is opened. It sets the
default window parameters for popup windows, clears leftover transient timers
and enables `+popup-buffer-mode'."
(with-selected-window window
(when (and alist +popup--populate-wparams)
;; Emacs 26+ will automatically map the window-parameters alist entry to
;; the popup window, so we need this for Emacs 25.x users
(dolist (param (cdr (assq 'window-parameters alist)))
(set-window-parameter window (car param) (cdr param))))
(set-window-parameter window 'popup t)
(set-window-parameter window 'no-other-window t)
(set-window-parameter window 'delete-window #'+popup--delete-window)
(set-window-parameter window 'delete-other-windows #'+popup/close-all)
(set-window-dedicated-p window 'popup)
(window-preserve-size
window (memq (window-parameter window 'window-side)
'(left right))
t)
(+popup-buffer-mode +1)
(run-hooks '+popup-create-window-hook)))
(defun +popup--delete-window (window)
"Do housekeeping before destroying a popup window.
+ Disables `+popup-buffer-mode' so that any hooks attached to it get a chance to
run and do cleanup of its own.
+ Either kills the buffer or sets a transient timer, if the window has a
`transient' window parameter (see `+popup-window-parameters').
+ And finally deletes the window!"
(let ((buffer (window-buffer window))
ttl)
(when (and (buffer-file-name buffer)
(buffer-modified-p buffer)
(y-or-n-p "Popup buffer is modified. Save it?"))
(with-current-buffer buffer (save-buffer)))
(set-buffer-modified-p nil)
(let ((ignore-window-parameters t))
(delete-window window))
(unless (window-live-p window)
(with-current-buffer buffer
(+popup-buffer-mode -1)
;; t = default
;; integer = ttl
;; nil = no timer
(unless +popup--inhibit-transient
(setq ttl (+popup-parameter-fn 'transient window buffer))
(when ttl
(when (eq ttl t)
(setq ttl +popup-ttl))
(cl-assert (integerp ttl) t)
(if (= ttl 0)
(+popup--kill-buffer buffer 0)
(add-hook 'kill-buffer-hook #'+popup|kill-buffer-hook nil t)
(setq +popup--timer
(run-at-time ttl nil #'+popup--kill-buffer
buffer ttl)))))))))
(defun +popup--normalize-alist (alist)
"Merge `+popup-default-alist' and `+popup-default-parameters' with ALIST."
(if (not alist)
(setq alist +popup-default-alist)
(let* ((alist (map-merge 'list +popup-default-alist alist))
(params (map-merge 'list
+popup-default-parameters
(cdr (assq 'window-parameters alist)))))
;; translate side => window-(width|height)
(when-let* ((size (cdr (assq 'size alist)))
(side (or (cdr (assq 'side alist)) 'bottom)))
(map-delete alist 'size)
(map-put alist (if (memq side '(left right))
'window-width
'window-height)
size))
;;
(map-put alist 'window-parameters params)
(nreverse alist))))
;;
;; Public library
;;
;;;###autoload
(defun +popup-buffer-p (&optional buffer)
"Return non-nil if BUFFER is a popup buffer. Defaults to the current buffer."
(unless buffer
(setq buffer (current-buffer)))
(cl-assert (bufferp buffer) t)
(and (buffer-live-p buffer)
(buffer-local-value '+popup-buffer-mode buffer)
buffer))
;;;###autoload
(defun +popup-window-p (&optional window)
"Return non-nil if WINDOW is a popup window. Defaults to the current window."
(unless window
(setq window (selected-window)))
(cl-assert (windowp window) t)
(and (window-live-p window)
(window-parameter window 'popup)
window))
;;;###autoload
(defun +popup-buffer (buffer &optional alist)
"Open BUFFER in a popup window. ALIST describes its features."
(let ((old-window (selected-window))
(alist (+popup--normalize-alist alist))
(window-min-height 3))
(when-let* ((new-window (run-hook-with-args-until-success
'+popup-display-buffer-actions buffer alist)))
(+popup--init new-window alist)
(unless +popup--inhibit-select
(let ((select (+popup-parameter 'select new-window)))
(if (functionp select)
(funcall select new-window old-window)
(select-window (if select new-window old-window)))))
new-window)))
;;;###autoload
(defun +popup-parameter (parameter &optional window)
"Fetch the window PARAMETER (symbol) of WINDOW"
(window-parameter (or window (selected-window)) parameter))
;;;###autoload
(defun +popup-parameter-fn (parameter &optional window &rest args)
"Fetch the window PARAMETER (symbol) of WINDOW. If it is a function, run it
with ARGS to get its return value."
(let ((val (+popup-parameter parameter window)))
(if (functionp val)
(apply val args)
val)))
;;;###autoload
(defun +popup-windows ()
"Returns a list of all popup windows."
(cl-remove-if-not #'+popup-window-p (window-list)))
;;;###autoload
(defun +popup-shrink-to-fit (&optional window)
"Shrinks WINDOW to fit the buffer contents, if the buffer isn't empty.
Uses `shrink-window-if-larger-than-buffer'."
(unless window
(setq window (selected-window)))
(unless (= (- (point-max) (point-min)) 0)
(shrink-window-if-larger-than-buffer window)))
;;
;; Minor mode
;;
;;;###autoload
(defvar +popup-mode-map (make-sparse-keymap)
"Active keymap in a session with the popup system enabled. See
`+popup-mode'.")
;;;###autoload
(defvar +popup-buffer-mode-map (make-sparse-keymap)
"Active keymap in popup windows. See `+popup-buffer-mode'.")
;;;###autoload
(define-minor-mode +popup-mode
"Global minor mode representing Doom's popup management system."
:init-value nil
:global t
:keymap +popup-mode-map
(cond (+popup-mode
(add-hook 'doom-unreal-buffer-functions #'+popup-buffer-p)
(add-hook 'doom-escape-hook #'+popup|close-on-escape t)
(add-hook 'doom-cleanup-hook #'+popup|cleanup-rules)
(add-hook 'after-change-major-mode-hook #'+popup|set-modeline-on-enable)
(setq +popup--old-display-buffer-alist display-buffer-alist
display-buffer-alist +popup--display-buffer-alist
window--sides-inhibit-check t)
(dolist (prop +popup-window-parameters)
(push (cons prop 'writable) window-persistent-parameters)))
(t
(remove-hook 'doom-unreal-buffer-functions #'+popup-buffer-p)
(remove-hook 'doom-escape-hook #'+popup|close-on-escape)
(remove-hook 'doom-cleanup-hook #'+popup|cleanup-rules)
(remove-hook 'after-change-major-mode-hook #'+popup|set-modeline-on-enable)
(setq display-buffer-alist +popup--old-display-buffer-alist
window--sides-inhibit-check nil)
(+popup|cleanup-rules)
(dolist (prop +popup-window-parameters)
(map-delete window-persistent-parameters prop)))))
;;;###autoload
(define-minor-mode +popup-buffer-mode
"Minor mode for individual popup windows.
It is enabled when a buffer is displayed in a popup window and disabled when
that window has been changed or closed."
:init-value nil
:keymap +popup-buffer-mode-map
(when (and +popup-buffer-mode (timerp +popup--timer))
(remove-hook 'kill-buffer-hook #'+popup|kill-buffer-hook t)
(cancel-timer +popup--timer)
(setq +popup--timer nil)))
(put '+popup-buffer-mode 'permanent-local t)
(put '+popup-buffer-mode 'permanent-local-hook t)
;;
;; Hooks
;;
;;;###autoload
(defun +popup|adjust-fringes ()
"Hides the fringe in popup windows, restoring them if `+popup-buffer-mode' is
disabled."
(let ((f (if +popup-buffer-mode 0)))
(set-window-fringes nil f f fringes-outside-margins)))
;;;###autoload
(defun +popup|set-modeline-on-enable ()
"Don't show modeline in popup windows without a `modeline' window-parameter.
+ If one exists and it's a symbol, use `doom-modeline' to grab the format.
+ If non-nil, show the mode-line as normal.
+ If nil (or omitted), then hide the modeline entirely (the default).
+ If a function, it takes the current buffer as its argument and must return one
of the above values."
(when +popup-buffer-mode
(let ((modeline (+popup-parameter-fn 'modeline nil (current-buffer))))
(cond ((eq modeline 't))
((or (eq modeline 'nil)
(null modeline))
(hide-mode-line-mode +1))
((symbolp modeline)
(when-let* ((hide-mode-line-format (doom-modeline modeline)))
(hide-mode-line-mode +1)))))))
;;;###autoload
(defun +popup|unset-modeline-on-disable ()
"Restore the modeline when `+popup-buffer-mode' is deactivated."
(when (and (not +popup-buffer-mode)
(bound-and-true-p hide-mode-line-mode))
(hide-mode-line-mode -1)))
;;;###autoload
(defun +popup|close-on-escape ()
"If called inside a popup, try to close that popup window (see
`+popup/close'). If called outside, try to close all popup windows (see
`+popup/close-all')."
(if (+popup-window-p)
(+popup/close)
(+popup/close-all)))
;;;###autoload
(defun +popup|cleanup-rules ()
"Cleans up any duplicate popup rules."
(interactive)
(cl-delete-duplicates
+popup--display-buffer-alist
:key #'car :test #'equal :from-end t)
(when +popup-mode
(setq display-buffer-alist +popup--display-buffer-alist)))
;;;###autoload
(defun +popup|kill-buffer-hook ()
"TODO"
(when-let* ((window (get-buffer-window)))
(when (+popup-window-p window)
(let ((+popup--inhibit-transient t))
(+popup--delete-window window)))))
;;
;; Commands
;;
;;;###autoload
(defalias 'other-popup #'+popup/other)
;;;###autoload
(defun +popup/other ()
"Cycle through popup windows, like `other-window'. Ignores regular windows."
(interactive)
(let ((popups (+popup-windows))
(window (selected-window)))
(unless popups
(user-error "No popups are open"))
(select-window (if (+popup-window-p)
(or (car-safe (cdr (memq window popups)))
(car (delq window popups))
(car popups))
(car popups)))))
;;;###autoload
(defun +popup/close (&optional window force-p)
"Close WINDOW, if it's a popup window.
This will do nothing if the popup's `quit' window parameter is either nil or
'other. This window parameter is ignored if FORCE-P is non-nil."
(interactive
(list (selected-window)
current-prefix-arg))
(unless window
(setq window (selected-window)))
(when (and (+popup-window-p window)
(or force-p
(memq (+popup-parameter-fn 'quit window window)
'(t current))))
(when +popup--remember-last
(+popup--remember (list window)))
(delete-window window)
t))
;;;###autoload
(defun +popup/close-all (&optional force-p)
"Close all open popup windows.
This will ignore popups with an `quit' parameter that is either nil or 'current.
This window parameter is ignored if FORCE-P is non-nil."
(interactive "P")
(let (targets +popup--remember-last)
(dolist (window (+popup-windows))
(when (or force-p
(memq (+popup-parameter-fn 'quit window window)
'(t other)))
(push window targets)))
(when targets
(+popup--remember targets)
(mapc #'delete-window targets)
t)))
;;;###autoload
(defun +popup/toggle ()
"If popups are open, close them. If they aren't, restore the last one or open
the message buffer in a popup window."
(interactive)
(let ((+popup--inhibit-transient t))
(cond ((+popup-windows) (+popup/close-all t))
((ignore-errors (+popup/restore)))
((display-buffer (get-buffer "*Messages*"))))))
;;;###autoload
(defun +popup/restore ()
"Restore the last popups that were closed, if any."
(interactive)
(unless +popup--last
(error "No popups to restore"))
(cl-loop for (buffer . state) in +popup--last
if (and (buffer-live-p buffer)
(display-buffer buffer))
do (window-state-put state it))
(setq +popup--last nil)
t)
;;;###autoload
(defun +popup/raise ()
"Raise the current popup window into a regular window."
(interactive)
(unless (+popup-window-p)
(user-error "Cannot raise a non-popup window"))
(let ((window (selected-window))
(buffer (current-buffer))
+popup--remember-last)
(set-window-parameter window 'transient nil)
(+popup/close window 'force)
(display-buffer-pop-up-window buffer nil)))
;;
;; Macros
;;
;;;###autoload
(defmacro with-popup-rules! (rules &rest body)
"Evaluate BODY with popup RULES. RULES is a list of popup rules. Each rule
should match the arguments of `+popup-define' or the :popup setting."
(declare (indent defun))
`(let ((+popup--display-buffer-alist +popup--old-display-buffer-alist)
display-buffer-alist)
,@(cl-loop for rule in rules collect `(+popup-define ,@rule))
(when (bound-and-true-p +popup-mode)
(setq display-buffer-alist +popup--display-buffer-alist))
,@body))
;;;###autoload
(defmacro without-popups! (&rest body)
"Run BODY with a default `display-buffer-alist', ignoring the popup rules set
with the :popup setting."
`(let ((display-buffer-alist +popup--old-display-buffer-alist))
,@body))
;;;###autoload
(defmacro save-popups! (&rest body)
"Sets aside all popups before executing the original function, usually to
prevent the popup(s) from messing up the UI (or vice versa)."
`(let* ((in-popup-p (+popup-buffer-p))
(popups (+popup-windows))
(+popup--inhibit-transient t)
+popup--last)
(dolist (p popups)
(+popup/close p 'force))
(unwind-protect
(progn ,@body)
(when popups
(let ((origin (selected-window)))
(+popup/restore)
(unless in-popup-p
(select-window origin)))))))
;;
;; Advice
;;
;;;###autoload
(defun +popup*close (&rest _)
"TODO"
(+popup/close nil t))
;;;###autoload
(defun +popup*save (orig-fn &rest args)
"Sets aside all popups before executing the original function, usually to
prevent the popup(s) from messing up the UI (or vice versa)."
(save-popups! (apply orig-fn args)))
;;
;; Popup actions
;;
(unless EMACS26+
(defvar window-sides-reversed nil)
(defun window--sides-reverse-on-frame-p (frame)
"Return non-nil when side windows should appear reversed on FRAME.
This uses some heuristics to guess the user's intentions when the
selected window of FRAME is a side window ."
(cond
;; Reverse when `window-sides-reversed' is t. Do not reverse when
;; `window-sides-reversed' is nil.
((memq window-sides-reversed '(nil t))
window-sides-reversed)
;; Reverse when FRAME's selected window shows a right-to-left buffer.
((let ((window (frame-selected-window frame)))
(when (and (not (window-parameter window 'window-side))
(or (not (window-minibuffer-p window))
(setq window (minibuffer-selected-window))))
(with-current-buffer (window-buffer window)
(eq bidi-paragraph-direction 'right-to-left)))))
;; Reverse when FRAME's `window-sides-main-selected-window' parameter
;; specifies a live window showing a right-to-left buffer.
((let ((window (frame-parameter
frame 'window-sides-main-selected-window)))
(when (window-live-p window)
(with-current-buffer (window-buffer window)
(eq bidi-paragraph-direction 'right-to-left)))))
;; Reverse when all windows in FRAME's main window show right-to-left
;; buffers.
(t
(catch 'found
(walk-window-subtree
(lambda (window)
(with-current-buffer (window-buffer window)
(when (eq bidi-paragraph-direction 'left-to-right)
(throw 'found nil))))
(window-main-window frame))
t))))
(defun window--make-major-side-window (buffer side slot &optional alist)
"Display BUFFER in a new major side window on the selected frame.
SIDE must be one of `left', `top', `right' or `bottom'. SLOT
specifies the slot to use. ALIST is an association list of
symbols and values as passed to `display-buffer-in-side-window'.
Return the new window, nil if its creation failed.
This is an auxiliary function of `display-buffer-in-side-window'
and may be called only if no window on SIDE exists yet."
(let* ((left-or-right (memq side '(left right)))
(next-to (window--make-major-side-window-next-to side))
(on-side (cond
((eq side 'top) 'above)
((eq side 'bottom) 'below)
(t side)))
(window--sides-inhibit-check t)
;; The following two bindings will tell `split-window' to take
;; the space for the new window from the selected frame's main
;; window and not make a new parent window unless needed.
(window-combination-resize 'side)
(window-combination-limit nil)
(window (ignore-errors (split-window next-to nil on-side))))
(when window
;; Initialize `window-side' parameter of new window to SIDE and
;; make that parameter persistent.
(set-window-parameter window 'window-side side)
(add-to-list 'window-persistent-parameters '(window-side . writable))
;; Install `window-slot' parameter of new window and make that
;; parameter persistent.
(set-window-parameter window 'window-slot slot)
(add-to-list 'window-persistent-parameters '(window-slot . writable))
;; Auto-adjust height/width of new window unless a size has been
;; explicitly requested.
(unless (if left-or-right
(cdr (assq 'window-width alist))
(cdr (assq 'window-height alist)))
(setq alist
(cons
(cons
(if left-or-right 'window-width 'window-height)
(/ (window-total-size (frame-root-window) left-or-right)
;; By default use a fourth of the size of the frame's
;; root window.
4))
alist)))
(with-current-buffer buffer
(setq window--sides-shown t))
;; Install BUFFER in new window and return WINDOW.
(window--display-buffer buffer window 'window alist 'side))))
(advice-add #'window--sides-check :override #'ignore))
;;;###autoload
(defun +popup-display-buffer (buffer alist)
"A `display-buffer' action that serves as an alternative to
`display-buffer-in-side-window', but allows for stacking popups not only
laterally with the `vslot' alist entry.
Accepts the same arguments as `display-buffer-in-side-window'. You must set
`window--sides-inhibit-check' to non-nil for this work properly."
(let* ((side (or (cdr (assq 'side alist)) 'bottom))
(slot (or (cdr (assq 'slot alist)) 0))
(vslot (or (cdr (assq 'vslot alist)) 0))
(left-or-right (memq side '(left right)))
(dedicated (or display-buffer-mark-dedicated 'popup)))
(cond ((not (memq side '(top bottom left right)))
(error "Invalid side %s specified" side))
((not (numberp slot))
(error "Invalid slot %s specified" slot))
((not (numberp vslot))
(error "Invalid vslot %s specified" vslot)))
(let* ((major (get-window-with-predicate
(lambda (window)
(and (eq (window-parameter window 'window-side) side)
(eq (window-parameter window 'window-vslot) vslot)))
nil t))
(reversed (window--sides-reverse-on-frame-p (selected-frame)))
(windows
(cond ((window-live-p major)
(list major))
((window-valid-p major)
(let* ((first (window-child major))
(next (window-next-sibling first))
(windows (list next first)))
(setq reversed (> (window-parameter first 'window-slot)
(window-parameter next 'window-slot)))
(while (setq next (window-next-sibling next))
(setq windows (cons next windows)))
(if reversed windows (nreverse windows))))))
(slots (if major (max 1 (window-child-count major))))
(max-slots
(nth (plist-get '(left 0 top 1 right 2 bottom 3) side)
window-sides-slots))
(window--sides-inhibit-check t)
window this-window this-slot prev-window next-window
best-window best-slot abs-slot)
(cond ((and (numberp max-slots) (<= max-slots 0))
nil)
((not windows)
(cl-letf (((symbol-function 'window--make-major-side-window-next-to)
(lambda (_side) (frame-root-window (selected-frame)))))
(when-let* ((window (window--make-major-side-window buffer side slot alist)))
(set-window-parameter window 'window-vslot vslot)
(add-to-list 'window-persistent-parameters '(window-vslot . writable))
window)))
(t
;; Scan windows on SIDE.
(catch 'found
(dolist (window windows)
(setq this-slot (window-parameter window 'window-slot))
(cond ((not (numberp this-slot)))
((= this-slot slot) ; A window with a matching slot found
(setq this-window window)
(throw 'found t))
(t
;; Check if this window has a better slot value wrt the
;; slot of the window we want.
(setq abs-slot
(if (or (and (> this-slot 0) (> slot 0))
(and (< this-slot 0) (< slot 0)))
(abs (- slot this-slot))
(+ (abs slot) (abs this-slot))))
(unless (and best-slot (<= best-slot abs-slot))
(setq best-window window)
(setq best-slot abs-slot))
(if reversed
(cond
((<= this-slot slot)
(setq next-window window))
((not prev-window)
(setq prev-window window)))
(cond
((<= this-slot slot)
(setq prev-window window))
((not next-window)
(setq next-window window))))))))
;; `this-window' is the first window with the same SLOT.
;; `prev-window' is the window with the largest slot < SLOT. A new
;; window will be created after it.
;; `next-window' is the window with the smallest slot > SLOT. A new
;; window will be created before it.
;; `best-window' is the window with the smallest absolute
;; difference of its slot and SLOT.
(or (and this-window
;; Reuse `this-window'.
(with-current-buffer buffer
(setq window--sides-shown t))
(window--display-buffer
buffer this-window 'reuse alist dedicated))
(and (or (not max-slots) (< slots max-slots))
(or (and next-window
;; Make new window before `next-window'.
(let ((next-side (if left-or-right 'above 'left))
(window-combination-resize 'side))
(setq window
(ignore-errors (split-window next-window nil next-side)))))
(and prev-window
;; Make new window after `prev-window'.
(let ((prev-side (if left-or-right 'below 'right))
(window-combination-resize 'side))
(setq window
(ignore-errors (split-window prev-window nil prev-side))))))
(set-window-parameter window 'window-slot slot)
(with-current-buffer buffer
(setq window--sides-shown t))
(window--display-buffer
buffer window 'window alist dedicated))
(and best-window
;; Reuse `best-window'.
(progn
;; Give best-window the new slot value.
(set-window-parameter best-window 'window-slot slot)
(with-current-buffer buffer
(setq window--sides-shown t))
(window--display-buffer
buffer best-window 'reuse alist dedicated)))))))))

167
modules/ui/popup/config.el Normal file
View file

@ -0,0 +1,167 @@
;;; ui/popup/config.el -*- lexical-binding: t; -*-
(defconst +popup-window-parameters
'(transient quit select modeline popup)
"A list of custom parameters to be added to `window-persistent-parameters'.
Modifying this has no effect, unless done before ui/popup loads.
(transient . CDR)
CDR can be t, an integer, nil or a function that returns one of these. It
represents the number of seconds before the buffer belonging to a closed popup
window is killed.
If t, CDR will default to `+popup-ttl'.
If 0, the buffer is immediately killed.
If nil, the buffer won't be killed.
If a function, it must return one of the other possible values above. It takes
the popup buffer as its sole argument.
(quit . CDR)
CDR can be t, 'other, 'current, nil, or a function that returns one of these.
This determines the behavior of the ESC/C-g keys in or outside of popup
windows.
If t, close the popup if ESC/C-g is pressed inside or outside of popups.
If 'other, close this popup if ESC/C-g is pressed outside of any popup. This
is great for popups you just want to peek at and discard, but might also
want to poke around in, without the risk of closing it from the inside.
If 'current, close the current popup if ESC/C-g is pressed from inside of the
popup.
If nil, pressing ESC/C-g will never close this buffer.
If a function, it is checked each time ESC/C-g is pressed to determine the
fate of the popup window. This function takes one argument: the popup
window and must return one of the other possible values.
(select . CDR)
CDR can be a boolean or function. The boolean determines whether to focus the
popup window after it opens (non-nil) or focus the origin window (nil).
If a function, it takes two arguments: the popup window and the source window
(where you were before the popup was opened). It does nothing else, and
ignores its return value.
(modeline . CDR)
CDR can be t (show the default modeline), a symbol representing the name of a
modeline defined with `def-modeline!', nil (show no modeline) or a function
that returns one of these. The function takes one argument: the popup buffer.
(popup . t)
This is for internal use, do not change this. It simply marks a window as a
popup window.
Since I can't find this information anywhere but the Emacs manual, I'll include
a brief description of some native window parameters that Emacs uses:
(delete-window . CDR)
(delete-other-window . CDR)
(split-window . CDR)
(other-window . CDR)
This applies to all four of the above: CDR can be t or a function. If t, using
those functions on this window will ignore all window parameters.
If CDR is a function, it will replace the native function when used on this
window. e.g. if CDR is #'ignore (delete-window popup) will run (ignore popup)
instead of deleting the window!
(no-other-window . BOOL)
If CDR is non-nil, this window becomes invisible to `other-window' and
`pop-to-buffer'. Doom popups sets this. The default is nil.")
(defvar +popup-display-buffer-actions
'(display-buffer-reuse-window +popup-display-buffer)
"The functions to use to display the popup buffer.")
(defvar +popup-default-alist
'((window-height . 0.16)
(reusable-frames . visible))
"The default alist for `display-buffer-alist' rules.")
(defvar +popup-default-parameters
'((transient . t)
(quit . t)
(select . ignore))
"The default window parameters.")
(defvar +popup-ttl 5
"The default time-to-live for transient buffers whose popup buffers have been
deleted.")
;;
;; Default popup rules & bootstrap
;;
(when (featurep! +all)
(+popup-define "^ \\*" '((slot . 1) (vslot . -1) (size . +popup-shrink-to-fit)))
(+popup-define "^\\*" '((slot . 1) (vslot . -1)) '((select . t))))
(when (featurep! +defaults)
(+popup-define "^\\*Completions"
'((slot . -1) (vslot . -2))
'((transient . 0)))
(+popup-define "^\\*Compil\\(?:ation\\|e-Log\\)"
'((size . 0.3))
'((transient . 0) (quit . t)))
(+popup-define "^\\*\\(?:scratch\\|Messages\\)"
nil
'((transient)))
(+popup-define "^\\*doom \\(?:term\\|eshell\\)"
'((size . 0.25) (vslot . -10))
'((select . t) (quit) (transient . 0)))
(+popup-define "^\\*doom:"
'((size . 0.35) (side . bottom))
'((select . t) (modeline . t) (quit) (transient . t)))
(+popup-define "^\\*\\(?:\\(?:Pp E\\|doom e\\)val\\)"
'((size . +popup-shrink-to-fit))
'((transient . 0) (select . ignore)))
(+popup-define "^\\*Customize"
'((slot . 2) (side . right))
'((modeline . nil) (select . t) (quit . t)))
(+popup-define "^ \\*undo-tree\\*"
'((slot . 2) (side . left) (size . 20))
'((modeline . nil) (select . t) (quit . t)))
;; `help-mode', `helpful-mode'
(+popup-define "^\\*[Hh]elp"
'((slot . 2) (vslot . 2) (size . 0.25))
'((select . t)))
;; `Info-mode'
(+popup-define "^\\*info\\*$"
'((slot . 2) (vslot . 2) (size . 0.35))
'((select . t)))
;; `org-mode'
;; Use org-load-hook instead of `after!' because the hook runs sooner,
;; allowing users to override these later.
(add-hook! 'org-load-hook
(+popup-define "^\\*\\(?:Agenda Com\\|Calendar\\|Org \\(?:Links\\|Export Dispatcher\\|Select\\)\\)"
'((slot . -1) (vslot . -1) (size . +popup-shrink-to-fit))
'((transient . 0)))
(+popup-define "^\\*Org Agenda"
'((size . 0.35))
'((select . t) (transient)))
(+popup-define "^\\*Org Src"
'((size . 0.3))
'((quit) (select . t)))
(+popup-define "^CAPTURE.*\\.org$"
'((size . 0.2))
'((quit) (select . t)))))
(add-hook 'doom-init-ui-hook #'+popup-mode)
(add-hook! '+popup-buffer-mode-hook
#'(+popup|adjust-fringes
+popup|set-modeline-on-enable
+popup|unset-modeline-on-disable))
(let ((map +popup-buffer-mode-map))
(when (featurep! :feature evil)
;; for maximum escape coverage in emacs state buffers
(define-key map [escape] #'doom/escape)
(define-key map (kbd "ESC") #'doom/escape))
map)
;;
;; Hacks
;;
(load! +hacks)

61
modules/ui/popup/init.el Normal file
View file

@ -0,0 +1,61 @@
;;; ui/popup/init.el -*- lexical-binding: t; -*-
(defvar +popup--display-buffer-alist nil)
(defun +popup-define (condition &optional alist parameters)
"Define a popup rule.
The buffers of new windows displayed by `pop-to-buffer' and `display-buffer'
will be tested against CONDITION, which is either a) a regexp string (which is
matched against the buffer's name) or b) a function that takes no arguments and
returns a boolean.
If CONDITION is met, the buffer will be displayed in a popup window with ALIST
and window PARAMETERS. See `display-buffer-alist' for details on what ALIST may
contain and `+popup-window-parameters' for what window parameters that the popup
module supports.
ALIST also supports the `size' parameter, which will be translated to
`window-width' or `window-height' depending on `side'.
If certain attributes/parameters are omitted, the ones from
`+popup-default-alist' and `+popup-default-parameters' will be used."
(declare (indent 1))
(push (if (eq alist :ignore)
(list condition nil)
`(,condition
(+popup-buffer)
,@alist
(window-parameters ,@parameters)))
+popup--display-buffer-alist))
;;
(def-setting! :popup (condition &optional alist parameters)
"Register a popup rule.
CONDITION can be a regexp string or a function. See `display-buffer' for a list
of possible entries for ALIST, which tells the display system how to initialize
the popup window. PARAMETERS is an alist of window parameters. See
`+popup-window-parameters' for a list of custom parameters provided by the popup
module.
ALIST supports one custom parameter: `size', which will resolve to
`window-height' or `window-width' depending on `side'."
`(progn
(+popup-define ,condition ,alist ,parameters)
(when (bound-and-true-p +popup-mode)
(setq display-buffer-alist +popup--display-buffer-alist))
+popup--display-buffer-alist))
(def-setting! :popups (&rest rules)
"Register multiple popup rules with :popup setting (`doom--set:popup'). For
example:
(set! :popups
(\"^ \\*\" '((slot . 1) (vslot . -1) (size . +popup-shrink-to-fit)))
(\"^\\*\" '((slot . 1) (vslot . -1)) '((select . t))))"
`(progn
,@(cl-loop for rule in rules collect `(+popup-define ,@rule))
(when (bound-and-true-p +popup-mode)
(setq display-buffer-alist +popup--display-buffer-alist))
+popup--display-buffer-alist))