236 lines
8.9 KiB
EmacsLisp
236 lines
8.9 KiB
EmacsLisp
;;; prot-window.el --- Display-buffer and window-related extensions for my dotemacs -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2023-2024 Protesilaos Stavrou
|
|
|
|
;; Author: Protesilaos Stavrou <info@protesilaos.com>
|
|
;; URL: https://protesilaos.com/emacs/dotemacs
|
|
;; Version: 0.1.0
|
|
;; Package-Requires: ((emacs "30.1"))
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
;;
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
;;
|
|
;; This covers my window and display-buffer extensions, for use in my
|
|
;; Emacs setup: https://protesilaos.com/emacs/dotemacs.
|
|
;;
|
|
;; Remember that every piece of Elisp that I write is for my own
|
|
;; educational and recreational purposes. I am not a programmer and I
|
|
;; do not recommend that you copy any of this if you are not certain of
|
|
;; what it does.
|
|
|
|
;;; Code:
|
|
|
|
(require 'prot-common)
|
|
|
|
(defvar prot-window-window-sizes
|
|
'( :max-height (lambda () (floor (frame-height) 3))
|
|
:min-height 10
|
|
:max-width (lambda () (floor (frame-width) 4))
|
|
:min-width 20)
|
|
"Property list of maximum and minimum window sizes.
|
|
The property keys are `:max-height', `:min-height', `:max-width',
|
|
and `:min-width'. They all accept a value of either a
|
|
number (integer or floating point) or a function.")
|
|
|
|
(defun prot-window--get-window-size (key)
|
|
"Extract the value of KEY from `prot-window-window-sizes'."
|
|
(when-let* ((value (plist-get prot-window-window-sizes key)))
|
|
(cond
|
|
((functionp value)
|
|
(funcall value))
|
|
((numberp value)
|
|
value)
|
|
(t
|
|
(error "The value of `%s' is neither a number nor a function" key)))))
|
|
|
|
(defun prot-window-select-fit-size (window)
|
|
"Select WINDOW and resize it.
|
|
The resize pertains to the maximum and minimum values for height
|
|
and width, per `prot-window-window-sizes'.
|
|
|
|
Use this as the `body-function' in a `display-buffer-alist' entry."
|
|
(select-window window)
|
|
(fit-window-to-buffer
|
|
window
|
|
(prot-window--get-window-size :max-height)
|
|
(prot-window--get-window-size :min-height)
|
|
(prot-window--get-window-size :max-width)
|
|
(prot-window--get-window-size :min-width))
|
|
;; If we did not use `display-buffer-below-selected', then we must
|
|
;; be in a lateral window, which has more space. Then we do not
|
|
;; want to dedicate the window to this buffer, because we will be
|
|
;; running out of space.
|
|
(when (or (window-in-direction 'above) (window-in-direction 'below))
|
|
(set-window-dedicated-p window t)))
|
|
|
|
(defun prot-window--get-display-buffer-below-or-pop ()
|
|
"Return list of functions for `prot-window-display-buffer-below-or-pop'."
|
|
(list
|
|
#'display-buffer-reuse-mode-window
|
|
(if (or (prot-common-window-small-p)
|
|
(prot-common-three-or-more-windows-p))
|
|
#'display-buffer-below-selected
|
|
#'display-buffer-pop-up-window)))
|
|
|
|
(defun prot-window-display-buffer-below-or-pop (&rest args)
|
|
"Display buffer below current window or pop a new window.
|
|
The criterion for choosing to display the buffer below the
|
|
current one is a non-nil return value for
|
|
`prot-common-window-small-p'.
|
|
|
|
Apply ARGS expected by the underlying `display-buffer' functions.
|
|
|
|
This as the action function in a `display-buffer-alist' entry."
|
|
(let ((functions (prot-window--get-display-buffer-below-or-pop)))
|
|
(catch 'success
|
|
(dolist (fn functions)
|
|
(when (apply fn args)
|
|
(throw 'success fn))))))
|
|
|
|
(defun prot-window-shell-or-term-p (buffer &rest _)
|
|
"Check if BUFFER is a shell or terminal.
|
|
This is a predicate function for `buffer-match-p', intended for
|
|
use in `display-buffer-alist'."
|
|
(when (string-match-p "\\*.*\\(e?shell\\|v?term\\).*" (buffer-name (get-buffer buffer)))
|
|
(with-current-buffer buffer
|
|
;; REVIEW 2022-07-14: Is this robust?
|
|
(and (not (derived-mode-p 'message-mode 'text-mode))
|
|
(derived-mode-p 'eshell-mode 'shell-mode 'comint-mode 'fundamental-mode)))))
|
|
|
|
(defun prot-window-remove-dedicated (&rest _)
|
|
"Remove dedicated window parameter.
|
|
Use this as :after advice to `delete-other-windows' and
|
|
`delete-window'."
|
|
(when (one-window-p :no-mini)
|
|
(set-window-dedicated-p nil nil)))
|
|
|
|
(mapc
|
|
(lambda (fn)
|
|
(advice-add fn :after #'prot-window-remove-dedicated))
|
|
'(delete-other-windows delete-window))
|
|
|
|
(defmacro prot-window-define-full-frame (name &rest args)
|
|
"Define command to call ARGS in new frame with `display-buffer-full-frame' bound.
|
|
Name the function prot-window- followed by NAME. If ARGS is nil,
|
|
call NAME as a function."
|
|
(declare (indent 1))
|
|
`(defun ,(intern (format "prot-window-%s" name)) ()
|
|
,(format "Call `prot-window-%s' in accordance with `prot-window-define-full-frame'." name)
|
|
(interactive)
|
|
(let ((display-buffer-alist '((".*" (display-buffer-full-frame)))))
|
|
(with-selected-frame (make-frame)
|
|
,(if args
|
|
`(progn ,@args)
|
|
`(funcall ',name))
|
|
(modify-frame-parameters nil '((buffer-list . nil)))))))
|
|
|
|
(defun prot-window--get-shell-buffers ()
|
|
"Return list of `shell' buffers."
|
|
(seq-filter
|
|
(lambda (buffer)
|
|
(with-current-buffer buffer
|
|
(derived-mode-p 'shell-mode)))
|
|
(buffer-list)))
|
|
|
|
(defun prot-window--get-new-shell-buffer ()
|
|
"Return buffer name for `shell' buffers."
|
|
(if-let* ((buffers (prot-window--get-shell-buffers))
|
|
(buffers-length (length buffers))
|
|
((>= buffers-length 1)))
|
|
(format "*shell*<%s>" (1+ buffers-length))
|
|
"*shell*"))
|
|
|
|
;;;###autoload (autoload 'prot-window-shell "prot-window")
|
|
(prot-window-define-full-frame shell
|
|
(let ((name (prot-window--get-new-shell-buffer)))
|
|
(shell name)
|
|
(set-frame-name name)
|
|
(when-let* ((buffer (get-buffer name)))
|
|
(with-current-buffer buffer
|
|
(add-hook
|
|
'delete-frame-functions
|
|
(lambda (_)
|
|
;; FIXME 2023-09-09: Works for multiple frames (per
|
|
;; `make-frame-command'), but not if the buffer is in two
|
|
;; windows in the same frame.
|
|
(unless (> (safe-length (get-buffer-window-list buffer nil t)) 1)
|
|
(let ((kill-buffer-query-functions nil))
|
|
(kill-buffer buffer))))
|
|
nil
|
|
:local)))))
|
|
|
|
;;;###autoload (autoload 'prot-window-coach "prot-window")
|
|
(prot-window-define-full-frame coach
|
|
(let ((buffer (get-buffer-create "*scratch for coach*")))
|
|
(with-current-buffer buffer
|
|
(funcall initial-major-mode))
|
|
(display-buffer buffer)
|
|
(set-frame-name "Coach")))
|
|
|
|
;; REVIEW 2023-06-25: Does this merit a user option? I don't think I
|
|
;; will ever set it to the left. It feels awkward there.
|
|
(defun prot-window-scroll-bar-placement ()
|
|
"Control the placement of scroll bars."
|
|
(when scroll-bar-mode
|
|
(setq default-frame-scroll-bars 'right)
|
|
(set-scroll-bar-mode 'right)))
|
|
|
|
(add-hook 'scroll-bar-mode-hook #'prot-window-scroll-bar-placement)
|
|
|
|
(defun prot-window-no-minibuffer-scroll-bar (frame)
|
|
"Remove the minibuffer scroll bars from FRAME."
|
|
(set-window-scroll-bars (minibuffer-window frame) nil nil nil nil :persistent))
|
|
|
|
(add-hook 'after-make-frame-functions 'prot-window-no-minibuffer-scroll-bar)
|
|
|
|
;;;; Run commands in a popup frame (via emacsclient)
|
|
|
|
(defun prot-window-delete-popup-frame (&rest _)
|
|
"Kill selected selected frame if it has parameter `prot-window-popup-frame'.
|
|
Use this function via a hook."
|
|
(when (frame-parameter nil 'prot-window-popup-frame)
|
|
(delete-frame)))
|
|
|
|
(defmacro prot-window-define-with-popup-frame (command)
|
|
"Define function which calls COMMAND in a new frame.
|
|
Make the new frame have the `prot-window-popup-frame' parameter."
|
|
`(defun ,(intern (format "prot-window-popup-%s" command)) ()
|
|
,(format "Run `%s' in a popup frame with `prot-window-popup-frame' parameter.
|
|
Also see `prot-window-delete-popup-frame'." command)
|
|
(interactive)
|
|
(let ((frame (make-frame '((prot-window-popup-frame . t)))))
|
|
(select-frame frame)
|
|
(switch-to-buffer " prot-window-hidden-buffer-for-popup-frame")
|
|
(condition-case nil
|
|
(call-interactively ',command)
|
|
((quit error user-error)
|
|
(delete-frame frame))))))
|
|
|
|
(declare-function org-capture "org-capture" (&optional goto keys))
|
|
(defvar org-capture-after-finalize-hook)
|
|
|
|
;;;###autoload (autoload 'prot-window-popup-org-capture "prot-window")
|
|
(prot-window-define-with-popup-frame org-capture)
|
|
|
|
(declare-function tmr "tmr" (time &optional description acknowledgep))
|
|
(defvar tmr-timer-created-functions)
|
|
|
|
;;;###autoload (autoload 'prot-window-popup-tmr "prot-window")
|
|
(prot-window-define-with-popup-frame tmr)
|
|
|
|
(provide 'prot-window)
|
|
;;; prot-window.el ends here
|