From 585f25e49db86693fe104fe0a05eb1b49b19747b Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Thu, 30 Mar 1989 16:40:21 +0000
Subject: [PATCH] 1) Add support for ordinary terminals by using the curses
 library.

2) Eliminate some interrupt windows in direct output.

3) Add operations to the screen data structure to accomodate curses.

4) Add a new structure, a display, which consists of a keyboard and a screen.

5) Conditions not trapped by edwin now revert to the user in a
reasonable way, ie. the terminal should be in the same state that it
was before edwin was entered.

6) Reentering edwin after an unhandled condition updates the display.

7) The interaction buffer prompt is now inserted in the "exit" thunk
of the dynamic unwind, so that an abort will insert it as well.

8) Fix wrong number of args bug in ^R Screen Video.
---
 v7/src/edwin/buffrm.scm |  38 +++++++----
 v7/src/edwin/bufwiu.scm | 143 +++++++++++++++++++---------------------
 v7/src/edwin/decls.scm  |   1 +
 v7/src/edwin/editor.scm |  54 ++++++++++-----
 v7/src/edwin/edwin.ldr  |   7 +-
 v7/src/edwin/edwin.pkg  |  38 +++++++----
 v7/src/edwin/grpops.scm |  20 ++----
 v7/src/edwin/intmod.scm |  23 +++----
 v7/src/edwin/make.scm   |   4 +-
 v7/src/edwin/screen.scm |  33 +++++++++-
 v7/src/edwin/wincom.scm |   7 +-
 v7/src/edwin/xterm.scm  |  65 +++++++++++++++---
 12 files changed, 269 insertions(+), 164 deletions(-)

