From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 8 Feb 1992 15:23:45 +0000 (+0000)
Subject: This version of Edwin requires microcode 11.108 and runtime 14.146.
X-Git-Tag: 20090517-FFI~9843
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=692945399958eb8aeccf347e9336b6fa12686684;p=mit-scheme.git

This version of Edwin requires microcode 11.108 and runtime 14.146.

* Multi-thread code from previous version has been moved to the
  runtime system.

* Use new reentrant directory-reading support from runtime system.

* New control variables in "basic.scm" give finer control over the
  exit options for Edwin.  The 6.001 student system should take
  advantage of these.

* Screens now have information indicating whether they are visible;
  commands that use screens avoid using invisible ones where possible.
  Invisible screens are never updated; they are fully updated when
  they are made visible again.

* Participate in WM_DELETE_WINDOW protocol; when running under a
  cooperating window manager (e.g. mwm), commands to delete Edwin's
  screens are now intercepted and processed appropriately.  When there
  are multiple screens, the given screen is deleted; if there is just
  one screen, Edwin exits exactly as if C-x c had been typed.

* Participate in WM_TAKE_FOCUS protocol; Edwin is a "locally active"
  client, meaning that it takes responsibility for managing keyboard
  focus among its own windows.  This means that switching the keyboard
  focus to a different Edwin window also informs the window manager
  that the focus has been changed.

* Edwin now tracks MapNotify and UnmapNotify events, and uses them to
  set the visibility information of screens.  This means that it is
  much harder to switch the focus to an iconified screen.
---

diff --git a/v7/src/edwin/basic.scm b/v7/src/edwin/basic.scm
index 4ae938432..c7242f5c8 100644
--- a/v7/src/edwin/basic.scm
+++ b/v7/src/edwin/basic.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.118 1992/02/04 04:01:10 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.119 1992/02/08 15:23:24 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -250,7 +250,7 @@ For more information type the HELP key while entering the name."
 
 (define-integrable (editor-beep)
   (screen-beep (selected-screen)))
