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

feat: REPLs, by major mode, by project

Browse Source 
Also includes Doom's popup code. }:)
This commit is contained in:
Madeleine Sydney
2025-01-27 03:21:52 -07:00
parent 2e11e3838a
commit 9bb1534b68
14 changed files with 1683 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
README.org
View File

@@ -141,7 +141,9 @@ As with the rest of the config, these are largely adapted from Doom's ([cite:@li
- ~syd/«NAME»~ :: Commands intended for interactive use.
- ~+syd-[-]«NAME»~ :: Indicates a [[https://en.wikipedia.org/wiki/Strategy_pattern][strategy]] function.
- ~+syd-[-]«NAME»~ (f) :: Indicates a [[https://en.wikipedia.org/wiki/Strategy_pattern][strategy]] function.
- ~+syd-[-]«NAME»~ (v) :: Indicates a variable holding various stategies available to a specific strategy function.
- ~syd-«NAME»-initialise~, where ~modules/«NAME» ∈ modules/*.el~ :: Instead of using top-level side-effects, (bar e.g. ~use-package~ invocations) should be wrapped in this kind of initialisation procedure.
@@ -532,3 +534,5 @@ Following is a subset of the many places I've learnt from.
- [[https://github.com/doomemacs/doomemacs][Doom Emacs]]
- [[https://cce.whatthefuck.computer/cce][Ryan Rix's Complete Computing Environment]]
- [cite:@wünsch2024setting]
- [[https://github.com/neeasade/emacs.d][neeasade/emacs.d]] — Has an interesting 'module' system.
- [[https://github.com/oantolin/emacs-config][oantolin/emacs-config]] — Has some internal packages.

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

@@ -13,6 +13,17 @@
;; Must come before the rest!
(require 'syd-use-package)
(eval-when-compile
(add-to-list 'load-path (file-name-concat user-emacs-directory "modules" "syd-popup")))
(use-package syd-popup
;; :defer t
:load-path "/persist/dots/users/crumb/programs/emacs/modules/syd-popup"
:straight nil
;; :straight
;; (:type nil
;; :local-repo "/persist/dots/users/crumb/programs/emacs/modules/syd-popup")
)
(require 'syd-age)
(require 'syd-autosave)
(require 'syd-completion)
@@ -20,6 +31,7 @@
(require 'syd-display-startup-time)
(require 'syd-evil)
(require 'syd-keybinds)
(require 'syd-lang)
(require 'syd-org)
(require 'syd-projects)
(require 'syd-scratch)

168
users/crumb/programs/emacs/lib/syd-handle-repl.el Normal file
View File

@@ -0,0 +1,168 @@
;;; syd-handle-repl.el -*- lexical-binding: t; -*-
(eval-when-compile (require 'cl-lib))
(require 'syd-prelude)
(require 'syd-project)
(defvar +syd-major-mode-repl-alist '()
"TODO: An alist pairing major-modes (symbols) with plists describing REPLs.")
(defvar +syd-repl-buffers (make-hash-table :test 'equal)
"A hashmap mapping pairs (MAJOR-MODE . PROJECT-ROOT) to their corresponding
buffers. Indeed, this implies a single REPL per language per project. Is this
limitation worth overcoming? I'm not sure! I've yet to butt heads with it.")
(define-minor-mode syd-repl-mode
"A minor mode for repl buffers. One use is to universally customise the
display of all repl buffers.")
(defun syd--repl-from-major-mode ()
"TODO:"
(pcase-let ((`(_ ,fn . ,plist) (assq major-mode +syd-major-mode-repl-alist)))
(list fn plist)))
(defun syd--clean-repl-buffers ()
"Remove any key/value pairs from `+syd-repl-buffers' whose values involve a
not-alive buffer."
(maphash (lambda (repl-key buffer)
(unless (buffer-live-p buffer)
(remhash repl-key +syd-repl-buffers)))
+syd-repl-buffers))
(defun syd--call-repl-handler (repl-handler)
"Call REPL-HANDLER, and error out if it does not return a buffer.
REPL-HANDLER will be called interactively if supported."
(let ((repl-buffer (save-window-excursion
(if (commandp repl-handler)
(call-interactively repl-handler)
(funcall repl-handler)))))
(cond ((null repl-buffer)
(error "REPL handler %S couldn't open the REPL buffer" repl-handler))
((not (bufferp repl-buffer))
(error "REPL handler %S failed to return a buffer" repl-handler))
(t repl-buffer))))
(defun syd--goto-end-of-repl ()
"Move point to the last comint prompt or the end of the buffer."
(unless (or (derived-mode-p 'term-mode)
(eq (current-local-map) (bound-and-true-p term-raw-map)))
(goto-char (if (and (derived-mode-p 'comint-mode)
(cdr comint-last-prompt))
(cdr comint-last-prompt)
(point-max)))))
(cl-defun syd--ensure-in-repl-buffer
(&key repl-handler plist (display-fn #'get-buffer-create))
"TODO: Display the repl buffer associated with the current major mode and
project. A repl buffer will be created (using REPL-HANDLER) if necessary.
If an active repl buffer is found in `+syd-repl-buffers', it will be displayed
by the given DISPLAY-FN.
PLIST is a plist of repl-specific options."
(syd--clean-repl-buffers)
(let* ((root (syd-project-root))
(repl-key (cons major-mode root))
(maybe-repl-buffer (gethash repl-key +syd-repl-buffers)))
(cl-check-type maybe-repl-buffer (or buffer null))
(unless (or (eq maybe-repl-buffer (current-buffer))
(null repl-handler))
(let* ((repl-buffer (if (buffer-live-p maybe-repl-buffer)
maybe-repl-buffer
(syd--call-repl-handler repl-handler)))
(displayed-repl-buffer (funcall display-fn repl-buffer)))
;; Repl buffers are to be saved in `+syd-repl-buffers'; we've just
;; opened one, so do so!
(puthash repl-key repl-buffer +syd-repl-buffers)
;; If it isn't a buffer, we return nil.
(when (bufferp repl-buffer)
(with-current-buffer repl-buffer
(syd-repl-mode 1)
(syd--goto-end-of-repl))
repl-buffer)))))
(defun syd--known-repls ()
"Return a list of all known mode-repl pairs, each as a two-element list.
More precisely, the return value is a list of mode-repl pairs, where each
mode-repl pair is a two-element list (MAJOR-MODE HANDLER) where MAJOR-MODE is a
symbol, and HANDLER is a (possibly interactive) procedure.
See also: `+syd-major-mode-repl-alist'."
(mapcar (lambda (xs) (list (car xs) (cadr xs)))
+syd-major-mode-repl-alist))
(defun syd--pretty-mode-name (mode)
"Convert MODE (a symbol or string) into a string appropriate for human
presentation."
(let ((mode* (if (symbolp mode) (symbol-name mode) mode)))
(if (not (string-match "^\\([a-z-]+\\)-mode$" mode*))
(error "Given string/symbol is not a major mode: %s" mode*)
(string-join (split-string
(capitalize (match-string-no-properties 1 mode*))
"-")
" "))))
(defun syd-prompt-for-repl ()
"Prompt the user for a repl to open. Returns the chosen repl-handler
function."
;; REVIEW: Doom scans all interned symbols for anything that looks like
;; "open-XXXX-repl." Is this worth doing?
(let* ((repls (mapcar (lambda (xs)
(pcase-let ((`(,mode ,fn) xs))
(list (syd--pretty-mode-name mode) fn)))
(syd--known-repls)))
(choice (or (completing-read "Open a REPL for: "
(mapcar #'car repls))
(user-error "Aborting"))))
(cadr (assoc choice repls))))
(cl-defun +syd-open-repl (&key prompt-p display-fn)
"TODO: Open a repl via DISPLAY-FN. When PROMPT-P, the user will be
unconditionally prompted for a repl choice.
If Evil-mode is active, insert state will be enabled."
(pcase-let* ((`(,major-mode-fn ,plist) (syd--repl-from-major-mode))
(repl-handler (if (or prompt-p (not major-mode-fn))
(syd-prompt-for-repl)
major-mode-fn))
(region (when (use-region-p)
(buffer-substring-no-properties (region-beginning)
(region-end)))))
(unless (commandp repl-handler)
(error "Couldn't find a REPL for %s" major-mode))
(with-current-buffer (syd--ensure-in-repl-buffer :repl-handler repl-handler
:plist plist
:display-fn display-fn)
;; Start the user in insert mode at the end of the input line.
(when (bound-and-true-p evil-mode)
(call-interactively #'evil-append-line))
(when region
(insert region))
t)))
;;;###autoload
(defun +syd/open-repl-other-window (prompt-p)
"Like `+syd-open-repl', but opens in a different window. The repl
corresponding to the current major mode and project will be opened, unless a
prefix argument is given, in which case the user will be prompted for a repl."
(interactive "P")
(+syd-open-repl :prompt-p prompt-p
:display-fn #'pop-to-buffer))
(set-popup-rule!
(lambda (bufname _)
(when (boundp '+eval-repl-mode)
(buffer-local-value '+eval-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)
(provide 'syd-handle-repl)

2
users/crumb/programs/emacs/lib/syd-prelude.el
View File

@@ -7,7 +7,7 @@
(cl-defmacro syd-define-stub
(name &key (desc "implement me!") interactive)
(let ((todo (format "%s: TODO: %s" name desc)))
`(defun ,name (&rest args)
`(defun ,name (&rest _)
,@(if interactive (list '(interactive)) nil)
,todo
(error ,todo))))

12
users/crumb/programs/emacs/lib/syd-project.el Normal file
View File

@@ -0,0 +1,12 @@
;;; syd-project.el -*- lexical-binding: t; -*-
(eval-when-compile (require 'cl-lib))
(require 'project)
(cl-defun syd-project-root (&key (dir default-directory))
"Return the project root of DIR, or nil if DIR belongs to no project."
(when-let* ((project (project-current nil dir)))
(project-root project)))
(provide 'syd-project)
;;; syd-project.el ends here

26
users/crumb/programs/emacs/modules/lang/syd-lang-emacs-lisp.el Normal file
View File

@@ -0,0 +1,26 @@
;;; emacs-lisp.el -*- lexical-binding: t; -*-
(require 'syd-handle-repl)
(use-package 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)))))
(add-to-list '+syd-major-mode-repl-alist
'(emacs-lisp-mode syd/open-emacs-lisp-repl))
(pp +popup-defaults))
(provide 'syd-lang-emacs-lisp)

7
users/crumb/programs/emacs/modules/syd-keybinds.el
View File

@@ -116,6 +116,12 @@ are active.")
"C-r" `("Redo window change" . ,#'winner-redo)
"m" `("Maximise" . ,syd-leader-window-maximise-map))
;; Open
(require 'syd-handle-repl)
(general-def
:prefix-map 'syd-leader-open-map
"r" `("Repl o/w" . ,#'+syd/open-repl-other-window))
(general-def
:prefix-map 'syd-leader-project-map
"C" `("Compile project" . ,#'project-compile))
@@ -128,6 +134,7 @@ are active.")
"x" `("Open scratch buffer" . ,#'scratch-buffer)
"u" `("Universal argument" . ,#'universal-argument)
"b" `("Buffer" . ,syd-leader-buffer-map)
"o" `("Open" . ,syd-leader-open-map)
"p" `("Project" . ,syd-leader-project-map)
"w" `("Window" . ,syd-leader-window-map)
"f" `("File" . ,syd-leader-file-map)

6
users/crumb/programs/emacs/modules/syd-lang.el Normal file
View File

@@ -0,0 +1,6 @@
(add-to-list 'load-path
(file-name-concat user-emacs-directory "modules" "lang"))
(require 'syd-lang-emacs-lisp)
(provide 'syd-lang)

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

@@ -0,0 +1,3 @@
#+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 Normal file
View File

@@ -0,0 +1,187 @@
;;; 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)

411
users/crumb/programs/emacs/modules/syd-popup/syd-popup-hacks.el Normal file
View File

@@ -0,0 +1,411 @@
;;; ui/popup/+hacks.el -*- lexical-binding: t; -*-
;; What follows are all the hacks needed to get various parts of Emacs and other
;; plugins to cooperate with the popup management system. Essentially, it comes
;; down to:
;;
;; 1. Making plugins that control their own window environment less greedy (e.g.
;; org agenda, which tries to reconfigure the entire frame by deleting all
;; other windows just to pop up one tiny window).
;; 2. Forcing plugins to use `display-buffer' and `pop-to-buffer' instead of
;; `switch-to-buffer' (which is unaffected by `display-buffer-alist', which
;; we must rely on, heavily).
;; 3. Closing popups (temporarily) before functions that are highly destructive
;; to the illusion of popup control get run (with the use of the
;; `save-popups!' macro).
;;
;; Keep in mind, all this black magic may break in future updates, and will need
;; to be watched carefully for corner cases. Also, once this file is loaded,
;; many of its changes are irreversible without restarting Emacs! I don't like
;; it either, but I will address this over time.
;;
;; Hacks should be kept in alphabetical order, named after the feature they
;; modify, and should follow a ;;;## package-name header line (if not using
;; `after!' or `use-package!').
;;
;;; Core functions
(defun +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'
grows larger."
(let (case-fold-search)
(apply fn args)))
(advice-add #'display-buffer-assq-regexp
:around #'+popup--make-case-sensitive-a)
;; Don't try to resize popup windows
(advice-add #'balance-windows :around #'+popup-save-a)
(defun +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."
(interactive "P")
(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)
;;
;;; External functions
(with-eval-after-load 'buff-menu
(define-key Buffer-menu-mode-map (kbd "RET") #'Buffer-menu-other-window))
(with-eval-after-load 'company
(defun +popup--dont-select-me-a (fn &rest args)
(let ((+popup--inhibit-select t))
(apply fn args)))
(advice-add #'company-show-doc-buffer
:around #'+popup--dont-select-me-a))
;;;###package compile
(with-eval-after-load 'compile
(defun +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)))))
(funcall pop-to-buffer buffer action norecord)))))
(apply fn args))))
(advice-add #'compilation-goto-locus
:around #'+popup--compilation-goto-locus-a))
;;;###package eshell
(with-eval-after-load 'eshell
(setq eshell-destroy-buffer-when-process-dies t)
;; When eshell runs a visual command (see `eshell-visual-commands'), it spawns
;; a term buffer to run it in, but where it spawns it is the problem...
(defun +popup--eshell-undedicate-popup (&rest _)
"Force spawned term buffer to share with the eshell popup (if necessary)."
(when (+popup-window-p)
(set-window-dedicated-p nil nil)
(add-transient-hook! (function eshell-query-kill-processes)
:after (set-window-dedicated-p nil t))))
(advice-add #'eshell-exec-visual
:around #'+popup--eshell-undedicate-popup))
;;;###package evil
(with-eval-after-load 'evil
(defun +popup--evil-command-window-execute-a nil
"Execute the command under the cursor in the appropriate buffer, rather than
the command buffer."
(interactive)
(let ((result (buffer-substring (line-beginning-position)
(line-end-position)))
(execute-fn evil-command-window-execute-fn)
(execute-window
(get-buffer-window evil-command-window-current-buffer))
(popup (selected-window)))
(if execute-window
(select-window execute-window)
(user-error "Originating buffer is no longer active"))
(delete-window popup)
(funcall execute-fn result)
(setq evil-command-window-current-buffer nil)))
(advice-add #'evil-command-window-execute
:around #'+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))
(with-eval-after-load 'help-mode
(defun +popup--switch-from-popup (location)
(let (origin enable-local-variables)
(save-popups!
(switch-to-buffer (car location) nil t)
(if (not (cdr location))
(message "Unable to find location in file")
(goto-char (cdr location))
(recenter)
(setq origin (selected-window))))
(select-window origin)))
;; Help buffers use `pop-to-window' to decide where to open followed links,
;; which can be unpredictable. It should *only* replace the original buffer we
;; opened the popup from. To fix this these three button types need to be
;; redefined to set aside the popup before following a link.
(define-button-type 'help-function-def
:supertype 'help-xref
'help-function
(lambda (fun file)
(require 'find-func)
(when (eq file 'C-source)
(setq file (help-C-file-name (indirect-function fun) 'fun)))
(+popup--switch-from-popup (find-function-search-for-symbol fun nil file))))
(define-button-type 'help-variable-def
:supertype 'help-xref
'help-function
(lambda (var &optional file)
(when (eq file 'C-source)
(setq file (help-C-file-name var 'var)))
(+popup--switch-from-popup (find-variable-noselect var file))))
(define-button-type 'help-face-def
:supertype 'help-xref
'help-function
(lambda (fun file)
(require 'find-func)
(+popup--switch-from-popup (find-function-search-for-symbol fun 'defface file)))))
;;;###package helpful
(with-eval-after-load 'helpful
(defadvice! +popup--helpful-open-in-origin-window-a (button)
"Open links in non-popup, originating window rather than helpful's window."
:override #'helpful--navigate
(let ((path (substring-no-properties (button-get button 'path)))
enable-local-variables
origin)
(save-popups!
(find-file path)
(when-let (pos (get-text-property button 'position
(marker-buffer button)))
(goto-char pos))
(setq origin (selected-window))
(recenter))
(select-window origin))))
;;;###package helm
;;;###package helm-ag
(with-eval-after-load 'helm
(setq helm-default-display-buffer-functions '(+popup-display-buffer-stacked-side-window-fn))
;; Fix #897: "cannot open side window" error when TAB-completing file links
(defadvice! +popup--helm-hide-org-links-popup-a (fn &rest args)
:around #'org-insert-link
(letf! ((defun org-completing-read (&rest args)
(when-let (win (get-buffer-window "*Org Links*"))
;; While helm is opened as a popup, it will mistaken the *Org
;; Links* popup for the "originated window", and will target it
;; for actions invoked by the user. However, since *Org Links*
;; is a popup too (they're dedicated side windows), Emacs
;; complains about being unable to split a side window. The
;; simple fix: get rid of *Org Links*!
(delete-window win)
;; ...but it must exist for org to clean up later.
(get-buffer-create "*Org Links*"))
(apply org-completing-read args)))
(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)
:before #'helm-elisp--persistent-help
(let (win)
(and (helm-attr 'help-running-p)
(string= candidate (helm-attr 'help-current-symbol))
(setq win (get-buffer-window (get-buffer (help-buffer))))
(delete-window win)))))
;;;###package Info
(with-eval-after-load 'Info
(defadvice! +popup--switch-to-info-window-a (&rest _)
:after #'info-lookup-symbol
(when-let (win (get-buffer-window "*info*"))
(when (+popup-window-p win)
(select-window win)))))
;;;###package latex
(with-eval-after-load 'latex
(defadvice! +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)
"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."
:around #'org-add-log-note
:around #'org-capture-place-template
:around #'org-export--dispatch-ui
:around #'org-agenda-get-restriction-and-command
:around #'org-goto-location
:around #'org-fast-tag-selection
:around #'org-fast-todo-selection
(if +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)
"`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
(letf! (defun internal-temp-output-buffer-show (buffer)
(let ((temp-buffer-show-function
(lambda (&rest args)
(apply #'+popup-display-buffer-stacked-side-window-fn
nil args))))
(with-current-buffer buffer
(+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)
"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
(letf! ((defun read-char-exclusive (&rest args)
(message nil)
(apply read-char-exclusive args))
(defun split-window-vertically (&optional _size)
(funcall split-window-vertically (- 0 window-min-height 1)))
(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)))
(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)
"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)))
(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)
:around #'org-journal--search-by-string
(letf! ((#'switch-to-buffer #'pop-to-buffer))
(apply fn args))))
;;;###package persp-mode
(with-eval-after-load 'persp-mode
(defadvice! +popup--persp-mode-restore-popups-a (&rest _)
"Restore popup windows when loading a perspective from file."
:after #'persp-load-state-from-file
(dolist (window (window-list))
(when (+popup-parameter 'popup window)
(+popup--init window nil)))))
(with-eval-after-load 'pdf-tools
(setq tablist-context-window-display-action
'((+popup-display-buffer-stacked-side-window-fn)
(side . left)
(slot . 2)
(window-height . 0.3)
(inhibit-same-window . t))
pdf-annot-list-display-buffer-action
'((+popup-display-buffer-stacked-side-window-fn)
(side . left)
(slot . 3)
(inhibit-same-window . t))))
;;;###package profiler
(with-eval-after-load 'profiler
(defadvice! +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))))
;;;###package undo-tree
(with-eval-after-load 'undo-tree
(defadvice! +popup--use-popup-window-for-undo-tree-visualizer-a (fn &rest args)
"TODO"
:around #'undo-tree-visualize
(if undo-tree-visualizer-diff
(apply fn args)
(letf! ((#'switch-to-buffer-other-window #'pop-to-buffer))
(apply fn args)))))
;;;###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))
;;;###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))
(with-eval-after-load 'which-key
(when (eq which-key-popup-type 'side-window)
(setq which-key-popup-type 'custom
which-key-custom-popup-max-dimensions-function
(lambda (_) (which-key--side-window-max-dimensions))
which-key-custom-hide-popup-function #'which-key--hide-buffer-side-window
which-key-custom-show-popup-function
(lambda (act-popup-dim)
(letf! (defun display-buffer-in-side-window (buffer alist)
(+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)))
(which-key--show-buffer-side-window act-popup-dim))))))
;;;###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)
"Allow *interactive* window moving commands to traverse popups."
(cl-letf ((windmove-find-other-window
(symbol-function #'windmove-find-other-window)))
(ignore windmove-find-other-window)
(cl-letf (((symbol-function #'windmove-find-other-window)
(lambda (dir &optional arg window)
(window-in-direction (pcase dir
(`up 'above)
(`down 'below)
(_ dir))
window
(bound-and-true-p +popup-mode)
arg
windmove-wrap-around
t))))
(apply fn args))))
(dolist (target (list #'windmove-up #'windmove-down
#'windmove-left #'windmove-right))
(advice-add target
:around #'+popup--ignore-window-parameters-a)))
(provide 'syd-popup-hacks)

195
users/crumb/programs/emacs/modules/syd-popup/syd-popup-settings.el Normal file
View File

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

645
users/crumb/programs/emacs/modules/syd-popup/syd-popup.el Normal file
View File

@@ -0,0 +1,645 @@
;;; popup.el -*- lexical-binding: t; -*-
(require 'syd-popup-settings)
(defvar +popup--internal nil)
(defun +popup--remember (windows)
"Remember WINDOWS (a list of windows) for later restoration."
(cl-assert (cl-every #'windowp windows) t)
(setq +popup--last
(cl-loop for w in windows
collect (cons (window-buffer w)
(window-state-get w)))))
(defun +popup--kill-buffer (buffer ttl)
"Tries to kill BUFFER, as was requested by a transient timer. If it fails, eg.
the buffer is visible, then set another timer and try again later."
(let ((inhibit-quit t))
(cond ((not (buffer-live-p buffer)))
((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))
confirm-kill-processes)
(when-let (process (get-buffer-process buffer))
(when (eq (process-type process) 'real)
(kill-process process)))
(let (kill-buffer-query-functions)
;; HACK The debugger backtrace buffer, when killed, called
;; `top-level'. This causes jumpiness when the popup
;; manager tries to clean it up.
(cl-letf (((symbol-function #'top-level) #'ignore))
(kill-buffer buffer)))))))
((let ((ttl (if (= ttl 0)
(or (plist-get +popup-defaults :ttl) 3)
ttl)))
(with-current-buffer buffer
(setq +popup--timer
(run-at-time ttl nil #'+popup--kill-buffer buffer ttl))))))))
(defun +popup--delete-window (window)
"Do housekeeping before destroying a popup window.
+ Disables `+popup-buffer-mode' so that any hooks attached to it get a chance to
run and do cleanup of its own.
+ Either kills the buffer or sets a transient timer, if the window has a
`transient' window parameter (see `+popup-window-parameters').
+ And finally deletes the window!"
(let ((buffer (window-buffer window))
(inhibit-quit t))
(and (or (buffer-file-name buffer)
(if-let (base-buffer (buffer-base-buffer buffer))
(buffer-file-name base-buffer)))
(buffer-modified-p buffer)
(let ((autosave (+popup-parameter 'autosave window)))
(cond ((eq autosave 't))
((null autosave)
(y-or-n-p "Popup buffer is modified. Save it?"))
((functionp autosave)
(funcall autosave buffer))))
(with-current-buffer buffer (save-buffer)))
(let ((ignore-window-parameters t))
(if-let (wconf (window-parameter window 'saved-wconf))
(set-window-configuration wconf)
(delete-window window)))
(unless (window-live-p window)
(with-current-buffer buffer
(set-buffer-modified-p nil)
(+popup-buffer-mode -1)
(unless +popup--inhibit-transient
(let ((ttl (+popup-parameter 'ttl window)))
(when (eq ttl 't)
(setq ttl (plist-get +popup-defaults :ttl)))
(cond ((null ttl))
((functionp ttl)
(funcall ttl buffer))
((not (integerp ttl))
(signal 'wrong-type-argument (list 'integerp ttl)))
((= ttl 0)
(+popup--kill-buffer buffer 0))
((add-hook 'kill-buffer-hook #'+popup-kill-buffer-hook-h nil t)
(setq +popup--timer
(run-at-time ttl nil #'+popup--kill-buffer
buffer ttl))))))))))
(defun +popup--delete-other-windows (window)
"Fixes `delete-other-windows' when used from a popup window."
(when-let (window (ignore-errors (+popup/raise window)))
(let ((ignore-window-parameters t))
(delete-other-windows window)))
nil)
(defun +popup--normalize-alist (alist)
"Merge `+popup-default-alist' and `+popup-default-parameters' with ALIST."
(when alist
(let ((alist ; handle defaults
(cl-remove-duplicates
(append alist +popup-default-alist)
:key #'car-safe :from-end t))
(parameters
(cl-remove-duplicates
(append (cdr (assq 'window-parameters alist))
+popup-default-parameters)
:key #'car-safe :from-end t)))
;; handle `size'
(when-let* ((size (cdr (assq 'size alist)))
(side (or (cdr (assq 'side alist)) 'bottom))
(param (if (memq side '(left right))
'window-width
'window-height)))
(setq alist (assq-delete-all 'size alist))
(setf (alist-get param alist) size))
(setf (alist-get 'window-parameters alist)
parameters)
;; Fixes #1305: addresses an edge case where a popup with a :size, :width
;; or :height greater than the current frame's dimensions causes
;; hanging/freezing (a bug in Emacs' `display-buffer' API perhaps?)
(let ((width (cdr (assq 'window-width alist)))
(height (cdr (assq 'window-height alist))))
(setf (alist-get 'window-width alist)
(if (numberp width)
(min width (frame-width))
width))
(setf (alist-get 'window-height alist)
(if (numberp height)
(min height (frame-height))
height))
alist))))
(defun +popup--split-window (window size side)
"Ensure a non-dedicated/popup window is selected when splitting a window."
(unless +popup--internal
(cl-loop for win
in (cons (or window (selected-window))
(window-list nil 0 window))
unless (+popup-window-p win)
return (setq window win)))
(let ((ignore-window-parameters t))
(split-window window size side)))
(defun +popup--maybe-select-window (window origin)
"Select a window based on `+popup--inhibit-select' and this window's `select' parameter."
(unless +popup--inhibit-select
;; 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)))
(if (functionp select)
(funcall select window origin)
(select-window (if select window origin))))))
;;;###autoload
(defun +popup--init (window &optional alist)
"Initializes a popup window. Run any time a popup is opened. It sets the
default window parameters for popup windows, clears leftover transient timers
and enables `+popup-buffer-mode'."
(with-selected-window window
(setq alist (delq (assq 'actions alist) alist))
(set-window-parameter window 'popup t)
(set-window-parameter window 'split-window #'+popup--split-window)
(set-window-parameter window 'delete-window #'+popup--delete-window)
(set-window-parameter window 'delete-other-windows #'+popup--delete-other-windows)
(set-window-dedicated-p window 'popup)
(window-preserve-size
window (memq (window-parameter window 'window-side)
'(left right))
t)
(+popup-buffer-mode +1)
(run-hooks '+popup-create-window-hook)))
;;
;; Public library
;;;###autoload
(defun +popup-buffer-p (&optional buffer)
"Return non-nil if BUFFER is a popup buffer. Defaults to the current buffer."
(when +popup-mode
(let ((buffer (or buffer (current-buffer))))
(and (bufferp buffer)
(buffer-live-p buffer)
(buffer-local-value '+popup-buffer-mode buffer)
buffer))))
;;;###autoload
(defun +popup-window-p (&optional window)
"Return non-nil if WINDOW is a popup window. Defaults to the current window."
(when +popup-mode
(let ((window (or window (selected-window))))
(and (windowp window)
(window-live-p window)
(window-parameter window 'popup)
window))))
;;;###autoload
(defun +popup-buffer (buffer &optional alist)
"Open BUFFER in a popup window. ALIST describes its features."
(let* ((origin (selected-window))
(window-min-height 3)
(alist (+popup--normalize-alist alist))
(actions (or (cdr (assq 'actions alist))
+popup-default-display-buffer-actions)))
(or (let* ((alist (remove (assq 'window-width alist) alist))
(alist (remove (assq 'window-height alist) alist))
(window (display-buffer-reuse-window buffer alist)))
(when window
(+popup--maybe-select-window window origin)
window))
(when-let (popup (cl-loop for func in actions
if (funcall func buffer alist)
return it))
(+popup--init popup alist)
(+popup--maybe-select-window popup origin)
popup))))
;;;###autoload
(defun +popup-parameter (parameter &optional window)
"Fetch the window PARAMETER (symbol) of WINDOW"
(window-parameter (or window (selected-window)) parameter))
;;;###autoload
(defun +popup-parameter-fn (parameter &optional window &rest args)
"Fetch the window PARAMETER (symbol) of WINDOW. If it is a function, run it
with ARGS to get its return value."
(let ((val (+popup-parameter parameter window)))
(if (functionp val)
(apply val args)
val)))
;;;###autoload
(defun +popup-windows ()
"Returns a list of all popup windows."
(cl-remove-if-not #'+popup-window-p (window-list)))
;;;###autoload
(defun +popup-shrink-to-fit (&optional window)
"Shrinks WINDOW to fit the buffer contents, if the buffer isn't empty.
Uses `shrink-window-if-larger-than-buffer'."
(unless window
(setq window (selected-window)))
(unless (= (- (point-max) (point-min)) 0)
(shrink-window-if-larger-than-buffer window)))
;;;###autoload
(defun +popup-alist-from-window-state (state)
"Convert window STATE (from `window-state-get') to a `display-buffer' alist."
(let* ((params (alist-get 'parameters state)))
`((side . ,(alist-get 'window-side params))
(window-width . ,(alist-get 'total-width state))
(window-height . ,(alist-get 'total-height state))
(window-parameters ,@params))))
;;
;; Hooks
;;;###autoload
(defun +popup-adjust-fringes-h ()
"Hides the fringe in popup windows, restoring them if `+popup-buffer-mode' is
disabled."
(let ((f (if (bound-and-true-p +popup-buffer-mode) 0)))
(set-window-fringes nil f f fringes-outside-margins)))
;;;###autoload
(defun +popup-adjust-margins-h ()
"Creates padding for the popup window determined by `+popup-margin-width',
restoring it if `+popup-buffer-mode' is disabled."
(when +popup-margin-width
(unless (memq (window-parameter nil 'window-side) '(left right))
(let ((m (if (bound-and-true-p +popup-buffer-mode) +popup-margin-width)))
(set-window-margins nil m m)))))
(defvar hide-mode-line-format)
;;;###autoload
(defun +popup-set-modeline-on-enable-h ()
"Don't show modeline in popup windows without a `modeline' window-parameter.
Possible values for this parameter are:
t show the mode-line as normal
nil hide the modeline entirely (the default)
a function `mode-line-format' is set to its return value
Any non-nil value besides the above will be used as the raw value for
`mode-line-format'."
(when (and (bound-and-true-p +popup-buffer-mode)
(boundp 'hide-mode-line-mode))
(let ((modeline (+popup-parameter 'modeline)))
(cond ((eq modeline 't))
((null modeline)
;; TODO use `mode-line-format' window parameter instead (emacs 26+)
(hide-mode-line-mode +1))
((let ((hide-mode-line-format
(if (functionp modeline)
(funcall modeline)
modeline)))
(hide-mode-line-mode +1)))))))
(put '+popup-set-modeline-on-enable-h 'permanent-local-hook t)
;;;###autoload
(defun +popup-unset-modeline-on-disable-h ()
"Restore the modeline when `+popup-buffer-mode' is deactivated."
(when (and (not (bound-and-true-p +popup-buffer-mode))
(bound-and-true-p hide-mode-line-mode)
(not (bound-and-true-p global-hide-mode-line-mode)))
(hide-mode-line-mode -1)))
;;;###autoload
(defun +popup-close-on-escape-h ()
"If called inside a popup, try to close that popup window (see
`+popup/close'). If called outside, try to close all popup windows (see
`+popup/close-all')."
(if (+popup-window-p)
(+popup/close)
(+popup/close-all)))
;;;###autoload
(defun +popup-cleanup-rules-h ()
"Cleans up any duplicate popup rules."
(interactive)
(setq +popup--display-buffer-alist
(cl-delete-duplicates +popup--display-buffer-alist
:key #'car :test #'equal :from-end t))
(when +popup-mode
(setq display-buffer-alist +popup--display-buffer-alist)))
;;;###autoload
(defun +popup-kill-buffer-hook-h ()
"TODO"
(when-let (window (get-buffer-window))
(when (+popup-window-p window)
(let ((+popup--inhibit-transient t))
(+popup--delete-window window)))))
;;
;; Commands
;;;###autoload
(defalias 'other-popup #'+popup/other)
;;;###autoload
(defun +popup/buffer ()
"Open this buffer in a popup window."
(interactive)
(let ((+popup-default-display-buffer-actions
'(+popup-display-buffer-stacked-side-window-fn))
(display-buffer-alist +popup--display-buffer-alist)
(buffer (current-buffer)))
(push (+popup-make-rule "." +popup-defaults) display-buffer-alist)
(bury-buffer)
(pop-to-buffer buffer)))
;;;###autoload
(defun +popup/other ()
"Cycle through popup windows, like `other-window'. Ignores regular windows."
(interactive)
(if-let (popups (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)))
(window-list)))
(select-window (if (or (+popup-window-p)
(window-parameter nil 'no-other-window))
(let ((window (selected-window)))
(or (car-safe (cdr (memq window popups)))
(car (delq window popups))
(car popups)))
(car popups)))
(user-error "No popups are open")))
;;;###autoload
(defun +popup/close (&optional window force-p)
"Close WINDOW, if it's a popup window.
This will do nothing if the popup's `quit' window parameter is either nil or
'other. This window parameter is ignored if FORCE-P is non-nil."
(interactive
(list (selected-window)
current-prefix-arg))
(let ((window (or window (selected-window))))
(when (and (+popup-window-p window)
(or force-p
(memq (+popup-parameter-fn 'quit window window)
'(t current))))
(when +popup--remember-last
(+popup--remember (list window)))
(delete-window window)
t)))
;;;###autoload
(defun +popup/close-all (&optional force-p)
"Close all open popup windows.
This will ignore popups with an `quit' parameter that is either nil or 'current.
This window parameter is ignored if FORCE-P is non-nil."
(interactive "P")
(let (targets +popup--remember-last)
(dolist (window (+popup-windows))
(when (or force-p
(memq (+popup-parameter-fn 'quit window window)
'(t other)))
(push window targets)))
(when targets
(+popup--remember targets)
(mapc #'delete-window targets)
t)))
;;;###autoload
(defun +popup/toggle ()
"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)))
((display-buffer (get-buffer "*Messages*"))))))
;;;###autoload
(defun +popup/restore ()
"Restore the last popups that were closed, if any."
(interactive)
(unless +popup--last
(error "No popups to restore"))
(cl-loop for (buffer . state) in +popup--last
if (buffer-live-p buffer)
do (+popup-buffer buffer (+popup-alist-from-window-state state)))
(setq +popup--last nil)
t)
;;;###autoload
(defun +popup/raise (window &optional arg)
"Raise the current popup window into a regular window 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)
(user-error "Cannot raise a non-popup window"))
(let ((buffer (current-buffer))
(+popup--inhibit-transient t)
+popup--remember-last)
(+popup/close window 'force)
(let (display-buffer-alist)
(if arg
(pop-to-buffer buffer)
(switch-to-buffer buffer)))
(selected-window)))
;;;###autoload
(defun +popup/diagnose ()
"Reveal what popup rule will be used for the current buffer."
(interactive)
(if-let (rule (cl-loop with bname = (buffer-name)
for (pred . action) in display-buffer-alist
if (and (functionp pred) (funcall pred bname action))
return (cons pred action)
else if (and (stringp pred) (string-match-p pred bname))
return (cons pred action)))
(message "Rule matches: %s" rule)
(message "No popup rule for this buffer")))
;; Advice
;;;###autoload
(defun +popup-close-a (&rest _)
"TODO"
(+popup/close nil t))
;;;###autoload
(defun +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)
"Displays the buffer fullscreen."
(let ((wconf (current-window-configuration)))
(when-let (window (or (display-buffer-reuse-window buffer alist)
(display-buffer-same-window buffer alist)
(display-buffer-pop-up-window buffer alist)
(display-buffer-use-some-window buffer alist)))
(set-window-parameter window 'saved-wconf wconf)
(add-to-list 'window-persistent-parameters '(saved-wconf . t))
(delete-other-windows window)
window)))
;;;###autoload
(defun +popup-display-buffer-stacked-side-window-fn (buffer alist)
"A `display-buffer' action that serves as an alternative to
`display-buffer-in-side-window', but allows for stacking popups with the `vslot'
alist entry.
Accepts the same arguments as `display-buffer-in-side-window'. You must set
`window--sides-inhibit-check' to non-nil for this work properly."
(let* ((side (or (cdr (assq 'side alist)) 'bottom))
(slot (or (cdr (assq 'slot alist)) 0))
(vslot (or (cdr (assq 'vslot alist)) 0))
(left-or-right (memq side '(left right)))
(display-buffer-mark-dedicated (or display-buffer-mark-dedicated 'popup)))
(cond ((not (memq side '(top bottom left right)))
(error "Invalid side %s specified" side))
((not (numberp slot))
(error "Invalid slot %s specified" slot))
((not (numberp vslot))
(error "Invalid vslot %s specified" vslot)))
(let* ((live (get-window-with-predicate
(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'),
;; `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
;; window with multiple children. In that case, all childen should
;; have the same `window-vslot' parameter, and the major side window
;; is the parent of the live window.
(prev (and live (window-prev-sibling live)))
(next (and live (window-next-sibling live)))
(prev-vslot (and prev (window-parameter prev 'window-vslot)))
(next-vslot (and next (window-parameter next 'window-vslot)))
(major (and live
(if (or (eq prev-vslot vslot) (eq next-vslot vslot))
(window-parent live)
live)))
(reversed (window--sides-reverse-on-frame-p (selected-frame)))
(windows
(cond ((window-live-p major)
(list major))
((window-valid-p major)
(let* ((first (window-child major))
(next (window-next-sibling first))
(windows (list next first)))
(setq reversed (> (window-parameter first 'window-slot)
(window-parameter next 'window-slot)))
(while (setq next (window-next-sibling next))
(setq windows (cons next windows)))
(if reversed windows (nreverse windows))))))
(slots (if major (max 1 (window-child-count major))))
(max-slots
(nth (plist-get '(left 0 top 1 right 2 bottom 3) side)
window-sides-slots))
(window--sides-inhibit-check t)
window this-window this-slot prev-window next-window
best-window best-slot abs-slot)
(cond ((and (numberp max-slots) (<= max-slots 0))
nil)
((not windows)
(cl-letf (((symbol-function 'window--make-major-side-window-next-to)
(lambda (_side) (frame-root-window (selected-frame)))))
(when-let (window (window--make-major-side-window buffer side slot alist))
(set-window-parameter window 'window-vslot vslot)
(add-to-list 'window-persistent-parameters '(window-vslot . writable))
window)))
(t
;; Scan windows on SIDE.
(catch 'found
(dolist (window windows)
(setq this-slot (window-parameter window 'window-slot))
(cond ((not (numberp this-slot)))
((= this-slot slot) ; A window with a matching slot found
(setq this-window window)
(throw 'found t))
(t
;; Check if this window has a better slot value wrt the
;; slot of the window we want.
(setq abs-slot
(if (or (and (> this-slot 0) (> slot 0))
(and (< this-slot 0) (< slot 0)))
(abs (- slot this-slot))
(+ (abs slot) (abs this-slot))))
(unless (and best-slot (<= best-slot abs-slot))
(setq best-window window)
(setq best-slot abs-slot))
(if reversed
(cond
((<= this-slot slot)
(setq next-window window))
((not prev-window)
(setq prev-window window)))
(cond
((<= this-slot slot)
(setq prev-window window))
((not next-window)
(setq next-window window))))))))
;; `this-window' is the first window with the same SLOT.
;; `prev-window' is the window with the largest slot < SLOT. A new
;; window will be created after it.
;; `next-window' is the window with the smallest slot > SLOT. A new
;; window will be created before it.
;; `best-window' is the window with the smallest absolute
;; difference of its slot and SLOT.
(or (and this-window
;; Reuse `this-window'.
(with-current-buffer buffer
(setq window--sides-shown t))
(window--display-buffer
buffer this-window 'reuse alist))
(and (or (not max-slots) (< slots max-slots))
(or (and next-window
;; Make new window before `next-window'.
(let ((next-side (if left-or-right 'above 'left))
(+popup--internal t)
(window-combination-resize 'side))
(setq window
(ignore-errors (split-window next-window nil next-side)))))
(and prev-window
;; Make new window after `prev-window'.
(let ((prev-side (if left-or-right 'below 'right))
(+popup--internal t)
(window-combination-resize 'side))
(setq window
(ignore-errors (split-window prev-window nil prev-side))))))
(set-window-parameter window 'window-slot slot)
(set-window-parameter window 'window-vslot vslot)
(with-current-buffer buffer
(setq window--sides-shown t))
(window--display-buffer
buffer window 'window alist))
(and best-window
;; Reuse `best-window'.
(progn
;; Give best-window the new slot value.
(set-window-parameter best-window 'window-slot slot)
(with-current-buffer buffer
(setq window--sides-shown t))
(window--display-buffer
buffer best-window 'reuse alist)))))))))
(require 'syd-popup-config)
(provide 'syd-popup)

10
users/crumb/programs/emacs/modules/syd-scratch.el
View File

@@ -4,15 +4,15 @@
;; Persist the scratch buffer between sessions. Note that it is not persisted
;; between boots.
;; TODO: This could be deferred better.
;; TODO: This could be better deferred.
(use-package persistent-scratch
:hook (after-init)
:custom (persistent-scratch-save-file
(file-name-concat syd-data-dir "scratch"))
:config
;; The default error/warning message is a bit too error-looking for my tastes.
;; This is the same function, but with a tamer warning message.
(defun syd--persistent-scratch--auto-restore ()
;; The default warning message is a bit too error-looking for my tastes. This
;; is the same function, but with a tamer warning message.
(defun syd--persistent-scratch--auto-restore-a ()
"Automatically restore the scratch buffer once per session."
(unless persistent-scratch--auto-restored
(condition-case err
@@ -21,7 +21,7 @@
(message "No previous scratch buffer to restore")))
(setq persistent-scratch--auto-restored t)))
(advice-add #'persistent-scratch--auto-restore
:override #'syd--persistent-scratch--auto-restore)
:override #'syd--persistent-scratch--auto-restore-a)
;; Arrange the activation of autosave and auto-restore (if applicable) on
;; Emacs start.