diff --git a/v7/src/edwin/buffrm.scm b/v7/src/edwin/buffrm.scm
index 12bd6d54e..d803607f5 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.29 1989/03/14 07:58:54 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffrm.scm,v 1.30 1989/03/30 16:39:21 jinx Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -197,27 +197,37 @@
   (%window-direct-update! (frame-text-inferior frame) display-style))
 
 (define (window-direct-output-insert-char! frame char)
-  (let ((point (window-point frame)))
-    (%group-insert-char! (mark-group point) (mark-index point) char))
-  (%direct-output-insert-char! (frame-text-inferior frame) char))
+  (without-interrupts
+   (lambda ()
+     (let ((point (window-point frame)))
+       (%group-insert-char! (mark-group point) (mark-index point) char))
+     (%direct-output-insert-char! (frame-text-inferior frame) char))))
 
 (define (window-direct-output-insert-newline! frame)
-  (let ((point (window-point frame)))
-    (%group-insert-char! (mark-group point) (mark-index point) #\newline))
-  (%direct-output-insert-newline! (frame-text-inferior frame)))
+  (without-interrupts
+   (lambda ()
+     (let ((point (window-point frame)))
+       (%group-insert-char! (mark-group point) (mark-index point) #\newline))
+     (%direct-output-insert-newline! (frame-text-inferior frame)))))
 
 (define (window-direct-output-insert-substring! frame string start end)
-  (let ((point (window-point frame)))
-    (%group-insert-substring! (mark-group point) (mark-index point)
-			      string start end))
-  (%direct-output-insert-substring! (frame-text-inferior frame)
-				    string start end))
+  (without-interrupts
+   (lambda ()
+     (let ((point (window-point frame)))
+       (%group-insert-substring! (mark-group point) (mark-index point)
+				 string start end))
+     (%direct-output-insert-substring! (frame-text-inferior frame)
+				       string start end))))
 
 (define-integrable (window-direct-output-forward-char! frame)
-  (%direct-output-forward-character! (frame-text-inferior frame)))
+  (without-interrupts
+   (lambda ()
+     (%direct-output-forward-character! (frame-text-inferior frame)))))
 
 (define-integrable (window-direct-output-backward-char! frame)
-  (%direct-output-backward-character! (frame-text-inferior frame)))
+  (without-interrupts
+   (lambda ()
+     (%direct-output-backward-character! (frame-text-inferior frame)))))
 
 (define (window-scroll-y-absolute! frame y-point)
   (let ((window (frame-text-inferior frame)))
diff --git a/v7/src/edwin/bufwiu.scm b/v7/src/edwin/bufwiu.scm
index 32a83bf4b..bc0afeca4 100644
--- a/v7/src/edwin/bufwiu.scm
+++ b/v7/src/edwin/bufwiu.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwiu.scm,v 1.5 1989/03/14 07:59:18 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwiu.scm,v 1.6 1989/03/30 16:39:27 jinx Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -287,6 +287,7 @@
 ;;; modifiable, and the modeline must already show that it has been
 ;;; modified.  None of the procedures may be used if the window needs
 ;;; redisplay.
+;;; They must be called without interrupts.
 
 (define (%window-direct-update! window display-style)
   (with-instance-variables buffer-window window (display-style)
@@ -301,90 +302,80 @@
 
 (define (%direct-output-forward-character! window)
   (with-instance-variables buffer-window window ()
-    (without-interrupts
-     (lambda ()
-       (%set-buffer-point! buffer (mark1+ point))
-       (set! point (buffer-point buffer))
-       (let ((x-start (1+ (inferior-x-start cursor-inferior)))
-	     (y-start (inferior-y-start cursor-inferior)))
-	 (screen-write-cursor! saved-screen
-			       (+ saved-x-start x-start)
-			       (+ saved-y-start y-start))
-	 (screen-flush! saved-screen)
-	 (%set-inferior-x-start! cursor-inferior x-start))))))
+   (%set-buffer-point! buffer (mark1+ point))
+   (set! point (buffer-point buffer))
+   (let ((x-start (1+ (inferior-x-start cursor-inferior)))
+	 (y-start (inferior-y-start cursor-inferior)))
+     (screen-write-cursor! saved-screen
+			   (+ saved-x-start x-start)
+			   (+ saved-y-start y-start))
+     (screen-flush! saved-screen)
+     (%set-inferior-x-start! cursor-inferior x-start))))
 
 (define (%direct-output-backward-character! window)
   (with-instance-variables buffer-window window ()
-    (without-interrupts
-     (lambda ()
-       (%set-buffer-point! buffer (mark-1+ point))
-       (set! point (buffer-point buffer))
-       (let ((x-start (-1+ (inferior-x-start cursor-inferior)))
-	     (y-start (inferior-y-start cursor-inferior)))
-	 (screen-write-cursor! saved-screen
-			       (+ saved-x-start x-start)
-			       (+ saved-y-start y-start))
-	 (screen-flush! saved-screen)
-	 (%set-inferior-x-start! cursor-inferior x-start))))))
+   (%set-buffer-point! buffer (mark-1+ point))
+   (set! point (buffer-point buffer))
+   (let ((x-start (-1+ (inferior-x-start cursor-inferior)))
+	 (y-start (inferior-y-start cursor-inferior)))
+     (screen-write-cursor! saved-screen
+			   (+ saved-x-start x-start)
+			   (+ saved-y-start y-start))
+     (screen-flush! saved-screen)
+     (%set-inferior-x-start! cursor-inferior x-start))))
 
 (define (%direct-output-insert-char! window char)
   (with-instance-variables buffer-window window (char)
-    (without-interrupts
-     (lambda ()
-       (let ((x-start (inferior-x-start cursor-inferior))
-	     (y-start (inferior-y-start cursor-inferior)))
-	 (let ((x (+ saved-x-start x-start))
-	       (y (+ saved-y-start y-start)))
-	   (screen-write-char! saved-screen x y char)
-	   (screen-write-cursor! saved-screen (1+ x) y)
-	   (screen-flush! saved-screen))
-	 (line-window-direct-output-insert-char!
-	  (inferior-window (car (y->inferiors window y-start)))
-	  x-start
-	  char)
-	 (%set-inferior-x-start! cursor-inferior (1+ x-start)))))))
+   (let ((x-start (inferior-x-start cursor-inferior))
+	 (y-start (inferior-y-start cursor-inferior)))
+     (let ((x (+ saved-x-start x-start))
+	   (y (+ saved-y-start y-start)))
+       (screen-write-char! saved-screen x y char)
+       (screen-write-cursor! saved-screen (1+ x) y)
+       (screen-flush! saved-screen))
+     (line-window-direct-output-insert-char!
+      (inferior-window (car (y->inferiors window y-start)))
+      x-start
+      char)
+     (%set-inferior-x-start! cursor-inferior (1+ x-start)))))
 
 (define (%direct-output-insert-newline! window)
   (with-instance-variables buffer-window window ()
-    (without-interrupts
-     (lambda ()
-       (let ((y-start (1+ (inferior-y-start cursor-inferior))))
-	 (let ((inferior (make-inferior window line-window)))
-	   (%set-inferior-x-start! inferior 0)
-	   (%set-inferior-y-start! inferior y-start)
-	   (set-cdr! (last-pair line-inferiors) (list inferior))
-	   (set! last-line-inferior inferior)
-	   (line-window-direct-output-insert-newline!
-	    (inferior-window inferior)))
-	 (let ((y-end (1+ y-start)))
-	   (if (< y-end y-size)
-	       (begin
-		 (%set-inferior-y-size! blank-inferior (- y-size y-end))
-		 (%set-inferior-y-start! blank-inferior y-end))
-	       (begin
-		 (%set-inferior-x-start! blank-inferior false)
-		 (%set-inferior-y-start! blank-inferior false))))
-	 (%set-inferior-x-start! cursor-inferior 0)
-	 (%set-inferior-y-start! cursor-inferior y-start)
-	 (screen-write-cursor! saved-screen
-			       saved-x-start
-			       (+ saved-y-start y-start))
-	 (screen-flush! saved-screen))))))
+   (let ((y-start (1+ (inferior-y-start cursor-inferior))))
+     (let ((inferior (make-inferior window line-window)))
+       (%set-inferior-x-start! inferior 0)
+       (%set-inferior-y-start! inferior y-start)
+       (set-cdr! (last-pair line-inferiors) (list inferior))
+       (set! last-line-inferior inferior)
+       (line-window-direct-output-insert-newline!
+	(inferior-window inferior)))
+     (let ((y-end (1+ y-start)))
+       (if (< y-end y-size)
+	   (begin
+	     (%set-inferior-y-size! blank-inferior (- y-size y-end))
+	     (%set-inferior-y-start! blank-inferior y-end))
+	   (begin
+	     (%set-inferior-x-start! blank-inferior false)
+	     (%set-inferior-y-start! blank-inferior false))))
+     (%set-inferior-x-start! cursor-inferior 0)
+     (%set-inferior-y-start! cursor-inferior y-start)
+     (screen-write-cursor! saved-screen
+			   saved-x-start
+			   (+ saved-y-start y-start))
+     (screen-flush! saved-screen))))
 
 (define (%direct-output-insert-substring! window string start end)
   (with-instance-variables buffer-window window (string start end)
-    (without-interrupts
-     (lambda ()
-       (let ((x-start (inferior-x-start cursor-inferior))
-	     (y-start (inferior-y-start cursor-inferior))
-	     (length (- end start)))
-	 (let ((x (+ saved-x-start x-start))
-	       (y (+ saved-y-start y-start)))
-	   (screen-write-substring! saved-screen x y string start end)
-	   (screen-write-cursor! saved-screen (+ x length) y)
-	   (screen-flush! saved-screen))
-	 (line-window-direct-output-insert-substring!
-	  (inferior-window (car (y->inferiors window y-start)))
-	  x-start
-	  string start end)
-	 (%set-inferior-x-start! cursor-inferior (+ x-start length)))))))
\ No newline at end of file
+   (let ((x-start (inferior-x-start cursor-inferior))
+	 (y-start (inferior-y-start cursor-inferior))
+	 (length (- end start)))
+     (let ((x (+ saved-x-start x-start))
+	   (y (+ saved-y-start y-start)))
+       (screen-write-substring! saved-screen x y string start end)
+       (screen-write-cursor! saved-screen (+ x length) y)
+       (screen-flush! saved-screen))
+     (line-window-direct-output-insert-substring!
+      (inferior-window (car (y->inferiors window y-start)))
+      x-start
+      string start end)
+     (%set-inferior-x-start! cursor-inferior (+ x-start length)))))
\ No newline at end of file
diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm
index 93ae40b9a..36cc65c36 100644
--- a/v7/src/edwin/decls.scm
+++ b/v7/src/edwin/decls.scm
@@ -8,6 +8,7 @@
      "clscon"
      "clsmac"
      "complt"