-
+
 ;;;; Level Control
 
 (define-command exit-recursive-edit
@@ -266,55 +266,78 @@ For a normal exit, you should use \\[exit-recursive-edit], NOT this command."
   ()
   (lambda ()
     (exit-recursive-edit 'ABORT)))
+
+;;;; Leaving Edwin
+
+;; Set this to #F to indicate that returning from the editor has the
+;; same effect as calling %EXIT.
+(define editor-can-exit? true)
+
+;; Set this to #F to indicate that calling QUIT has the same effect
+;; as calling %EXIT.
+(define scheme-can-quit? true)
+
+;; Set this to #T to force the exit commands to always prompt for
+;; confirmation before killing Edwin.
+(define paranoid-exit? false)
 
 (define-command suspend-scheme
   "Go back to Scheme's superior job.
 With argument, saves visited file first."
   "P"
   (lambda (argument)
-    (if (prompt-for-yes-or-no? "Suspend Scheme")
-	(begin
-	  (if argument (save-buffer (current-buffer) false))
-	  (quit)))))
+    (if argument (save-buffer (current-buffer) false))
+    (if (not (and scheme-can-quit? (subprocess-job-control-available?)))
+	(editor-error "Scheme cannot be suspended"))
+    (quit)))
 
 (define-command suspend-edwin
   "Stop Edwin and return to Scheme."
   ()
   (lambda ()
-    (if (prompt-for-yes-or-no? "Suspend Edwin")
-	(quit-editor))))
+    (if (not editor-can-exit?)
+	(editor-error "Edwin cannot be suspended"))
+    (quit-editor)))
+
+(define (save-buffers-and-exit no-confirmation? noun exit)
+  (save-some-buffers no-confirmation? true)
+  (if (and (or (not (there-exists? (buffer-list)
+		      (lambda (buffer)
+			(and (buffer-modified? buffer)
+			     (buffer-pathname buffer)))))
+	       (prompt-for-yes-or-no? "Modified buffers exist; exit anyway"))
+	   (if (there-exists? (process-list)
+		 (lambda (process)
+		   (and (not (process-kill-without-query process))
+			(process-runnable? process))))
+	       (and (prompt-for-yes-or-no?
+		     "Active processes exist; kill them and exit anyway")
+		    (begin
+		      (for-each delete-process (process-list))
+		      true))
+	       (or (not paranoid-exit?)
+		   (prompt-for-yes-or-no? (string-append "Kill " noun)))))
+      (exit)))
 
 (define-command save-buffers-kill-scheme
   "Offer to save each buffer, then kill Scheme.
 With prefix arg, silently save all file-visiting buffers, then kill."
   "P"
   (lambda (no-confirmation?)
-    (save-some-buffers no-confirmation? true)
-    (if (prompt-for-yes-or-no? "Kill Scheme")
-	(%exit))))
+    (save-buffers-and-exit no-confirmation? "Scheme" %exit)))
+
+(define (save-buffers-kill-edwin #!optional no-confirmation?)
+  (let ((no-confirmation?
+	 (and (not (default-object? no-confirmation?)) no-confirmation?)))
+    (if editor-can-exit?
+	(save-buffers-and-exit no-confirmation? "Edwin" exit-editor)
+	(save-buffers-and-exit no-confirmation? "Scheme" %exit))))
 
 (define-command save-buffers-kill-edwin
   "Offer to save each buffer, then kill Edwin, returning to Scheme.
 With prefix arg, silently save all file-visiting buffers, then kill."
   "P"
-  (lambda (no-confirmation?)
-    (save-some-buffers no-confirmation? true)
-    (if (and (or (not (there-exists? (buffer-list)
-			(lambda (buffer)
-			  (and (buffer-modified? buffer)
-			       (buffer-pathname buffer)))))
-		 (prompt-for-yes-or-no?
-		  "Modified buffers exist; exit anyway"))
-	     (or (not (there-exists? (process-list)
-			(lambda (process)
-			  (and (not (process-kill-without-query process))
-			       (process-runnable? process)))))
-		 (and (prompt-for-yes-or-no?
-		       "Active processes exist; kill them and exit anyway")
-		      (begin
-			(for-each delete-process (process-list))
-			true))))
-	(exit-editor))))
+  save-buffers-kill-edwin)
 
 ;;;; Comment Commands
 
diff --git a/v7/src/edwin/curren.scm b/v7/src/edwin/curren.scm
index 3a3927d8d..5e4c7d38a 100644
--- a/v7/src/edwin/curren.scm
+++ b/v7/src/edwin/curren.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.94 1992/02/04 04:02:06 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.95 1992/02/08 15:23:26 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -156,7 +156,15 @@
 	 screen)))
 
 (define (other-screen screen)
-  (let ((screen* (screen1+ screen)))
+  (let ((screen*
+	 (let loop ((screen* screen))
+	   (let ((screen* (screen1+ screen*)))
+	     (cond ((eq? screen* screen)
+		    (screen1+ screen*))
+		   ((screen-visible? screen*)
+		    screen*)
+		   (else
+		    (loop screen*)))))))
     (and (not (eq? screen screen*))
 	 screen*)))
 
diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm
index fccae5cc4..5b3f5dce6 100644
--- a/v7/src/edwin/decls.scm
+++ b/v7/src/edwin/decls.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/decls.scm,v 1.30 1992/02/04 04:02:26 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/decls.scm,v 1.31 1992/02/08 15:23:28 cph Exp $
 
 Copyright (c) 1989-92 Massachusetts Institute of Technology
 
@@ -93,7 +93,6 @@ MIT in each case. |#
 	      "strpad"
 	      "strtab"
 	      "termcap"
-	      "thread"
 	      "utils"
 	      "winren"
 	      "xform"
diff --git a/v7/src/edwin/ed-ffi.scm b/v7/src/edwin/ed-ffi.scm
index b1b436c90..bc10f2659 100644
--- a/v7/src/edwin/ed-ffi.scm
+++ b/v7/src/edwin/ed-ffi.scm
@@ -207,8 +207,6 @@
 	       edwin-syntax-table)
     ("things"  (edwin)
 	       edwin-syntax-table)
