Install mechanism for saving and restoring window configurations.

diff --git a/v7/src/edwin/buffrm.scm b/v7/src/edwin/buffrm.scm
index 9f43249595a4c2b13851abb87518a3d8d320e404..45ed92c6d36537b60b6e8f0a7cab71e00f0ab980 100644 (file)
--- a/v7/src/edwin/buffrm.scm
+++ b/v7/src/edwin/buffrm.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffrm.scm,v 1.42 1992/04/07 09:35:39 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffrm.scm,v 1.43 1992/09/08 18:18:29 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -334,4 +334,162 @@ Automatically becomes local when set in any fashion."
    setup-truncate-lines!)
   (add-variable-assignment-daemon!
    (ref-variable-object tab-width)
-   setup-truncate-lines!))
\ No newline at end of file
+   setup-truncate-lines!))
+\f
+;;;; Window Configurations
+
+(define-structure (window-configuration (conc-name window-configuration/))
+  (screen-x-size false read-only true)
+  (screen-y-size false read-only true)
+  (root-window false read-only true)
+  (root-x-size false read-only true)
+  (root-y-size false read-only true)
+  (selected-window false read-only true)
+  (cursor-window false read-only true)
+  (minibuffer-scroll-window false read-only true))
+
+(define-structure (saved-combination (conc-name saved-combination/))
+  (vertical? false read-only true)
+  (children false read-only true))
+
+(define-structure (saved-window (conc-name saved-window/))
+  (buffer false read-only true)
+  (point false read-only true)
+  (mark false read-only true)
+  (start-mark false read-only true))
+
+(define (guarantee-window-configuration object procedure)
+  (if (not (window-configuration? object))
+      (error:wrong-type-argument object "window configuration" procedure)))
+
+(define (screen-window-configuration screen)
+  (if (not (screen? screen))
+      (error:wrong-type-argument screen "screen" 'SCREEN-WINDOW-CONFIGURATION))
+  (let ((frame (screen-root-window screen))
+       (converted-windows '()))
+    (let ((root-window
+          (let convert-window ((window (editor-frame-root-window frame)))
+            (if (combination? window)
+                (let ((vertical? (combination-vertical? window)))
+                  (make-saved-combination
+                   vertical?
+                   (let loop ((window (combination-child window)))
+                     (cons (cons (if vertical?
+                                     (window-y-size window)
+                                     (window-x-size window))
+                                 (convert-window window))
+                           (let ((next (window-next window)))
+                             (if next
+                                 (loop next)
+                                 '()))))))
+                (let ((saved-window
+                       (let ((buffer (window-buffer window)))
+                         (make-saved-window
+                          buffer
+                          (mark-left-inserting-copy (window-point window))
+                          (let ((ring (buffer-mark-ring buffer)))
+                            (if (ring-empty? ring)
+                                false
+                                (mark-right-inserting-copy
+                                 (ring-ref ring 0))))
+                          (mark-right-inserting-copy
+                           (window-start-mark window))))))
+                  (set! converted-windows
+                        (cons (cons window saved-window) converted-windows))
+                  saved-window))))
+         (converted-window
+          (lambda (window)
+            (let ((association (assq window converted-windows)))
+              (and association
+                   (cdr association))))))
+      (make-window-configuration
+       (screen-x-size screen)
+       (screen-y-size screen)
+       (window-x-size frame)
+       (window-y-size frame)
+       root-window
+       (converted-window (editor-frame-selected-window frame))
+       (converted-window (editor-frame-cursor-window frame))
+       (let ((window (object-unhash *minibuffer-scroll-window*)))
+        (and window
+             (converted-window window)))))))
+\f
+(define (set-screen-window-configuration! screen configuration)
+  (guarantee-screen screen 'SET-SCREEN-WINDOW-CONFIGURATION!)
+  (guarantee-window-configuration configuration
+                                 'SET-SCREEN-WINDOW-CONFIGURATION!)
+  (if (and (= (screen-x-size screen)
+             (window-configuration/screen-x-size configuration))
+          (= (screen-y-size screen)
+             (window-configuration/screen-y-size configuration)))
+      (begin
+       (delete-other-windows (screen-window0 screen))
+       (let ((x-size (window-configuration/screen-x-size configuration))
+             (y-size (window-configuration/screen-y-size configuration))
+             (frame (screen-root-window screen)))
+         (if (not (and (= x-size (window-x-size frame))
+                       (= y-size (window-y-size frame))))
+             (set-editor-frame-size! frame x-size y-size)))
+       (let ((converted-windows '())
+             (need-buffers '()))
+         (let loop
+             ((window (screen-window0 screen))
+              (saved-window (window-configuration/root-window configuration)))
+           (if (saved-combination? saved-window)
+               (let ((vertical? (saved-combination/vertical? saved-window)))
+                 (let child-loop
+                     ((window window)
+                      (children (saved-combination/children saved-window)))
+                   (let ((new
+                          ((if vertical?
+                               window-split-vertically!
+                               window-split-horizontally!)
+                           window
+                           (caar children))))
+                     (loop window (cdar children))
+                     (if (null? (cddr children))
+                         (loop new (cdadr children))
+                         (child-loop new (cdr children))))))
+               (let ((buffer (saved-window/buffer saved-window)))
+                 (if (buffer-alive? buffer)
+                     (begin
+                       (set-window-buffer! window buffer)
+                       (set-window-point! window
+                                          (saved-window/point saved-window))
+                       (push-buffer-mark! buffer
+                                          (saved-window/mark saved-window))
+                       (set-window-start-mark!
+                        window
+                        (saved-window/start-mark saved-window)
+                        true))
+                     (set! need-buffers (cons window need-buffers)))
+                 (set! converted-windows
+                       (cons (cons saved-window window) converted-windows)))))
+         (for-each (lambda (window)
+                     (let ((buffer (other-buffer false)))
+                       (if buffer
+                           (set-window-buffer! window buffer))))
+                   need-buffers)
+         (let ((convert-window
+                (lambda (saved-window)
+                  (let ((association (assq saved-window converted-windows)))
+                    (and association
+                         (cdr association))))))
+           (let ((window
+                  (window-configuration/selected-window configuration)))
+             (if window
+                 (let ((window (convert-window window)))
+                   (without-interrupts
+                    (lambda ()
+                      (screen-select-window! screen window))))))
+           (let ((window (window-configuration/cursor-window configuration)))
+             (if window
+                 (screen-select-cursor! screen (convert-window window))))
+           (let ((window
+                  (window-configuration/minibuffer-scroll-window
+                   configuration)))
+             (if window
+                 (begin
+                   (set! *minibuffer-scroll-window*
+                         (hash (convert-window window)))
+                   unspecific))))))))
\ No newline at end of file

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index a341018d7074749135935af991300adf12d8c7ae..2358e72396b4bc89cdbcd9037cce3652da0bcac6 100644 (file)
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.97 1992/09/02 02:35:36 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.98 1992/09/08 18:18:18 cph Exp $
 
-Copyright (c) 1989-1992 Massachusetts Institute of Technology
+Copyright (c) 1989-92 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -225,6 +225,7 @@ MIT in each case. |#
   (files "screen")
   (parent (edwin))
   (export (edwin)
+         guarantee-screen
          initialize-screen-root-window!
          screen-beep
          screen-clear-rectangle
@@ -257,6 +258,7 @@ MIT in each case. |#
          screen-window0
          screen-x-size
          screen-y-size
+         screen?
          set-screen-debug-trace!
          set-screen-root-window!
          update-screen!
@@ -373,11 +375,14 @@ MIT in each case. |#
          edwin-variable$tab-width
          edwin-variable$truncate-lines
          edwin-variable$truncate-partial-width-windows
+         screen-window-configuration
+         set-screen-window-configuration!
          set-window-debug-trace!
          set-window-point!
          set-window-start-mark!
          window-buffer
          window-clear-override-message!
+         window-configuration?
          window-coordinates->mark
          window-direct-output-backward-char!
          window-direct-output-forward-char!
@@ -436,7 +441,11 @@ MIT in each case. |#
          window-split-vertically!
          window1+)
   (export (edwin window)
+         combination-child
          combination-leaf-window
+         combination-vertical?
+         combination?
+         window-next
          window0))
 
 (define-package (edwin modeline-string)

diff --git a/v7/src/edwin/screen.scm b/v7/src/edwin/screen.scm
index 8b9d70e16aa01d32cd81228df8520e9b0bb59125..d4ca39093caa21db3af02179036c6b517d3b7c29 100644 (file)
--- a/v7/src/edwin/screen.scm
+++ b/v7/src/edwin/screen.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.100 1992/03/31 07:43:34 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.101 1992/09/08 18:18:03 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -102,6 +102,10 @@
   ;; Set this variable in the debugger to trace interesting events.
   (debug-trace false))
 
+(define (guarantee-screen object procedure)
+  (if (not (screen? object))
+      (error:wrong-type-argument object "screen" procedure)))
+
 (define (initialize-screen-root-window! screen bufferset buffer)
   (set-screen-root-window!
    screen