From 5d8f4fd35512938ddc28714d1c41523681f55032 Mon Sep 17 00:00:00 2001 From: Pranshu Sharma Date: Fri, 10 Jan 2025 16:07:30 +0100 Subject: [PATCH] Add new file window-x.el * lisp/window-x.el: New file. * etc/NEWS: Mention new commands to modify window layout. (cherry picked from commit d1e6379d6ab6148b0c93369daf51f7d6b10a3c9a) --- etc/NEWS | 10 ++ lisp/window-x.el | 336 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 346 insertions(+) create mode 100644 lisp/window-x.el diff --git a/etc/NEWS b/etc/NEWS index 73b63e34be1..7b6ae8b7b78 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -64,6 +64,16 @@ expectations. ** Windows +*** New functions to modify window layout. +Several functions to modify the window layout have been added: +'rotate-window-layout-clockwise' +'rotate-window-layout-anticlockwise' +'flip-window-layout-vertically' +'flip-window-layout-horizontally' +'transpose-window-layout' +'rotate-windows' +'rotate-windows-back' + +++ *** New hook 'window-deletable-functions'. This abnormal hook gives its client a way to save a window from getting diff --git a/lisp/window-x.el b/lisp/window-x.el new file mode 100644 index 00000000000..d6c1851ddeb --- /dev/null +++ b/lisp/window-x.el @@ -0,0 +1,336 @@ +;;; window-x.el --- extended window commands -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; Author: Pranshu Sharma +;; Martin Rudalics +;; Maintainer: emacs-devel@gnu.org +;; Keywords: files +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; This file defines additional infrequently used window commands that +;; should not be in window.el to not make the dumped image bigger. + +;;; Code: + +(defun window-tree-normal-sizes (window &optional next) + "Return normal sizes of all windows rooted at WINDOW. +A list of the form (SPLIT-TYPE PARENT-WIN PARENT-WIN-HEIGHT +PARENT-WIN-WIDTH W1 W2 ...) is returned. SPLIT-TYPE is non-nil if +PARENT-WIN is split horizontally. PARENT-WIN is the internal window. +PARENT-WIN-HEIGHT and PARENT-WIN-WIDTH are the normal heights of +PARENT-WIN. Wn is a list of the form (WINDOW HEIGHT WIDTH) where HEIGHT +and WIDTH are the normal height and width of the window." + (let (list) + (while window + (setq list + (cons + (cond + ((window-top-child window) + (append + (list t window + (window-normal-size window nil) + (window-normal-size window t)) + (window-tree-normal-sizes (window-top-child window) t))) + ((window-left-child window) + (append + (list nil window + (window-normal-size window nil) + (window-normal-size window t)) + (window-tree-normal-sizes (window-left-child window) t))) + (t (list window + (window-normal-size window nil) + (window-normal-size window t)))) + list)) + (setq window (when next (window-next-sibling window)))) + (nreverse list))) + +(defun window--window-to-transpose (frame-or-window) + "Return the window to be acted upon by `window--transpose'. +If FRAME-OR-WINDOW is a window return FRAME-OR-WINDOW. If +FRAME-OR-WINDOW is a frame, return FRAME-OR-WINDOW's main window. If +FRAME-OR-WINDOW is nil, than the frames main window wil be returned. If +FRAME-OR-WINDOW is non-nil, and not a frame or a window or a number, +than the return value will be the parent window of the selected window." + (cond + ((windowp frame-or-window) + frame-or-window) + ((or (framep frame-or-window) (not frame-or-window)) + (window-main-window frame-or-window)) + (frame-or-window + (window-parent)))) + +(defun rotate-window-layout-anticlockwise (&optional frame-or-window) + "Rotate windows of FRAME-OR-WINDOW anticlockwise by 90 degrees. +Transform the layout of windows such that a window on top becomes a +window on the right, a window on the right moves to the bottom, a window +on the bottom moves to the left and a window on the left becomes one on +the top. + +If FRAME-OR-WINDOW is nil, rotate the main window of the selected +frame. If FRAME-OR-WINDOW specifies a live frame, rotate the main +window of that frame. If FRAME-OR-WINDOW specifies a parent window, +rotate that window. In any other case and interactively with a prefix +argument rotate the parent window of the selected window." + (interactive "P") + (let ((window (window--window-to-transpose frame-or-window))) + (window--transpose window '(right . above) nil))) + +(defun rotate-window-layout-clockwise (&optional frame-or-window) + "Rotate windows of FRAME-OR-WINDOW clockwise by 90 degrees. +Transform the layout of windows such that a window on top becomes a +window on the right, a window on the right moves to the bottom, a +window on the bottom moves to the left and a window on the left becomes +one on the top. + +If FRAME-OR-WINDOW is nil, rotate the main window of the selected frame. +If FRAME-OR-WINDOW specifies a live frame, rotate the main window of +that frame. If FRAME-OR-WINDOW specifies a parent window, rotate that +window. In any other case and interactively with a prefix argument +rotate the parent window of the selected window." + (interactive "P") + (let ((window (window--window-to-transpose frame-or-window))) + (window--transpose window '(left . below) nil))) + +(defun flip-window-layout-horizontally (&optional frame-or-window) + "Horizontally flip windows of FRAME-OR-WINDOW. +Flip the window layout so that the window on the right becomes the +window on the left, and vice-versa. + +If FRAME-OR-WINDOW is nil, flip the main window of the selected frame. +If FRAME-OR-WINDOW specifies a live frame, rotate the main window of +that frame. If FRAME-OR-WINDOW specifies a parent window, rotate that +window. In any other case and interactively with a prefix argument +rotate the parent window of the selected window." + (interactive "P") + (let ((window (window--window-to-transpose frame-or-window))) + (window--transpose window '(below . left) t))) + +(defun flip-window-layout-vertically (&optional frame-or-window) + "Verticlly flip windows of FRAME-OR-WINDOW. +Flip the window layout so that the top window becomes the bottom window +and vice-versa. + +If FRAME-OR-WINDOW is nil, flip the main window of the selected frame. +If FRAME-OR-WINDOW specifies a live frame, rotate the main window of +that frame. If FRAME-OR-WINDOW specifies a parent window, rotate that +window. In any other case and interactively with a prefix argument +rotate the parent window of the selected window." + (interactive "P") + (let ((window (window--window-to-transpose frame-or-window))) + (window--transpose window '(above . right) t))) + +(defun transpose-window-layout (&optional frame-or-window) + "Transpose windows of FRAME-OR-WINDOW. +Make the windows on FRAME-OR-WINDOW so that every horizontal split +becomes a vertical split, and vice versa. This is equivalent to +diagonally flipping. + +If FRAME-OR-WINDOW is nil, transpose the main window of the selected frame. +If FRAME-OR-WINDOW specifies a live frame, rotate the main window of +that frame. If FRAME-OR-WINDOW specifies a parent window, rotate that +window. In any other case and interactively with a prefix argument +rotate the parent window of the selected window." + (interactive "P") + (let ((window (window--window-to-transpose frame-or-window))) + (window--transpose window '(right . below) nil))) + +(defun window--depmap(fun ls) + "Map FUN across all nodes of list LS." + (if (consp ls) + (cons + (if (consp (car ls)) + (window--depmap fun (car ls)) + (funcall fun (car ls))) + (window--depmap fun (cdr ls))) + (funcall fun ls))) + +(defun rotate-windows-back(&optional frame-or-window) + "Move windows into locations of their predecessors in cyclic ordering. + +If FRAME-OR-WINDOW is nil, rotate the main window of the selected frame. +If FRAME-OR-WINDOW specifies a live frame, rotate the main window of +that frame. If FRAME-OR-WINDOW specifies a parent window, rotate that +window. In any other case and interactively with a prefix argument +rotate the parent window of the selected window." + (interactive "P") + (rotate-windows frame-or-window t)) + +(defun rotate-windows (&optional frame-or-window reverse) + "Move windows into locations of their forerunners in cyclic ordering. + +Else if FRAME-OR-WINDOW is nil, rotate the main window of the +selected frame. If FRAME-OR-WINDOW specifies a live frame, rotate the +main window of that frame. If FRAME-OR-WINDOW specifies a parent +window, rotate that window. In any other case and interactively with a +prefix argument rotate the parent window of the selected window." + (interactive "P") + (let ((window (window--window-to-transpose frame-or-window))) + (if (or (not window) + (window-live-p window)) + (message "No windows to transpose") + (let* ((frame (window-frame window)) + (selected-window (frame-selected-window window)) + (win-tree (car (window-tree-normal-sizes window))) + (winls (seq-filter 'window-live-p (flatten-list win-tree))) + (rotated-ls (if reverse + (append (cdr winls) (list (car winls))) + (append (last winls) winls))) + (other-window-arg (if reverse 1 -1)) + (first-window (car rotated-ls)) + (new-win-tree (window--depmap + (lambda (x) + (if (window-live-p x) + (pop rotated-ls) + x)) + win-tree))) + (if (or (seq-some 'window-atom-root winls) + (seq-some 'window-fixed-size-p winls)) + (message "This does not work with fixed size or atom windows.") + (progn + ;; All child windows need to be recursively deleted. + (delete-other-windows-internal first-window window) + ;; (delete-dups atom-windows) + (window--transpose-1 new-win-tree first-window '(below . right) t nil) + (set-frame-selected-window frame selected-window) + (other-window other-window-arg) + (while (not (memq (selected-window) winls)) + (other-window other-window-arg)))))))) + +(defun window--transpose (window conf no-resize) + "Rearrange windows of WINDOW recursively. +CONF should be a cons cell: (HORIZONTAL-SPLIT . VERTICAL-SPLIT) where +HORIZONTAL-SPLIT will be used as the third argument of `split-window' +when splitting a window that was previously horizontally split, and +VERTICAL-SPLIT as third argument of `split-window' for a window that was +previously vertically split. If NO-RESIZE is nil, the SIDE argument of +the window-split is converted from vertical to horizontal or vice versa, +with the same proportion of the total split." + (if (or (not window) + (window-live-p window)) + (message "No windows to transpose") + (let* ((frame (window-frame window)) + (first-window window) + (selected-window (frame-selected-window window)) + (win-tree (car (window-tree-normal-sizes window))) + (win-list (seq-filter 'window-live-p (flatten-list win-tree))) + (atom-windows + (remq nil (mapcar 'window-atom-root + win-list)))) + (if (and (not (eq (car atom-windows) window)) + (or no-resize + (and (not atom-windows) + (not (seq-some 'window-fixed-size-p win-list))))) + (progn + (delete-dups atom-windows) + (while (not (window-live-p first-window)) + (setq first-window (window-child first-window))) + (delete-other-windows-internal first-window window) + (window--transpose-1 win-tree first-window conf no-resize atom-windows) + ;; Go back to previously selected window. + (set-frame-selected-window frame selected-window) + (mapc 'window-make-atom atom-windows)) + (message "This does not work with fixed size or atom windows."))))) + +(defun window--transpose-1 (subtree cwin conf no-resize atom-windows) + "Subroutine of `window--transpose'. +SUBTREE must be in the format of the result of +`window-tree-normal-sizes'. CWIN is the current window through which +the window splits are made. ATOM-WINDOWS is a list of internal atom +windows. The CONF and NO-RESIZE arguments are the same as the +ones in `window--transpose'." + ;; `flen' is max size the window could be converted to the opposite + ;; of the given split type. + (let ((parent-window-is-set t) + (flen (if (funcall (if no-resize 'not 'identity) + (car subtree)) + (float (window-pixel-width cwin)) + (float (window-pixel-height cwin))))) + (mapc + (pcase-lambda (`(,window . ,size)) + (prog1 + (let* ((split-size (- (round (* flen size)))) + (split-type + (funcall (if (car subtree) 'car 'cdr) conf)) + (return-win + (if (listp window) + ;; `window' is a window subtree. + ;; `first-child' is a live window that is an descended of window + (let* ((first-child window) + ;; If the window being split is atomic + (is-atom + ;; cadr will return the internal parent window + (memq (cadr first-child) atom-windows))) + ;; (caar (cddddr first-child)) is the first window in the + ;; list if there is a live window. + (while (not (windowp (caar (cddddr first-child)))) + (setq first-child (car (cddddr first-child)))) + (window--transpose-1 + window + (let ((window-combination-limit parent-window-is-set)) + (split-window + cwin + split-size + split-type + t + (if window-combination-limit + (cons (caar (cddddr first-child)) (cadr subtree)) + (caar (cddddr first-child))))) + (if is-atom + '(nil . t) + conf) + no-resize + atom-windows)) + ;; `window' is a window. + (split-window + cwin + split-size + split-type t + ;; We need to set parent window if it hasn't been set + ;; already. + (if parent-window-is-set + (cons window (cadr subtree)) + window))))) + (when (eq window-combination-limit t) + (set-window-combination-limit (cadr subtree) nil)) + return-win) + (setq parent-window-is-set nil))) + (mapcar + (lambda (e) + (pcase-let* ((`(,window . ,window-size-info) + (if (windowp (car e)) + (cons (car e) e) + (cons e (cdr e))))) + (cons window + ;; The respective size of the window. + (if (car subtree) + (cadr window-size-info) + (caddr window-size-info))))) + ;; We need to ingore first 5 elements of window list, we ignore + ;; window split type, sizes and the first window (it's + ;; implicitly created). We just have a list of windows. + (nreverse (cdr (cddddr subtree))))) + ;; (caar (cddddr subtree)) is the first child window of subtree. + (unless (windowp (caar (cddddr subtree))) + (let ((is-atom (memq (cadr (cadr (cddddr subtree))) atom-windows))) + (window--transpose-1 (car (cddddr subtree)) cwin (if is-atom '(nil . t) conf) + no-resize atom-windows))))) + +;;; window-x.el ends here -- 2.39.5