add transpose-frame

This commit is contained in:
KemoNine 2022-04-23 17:36:30 -04:00
parent 19600905e5
commit d01f192e3b
6 changed files with 596 additions and 0 deletions

View File

@ -0,0 +1,59 @@
;;; transpose-frame-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "transpose-frame" "transpose-frame.el" (0 0
;;;;;; 0 0))
;;; Generated autoloads from transpose-frame.el
(autoload 'transpose-frame "transpose-frame" "\
Transpose windows arrangement at FRAME.
Omitting FRAME means currently selected frame.
\(fn &optional FRAME)" t nil)
(autoload 'flip-frame "transpose-frame" "\
Flip windows arrangement vertically at FRAME.
Omitting FRAME means currently selected frame.
\(fn &optional FRAME)" t nil)
(autoload 'flop-frame "transpose-frame" "\
Flop windows arrangement horizontally at FRAME.
Omitting FRAME means currently selected frame.
\(fn &optional FRAME)" t nil)
(autoload 'rotate-frame "transpose-frame" "\
Rotate windows arrangement 180 degrees at FRAME.
Omitting FRAME means currently selected frame.
\(fn &optional FRAME)" t nil)
(autoload 'rotate-frame-clockwise "transpose-frame" "\
Rotate windows arrangement 90 degrees clockwise at FRAME.
Omitting FRAME means currently selected frame.
\(fn &optional FRAME)" t nil)
(autoload 'rotate-frame-anticlockwise "transpose-frame" "\
Rotate windows arrangement 90 degrees anti-clockwise at FRAME.
Omitting FRAME means currently selected frame.
\(fn &optional FRAME)" t nil)
(register-definition-prefixes "transpose-frame" '("transpose-frame-"))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; transpose-frame-autoloads.el ends here

View File

@ -0,0 +1,2 @@
;;; Generated package description from transpose-frame.el -*- no-byte-compile: t -*-
(define-package "transpose-frame" "20200307.2119" "Transpose windows arrangement in a frame" 'nil :commit "12e523d70ff78cc8868097b56120848befab5dbc" :authors '(("S. Irie")) :maintainer '("S. Irie") :keywords '("window"))

View File

@ -0,0 +1,237 @@
;;; transpose-frame.el --- Transpose windows arrangement in a frame
;; Copyright (c) 2011 S. Irie
;; Author: S. Irie
;; Keywords: window
;; Package-Version: 20200307.2119
;; Package-Commit: 12e523d70ff78cc8868097b56120848befab5dbc
;; This program is free software.
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;; Commentary:
;; This program provides some interactive functions which allows users
;; to transpose windows arrangement in currently selected frame:
;;
;; `transpose-frame' ... Swap x-direction and y-direction
;;
;; +------------+------------+ +----------------+--------+
;; | | B | | A | |
;; | A +------------+ | | |
;; | | C | => +--------+-------+ D |
;; +------------+------------+ | B | C | |
;; | D | | | | |
;; +-------------------------+ +--------+-------+--------+
;;
;; `flip-frame' ... Flip vertically
;;
;; +------------+------------+ +------------+------------+
;; | | B | | D |
;; | A +------------+ +------------+------------+
;; | | C | => | | C |
;; +------------+------------+ | A +------------+
;; | D | | | B |
;; +-------------------------+ +------------+------------+
;;
;; `flop-frame' ... Flop horizontally
;;
;; +------------+------------+ +------------+------------+
;; | | B | | B | |
;; | A +------------+ +------------+ A |
;; | | C | => | C | |
;; +------------+------------+ +------------+------------+
;; | D | | D |
;; +-------------------------+ +-------------------------+
;;
;; `rotate-frame' ... Rotate 180 degrees
;;
;; +------------+------------+ +-------------------------+
;; | | B | | D |
;; | A +------------+ +------------+------------+
;; | | C | => | C | |
;; +------------+------------+ +------------+ A |
;; | D | | B | |
;; +-------------------------+ +------------+------------+
;;
;; `rotate-frame-clockwise' ... Rotate 90 degrees clockwise
;;
;; +------------+------------+ +-------+-----------------+
;; | | B | | | A |
;; | A +------------+ | | |
;; | | C | => | D +--------+--------+
;; +------------+------------+ | | B | C |
;; | D | | | | |
;; +-------------------------+ +-------+--------+--------+
;;
;; `rotate-frame-anticlockwise' ... Rotate 90 degrees anti-clockwise
;;
;; +------------+------------+ +--------+--------+-------+
;; | | B | | B | C | |
;; | A +------------+ | | | |
;; | | C | => +--------+--------+ D |
;; +------------+------------+ | A | |
;; | D | | | |
;; +-------------------------+ +-----------------+-------+
;;
;; This program is tested on GNU Emacs 22, 23.
;;; Code:
;;; Internal functions
(defun transpose-frame-get-arrangement (&optional frame subtree)
(let ((tree (or subtree
(car (window-tree frame)))))
(if (windowp tree)
(list (window-buffer tree)
(window-start tree)
(window-point tree)
(window-hscroll tree)
(window-margins tree)
(window-fringes tree)
(window-dedicated-p tree)
(window-redisplay-end-trigger tree)
tree
(eq tree (frame-selected-window frame)))
(let* ((vertical (car tree))
(edges (cadr tree))
(length (float (if vertical
(- (nth 3 edges) (cadr edges))
(- (nth 2 edges) (car edges))))))
(cons vertical
(mapcar (lambda (subtree)
(cons (transpose-frame-get-arrangement frame subtree)
(/ (let ((edges (if (windowp subtree)
(window-edges subtree)
(cadr subtree))))
(if vertical
(- (nth 3 edges) (cadr edges))
(- (nth 2 edges) (car edges))))
length)))
(cddr tree)))))))
(defun transpose-frame-set-arrangement (config &optional window-or-frame &rest how)
(let ((window (if (windowp window-or-frame)
window-or-frame
(frame-selected-window window-or-frame))))
(unless (windowp window-or-frame)
(delete-other-windows window))
(if (bufferp (car config))
(let ((buffer (pop config)))
(set-window-buffer window buffer)
(set-window-start window (pop config))
(set-window-point window (pop config))
(set-window-hscroll window (pop config))
(set-window-margins window (caar config) (cdr (pop config)))
(apply 'set-window-fringes window (pop config))
(set-window-dedicated-p window (pop config))
(set-window-redisplay-end-trigger window (pop config))
(let* ((orig-window (pop config))
(ol-func (lambda (ol)
(when (eq (overlay-get ol 'window) orig-window)
(overlay-put ol 'window window))))
(ol-lists (with-current-buffer buffer
(overlay-lists))))
(mapc ol-func (car ol-lists))
(mapc ol-func (cdr ol-lists)))
(if (car config) (select-window window)))
(let* ((horizontal (if (memq 'transpose how)
(pop config)
(not (pop config))))
(edges (window-edges window))
(length (if horizontal
(- (nth 2 edges) (car edges))
(- (nth 3 edges) (cadr edges)))))
(if (memq (if horizontal 'flop 'flip) how)
(setq config (reverse config)))
(while (cdr config)
(setq window (prog1
(split-window window (round (* length (cdar config)))
horizontal)
(apply 'transpose-frame-set-arrangement
(caar config) window how))
config (cdr config)))
(apply 'transpose-frame-set-arrangement
(caar config) window how)))))
;;; User commands
;;;###autoload
(defun transpose-frame (&optional frame)
"Transpose windows arrangement at FRAME.
Omitting FRAME means currently selected frame."
(interactive)
(transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame
'transpose)
(when (called-interactively-p 'any) (recenter)))
;;;###autoload
(defun flip-frame (&optional frame)
"Flip windows arrangement vertically at FRAME.
Omitting FRAME means currently selected frame."
(interactive)
(transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame
'flip))
;;;###autoload
(defun flop-frame (&optional frame)
"Flop windows arrangement horizontally at FRAME.
Omitting FRAME means currently selected frame."
(interactive)
(transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame
'flop))
;;;###autoload
(defun rotate-frame (&optional frame)
"Rotate windows arrangement 180 degrees at FRAME.
Omitting FRAME means currently selected frame."
(interactive)
(transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame
'flip 'flop))
;;;###autoload
(defun rotate-frame-clockwise (&optional frame)
"Rotate windows arrangement 90 degrees clockwise at FRAME.
Omitting FRAME means currently selected frame."
(interactive)
(transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame
'transpose 'flop)
(when (called-interactively-p 'any) (recenter)))
;;;###autoload
(defun rotate-frame-anticlockwise (&optional frame)
"Rotate windows arrangement 90 degrees anti-clockwise at FRAME.
Omitting FRAME means currently selected frame."
(interactive)
(transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame
'transpose 'flip)
(when (called-interactively-p 'any) (recenter)))
;;; _
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
(provide 'transpose-frame)
;;; transpose-frame.el ends here

View File

@ -0,0 +1,59 @@
;;; transpose-frame-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "transpose-frame" "transpose-frame.el" (0 0
;;;;;; 0 0))
;;; Generated autoloads from transpose-frame.el
(autoload 'transpose-frame "transpose-frame" "\
Transpose windows arrangement at FRAME.
Omitting FRAME means currently selected frame.
\(fn &optional FRAME)" t nil)
(autoload 'flip-frame "transpose-frame" "\
Flip windows arrangement vertically at FRAME.
Omitting FRAME means currently selected frame.
\(fn &optional FRAME)" t nil)
(autoload 'flop-frame "transpose-frame" "\
Flop windows arrangement horizontally at FRAME.
Omitting FRAME means currently selected frame.
\(fn &optional FRAME)" t nil)
(autoload 'rotate-frame "transpose-frame" "\
Rotate windows arrangement 180 degrees at FRAME.
Omitting FRAME means currently selected frame.
\(fn &optional FRAME)" t nil)
(autoload 'rotate-frame-clockwise "transpose-frame" "\
Rotate windows arrangement 90 degrees clockwise at FRAME.
Omitting FRAME means currently selected frame.
\(fn &optional FRAME)" t nil)
(autoload 'rotate-frame-anticlockwise "transpose-frame" "\
Rotate windows arrangement 90 degrees anti-clockwise at FRAME.
Omitting FRAME means currently selected frame.
\(fn &optional FRAME)" t nil)
(register-definition-prefixes "transpose-frame" '("transpose-frame-"))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; transpose-frame-autoloads.el ends here

View File

@ -0,0 +1,2 @@
;;; Generated package description from transpose-frame.el -*- no-byte-compile: t -*-
(define-package "transpose-frame" "20200307.2119" "Transpose windows arrangement in a frame" 'nil :commit "12e523d70ff78cc8868097b56120848befab5dbc" :authors '(("S. Irie")) :maintainer '("S. Irie") :keywords '("window"))

View File

@ -0,0 +1,237 @@
;;; transpose-frame.el --- Transpose windows arrangement in a frame
;; Copyright (c) 2011 S. Irie
;; Author: S. Irie
;; Keywords: window
;; Package-Version: 20200307.2119
;; Package-Commit: 12e523d70ff78cc8868097b56120848befab5dbc
;; This program is free software.
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;; Commentary:
;; This program provides some interactive functions which allows users
;; to transpose windows arrangement in currently selected frame:
;;
;; `transpose-frame' ... Swap x-direction and y-direction
;;
;; +------------+------------+ +----------------+--------+
;; | | B | | A | |
;; | A +------------+ | | |
;; | | C | => +--------+-------+ D |
;; +------------+------------+ | B | C | |
;; | D | | | | |
;; +-------------------------+ +--------+-------+--------+
;;
;; `flip-frame' ... Flip vertically
;;
;; +------------+------------+ +------------+------------+
;; | | B | | D |
;; | A +------------+ +------------+------------+
;; | | C | => | | C |
;; +------------+------------+ | A +------------+
;; | D | | | B |
;; +-------------------------+ +------------+------------+
;;
;; `flop-frame' ... Flop horizontally
;;
;; +------------+------------+ +------------+------------+
;; | | B | | B | |
;; | A +------------+ +------------+ A |
;; | | C | => | C | |
;; +------------+------------+ +------------+------------+
;; | D | | D |
;; +-------------------------+ +-------------------------+
;;
;; `rotate-frame' ... Rotate 180 degrees
;;
;; +------------+------------+ +-------------------------+
;; | | B | | D |
;; | A +------------+ +------------+------------+
;; | | C | => | C | |
;; +------------+------------+ +------------+ A |
;; | D | | B | |
;; +-------------------------+ +------------+------------+
;;
;; `rotate-frame-clockwise' ... Rotate 90 degrees clockwise
;;
;; +------------+------------+ +-------+-----------------+
;; | | B | | | A |
;; | A +------------+ | | |
;; | | C | => | D +--------+--------+
;; +------------+------------+ | | B | C |
;; | D | | | | |
;; +-------------------------+ +-------+--------+--------+
;;
;; `rotate-frame-anticlockwise' ... Rotate 90 degrees anti-clockwise
;;
;; +------------+------------+ +--------+--------+-------+
;; | | B | | B | C | |
;; | A +------------+ | | | |
;; | | C | => +--------+--------+ D |
;; +------------+------------+ | A | |
;; | D | | | |
;; +-------------------------+ +-----------------+-------+
;;
;; This program is tested on GNU Emacs 22, 23.
;;; Code:
;;; Internal functions
(defun transpose-frame-get-arrangement (&optional frame subtree)
(let ((tree (or subtree
(car (window-tree frame)))))
(if (windowp tree)
(list (window-buffer tree)
(window-start tree)
(window-point tree)
(window-hscroll tree)
(window-margins tree)
(window-fringes tree)
(window-dedicated-p tree)
(window-redisplay-end-trigger tree)
tree
(eq tree (frame-selected-window frame)))
(let* ((vertical (car tree))
(edges (cadr tree))
(length (float (if vertical
(- (nth 3 edges) (cadr edges))
(- (nth 2 edges) (car edges))))))
(cons vertical
(mapcar (lambda (subtree)
(cons (transpose-frame-get-arrangement frame subtree)
(/ (let ((edges (if (windowp subtree)
(window-edges subtree)
(cadr subtree))))
(if vertical
(- (nth 3 edges) (cadr edges))
(- (nth 2 edges) (car edges))))
length)))
(cddr tree)))))))
(defun transpose-frame-set-arrangement (config &optional window-or-frame &rest how)
(let ((window (if (windowp window-or-frame)
window-or-frame
(frame-selected-window window-or-frame))))
(unless (windowp window-or-frame)
(delete-other-windows window))
(if (bufferp (car config))
(let ((buffer (pop config)))
(set-window-buffer window buffer)
(set-window-start window (pop config))
(set-window-point window (pop config))
(set-window-hscroll window (pop config))
(set-window-margins window (caar config) (cdr (pop config)))
(apply 'set-window-fringes window (pop config))
(set-window-dedicated-p window (pop config))
(set-window-redisplay-end-trigger window (pop config))
(let* ((orig-window (pop config))
(ol-func (lambda (ol)
(when (eq (overlay-get ol 'window) orig-window)
(overlay-put ol 'window window))))
(ol-lists (with-current-buffer buffer
(overlay-lists))))
(mapc ol-func (car ol-lists))
(mapc ol-func (cdr ol-lists)))
(if (car config) (select-window window)))
(let* ((horizontal (if (memq 'transpose how)
(pop config)
(not (pop config))))
(edges (window-edges window))
(length (if horizontal
(- (nth 2 edges) (car edges))
(- (nth 3 edges) (cadr edges)))))
(if (memq (if horizontal 'flop 'flip) how)
(setq config (reverse config)))
(while (cdr config)
(setq window (prog1
(split-window window (round (* length (cdar config)))
horizontal)
(apply 'transpose-frame-set-arrangement
(caar config) window how))
config (cdr config)))
(apply 'transpose-frame-set-arrangement
(caar config) window how)))))
;;; User commands
;;;###autoload
(defun transpose-frame (&optional frame)
"Transpose windows arrangement at FRAME.
Omitting FRAME means currently selected frame."
(interactive)
(transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame
'transpose)
(when (called-interactively-p 'any) (recenter)))
;;;###autoload
(defun flip-frame (&optional frame)
"Flip windows arrangement vertically at FRAME.
Omitting FRAME means currently selected frame."
(interactive)
(transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame
'flip))
;;;###autoload
(defun flop-frame (&optional frame)
"Flop windows arrangement horizontally at FRAME.
Omitting FRAME means currently selected frame."
(interactive)
(transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame
'flop))
;;;###autoload
(defun rotate-frame (&optional frame)
"Rotate windows arrangement 180 degrees at FRAME.
Omitting FRAME means currently selected frame."
(interactive)
(transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame
'flip 'flop))
;;;###autoload
(defun rotate-frame-clockwise (&optional frame)
"Rotate windows arrangement 90 degrees clockwise at FRAME.
Omitting FRAME means currently selected frame."
(interactive)
(transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame
'transpose 'flop)
(when (called-interactively-p 'any) (recenter)))
;;;###autoload
(defun rotate-frame-anticlockwise (&optional frame)
"Rotate windows arrangement 90 degrees anti-clockwise at FRAME.
Omitting FRAME means currently selected frame."
(interactive)
(transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame
'transpose 'flip)
(when (called-interactively-p 'any) (recenter)))
;;; _
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
(provide 'transpose-frame)
;;; transpose-frame.el ends here