2021-04-26 07:53:20 -04:00
|
|
|
|
#| -*-Scheme-*-
|
|
|
|
|
|
|
|
|
|
Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
|
|
|
|
|
1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
|
|
|
|
|
2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
|
|
|
|
|
2017, 2018, 2019, 2020 Massachusetts Institute of Technology
|
|
|
|
|
|
|
|
|
|
This file is part of MIT/GNU Scheme.
|
|
|
|
|
|
|
|
|
|
MIT/GNU Scheme 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 2 of the License, or (at
|
|
|
|
|
your option) any later version.
|
|
|
|
|
|
|
|
|
|
MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software
|
|
|
|
|
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
|
|
|
|
|
USA.
|
|
|
|
|
|
|
|
|
|
|#
|
|
|
|
|
|
|
|
|
|
;;;; Combination Windows
|
|
|
|
|
|
2021-04-26 07:57:47 -04:00
|
|
|
|
|
2021-04-26 07:53:20 -04:00
|
|
|
|
|
|
|
|
|
;;; Combination windows are used to split a window into vertically or
|
|
|
|
|
;;; horizontally divided areas. That window's initial superior must
|
|
|
|
|
;;; support the :NEW-ROOT-WINDOW! operation, but is otherwise not
|
|
|
|
|
;;; constrained.
|
|
|
|
|
|
|
|
|
|
;;; (==> WINDOW :NEW-ROOT-WINDOW! WINDOW*)
|
|
|
|
|
|
|
|
|
|
;;; This is called whenever the root is changed. It need not do
|
|
|
|
|
;;; anything at all, but it is useful to keep track of the root.
|
|
|
|
|
|
|
|
|
|
;;; What happens is that the initial window may be split horizontally
|
|
|
|
|
;;; or vertically, as many times as desired. The combination windows
|
|
|
|
|
;;; organize those splits into a tree. The leaves of the tree are not
|
|
|
|
|
;;; combination windows, but are created from one of the other leaves
|
|
|
|
|
;;; by the :MAKE-LEAF operation. Of course, the initial window is a
|
|
|
|
|
;;; leaf window too.
|
|
|
|
|
|
|
|
|
|
;;; If there is just one leaf window in the tree, then it is the root
|
|
|
|
|
;;; window also. Otherwise, the root is a combination window.
|
|
|
|
|
|
|
|
|
|
;;; The leaf windows must be subclasses of COMBINATION-LEAF-WINDOW,
|
|
|
|
|
;;; and they must support these operations:
|
|
|
|
|
|
|
|
|
|
;;; (==> WINDOW :MAKE-LEAF)
|
|
|
|
|
|
|
|
|
|
;;; Make a new leaf which can be placed next to WINDOW. For example,
|
|
|
|
|
;;; if WINDOW is a buffer window, the new window should also be a
|
|
|
|
|
;;; buffer window, visiting the same buffer, and sharing the same
|
|
|
|
|
;;; superior.
|
|
|
|
|
|
|
|
|
|
;;; (==> WINDOW :MINIMUM-X-SIZE)
|
|
|
|
|
;;; (==> WINDOW :MINIMUM-Y-SIZE)
|
|
|
|
|
|
|
|
|
|
;;; These define how small the window is allowed to be. Since the
|
|
|
|
|
;;; combination window operations change the sizes of leaf windows,
|
|
|
|
|
;;; they need some idea of how small the leaves are allowed to get.
|
|
|
|
|
;;; So, no window will ever be set to a size that is below its minimum
|
|
|
|
|
;;; -- it will be deleted from the heirarchy instead.
|
|
|
|
|
|
|
|
|
|
;;; The values of these operations may depend on the window's position
|
|
|
|
|
;;; in the heirarchy, i.e. the SUPERIOR, NEXT-WINDOW, and
|
|
|
|
|
;;; PREVIOUS-WINDOW. These are carefully arranged in the target
|
|
|
|
|
;;; configuration before the operations are invoked. This is intended
|
|
|
|
|
;;; to allow the leaves to have different minimums when there are
|
|
|
|
|
;;; optional borders which depend on their placement.
|
|
|
|
|
|
|
|
|
|
;;; Under no circumstances should the :MINIMUM-SIZE depend on the
|
|
|
|
|
;;; current size of a leaf window.
|
|
|
|
|
|
|
|
|
|
(define-class combination-leaf-window vanilla-window
|
|
|
|
|
(next-window previous-window))
|
|
|
|
|
|
|
|
|
|
(define-integrable (window-next window)
|
|
|
|
|
(with-instance-variables combination-leaf-window window ()
|
|
|
|
|
next-window))
|
|
|
|
|
|
|
|
|
|
(define-integrable (set-window-next! window window*)
|
|
|
|
|
(with-instance-variables combination-leaf-window window (window*)
|
|
|
|
|
(set! next-window window*)))
|
|
|
|
|
|
|
|
|
|
(define-integrable (window-previous window)
|
|
|
|
|
(with-instance-variables combination-leaf-window window ()
|
|
|
|
|
previous-window))
|
|
|
|
|
|
|
|
|
|
(define-integrable (set-window-previous! window window*)
|
|
|
|
|
(with-instance-variables combination-leaf-window window (window*)
|
|
|
|
|
(set! previous-window window*)))
|
|
|
|
|
|
|
|
|
|
(define (link-windows! previous next)
|
|
|
|
|
(set-window-previous! next previous)
|
|
|
|
|
(set-window-next! previous next))
|
|
|
|
|
|
|
|
|
|
(define-class combination-window combination-leaf-window
|
|
|
|
|
(vertical? child))
|
|
|
|
|
|
|
|
|
|
(define-integrable (combination-vertical? window)
|
|
|
|
|
(with-instance-variables combination-window window ()
|
|
|
|
|
vertical?))
|
|
|
|
|
|
|
|
|
|
(define-integrable (set-combination-vertical! window v)
|
|
|
|
|
(with-instance-variables combination-window window (v)
|
|
|
|
|
(set! vertical? v)))
|
|
|
|
|
|
|
|
|
|
(define-integrable (combination-child window)
|
|
|
|
|
(with-instance-variables combination-window window ()
|
|
|
|
|
child))
|
|
|
|
|
|
|
|
|
|
(define (set-combination-child! window window*)
|
|
|
|
|
(with-instance-variables combination-window window (window*)
|
|
|
|
|
(set! child window*)
|
|
|
|
|
(set-window-previous! window* false)))
|
|
|
|
|
|
|
|
|
|
(define-integrable (combination? window)
|
|
|
|
|
(object-of-class? combination-window window))
|
|
|
|
|
|
|
|
|
|
(define-integrable (leaf? window)
|
|
|
|
|
(and (object? window)
|
|
|
|
|
(subclass? (object-class window) combination-leaf-window)
|
|
|
|
|
(not (eq? (object-class window) combination-window))))
|
|
|
|
|
|
|
|
|
|
(define-integrable (check-leaf-window window name)
|
|
|
|
|
(if (not (leaf? window))
|
|
|
|
|
(error:wrong-type-argument window "window" name)))
|
|
|
|
|
|
|
|
|
|
;;;; Leaf Ordering
|
|
|
|
|
|
|
|
|
|
(define (window+ leaf n)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW+)
|
|
|
|
|
(cond ((positive? n) (%window+ leaf n))
|
|
|
|
|
((negative? n) (%window- leaf (- n)))
|
|
|
|
|
(else leaf)))
|
|
|
|
|
|
|
|
|
|
(define (window- leaf n)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-)
|
|
|
|
|
(cond ((positive? n) (%window- leaf n))
|
|
|
|
|
((negative? n) (%window+ leaf (- n)))
|
|
|
|
|
(else leaf)))
|
|
|
|
|
|
|
|
|
|
(define (%window+ leaf n)
|
|
|
|
|
(if (= n 1)
|
|
|
|
|
(%window1+ leaf)
|
|
|
|
|
(%window+ (%window1+ leaf) (-1+ n))))
|
|
|
|
|
|
|
|
|
|
(define (%window- leaf n)
|
|
|
|
|
(if (= n 1)
|
|
|
|
|
(%window-1+ leaf)
|
|
|
|
|
(%window- (%window-1+ leaf) (-1+ n))))
|
|
|
|
|
|
|
|
|
|
(define (window1+ leaf)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW1+)
|
|
|
|
|
(%window1+ leaf))
|
|
|
|
|
|
|
|
|
|
(define (window-1+ leaf)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-1+)
|
|
|
|
|
(%window-1+ leaf))
|
|
|
|
|
|
|
|
|
|
(define (window0 window)
|
|
|
|
|
(if (not (and (object? window)
|
|
|
|
|
(subclass? (object-class window) combination-leaf-window)))
|
|
|
|
|
(error:wrong-type-argument window "window" 'WINDOW0))
|
|
|
|
|
(window-leftmost-leaf (window-root window)))
|
|
|
|
|
|
|
|
|
|
(define (%window1+ leaf)
|
|
|
|
|
(window-leftmost-leaf
|
|
|
|
|
(or (window-next leaf)
|
|
|
|
|
(if (combination? (window-superior leaf))
|
|
|
|
|
(find-window-with-next (window-superior leaf))
|
|
|
|
|
leaf))))
|
|
|
|
|
|
|
|
|
|
(define (%window-1+ leaf)
|
|
|
|
|
(window-rightmost-leaf
|
|
|
|
|
(or (window-previous leaf)
|
|
|
|
|
(if (combination? (window-superior leaf))
|
|
|
|
|
(find-window-with-previous (window-superior leaf))
|
|
|
|
|
leaf))))
|
|
|
|
|
|
|
|
|
|
(define (find-window-with-next combination)
|
|
|
|
|
(or (window-next combination)
|
|
|
|
|
(if (combination? (window-superior combination))
|
|
|
|
|
(find-window-with-next (window-superior combination))
|
|
|
|
|
combination)))
|
|
|
|
|
|
|
|
|
|
(define (find-window-with-previous combination)
|
|
|
|
|
(or (window-previous combination)
|
|
|
|
|
(if (combination? (window-superior combination))
|
|
|
|
|
(find-window-with-previous (window-superior combination))
|
|
|
|
|
combination)))
|
|
|
|
|
|
|
|
|
|
(define (window-first window)
|
|
|
|
|
(if (window-previous window)
|
|
|
|
|
(window-first (window-previous window))
|
|
|
|
|
window))
|
|
|
|
|
|
|
|
|
|
(define (window-last window)
|
|
|
|
|
(if (window-next window)
|
|
|
|
|
(window-last (window-next window))
|
|
|
|
|
window))
|
|
|
|
|
|
|
|
|
|
(define (window-root window)
|
|
|
|
|
(if (combination? (window-superior window))
|
|
|
|
|
(window-root (window-superior window))
|
|
|
|
|
window))
|
|
|
|
|
|
|
|
|
|
(define (window-leftmost-leaf window)
|
|
|
|
|
(if (combination? window)
|
|
|
|
|
(window-leftmost-leaf (combination-child window))
|
|
|
|
|
window))
|
|
|
|
|
|
|
|
|
|
(define (window-rightmost-leaf window)
|
|
|
|
|
(if (combination? window)
|
|
|
|
|
(window-rightmost-leaf (window-last (combination-child window)))
|
|
|
|
|
window))
|
|
|
|
|
|
|
|
|
|
(define (window-has-no-neighbors? leaf)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-HAS-NO-NEIGHBORS?)
|
|
|
|
|
(not (combination? (window-superior leaf))))
|
|
|
|
|
|
|
|
|
|
(define (window-has-horizontal-neighbor? leaf)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-HAS-HORIZONTAL-NEIGHBOR?)
|
|
|
|
|
(%window-has-horizontal-neighbor? leaf))
|
|
|
|
|
|
|
|
|
|
(define (%window-has-horizontal-neighbor? window)
|
|
|
|
|
(let ((superior (window-superior window)))
|
|
|
|
|
(and (combination? superior)
|
|
|
|
|
(or (not (combination-vertical? superior))
|
|
|
|
|
(%window-has-horizontal-neighbor? superior)))))
|
|
|
|
|
|
|
|
|
|
(define (window-has-vertical-neighbor? leaf)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-HAS-VERTICAL-NEIGHBOR?)
|
|
|
|
|
(%window-has-vertical-neighbor? leaf))
|
|
|
|
|
|
|
|
|
|
(define (%window-has-vertical-neighbor? window)
|
|
|
|
|
(let ((superior (window-superior window)))
|
|
|
|
|
(and (combination? superior)
|
|
|
|
|
(or (combination-vertical? superior)
|
|
|
|
|
(%window-has-vertical-neighbor? superior)))))
|
|
|
|
|
|
|
|
|
|
(define (window-has-right-neighbor? leaf)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-HAS-RIGHT-NEIGHBOR?)
|
|
|
|
|
(%window-has-right-neighbor? leaf))
|
|
|
|
|
|
|
|
|
|
(define (%window-has-right-neighbor? window)
|
|
|
|
|
(and (combination? (window-superior window))
|
|
|
|
|
(or (and (not (combination-vertical? (window-superior window)))
|
|
|
|
|
(window-next window))
|
|
|
|
|
(%window-has-right-neighbor? (window-superior window)))))
|
|
|
|
|
|
|
|
|
|
(define (window-has-left-neighbor? leaf)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-HAS-LEFT-NEIGHBOR?)
|
|
|
|
|
(%window-has-left-neighbor? leaf))
|
|
|
|
|
|
|
|
|
|
(define (%window-has-left-neighbor? window)
|
|
|
|
|
(and (combination? (window-superior window))
|
|
|
|
|
(or (and (not (combination-vertical? (window-superior window)))
|
|
|
|
|
(window-previous window))
|
|
|
|
|
(%window-has-left-neighbor? (window-superior window)))))
|
|
|
|
|
|
|
|
|
|
(define (window-has-up-neighbor? leaf)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-HAS-UP-NEIGHBOR?)
|
|
|
|
|
(%window-has-up-neighbor? leaf))
|
|
|
|
|
|
|
|
|
|
(define (%window-has-up-neighbor? window)
|
|
|
|
|
(and (combination? (window-superior window))
|
|
|
|
|
(or (and (combination-vertical? (window-superior window))
|
|
|
|
|
(window-previous window))
|
|
|
|
|
(%window-has-up-neighbor? (window-superior window)))))
|
|
|
|
|
|
|
|
|
|
(define (window-has-down-neighbor? leaf)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-HAS-DOWN-NEIGHBOR?)
|
|
|
|
|
(%window-has-down-neighbor? leaf))
|
|
|
|
|
|
|
|
|
|
(define (%window-has-down-neighbor? window)
|
|
|
|
|
(and (combination? (window-superior window))
|
|
|
|
|
(or (and (combination-vertical? (window-superior window))
|
|
|
|
|
(window-next window))
|
|
|
|
|
(%window-has-down-neighbor? (window-superior window)))))
|
|
|
|
|
|
|
|
|
|
;;;; Creation
|
|
|
|
|
|
|
|
|
|
(define (window-split-horizontally! leaf #!optional n)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-SPLIT-HORIZONTALLY!)
|
|
|
|
|
(without-interrupts
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let ((n
|
|
|
|
|
(if (or (default-object? n) (not n))
|
|
|
|
|
(quotient (window-x-size leaf) 2)
|
|
|
|
|
n))
|
|
|
|
|
(x (window-x-size leaf))
|
|
|
|
|
(y (window-y-size leaf)))
|
|
|
|
|
(let ((n* (- x n))
|
|
|
|
|
(new (allocate-leaf! leaf false)))
|
|
|
|
|
(let ((combination (window-superior leaf)))
|
|
|
|
|
(inferior-start (window-inferior combination leaf)
|
|
|
|
|
(lambda (x y)
|
|
|
|
|
(set-inferior-start! (window-inferior combination new)
|
|
|
|
|
(+ x n)
|
|
|
|
|
y))))
|
|
|
|
|
(if (or (< n (==> leaf :minimum-x-size))
|
|
|
|
|
(< n* (==> new :minimum-x-size)))
|
|
|
|
|
(begin
|
|
|
|
|
(deallocate-leaf! new)
|
|
|
|
|
false)
|
|
|
|
|
(begin
|
|
|
|
|
(==> leaf :set-x-size! n)
|
|
|
|
|
(==> new :set-size! n* y)
|
|
|
|
|
new)))))))
|
|
|
|
|
|
|
|
|
|
(define (window-split-vertically! leaf #!optional n)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-SPLIT-VERTICALLY!)
|
|
|
|
|
(without-interrupts
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let ((n
|
|
|
|
|
(if (or (default-object? n) (not n))
|
|
|
|
|
(quotient (window-y-size leaf) 2)
|
|
|
|
|
n))
|
|
|
|
|
(x (window-x-size leaf))
|
|
|
|
|
(y (window-y-size leaf)))
|
|
|
|
|
(let ((n* (- y n))
|
|
|
|
|
(new (allocate-leaf! leaf true)))
|
|
|
|
|
(let ((combination (window-superior leaf)))
|
|
|
|
|
(inferior-start (window-inferior combination leaf)
|
|
|
|
|
(lambda (x y)
|
|
|
|
|
(set-inferior-start! (window-inferior combination new)
|
|
|
|
|
x
|
|
|
|
|
(+ y n)))))
|
|
|
|
|
(if (or (< n (==> leaf :minimum-y-size))
|
|
|
|
|
(< n* (==> new :minimum-y-size)))
|
|
|
|
|
(begin
|
|
|
|
|
(deallocate-leaf! new)
|
|
|
|
|
false)
|
|
|
|
|
(begin
|
|
|
|
|
(==> leaf :set-y-size! n)
|
|
|
|
|
(==> new :set-size! x n*)
|
|
|
|
|
new)))))))
|
|
|
|
|
|
|
|
|
|
(define (allocate-leaf! leaf v)
|
|
|
|
|
(let ((superior (window-superior leaf)))
|
|
|
|
|
(if (or (not (combination? superior))
|
|
|
|
|
(not (eq? v (combination-vertical? superior))))
|
|
|
|
|
(let ((combination (==> superior :make-inferior combination-window)))
|
|
|
|
|
(==> superior :set-inferior-position! combination
|
|
|
|
|
(==> superior :inferior-position leaf))
|
|
|
|
|
(set-combination-vertical! combination v)
|
|
|
|
|
(window-replace! leaf combination)
|
|
|
|
|
(set-combination-child! combination leaf)
|
|
|
|
|
(set-window-next! leaf false)
|
|
|
|
|
(==> superior :delete-inferior! leaf)
|
|
|
|
|
(add-inferior! combination leaf)
|
|
|
|
|
(set-inferior-start! (window-inferior combination leaf) 0 0)
|
|
|
|
|
(set-window-size! combination
|
|
|
|
|
(window-x-size leaf)
|
|
|
|
|
(window-y-size leaf)))))
|
|
|
|
|
(let ((new (==> leaf :make-leaf)))
|
|
|
|
|
(set-window-next! new (window-next leaf))
|
|
|
|
|
(if (window-next leaf) (set-window-previous! (window-next leaf) new))
|
|
|
|
|
(link-windows! leaf new)
|
|
|
|
|
new))
|
|
|
|
|
|
|
|
|
|
(define (deallocate-leaf! leaf)
|
|
|
|
|
(unlink-leaf! leaf)
|
|
|
|
|
(maybe-delete-combination! (window-superior leaf)))
|
|
|
|
|
|
|
|
|
|
;;;; Deletion
|
|
|
|
|
|
|
|
|
|
(define (window-delete! leaf #!optional merge-into)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-DELETE!)
|
|
|
|
|
(if (window-live? leaf)
|
|
|
|
|
(let ((screen (window-screen leaf)))
|
|
|
|
|
(without-interrupts
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let ((superior (window-superior leaf))
|
|
|
|
|
(next (window-next leaf))
|
|
|
|
|
(previous (window-previous leaf))
|
|
|
|
|
(x-size (window-x-size leaf))
|
|
|
|
|
(y-size (window-y-size leaf)))
|
|
|
|
|
(if (not (combination? superior))
|
|
|
|
|
(editor-error "Window has no neighbors; can't delete"))
|
|
|
|
|
(let ((adjust-size!
|
|
|
|
|
(lambda (window)
|
|
|
|
|
(if (current-window? leaf)
|
|
|
|
|
(select-window
|
|
|
|
|
(let loop ((window window))
|
|
|
|
|
(if (combination? window)
|
|
|
|
|
(loop (combination-child window))
|
|
|
|
|
window))))
|
|
|
|
|
(unlink-leaf! leaf)
|
|
|
|
|
(if (combination-vertical? superior)
|
|
|
|
|
(==> window :set-y-size!
|
|
|
|
|
(+ (window-y-size window) y-size))
|
|
|
|
|
(==> window :set-x-size!
|
|
|
|
|
(+ (window-x-size window) x-size))))))
|
|
|
|
|
(let ((do-next
|
|
|
|
|
(lambda ()
|
|
|
|
|
(adjust-size! next)
|
|
|
|
|
(let ((inferior (window-inferior superior next)))
|
|
|
|
|
(if (combination-vertical? superior)
|
|
|
|
|
(set-inferior-y-start!
|
|
|
|
|
inferior
|
|
|
|
|
(- (inferior-y-start inferior) y-size))
|
|
|
|
|
(set-inferior-x-start!
|
|
|
|
|
inferior
|
|
|
|
|
(- (inferior-x-start inferior) x-size))))))
|
|
|
|
|
(do-previous
|
|
|
|
|
(lambda ()
|
|
|
|
|
(adjust-size! previous))))
|
|
|
|
|
(cond ((and (not (default-object? merge-into))
|
|
|
|
|
merge-into
|
|
|
|
|
(or (eq? merge-into next)
|
|
|
|
|
(eq? merge-into previous)))
|
|
|
|
|
(if (eq? merge-into next)
|
|
|
|
|
(do-next)
|
|
|
|
|
(do-previous)))
|
|
|
|
|
(next (do-next))
|
|
|
|
|
(previous (do-previous))
|
|
|
|
|
(else
|
|
|
|
|
(error "Combination with single child:" superior)))))
|
|
|
|
|
(maybe-delete-combination! superior))))
|
|
|
|
|
(maybe-deselect-buffer-layout screen))))
|
|
|
|
|
|
|
|
|
|
(define (unlink-leaf! leaf)
|
|
|
|
|
(let ((combination (window-superior leaf))
|
|
|
|
|
(next (window-next leaf))
|
|
|
|
|
(previous (window-previous leaf)))
|
|
|
|
|
(==> leaf :kill!)
|
|
|
|
|
(delete-inferior! combination leaf)
|
|
|
|
|
(if previous
|
|
|
|
|
(set-window-next! previous next)
|
|
|
|
|
(set-combination-child! combination next))
|
|
|
|
|
(if next
|
|
|
|
|
(set-window-previous! next previous))))
|
|
|
|
|
|
|
|
|
|
(define (maybe-delete-combination! combination)
|
|
|
|
|
(let ((child (combination-child combination)))
|
|
|
|
|
(if (not (window-next child))
|
|
|
|
|
(begin
|
|
|
|
|
(delete-inferior! combination child)
|
|
|
|
|
(==> (window-superior combination) :replace-inferior!
|
|
|
|
|
combination
|
|
|
|
|
child)
|
|
|
|
|
(window-replace! combination child)))))
|
|
|
|
|
|
|
|
|
|
(define (window-replace! old new)
|
|
|
|
|
(with-instance-variables combination-leaf-window old (new)
|
|
|
|
|
(cond ((not (combination? superior))
|
|
|
|
|
(==> superior :new-root-window! new))
|
|
|
|
|
((and (combination? new)
|
|
|
|
|
(eq? (combination-vertical? superior)
|
|
|
|
|
(combination-vertical? new)))
|
|
|
|
|
(let ((first (combination-child new)))
|
|
|
|
|
(inferior-start (window-inferior superior new)
|
|
|
|
|
(lambda (xs ys)
|
|
|
|
|
(define (loop window)
|
|
|
|
|
(add-inferior! superior window)
|
|
|
|
|
(inferior-start (window-inferior new window)
|
|
|
|
|
(lambda (x y)
|
|
|
|
|
(set-inferior-start! (window-inferior superior window)
|
|
|
|
|
(+ xs x)
|
|
|
|
|
(+ ys y))))
|
|
|
|
|
(if (window-next window)
|
|
|
|
|
(loop (window-next window))))
|
|
|
|
|
(delete-inferior! superior new)
|
|
|
|
|
(loop first)))
|
|
|
|
|
(if next-window
|
|
|
|
|
(link-windows! (window-last first) next-window))
|
|
|
|
|
(if previous-window
|
|
|
|
|
(link-windows! previous-window first)
|
|
|
|
|
(set-combination-child! superior first))))
|
|
|
|
|
(else
|
|
|
|
|
(if next-window
|
|
|
|
|
(link-windows! new next-window))
|
|
|
|
|
(if previous-window
|
|
|
|
|
(link-windows! previous-window new)
|
|
|
|
|
(set-combination-child! superior new))))))
|
|
|
|
|
|
|
|
|
|
;;;; Sizing
|
|
|
|
|
|
|
|
|
|
(define (window-grow! vertical? size min-size set-w-size! start set-start!
|
|
|
|
|
scale-combination-inferiors!)
|
|
|
|
|
(lambda (leaf delta)
|
|
|
|
|
(check-leaf-window leaf 'WINDOW-GROW!)
|
|
|
|
|
(without-interrupts
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let ((leaf
|
|
|
|
|
(let loop ((leaf leaf))
|
|
|
|
|
(let ((combination (window-superior leaf)))
|
|
|
|
|
(if (not (combination? combination))
|
|
|
|
|
(editor-error "Can't grow this window "
|
|
|
|
|
(if vertical?
|
|
|
|
|
"vertically"
|
|
|
|
|
"horizontally")))
|
|
|
|
|
(if (boolean=? vertical? (combination-vertical? combination))
|
|
|
|
|
leaf
|
|
|
|
|
(loop combination))))))
|
|
|
|
|
(let ((new-size (+ (size leaf) delta))
|
|
|
|
|
(combination (window-superior leaf))
|
|
|
|
|
(next (window-next leaf))
|
|
|
|
|
(previous (window-previous leaf)))
|
|
|
|
|
(if (> new-size (size combination))
|
|
|
|
|
(begin
|
|
|
|
|
(set! new-size (size combination))
|
|
|
|
|
(set! delta (- new-size (size leaf)))))
|
|
|
|
|
(cond ((< new-size (min-size leaf))
|
|
|
|
|
(window-delete! leaf))
|
|
|
|
|
((and next (>= (- (size next) delta) (min-size next)))
|
|
|
|
|
(let ((inferior (window-inferior combination next)))
|
|
|
|
|
(set-start! inferior (+ (start inferior) delta)))
|
|
|
|
|
(set-w-size! next (- (size next) delta))
|
|
|
|
|
(set-w-size! leaf new-size))
|
|
|
|
|
((and previous
|
|
|
|
|
(>= (- (size previous) delta) (min-size previous)))
|
|
|
|
|
(let ((inferior (window-inferior combination leaf)))
|
|
|
|
|
(set-start! inferior (- (start inferior) delta)))
|
|
|
|
|
(set-w-size! previous (- (size previous) delta))
|
|
|
|
|
(set-w-size! leaf new-size))
|
|
|
|
|
(else
|
|
|
|
|
(scale-combination-inferiors! combination
|
|
|
|
|
(- (size combination) new-size)
|
|
|
|
|
leaf)
|
|
|
|
|
;; Scaling may have deleted all other inferiors.
|
|
|
|
|
;; If so, leaf has replaced combination.
|
|
|
|
|
(set-w-size! leaf
|
|
|
|
|
(if (eq? combination (window-superior leaf))
|
|
|
|
|
new-size
|
|
|
|
|
(size combination)))))))))))
|
|
|
|
|
|
|
|
|
|
;;; (SCALE-COMBINATION-INFERIORS! COMBINATION NEW-ROOM EXCEPT)
|
|
|
|
|
|
|
|
|
|
;;; Change all of the inferiors of COMBINATION (except EXCEPT) to use
|
|
|
|
|
;;; NEW-ROOM's worth of space. EXCEPT, if given, should not be
|
|
|
|
|
;;; changed in size, but should be moved if its neighbors change. It
|
|
|
|
|
;;; is assumed that EXCEPT is given only for case where the
|
|
|
|
|
;;; combination's VERTICAL? flag is the same as V.
|
|
|
|
|
|
|
|
|
|
;;; General strategy:
|
|
|
|
|
|
|
|
|
|
;;; If the window is growing, we can simply change the sizes of the
|
|
|
|
|
;;; inferiors. However, if it is shrinking, we must be more careful
|
|
|
|
|
;;; because some or all of the inferiors can be deleted. So in that
|
|
|
|
|
;;; case, before any sizes are changed, we find those inferiors that
|
|
|
|
|
;;; will be deleted and delete them. If we delete all of the
|
|
|
|
|
;;; inferiors, then we are done: this window has also been deleted.
|
|
|
|
|
;;; Otherwise, we can then perform all of the changes, knowing that no
|
|
|
|
|
;;; window will grow too small.
|
|
|
|
|
|
|
|
|
|
(define (scale-combination-inferiors! v size min-size set-w-size! set-start!)
|
|
|
|
|
(lambda (combination new-room except)
|
|
|
|
|
(let ((kernel
|
|
|
|
|
(lambda (old-room collect-deletions change-inferiors)
|
|
|
|
|
(cond ((< old-room new-room)
|
|
|
|
|
(change-inferiors))
|
|
|
|
|
((> old-room new-room)
|
|
|
|
|
(for-each window-delete! (collect-deletions))
|
|
|
|
|
(if (not (null? (window-inferiors combination)))
|
|
|
|
|
(change-inferiors))))))
|
|
|
|
|
(child (combination-child combination))
|
|
|
|
|
(c-size (size combination)))
|
|
|
|
|
(if (not (eq? (combination-vertical? combination) v))
|
|
|
|
|
(kernel
|
|
|
|
|
c-size
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let loop ((window child))
|
|
|
|
|
(let ((deletions
|
|
|
|
|
(if (window-next window)
|
|
|
|
|
(loop (window-next window))
|
|
|
|
|
'())))
|
|
|
|
|
(if (< new-room (min-size window))
|
|
|
|
|
(cons window deletions)
|
|
|
|
|
deletions))))
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let loop ((window child))
|
|
|
|
|
(set-w-size! window new-room)
|
|
|
|
|
(if (window-next window)
|
|
|
|
|
(loop (window-next window))))))
|
|
|
|
|
(let ((old-room (if except (- c-size (size except)) c-size)))
|
|
|
|
|
(kernel
|
|
|
|
|
old-room
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let loop
|
|
|
|
|
((window child) (old-room old-room) (new-room new-room))
|
|
|
|
|
(cond ((eq? window except)
|
|
|
|
|
(if (window-next window)
|
|
|
|
|
(loop (window-next window) old-room new-room)
|
|
|
|
|
'()))
|
|
|
|
|
((not (window-next window))
|
|
|
|
|
(if (< new-room (min-size window))
|
|
|
|
|
(list window)
|
|
|
|
|
'()))
|
|
|
|
|
(else
|
|
|
|
|
(let* ((old-s (size window))
|
|
|
|
|
(new-s (quotient (* old-s new-room) old-room))
|
|
|
|
|
(deletions
|
|
|
|
|
(loop (window-next window)
|
|
|
|
|
(- old-room old-s)
|
|
|
|
|
(- new-room new-s))))
|
|
|
|
|
(if (< new-s (min-size window))
|
|
|
|
|
(cons window deletions)
|
|
|
|
|
deletions))))))
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let loop
|
|
|
|
|
((window child)
|
|
|
|
|
(start 0)
|
|
|
|
|
(old-room old-room)
|
|
|
|
|
(new-room new-room))
|
|
|
|
|
(set-start! (window-inferior combination window) start)
|
|
|
|
|
(cond ((eq? window except)
|
|
|
|
|
(if (window-next window)
|
|
|
|
|
(loop (window-next window)
|
|
|
|
|
start
|
|
|
|
|
old-room
|
|
|
|
|
new-room)))
|
|
|
|
|
((not (window-next window))
|
|
|
|
|
(set-w-size! window new-room))
|
|
|
|
|
(else
|
|
|
|
|
(let* ((old-s (size window))
|
|
|
|
|
(new-s (quotient (* old-s new-room) old-room)))
|
|
|
|
|
(set-w-size! window new-s)
|
|
|
|
|
(loop (window-next window)
|
|
|
|
|
(+ start new-s)
|
|
|
|
|
(- old-room old-s)
|
|
|
|
|
(- new-room new-s)))))))))))))
|
|
|
|
|
|
|
|
|
|
(define (window-min-x-size window)
|
|
|
|
|
(==> window :minimum-x-size))
|
|
|
|
|
|
|
|
|
|
(define (send-window-x-size! window x)
|
|
|
|
|
(==> window :set-x-size! x))
|
|
|
|
|
|
|
|
|
|
(define (window-min-y-size window)
|
|
|
|
|
(==> window :minimum-y-size))
|
|
|
|
|
|
|
|
|
|
(define (send-window-y-size! window y)
|
|
|
|
|
(==> window :set-y-size! y))
|
|
|
|
|
|
|
|
|
|
(define scale-combination-inferiors-x!
|
|
|
|
|
(scale-combination-inferiors! false window-x-size window-min-x-size
|
|
|
|
|
send-window-x-size! set-inferior-x-start!))
|
|
|
|
|
|
|
|
|
|
(define scale-combination-inferiors-y!
|
|
|
|
|
(scale-combination-inferiors! true window-y-size window-min-y-size
|
|
|
|
|
send-window-y-size! set-inferior-y-start!))
|
|
|
|
|
|
|
|
|
|
(define window-grow-horizontally!
|
|
|
|
|
(window-grow! false window-x-size window-min-x-size send-window-x-size!
|
|
|
|
|
inferior-x-start set-inferior-x-start!
|
|
|
|
|
scale-combination-inferiors-x!))
|
|
|
|
|
|
|
|
|
|
(define window-grow-vertically!
|
|
|
|
|
(window-grow! true window-y-size window-min-y-size send-window-y-size!
|
|
|
|
|
inferior-y-start set-inferior-y-start!
|
|
|
|
|
scale-combination-inferiors-y!))
|
|
|
|
|
|
|
|
|
|
(define-method combination-window (:minimum-x-size combination)
|
|
|
|
|
(==> (window-leftmost-leaf combination) :minimum-x-size))
|
|
|
|
|
|
|
|
|
|
(define-method combination-window (:minimum-y-size combination)
|
|
|
|
|
(==> (window-leftmost-leaf combination) :minimum-y-size))
|
|
|
|
|
|
|
|
|
|
(define (set-combination-x-size! combination x)
|
|
|
|
|
(scale-combination-inferiors-x! combination x false)
|
|
|
|
|
(set-window-x-size! combination x))
|
|
|
|
|
|
|
|
|
|
(define (set-combination-y-size! combination y)
|
|
|
|
|
(scale-combination-inferiors-y! combination y false)
|
|
|
|
|
(set-window-y-size! combination y))
|
|
|
|
|
|
|
|
|
|
(define (set-combination-size! combination x y)
|
|
|
|
|
(scale-combination-inferiors-x! combination x false)
|
|
|
|
|
(scale-combination-inferiors-y! combination y false)
|
|
|
|
|
(set-window-size! combination x y))
|
|
|
|
|
|
|
|
|
|
(define-method combination-window :set-x-size! set-combination-x-size!)
|
|
|
|
|
(define-method combination-window :set-y-size! set-combination-y-size!)
|
|
|
|
|
(define-method combination-window :set-size! set-combination-size!)
|
|
|
|
|
|
|
|
|
|
(define-method combination-window
|
|
|
|
|
(:leaf-containing-coordinates combination x y)
|
|
|
|
|
(inferior-containing-coordinates combination x y leaf?))
|
|
|
|
|
|
|
|
|
|
(define-method combination-leaf-window (:leaf-containing-coordinates leaf x y)
|
2021-04-26 07:57:47 -04:00
|
|
|
|
(values leaf x y))
|