+     "cterm"
      "entity"
      "grpops"
      "image"
diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index 730f9bb7d..c120234b2 100644
--- a/v7/src/edwin/editor.scm
+++ b/v7/src/edwin/editor.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.183 1989/03/14 08:00:27 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.184 1989/03/30 16:39:37 jinx Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -44,22 +44,42 @@
 (define (edwin)
   (if (not edwin-editor)
       (edwin-reset))
-  (with-editor-input-port edwin-input-port
-    (lambda ()
-      (with-editor-interrupts
-       (lambda ()
-	 (within-editor edwin-editor
-	   (lambda ()
-	     (perform-buffer-initializations! (current-buffer))
-	     (update-screens! true)
-	     (if edwin-initialization (edwin-initialization))
-	     (let ((message (cmdl-message/null)))
-	       (push-cmdl (lambda (cmdl)
-			    cmdl		;ignore
-			    (top-level-command-reader)
-			    message)
-			  false
-			  message))))))))
+  (call-with-current-continuation
+   (lambda (edwin-abort-continuation)
+     (bind-condition-handler
+      '()
+      (lambda (condition)
+	(within-continuation edwin-abort-continuation
+			     (lambda ()
+			       (signal-error condition))))
+      enter-edwin))))
+
+(define (enter-edwin)
+  (using-screen edwin-screen
+   (lambda ()
+     (with-editor-input-port edwin-input-port
+      (lambda ()
+	(with-editor-interrupts
+	 (lambda ()
+	   (within-editor edwin-editor
+	    (lambda ()
+	      (perform-buffer-initializations! (current-buffer))
+	      (dynamic-wind
+	       (lambda ()
+		 (update-screens! true))
+	       (lambda ()
+		 ;; Should this be in a dynamic wind? -- Jinx
+		 (if edwin-initialization (edwin-initialization))
+		 (let ((message (cmdl-message/null)))
+		   (push-cmdl (lambda (cmdl)
+				cmdl	;ignore
+				(top-level-command-reader)
+				message)
+			      false
+			      message)))
+	       (lambda ()
+		 unspecific))))))))))
+  ;; Should this be here or in a dynamic wind? -- Jinx
   (if edwin-finalization (edwin-finalization))
   unspecific)
 
