You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

242 lines
8.7 KiB

7 months ago
;;; pip-frame.el --- Display and manage a PIP frame -*- lexical-binding: t -*-
9 months ago
;; Copyright (C) 2022 Milan Zamazal <pdm@zamazal.org>
7 months ago
;; Author: Milan Zamazal <pdm@zamazal.org>
;; Version: 1
;; Package-Requires: ((emacs "25.1"))
7 months ago
;; Keywords: frames
;; URL: https://git.zamazal.org/pdm/pip-frame
9 months ago
;; COPYRIGHT NOTICE
;;
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
9 months ago
;; Display a floating Emacs frame with selected buffers.
;; Similar to PIP on screens. Probably most useful in EXWM.
;;
;; Use `M-x pip-frame-add-buffer' to create the frame and add
;; additional buffers to it and remove the buffers with
;; `M-x pip-frame-remove-buffer' or close the whole frame with
;; `M-x pip-frame-delete-frame'.
;;; Code:
(require 'cl-lib)
9 months ago
(defgroup pip-frame ()
"Display PIP frame."
:group 'frames)
9 months ago
(defcustom pip-frame-scale 4
"How many times to shrink the PIP frame relative to the display size."
:type 'number
:group 'pip-frame)
(defcustom pip-frame-font-scale 2
"How many times to reduce the font size in the PIP frame."
:type 'number
:group 'pip-frame)
(defcustom pip-frame-move-step 0.1
"Movement step relative to the display size in the given direction.
Usually, the value should be larger than 0 and much smaller than 1."
:type 'number
:group 'pip-frame)
(defcustom pip-frame-parameters
'((left . 0.9)
(top . 0.9)
(tab-bar-lines . 0)
(minibuffer . nil))
9 months ago
"Alist of frame parameters to use for the PIP frame.
The frame size is determined automatically using `pip-frame-scale'
custom option but it can be overriden here."
:type '(alist :key-type symbol :value-type sexp)
:group 'pip-frame)
(defcustom pip-frame-face-attributes '()
"Alist of face attributes to modify `default' face in the PIP frame."
:type '(alist :key-type symbol :value-type sexp)
:group 'pip-frame)
(defcustom pip-frame-temporary-buffer-seconds 10
"Number of seconds to keep a buffer displayed temporarily by default."
:type 'number
:group 'pip-frame)
9 months ago
(defvar pip-frame--name "PIP-frame")
(defun pip-frame--get-frame (&optional no-error)
(let ((frame (cl-find pip-frame--name (frame-list)
:key (lambda (f) (frame-parameter f 'name)))))
9 months ago
(or frame
(unless no-error
(error "No PIP frame")))))
(defun pip-frame--make-frame (buffer)
9 months ago
(let ((frame (make-frame `((name . ,pip-frame--name)
(unsplittable . t)
,@pip-frame-parameters
(width . ,(/ 1.0 pip-frame-scale))
(height . ,(/ 1.0 pip-frame-scale)))))
(frame-inhibit-implied-resize t)
(face-height (round (/ (face-attribute 'default :height) pip-frame-font-scale))))
(set-face-attribute 'default frame :height face-height)
(dolist (p pip-frame-face-attributes)
(set-face-attribute 'default frame (car p) (cdr p)))
(set-window-buffer (car (window-list frame)) buffer)
9 months ago
frame))
(defun pip-frame-delete-frame ()
"Delete the PIP frame."
9 months ago
(interactive)
(delete-frame (pip-frame--get-frame)))
(defun pip-frame--buffers ()
(mapcar #'window-buffer (window-list (pip-frame--get-frame))))
(defun pip-frame--add-additional-buffer (buffer temporary)
(let ((windows (window-list (pip-frame--get-frame))))
(unless (and temporary
(cl-find buffer windows :key #'window-buffer :test #'eq))
(let* ((sizes (mapcar (lambda (w)
(let ((width (window-body-width w t))
(height (window-body-height w t)))
(cons (+ (* width width) (* height height))
w)))
windows))
(largest (cdr (cl-first (cl-sort sizes #'> :key #'car))))
(side (if (> (window-body-width largest t)
(* 2 (window-body-height largest t)))
'right
'below))
(new-window (split-window largest nil side)))
(set-window-buffer new-window buffer)))))
(defvar pip-frame--buffer-timers '())
(defun pip-frame--make-buffer-temporary (buffer seconds)
(when (eq seconds t)
(setq seconds pip-frame-temporary-buffer-seconds))
(let ((timer (run-with-timer seconds nil #'pip-frame-remove-buffer buffer)))
(setq pip-frame--buffer-timers (cons (cons buffer timer)
pip-frame--buffer-timers))))
(defun pip-frame--delete-buffer-timer (buffer)
(let ((timer (alist-get buffer pip-frame--buffer-timers)))
(when timer
(cancel-timer timer)
(setq pip-frame--buffer-timers
(assq-delete-all buffer pip-frame--buffer-timers)))))
9 months ago
;;;###autoload
(defun pip-frame-add-buffer (&optional buffer-or-name temporary)
"Add a buffer to the PIP frame.
If there is no PIP frame then create one.
If BUFFER-OR-NAME is specified, add the given buffer to the frame,
otherwise add the current buffer.
If TEMPORARY is given, display the buffer in the PIP frame for that
many seconds and then remove it from the frame. If t, display it for
`pip-frame-temporary-buffer-seconds'.
A buffer can be added and displayed multiple times in the frame. If
TEMPORARY is non-nil, the buffer is not displayed again if it is
already present."
9 months ago
(interactive)
(let ((frame (pip-frame--get-frame t))
(buffer (get-buffer (or buffer-or-name (current-buffer)))))
9 months ago
(if frame
(progn
(when temporary
(pip-frame--delete-buffer-timer buffer))
(pip-frame--add-additional-buffer buffer temporary))
(pip-frame--make-frame buffer))
(when temporary
(pip-frame--make-buffer-temporary buffer temporary))))
(defun pip-frame-remove-buffer (buffer-or-name)
"Remove buffer named BUFFER-OR-NAME from the PIP frame.
If it is the last buffer in the PIP frame, delete the frame.
If the buffer is not present in the PIP frame, do nothing."
9 months ago
(interactive (list (completing-read "Remove PIP buffer: "
(mapcar #'buffer-name (pip-frame--buffers))
nil t)))
(if-let ((frame (pip-frame--get-frame t))
(windows (window-list frame))
(buffer (get-buffer buffer-or-name))
(windows-to-delete (cl-remove buffer windows
:key #'window-buffer
:test-not #'eq)))
(if (= (length windows-to-delete) (length windows))
(pip-frame-delete-frame)
(seq-do #'delete-window windows-to-delete))))
9 months ago
(defun pip-frame--move (x y)
(let ((frame (pip-frame--get-frame)))
(set-frame-parameter frame 'left (+ (frame-parameter frame 'left) x))
(set-frame-parameter frame 'top (+ (frame-parameter frame 'top) y))))
(defun pip-frame--move-step (vertical)
(if (integerp pip-frame-move-step)
pip-frame-move-step
(let ((workarea (cdr (assoc 'workarea (cl-first (display-monitor-attributes-list))))))
(round (* pip-frame-move-step (nth (if vertical 3 2) workarea))))))
(defun pip-frame-move-left ()
"Move the PIP frame left."
9 months ago
(interactive)
(pip-frame--move (- (pip-frame--move-step nil)) 0))
(defun pip-frame-move-right ()
"Move the PIP frame right."
9 months ago
(interactive)
(pip-frame--move (pip-frame--move-step nil) 0))
(defun pip-frame-move-up ()
"Move the PIP frame up."
9 months ago
(interactive)
(pip-frame--move 0 (- (pip-frame--move-step t))))
(defun pip-frame-move-down ()
"Move the PIP frame down."
9 months ago
(interactive)
(pip-frame--move 0 (pip-frame--move-step t)))
(defvar pip-frame-move-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "<left>") 'pip-frame-move-left)
(define-key map (kbd "<right>") 'pip-frame-move-right)
(define-key map (kbd "<up>") 'pip-frame-move-up)
(define-key map (kbd "<down>") 'pip-frame-move-down)
map))
(defun pip-frame-move ()
"Move PIP frame interactively.
Use arrow keys to move the frame around.
Any other key stops this command and executes its own command."
9 months ago
(interactive)
(message "Use arrow keys to move the frame, any other key to quit")
(set-transient-map pip-frame-move-map t))
(provide 'pip-frame)
;; Local Variables:
;; checkdoc-force-docstrings-flag: nil
;; End:
;;; pip-frame.el ends here