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
(add-to-list 'load-path (file-name-concat user-emacs-directory "modules" "syd-popup")))
(use-package syd-popup
(use-package doom-popup
;; :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
;; (: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)

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!
(lambda (bufname _)
(when (boundp '+eval-repl-mode)
(buffer-local-value '+eval-repl-mode (get-buffer bufname))))
(when (boundp 'syd-repl-mode)
(buffer-local-value 'syd-repl-mode (get-buffer bufname))))
:ttl (lambda (buf)
(unless (plist-get +eval-repl-plist :persist)
(when-let (process (get-buffer-process buf))
(set-process-query-on-exit-flag process nil)
(kill-process process)
(kill-buffer buf))))
:size 0.25 :quit nil)
:size 0.25
:quit nil)
(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; -*-
;; 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
;; plugins to cooperate with the popup management system. Essentially, it comes
;; down to:
@@ -26,7 +49,7 @@
;;
;;; 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.
To reduce fewer edge cases and improve performance when `display-buffer-alist'
@@ -35,12 +58,12 @@ grows larger."
(apply fn args)))
(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
(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
buffer that shouldn't be in a popup. We prevent that by remapping `quit-window'
to this commmand."
@@ -48,9 +71,9 @@ to this commmand."
(let ((orig-buffer (current-buffer)))
(quit-window arg)
(when (and (eq orig-buffer (current-buffer))
(+popup-buffer-p))
(+popup/close nil 'force))))
(define-key +popup-buffer-mode-map [remap quit-window] #'+popup/quit-window)
(doom-popup-buffer-p))
(doom-popup/close nil 'force))))
(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
(defun +popup--dont-select-me-a (fn &rest args)
(let ((+popup--inhibit-select t))
(defun doom-popup--dont-select-me-a (fn &rest args)
(let ((doom-popup--inhibit-select t))
(apply fn args)))
(advice-add #'company-show-doc-buffer
:around #'+popup--dont-select-me-a))
:around #'doom-popup--dont-select-me-a))
;;;###package 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)))
(ignore pop-to-buffer)
(cl-letf (((symbol-function #'pop-to-buffer)
(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)))))
(apply fn args))))
(advice-add #'compilation-goto-locus
:around #'+popup--compilation-goto-locus-a))
:around #'doom-popup--compilation-goto-locus-a))
;;;###package eshell
@@ -90,19 +113,19 @@ to this commmand."
;; When eshell runs a visual command (see `eshell-visual-commands'), it spawns
;; a term buffer to run it in, but where it spawns it is the problem...
(defun +popup--eshell-undedicate-popup (&rest _)
(defun doom-popup--eshell-undedicate-popup (&rest _)
"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)
(add-transient-hook! (function eshell-query-kill-processes)
:after (set-window-dedicated-p nil t))))
(advice-add #'eshell-exec-visual
:around #'+popup--eshell-undedicate-popup))
:around #'doom-popup--eshell-undedicate-popup))
;;;###package 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
the command buffer."
(interactive)
@@ -120,17 +143,17 @@ the command buffer."
(setq evil-command-window-current-buffer nil)))
(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
(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))
(advice-add #'+evil--window-swap :around #'doom-popup-save-a)
(advice-add #'evil-window-move-very-bottom :around #'doom-popup-save-a)
(advice-add #'evil-window-move-very-top :around #'doom-popup-save-a)
(advice-add #'evil-window-move-far-left :around #'doom-popup-save-a)
(advice-add #'evil-window-move-far-right :around #'doom-popup-save-a))
(with-eval-after-load 'help-mode
(defun +popup--switch-from-popup (location)
(defun doom-popup--switch-from-popup (location)
(let (origin enable-local-variables)
(save-popups!
(switch-to-buffer (car location) nil t)
@@ -152,7 +175,7 @@ the command buffer."
(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))))
(doom-popup--switch-from-popup (find-function-search-for-symbol fun nil file))))
(define-button-type 'help-variable-def
:supertype 'help-xref
@@ -160,19 +183,19 @@ the command buffer."
(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))))
(doom-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)))))
(doom-popup--switch-from-popup (find-function-search-for-symbol fun 'defface file)))))
;;;###package 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."
:override #'helpful--navigate
(let ((path (substring-no-properties (button-get button 'path)))
@@ -191,10 +214,10 @@ the command buffer."
;;;###package helm
;;;###package helm-ag
(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
(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
(letf! ((defun org-completing-read (&rest args)
(when-let (win (get-buffer-window "*Org Links*"))
@@ -211,7 +234,7 @@ the command buffer."
(apply #'funcall-interactively 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)
(defadvice! doom-popup--helm-elisp--persistent-help-a (candidate _fun &optional _name)
:before #'helm-elisp--persistent-help
(let (win)
(and (helm-attr 'help-running-p)
@@ -222,23 +245,23 @@ the command buffer."
;;;###package 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
(when-let (win (get-buffer-window "*info*"))
(when (+popup-window-p win)
(when (doom-popup-window-p win)
(select-window win)))))
;;;###package 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
(letf! ((#'switch-to-buffer-other-window #'pop-to-buffer))
(apply fn args))))
(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
kills all other windows just so it can monopolize the frame. No thanks. We can
do better."
@@ -249,36 +272,36 @@ do better."
:around #'org-goto-location
:around #'org-fast-tag-selection
:around #'org-fast-todo-selection
(if +popup-mode
(if doom-popup-mode
(letf! ((#'delete-other-windows #'ignore)
(#'delete-window #'ignore))
(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,
for some reason, which is very unconventional, and so requires these gymnastics
to tame (i.e. to get the popup manager to handle it)."
:around #'org-goto-location
(if +popup-mode
(if doom-popup-mode
(letf! (defun internal-temp-output-buffer-show (buffer)
(let ((temp-buffer-show-function
(lambda (&rest args)
(apply #'+popup-display-buffer-stacked-side-window-fn
(apply #'doom-popup-display-buffer-stacked-side-window-fn
nil args))))
(with-current-buffer buffer
(+popup-buffer-mode +1))
(doom-popup-buffer-mode +1))
(funcall internal-temp-output-buffer-show buffer)))
(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
content and displays it in a side window without deleting all other windows.
Ugh, such an ugly hack."
:around #'org-fast-tag-selection
:around #'org-fast-todo-selection
(if +popup-mode
(if doom-popup-mode
(letf! ((defun read-char-exclusive (&rest args)
(message nil)
(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)
(when-let (buf (window-buffer window))
(with-current-buffer buf
(+popup-buffer-mode)))
(doom-popup-buffer-mode)))
(when (> (window-buffer-height window)
(window-height window))
(fit-window-to-buffer window (window-buffer-height window)))))
(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..."
:around #'org-edit-src-exit
(let* ((window (selected-window))
(popup-p (+popup-window-p window)))
(popup-p (doom-popup-window-p window)))
(prog1 (apply fn args)
(when (and popup-p (window-live-p window))
(delete-window window))))))
;;;###package 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
(letf! ((#'switch-to-buffer #'pop-to-buffer))
(apply fn args))))
@@ -313,23 +336,23 @@ Ugh, such an ugly hack."
;;;###package 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."
:after #'persp-load-state-from-file
(dolist (window (window-list))
(when (+popup-parameter 'popup window)
(+popup--init window nil)))))
(when (doom-popup-parameter 'popup window)
(doom-popup--init window nil)))))
(with-eval-after-load 'pdf-tools
(setq tablist-context-window-display-action
'((+popup-display-buffer-stacked-side-window-fn)
'((doom-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)
'((doom-popup-display-buffer-stacked-side-window-fn)
(side . left)
(slot . 3)
(inhibit-same-window . t))))
@@ -337,7 +360,7 @@ Ugh, such an ugly hack."
;;;###package 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
(letf! ((#'find-function #'find-function-other-window))
(funcall fn function))))
@@ -345,7 +368,7 @@ Ugh, such an ugly hack."
;;;###package 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"
:around #'undo-tree-visualize
(if undo-tree-visualizer-diff
@@ -356,14 +379,14 @@ Ugh, such an ugly hack."
;;;###package wdired
(with-eval-after-load 'wdired
;; close the popup after you're done with a wdired buffer
(advice-add #'wdired-abort-changes :after #'+popup-close-a)
(advice-add #'wdired-finish-edit :after #'+popup-close-a))
(advice-add #'wdired-abort-changes :after #'doom-popup-close-a)
(advice-add #'wdired-finish-edit :after #'doom-popup-close-a))
;;;###package wgrep
(with-eval-after-load 'wgrep
;; 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))
(advice-add #'wgrep-abort-changes :after #'doom-popup-close-a)
(advice-add #'wgrep-finish-edit :after #'doom-popup-close-a))
(with-eval-after-load 'which-key
@@ -375,7 +398,7 @@ Ugh, such an ugly hack."
which-key-custom-show-popup-function
(lambda (act-popup-dim)
(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)))
;; HACK Fix #2219 where the which-key popup would get cut off.
(setcar act-popup-dim (1+ (car act-popup-dim)))
@@ -385,7 +408,7 @@ Ugh, such an ugly hack."
;;;###package windmove
;; Users should be able to hop into popups easily, but Elisp shouldn't.
(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."
(cl-letf ((windmove-find-other-window
(symbol-function #'windmove-find-other-window)))
@@ -397,7 +420,7 @@ Ugh, such an ugly hack."
(`down 'below)
(_ dir))
window
(bound-and-true-p +popup-mode)
(bound-and-true-p doom-popup-mode)
arg
windmove-wrap-around
t))))
@@ -406,6 +429,6 @@ Ugh, such an ugly hack."
(dolist (target (list #'windmove-up #'windmove-down
#'windmove-left #'windmove-right))
(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; -*-
;;;###autoload
(defvar +popup--display-buffer-alist nil)
;; 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.
;;;###autoload
(defvar +popup-defaults
(defvar doom-popup--display-buffer-alist nil)
;;;###autoload
(defvar doom-popup-defaults
(list :side 'bottom
:height 0.16
:width 40
@@ -14,10 +37,10 @@
"Default properties for popup rules defined with `set-popup-rule!'.")
;;;###autoload
(defun +popup-make-rule (predicate plist)
(defun doom-popup-make-rule (predicate plist)
(if (plist-get plist :ignore)
(list predicate nil)
(let* ((plist (append plist +popup-defaults))
(let* ((plist (append plist doom-popup-defaults))
(alist
`((actions . ,(plist-get plist :actions))
(side . ,(plist-get plist :side))
@@ -33,7 +56,7 @@
(modeline . ,(plist-get plist :modeline))
(autosave . ,(plist-get plist :autosave))
,@(plist-get plist :parameters))))
`(,predicate (+popup-buffer)
`(,predicate (doom-popup-buffer)
,@alist
(window-parameters ,@params)))))
@@ -62,12 +85,12 @@ PLIST can be made up of any of the following properties:
: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.
it accepts. If omitted, `doom-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'.
`doom-popup-display-buffer-stacked-side-window-fn' or `display-buffer-in-side-window'
is in :actions or `doom-popup-default-display-buffer-actions'.
:size/:width/:height FLOAT|INT|FN
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
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'.
wants with it, typically resize it, like `doom-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
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
negative.
@@ -108,7 +131,7 @@ PLIST can be made up of any of the following properties:
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
If t, resort to the default :ttl in `doom-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.
@@ -157,16 +180,16 @@ PLIST can be made up of any of the following properties:
: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
If any of these are omitted, defaults derived from `doom-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)
(push (doom-popup-make-rule predicate plist) doom-popup--display-buffer-alist)
;; TODO: Don't overwrite user entries in `display-buffer-alist'
(when (bound-and-true-p +popup-mode)
(setq display-buffer-alist +popup--display-buffer-alist))
+popup--display-buffer-alist)
(when (bound-and-true-p doom-popup-mode)
(setq display-buffer-alist doom-popup--display-buffer-alist))
doom-popup--display-buffer-alist)
;;;###autodef
(defun set-popup-rules! (&rest rulesets)
@@ -179,17 +202,17 @@ and plist.
Example:
(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))
'((\"^\\*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)
(push (doom-popup-make-rule (car rule) (cdr rule))
doom-popup--display-buffer-alist)))
(when (bound-and-true-p doom-popup-mode)
(setq display-buffer-alist doom-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."
(cl-assert (cl-every #'windowp windows) t)
(setq +popup--last
(setq doom-popup--last
(cl-loop for w in windows
collect (cons (window-buffer 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.
the buffer is visible, then set another timer and try again later."
(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))
(with-demoted-errors "Error killing transient buffer: %s"
(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)
(when-let (process (get-buffer-process buffer))
(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))
(kill-buffer buffer)))))))
((let ((ttl (if (= ttl 0)
(or (plist-get +popup-defaults :ttl) 3)
(or (plist-get doom-popup-defaults :ttl) 3)
ttl)))
(with-current-buffer buffer
(setq +popup--timer
(run-at-time ttl nil #'+popup--kill-buffer buffer ttl))))))))
(setq doom-popup--timer
(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.
+ 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.
+ 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!"
(let ((buffer (window-buffer window))
(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))
(buffer-file-name base-buffer)))
(buffer-modified-p buffer)
(let ((autosave (+popup-parameter 'autosave window)))
(let ((autosave (doom-popup-parameter 'autosave window)))
(cond ((eq autosave 't))
((null autosave)
(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)
(with-current-buffer buffer
(set-buffer-modified-p nil)
(+popup-buffer-mode -1)
(unless +popup--inhibit-transient
(let ((ttl (+popup-parameter 'ttl window)))
(doom-popup-buffer-mode -1)
(unless doom-popup--inhibit-transient
(let ((ttl (doom-popup-parameter 'ttl window)))
(when (eq ttl 't)
(setq ttl (plist-get +popup-defaults :ttl)))
(setq ttl (plist-get doom-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
(doom-popup--kill-buffer buffer 0))
((add-hook 'kill-buffer-hook
#'doom-popup-kill-buffer-hook-h
nil
t)
(setq doom-popup--timer
(run-at-time ttl nil #'doom-popup--kill-buffer
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."
(when-let (window (ignore-errors (+popup/raise window)))
(when-let (window (ignore-errors (doom-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."
(defun doom-popup--normalize-alist (alist)
"Merge `doom-popup-default-alist' and `doom-popup-default-parameters' with ALIST."
(when alist
(let ((alist ; handle defaults
(cl-remove-duplicates
(append alist +popup-default-alist)
(append alist doom-popup-default-alist)
:key #'car-safe :from-end t))
(parameters
(cl-remove-duplicates
(append (cdr (assq 'window-parameters alist))
+popup-default-parameters)
doom-popup-default-parameters)
:key #'car-safe :from-end t)))
;; handle `size'
(when-let* ((size (cdr (assq 'size alist)))
@@ -127,64 +164,67 @@ the buffer is visible, then set another timer and try again later."
height))
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."
(unless +popup--internal
(unless doom-popup--internal
(cl-loop for win
in (cons (or window (selected-window))
(window-list nil 0 window))
unless (+popup-window-p win)
unless (doom-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
(defun doom-popup--maybe-select-window (window origin)
"Select a window based on `doom-popup--inhibit-select' and this window's `select'
parameter."
(unless doom-popup--inhibit-select
;; REVIEW: Once our minimum version is bumped up to Emacs 30.x, replace this
;; with `post-command-select-window' window parameter.
(let ((select (+popup-parameter 'select window)))
(let ((select (doom-popup-parameter 'select window)))
(if (functionp select)
(funcall select window origin)
(select-window (if select window origin))))))
;;;###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
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
(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-parameter window 'split-window #'doom-popup--split-window)
(set-window-parameter window 'delete-window #'doom-popup--delete-window)
(set-window-parameter window
'delete-other-windows
#'doom-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)))
(doom-popup-buffer-mode +1)
(run-hooks 'doom-popup-create-window-hook)))
;;
;; Public library
;;;###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."
(when +popup-mode
(when doom-popup-mode
(let ((buffer (or buffer (current-buffer))))
(and (bufferp buffer)
(buffer-live-p buffer)
(buffer-local-value '+popup-buffer-mode buffer)
(buffer-local-value 'doom-popup-buffer-mode buffer)
buffer))))
;;;###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."
(when +popup-mode
(when doom-popup-mode
(let ((window (or window (selected-window))))
(and (windowp window)
(window-live-p window)
@@ -192,47 +232,47 @@ and enables `+popup-buffer-mode'."
window))))
;;;###autoload
(defun +popup-buffer (buffer &optional alist)
(defun doom-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))
(alist (doom-popup--normalize-alist 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))
(alist (remove (assq 'window-height alist) alist))
(window (display-buffer-reuse-window buffer alist)))
(when window
(+popup--maybe-select-window window origin)
(doom-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)
(doom-popup--init popup alist)
(doom-popup--maybe-select-window popup origin)
popup))))
;;;###autoload
(defun +popup-parameter (parameter &optional window)
(defun doom-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)
(defun doom-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)))
(let ((val (doom-popup-parameter parameter window)))
(if (functionp val)
(apply val args)
val)))
;;;###autoload
(defun +popup-windows ()
(defun doom-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
(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.
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)))
;;;###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."
(let* ((params (alist-get 'parameters state)))
`((side . ,(alist-get 'window-side params))
@@ -255,25 +295,25 @@ Uses `shrink-window-if-larger-than-buffer'."
;; Hooks
;;;###autoload
(defun +popup-adjust-fringes-h ()
"Hides the fringe in popup windows, restoring them if `+popup-buffer-mode' is
(defun doom-popup-adjust-fringes-h ()
"Hides the fringe in popup windows, restoring them if `doom-popup-buffer-mode' is
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)))
;;;###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
(defun doom-popup-adjust-margins-h ()
"Creates padding for the popup window determined by `doom-popup-margin-width',
restoring it if `doom-popup-buffer-mode' is disabled."
(when doom-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)))
(let ((m (if (bound-and-true-p doom-popup-buffer-mode) doom-popup-margin-width)))
(set-window-margins nil m m)))))
(defvar hide-mode-line-format)
;;;###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.
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
`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))
(let ((modeline (+popup-parameter 'modeline)))
(let ((modeline (doom-popup-parameter 'modeline)))
(cond ((eq modeline 't))
((null modeline)
;; 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)
modeline)))
(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
(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))
(defun doom-popup-unset-modeline-on-disable-h ()
"Restore the modeline when `doom-popup-buffer-mode' is deactivated."
(when (and (not (bound-and-true-p doom-popup-buffer-mode))
(bound-and-true-p hide-mode-line-mode)
(not (bound-and-true-p global-hide-mode-line-mode)))
(hide-mode-line-mode -1)))
;;;###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
`+popup/close'). If called outside, try to close all popup windows (see
`+popup/close-all')."
(if (+popup-window-p)
(+popup/close)
(+popup/close-all)))
`doom-popup/close'). If called outside, try to close all popup windows (see
`doom-popup/close-all')."
(if (doom-popup-window-p)
(doom-popup/close)
(doom-popup/close-all)))
;;;###autoload
(defun +popup-cleanup-rules-h ()
(defun doom-popup-cleanup-rules-h ()
"Cleans up any duplicate popup rules."
(interactive)
(setq +popup--display-buffer-alist
(cl-delete-duplicates +popup--display-buffer-alist
(setq doom-popup--display-buffer-alist
(cl-delete-duplicates doom-popup--display-buffer-alist
:key #'car :test #'equal :from-end t))
(when +popup-mode
(setq display-buffer-alist +popup--display-buffer-alist)))
(when doom-popup-mode
(setq display-buffer-alist doom-popup--display-buffer-alist)))
;;;###autoload
(defun +popup-kill-buffer-hook-h ()
(defun doom-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)))))
(when (doom-popup-window-p window)
(let ((doom-popup--inhibit-transient t))
(doom-popup--delete-window window)))))
;;
;; Commands
;;;###autoload
(defalias 'other-popup #'+popup/other)
(defalias 'other-popup #'doom-popup/other)
;;;###autoload
(defun +popup/buffer ()
(defun doom-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)
(let ((doom-popup-default-display-buffer-actions
'(doom-popup-display-buffer-stacked-side-window-fn))
(display-buffer-alist doom-popup--display-buffer-alist)
(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)
(pop-to-buffer buffer)))
;;;###autoload
(defun +popup/other ()
(defun doom-popup/other ()
"Cycle through popup windows, like `other-window'. Ignores regular windows."
(interactive)
(if-let (popups (cl-remove-if-not
(lambda (w) (or (+popup-window-p w)
;; This command should be able to hop between
;; windows with a `no-other-window'
;; parameter, since `other-window' won't.
(window-parameter w 'no-other-window)))
(lambda (w) (or (doom-popup-window-p w)
;; This command should be able to hop between
;; windows with a `no-other-window'
;; parameter, since `other-window' won't.
(window-parameter w 'no-other-window)))
(window-list)))
(select-window (if (or (+popup-window-p)
(select-window (if (or (doom-popup-window-p)
(window-parameter nil 'no-other-window))
(let ((window (selected-window)))
(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")))
;;;###autoload
(defun +popup/close (&optional window force-p)
(defun doom-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
@@ -381,69 +421,69 @@ This will do nothing if the popup's `quit' window parameter is either nil or
(list (selected-window)
current-prefix-arg))
(let ((window (or window (selected-window))))
(when (and (+popup-window-p window)
(when (and (doom-popup-window-p window)
(or force-p
(memq (+popup-parameter-fn 'quit window window)
(memq (doom-popup-parameter-fn 'quit window window)
'(t current))))
(when +popup--remember-last
(+popup--remember (list window)))
(when doom-popup--remember-last
(doom-popup--remember (list window)))
(delete-window window)
t)))
;;;###autoload
(defun +popup/close-all (&optional force-p)
(defun doom-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))
(let (targets doom-popup--remember-last)
(dolist (window (doom-popup-windows))
(when (or force-p
(memq (+popup-parameter-fn 'quit window window)
(memq (doom-popup-parameter-fn 'quit window window)
'(t other)))
(push window targets)))
(when targets
(+popup--remember targets)
(doom-popup--remember targets)
(mapc #'delete-window targets)
t)))
;;;###autoload
(defun +popup/toggle ()
(defun doom-popup/toggle ()
"Toggle any visible popups.
If no popups are available, display the *Messages* buffer in a popup window."
(interactive)
(let ((+popup--inhibit-transient t))
(cond ((+popup-windows) (+popup/close-all t))
((ignore-errors (+popup/restore)))
(let ((doom-popup--inhibit-transient t))
(cond ((doom-popup-windows) (doom-popup/close-all t))
((ignore-errors (doom-popup/restore)))
((display-buffer (get-buffer "*Messages*"))))))
;;;###autoload
(defun +popup/restore ()
(defun doom-popup/restore ()
"Restore the last popups that were closed, if any."
(interactive)
(unless +popup--last
(unless doom-popup--last
(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)
do (+popup-buffer buffer (+popup-alist-from-window-state state)))
(setq +popup--last nil)
do (doom-popup-buffer buffer (doom-popup-alist-from-window-state state)))
(setq doom-popup--last nil)
t)
;;;###autoload
(defun +popup/raise (window &optional arg)
(defun doom-popup/raise (window &optional arg)
"Raise the current popup window into a regular window and
return it. If prefix ARG, raise the current popup into a new
window and return that window."
(interactive
(list (selected-window) current-prefix-arg))
(cl-check-type window window)
(unless (+popup-window-p window)
(unless (doom-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)
(doom-popup--inhibit-transient t)
doom-popup--remember-last)
(doom-popup/close window 'force)
(let (display-buffer-alist)
(if arg
(pop-to-buffer buffer)
@@ -451,7 +491,7 @@ window and return that window."
(selected-window)))
;;;###autoload
(defun +popup/diagnose ()
(defun doom-popup/diagnose ()
"Reveal what popup rule will be used for the current buffer."
(interactive)
(if-let (rule (cl-loop with bname = (buffer-name)
@@ -467,18 +507,18 @@ window and return that window."
;; Advice
;;;###autoload
(defun +popup-close-a (&rest _)
(defun doom-popup-close-a (&rest _)
"TODO"
(+popup/close nil t))
(doom-popup/close nil t))
;;;###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
prevent the popup(s) from messing up the UI (or vice versa)."
(save-popups! (apply fn args)))
;;;###autoload
(defun +popup-display-buffer-fullframe-fn (buffer alist)
(defun doom-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)
@@ -491,7 +531,7 @@ prevent the popup(s) from messing up the UI (or vice versa)."
window)))
;;;###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
`display-buffer-in-side-window', but allows for stacking popups with the `vslot'
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))
(vslot (or (cdr (assq 'vslot alist)) 0))
(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)))
(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)))
(let* ((live (get-window-with-predicate
(lambda (window)
(and (eq (window-parameter window 'window-side) side)
(eq (window-parameter window 'window-vslot) vslot)))
nil))
(lambda (window)
(and (eq (window-parameter window 'window-side) side)
(eq (window-parameter window 'window-vslot) vslot)))
nil))
;; As opposed to the `window-side' property, our `window-vslot'
;; parameter is set only on a single live window and never on internal
;; windows. Moreover, as opposed to `window-with-parameter' (as used
;; by the original `display-buffer-in-side-window'),
;; parameter is set only on a single live window and never on
;; internal windows. Moreover, as opposed to `window-with-parameter'
;; (as used by the original `display-buffer-in-side-window'),
;; `get-window-with-predicate' only returns live windows anyway. In
;; 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
@@ -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))
nil)
((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)))))
(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)
(add-to-list 'window-persistent-parameters '(window-vslot . writable))
(add-to-list 'window-persistent-parameters
'(window-vslot . writable))
window)))
(t
;; 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
;; Make new window before `next-window'.
(let ((next-side (if left-or-right 'above 'left))
(+popup--internal t)
(doom-popup--internal t)
(window-combination-resize 'side))
(setq window
(ignore-errors (split-window next-window nil next-side)))))
(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)
(let ((prev-side (if left-or-right
'below
'right))
(doom-popup--internal t)
(window-combination-resize 'side))
(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-vslot vslot)
(with-current-buffer buffer
@@ -640,6 +692,6 @@ Accepts the same arguments as `display-buffer-in-side-window'. You must set
(window--display-buffer
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)
(use-package ielm
:commands ielm
:hook (emacs-lisp-mode)
:custom ((ielm-history-file-name ; Stay out of my config dir!
(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)))))
(file-name-concat syd-cache-dir "ielm-history.eld"))))
(add-to-list '+syd-major-mode-repl-alist
'(emacs-lisp-mode syd/open-emacs-lisp-repl))
(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)))))
(pp +popup-defaults))
(add-to-list '+syd-major-mode-repl-alist
'(emacs-lisp-mode syd/open-emacs-lisp-repl))
(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)