diff --git a/v7/src/edwin/edwin.ldr b/v7/src/edwin/edwin.ldr
index 4e7a7fb3c..77401d563 100644
--- a/v7/src/edwin/edwin.ldr
+++ b/v7/src/edwin/edwin.ldr
@@ -33,7 +33,6 @@
     (load "bufset" environment)
     (load "undo" (->environment '(EDWIN UNDO)))
     (load "screen" (->environment '(EDWIN SCREEN)))
-    (load "xterm" (->environment '(EDWIN X-SCREEN)))
     (load "winren" (->environment '(EDWIN)))
     (let ((environment (->environment '(EDWIN WINDOW))))
       (load "window" environment)
@@ -48,6 +47,12 @@
       (load "buffrm" environment)
       (load "edtfrm" environment)
       (load "winmis" environment))
+    (let ((env (->environment '(EDWIN X-SCREEN))))
+      (load "xterm" env)
+      ((access initialize-package! env)))
+    (let ((env (->environment '(EDWIN CONSOLE-SCREEN))))
+      (load "cterm" env)
+      ((access initialize-package! env)))    
     (load "edtstr" environment)
     (load "editor" environment)
     (load "curren" environment)
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 67b0fcf6b..4c690e6cb 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.1 1989/03/14 08:12:18 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.2 1989/03/30 16:39:47 jinx Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -179,11 +179,15 @@ MIT in each case. |#
   (export (edwin)
 	  make-screen
 	  screen-beep
+	  screen-discard!
+	  screen-enter!
+	  screen-exit!
 	  screen-flush!
 	  screen-in-update?
 	  screen-inverse-video!
 	  screen-state
 	  screen-window
+	  screen-wipe!
 	  screen-write-char!
 	  screen-write-cursor!
 	  screen-write-substring!
@@ -192,24 +196,22 @@ MIT in each case. |#
 	  screen-y-size
 	  set-screen-window!
 	  subscreen-clear!
+	  using-screen
 	  with-screen-in-update!))
 
 (define-package (edwin x-screen)
   (files "xterm")
   (parent (edwin))
   (export (edwin)
-	  make-xterm-input-port
-	  make-xterm-screen
-	  with-editor-interrupts
-	  with-editor-interrupts-disabled
-	  with-editor-interrupts-enabled
-	  xterm-close-all-displays
-	  xterm-close-display
-	  xterm-close-window
-	  xterm-map
-	  xterm-open-display
-	  xterm-open-window
-	  xterm-unmap))
+	  X-display)
+  (initialization (initialize-package!)))
+
+(define-package (edwin console-screen)
+  (files "cterm")
+  (parent (edwin))
+  (export (edwin)
+	  console-display)
+  (initialization (initialize-package!)))
 
 (define-package (edwin window)
   (files "window"
@@ -224,6 +226,8 @@ MIT in each case. |#
 	 "edtfrm"
 	 "winmis")
   (parent (edwin))
+  (export ()
+	  edwin-set-display!)
   (export (edwin)
 	  editor-frame-select-cursor!
 	  editor-frame-select-window!
@@ -231,10 +235,13 @@ MIT in each case. |#
 	  editor-frame-typein-window
 	  editor-frame-window0
 	  edwin-discard-state!
+	  edwin-display
 	  edwin-editor
 	  edwin-input-port
 	  edwin-reset
 	  edwin-reset-windows
+	  edwin-screen
+	  make-display
 	  make-editor-frame
 	  modeline-mode-string
 	  modeline-modified-string
@@ -272,7 +279,10 @@ MIT in each case. |#
 	  window-select-time
 	  window-set-override-message!
 	  window-start-mark
-	  window-y-center)
+	  window-y-center
+	  with-editor-interrupts
+	  with-editor-interrupts-enabled
+	  with-editor-interrupts-disabled)
   (export (edwin prompt)
 	  clear-override-message!
 	  frame-text-inferior
diff --git a/v7/src/edwin/grpops.scm b/v7/src/edwin/grpops.scm
index bc1cd13df..7241c759f 100644
--- a/v7/src/edwin/grpops.scm
+++ b/v7/src/edwin/grpops.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/grpops.scm,v 1.1 1989/03/14 08:00:49 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/grpops.scm,v 1.2 1989/03/30 16:39:53 jinx Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -82,15 +82,10 @@
 (define (group-insert-char! group index char)
   (without-interrupts
    (lambda ()
-     (group-insert-char-kernel group index char)
+     (%group-insert-char! group index char)
      (record-insertion! group index (group-gap-start group)))))
 
-(define (%group-insert-char! group index char)
-  (without-interrupts
-   (lambda ()
-     (group-insert-char-kernel group index char))))
-
-(define-integrable (group-insert-char-kernel group index char)
+(define-integrable (%group-insert-char! group index char)
   (barf-if-read-only group)
   (move-gap-to! group index)
   (guarantee-gap-length! group 1)
@@ -106,15 +101,10 @@
 (define (group-insert-substring! group index string start end)
   (without-interrupts
    (lambda ()
-     (group-insert-substring-kernel group index string start end)
+     (%group-insert-substring! group index string start end)
      (record-insertion! group index (group-gap-start group)))))
 
-(define (%group-insert-substring! group index string start end)
-  (without-interrupts
-   (lambda ()
-     (group-insert-substring-kernel group index string start end))))
-
-(define-integrable (group-insert-substring-kernel group index string start end)
+(define-integrable (%group-insert-substring! group index string start end)
   (barf-if-read-only group)
   (move-gap-to! group index)
   (let ((n (- end start)))
diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm
index 4b4a1b106..301d0992c 100644
--- a/v7/src/edwin/intmod.scm
+++ b/v7/src/edwin/intmod.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/intmod.scm,v 1.30 1989/03/14 08:01:05 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/intmod.scm,v 1.31 1989/03/30 16:39:58 jinx Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -141,16 +141,17 @@ Output is inserted into the buffer at the end."
 	(dynamic-wind
 	 (lambda () 'DONE)
 	 (lambda ()
-	   (intercept-^G-interrupts (lambda ()
-				      (newline)
-				      (write-string "Abort!"))
-	     (lambda ()
-	       (let ((environment (evaluation-environment false)))
-		 (with-output-to-current-point
-		  (lambda ()
-		    (write-line (eval-with-history (with-input-from-mark mark
-						     read)
-						   environment))))))))
+	   (with-output-to-current-point
+	    (lambda ()
+	      (intercept-^G-interrupts
+	       (lambda ()
+		 (newline)
+		 (write-string "Abort!"))
+	       (lambda ()
+		 (write-line
+		  (eval-with-history (with-input-from-mark mark
+							   read)
+				     (evaluation-environment false))))))))
 	 insert-interaction-prompt))))
 
 (define-command ("^R Interaction Refresh")
diff --git a/v7/src/edwin/make.scm b/v7/src/edwin/make.scm
index 082f88696..8652f07f5 100644
--- a/v7/src/edwin/make.scm
+++ b/v7/src/edwin/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.1 1989/03/15 19:17:06 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.2 1989/03/30 16:40:02 jinx Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -37,4 +37,4 @@ MIT in each case. |#
 (declare (usual-integrations))
 
 (package/system-loader "edwin" '() 'QUERY)
-(add-system! (make-system "Edwin" 3 1 '()))
\ No newline at end of file
+(add-system! (make-system "Edwin" 3 2 '()))
\ No newline at end of file
diff --git a/v7/src/edwin/screen.scm b/v7/src/edwin/screen.scm
index f1b153d85..1925c035a 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.78 1989/03/14 08:02:42 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.79 1989/03/30 16:40:07 jinx Exp $
 ;;;
 ;;;	Copyright (c) 1989 Massachusetts Institute of Technology
 ;;;
@@ -55,7 +55,11 @@
 				 operation/write-substring!
 				 operation/write-substrings!
 				 operation/x-size
-				 operation/y-size)))
+				 operation/y-size
+				 operation/wipe!
+				 operation/enter!
+				 operation/exit!
+				 operation/discard!)))
   (state false read-only true)
   (operation/beep false read-only true)
   (operation/finish-update! false read-only true)
@@ -69,9 +73,20 @@
   (operation/write-substrings! false read-only true)
   (operation/x-size false read-only true)
   (operation/y-size false read-only true)
+  (operation/wipe! false read-only true)
+  (operation/enter! false read-only true)
+  (operation/exit! false read-only true)
+  (operation/discard! false read-only true)
   (window false)
   (in-update? false))
 
+(define (using-screen screen thunk)
+  (dynamic-wind (lambda ()
+		  ((screen-operation/enter! screen) screen))
+		thunk
+		(lambda ()
+		  ((screen-operation/exit! screen) screen))))   
+
 (define (with-screen-in-update! screen thunk)
   (let ((old-flag)
 	(new-flag true))
@@ -114,4 +129,16 @@
 
 (define (screen-write-substrings! screen x y strings bil biu bjl bju)
   ((screen-operation/write-substrings! screen)
-   screen x y strings bil biu bjl bju))
\ No newline at end of file
+   screen x y strings bil biu bjl bju))
+
+(define (screen-wipe! screen)
+  ((screen-operation/wipe! screen) screen))
+
+(define (screen-enter! screen)
+  ((screen-operation/enter! screen) screen))
+
+(define (screen-exit! screen)
+  ((screen-operation/exit! screen) screen))
+
+(define (screen-discard! screen)
+  ((screen-operation/discard! screen) screen))
\ No newline at end of file
diff --git a/v7/src/edwin/wincom.scm b/v7/src/edwin/wincom.scm
index a02d1b3b1..a1d5044f2 100644
--- a/v7/src/edwin/wincom.scm
+++ b/v7/src/edwin/wincom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/wincom.scm,v 1.89 1989/03/14 08:03:47 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/wincom.scm,v 1.90 1989/03/30 16:40:11 jinx Exp $
 ;;;
 ;;;	Copyright (c) 1987, 1989 Massachusetts Institute of Technology
 ;;;
@@ -178,9 +178,12 @@ Just minus as an argument moves down full screen."
 With a positive argument, inverse video is forced.
 With a negative argument, normal video is forced."
   (screen-inverse-video!
+   (current-screen)
    (or (positive? argument)
        (not (or (negative? argument)
-		(screen-inverse-video! false)))))
+		(screen-inverse-video!
+		 (current-screen)
+		 false)))))
   (update-screens! true))
 
 (define-command ("What Cursor Position")
diff --git a/v7/src/edwin/xterm.scm b/v7/src/edwin/xterm.scm
index f83993d6a..bc0da8032 100644
--- a/v7/src/edwin/xterm.scm
+++ b/v7/src/edwin/xterm.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.1 1989/03/14 08:08:58 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.2 1989/03/30 16:40:21 jinx Exp $
 ;;;
 ;;;	Copyright (c) 1989 Massachusetts Institute of Technology
 ;;;
@@ -68,7 +68,7 @@
 
 (define (make-xterm-screen #!optional geometry)
   (make-screen (make-xterm-screen-state
-		(xterm-open-window (or (xterm-open-display false)
+		(xterm-open-window (or (get-X-display)
 				       (error "unable to open display"))
 				   (and (not (default-object? geometry))
 					geometry)
@@ -84,14 +84,18 @@
 	       xterm-screen/write-substring!
 	       xterm-screen/write-substrings!
 	       xterm-screen/x-size
-	       xterm-screen/y-size))
+	       xterm-screen/y-size
+	       xterm-screen/wipe!
+	       xterm-screen/enter!
+	       xterm-screen/exit!
+	       xterm-screen/discard!))
 
 (define-integrable (screen-xterm screen)
   (xterm-screen-state/xterm (screen-state screen)))
 
 (define-integrable (screen-highlight screen)
   (xterm-screen-state/highlight (screen-state screen)))
-
+
 (define-integrable (set-screen-highlight! screen highlight)
   (set-xterm-screen-state/highlight! (screen-state screen) highlight))
 
@@ -140,7 +144,7 @@
 					    ail aiu
 					    highlight)
 		    (loop (1+ y) (1+ j)))))))))))
-
+
 (define (clip axu x bil biu receiver)
   (let ((ail (- bil x)))
     (if (< ail biu)
@@ -159,6 +163,22 @@
 
 (define (xterm-screen/y-size screen)
   (xterm-y-size (screen-xterm screen)))
+
+(define (xterm-screen/wipe! screen)
+  screen				; ignored
+  unspecific)
+
+(define (xterm-screen/enter! screen)
+  screen				; ignored
+  unspecific)
+
+(define (xterm-screen/exit! screen)
+  screen				; ignored
+  unspecific)
+
+(define (xterm-screen/discard! screen)
+  screen				; ignored
+  (close-X-display))
 
 ;;;; Input Port
 
@@ -270,15 +290,15 @@
   (set! pending-interrupt? false)
   (^G-signal))
 
-(define (with-editor-interrupts thunk)
+(define (with-editor-interrupts-from-X thunk)
   (fluid-let ((signal-interrupts? true)
 	      (pending-interrupt? false))
     (thunk)))
 
-(define (with-editor-interrupts-enabled thunk)
+(define (with-X-interrupts-enabled thunk)
   (bind-signal-interrupts? true thunk))
 
-(define (with-editor-interrupts-disabled thunk)
+(define (with-X-interrupts-disabled thunk)
   (bind-signal-interrupts? false thunk))
 
 (define (bind-signal-interrupts? new-mask thunk)
@@ -293,4 +313,31 @@
 		    (set! new-mask signal-interrupts?)
 		    (set! signal-interrupts? old-mask)
 		    (if (and old-mask pending-interrupt?)
-			(signal-interrupt!))))))
\ No newline at end of file
+			(signal-interrupt!))))))
+
+;;;; Display description for X displays
+
+(define X-display)
+(define X-display-data)
+
+(define (get-X-display)
+  (if (and (not (unassigned? X-display-data))
+	   X-display-data)
+      X-display-data
+      (let ((display (xterm-open-display false)))
+	(set! X-display-data display)
+	display)))      
+
+(define (close-X-display)
+  (xterm-close-all-displays)
+  (set! X-display-data false)
+  unspecific)
+
+(define (initialize-package!)
+  (set! X-display
+	(make-display get-X-display
+		      make-xterm-screen
+		      make-xterm-input-port
+		      with-editor-interrupts-from-X
+		      with-X-interrupts-enabled
+		      with-X-interrupts-disabled)))
-- 
2.25.1