;;; window-x.el --- extended window commands  -*- lexical-binding: t; -*-

;; Copyright (C) 2025 Free Software Foundation, Inc.

;; Author: Pranshu Sharma <pranshu@bauherren.ovh>
;;         Martin Rudalics <rudalics@gmx.at>
;; 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 <https://www.gnu.org/licenses/>.

;;; 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-window-layout frame-or-window t))

(defun rotate-windows (&optional frame-or-window)
  "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