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