-    ("thread"  (edwin thread)
-	       syntax-table/system-internal)
     ("tparse"  (edwin)
 	       edwin-syntax-table)
     ("tterm"   (edwin console-screen)
diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index bd5a1923d..3f70a0e1b 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.211 1992/02/04 04:02:36 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.212 1992/02/08 15:23:31 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -61,41 +61,36 @@
    (lambda (continuation)
      (fluid-let ((editor-abort continuation)
 		 (current-editor edwin-editor)
-		 (editor-thread)
+		 (editor-thread (current-thread))
 		 (editor-initial-threads '())
-		 (unwind-protect-cleanups '())
 		 (inferior-thread-changes? false)
 		 (recursive-edit-continuation false)
 		 (recursive-edit-level 0))
-       (within-thread-environment
-	(lambda ()
-	  (set! editor-thread (create-initial-thread))
-	  (editor-grab-display edwin-editor
-	    (lambda (with-editor-ungrabbed operations)
-	      (let ((message (cmdl-message/null)))
-		(cmdl/start
-		 (push-cmdl
-		  (lambda (cmdl)
-		    cmdl		;ignore
-		    (bind-condition-handler (list condition-type:error)
-			internal-error-handler
-		      (lambda ()
-			(call-with-current-continuation
-			 (lambda (root-continuation)
-			   (set-thread-root-continuation! root-continuation)
-			   (do ((thunks (let ((thunks editor-initial-threads))
-					  (set! editor-initial-threads '())
-					  thunks)
-					(cdr thunks)))
-			       ((null? thunks))
-			     (create-thread (car thunks)))
-			   (top-level-command-reader edwin-initialization)))))
-		    message)
-		  false
-		  `((START-CHILD
-		     ,(editor-start-child-cmdl with-editor-ungrabbed))
-		    ,@operations))
-		 message))))))))))
+       (editor-grab-display edwin-editor
+	 (lambda (with-editor-ungrabbed operations)
+	   (let ((message (cmdl-message/null)))
+	     (cmdl/start
+	      (push-cmdl
+	       (lambda (cmdl)
+		 cmdl		;ignore
+		 (bind-condition-handler (list condition-type:error)
+		     internal-error-handler
+		   (lambda ()
+		     (call-with-current-continuation
+		      (lambda (root-continuation)
+			(do ((thunks (let ((thunks editor-initial-threads))
+				       (set! editor-initial-threads '())
+				       thunks)
+				     (cdr thunks)))
+			    ((null? thunks))
+			  (create-thread root-continuation (car thunks)))
+			(top-level-command-reader edwin-initialization)))))
+		 message)
+	       false
+	       `((START-CHILD
+		  ,(editor-start-child-cmdl with-editor-ungrabbed))
+		 ,@operations))
+	      message))))))))
 
 (define (edwin . args) (apply edit args))
 (define (within-editor?) (not (unassigned? current-editor)))
@@ -238,8 +233,8 @@ with the contents of the startup message."
 				    (window-modeline-event! window
 							    'RECURSIVE-EDIT))
 				  (window-list)))))
-		 (unwind-protect
-		  false
+		 (dynamic-wind
+		  (lambda () unspecific)
 		  (lambda ()
 		    (recursive-edit-event!)
 		    (command-reader))
@@ -347,39 +342,13 @@ This does not affect editor errors or evaluation errors."
 	  (interceptor)
 	  value))))
 
