[comp.emacs] More than you ever wanted to know about windows

maa@sei.cmu.edu (Mark Ardis) (11/12/87)

This may be overkill, but it is a good example of some of the functionality
of the Gnutest system.  Gnutest is a collection of functions to support the
testing of GNU Emacs packages.  Please consult comp.sources.unix archives,
or if you are unable to do that write to me, for the complete Gnutest system.

The "tst-capture-windows-state" function will return a complete description of
the state of windows.

;;; windows.el -- return the state of windows
;;;  This collection of functions was taken from the Gnutest system.
;;;  The Gnutest system was constructed at Wang Institute in the summer
;;;    of 1987.  This excerpt was written by Carl Lagoze and Franklin Davis.
;;;  The complete Gnutest system is available from comp.sources.unix and:
;;;    Mark Ardis, Software Engineering Institute, Carnegie Mellon University,
;;;    Pittsburgh, PA 15213, maa@sei.cmu.edu

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; some utilities

(defmacro cadr (l)
  (list 'car (list 'cdr l)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; windows

(defun tst-capture-windows-state ()
  "Return the state of emacs windows as a two element a-list.  The first
   element is the key 'windows.  The second element is a list 
   representation of the binary tree abstraction of the window state.  This
   tree is built by walking the windows (starting at the window positioned
   at 0,0) and doing a shift-reduce parse on the window-list.  This parse
   has two productions:
     0: reduce two windows to a combined window when their top/bottom
        edges are common.
     1: reduce two windows to a combined window when their right/left
        edges are common.
   The parser has three states:
     0: The start state.  The stack is empty
     1: 1 element on the stack
     2: >1 element on the stack"
  (let ((stack) (state) (cur-window))
    (message "Capturing state of windows...")
    (save-window-excursion
      (setq cur-window (selected-window))
      (while (not (equal '(0 0) ;go to the upper left window
                         (list (car (window-edges)) (cadr (window-edges)))))
        (select-window (next-window))
         )                              ;while
					;always shift first window
      (setq stack (tst-shift-window-stack stack cur-window))
      (setq state 1)                    ;state 1 when 1 element on stack
      ; At this point the base (0,0) window is on the stack and we are in
      ; state 1.  Loop until we return to the condition where the state is
      ; 1 and the next window is the base window (reduced to the final state)
      (while (not (and (equal '(0 0) 
                         (list
			  (car (window-edges (next-window)))
			  (cadr (window-edges (next-window)))
			  )
			 )
                       (= state 1)
		       ))
        (if (= state 1)             ;always shift
             (progn
               (select-window (next-window))
               (setq stack (tst-shift-window-stack stack cur-window))
               (setq state 2)
               )                        ;progn
          (progn                        ;state 2
            (if (equal
                 (tst-get-window-bottom-edge (cadr stack))
                 (tst-get-window-top-edge (car stack)))
                (progn                  ;reduce by v rule
                  (setq stack (tst-reduce-window-stack stack 'v))
                  (if (= 1 (length stack))
                      (progn
                        (setq state 1)
                        )               ;progn
                    )                   ;if
                  )                     ;progn
              (progn
                (if (equal
                     (tst-get-window-right-edge (cadr stack))
                     (tst-get-window-left-edge (car stack)))
                    (progn
                      (setq stack (tst-reduce-window-stack stack 'h))
                      (if (= 1 (length stack))
                          (progn
                            (setq state 1)
                            )           ;progn
                        )                       ;if
                      )
                  (progn
                    (select-window (next-window))
                    (setq stack (tst-shift-window-stack stack cur-window))
                    )                     ;progn
                  )                     ;if equal left and right edge
                )                       ;progn-else of if top and bottom equal
              )                         ;if equal top and bottom edge
            )                           ;progn - state 2
          )                             ;if equal state 1
        )                               ;while not accept state
      )                                 ;save window excursion
    (list 'windows (car stack))
    )                                   ;let
  )                                     ;defun tst-capture-windows-state
  
(defun tst-shift-window-stack (stack cur-window)
  "Perform a shift in the LR parse of the window configuration tree (i.e. put
   the state of the current window on top of the parse stack"
  (let ()
    (cons (tst-capture-window-state (selected-window) cur-window) stack)
    )                                   ;let
  )                                     ;shift-window-state

(defun tst-reduce-window-stack (stack rule)
  "Perform a reduce in the LR parse of the window configuration tree.  A reduce
   always pops two elements off the parse stack and pushes a new element that
   is a description of the 'combined' elements that were popped.  The input 
   argument rule is either 'v' if the two items at the top of the stack were 
   split vertically, or 'h' if the two items at the top of the stack were
   split horizontally"
   (let ((wstatet) (wstatet-1) (combined) (edgest) (edgest-1))
     (setq wstatet (car stack))
     (setq wstatet-1 (cadr stack))
     (setq stack (cdr (cdr stack)))
     (setq combined (list
                     (list 'children (list wstatet-1 wstatet))
                     (list 'split rule)))
     (setq edgest (cadr (assoc 'window-edges wstatet)))
     (setq edgest-1 (cadr (assoc 'window-edges wstatet-1)))
     (setq combined (cons (list 'window-edges (list
                                (car edgest-1)
                                (cadr edgest-1)
                                (cadr (cdr edgest))
                                (cadr (cdr (cdr edgest)))
                                )
                 )
           combined))

     (setq stack (cons combined stack))
     )                                  ;let
   )                                    ;defun tst-reduce-window-stack

(defun tst-get-window-top-edge (wstate)
  "Return the coordinates of the top edge of input window as a three element
   list consisting of (left-column row right-column)"
  (let ((edges))
    (setq edges (cadr (assoc 'window-edges wstate)))
    (list (car edges) (cadr edges) (cadr (cdr edges)))
    )                                   ;let
  )                                     ;defun tst-reg-get-top-edge

(defun tst-get-window-bottom-edge (wstate)
  "Return the coordinates of the bottom edge of nput window as a three element
   list consisting of (left-column row right-column)"
  (let ((edges))
    (setq edges (cadr (assoc 'window-edges wstate)))
    (list (car edges) (cadr (cdr (cdr edges))) (cadr (cdr edges)))
    )                                   ;let
  )                                     ;defun tst-reg-get-top-edge

(defun tst-get-window-left-edge (wstate)
  "Return the coordinates of the left edge of input window as a three element
   list consisting of (top-row column bottom-row)"
  (let ((edges))
    (setq edges (cadr (assoc 'window-edges wstate)))
    (list (cadr edges) (car edges) (cadr (cdr (cdr edges))))
    )                                   ;let
  )                                     ;defun tst-reg-get-left-edge

(defun tst-get-window-right-edge (wstate)
  "Return the coordinates of the right edge of input window as a three element
   list consisting of (top-row column bottom-row)"
  (let ((edges))
    (setq edges (cadr (assoc 'window-edges wstate)))
    (list (cadr edges) (cadr (cdr edges)) (cadr (cdr (cdr edges))))
    )                                   ;let
  )                                     ;defun tst-reg-get-right-edge

(defun tst-capture-window-state (window cur-window)
  "Return the state of the window as an a-list."
  (let ()
    (list
     (list 'window-edges (window-edges))
     (list 'window-buffer (buffer-name))
     (list 'window-start (window-start))
     (list 'window-point (window-point))
     (list 'current-window (equal window cur-window))
     )
    )
  )

;;; end of windows.el
--
Mark A. Ardis
Software Engineering Institute
Carnegie-Mellon University
Pittsburgh, PA 15213
(412) 268-7636
maa@sei.cmu.edu