From e8546065e553bcc539918096875baf7ff8cfd78e Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 8 Sep 1992 18:18:29 +0000 Subject: [PATCH] Install mechanism for saving and restoring window configurations. --- v7/src/edwin/buffrm.scm | 162 +++++++++++++++++++++++++++++++++++++++- v7/src/edwin/edwin.pkg | 13 +++- v7/src/edwin/screen.scm | 6 +- 3 files changed, 176 insertions(+), 5 deletions(-) diff --git a/v7/src/edwin/buffrm.scm b/v7/src/edwin/buffrm.scm index 9f4324959..45ed92c6d 100644 --- 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!)) + +;;;; 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))))))) + +(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 a341018d7..2358e7239 100644 --- 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 8b9d70e16..d4ca39093 100644 --- 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 -- 2.25.1