-(define (call-with-protected-continuation receiver)
-  (call-with-current-continuation
-   (lambda (continuation)
-     (let ((cleanups unwind-protect-cleanups))
-       (receiver
-	(lambda (value)
-	  (let ((blocked? (block-thread-events)))
-	    (do () ((eq? cleanups unwind-protect-cleanups))
-	      (if (null? unwind-protect-cleanups)
-		  (error "unwind-protect stack slipped!"))
-	      (let ((cleanup (car unwind-protect-cleanups)))
-		(set! unwind-protect-cleanups (cdr unwind-protect-cleanups))
-		(cleanup)))
-	    (if (not blocked?) (unblock-thread-events)))
-	  (continuation value)))))))
+(define call-with-protected-continuation
+  call-with-current-continuation)
 
 (define (unwind-protect setup body cleanup)
-  (let ((blocked? (block-thread-events)))
-    (if setup (setup))
-    (let ((cleanups (cons cleanup unwind-protect-cleanups)))
-      (set! unwind-protect-cleanups cleanups)
-      (if (not blocked?) (unblock-thread-events))
-      (let ((value (body)))
-	(block-thread-events)
-	(if (not (eq? unwind-protect-cleanups cleanups))
-	    (error "unwind-protect stack slipped!"))
-	(set! unwind-protect-cleanups (cdr cleanups))
-	(cleanup)
-	(if (not blocked?) (unblock-thread-events))
-	value))))
+  (dynamic-wind (or setup (lambda () unspecific)) body cleanup))
 
 (define *^G-interrupt-handler* false)
