Snoooopy/dtos-dotfiles
1
0
Fork 0
mirror of https://gitlab.com/dwt1/dotfiles.git synced 2026-04-23 03:20:26 +10:00
Code Issues Packages Projects Releases Wiki Activity

Moving to Doom Emacs!

Browse Source
This commit is contained in:
Derek Taylor
2019-12-16 20:21:19 -06:00
parent d9f2f456f1
commit d4b4c33550
683 changed files with 51877 additions and 100 deletions
Download Patch File Download Diff File Expand all files Collapse all files

344
.emacs.d/modules/ui/popup/+hacks.el Normal file
View File

@@ -0,0 +1,344 @@
;;; 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,
;; many of 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 (if not using
;; `after!' or `use-package!').
;;
;;; Core functions
;; Don't try to resize popup windows
(advice-add #'balance-windows :around #'+popup-save-a)
(defun +popup/quit-window ()
"The regular `quit-window' sometimes kills the popup buffer and switches to a
buffer that shouldn't be in a popup. We prevent that by remapping `quit-window'
to this commmand."
(interactive)
(let ((orig-buffer (current-buffer)))
(quit-window)
(when (and (eq orig-buffer (current-buffer))
(+popup-window-p))
(+popup/close))))
(global-set-key [remap quit-window] #'+popup/quit-window)
;;
;;; External functions
;;;###package buff-menu
(define-key Buffer-menu-mode-map (kbd "RET") #'Buffer-menu-other-window)
;;;###package company
(defadvice! +popup--dont-select-me-a (orig-fn &rest args)
:around #'company-show-doc-buffer
(let ((+popup--inhibit-select t))
(apply orig-fn args)))
;;;###package eshell
(progn
(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...
(defadvice! +popup--eshell-undedicate-popup (&rest _)
"Force spawned term buffer to share with the eshell popup (if necessary)."
:before #'eshell-exec-visual
(when (+popup-window-p)
(set-window-dedicated-p nil nil)
(add-transient-hook! #'eshell-query-kill-processes :after
(set-window-dedicated-p nil t)))))
;;;###package evil
(progn
;; Make evil-mode cooperate with popups
(defadvice! +popup--evil-command-window-a (hist cmd-key execute-fn)
"Monkey patch the evil command window to use `pop-to-buffer' instead of
`switch-to-buffer', allowing the popup manager to handle it."
:override #'evil-command-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)))
(defadvice! +popup--evil-command-window-execute-a ()
"Execute the command under the cursor in the appropriate buffer, rather than
the command buffer."
:override #'evil-command-window-execute
(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)))
;; Don't mess with popups
(advice-add #'+evil--window-swap :around #'+popup-save-a)
(advice-add #'evil-window-move-very-bottom :around #'+popup-save-a)
(advice-add #'evil-window-move-very-top :around #'+popup-save-a)
(advice-add #'evil-window-move-far-left :around #'+popup-save-a)
(advice-add #'evil-window-move-far-right :around #'+popup-save-a))
;;;###package help-mode
(after! help-mode
(defun +popup--switch-from-popup (location)
(let (origin enable-local-variables)
(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)))
(+popup--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)))
(+popup--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)
(+popup--switch-from-popup (find-function-search-for-symbol fun 'defface file)))))
;;;###package helpful
(defadvice! +popup--helpful-open-in-origin-window-a (button)
"Open links in non-popup, originating window rather than helpful's window."
:override #'helpful--navigate
(let ((path (substring-no-properties (button-get button 'path)))
enable-local-variables
origin)
(save-popups!
(find-file path)
(when-let (pos (get-text-property button 'position
(marker-buffer button)))
(goto-char pos))
(setq origin (selected-window))
(recenter))
(select-window origin)))
;;;###package helm
;;;###package helm-ag
(when (featurep! :completion helm)
(setq helm-default-display-buffer-functions '(+popup-display-buffer-stacked-side-window-fn))
;; Fix #897: "cannot open side window" error when TAB-completing file links
(defadvice! +popup--helm-hide-org-links-popup-a (orig-fn &rest args)
:around #'org-insert-link
(cl-letf* ((old-org-completing-read (symbol-function 'org-completing-read))
((symbol-function 'org-completing-read)
(lambda (&rest args)
(when-let (win (get-buffer-window "*Org Links*"))
;; While helm is opened as a popup, it will mistaken the
;; *Org Links* popup for the "originated window", and will
;; target it for actions invoked by the user. However, since
;; *Org Links* is a popup too (they're dedicated side
;; windows), Emacs complains about being unable to split a
;; side window. The simple fix: get rid of *Org Links*!
(delete-window win)
;; But it must exist for org to clean up later.
(get-buffer-create "*Org Links*"))
(apply old-org-completing-read args))))
(apply #'funcall-interactively orig-fn args)))
;; Fix left-over popup window when closing persistent help for `helm-M-x'
(defadvice! +popup--helm-elisp--persistent-help-a (candidate _fun &optional _name)
:before #'helm-elisp--persistent-help
(let (win)
(when (and (helm-attr 'help-running-p)
(string= candidate (helm-attr 'help-current-symbol))
(setq win (get-buffer-window (get-buffer (help-buffer)))))
(delete-window win)))))
;;;###package Info
(defadvice! +popup--switch-to-info-window-a (&rest _)
:after #'info-lookup-symbol
(when-let (win (get-buffer-window "*info*"))
(when (+popup-window-p win)
(select-window win))))
;;;###package multi-term
(setq multi-term-buffer-name "doom terminal")
;;;###package neotree
(after! neotree
(advice-add #'neo-util--set-window-width :override #'ignore)
(advice-remove #'balance-windows #'ad-Advice-balance-windows))
;;;###package org
(after! org
;; Org has a scorched-earth window management policy I'm not fond of. i.e. it
;; kills all other windows just so it can monopolize the frame. No thanks. We
;; can do better ourselves.
(defadvice! +popup--suppress-delete-other-windows-a (orig-fn &rest args)
:around '(org-add-log-note
org-capture-place-template
org-export--dispatch-ui
org-agenda-get-restriction-and-command
org-fast-tag-selection
org-fast-todo-selection)
(if +popup-mode
(cl-letf (((symbol-function #'delete-other-windows)
(symbol-function #'ignore)))
(apply orig-fn args))
(apply orig-fn args)))
(defadvice! +popup--org-fix-popup-window-shrinking-a (orig-fn &rest args)
"Hides the mode-line in *Org tags* buffer so you can actually see its
content and displays it in a side window without deleting all other windows.
Ugh, such an ugly hack."
:around '(org-fast-tag-selection
org-fast-todo-selection)
(if +popup-mode
(cl-letf* ((old-fit-buffer-fn (symbol-function #'org-fit-window-to-buffer))
((symbol-function #'org-fit-window-to-buffer)
(lambda (&optional window max-height min-height shrink-only)
(when-let (buf (window-buffer window))
(delete-window window)
(select-window
(setq window (display-buffer-at-bottom buf nil)))
(with-current-buffer buf
(setq mode-line-format nil)))
(funcall old-fit-buffer-fn window max-height min-height shrink-only))))
(apply orig-fn args))
(apply orig-fn args)))
;; Ensure todo, agenda, and other minor popups are delegated to the popup system.
(defadvice! +popup--org-pop-to-buffer-a (orig-fn buf &optional norecord)
"Use `pop-to-buffer' instead of `switch-to-buffer' to open buffer.'"
:around #'org-switch-to-buffer-other-window
(if +popup-mode
(pop-to-buffer buf nil norecord)
(funcall orig-fn buf norecord))))
;;;###package persp-mode
(defadvice! +popup--persp-mode-restore-popups-a (&rest _)
"Restore popup windows when loading a perspective from file."
:after #'persp-load-state-from-file
(dolist (window (window-list))
(when (+popup-parameter 'popup window)
(+popup--init window nil))))
;;;###package pdf-tools
(after! pdf-tools
(setq tablist-context-window-display-action
'((+popup-display-buffer-stacked-side-window-fn)
(side . left)
(slot . 2)
(window-height . 0.3)
(inhibit-same-window . t))
pdf-annot-list-display-buffer-action
'((+popup-display-buffer-stacked-side-window-fn)
(side . left)
(slot . 3)
(inhibit-same-window . t))))
;;;###package profiler
(defadvice! +popup--profiler-report-find-entry-in-other-window-a (orig-fn function)
:around #'profiler-report-find-entry
(cl-letf (((symbol-function 'find-function)
(symbol-function 'find-function-other-window)))
(funcall orig-fn function)))
;;;###package wgrep
(progn
;; close the popup after you're done with a wgrep buffer
(advice-add #'wgrep-abort-changes :after #'+popup-close-a)
(advice-add #'wgrep-finish-edit :after #'+popup-close-a))
;;;###package which-key
(after! which-key
(when (eq which-key-popup-type 'side-window)
(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-stacked-side-window-fn
buffer (append '((vslot . -9999)) alist)))))
(which-key--show-buffer-side-window act-popup-dim))))))
;;;###package windmove
;; Users should be able to hop into popups easily, but Elisp shouldn't.
(defadvice! +popup--ignore-window-parameters-a (orig-fn &rest args)
"Allow *interactive* window moving commands to traverse popups."
:around '(windmove-up windmove-down windmove-left windmove-right)
(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)))

140
.emacs.d/modules/ui/popup/README.org Normal file
View File

@@ -0,0 +1,140 @@
#+TITLE: ui/popup
#+DATE: January 6, 2018
#+SINCE: v2.0.9
#+STARTUP: inlineimages
* Table of Contents :TOC:
- [[#description][Description]]
- [[#module-flags][Module Flags]]
- [[#prerequisites][Prerequisites]]
- [[#configuration][Configuration]]
- [[#set-popup-rule-and-set-popup-rules][~set-popup-rule!~ and ~set-popup-rules!~]]
- [[#disabling-hidden-mode-line-in-popups][Disabling hidden mode-line in popups]]
- [[#appendix][Appendix]]
- [[#commands][Commands]]
- [[#library][Library]]
- [[#hacks][Hacks]]
* Description
This module provides a customizable popup window management system.
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 the second class citizens of my editor;
spawned off to the side, discarded with the push of a button (e.g. =ESC= or
=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.
** Module Flags
+ =+all= Enables fallback rules to ensure all temporary/special buffers (whose
name begins with a space or asterix) are treated as popups.
+ =+defaults= Enables reasonable default popup rules for a variety of buffers.
* Prerequisites
This module has no external prerequisites.
* Configuration
** ~set-popup-rule!~ and ~set-popup-rules!~
This module has two functions for defining your own rules for popups:
#+BEGIN_SRC emacs-lisp
(set-popup-rule! PREDICATE &key IGNORE ACTIONS SIDE SIZE WIDTH HEIGHT SLOT VSLOT TTL QUIT SELECT MODELINE AUTOSAVE PARAMETERS)
(set-popup-rules! &rest RULESETS)
#+END_SRC
~PREDICATE~ is a predicate function or regexp string to match against the
buffer's name. You'll find comprehensive documentation on the other keywords in
~set-popup-rule!~'s docstring (=SPC h f set-popup-rule!=).
#+begin_quote
Popup rules end up in ~display-buffer-alist~, which instructs ~display-buffer~
calls on how to set up windows for buffers that meet certain conditions.
However, some plugins can avoid it entirely if they use ~set-buffer~ or
~switch-to-buffer~, which don't obey ~display-buffer-alist~.
#+end_quote
Multiple popup rules can be defined with ~set-popup-rules!~:
#+BEGIN_SRC emacs-lisp
(set-popup-rules!
'(("^ \\*" :slot -1) ; fallback rule for special buffers
("^\\*" :select t)
("^\\*Completions" :slot -1 :ttl 0)
("^\\*\\(?:scratch\\|Messages\\)" :ttl t)
("^\\*Help" :slot -1 :size 0.2 :select t)
("^\\*doom:"
:size 0.35 :select t :modeline t :quit t :ttl t)))
#+END_SRC
Omitted parameters in a ~set-popup-rules!~ will use the defaults set in
~+popup-defaults~.
** Disabling hidden mode-line in popups
By default, the mode-line is hidden in popups. To disable this, you can either:
1. Change the default ~:modeline~ property in ~+popup-defaults~:
#+BEGIN_SRC emacs-lisp
;; add to $DOOMDIR/config.el
(plist-put +popup-defaults :modeline t)
#+END_SRC
A value of ~t~ will instruct popups to use the default mode-line. Any
popup rule with a ~:modeline~ property can still override this.
2. Completely disable management of the mode-line in popups:
#+BEGIN_SRC emacs-lisp
;; add to ~/.doom.d/config.el
(remove-hook '+popup-buffer-mode-hook #'+popup-set-modeline-on-enable-h)
#+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-h~
+ ~+popup|set-modeline~
+ ~+popup-close-on-escape-h~
+ ~+popup-cleanup-rules-h~
+ 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 restore 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~. Some work has gone into reversing this.

617
.emacs.d/modules/ui/popup/autoload/popup.el Normal file
View File

@@ -0,0 +1,617 @@
;;; ui/popup/autoload/popup.el -*- lexical-binding: t; -*-
(defvar +popup--internal 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-h kill-buffer-hook)))
(cond ((get-buffer-window buffer t)
(with-current-buffer buffer
(setq +popup--timer
(run-at-time ttl nil #'+popup--kill-buffer buffer ttl))))
((eq ttl 0)
(kill-buffer buffer))
((with-demoted-errors "Error killing transient buffer: %s"
(with-current-buffer buffer
(let (confirm-kill-processes)
(when-let (process (get-buffer-process buffer))
(kill-process process))
(let (kill-buffer-query-functions)
;; HACK The debugger backtrace buffer, when killed, called
;; `top-level'. This causes jumpiness when the popup
;; manager tries to clean it up.
(cl-letf (((symbol-function #'top-level) #'ignore))
(kill-buffer buffer)))))))))))
(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))
(inhibit-quit t))
(and (buffer-file-name buffer)
(buffer-modified-p buffer)
(let ((autosave (+popup-parameter 'autosave window)))
(cond ((eq autosave 't))
((null autosave)
(y-or-n-p "Popup buffer is modified. Save it?"))
((functionp autosave)
(funcall autosave buffer))))
(with-current-buffer buffer (save-buffer)))
(let ((ignore-window-parameters t))
(if-let (wconf (window-parameter window 'saved-wconf))
(set-window-configuration wconf)
(delete-window window)))
(unless (window-live-p window)
(with-current-buffer buffer
(set-buffer-modified-p nil)
(+popup-buffer-mode -1)
(unless +popup--inhibit-transient
(let ((ttl (+popup-parameter 'ttl window)))
(when (eq ttl 't)
(setq ttl (plist-get +popup-defaults :ttl)))
(cond ((null ttl))
((functionp ttl)
(funcall ttl buffer))
((not (integerp ttl))
(signal 'wrong-type-argument (list 'integerp ttl)))
((= ttl 0)
(+popup--kill-buffer buffer 0))
((add-hook 'kill-buffer-hook #'+popup-kill-buffer-hook-h nil t)
(setq +popup--timer
(run-at-time ttl nil #'+popup--kill-buffer
buffer ttl))))))))))
(defun +popup--delete-other-windows (window)
"Fixes `delete-other-windows' when used from a popup window."
(when-let (window (ignore-errors (+popup/raise window)))
(let ((ignore-window-parameters t))
(delete-other-windows window)))
nil)
(defun +popup--normalize-alist (alist)
"Merge `+popup-default-alist' and `+popup-default-parameters' with ALIST."
(when alist
(let ((alist ; handle defaults
(cl-remove-duplicates
(append alist +popup-default-alist)
:key #'car-safe :from-end t))
(parameters
(cl-remove-duplicates
(append (cdr (assq 'window-parameters alist))
+popup-default-parameters)
:key #'car-safe :from-end t)))
;; handle `size'
(when-let* ((size (cdr (assq 'size alist)))
(side (or (cdr (assq 'side alist)) 'bottom))
(param (if (memq side '(left right))
'window-width
'window-height)))
(setq list (assq-delete-all 'size alist))
(setf (alist-get param alist) size))
(setf (alist-get 'window-parameters alist)
parameters)
;; Fixes #1305: addresses an edge case where a popup with a :size, :width
;; or :height greater than the current frame's dimensions causes
;; hanging/freezing (a bug in Emacs' `display-buffer' API perhaps?)
(let ((width (cdr (assq 'window-width alist)))
(height (cdr (assq 'window-height alist))))
(setf (alist-get 'window-width alist)
(if (numberp width)
(min width (frame-width))
width))
(setf (alist-get 'window-height alist)
(if (numberp height)
(min height (frame-height))
height))
alist))))
(defun +popup--split-window (window size side)
"Ensure a non-dedicated/popup window is selected when splitting a window."
(unless +popup--internal
(cl-loop for win
in (cons (or window (selected-window))
(window-list nil 0 window))
unless (+popup-window-p win)
return (setq window win)))
(let ((ignore-window-parameters t))
(split-window window size side)))
(defun +popup--maybe-select-window (window origin)
"Select a window based on `+popup--inhibit-select' and this window's `select' parameter."
(unless +popup--inhibit-select
(let ((select (+popup-parameter 'select window)))
(if (functionp select)
(funcall select window origin)
(select-window (if select window origin))))))
;;;###autoload
(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
(setq alist (delq (assq 'actions alist) alist))
(set-window-parameter window 'popup t)
(set-window-parameter window 'split-window #'+popup--split-window)
(set-window-parameter window 'delete-window #'+popup--delete-window)
(set-window-parameter window 'delete-other-windows #'+popup--delete-other-windows)
(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)))
;;
;; Public library
;;;###autoload
(defun +popup-buffer-p (&optional buffer)
"Return non-nil if BUFFER is a popup buffer. Defaults to the current buffer."
(when +popup-mode
(let ((buffer (or buffer (current-buffer))))
(and (bufferp buffer)
(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."
(when +popup-mode
(let ((window (or window (selected-window))))
(and (windowp window)
(window-live-p window)
(or (window-parameter window 'popup)
(window-parameter window 'no-other-window))
window))))
;;;###autoload
(defun +popup-buffer (buffer &optional alist)
"Open BUFFER in a popup window. ALIST describes its features."
(let* ((origin (selected-window))
(window-min-height 3)
(alist (+popup--normalize-alist alist))
(actions (or (cdr (assq 'actions alist))
+popup-default-display-buffer-actions)))
(or (let* ((alist (remove (assq 'window-width alist) alist))
(alist (remove (assq 'window-height alist) alist))
(window (display-buffer-reuse-window buffer alist)))
(when window
(+popup--maybe-select-window window origin)
window))
(when-let (popup (cl-loop for func in actions
if (funcall func buffer alist)
return it))
(+popup--init popup alist)
(+popup--maybe-select-window popup origin)
popup))))
;;;###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)))
;;;###autoload
(defun +popup-alist-from-window-state (state)
"Convert window STATE (from `window-state-get') to a `display-buffer' alist."
(let* ((params (alist-get 'parameters state)))
`((side . ,(alist-get 'window-side params))
(window-width . ,(alist-get 'total-width state))
(window-height . ,(alist-get 'total-height state))
(window-parameters ,@params))))
;;
;; Hooks
;;;###autoload
(defun +popup-adjust-fringes-h ()
"Hides the fringe in popup windows, restoring them if `+popup-buffer-mode' is
disabled."
(let ((f (if (bound-and-true-p +popup-buffer-mode) 0)))
(set-window-fringes nil f f fringes-outside-margins)))
;;;###autoload
(defun +popup-adjust-margins-h ()
"Creates padding for the popup window determined by `+popup-margin-width',
restoring it if `+popup-buffer-mode' is disabled."
(when +popup-margin-width
(unless (memq (window-parameter nil 'window-side) '(left right))
(let ((m (if (bound-and-true-p +popup-buffer-mode) +popup-margin-width)))
(set-window-margins nil m m)))))
(defvar hide-mode-line-format)
;;;###autoload
(defun +popup-set-modeline-on-enable-h ()
"Don't show modeline in popup windows without a `modeline' window-parameter.
Possible values for this parameter are:
t show the mode-line as normal
nil hide the modeline entirely (the default)
a function `mode-line-format' is set to its return value
Any non-nil value besides the above will be used as the raw value for
`mode-line-format'."
(when (bound-and-true-p +popup-buffer-mode)
(let ((modeline (+popup-parameter 'modeline)))
(cond ((eq modeline 't))
((null modeline)
;; TODO use `mode-line-format' window parameter instead (emacs 26+)
(hide-mode-line-mode +1))
((let ((hide-mode-line-format
(if (functionp modeline)
(funcall modeline)
modeline)))
(hide-mode-line-mode +1)))))))
(put '+popup-set-modeline-on-enable-h 'permanent-local-hook t)
;;;###autoload
(defun +popup-unset-modeline-on-disable-h ()
"Restore the modeline when `+popup-buffer-mode' is deactivated."
(when (and (not (bound-and-true-p +popup-buffer-mode))
(bound-and-true-p hide-mode-line-mode))
(hide-mode-line-mode -1)))
;;;###autoload
(defun +popup-close-on-escape-h ()
"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-h ()
"Cleans up any duplicate popup rules."
(interactive)
(setq +popup--display-buffer-alist
(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-h ()
"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/buffer ()
"Open this buffer in a popup window."
(interactive)
(let ((+popup-default-display-buffer-actions
'(+popup-display-buffer-stacked-side-window-fn))
(display-buffer-alist +popup--display-buffer-alist)
(buffer (current-buffer)))
(push (+popup-make-rule "." +popup-defaults) display-buffer-alist)
(bury-buffer)
(pop-to-buffer buffer)))
;;;###autoload
(defun +popup/other ()
"Cycle through popup windows, like `other-window'. Ignores regular windows."
(interactive)
(if-let (popups (+popup-windows))
(select-window (if (+popup-window-p)
(let ((window (selected-window)))
(or (car-safe (cdr (memq window popups)))
(car (delq window popups))
(car popups)))
(car popups)))
(user-error "No popups are open")))
;;;###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))
(let ((window (or 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 (buffer-live-p buffer)
do (+popup-buffer buffer (+popup-alist-from-window-state state)))
(setq +popup--last nil)
t)
;;;###autoload
(defun +popup/raise (window &optional arg)
"Raise the current popup window into a regular window.
If prefix ARG, raise the current popup into a new window."
(interactive
(list (selected-window) current-prefix-arg))
(cl-check-type window window)
(unless (+popup-window-p window)
(user-error "Cannot raise a non-popup window"))
(let ((buffer (current-buffer))
(+popup--inhibit-transient t)
+popup--remember-last)
(+popup/close window 'force)
(if arg
(pop-to-buffer buffer)
(switch-to-buffer buffer))))
;;;###autoload
(defun +popup/diagnose ()
"Reveal what popup rule will be used for the current buffer."
(interactive)
(or (cl-loop with bname = (buffer-name)
for (pred . action) in display-buffer-alist
if (and (functionp pred) (funcall pred bname action))
return (cons pred action)
else if (and (stringp pred) (string-match-p pred bname))
return (cons pred action))
(message "No popup rule for this buffer")))
;;
;;; Advice
;;;###autoload
(defun +popup-close-a (&rest _)
"TODO"
(+popup/close nil t))
;;;###autoload
(defun +popup-save-a (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)))
;;;###autoload
(defun +popup-display-buffer-fullframe-fn (buffer alist)
"Displays the buffer fullscreen."
(let ((wconf (current-window-configuration)))
(when-let (window (or (display-buffer-reuse-window buffer alist)
(display-buffer-same-window buffer alist)
(display-buffer-pop-up-window buffer alist)
(display-buffer-use-some-window buffer alist)))
(set-window-parameter window 'saved-wconf wconf)
(add-to-list 'window-persistent-parameters '(saved-wconf . t))
(delete-other-windows window)
window)))
;;;###autoload
(defun +popup-display-buffer-stacked-side-window-fn (buffer alist)
"A `display-buffer' action that serves as an alternative to
`display-buffer-in-side-window', but allows for stacking popups 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)))
(display-buffer-mark-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))
(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))
(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))
(+popup--internal t)
(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))
(+popup--internal t)
(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))
(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)))))))))
;;
;; Emacs backwards compatibility
(unless EMACS27+
(defadvice! +popup--set-window-dedicated-a (window)
"Ensure `window--display-buffer' respects `display-buffer-mark-dedicated'.
This was not so until recent Emacs 27 builds, where it causes breaking errors.
This advice ensures backwards compatibility for Emacs <= 26 users."
:filter-return #'window--display-buffer
(when (and (windowp window) display-buffer-mark-dedicated)
(set-window-dedicated-p window display-buffer-mark-dedicated))
window))

190
.emacs.d/modules/ui/popup/autoload/settings.el Normal file
View File

@@ -0,0 +1,190 @@
;;; ui/popup/autoload/settings.el -*- lexical-binding: t; -*-
;;;###autoload
(defvar +popup--display-buffer-alist nil)
;;;###autoload
(defvar +popup-defaults
(list :side 'bottom
:height 0.16
:width 40
:quit t
:select #'ignore
:ttl 5)
"Default properties for popup rules defined with `set-popup-rule!'.")
;;;###autoload
(defun +popup-make-rule (predicate plist)
(if (plist-get plist :ignore)
(list predicate nil)
(let* ((plist (append plist +popup-defaults))
(alist
`((actions . ,(plist-get plist :actions))
(side . ,(plist-get plist :side))
(size . ,(plist-get plist :size))
(window-width . ,(plist-get plist :width))
(window-height . ,(plist-get plist :height))
(slot . ,(plist-get plist :slot))
(vslot . ,(plist-get plist :vslot))))
(params
`((ttl . ,(plist-get plist :ttl))
(quit . ,(plist-get plist :quit))
(select . ,(plist-get plist :select))
(modeline . ,(plist-get plist :modeline))
(autosave . ,(plist-get plist :autosave))
,@(plist-get plist :parameters))))
`(,predicate (+popup-buffer)
,@alist
(window-parameters ,@params)))))
;;;###autodef
(defun set-popup-rule! (predicate &rest plist)
"Define a popup rule.
These rules affect buffers displayed with `pop-to-buffer' and `display-buffer'
(or their siblings). Buffers displayed with `switch-to-buffer' (and its
variants) will not be affected by these rules (as they are unaffected by
`display-buffer-alist', which powers the popup management system).
PREDICATE can be either a) a regexp string (matched against the buffer's name)
or b) a function that takes two arguments (a buffer name and the ACTION argument
of `display-buffer') and returns a boolean.
PLIST can be made up of any of the following properties:
:ignore BOOL
If BOOL is non-nil, popups matching PREDICATE will not be handled by the popup
system. Use this for buffers that have their own window management system like
magit or helm.
:actions ACTIONS
ACTIONS is a list of functions or an alist containing (FUNCTION . ALIST). See
`display-buffer''s second argument for more information on its format and what
it accepts. If omitted, `+popup-default-display-buffer-actions' is used.
:side 'bottom|'top|'left|'right
Which side of the frame to open the popup on. This is only respected if
`+popup-display-buffer-stacked-side-window-fn' or `display-buffer-in-side-window'
is in :actions or `+popup-default-display-buffer-actions'.
:size/:width/:height FLOAT|INT|FN
Determines the size of the popup. If more tha one of these size properties are
given :size always takes precedence, and is mapped with window-width or
window-height depending on what :side the popup is opened. Setting a height
for a popup that opens on the left or right is harmless, but comes into play
if two popups occupy the same :vslot.
If a FLOAT (0 < x < 1), the number represents how much of the window will be
consumed by the popup (a percentage).
If an INT, the number determines the size in lines (height) or units of
character width (width).
If a function, it takes one argument: the popup window, and can do whatever it
wants with it, typically resize it, like `+popup-shrink-to-fit'.
:slot/:vslot INT
(This only applies to popups with a :side and only if :actions is blank or
contains the `+popup-display-buffer-stacked-side-window-fn' action) These control
how multiple popups are laid out. INT can be any integer, positive and
negative.
:slot controls lateral positioning (e.g. the horizontal positioning for
top/bottom popups, or vertical positioning for left/right popups).
:vslot controls popup stacking (from the edge of the frame toward the center).
Let's assume popup A and B are opened with :side 'bottom, in that order.
If they possess the same :slot and :vslot, popup B will replace popup A.
If popup B has a higher :slot, it will open to the right of popup A.
If popup B has a lower :slot, it will open to the left of popup A.
If popup B has a higher :vslot, it will open above popup A.
If popup B has a lower :vslot, it will open below popup A.
:ttl INT|BOOL|FN
Stands for time-to-live. It can be t, an integer, nil or a function. This
controls how (and if) the popup system will clean up after the popup.
If any non-zero integer, wait that many seconds before killing the buffer (and
any associated processes).
If 0, the buffer is immediately killed.
If nil, the buffer won't be killed and is left to its own devices.
If t, resort to the default :ttl in `+popup-defaults'. If none exists, this is
the same as nil.
If a function, it takes one argument: the target popup buffer. The popup
system does nothing else and ignores the function's return value.
:quit FN|BOOL|'other|'current
Can be t, 'other, 'current, nil, or a function. 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 anywhere.
If 'other, close this popup if ESC/C-g is pressed outside of any popup. This
is great for popups you may press ESC/C-g a lot in.
If 'current, close the current popup if ESC/C-g is pressed from inside of the
popup. This makes it harder to accidentally close a popup until you really
want to.
If nil, pressing ESC/C-g will never close this popup.
If a function, it takes one argument: the to-be-closed popup window, and is
run when ESC/C-g is pressed while that popup is open. It must return one of
the other values to determine the fate of the popup.
:select BOOL|FN
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 originating window
(where you were before the popup opened). The popup system does nothing else
and ignores the function's return value.
:modeline BOOL|FN|LIST
Can be t (show the default modeline), nil (show no modeline), a function that
returns a modeline format or a valid value for `mode-line-format' to be used
verbatim. The function takes no arguments and is run in the context of the
popup buffer.
:autosave BOOL|FN
This parameter determines what to do with modified buffers when closing popup
windows. It accepts t, 'ignore, a function or nil.
If t, no prompts. Just save them automatically (if they're file-visiting
buffers). Same as 'ignore for non-file-visiting buffers.
If nil (the default), prompt the user what to do if the buffer is
file-visiting and modified.
If 'ignore, no prompts, no saving. Just silently kill it.
If a function, it is run with one argument: the popup buffer, and must return
non-nil to save or nil to do nothing (but no prompts).
:parameters ALIST
An alist of custom window parameters. See `(elisp)Window Parameters'.
If any of these are omitted, defaults derived from `+popup-defaults' will be
used.
\(fn PREDICATE &key IGNORE ACTIONS SIDE SIZE WIDTH HEIGHT SLOT VSLOT TTL QUIT SELECT MODELINE AUTOSAVE PARAMETERS)"
(declare (indent defun))
(push (+popup-make-rule predicate plist) +popup--display-buffer-alist)
(when (bound-and-true-p +popup-mode)
(setq display-buffer-alist +popup--display-buffer-alist))
+popup--display-buffer-alist)
;;;###autodef
(defun set-popup-rules! (&rest rulesets)
"Defines multiple popup rules.
Every entry in RULESETS should be a list of alists where the CAR is the
predicate and CDR is a plist. See `set-popup-rule!' for details on the predicate
and plist.
Example:
(set-popup-rules!
'((\"^ \\*\" :slot 1 :vslot -1 :size #'+popup-shrink-to-fit)
(\"^\\*\" :slot 1 :vslot -1 :select t))
'((\"^\\*Completions\" :slot -1 :vslot -2 :ttl 0)
(\"^\\*Compil\\(?:ation\\|e-Log\\)\" :size 0.3 :ttl 0 :quit t)))"
(declare (indent 0))
(dolist (rules rulesets)
(dolist (rule rules)
(push (+popup-make-rule (car rule) (cdr rule))
+popup--display-buffer-alist)))
(when (bound-and-true-p +popup-mode)
(setq display-buffer-alist +popup--display-buffer-alist))
+popup--display-buffer-alist)

175
.emacs.d/modules/ui/popup/config.el Normal file
View File

@@ -0,0 +1,175 @@
;;; ui/popup/config.el -*- lexical-binding: t; -*-
(defconst +popup-window-parameters '(ttl 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.")
(defvar +popup-default-display-buffer-actions
'(+popup-display-buffer-stacked-side-window-fn)
"The functions to use to display the popup buffer.")
(defvar +popup-default-alist
'((window-height . 0.16) ; remove later
(reusable-frames . visible))
"The default alist for `display-buffer-alist' rules.")
(defvar +popup-default-parameters
'((transient . t) ; remove later
(quit . t) ; remove later
(select . ignore) ; remove later
(no-other-window . t))
"The default window parameters.")
(defvar +popup-margin-width 1
"Size of the margins to give popup windows. Set this to nil to disable margin
adjustment.")
(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)
;;
;; Global modes
(defvar +popup-mode-map (make-sparse-keymap)
"Active keymap in a session with the popup system enabled. See
`+popup-mode'.")
(defvar +popup-buffer-mode-map
(let ((map (make-sparse-keymap)))
(when (featurep! :editor evil)
;; For maximum escape coverage in emacs state buffers; this only works in
;; GUI Emacs, in tty Emacs use C-g instead
(define-key map [escape] #'doom/escape))
map)
"Active keymap in popup windows. See `+popup-buffer-mode'.")
(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-escape-hook #'+popup-close-on-escape-h 'append)
(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-escape-hook #'+popup-close-on-escape-h)
(setq display-buffer-alist +popup--old-display-buffer-alist
window--sides-inhibit-check nil)
(+popup-cleanup-rules-h)
(dolist (prop +popup-window-parameters)
(delq (assq prop window-persistent-parameters)
window-persistent-parameters)))))
(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
(if (not +popup-buffer-mode)
(remove-hook 'after-change-major-mode-hook #'+popup-set-modeline-on-enable-h t)
(add-hook 'after-change-major-mode-hook #'+popup-set-modeline-on-enable-h
nil 'local)
(when (timerp +popup--timer)
(remove-hook 'kill-buffer-hook #'+popup-kill-buffer-hook-h t)
(cancel-timer +popup--timer)
(setq +popup--timer nil))))
(put '+popup-buffer-mode 'permanent-local t)
(put '+popup-buffer-mode 'permanent-local-hook t)
(put '+popup-set-modeline-on-enable-h 'permanent-local-hook t)
;;
;; Macros
(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)
(set-popup-rules! ,rules)
(when (bound-and-true-p +popup-mode)
(setq display-buffer-alist +popup--display-buffer-alist))
,@body))
(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)))))))
;;
;; Default popup rules & bootstrap
(set-popup-rules!
(when (featurep! +all)
'(("^\\*" :slot 1 :vslot -1 :select t)
("^ \\*" :slot 1 :vslot -1 :size +popup-shrink-to-fit)))
(when (featurep! +defaults)
'(("^\\*Completions" :ignore t)
("^\\*\\(?:[Cc]ompil\\(?:ation\\|e-Log\\)\\|Messages\\)"
:vslot -2 :size 0.3 :autosave t :quit t :ttl nil)
("^\\*\\(?:doom \\|Pp E\\)" ; transient buffers (no interaction required)
:vslot -3 :size +popup-shrink-to-fit :autosave t :select ignore :quit t :ttl 0)
("^\\*doom:" ; editing buffers (interaction required)
:vslot -4 :size 0.35 :autosave t :select t :modeline t :quit nil :ttl t)
("^\\*doom:\\(?:v?term\\|eshell\\)-popup" ; editing buffers (interaction required)
:vslot -5 :size 0.35 :select t :modeline t :quit nil :ttl nil)
("^\\*\\(?:Wo\\)?Man "
:vslot -6 :size 0.45 :select t :quit t :ttl 0)
("^\\*Calc"
:vslot -7 :side bottom :size 0.4 :select t :quit nil :ttl 0)
("^\\*Customize"
:slot 2 :side right :select t :quit t)
("^ \\*undo-tree\\*"
:slot 2 :side left :size 20 :select t :quit t)
;; `help-mode', `helpful-mode'
("^\\*[Hh]elp"
:slot 2 :vslot -8 :size 0.35 :select t)
("^\\*eww\\*" ; `eww' (and used by dash docsets)
:vslot -11 :size 0.35 :select t)
("^\\*info\\*$" ; `Info-mode'
:slot 2 :vslot 2 :size 0.45 :select t)))
'(("^\\*Warnings" :vslot 99 :size 0.25)
("^\\*Backtrace" :vslot 99 :size 0.4 :quit nil)
("^\\*CPU-Profiler-Report " :side bottom :vslot 100 :slot 1 :height 0.4 :width 0.5 :quit nil)
("^\\*Memory-Profiler-Report " :side bottom :vslot 100 :slot 2 :height 0.4 :width 0.5 :quit nil)
("^\\*\\(?:Proced\\|timer-list\\|Process List\\|Abbrevs\\|Output\\|Occur\\|unsent mail\\)\\*" :ignore t)))
(add-hook 'doom-init-ui-hook #'+popup-mode 'append)
(add-hook! '+popup-buffer-mode-hook
#'+popup-adjust-fringes-h
#'+popup-adjust-margins-h
#'+popup-set-modeline-on-enable-h
#'+popup-unset-modeline-on-disable-h)
;;
;; Hacks
(load! "+hacks")

212
.emacs.d/modules/ui/popup/test/test-popup.el Normal file
View File

@@ -0,0 +1,212 @@
;; -*- no-byte-compile: t; -*-
;;; ui/popup/test/test-popup.el
(require! :ui popup)
(describe "ui/popup"
:var (display-buffer-alist
+popup-default-display-buffer-actions
+popup--display-buffer-alist
+popup-defaults
wconf)
(before-all
(delete-other-windows)
(switch-to-buffer "*scratch*")
(setq wconf (current-window-configuration))
(+popup-mode +1))
(after-all
(+popup-mode -1))
(before-each
(setq display-buffer-alist nil
+popup--display-buffer-alist nil
+popup-default-display-buffer-actions '(+popup-display-buffer-stacked-side-window-fn)
+popup-defaults '(:side bottom :select ignore :ttl nil :slot 1 :vslot 1)))
(after-each
(set-window-configuration wconf))
(describe "set-popup-rule!"
(it "sets popup rules"
(set-popup-rule! "does-not-exist" :size 10)
(let ((rule (cdr (assoc "does-not-exist" display-buffer-alist))))
(expect rule :to-contain '(+popup-buffer))
(expect rule :to-contain '(size . 10))))
(it "shadows old rules"
(set-popup-rule! "a" :size 10)
(set-popup-rule! "a" :size 20)
(expect (cdr (assoc "a" display-buffer-alist))
:to-contain '(size . 20)))
(it "resolves to defaults"
(let ((+popup-defaults '(:size 5)))
(set-popup-rule! "a")
(expect (cdr (assoc "a" display-buffer-alist))
:to-contain '(size . 5)))))
(describe "popup rules"
:var (origin a b c d e f g)
(before-all (setq origin (current-buffer)))
(before-each
(dolist (name '(a b c d e f g))
(set name (get-buffer-create (symbol-name name)))))
(after-each
(let (kill-buffer-query-functions kill-buffer-hook)
(dolist (x (list a b c d e f g))
(ignore-errors (delete-window (get-buffer-window x)))
(kill-buffer x))))
(describe "slot positioning"
(before-each
(set-popup-rules!
'(("a" :slot 1 :vslot 1)
("b" :slot 2 :vslot 1)
("c" :slot 1 :vslot 2)
("d" :slot 2 :vslot 2)
("e" :slot 1 :vslot 3)
("f" :slot 1 :vslot 3)
("g"))))
(it "replaces popups with the same slots"
(mapc #'display-buffer (list e f))
(expect (length (+popup-windows)) :to-be 1))
(it "replaces popups among multiple that have the same slots"
(let ((first (display-buffer a))
(second (display-buffer b))
(third (display-buffer e))
(fourth (display-buffer f)))
(expect (+popup-windows) :to-have-same-items-as
(list first second fourth))))
(describe ":slot"
(it "opens left of others if lower"
(let ((first (display-buffer b))
(second (display-buffer a)))
(expect (length (+popup-windows)) :to-be 2)
(expect (window-in-direction 'left first t)
:to-equal second)))
(it "opens right of others if higher"
(let ((first (display-buffer a))
(second (display-buffer b)))
(expect (length (+popup-windows)) :to-be 2)
(expect (window-in-direction 'right first t)
:to-equal second)))
(it "obeys default :slot"
(let ((window (display-buffer g)))
(expect (window-parameter window 'window-slot) :to-be 1)
(expect (window-parameter window 'window-vslot) :to-be 1))))
(describe ":vslot"
;; TODO Implement this, somehow
(xit "opens lower :vslot popups above others"
(let ((first (display-buffer c))
(second (display-buffer a)))
(expect (length (+popup-windows)) :to-be 2)
(expect (window-in-direction 'above first t)
:to-equal second)))
(it "opens higher :vslot popups below others"
(let ((first (display-buffer c))
(second (display-buffer e)))
(expect (length (+popup-windows)) :to-be 2)
(expect (window-in-direction 'below first t)
:to-equal second)))))
(describe ":select"
(it "selects the popup if non-nil"
(set-popup-rule! "^a$" :select t)
(display-buffer a)
(expect (current-buffer) :to-equal a))
(it "selects the originating window if nil"
(set-popup-rule! "^a$" :select nil)
(display-buffer a)
(expect (current-buffer) :to-equal origin))
(it "fall back to base selection if passed #'ignore"
(spy-on 'ignore)
(set-popup-rule! "^a$" :select #'ignore)
(save-window-excursion
(display-buffer a)
(expect (current-buffer) :to-equal origin))
(save-window-excursion
(pop-to-buffer a)
(expect (current-buffer) :to-equal a))
(expect 'ignore :to-have-been-called-times 2)))
(describe ":modeline"
(it "disables the mode-line if nil"
(set-popup-rule! "a" :modeline nil :select t)
(display-buffer a)
(expect mode-line-format :to-be nil))
(it "uses the default mode-line if t"
(set-popup-rule! "a" :modeline t :select t)
(display-buffer a)
(expect mode-line-format :to-equal (default-value 'mode-line-format)))
(it "uses a predefined mode-line if passed a symbol"
(set-popup-rule! "a" :modeline '("x") :select t)
(display-buffer a)
(expect mode-line-format :to-equal '("x")))
(it "runs the handler if passed a function"
(set-popup-rule! "a" :modeline (lambda () (setq mode-line-format '("x"))) :select t)
(display-buffer a)
(expect mode-line-format :to-equal '("x"))))
;; TODO
(xdescribe ":autosave")
(describe ":quit"
(it "will close from anywhere if :quit = t"
(set-popup-rule! "a" :quit t)
(save-window-excursion
(display-buffer a)
(call-interactively #'+popup/close-all)
(expect (get-buffer-window a) :to-be nil))
(save-window-excursion
(pop-to-buffer a)
(call-interactively #'+popup/close)
(expect (get-buffer-window a) :to-be nil)))
(it "will only close from outside if :quit = 'other"
(set-popup-rule! "a" :quit 'other)
(save-window-excursion
(display-buffer a)
(call-interactively #'+popup/close-all)
(expect (get-buffer-window a) :to-be nil))
(save-window-excursion
(pop-to-buffer a)
(call-interactively #'+popup/close)
(expect (get-buffer-window a))))
(it "will only close from inside if :quit = 'current"
(set-popup-rule! "a" :quit 'current)
(save-window-excursion
(display-buffer a)
(call-interactively #'+popup/close-all)
(expect (get-buffer-window a)))
(save-window-excursion
(pop-to-buffer a)
(call-interactively #'+popup/close)
(expect (get-buffer-window a) :to-be nil)))
(it "never close a if :quit = nil"
(set-popup-rule! "a" :quit nil)
(save-window-excursion
(display-buffer a)
(call-interactively #'+popup/close-all)
(expect (get-buffer-window a)))
(save-window-excursion
(pop-to-buffer a)
(call-interactively #'+popup/close)
(expect (get-buffer-window a)))))
;; TODO
(xdescribe ":ttl")
(xdescribe ":size")
(xdescribe ":width")
(xdescribe ":height")
(xdescribe ":side")
(xdescribe ":actions"))
;; TODO
(xdescribe "predicate functions"
(describe "buffer-p")
(describe "window-p"))
;; TODO
(xdescribe "save-popups!")
(xdescribe "with-popup-rules!"))