msyds/sydnix
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: Rename to doom-popup

Browse Source
This commit is contained in:
Madeleine Sydney
2025-01-30 01:45:23 -07:00
parent fbdaac356c
commit 4a3551ed12
10 changed files with 575 additions and 448 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
users/crumb/programs/emacs/init.el
View File

@@ -15,13 +15,13 @@
(eval-when-compile (eval-when-compile
(add-to-list 'load-path (file-name-concat user-emacs-directory "modules" "syd-popup"))) (add-to-list 'load-path (file-name-concat user-emacs-directory "modules" "syd-popup")))
(use-package syd-popup (use-package doom-popup
;; :defer t ;; :defer t
:load-path "/persist/dots/users/crumb/programs/emacs/modules/syd-popup" :load-path "/persist/dots/users/crumb/programs/emacs/modules/doom-popup"
:straight nil :straight nil
;; :straight ;; :straight
;; (:type nil ;; (:type nil
;; :local-repo "/persist/dots/users/crumb/programs/emacs/modules/syd-popup") ;; :local-repo "/persist/dots/users/crumb/programs/emacs/modules/doom-popup")
) )
(require 'syd-age) (require 'syd-age)

7
users/crumb/programs/emacs/lib/syd-handle-repl.el
View File

@@ -155,14 +155,15 @@ prefix argument is given, in which case the user will be prompted for a repl."
(set-popup-rule! (set-popup-rule!
(lambda (bufname _) (lambda (bufname _)
(when (boundp '+eval-repl-mode) (when (boundp 'syd-repl-mode)
(buffer-local-value '+eval-repl-mode (get-buffer bufname)))) (buffer-local-value 'syd-repl-mode (get-buffer bufname))))
:ttl (lambda (buf) :ttl (lambda (buf)
(unless (plist-get +eval-repl-plist :persist) (unless (plist-get +eval-repl-plist :persist)
(when-let (process (get-buffer-process buf)) (when-let (process (get-buffer-process buf))
(set-process-query-on-exit-flag process nil) (set-process-query-on-exit-flag process nil)
(kill-process process) (kill-process process)
(kill-buffer buf)))) (kill-buffer buf))))
:size 0.25 :quit nil) :size 0.25
:quit nil)
(provide 'syd-handle-repl) (provide 'syd-handle-repl)

9
users/crumb/programs/emacs/modules/doom-popup/README.org Normal file
View File

@@ -0,0 +1,9 @@
#+title: Popups
This directory is almost entirely poached from Doom Emacs. Taming various ill-behaved packages is not something I want to hack myself.
* My changes
- Remove uses of Doom's libraries, e.g. ~defadvice!~, ~after!~, ...
- Substitute ~+popup-«name»~ for ~doom-popup-«name»~.
- Prepend MIT license to each stolen file (as Doom is MIT-licensed).

210
users/crumb/programs/emacs/modules/doom-popup/doom-popup-config.el Normal file
View File

@@ -0,0 +1,210 @@
;;; doom-popup-config.el -*- lexical-binding: t; -*-
;; The MIT License (MIT)
;;
;; Copyright (c) 2014-2024 Henrik Lissner.
;;
;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
;; "Software"), to deal in the Software without restriction, including
;; without limitation the rights to use, copy, modify, merge, publish,
;; distribute, sublicense, and/or sell copies of the Software, and to
;; permit persons to whom the Software is furnished to do so, subject to
;; the following conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
(defconst doom-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 doom-popup-default-display-buffer-actions
'(doom-popup-display-buffer-stacked-side-window-fn)
"The functions to use to display the popup buffer.")
(defvar doom-popup-default-alist
'((window-height . 0.16) ; remove later
(reusable-frames . visible))
"The default alist for `display-buffer-alist' rules.")
(defvar doom-popup-default-parameters
'((transient . t) ; remove later
(quit . t) ; remove later
(select . ignore) ; remove later
(no-other-window . t))
"The default window parameters.")
(defvar doom-popup-margin-width 1
"Size of the margins to give popup windows. Set this to nil to disable margin
adjustment.")
(defvar doom-popup--inhibit-transient nil)
(defvar doom-popup--inhibit-select nil)
(defvar doom-popup--old-display-buffer-alist nil)
(defvar doom-popup--remember-last t)
(defvar doom-popup--last nil)
(defvar-local doom-popup--timer nil)
;;
;; Global modes
(defvar doom-popup-mode-map (make-sparse-keymap)
"Active keymap in a session with the popup system enabled. See
`doom-popup-mode'.")
(defvar doom-popup-buffer-mode-map
(let ((map (make-sparse-keymap)))
(when (featurep '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 `doom-popup-buffer-mode'.")
(define-minor-mode doom-popup-mode
"Global minor mode representing Doom's popup management system."
:init-value nil
:global t
:keymap doom-popup-mode-map
(cond (doom-popup-mode
(add-hook 'doom-escape-hook #'doom-popup-close-on-escape-h 'append)
(setq doom-popup--old-display-buffer-alist display-buffer-alist
display-buffer-alist doom-popup--display-buffer-alist
window--sides-inhibit-check t)
(dolist (prop doom-popup-window-parameters)
(push (cons prop 'writable) window-persistent-parameters)))
(t
(remove-hook 'doom-escape-hook #'doom-popup-close-on-escape-h)
(setq display-buffer-alist doom-popup--old-display-buffer-alist
window--sides-inhibit-check nil)
(doom-popup-cleanup-rules-h)
(dolist (prop doom-popup-window-parameters)
(delq (assq prop window-persistent-parameters)
window-persistent-parameters)))))
(define-minor-mode doom-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 doom-popup-buffer-mode-map
(if (not doom-popup-buffer-mode)
(remove-hook 'after-change-major-mode-hook #'doom-popup-set-modeline-on-enable-h t)
(add-hook 'after-change-major-mode-hook #'doom-popup-set-modeline-on-enable-h
nil 'local)
(when (timerp doom-popup--timer)
(remove-hook 'kill-buffer-hook #'doom-popup-kill-buffer-hook-h t)
(cancel-timer doom-popup--timer)
(setq doom-popup--timer nil))))
(put 'doom-popup-buffer-mode 'permanent-local t)
(put 'doom-popup-buffer-mode 'permanent-local-hook t)
(put 'doom-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 `doom-popup-define' or the :popup setting."
(declare (indent defun))
`(let ((doom-popup--display-buffer-alist doom-popup--old-display-buffer-alist)
display-buffer-alist)
(set-popup-rules! ,rules)
(when (bound-and-true-p doom-popup-mode)
(setq display-buffer-alist doom-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 (doom-popup-buffer-p))
(popups (doom-popup-windows))
(doom-popup--inhibit-transient t)
buffer-list-update-hook
doom-popup--last)
(dolist (p popups)
(doom-popup/close p 'force))
(unwind-protect
(progn ,@body)
(when popups
(let ((origin (selected-window)))
(doom-popup/restore)
(unless in-popup-p
(select-window origin)))))))
;;
;; Default popup rules & bootstrap
(defvar doom-popup-use-aggressive-defaults nil)
(defvar doom-popup-use-defaults t)
(set-popup-rules!
(when doom-popup-use-aggressive-defaults
'(("^\\*" :slot 1 :vslot -1 :select t)
("^ \\*" :slot 1 :vslot -1 :size doom-popup-shrink-to-fit)))
(when doom-popup-use-defaults
'(("^\\*Completions" :ignore t)
("^\\*Local variables\\*$"
:vslot -1 :slot 1 :size doom-popup-shrink-to-fit)
("^\\*\\(?:[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 doom-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\\|e?shell\\)-popup" ; editing buffers (interaction required)
:vslot -5 :size 0.35 :select t :modeline nil :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 :size 0.5 :select t :quit nil)
("^ \\*undo-tree\\*"
:slot 2 :side left :size 20 :select t :quit t)
;; `help-mode', `helpful-mode'
("^\\*\\([Hh]elp\\|Apropos\\)"
:slot 2 :vslot -8 :size 0.42 :select t)
("^\\*eww\\*" ; `eww' (and used by dash docsets)
:vslot -11 :size 0.35 :select t)
("^\\*xwidget"
:vslot -11 :size 0.35 :select nil)
("^\\*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)
("^\\*Process List\\*" :side bottom :vslot 101 :size 0.25 :select t :quit t)
("^\\*\\(?:Proced\\|timer-list\\|Abbrevs\\|Output\\|Occur\\|unsent mail.*?\\|message\\)\\*" :ignore t)))
(add-hook 'on-init-ui-hook #'doom-popup-mode 'append)
(dolist (hook-fn (list #'doom-popup-adjust-fringes-h
#'doom-popup-adjust-margins-h
#'doom-popup-set-modeline-on-enable-h
#'doom-popup-unset-modeline-on-disable-h))
(add-hook 'doom-popup-buffer-mode-hook hook-fn))
;;
;;; Hacks
(require 'doom-popup-hacks)
(provide 'doom-popup-config)

147
users/crumb/programs/emacs/modules/syd-popup/syd-popup-hacks.el → users/crumb/programs/emacs/modules/doom-popup/doom-popup-hacks.el
View File

@@ -1,5 +1,28 @@
;;; ui/popup/+hacks.el -*- lexical-binding: t; -*- ;;; ui/popup/+hacks.el -*- lexical-binding: t; -*-
;; The MIT License (MIT)
;;
;; Copyright (c) 2014-2024 Henrik Lissner.
;;
;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
;; "Software"), to deal in the Software without restriction, including
;; without limitation the rights to use, copy, modify, merge, publish,
;; distribute, sublicense, and/or sell copies of the Software, and to
;; permit persons to whom the Software is furnished to do so, subject to
;; the following conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
;; What follows are all the hacks needed to get various parts of Emacs and other ;; 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 ;; plugins to cooperate with the popup management system. Essentially, it comes
;; down to: ;; down to:
@@ -26,7 +49,7 @@
;; ;;
;;; Core functions ;;; Core functions
(defun +popup--make-case-sensitive-a (fn &rest args) (defun doom-popup--make-case-sensitive-a (fn &rest args)
"Make regexps in `display-buffer-alist' case-sensitive. "Make regexps in `display-buffer-alist' case-sensitive.
To reduce fewer edge cases and improve performance when `display-buffer-alist' To reduce fewer edge cases and improve performance when `display-buffer-alist'
@@ -35,12 +58,12 @@ grows larger."
(apply fn args))) (apply fn args)))
(advice-add #'display-buffer-assq-regexp (advice-add #'display-buffer-assq-regexp
:around #'+popup--make-case-sensitive-a) :around #'doom-popup--make-case-sensitive-a)
;; Don't try to resize popup windows ;; Don't try to resize popup windows
(advice-add #'balance-windows :around #'+popup-save-a) (advice-add #'balance-windows :around #'doom-popup-save-a)
(defun +popup/quit-window (&optional arg) (defun doom-popup/quit-window (&optional arg)
"The regular `quit-window' sometimes kills the popup buffer and switches to a "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' buffer that shouldn't be in a popup. We prevent that by remapping `quit-window'
to this commmand." to this commmand."
@@ -48,9 +71,9 @@ to this commmand."
(let ((orig-buffer (current-buffer))) (let ((orig-buffer (current-buffer)))
(quit-window arg) (quit-window arg)
(when (and (eq orig-buffer (current-buffer)) (when (and (eq orig-buffer (current-buffer))
(+popup-buffer-p)) (doom-popup-buffer-p))
(+popup/close nil 'force)))) (doom-popup/close nil 'force))))
(define-key +popup-buffer-mode-map [remap quit-window] #'+popup/quit-window) (define-key doom-popup-buffer-mode-map [remap quit-window] #'doom-popup/quit-window)
;; ;;
@@ -61,27 +84,27 @@ to this commmand."
(with-eval-after-load 'company (with-eval-after-load 'company
(defun +popup--dont-select-me-a (fn &rest args) (defun doom-popup--dont-select-me-a (fn &rest args)
(let ((+popup--inhibit-select t)) (let ((doom-popup--inhibit-select t))
(apply fn args))) (apply fn args)))
(advice-add #'company-show-doc-buffer (advice-add #'company-show-doc-buffer
:around #'+popup--dont-select-me-a)) :around #'doom-popup--dont-select-me-a))
;;;###package compile ;;;###package compile
(with-eval-after-load 'compile (with-eval-after-load 'compile
(defun +popup--compilation-goto-locus-a (fn &rest args) (defun doom-popup--compilation-goto-locus-a (fn &rest args)
(cl-letf ((pop-to-buffer (symbol-function #'pop-to-buffer))) (cl-letf ((pop-to-buffer (symbol-function #'pop-to-buffer)))
(ignore pop-to-buffer) (ignore pop-to-buffer)
(cl-letf (((symbol-function #'pop-to-buffer) (cl-letf (((symbol-function #'pop-to-buffer)
(lambda (buffer &optional action norecord) (lambda (buffer &optional action norecord)
(let ((pop-up-windows (not (+popup-buffer-p (current-buffer))))) (let ((pop-up-windows (not (doom-popup-buffer-p (current-buffer)))))
(funcall pop-to-buffer buffer action norecord))))) (funcall pop-to-buffer buffer action norecord)))))
(apply fn args)))) (apply fn args))))
(advice-add #'compilation-goto-locus (advice-add #'compilation-goto-locus
:around #'+popup--compilation-goto-locus-a)) :around #'doom-popup--compilation-goto-locus-a))
;;;###package eshell ;;;###package eshell
@@ -90,19 +113,19 @@ to this commmand."
;; When eshell runs a visual command (see `eshell-visual-commands'), it spawns ;; 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... ;; a term buffer to run it in, but where it spawns it is the problem...
(defun +popup--eshell-undedicate-popup (&rest _) (defun doom-popup--eshell-undedicate-popup (&rest _)
"Force spawned term buffer to share with the eshell popup (if necessary)." "Force spawned term buffer to share with the eshell popup (if necessary)."
(when (+popup-window-p) (when (doom-popup-window-p)
(set-window-dedicated-p nil nil) (set-window-dedicated-p nil nil)
(add-transient-hook! (function eshell-query-kill-processes) (add-transient-hook! (function eshell-query-kill-processes)
:after (set-window-dedicated-p nil t)))) :after (set-window-dedicated-p nil t))))
(advice-add #'eshell-exec-visual (advice-add #'eshell-exec-visual
:around #'+popup--eshell-undedicate-popup)) :around #'doom-popup--eshell-undedicate-popup))
;;;###package evil ;;;###package evil
(with-eval-after-load 'evil (with-eval-after-load 'evil
(defun +popup--evil-command-window-execute-a nil (defun doom-popup--evil-command-window-execute-a nil
"Execute the command under the cursor in the appropriate buffer, rather than "Execute the command under the cursor in the appropriate buffer, rather than
the command buffer." the command buffer."
(interactive) (interactive)
@@ -120,17 +143,17 @@ the command buffer."
(setq evil-command-window-current-buffer nil))) (setq evil-command-window-current-buffer nil)))
(advice-add #'evil-command-window-execute (advice-add #'evil-command-window-execute
:around #'+popup--evil-command-window-execute-a) :around #'doom-popup--evil-command-window-execute-a)
;; Don't mess with popups ;; Don't mess with popups
(advice-add #'+evil--window-swap :around #'+popup-save-a) (advice-add #'+evil--window-swap :around #'doom-popup-save-a)
(advice-add #'evil-window-move-very-bottom :around #'+popup-save-a) (advice-add #'evil-window-move-very-bottom :around #'doom-popup-save-a)
(advice-add #'evil-window-move-very-top :around #'+popup-save-a) (advice-add #'evil-window-move-very-top :around #'doom-popup-save-a)
(advice-add #'evil-window-move-far-left :around #'+popup-save-a) (advice-add #'evil-window-move-far-left :around #'doom-popup-save-a)
(advice-add #'evil-window-move-far-right :around #'+popup-save-a)) (advice-add #'evil-window-move-far-right :around #'doom-popup-save-a))
(with-eval-after-load 'help-mode (with-eval-after-load 'help-mode
(defun +popup--switch-from-popup (location) (defun doom-popup--switch-from-popup (location)
(let (origin enable-local-variables) (let (origin enable-local-variables)
(save-popups! (save-popups!
(switch-to-buffer (car location) nil t) (switch-to-buffer (car location) nil t)
@@ -152,7 +175,7 @@ the command buffer."
(require 'find-func) (require 'find-func)
(when (eq file 'C-source) (when (eq file 'C-source)
(setq file (help-C-file-name (indirect-function fun) 'fun))) (setq file (help-C-file-name (indirect-function fun) 'fun)))
(+popup--switch-from-popup (find-function-search-for-symbol fun nil file)))) (doom-popup--switch-from-popup (find-function-search-for-symbol fun nil file))))
(define-button-type 'help-variable-def (define-button-type 'help-variable-def
:supertype 'help-xref :supertype 'help-xref
@@ -160,19 +183,19 @@ the command buffer."
(lambda (var &optional file) (lambda (var &optional file)
(when (eq file 'C-source) (when (eq file 'C-source)
(setq file (help-C-file-name var 'var))) (setq file (help-C-file-name var 'var)))
(+popup--switch-from-popup (find-variable-noselect var file)))) (doom-popup--switch-from-popup (find-variable-noselect var file))))
(define-button-type 'help-face-def (define-button-type 'help-face-def
:supertype 'help-xref :supertype 'help-xref
'help-function 'help-function
(lambda (fun file) (lambda (fun file)
(require 'find-func) (require 'find-func)
(+popup--switch-from-popup (find-function-search-for-symbol fun 'defface file))))) (doom-popup--switch-from-popup (find-function-search-for-symbol fun 'defface file)))))
;;;###package helpful ;;;###package helpful
(with-eval-after-load 'helpful (with-eval-after-load 'helpful
(defadvice! +popup--helpful-open-in-origin-window-a (button) (defadvice! doom-popup--helpful-open-in-origin-window-a (button)
"Open links in non-popup, originating window rather than helpful's window." "Open links in non-popup, originating window rather than helpful's window."
:override #'helpful--navigate :override #'helpful--navigate
(let ((path (substring-no-properties (button-get button 'path))) (let ((path (substring-no-properties (button-get button 'path)))
@@ -191,10 +214,10 @@ the command buffer."
;;;###package helm ;;;###package helm
;;;###package helm-ag ;;;###package helm-ag
(with-eval-after-load 'helm (with-eval-after-load 'helm
(setq helm-default-display-buffer-functions '(+popup-display-buffer-stacked-side-window-fn)) (setq helm-default-display-buffer-functions '(doom-popup-display-buffer-stacked-side-window-fn))
;; Fix #897: "cannot open side window" error when TAB-completing file links ;; Fix #897: "cannot open side window" error when TAB-completing file links
(defadvice! +popup--helm-hide-org-links-popup-a (fn &rest args) (defadvice! doom-popup--helm-hide-org-links-popup-a (fn &rest args)
:around #'org-insert-link :around #'org-insert-link
(letf! ((defun org-completing-read (&rest args) (letf! ((defun org-completing-read (&rest args)
(when-let (win (get-buffer-window "*Org Links*")) (when-let (win (get-buffer-window "*Org Links*"))
@@ -211,7 +234,7 @@ the command buffer."
(apply #'funcall-interactively fn args))) (apply #'funcall-interactively fn args)))
;; Fix left-over popup window when closing persistent help for `helm-M-x' ;; Fix left-over popup window when closing persistent help for `helm-M-x'
(defadvice! +popup--helm-elisp--persistent-help-a (candidate _fun &optional _name) (defadvice! doom-popup--helm-elisp--persistent-help-a (candidate _fun &optional _name)
:before #'helm-elisp--persistent-help :before #'helm-elisp--persistent-help
(let (win) (let (win)
(and (helm-attr 'help-running-p) (and (helm-attr 'help-running-p)
@@ -222,23 +245,23 @@ the command buffer."
;;;###package Info ;;;###package Info
(with-eval-after-load 'Info (with-eval-after-load 'Info
(defadvice! +popup--switch-to-info-window-a (&rest _) (defadvice! doom-popup--switch-to-info-window-a (&rest _)
:after #'info-lookup-symbol :after #'info-lookup-symbol
(when-let (win (get-buffer-window "*info*")) (when-let (win (get-buffer-window "*info*"))
(when (+popup-window-p win) (when (doom-popup-window-p win)
(select-window win))))) (select-window win)))))
;;;###package latex ;;;###package latex
(with-eval-after-load 'latex (with-eval-after-load 'latex
(defadvice! +popup--use-popup-window-for-reftex-citation-a (fn &rest args) (defadvice! doom-popup--use-popup-window-for-reftex-citation-a (fn &rest args)
:around #'reftex-do-citation :around #'reftex-do-citation
(letf! ((#'switch-to-buffer-other-window #'pop-to-buffer)) (letf! ((#'switch-to-buffer-other-window #'pop-to-buffer))
(apply fn args)))) (apply fn args))))
(with-eval-after-load 'org (with-eval-after-load 'org
(defadvice! +popup--suppress-delete-other-windows-a (fn &rest args) (defadvice! doom-popup--suppress-delete-other-windows-a (fn &rest args)
"Org has a scorched-earth window management policy I'm not fond of. i.e. it "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 kills all other windows just so it can monopolize the frame. No thanks. We can
do better." do better."
@@ -249,36 +272,36 @@ do better."
:around #'org-goto-location :around #'org-goto-location
:around #'org-fast-tag-selection :around #'org-fast-tag-selection
:around #'org-fast-todo-selection :around #'org-fast-todo-selection
(if +popup-mode (if doom-popup-mode
(letf! ((#'delete-other-windows #'ignore) (letf! ((#'delete-other-windows #'ignore)
(#'delete-window #'ignore)) (#'delete-window #'ignore))
(apply fn args)) (apply fn args))
(apply fn args))) (apply fn args)))
(defadvice! +popup--org-fix-goto-a (fn &rest args) (defadvice! doom-popup--org-fix-goto-a (fn &rest args)
"`org-goto' uses `with-output-to-temp-buffer' to display its help buffer, "`org-goto' uses `with-output-to-temp-buffer' to display its help buffer,
for some reason, which is very unconventional, and so requires these gymnastics for some reason, which is very unconventional, and so requires these gymnastics
to tame (i.e. to get the popup manager to handle it)." to tame (i.e. to get the popup manager to handle it)."
:around #'org-goto-location :around #'org-goto-location
(if +popup-mode (if doom-popup-mode
(letf! (defun internal-temp-output-buffer-show (buffer) (letf! (defun internal-temp-output-buffer-show (buffer)
(let ((temp-buffer-show-function (let ((temp-buffer-show-function
(lambda (&rest args) (lambda (&rest args)
(apply #'+popup-display-buffer-stacked-side-window-fn (apply #'doom-popup-display-buffer-stacked-side-window-fn
nil args)))) nil args))))
(with-current-buffer buffer (with-current-buffer buffer
(+popup-buffer-mode +1)) (doom-popup-buffer-mode +1))
(funcall internal-temp-output-buffer-show buffer))) (funcall internal-temp-output-buffer-show buffer)))
(apply fn args)) (apply fn args))
(apply fn args))) (apply fn args)))
(defadvice! +popup--org-fix-popup-window-shrinking-a (fn &rest args) (defadvice! doom-popup--org-fix-popup-window-shrinking-a (fn &rest args)
"Hides the mode-line in *Org tags* buffer so you can actually see its "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. content and displays it in a side window without deleting all other windows.
Ugh, such an ugly hack." Ugh, such an ugly hack."
:around #'org-fast-tag-selection :around #'org-fast-tag-selection
:around #'org-fast-todo-selection :around #'org-fast-todo-selection
(if +popup-mode (if doom-popup-mode
(letf! ((defun read-char-exclusive (&rest args) (letf! ((defun read-char-exclusive (&rest args)
(message nil) (message nil)
(apply read-char-exclusive args)) (apply read-char-exclusive args))
@@ -287,25 +310,25 @@ Ugh, such an ugly hack."
(defun org-fit-window-to-buffer (&optional window max-height min-height shrink-only) (defun org-fit-window-to-buffer (&optional window max-height min-height shrink-only)
(when-let (buf (window-buffer window)) (when-let (buf (window-buffer window))
(with-current-buffer buf (with-current-buffer buf
(+popup-buffer-mode))) (doom-popup-buffer-mode)))
(when (> (window-buffer-height window) (when (> (window-buffer-height window)
(window-height window)) (window-height window))
(fit-window-to-buffer window (window-buffer-height window))))) (fit-window-to-buffer window (window-buffer-height window)))))
(apply fn args)) (apply fn args))
(apply fn args))) (apply fn args)))
(defadvice! +popup--org-edit-src-exit-a (fn &rest args) (defadvice! doom-popup--org-edit-src-exit-a (fn &rest args)
"If you switch workspaces or the src window is recreated..." "If you switch workspaces or the src window is recreated..."
:around #'org-edit-src-exit :around #'org-edit-src-exit
(let* ((window (selected-window)) (let* ((window (selected-window))
(popup-p (+popup-window-p window))) (popup-p (doom-popup-window-p window)))
(prog1 (apply fn args) (prog1 (apply fn args)
(when (and popup-p (window-live-p window)) (when (and popup-p (window-live-p window))
(delete-window window)))))) (delete-window window))))))
;;;###package org-journal ;;;###package org-journal
(with-eval-after-load 'org-journal (with-eval-after-load 'org-journal
(defadvice! +popup--use-popup-window-a (fn &rest args) (defadvice! doom-popup--use-popup-window-a (fn &rest args)
:around #'org-journal--search-by-string :around #'org-journal--search-by-string
(letf! ((#'switch-to-buffer #'pop-to-buffer)) (letf! ((#'switch-to-buffer #'pop-to-buffer))
(apply fn args)))) (apply fn args))))
@@ -313,23 +336,23 @@ Ugh, such an ugly hack."
;;;###package persp-mode ;;;###package persp-mode
(with-eval-after-load 'persp-mode (with-eval-after-load 'persp-mode
(defadvice! +popup--persp-mode-restore-popups-a (&rest _) (defadvice! doom-popup--persp-mode-restore-popups-a (&rest _)
"Restore popup windows when loading a perspective from file." "Restore popup windows when loading a perspective from file."
:after #'persp-load-state-from-file :after #'persp-load-state-from-file
(dolist (window (window-list)) (dolist (window (window-list))
(when (+popup-parameter 'popup window) (when (doom-popup-parameter 'popup window)
(+popup--init window nil))))) (doom-popup--init window nil)))))
(with-eval-after-load 'pdf-tools (with-eval-after-load 'pdf-tools
(setq tablist-context-window-display-action (setq tablist-context-window-display-action
'((+popup-display-buffer-stacked-side-window-fn) '((doom-popup-display-buffer-stacked-side-window-fn)
(side . left) (side . left)
(slot . 2) (slot . 2)
(window-height . 0.3) (window-height . 0.3)
(inhibit-same-window . t)) (inhibit-same-window . t))
pdf-annot-list-display-buffer-action pdf-annot-list-display-buffer-action
'((+popup-display-buffer-stacked-side-window-fn) '((doom-popup-display-buffer-stacked-side-window-fn)
(side . left) (side . left)
(slot . 3) (slot . 3)
(inhibit-same-window . t)))) (inhibit-same-window . t))))
@@ -337,7 +360,7 @@ Ugh, such an ugly hack."
;;;###package profiler ;;;###package profiler
(with-eval-after-load 'profiler (with-eval-after-load 'profiler
(defadvice! +popup--profiler-report-find-entry-in-other-window-a (fn function) (defadvice! doom-popup--profiler-report-find-entry-in-other-window-a (fn function)
:around #'profiler-report-find-entry :around #'profiler-report-find-entry
(letf! ((#'find-function #'find-function-other-window)) (letf! ((#'find-function #'find-function-other-window))
(funcall fn function)))) (funcall fn function))))
@@ -345,7 +368,7 @@ Ugh, such an ugly hack."
;;;###package undo-tree ;;;###package undo-tree
(with-eval-after-load 'undo-tree (with-eval-after-load 'undo-tree
(defadvice! +popup--use-popup-window-for-undo-tree-visualizer-a (fn &rest args) (defadvice! doom-popup--use-popup-window-for-undo-tree-visualizer-a (fn &rest args)
"TODO" "TODO"
:around #'undo-tree-visualize :around #'undo-tree-visualize
(if undo-tree-visualizer-diff (if undo-tree-visualizer-diff
@@ -356,14 +379,14 @@ Ugh, such an ugly hack."
;;;###package wdired ;;;###package wdired
(with-eval-after-load 'wdired (with-eval-after-load 'wdired
;; close the popup after you're done with a wdired buffer ;; close the popup after you're done with a wdired buffer
(advice-add #'wdired-abort-changes :after #'+popup-close-a) (advice-add #'wdired-abort-changes :after #'doom-popup-close-a)
(advice-add #'wdired-finish-edit :after #'+popup-close-a)) (advice-add #'wdired-finish-edit :after #'doom-popup-close-a))
;;;###package wgrep ;;;###package wgrep
(with-eval-after-load 'wgrep (with-eval-after-load 'wgrep
;; close the popup after you're done with a wgrep buffer ;; close the popup after you're done with a wgrep buffer
(advice-add #'wgrep-abort-changes :after #'+popup-close-a) (advice-add #'wgrep-abort-changes :after #'doom-popup-close-a)
(advice-add #'wgrep-finish-edit :after #'+popup-close-a)) (advice-add #'wgrep-finish-edit :after #'doom-popup-close-a))
(with-eval-after-load 'which-key (with-eval-after-load 'which-key
@@ -375,7 +398,7 @@ Ugh, such an ugly hack."
which-key-custom-show-popup-function which-key-custom-show-popup-function
(lambda (act-popup-dim) (lambda (act-popup-dim)
(letf! (defun display-buffer-in-side-window (buffer alist) (letf! (defun display-buffer-in-side-window (buffer alist)
(+popup-display-buffer-stacked-side-window-fn (doom-popup-display-buffer-stacked-side-window-fn
buffer (append '((vslot . -9999) (select . t)) alist))) buffer (append '((vslot . -9999) (select . t)) alist)))
;; HACK Fix #2219 where the which-key popup would get cut off. ;; HACK Fix #2219 where the which-key popup would get cut off.
(setcar act-popup-dim (1+ (car act-popup-dim))) (setcar act-popup-dim (1+ (car act-popup-dim)))
@@ -385,7 +408,7 @@ Ugh, such an ugly hack."
;;;###package windmove ;;;###package windmove
;; Users should be able to hop into popups easily, but Elisp shouldn't. ;; Users should be able to hop into popups easily, but Elisp shouldn't.
(with-eval-after-load 'windmove (with-eval-after-load 'windmove
(defun +popup--ignore-window-parameters-a (fn &rest args) (defun doom-popup--ignore-window-parameters-a (fn &rest args)
"Allow *interactive* window moving commands to traverse popups." "Allow *interactive* window moving commands to traverse popups."
(cl-letf ((windmove-find-other-window (cl-letf ((windmove-find-other-window
(symbol-function #'windmove-find-other-window))) (symbol-function #'windmove-find-other-window)))
@@ -397,7 +420,7 @@ Ugh, such an ugly hack."
(`down 'below) (`down 'below)
(_ dir)) (_ dir))
window window
(bound-and-true-p +popup-mode) (bound-and-true-p doom-popup-mode)
arg arg
windmove-wrap-around windmove-wrap-around
t)))) t))))
@@ -406,6 +429,6 @@ Ugh, such an ugly hack."
(dolist (target (list #'windmove-up #'windmove-down (dolist (target (list #'windmove-up #'windmove-down
#'windmove-left #'windmove-right)) #'windmove-left #'windmove-right))
(advice-add target (advice-add target
:around #'+popup--ignore-window-parameters-a))) :around #'doom-popup--ignore-window-parameters-a)))
(provide 'syd-popup-hacks) (provide 'doom-popup-hacks)

71
users/crumb/programs/emacs/modules/syd-popup/syd-popup-settings.el → users/crumb/programs/emacs/modules/doom-popup/doom-popup-settings.el
View File

@@ -1,10 +1,33 @@
;;; settings.el -*- lexical-binding: t; -*- ;;; settings.el -*- lexical-binding: t; -*-
;;;###autoload ;; The MIT License (MIT)
(defvar +popup--display-buffer-alist nil) ;;
;; Copyright (c) 2014-2024 Henrik Lissner.
;;
;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
;; "Software"), to deal in the Software without restriction, including
;; without limitation the rights to use, copy, modify, merge, publish,
;; distribute, sublicense, and/or sell copies of the Software, and to
;; permit persons to whom the Software is furnished to do so, subject to
;; the following conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
;;;###autoload ;;;###autoload
(defvar +popup-defaults (defvar doom-popup--display-buffer-alist nil)
;;;###autoload
(defvar doom-popup-defaults
(list :side 'bottom (list :side 'bottom
:height 0.16 :height 0.16
:width 40 :width 40
@@ -14,10 +37,10 @@
"Default properties for popup rules defined with `set-popup-rule!'.") "Default properties for popup rules defined with `set-popup-rule!'.")
;;;###autoload ;;;###autoload
(defun +popup-make-rule (predicate plist) (defun doom-popup-make-rule (predicate plist)
(if (plist-get plist :ignore) (if (plist-get plist :ignore)
(list predicate nil) (list predicate nil)
(let* ((plist (append plist +popup-defaults)) (let* ((plist (append plist doom-popup-defaults))
(alist (alist
`((actions . ,(plist-get plist :actions)) `((actions . ,(plist-get plist :actions))
(side . ,(plist-get plist :side)) (side . ,(plist-get plist :side))
@@ -33,7 +56,7 @@
(modeline . ,(plist-get plist :modeline)) (modeline . ,(plist-get plist :modeline))
(autosave . ,(plist-get plist :autosave)) (autosave . ,(plist-get plist :autosave))
,@(plist-get plist :parameters)))) ,@(plist-get plist :parameters))))
`(,predicate (+popup-buffer) `(,predicate (doom-popup-buffer)
,@alist ,@alist
(window-parameters ,@params))))) (window-parameters ,@params)))))
@@ -62,12 +85,12 @@ PLIST can be made up of any of the following properties:
:actions ACTIONS :actions ACTIONS
ACTIONS is a list of functions or an alist containing (FUNCTION . ALIST). See 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 `display-buffer''s second argument for more information on its format and what
it accepts. If omitted, `+popup-default-display-buffer-actions' is used. it accepts. If omitted, `doom-popup-default-display-buffer-actions' is used.
:side 'bottom|'top|'left|'right :side 'bottom|'top|'left|'right
Which side of the frame to open the popup on. This is only respected if 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' `doom-popup-display-buffer-stacked-side-window-fn' or `display-buffer-in-side-window'
is in :actions or `+popup-default-display-buffer-actions'. is in :actions or `doom-popup-default-display-buffer-actions'.
:size/:width/:height FLOAT|INT|FN :size/:width/:height FLOAT|INT|FN
Determines the size of the popup. If more than one of these size properties are Determines the size of the popup. If more than one of these size properties are
@@ -81,11 +104,11 @@ PLIST can be made up of any of the following properties:
If an INT, the number determines the size in lines (height) or units of If an INT, the number determines the size in lines (height) or units of
character width (width). character width (width).
If a function, it takes one argument: the popup window, and can do whatever it 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'. wants with it, typically resize it, like `doom-popup-shrink-to-fit'.
:slot/:vslot INT :slot/:vslot INT
(This only applies to popups with a :side and only if :actions is blank or (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 contains the `doom-popup-display-buffer-stacked-side-window-fn' action) These control
how multiple popups are laid out. INT can be any integer, positive and how multiple popups are laid out. INT can be any integer, positive and
negative. negative.
@@ -108,7 +131,7 @@ PLIST can be made up of any of the following properties:
any associated processes). any associated processes).
If 0, the buffer is immediately killed. If 0, the buffer is immediately killed.
If nil, the buffer won't be killed and is left to its own devices. 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 If t, resort to the default :ttl in `doom-popup-defaults'. If none exists, this is
the same as nil. the same as nil.
If a function, it takes one argument: the target popup buffer. The popup If a function, it takes one argument: the target popup buffer. The popup
system does nothing else and ignores the function's return value. system does nothing else and ignores the function's return value.
@@ -157,16 +180,16 @@ PLIST can be made up of any of the following properties:
:parameters ALIST :parameters ALIST
An alist of custom window parameters. See `(elisp)Window Parameters'. An alist of custom window parameters. See `(elisp)Window Parameters'.
If any of these are omitted, defaults derived from `+popup-defaults' will be If any of these are omitted, defaults derived from `doom-popup-defaults' will be
used. used.
\(fn PREDICATE &key IGNORE ACTIONS SIDE SIZE WIDTH HEIGHT SLOT VSLOT TTL QUIT SELECT MODELINE AUTOSAVE PARAMETERS)" \(fn PREDICATE &key IGNORE ACTIONS SIDE SIZE WIDTH HEIGHT SLOT VSLOT TTL QUIT SELECT MODELINE AUTOSAVE PARAMETERS)"
(declare (indent defun)) (declare (indent defun))
(push (+popup-make-rule predicate plist) +popup--display-buffer-alist) (push (doom-popup-make-rule predicate plist) doom-popup--display-buffer-alist)
;; TODO: Don't overwrite user entries in `display-buffer-alist' ;; TODO: Don't overwrite user entries in `display-buffer-alist'
(when (bound-and-true-p +popup-mode) (when (bound-and-true-p doom-popup-mode)
(setq display-buffer-alist +popup--display-buffer-alist)) (setq display-buffer-alist doom-popup--display-buffer-alist))
+popup--display-buffer-alist) doom-popup--display-buffer-alist)
;;;###autodef ;;;###autodef
(defun set-popup-rules! (&rest rulesets) (defun set-popup-rules! (&rest rulesets)
@@ -179,17 +202,17 @@ and plist.
Example: Example:
(set-popup-rules! (set-popup-rules!
'((\"^ \\*\" :slot 1 :vslot -1 :size #'+popup-shrink-to-fit) '((\"^ \\*\" :slot 1 :vslot -1 :size #'doom-popup-shrink-to-fit)
(\"^\\*\" :slot 1 :vslot -1 :select t)) (\"^\\*\" :slot 1 :vslot -1 :select t))
'((\"^\\*Completions\" :slot -1 :vslot -2 :ttl 0) '((\"^\\*Completions\" :slot -1 :vslot -2 :ttl 0)
(\"^\\*Compil\\(?:ation\\|e-Log\\)\" :size 0.3 :ttl 0 :quit t)))" (\"^\\*Compil\\(?:ation\\|e-Log\\)\" :size 0.3 :ttl 0 :quit t)))"
(declare (indent 0)) (declare (indent 0))
(dolist (rules rulesets) (dolist (rules rulesets)
(dolist (rule rules) (dolist (rule rules)
(push (+popup-make-rule (car rule) (cdr rule)) (push (doom-popup-make-rule (car rule) (cdr rule))
+popup--display-buffer-alist))) doom-popup--display-buffer-alist)))
(when (bound-and-true-p +popup-mode) (when (bound-and-true-p doom-popup-mode)
(setq display-buffer-alist +popup--display-buffer-alist)) (setq display-buffer-alist doom-popup--display-buffer-alist))
+popup--display-buffer-alist) doom-popup--display-buffer-alist)
(provide 'syd-popup-settings) (provide 'doom-popup-settings)

354
users/crumb/programs/emacs/modules/syd-popup/syd-popup.el → users/crumb/programs/emacs/modules/doom-popup/doom-popup.el
View File

@@ -1,18 +1,50 @@
;;; popup.el -*- lexical-binding: t; -*- ;;; doom-popup.el -*- lexical-binding: t; -*-
(require 'syd-popup-settings) ;; The MIT License (MIT)
;;
;; Copyright (c) 2014-2024 Henrik Lissner.
;;
;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
;; "Software"), to deal in the Software without restriction, including
;; without limitation the rights to use, copy, modify, merge, publish,
;; distribute, sublicense, and/or sell copies of the Software, and to
;; permit persons to whom the Software is furnished to do so, subject to
;; the following conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
(defvar +popup--internal nil) (require 'doom-popup-settings)
(defun +popup--remember (windows) (use-package popper
:custom ((popper-display-control nil)
(popper-reference-buffers
(list (lambda (buf)
(with-current-buffer buf
(bound-and-true-p doom-popup-mode))))))
:config
(popper-mode 1))
(defvar doom-popup--internal nil)
(defun doom-popup--remember (windows)
"Remember WINDOWS (a list of windows) for later restoration." "Remember WINDOWS (a list of windows) for later restoration."
(cl-assert (cl-every #'windowp windows) t) (cl-assert (cl-every #'windowp windows) t)
(setq +popup--last (setq doom-popup--last
(cl-loop for w in windows (cl-loop for w in windows
collect (cons (window-buffer w) collect (cons (window-buffer w)
(window-state-get w))))) (window-state-get w)))))
(defun +popup--kill-buffer (buffer ttl) (defun doom-popup--kill-buffer (buffer ttl)
"Tries to kill BUFFER, as was requested by a transient timer. If it fails, eg. "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." the buffer is visible, then set another timer and try again later."
(let ((inhibit-quit t)) (let ((inhibit-quit t))
@@ -20,7 +52,8 @@ the buffer is visible, then set another timer and try again later."
((not (get-buffer-window buffer t)) ((not (get-buffer-window buffer t))
(with-demoted-errors "Error killing transient buffer: %s" (with-demoted-errors "Error killing transient buffer: %s"
(with-current-buffer buffer (with-current-buffer buffer
(let ((kill-buffer-hook (remq '+popup-kill-buffer-hook-h kill-buffer-hook)) (let ((kill-buffer-hook (remq 'doom-popup-kill-buffer-hook-h
kill-buffer-hook))
confirm-kill-processes) confirm-kill-processes)
(when-let (process (get-buffer-process buffer)) (when-let (process (get-buffer-process buffer))
(when (eq (process-type process) 'real) (when (eq (process-type process) 'real)
@@ -32,19 +65,20 @@ the buffer is visible, then set another timer and try again later."
(cl-letf (((symbol-function #'top-level) #'ignore)) (cl-letf (((symbol-function #'top-level) #'ignore))
(kill-buffer buffer))))))) (kill-buffer buffer)))))))
((let ((ttl (if (= ttl 0) ((let ((ttl (if (= ttl 0)
(or (plist-get +popup-defaults :ttl) 3) (or (plist-get doom-popup-defaults :ttl) 3)
ttl))) ttl)))
(with-current-buffer buffer (with-current-buffer buffer
(setq +popup--timer (setq doom-popup--timer
(run-at-time ttl nil #'+popup--kill-buffer buffer ttl)))))))) (run-at-time
ttl nil #'doom-popup--kill-buffer buffer ttl))))))))
(defun +popup--delete-window (window) (defun doom-popup--delete-window (window)
"Do housekeeping before destroying a popup window. "Do housekeeping before destroying a popup window.
+ Disables `+popup-buffer-mode' so that any hooks attached to it get a chance to + Disables `doom-popup-buffer-mode' so that any hooks attached to it get a chance to
run and do cleanup of its own. run and do cleanup of its own.
+ Either kills the buffer or sets a transient timer, if the window has a + Either kills the buffer or sets a transient timer, if the window has a
`transient' window parameter (see `+popup-window-parameters'). `transient' window parameter (see `doom-popup-window-parameters').
+ And finally deletes the window!" + And finally deletes the window!"
(let ((buffer (window-buffer window)) (let ((buffer (window-buffer window))
(inhibit-quit t)) (inhibit-quit t))
@@ -52,7 +86,7 @@ the buffer is visible, then set another timer and try again later."
(if-let (base-buffer (buffer-base-buffer buffer)) (if-let (base-buffer (buffer-base-buffer buffer))
(buffer-file-name base-buffer))) (buffer-file-name base-buffer)))
(buffer-modified-p buffer) (buffer-modified-p buffer)
(let ((autosave (+popup-parameter 'autosave window))) (let ((autosave (doom-popup-parameter 'autosave window)))
(cond ((eq autosave 't)) (cond ((eq autosave 't))
((null autosave) ((null autosave)
(y-or-n-p "Popup buffer is modified. Save it?")) (y-or-n-p "Popup buffer is modified. Save it?"))
@@ -66,41 +100,44 @@ the buffer is visible, then set another timer and try again later."
(unless (window-live-p window) (unless (window-live-p window)
(with-current-buffer buffer (with-current-buffer buffer
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(+popup-buffer-mode -1) (doom-popup-buffer-mode -1)
(unless +popup--inhibit-transient (unless doom-popup--inhibit-transient
(let ((ttl (+popup-parameter 'ttl window))) (let ((ttl (doom-popup-parameter 'ttl window)))
(when (eq ttl 't) (when (eq ttl 't)
(setq ttl (plist-get +popup-defaults :ttl))) (setq ttl (plist-get doom-popup-defaults :ttl)))
(cond ((null ttl)) (cond ((null ttl))
((functionp ttl) ((functionp ttl)
(funcall ttl buffer)) (funcall ttl buffer))
((not (integerp ttl)) ((not (integerp ttl))
(signal 'wrong-type-argument (list 'integerp ttl))) (signal 'wrong-type-argument (list 'integerp ttl)))
((= ttl 0) ((= ttl 0)
(+popup--kill-buffer buffer 0)) (doom-popup--kill-buffer buffer 0))
((add-hook 'kill-buffer-hook #'+popup-kill-buffer-hook-h nil t) ((add-hook 'kill-buffer-hook
(setq +popup--timer #'doom-popup-kill-buffer-hook-h
(run-at-time ttl nil #'+popup--kill-buffer nil
t)
(setq doom-popup--timer
(run-at-time ttl nil #'doom-popup--kill-buffer
buffer ttl)))))))))) buffer ttl))))))))))
(defun +popup--delete-other-windows (window) (defun doom-popup--delete-other-windows (window)
"Fixes `delete-other-windows' when used from a popup window." "Fixes `delete-other-windows' when used from a popup window."
(when-let (window (ignore-errors (+popup/raise window))) (when-let (window (ignore-errors (doom-popup/raise window)))
(let ((ignore-window-parameters t)) (let ((ignore-window-parameters t))
(delete-other-windows window))) (delete-other-windows window)))
nil) nil)
(defun +popup--normalize-alist (alist) (defun doom-popup--normalize-alist (alist)
"Merge `+popup-default-alist' and `+popup-default-parameters' with ALIST." "Merge `doom-popup-default-alist' and `doom-popup-default-parameters' with ALIST."
(when alist (when alist
(let ((alist ; handle defaults (let ((alist ; handle defaults
(cl-remove-duplicates (cl-remove-duplicates
(append alist +popup-default-alist) (append alist doom-popup-default-alist)
:key #'car-safe :from-end t)) :key #'car-safe :from-end t))
(parameters (parameters
(cl-remove-duplicates (cl-remove-duplicates
(append (cdr (assq 'window-parameters alist)) (append (cdr (assq 'window-parameters alist))
+popup-default-parameters) doom-popup-default-parameters)
:key #'car-safe :from-end t))) :key #'car-safe :from-end t)))
;; handle `size' ;; handle `size'
(when-let* ((size (cdr (assq 'size alist))) (when-let* ((size (cdr (assq 'size alist)))
@@ -127,64 +164,67 @@ the buffer is visible, then set another timer and try again later."
height)) height))
alist)))) alist))))
(defun +popup--split-window (window size side) (defun doom-popup--split-window (window size side)
"Ensure a non-dedicated/popup window is selected when splitting a window." "Ensure a non-dedicated/popup window is selected when splitting a window."
(unless +popup--internal (unless doom-popup--internal
(cl-loop for win (cl-loop for win
in (cons (or window (selected-window)) in (cons (or window (selected-window))
(window-list nil 0 window)) (window-list nil 0 window))
unless (+popup-window-p win) unless (doom-popup-window-p win)
return (setq window win))) return (setq window win)))
(let ((ignore-window-parameters t)) (let ((ignore-window-parameters t))
(split-window window size side))) (split-window window size side)))
(defun +popup--maybe-select-window (window origin) (defun doom-popup--maybe-select-window (window origin)
"Select a window based on `+popup--inhibit-select' and this window's `select' parameter." "Select a window based on `doom-popup--inhibit-select' and this window's `select'
(unless +popup--inhibit-select parameter."
(unless doom-popup--inhibit-select
;; REVIEW: Once our minimum version is bumped up to Emacs 30.x, replace this ;; REVIEW: Once our minimum version is bumped up to Emacs 30.x, replace this
;; with `post-command-select-window' window parameter. ;; with `post-command-select-window' window parameter.
(let ((select (+popup-parameter 'select window))) (let ((select (doom-popup-parameter 'select window)))
(if (functionp select) (if (functionp select)
(funcall select window origin) (funcall select window origin)
(select-window (if select window origin)))))) (select-window (if select window origin))))))
;;;###autoload ;;;###autoload
(defun +popup--init (window &optional alist) (defun doom-popup--init (window &optional alist)
"Initializes a popup window. Run any time a popup is opened. It sets the "Initializes a popup window. Run any time a popup is opened. It sets the
default window parameters for popup windows, clears leftover transient timers default window parameters for popup windows, clears leftover transient timers
and enables `+popup-buffer-mode'." and enables `doom-popup-buffer-mode'."
(with-selected-window window (with-selected-window window
(setq alist (delq (assq 'actions alist) alist)) (setq alist (delq (assq 'actions alist) alist))
(set-window-parameter window 'popup t) (set-window-parameter window 'popup t)
(set-window-parameter window 'split-window #'+popup--split-window) (set-window-parameter window 'split-window #'doom-popup--split-window)
(set-window-parameter window 'delete-window #'+popup--delete-window) (set-window-parameter window 'delete-window #'doom-popup--delete-window)
(set-window-parameter window 'delete-other-windows #'+popup--delete-other-windows) (set-window-parameter window
'delete-other-windows
#'doom-popup--delete-other-windows)
(set-window-dedicated-p window 'popup) (set-window-dedicated-p window 'popup)
(window-preserve-size (window-preserve-size
window (memq (window-parameter window 'window-side) window (memq (window-parameter window 'window-side)
'(left right)) '(left right))
t) t)
(+popup-buffer-mode +1) (doom-popup-buffer-mode +1)
(run-hooks '+popup-create-window-hook))) (run-hooks 'doom-popup-create-window-hook)))
;; ;;
;; Public library ;; Public library
;;;###autoload ;;;###autoload
(defun +popup-buffer-p (&optional buffer) (defun doom-popup-buffer-p (&optional buffer)
"Return non-nil if BUFFER is a popup buffer. Defaults to the current buffer." "Return non-nil if BUFFER is a popup buffer. Defaults to the current buffer."
(when +popup-mode (when doom-popup-mode
(let ((buffer (or buffer (current-buffer)))) (let ((buffer (or buffer (current-buffer))))
(and (bufferp buffer) (and (bufferp buffer)
(buffer-live-p buffer) (buffer-live-p buffer)
(buffer-local-value '+popup-buffer-mode buffer) (buffer-local-value 'doom-popup-buffer-mode buffer)
buffer)))) buffer))))
;;;###autoload ;;;###autoload
(defun +popup-window-p (&optional window) (defun doom-popup-window-p (&optional window)
"Return non-nil if WINDOW is a popup window. Defaults to the current window." "Return non-nil if WINDOW is a popup window. Defaults to the current window."
(when +popup-mode (when doom-popup-mode
(let ((window (or window (selected-window)))) (let ((window (or window (selected-window))))
(and (windowp window) (and (windowp window)
(window-live-p window) (window-live-p window)
@@ -192,47 +232,47 @@ and enables `+popup-buffer-mode'."
window)))) window))))
;;;###autoload ;;;###autoload
(defun +popup-buffer (buffer &optional alist) (defun doom-popup-buffer (buffer &optional alist)
"Open BUFFER in a popup window. ALIST describes its features." "Open BUFFER in a popup window. ALIST describes its features."
(let* ((origin (selected-window)) (let* ((origin (selected-window))
(window-min-height 3) (window-min-height 3)
(alist (+popup--normalize-alist alist)) (alist (doom-popup--normalize-alist alist))
(actions (or (cdr (assq 'actions alist)) (actions (or (cdr (assq 'actions alist))
+popup-default-display-buffer-actions))) doom-popup-default-display-buffer-actions)))
(or (let* ((alist (remove (assq 'window-width alist) alist)) (or (let* ((alist (remove (assq 'window-width alist) alist))
(alist (remove (assq 'window-height alist) alist)) (alist (remove (assq 'window-height alist) alist))
(window (display-buffer-reuse-window buffer alist))) (window (display-buffer-reuse-window buffer alist)))
(when window (when window
(+popup--maybe-select-window window origin) (doom-popup--maybe-select-window window origin)
window)) window))
(when-let (popup (cl-loop for func in actions (when-let (popup (cl-loop for func in actions
if (funcall func buffer alist) if (funcall func buffer alist)
return it)) return it))
(+popup--init popup alist) (doom-popup--init popup alist)
(+popup--maybe-select-window popup origin) (doom-popup--maybe-select-window popup origin)
popup)))) popup))))
;;;###autoload ;;;###autoload
(defun +popup-parameter (parameter &optional window) (defun doom-popup-parameter (parameter &optional window)
"Fetch the window PARAMETER (symbol) of WINDOW" "Fetch the window PARAMETER (symbol) of WINDOW"
(window-parameter (or window (selected-window)) parameter)) (window-parameter (or window (selected-window)) parameter))
;;;###autoload ;;;###autoload
(defun +popup-parameter-fn (parameter &optional window &rest args) (defun doom-popup-parameter-fn (parameter &optional window &rest args)
"Fetch the window PARAMETER (symbol) of WINDOW. If it is a function, run it "Fetch the window PARAMETER (symbol) of WINDOW. If it is a function, run it
with ARGS to get its return value." with ARGS to get its return value."
(let ((val (+popup-parameter parameter window))) (let ((val (doom-popup-parameter parameter window)))
(if (functionp val) (if (functionp val)
(apply val args) (apply val args)
val))) val)))
;;;###autoload ;;;###autoload
(defun +popup-windows () (defun doom-popup-windows ()
"Returns a list of all popup windows." "Returns a list of all popup windows."
(cl-remove-if-not #'+popup-window-p (window-list))) (cl-remove-if-not #'doom-popup-window-p (window-list)))
;;;###autoload ;;;###autoload
(defun +popup-shrink-to-fit (&optional window) (defun doom-popup-shrink-to-fit (&optional window)
"Shrinks WINDOW to fit the buffer contents, if the buffer isn't empty. "Shrinks WINDOW to fit the buffer contents, if the buffer isn't empty.
Uses `shrink-window-if-larger-than-buffer'." Uses `shrink-window-if-larger-than-buffer'."
@@ -242,7 +282,7 @@ Uses `shrink-window-if-larger-than-buffer'."
(shrink-window-if-larger-than-buffer window))) (shrink-window-if-larger-than-buffer window)))
;;;###autoload ;;;###autoload
(defun +popup-alist-from-window-state (state) (defun doom-popup-alist-from-window-state (state)
"Convert window STATE (from `window-state-get') to a `display-buffer' alist." "Convert window STATE (from `window-state-get') to a `display-buffer' alist."
(let* ((params (alist-get 'parameters state))) (let* ((params (alist-get 'parameters state)))
`((side . ,(alist-get 'window-side params)) `((side . ,(alist-get 'window-side params))
@@ -255,25 +295,25 @@ Uses `shrink-window-if-larger-than-buffer'."
;; Hooks ;; Hooks
;;;###autoload ;;;###autoload
(defun +popup-adjust-fringes-h () (defun doom-popup-adjust-fringes-h ()
"Hides the fringe in popup windows, restoring them if `+popup-buffer-mode' is "Hides the fringe in popup windows, restoring them if `doom-popup-buffer-mode' is
disabled." disabled."
(let ((f (if (bound-and-true-p +popup-buffer-mode) 0))) (let ((f (if (bound-and-true-p doom-popup-buffer-mode) 0)))
(set-window-fringes nil f f fringes-outside-margins))) (set-window-fringes nil f f fringes-outside-margins)))
;;;###autoload ;;;###autoload
(defun +popup-adjust-margins-h () (defun doom-popup-adjust-margins-h ()
"Creates padding for the popup window determined by `+popup-margin-width', "Creates padding for the popup window determined by `doom-popup-margin-width',
restoring it if `+popup-buffer-mode' is disabled." restoring it if `doom-popup-buffer-mode' is disabled."
(when +popup-margin-width (when doom-popup-margin-width
(unless (memq (window-parameter nil 'window-side) '(left right)) (unless (memq (window-parameter nil 'window-side) '(left right))
(let ((m (if (bound-and-true-p +popup-buffer-mode) +popup-margin-width))) (let ((m (if (bound-and-true-p doom-popup-buffer-mode) doom-popup-margin-width)))
(set-window-margins nil m m))))) (set-window-margins nil m m)))))
(defvar hide-mode-line-format) (defvar hide-mode-line-format)
;;;###autoload ;;;###autoload
(defun +popup-set-modeline-on-enable-h () (defun doom-popup-set-modeline-on-enable-h ()
"Don't show modeline in popup windows without a `modeline' window-parameter. "Don't show modeline in popup windows without a `modeline' window-parameter.
Possible values for this parameter are: Possible values for this parameter are:
@@ -283,9 +323,9 @@ Possible values for this parameter are:
Any non-nil value besides the above will be used as the raw value for Any non-nil value besides the above will be used as the raw value for
`mode-line-format'." `mode-line-format'."
(when (and (bound-and-true-p +popup-buffer-mode) (when (and (bound-and-true-p doom-popup-buffer-mode)
(boundp 'hide-mode-line-mode)) (boundp 'hide-mode-line-mode))
(let ((modeline (+popup-parameter 'modeline))) (let ((modeline (doom-popup-parameter 'modeline)))
(cond ((eq modeline 't)) (cond ((eq modeline 't))
((null modeline) ((null modeline)
;; TODO use `mode-line-format' window parameter instead (emacs 26+) ;; TODO use `mode-line-format' window parameter instead (emacs 26+)
@@ -295,74 +335,74 @@ Any non-nil value besides the above will be used as the raw value for
(funcall modeline) (funcall modeline)
modeline))) modeline)))
(hide-mode-line-mode +1))))))) (hide-mode-line-mode +1)))))))
(put '+popup-set-modeline-on-enable-h 'permanent-local-hook t) (put 'doom-popup-set-modeline-on-enable-h 'permanent-local-hook t)
;;;###autoload ;;;###autoload
(defun +popup-unset-modeline-on-disable-h () (defun doom-popup-unset-modeline-on-disable-h ()
"Restore the modeline when `+popup-buffer-mode' is deactivated." "Restore the modeline when `doom-popup-buffer-mode' is deactivated."
(when (and (not (bound-and-true-p +popup-buffer-mode)) (when (and (not (bound-and-true-p doom-popup-buffer-mode))
(bound-and-true-p hide-mode-line-mode) (bound-and-true-p hide-mode-line-mode)
(not (bound-and-true-p global-hide-mode-line-mode))) (not (bound-and-true-p global-hide-mode-line-mode)))
(hide-mode-line-mode -1))) (hide-mode-line-mode -1)))
;;;###autoload ;;;###autoload
(defun +popup-close-on-escape-h () (defun doom-popup-close-on-escape-h ()
"If called inside a popup, try to close that popup window (see "If called inside a popup, try to close that popup window (see
`+popup/close'). If called outside, try to close all popup windows (see `doom-popup/close'). If called outside, try to close all popup windows (see
`+popup/close-all')." `doom-popup/close-all')."
(if (+popup-window-p) (if (doom-popup-window-p)
(+popup/close) (doom-popup/close)
(+popup/close-all))) (doom-popup/close-all)))
;;;###autoload ;;;###autoload
(defun +popup-cleanup-rules-h () (defun doom-popup-cleanup-rules-h ()
"Cleans up any duplicate popup rules." "Cleans up any duplicate popup rules."
(interactive) (interactive)
(setq +popup--display-buffer-alist (setq doom-popup--display-buffer-alist
(cl-delete-duplicates +popup--display-buffer-alist (cl-delete-duplicates doom-popup--display-buffer-alist
:key #'car :test #'equal :from-end t)) :key #'car :test #'equal :from-end t))
(when +popup-mode (when doom-popup-mode
(setq display-buffer-alist +popup--display-buffer-alist))) (setq display-buffer-alist doom-popup--display-buffer-alist)))
;;;###autoload ;;;###autoload
(defun +popup-kill-buffer-hook-h () (defun doom-popup-kill-buffer-hook-h ()
"TODO" "TODO"
(when-let (window (get-buffer-window)) (when-let (window (get-buffer-window))
(when (+popup-window-p window) (when (doom-popup-window-p window)
(let ((+popup--inhibit-transient t)) (let ((doom-popup--inhibit-transient t))
(+popup--delete-window window))))) (doom-popup--delete-window window)))))
;; ;;
;; Commands ;; Commands
;;;###autoload ;;;###autoload
(defalias 'other-popup #'+popup/other) (defalias 'other-popup #'doom-popup/other)
;;;###autoload ;;;###autoload
(defun +popup/buffer () (defun doom-popup/buffer ()
"Open this buffer in a popup window." "Open this buffer in a popup window."
(interactive) (interactive)
(let ((+popup-default-display-buffer-actions (let ((doom-popup-default-display-buffer-actions
'(+popup-display-buffer-stacked-side-window-fn)) '(doom-popup-display-buffer-stacked-side-window-fn))
(display-buffer-alist +popup--display-buffer-alist) (display-buffer-alist doom-popup--display-buffer-alist)
(buffer (current-buffer))) (buffer (current-buffer)))
(push (+popup-make-rule "." +popup-defaults) display-buffer-alist) (push (doom-popup-make-rule "." doom-popup-defaults) display-buffer-alist)
(bury-buffer) (bury-buffer)
(pop-to-buffer buffer))) (pop-to-buffer buffer)))
;;;###autoload ;;;###autoload
(defun +popup/other () (defun doom-popup/other ()
"Cycle through popup windows, like `other-window'. Ignores regular windows." "Cycle through popup windows, like `other-window'. Ignores regular windows."
(interactive) (interactive)
(if-let (popups (cl-remove-if-not (if-let (popups (cl-remove-if-not
(lambda (w) (or (+popup-window-p w) (lambda (w) (or (doom-popup-window-p w)
;; This command should be able to hop between ;; This command should be able to hop between
;; windows with a `no-other-window' ;; windows with a `no-other-window'
;; parameter, since `other-window' won't. ;; parameter, since `other-window' won't.
(window-parameter w 'no-other-window))) (window-parameter w 'no-other-window)))
(window-list))) (window-list)))
(select-window (if (or (+popup-window-p) (select-window (if (or (doom-popup-window-p)
(window-parameter nil 'no-other-window)) (window-parameter nil 'no-other-window))
(let ((window (selected-window))) (let ((window (selected-window)))
(or (car-safe (cdr (memq window popups))) (or (car-safe (cdr (memq window popups)))
@@ -372,7 +412,7 @@ Any non-nil value besides the above will be used as the raw value for
(user-error "No popups are open"))) (user-error "No popups are open")))
;;;###autoload ;;;###autoload
(defun +popup/close (&optional window force-p) (defun doom-popup/close (&optional window force-p)
"Close WINDOW, if it's a popup window. "Close WINDOW, if it's a popup window.
This will do nothing if the popup's `quit' window parameter is either nil or This will do nothing if the popup's `quit' window parameter is either nil or
@@ -381,69 +421,69 @@ This will do nothing if the popup's `quit' window parameter is either nil or
(list (selected-window) (list (selected-window)
current-prefix-arg)) current-prefix-arg))
(let ((window (or window (selected-window)))) (let ((window (or window (selected-window))))
(when (and (+popup-window-p window) (when (and (doom-popup-window-p window)
(or force-p (or force-p
(memq (+popup-parameter-fn 'quit window window) (memq (doom-popup-parameter-fn 'quit window window)
'(t current)))) '(t current))))
(when +popup--remember-last (when doom-popup--remember-last
(+popup--remember (list window))) (doom-popup--remember (list window)))
(delete-window window) (delete-window window)
t))) t)))
;;;###autoload ;;;###autoload
(defun +popup/close-all (&optional force-p) (defun doom-popup/close-all (&optional force-p)
"Close all open popup windows. "Close all open popup windows.
This will ignore popups with an `quit' parameter that is either nil or 'current. 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." This window parameter is ignored if FORCE-P is non-nil."
(interactive "P") (interactive "P")
(let (targets +popup--remember-last) (let (targets doom-popup--remember-last)
(dolist (window (+popup-windows)) (dolist (window (doom-popup-windows))
(when (or force-p (when (or force-p
(memq (+popup-parameter-fn 'quit window window) (memq (doom-popup-parameter-fn 'quit window window)
'(t other))) '(t other)))
(push window targets))) (push window targets)))
(when targets (when targets
(+popup--remember targets) (doom-popup--remember targets)
(mapc #'delete-window targets) (mapc #'delete-window targets)
t))) t)))
;;;###autoload ;;;###autoload
(defun +popup/toggle () (defun doom-popup/toggle ()
"Toggle any visible popups. "Toggle any visible popups.
If no popups are available, display the *Messages* buffer in a popup window." If no popups are available, display the *Messages* buffer in a popup window."
(interactive) (interactive)
(let ((+popup--inhibit-transient t)) (let ((doom-popup--inhibit-transient t))
(cond ((+popup-windows) (+popup/close-all t)) (cond ((doom-popup-windows) (doom-popup/close-all t))
((ignore-errors (+popup/restore))) ((ignore-errors (doom-popup/restore)))
((display-buffer (get-buffer "*Messages*")))))) ((display-buffer (get-buffer "*Messages*"))))))
;;;###autoload ;;;###autoload
(defun +popup/restore () (defun doom-popup/restore ()
"Restore the last popups that were closed, if any." "Restore the last popups that were closed, if any."
(interactive) (interactive)
(unless +popup--last (unless doom-popup--last
(error "No popups to restore")) (error "No popups to restore"))
(cl-loop for (buffer . state) in +popup--last (cl-loop for (buffer . state) in doom-popup--last
if (buffer-live-p buffer) if (buffer-live-p buffer)
do (+popup-buffer buffer (+popup-alist-from-window-state state))) do (doom-popup-buffer buffer (doom-popup-alist-from-window-state state)))
(setq +popup--last nil) (setq doom-popup--last nil)
t) t)
;;;###autoload ;;;###autoload
(defun +popup/raise (window &optional arg) (defun doom-popup/raise (window &optional arg)
"Raise the current popup window into a regular window and "Raise the current popup window into a regular window and
return it. If prefix ARG, raise the current popup into a new return it. If prefix ARG, raise the current popup into a new
window and return that window." window and return that window."
(interactive (interactive
(list (selected-window) current-prefix-arg)) (list (selected-window) current-prefix-arg))
(cl-check-type window window) (cl-check-type window window)
(unless (+popup-window-p window) (unless (doom-popup-window-p window)
(user-error "Cannot raise a non-popup window")) (user-error "Cannot raise a non-popup window"))
(let ((buffer (current-buffer)) (let ((buffer (current-buffer))
(+popup--inhibit-transient t) (doom-popup--inhibit-transient t)
+popup--remember-last) doom-popup--remember-last)
(+popup/close window 'force) (doom-popup/close window 'force)
(let (display-buffer-alist) (let (display-buffer-alist)
(if arg (if arg
(pop-to-buffer buffer) (pop-to-buffer buffer)
@@ -451,7 +491,7 @@ window and return that window."
(selected-window))) (selected-window)))
;;;###autoload ;;;###autoload
(defun +popup/diagnose () (defun doom-popup/diagnose ()
"Reveal what popup rule will be used for the current buffer." "Reveal what popup rule will be used for the current buffer."
(interactive) (interactive)
(if-let (rule (cl-loop with bname = (buffer-name) (if-let (rule (cl-loop with bname = (buffer-name)
@@ -467,18 +507,18 @@ window and return that window."
;; Advice ;; Advice
;;;###autoload ;;;###autoload
(defun +popup-close-a (&rest _) (defun doom-popup-close-a (&rest _)
"TODO" "TODO"
(+popup/close nil t)) (doom-popup/close nil t))
;;;###autoload ;;;###autoload
(defun +popup-save-a (fn &rest args) (defun doom-popup-save-a (fn &rest args)
"Sets aside all popups before executing the original function, usually to "Sets aside all popups before executing the original function, usually to
prevent the popup(s) from messing up the UI (or vice versa)." prevent the popup(s) from messing up the UI (or vice versa)."
(save-popups! (apply fn args))) (save-popups! (apply fn args)))
;;;###autoload ;;;###autoload
(defun +popup-display-buffer-fullframe-fn (buffer alist) (defun doom-popup-display-buffer-fullframe-fn (buffer alist)
"Displays the buffer fullscreen." "Displays the buffer fullscreen."
(let ((wconf (current-window-configuration))) (let ((wconf (current-window-configuration)))
(when-let (window (or (display-buffer-reuse-window buffer alist) (when-let (window (or (display-buffer-reuse-window buffer alist)
@@ -491,7 +531,7 @@ prevent the popup(s) from messing up the UI (or vice versa)."
window))) window)))
;;;###autoload ;;;###autoload
(defun +popup-display-buffer-stacked-side-window-fn (buffer alist) (defun doom-popup-display-buffer-stacked-side-window-fn (buffer alist)
"A `display-buffer' action that serves as an alternative to "A `display-buffer' action that serves as an alternative to
`display-buffer-in-side-window', but allows for stacking popups with the `vslot' `display-buffer-in-side-window', but allows for stacking popups with the `vslot'
alist entry. alist entry.
@@ -502,7 +542,8 @@ Accepts the same arguments as `display-buffer-in-side-window'. You must set
(slot (or (cdr (assq 'slot alist)) 0)) (slot (or (cdr (assq 'slot alist)) 0))
(vslot (or (cdr (assq 'vslot alist)) 0)) (vslot (or (cdr (assq 'vslot alist)) 0))
(left-or-right (memq side '(left right))) (left-or-right (memq side '(left right)))
(display-buffer-mark-dedicated (or display-buffer-mark-dedicated 'popup))) (display-buffer-mark-dedicated (or display-buffer-mark-dedicated
'popup)))
(cond ((not (memq side '(top bottom left right))) (cond ((not (memq side '(top bottom left right)))
(error "Invalid side %s specified" side)) (error "Invalid side %s specified" side))
@@ -512,14 +553,14 @@ Accepts the same arguments as `display-buffer-in-side-window'. You must set
(error "Invalid vslot %s specified" vslot))) (error "Invalid vslot %s specified" vslot)))
(let* ((live (get-window-with-predicate (let* ((live (get-window-with-predicate
(lambda (window) (lambda (window)
(and (eq (window-parameter window 'window-side) side) (and (eq (window-parameter window 'window-side) side)
(eq (window-parameter window 'window-vslot) vslot))) (eq (window-parameter window 'window-vslot) vslot)))
nil)) nil))
;; As opposed to the `window-side' property, our `window-vslot' ;; As opposed to the `window-side' property, our `window-vslot'
;; parameter is set only on a single live window and never on internal ;; parameter is set only on a single live window and never on
;; windows. Moreover, as opposed to `window-with-parameter' (as used ;; internal windows. Moreover, as opposed to `window-with-parameter'
;; by the original `display-buffer-in-side-window'), ;; (as used by the original `display-buffer-in-side-window'),
;; `get-window-with-predicate' only returns live windows anyway. In ;; `get-window-with-predicate' only returns live windows anyway. In
;; any case, we will have missed the major side window and got a ;; any case, we will have missed the major side window and got a
;; child instead if the major side window happens to be an internal ;; child instead if the major side window happens to be an internal
@@ -558,11 +599,14 @@ Accepts the same arguments as `display-buffer-in-side-window'. You must set
(cond ((and (numberp max-slots) (<= max-slots 0)) (cond ((and (numberp max-slots) (<= max-slots 0))
nil) nil)
((not windows) ((not windows)
(cl-letf (((symbol-function 'window--make-major-side-window-next-to) (cl-letf (((symbol-function
'window--make-major-side-window-next-to)
(lambda (_side) (frame-root-window (selected-frame))))) (lambda (_side) (frame-root-window (selected-frame)))))
(when-let (window (window--make-major-side-window buffer side slot alist)) (when-let (window (window--make-major-side-window
buffer side slot alist))
(set-window-parameter window 'window-vslot vslot) (set-window-parameter window 'window-vslot vslot)
(add-to-list 'window-persistent-parameters '(window-vslot . writable)) (add-to-list 'window-persistent-parameters
'(window-vslot . writable))
window))) window)))
(t (t
;; Scan windows on SIDE. ;; Scan windows on SIDE.
@@ -613,17 +657,25 @@ Accepts the same arguments as `display-buffer-in-side-window'. You must set
(or (and next-window (or (and next-window
;; Make new window before `next-window'. ;; Make new window before `next-window'.
(let ((next-side (if left-or-right 'above 'left)) (let ((next-side (if left-or-right 'above 'left))
(+popup--internal t) (doom-popup--internal t)
(window-combination-resize 'side)) (window-combination-resize 'side))
(setq window (setq window
(ignore-errors (split-window next-window nil next-side))))) (ignore-errors
(split-window next-window
nil
next-side)))))
(and prev-window (and prev-window
;; Make new window after `prev-window'. ;; Make new window after `prev-window'.
(let ((prev-side (if left-or-right 'below 'right)) (let ((prev-side (if left-or-right
(+popup--internal t) 'below
'right))
(doom-popup--internal t)
(window-combination-resize 'side)) (window-combination-resize 'side))
(setq window (setq window
(ignore-errors (split-window prev-window nil prev-side)))))) (ignore-errors
(split-window prev-window
nil
prev-side))))))
(set-window-parameter window 'window-slot slot) (set-window-parameter window 'window-slot slot)
(set-window-parameter window 'window-vslot vslot) (set-window-parameter window 'window-vslot vslot)
(with-current-buffer buffer (with-current-buffer buffer
@@ -640,6 +692,6 @@ Accepts the same arguments as `display-buffer-in-side-window'. You must set
(window--display-buffer (window--display-buffer
buffer best-window 'reuse alist))))))))) buffer best-window 'reuse alist)))))))))
(require 'syd-popup-config) (require 'doom-popup-config)
(provide 'syd-popup) (provide 'doom-popup)

29
users/crumb/programs/emacs/modules/lang/syd-lang-emacs-lisp.el
View File

@@ -3,24 +3,23 @@
(require 'syd-handle-repl) (require 'syd-handle-repl)
(use-package ielm (use-package ielm
:commands ielm
:hook (emacs-lisp-mode) :hook (emacs-lisp-mode)
:custom ((ielm-history-file-name ; Stay out of my config dir! :custom ((ielm-history-file-name ; Stay out of my config dir!
(file-name-concat syd-cache-dir "ielm-history.eld"))) (file-name-concat syd-cache-dir "ielm-history.eld"))))
:config
(defun syd/open-emacs-lisp-repl ()
(interactive)
(pop-to-buffer
(or (get-buffer "*ielm*")
(progn (ielm) ; Creates the *ielm* buffer.
(let ((b (get-buffer "*ielm*")))
;; We leave it to the enclosing `pop-to-buffer' to display the
;; buffer.
(bury-buffer b)
b)))))
(add-to-list '+syd-major-mode-repl-alist (defun syd/open-emacs-lisp-repl ()
'(emacs-lisp-mode syd/open-emacs-lisp-repl)) (interactive)
(pop-to-buffer
(or (get-buffer "*ielm*")
(progn (ielm) ; Creates the *ielm* buffer.
(let ((b (get-buffer "*ielm*")))
;; We leave it to the enclosing `pop-to-buffer' to display the
;; buffer.
(bury-buffer b)
b)))))
(pp +popup-defaults)) (add-to-list '+syd-major-mode-repl-alist
'(emacs-lisp-mode syd/open-emacs-lisp-repl))
(provide 'syd-lang-emacs-lisp) (provide 'syd-lang-emacs-lisp)

3
users/crumb/programs/emacs/modules/syd-popup/README.org
View File

@@ -1,3 +0,0 @@
#+title: Popups
This directory is almost entirely poached from Doom Emacs. Taming various ill-behaved packages is not something I want to hack myself.

187
users/crumb/programs/emacs/modules/syd-popup/syd-popup-config.el
View File

@@ -1,187 +0,0 @@
;;; syd-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 '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)
buffer-list-update-hook
+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
(defvar syd-popup-use-aggressive-defaults nil)
(defvar syd-popup-use-defaults t)
(set-popup-rules!
(when syd-popup-use-aggressive-defaults
'(("^\\*" :slot 1 :vslot -1 :select t)
("^ \\*" :slot 1 :vslot -1 :size +popup-shrink-to-fit)))
(when syd-popup-use-defaults
'(("^\\*Completions" :ignore t)
("^\\*Local variables\\*$"
:vslot -1 :slot 1 :size +popup-shrink-to-fit)
("^\\*\\(?:[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\\|e?shell\\)-popup" ; editing buffers (interaction required)
:vslot -5 :size 0.35 :select t :modeline nil :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 :size 0.5 :select t :quit nil)
("^ \\*undo-tree\\*"
:slot 2 :side left :size 20 :select t :quit t)
;; `help-mode', `helpful-mode'
("^\\*\\([Hh]elp\\|Apropos\\)"
:slot 2 :vslot -8 :size 0.42 :select t)
("^\\*eww\\*" ; `eww' (and used by dash docsets)
:vslot -11 :size 0.35 :select t)
("^\\*xwidget"
:vslot -11 :size 0.35 :select nil)
("^\\*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)
("^\\*Process List\\*" :side bottom :vslot 101 :size 0.25 :select t :quit t)
("^\\*\\(?:Proced\\|timer-list\\|Abbrevs\\|Output\\|Occur\\|unsent mail.*?\\|message\\)\\*" :ignore t)))
(add-hook 'on-init-ui-hook #'+popup-mode 'append)
(dolist (hook-fn (list #'+popup-adjust-fringes-h
#'+popup-adjust-margins-h
#'+popup-set-modeline-on-enable-h
#'+popup-unset-modeline-on-disable-h))
(add-hook '+popup-buffer-mode-hook hook-fn))
;;
;;; Hacks
(require 'syd-popup-hacks)
(provide 'syd-popup-config)