-(define unwind-protect-cleanups)
 
 (define (editor-grab-display editor receiver)
   (display-type/with-display-grabbed (editor-display-type editor)
@@ -388,14 +357,12 @@ This does not affect editor errors or evaluation errors."
 	(lambda ()
 	  (let ((enter
 		 (lambda ()
-		   (start-timer-interrupt)
 		   (let ((screen (selected-screen)))
 		     (screen-enter! screen)
 		     (update-screen! screen true))))
 		(exit
 		 (lambda ()
-		   (screen-exit! (selected-screen))
-		   (stop-timer-interrupt))))
+		   (screen-exit! (selected-screen)))))
 	    (dynamic-wind enter
 			  (lambda ()
 			    (receiver
@@ -412,27 +379,6 @@ This does not affect editor errors or evaluation errors."
     cmdl
     (with-editor-ungrabbed thunk)))
 
-(define (start-timer-interrupt)
-  (if timer-interval
-      ((ucode-primitive real-timer-set) timer-interval timer-interval)
-      (stop-timer-interrupt)))
-
-(define (stop-timer-interrupt)
-  ((ucode-primitive real-timer-clear))
-  ((ucode-primitive clear-interrupts!) interrupt-bit/timer))
-
-(define (set-thread-timer-interval! interval)
-  (if (not (or (false? interval)
-	       (and (exact-integer? interval)
-		    (positive? interval))))
-      (error:wrong-type-argument interval false 'SET-THREAD-TIMER-INTERVAL!))
-  (set! timer-interval interval)
-  (start-timer-interrupt))
-
-(define (thread-timer-interval)
-  timer-interval)
-
-(define timer-interval 100)
 (define inferior-thread-changes?)
 
 (define (accept-thread-output)
diff --git a/v7/src/edwin/edwin.ldr b/v7/src/edwin/edwin.ldr
index 6a68b9b48..4965f4b16 100644
--- a/v7/src/edwin/edwin.ldr
+++ b/v7/src/edwin/edwin.ldr
@@ -1,5 +1,5 @@
 ;;; -*-Scheme-*-
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.ldr,v 1.22 1992/02/04 04:02:46 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.ldr,v 1.23 1992/02/08 15:23:33 cph Exp $
 ;;; program to load package contents
 ;;; **** This program (unlike most .ldr files) is not generated by a program.
 
@@ -57,7 +57,6 @@
       (load "tterm" env)
       ((access initialize-package! env)))    
     (load "edtstr" environment)
-    (load "thread" (->environment '(EDWIN THREAD)))
     (load "editor" environment)
     (load "curren" environment)
     (load "simple" environment)
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 818b36eef..0f821955a 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.74 1992/02/04 04:02:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.75 1992/02/08 15:23:35 cph Exp $
 
 Copyright (c) 1989-92 Massachusetts Institute of Technology
 
@@ -223,6 +223,7 @@ MIT in each case. |#
 	  initialize-screen-root-window!
 	  screen-beep
 	  screen-clear-rectangle
+	  screen-deleted?
 	  screen-direct-output-char
 	  screen-direct-output-move-cursor
 	  screen-direct-output-substring
@@ -245,6 +246,8 @@ MIT in each case. |#
 	  screen-selected-window
 	  screen-state
 	  screen-typein-window
+	  screen-visibility
+	  screen-visible?
 	  screen-window-list
 	  screen-window0
 	  screen-x-size
@@ -258,7 +261,8 @@ MIT in each case. |#
 	  make-screen)
   (export (edwin x-screen)
 	  make-screen
-	  set-screen-size!))
+	  set-screen-size!
+	  set-screen-visibility!))
 
 (define-package (edwin x-screen)
   (files "xterm")
@@ -472,7 +476,6 @@ MIT in each case. |#
 	  set-current-command!
 	  top-level-command-reader)
   (export (edwin inferior-repl)
-	  *command-continuation*
 	  command-reader-reset-continuation))
 
 (define-package (edwin keyboard)
@@ -1018,37 +1021,4 @@ MIT in each case. |#
 	  edwin-variable$bindings-window-fraction)
   (import (runtime debugger-utilities)
 	  show-environment-bindings)
-  (initialization (initialize-bochser-mode!)))
-
-(define-package (edwin thread)
-  (files "thread")
-  (parent (edwin))
-  (export (edwin)
-	  allow-preempt-current-thread
-	  block-thread-events
-	  condition-type:thread-deadlock
-	  condition-type:thread-detached
-	  condition-type:thread-error
-	  create-initial-thread
-	  create-thread
-	  current-thread
-	  detach-thread
-	  disallow-preempt-current-thread
-	  exit-current-thread
-	  join-thread
-	  lock-thread-mutex
-	  make-thread-mutex
-	  other-running-threads?
-	  set-thread-root-continuation!
-	  signal-thread-event
-	  sleep-current-thread
-	  suspend-current-thread
-	  thread-continuation
-	  thread-dead?
-	  thread-mutex?
-	  thread?
-	  try-lock-thread-mutex
-	  unblock-thread-events
-	  unlock-thread-mutex
-	  within-thread-environment
-	  yield-current-thread))
\ No newline at end of file
+  (initialization (initialize-bochser-mode!)))
\ No newline at end of file
diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm
index eac5bc90c..26b9531ad 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.41 1992/02/04 04:03:13 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/intmod.scm,v 1.42 1992/02/08 15:23:37 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -71,6 +71,7 @@ but prefix argument means prompt for different environment."
    buffer
    (lambda ()
      (create-thread
+      command-reader-reset-continuation
       (lambda ()
 	(let ((thread (current-thread)))
 	  (detach-thread thread)
diff --git a/v7/src/edwin/make.scm b/v7/src/edwin/make.scm
index 80c47ccec..baa7895a2 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.65 1992/02/04 04:03:28 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.66 1992/02/08 15:23:39 cph Exp $
 
 Copyright (c) 1989-92 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 65 '()))
\ No newline at end of file
+(add-system! (make-system "Edwin" 3 66 '()))
\ No newline at end of file
diff --git a/v7/src/edwin/screen.scm b/v7/src/edwin/screen.scm
index 50cf4f497..3eeaa0a72 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.95 1992/02/04 04:04:04 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.96 1992/02/08 15:23:40 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -87,6 +87,7 @@
   (operation/write-substring! false read-only true)
   (preemption-modulus false read-only true)
   (root-window false)
+  (visibility 'VISIBLE)
   (needs-update? false)
   (in-update? false)
   (x-size false)
@@ -130,9 +131,12 @@
 			  'DESELECT-SCREEN))
 
 (define (screen-discard! screen)
-  (for-each (lambda (window) (send window ':kill!))
-	    (screen-window-list screen))
-  ((screen-operation/discard! screen) screen))
+  (if (not (eq? (screen-visibility screen) 'DELETED))
+      (begin
+	(set-screen-visibility! screen 'DELETED)
+	(for-each (lambda (window) (send window ':kill!))
+		  (screen-window-list screen))
+	((screen-operation/discard! screen) screen))))
 
 (define (screen-modeline-event! screen window type)
   ((screen-operation/modeline-event! screen) screen window type))
@@ -159,12 +163,23 @@
 (define (window-screen window)
   (editor-frame-screen (window-root-window window)))
 
+(define-integrable (screen-visible? screen)
+  (eq? 'VISIBLE (screen-visibility screen)))
+
+(define-integrable (screen-deleted? screen)
+  (eq? 'DELETED (screen-visibility screen)))
+
 (define (update-screen! screen display-style)
-  (if display-style (screen-force-update screen))
-  (with-screen-in-update screen display-style
-    (lambda ()
-      (editor-frame-update-display! (screen-root-window screen)
-				    display-style))))
+  (if (screen-visible? screen)
+      (begin
+	(if display-style (screen-force-update screen))
+	(with-screen-in-update screen display-style
+	  (lambda ()
+	    (editor-frame-update-display! (screen-root-window screen)
+					  display-style))))
+      (begin
+	(set-screen-needs-update?! screen false)
+	true)))
 
 ;;; Interface from update optimizer to terminal:
 
diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index 7b80b5a9b..434202ca0 100644
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.21 1992/01/13 20:15:26 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.22 1992/02/08 15:23:43 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -238,26 +238,24 @@ Includes the new backup.  Must be > 0."
 			(no-versions)))))))))))
 
 (define (os/directory-list directory)
-  ((ucode-primitive directory-close 0))
-  ((ucode-primitive directory-open-noread 1) directory)
-  (let loop ((result '()))
-    (let ((name ((ucode-primitive directory-read 0))))
-      (if name
-	  (loop (cons name result))
-	  (begin
-	    ((ucode-primitive directory-close 0))
-	    result)))))
+  (let ((channel (directory-channel-open directory)))
+    (let loop ((result '()))
+      (let ((name (directory-channel-read channel)))
+	(if name
+	    (loop (cons name result))
+	    (begin
+	      (directory-channel-close channel)
+	      result))))))
 
 (define (os/directory-list-completions directory prefix)
-  ((ucode-primitive directory-close 0))
-  ((ucode-primitive directory-open-noread 1) directory)
-  (let loop ((result '()))
-    (let ((name ((ucode-primitive directory-read-matching 1) prefix)))
-      (if name
-	  (loop (cons name result))
-	  (begin
-	    ((ucode-primitive directory-close 0))
-	    result)))))
+  (let ((channel (directory-channel-open directory)))
+    (let loop ((result '()))
+      (let ((name (directory-channel-read-matching channel prefix)))
+	(if name
+	    (loop (cons name result))
+	    (begin
+	      (directory-channel-close channel)
+	      result))))))
 
 (define-integrable os/file-directory?
   (ucode-primitive file-directory?))
diff --git a/v7/src/edwin/xterm.scm b/v7/src/edwin/xterm.scm
index 0942ece49..048872b3a 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.25 1992/02/04 04:04:50 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.26 1992/02/08 15:23:45 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -57,9 +57,9 @@
   (x-display-sync 2)
   (x-window-beep 1)
   (x-window-display 1)
-  (x-window-set-class-hint 4)
   (x-window-set-event-mask 2)
   (x-window-set-icon-name 2)
+  (x-window-set-input-focus 2)
   (x-window-set-name 2)
   (xterm-clear-rectangle! 6)
   (xterm-draw-cursor 1)
@@ -97,11 +97,15 @@
 (define-integrable event-type:leave 7)
 (define-integrable event-type:motion 8)
 (define-integrable event-type:expose 9)
-(define-integrable number-of-event-types 10)
+(define-integrable event-type:delete-window 10)
+(define-integrable event-type:map 11)
+(define-integrable event-type:unmap 12)
+(define-integrable event-type:take-focus 13)
+(define-integrable number-of-event-types 14)
 
 ;; This mask contains button-down, button-up, configure, focus-in,
-;; key-press, and expose.
-(define-integrable event-mask #x257)
+;; key-press, expose, destroy, map, and unmap.
+(define-integrable event-mask #x1e57)
 
 (define-structure (xterm-screen-state
 		   (constructor make-xterm-screen-state (xterm display))
@@ -121,9 +125,8 @@
 					(error "unable to open display"))
 				    (and (not (default-object? geometry))
 					 geometry)
-				    false)))
+				    '("edwin" . "Edwin"))))
 	   (x-window-set-event-mask xterm event-mask)
-	   (x-window-set-class-hint display xterm "edwin" "Edwin")
 	   (make-screen (make-xterm-screen-state xterm
 						 (x-window-display xterm))
 			xterm-screen/beep
@@ -201,7 +204,9 @@
   (set-screen-selected?! screen true)
   (let ((xterm (screen-xterm screen)))
     (xterm-enable-cursor xterm true)
-    (xterm-draw-cursor xterm))
+    (xterm-draw-cursor xterm)
+    (if (and last-focus-time (screen-visible? screen))
+	(x-window-set-input-focus xterm last-focus-time)))
   (xterm-screen/flush! screen))
 
 (define (xterm-screen/exit! screen)
@@ -267,6 +272,7 @@
 		 (read-event queue display time-limit))))
 	  (process-key-press-event
 	   (lambda (event)
+	     (set! last-focus-time (vector-ref event 5))
 	     (set! string (vector-ref event 2))
 	     (set! end (string-length string))
 	     (set! start end)
@@ -470,6 +476,7 @@
 
 (define-event-handler event-type:button-down
   (lambda (screen event)
+    (set! last-focus-time (vector-ref event 5))
     (let ((xterm (screen-xterm screen)))
       (send (screen-root-window screen) ':button-event!
 	    (make-down-button (vector-ref event 4))
@@ -479,13 +486,14 @@
 
 (define-event-handler event-type:button-up
   (lambda (screen event)
+    (set! last-focus-time (vector-ref event 5))
     (let ((xterm (screen-xterm screen)))
       (send (screen-root-window screen) ':button-event!
 	    (make-up-button (vector-ref event 4))
 	    (xterm-map-x-coordinate xterm (vector-ref event 2))
 	    (xterm-map-y-coordinate xterm (vector-ref event 3))))
     (update-screen! screen false)))
-
+
 (define-event-handler event-type:focus-in
   (lambda (screen event)
     event
@@ -493,14 +501,52 @@
 	(command-reader/reset-and-execute
 	 (lambda ()
 	   (select-screen screen))))))
+
+(define-event-handler event-type:delete-window
+  (lambda (screen event)
+    event
+    (if (not (screen-deleted? screen))
+	(if (other-screen screen)
+	    (delete-screen! screen)
+	    (begin
+	      (save-buffers-kill-edwin)
+	      ;; Return here only if user changes mind about killing
+	      ;; editor.  In that case, the screen will need updating.
+	      (update-screen! screen false))))))
+
+(define-event-handler event-type:map
+  (lambda (screen event)
+    event
+    (if (not (screen-deleted? screen))
+	(begin
+	  (set-screen-visibility! screen 'VISIBLE)
+	  (update-screen! screen true)))))
+
+(define-event-handler event-type:unmap
+  (lambda (screen event)
+    event
+    (if (not (screen-deleted? screen))
+	(begin
+	  (set-screen-visibility! screen 'INVISIBLE)
+	  (if (selected-screen? screen)
+	      (let ((screen (other-screen screen)))
+		(if screen
+		    (select-screen screen))))))))
+
+(define-event-handler event-type:take-focus
+  (lambda (screen event)
+    (set! last-focus-time (vector-ref event 2))
+    (select-screen screen)))
 
 (define signal-interrupts?)
 (define event-stream-mutex)
 (define previewer-interval 1000)
+(define last-focus-time)
 
 (define (with-editor-interrupts-from-x receiver)
   (fluid-let ((signal-interrupts? true)
-	      (event-stream-mutex (make-thread-mutex)))
+	      (event-stream-mutex (make-thread-mutex))
+	      (last-focus-time false))
     (queue-initial-thread preview-event-stream)
     (receiver (lambda (thunk) (thunk)) '())))