From: Mark Friedman <edu/mit/csail/zurich/markf>
Date: Fri, 31 Aug 1990 20:18:01 +0000 (+0000)
Subject: Support for multiple screens.
X-Git-Tag: 20090517-FFI~11226
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=af72e5878837c7fa862271ed2cabd7b9e9563e87;p=mit-scheme.git

Support for multiple screens.
---

diff --git a/v7/src/edwin/bufcom.scm b/v7/src/edwin/bufcom.scm
index 7ba1a416e..bf4a21a52 100644
--- a/v7/src/edwin/bufcom.scm
+++ b/v7/src/edwin/bufcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufcom.scm,v 1.83 1989/08/09 13:16:45 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufcom.scm,v 1.84 1990/08/31 20:11:47 markf Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -73,6 +73,21 @@ specifying a non-existent buffer will cause it to be created."
   (prompt-for-select-buffer "Switch to buffer")
   (lambda (buffer)
     (select-buffer (find-buffer buffer))))
+
+(define-command switch-to-buffer-in-new-screen
+  "Select buffer in a new screen."
+  (prompt-for-select-buffer "Switch to buffer in a new screen.")
+  (lambda (buffer)
+    (create-new-frame (find-buffer buffer))))
+
+(define-command create-buffer-in-new-screen
+  "Create a new buffer with a given name, and select it in a new screen."
+  "sCreate buffer in a new screen"
+  (lambda (name)
+    (let ((buffer (new-buffer name)))
+      (set-buffer-major-mode! buffer (ref-variable editor-default-mode))
+      (create-new-frame buffer))))
+
 (define-command switch-to-buffer-other-window
   "Select buffer in another window."
   (prompt-for-select-buffer "Switch to buffer in other window")
diff --git a/v7/src/edwin/curren.scm b/v7/src/edwin/curren.scm
index c68da1732..b3c1cf36a 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.86 1989/08/12 08:31:40 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.87 1990/08/31 20:11:51 markf Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -46,6 +46,82 @@
 
 (declare (usual-integrations))
 
+;;;; Editor frames
+
+(define (change-frame new-frame)
+  (set-editor-current-frame-window! current-editor new-frame))
+
+(define (create-new-frame #!optional buffer)
+  (without-interrupts
+   (lambda ()
+     (let* ((new-screen (make-editor-screen #f))
+	    (new-frame
+	     (make-editor-frame
+	      new-screen
+	      (if (default-object? buffer)
+		  (current-buffer)
+		  buffer)
+	      (make-buffer " *Typein-0*"))))
+       (set-screen-window! new-screen new-frame)
+       (editor-add-screen! current-editor new-screen)
+       (editor-add-frame! current-editor new-frame)
+       (let ((hook (ref-variable select-buffer-hook)))
+	 (if hook (hook buffer new-frame)))))))
+
+(define (delete-frame! frame)
+  (let ((screen (editor-frame-screen frame)))
+    (editor-delete-screen! current-editor screen)
+    (editor-delete-frame! current-editor frame)
+    (screen-discard! screen)))
+
+(define (delete-current-frame!) (delete-frame! (current-editor-frame)))
+
+;;;; Screens
+
+;; This version of change-screen was meant to be used in conjunction
+;; with the reader-continuation stuff in edtfrm.scm and input.scm. But
+;; since that stuff doesn't quite work I'm commenting out this
+;; version.
+#|
+(define (change-screen screen)
+  (let ((old-frame (current-editor-frame))
+	(my-frame (screen-window screen)))
+    (change-frame  my-frame)
+    (set-editor-input-port! (current-editor-input-port))
+    (without-interrupts
+     (lambda ()
+       (change-local-bindings!
+	(window-buffer (editor-frame-selected-window old-frame))
+	(window-buffer (editor-frame-selected-window my-frame))
+	(lambda () unspecific))))
+    (update-screens! #t)
+    (change-reading my-frame old-frame)))
+|#
+
+(define (change-screen screen)
+  (let ((old-frame (current-editor-frame))
+	(my-frame (screen-window screen)))
+    (set-reader-do-before-next-read!
+     (lambda ()
+       (change-frame  my-frame)
+       (set-editor-input-port! (current-editor-input-port))
+       (without-interrupts
+	(lambda ()
+	  (change-local-bindings!
+	   (window-buffer (editor-frame-selected-window old-frame))
+	   (window-buffer (editor-frame-selected-window my-frame))
+	   (lambda () unspecific))))
+       (update-screens! #t)))
+    (^G-signal)))
+
+(define (delete-screen! screen)
+  (let ((frame (screen-window screen)))
+    (editor-delete-frame! current-editor frame)
+    (editor-delete-screen! current-editor screen)
+    (screen-discard! screen)))
+
+(define (delete-current-screen!) (delete-screen! (current-screen)))
+
 ;;;; Windows
 
 (define-integrable (current-window)
@@ -183,6 +259,13 @@
 	  (loop (cdr windows) new-buffer))))
   (bufferset-kill-buffer! (current-bufferset) buffer))
 
+(define-variable select-buffer-hook
+  "If not false, a procedure to call when a buffer is selected.
+The procedure is passed the new buffer and the window in which 
+it is selected.
+The buffer is guaranteed to be selected at that time."
+  false)
+
 (define-integrable (select-buffer buffer)
   (set-window-buffer! (current-window) buffer true))
 
@@ -202,7 +285,11 @@
 	    buffer
 	    (lambda () (%set-window-buffer! window buffer)))
 	   (if record? (bufferset-select-buffer! (current-bufferset) buffer)))
-	 (%set-window-buffer! window buffer)))))
+	 (%set-window-buffer! window buffer))
+     (if (not (minibuffer? buffer))
+	 (let ((hook (ref-variable select-buffer-hook)))
+	   (if hook (hook buffer window)))))))
+
 (define (with-selected-buffer buffer thunk)
   (let ((old-buffer))
     (dynamic-wind (lambda ()
diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm
index 583f800af..416fdb3c5 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.10 1989/08/29 21:39:43 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/decls.scm,v 1.11 1990/08/31 20:11:55 markf Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -155,6 +155,7 @@ MIT in each case. |#
 	      "regexp"
 	      "replaz"
 	      "schmod"
+	      "scrcom"
 	      "sercom"
 	      "struct"
 	      "syntax"
diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index a85dcd49e..6a0890450 100644
--- a/v7/src/edwin/editor.scm
+++ b/v7/src/edwin/editor.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.193 1990/06/20 23:01:51 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.194 1990/08/31 20:12:00 markf Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -108,7 +108,7 @@
       (initialize-display-type!))
   (set! edwin-editor
 	(let ((screen (apply make-editor-screen make-screen-args)))
-	  (make-editor "Edwin" screen (make-editor-input-port screen))))
+	  (make-editor "Edwin" screen)))
   (set! edwin-initialization
 	(lambda ()
 	  (set! edwin-initialization false)
@@ -120,7 +120,9 @@
    (lambda ()
      (if edwin-editor
 	 (begin
-	   (screen-discard! (editor-screen edwin-editor))
+	   (for-each (lambda (screen)
+		       (screen-discard! screen))
+		     (editor-screens edwin-editor))
 	   (set! edwin-editor false)
 	   unspecific)))))
 
@@ -177,6 +179,13 @@ with the contents of the startup message."
 
 (define (within-editor?)
   (not (unassigned? current-editor)))
+
+;;; There is a problem with recursive edits and multiple screens.
+;;; When you switch screens the recursive edit aborts. The problem
+;;; is that a top level ^G in a recursive edit aborts the recursive
+;;; edit and a ^G is signalled when you switch screens. I think that
+;;; ^G should not abort a recursive edit.
+
 (define (enter-recursive-edit)
   (let ((value
 	 (call-with-current-continuation
diff --git a/v7/src/edwin/edtfrm.scm b/v7/src/edwin/edtfrm.scm
index 57e53e1cb..05b9fd37c 100644
--- a/v7/src/edwin/edtfrm.scm
+++ b/v7/src/edwin/edtfrm.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtfrm.scm,v 1.79 1989/08/11 11:50:30 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtfrm.scm,v 1.80 1990/08/31 20:12:04 markf Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989 Massachusetts Institute of Technology
 ;;;
@@ -55,7 +55,15 @@
    selected-window
    cursor-window
    select-time
-   properties))
+   properties
+   typein-bufferset
+   input-port
+   ;; The reader-continuation is intended to be used to switch
+   ;; between reader loops for different editor frames. However,
+   ;; its interactions with typein and typeout don't quite work, so
+   ;; I'm commenting out the code that deals with this.
+   ;reader-continuation
+   ))
 
 (define (make-editor-frame root-screen main-buffer typein-buffer)
   (let ((window (make-object editor-frame)))
@@ -68,6 +76,9 @@
       (set! redisplay-flags (list false))
       (set! inferiors '())
       (set! properties (make-1d-table))
+      (set! typein-bufferset (make-bufferset typein-buffer))
+      (set! input-port (make-editor-input-port root-screen))
+      (bufferset-guarantee-buffer! typein-bufferset typein-buffer)
       (let ((main-window (make-buffer-frame window main-buffer true))
 	    (typein-window (make-buffer-frame window typein-buffer false)))
 	(set! screen root-screen)
@@ -78,9 +89,31 @@
 	(set! select-time 2)
 	(set-window-select-time! main-window 1)
 	(=> (window-cursor main-window) :enable!))
-      (set-editor-frame-size! window x-size y-size))
+      (set-editor-frame-size! window x-size y-size)
+#|
+      (set! reader-continuation (lambda (who-cares)
+				  who-cares ;ignore
+				  (top-level-command-reader
+				   (lambda ()
+				     (initialize-typein!)
+				     (initialize-typeout!)))))
+|#
+      )
     window))
+#|
+(define (set-editor-frame-reader-continuation! window cont)
+  (with-instance-variables editor-frame window (cont)
+    (set! reader-continuation cont)))
 
+(define (change-reader new-window old-window)
+  (with-instance-variables editor-frame new-window ()
+    (switch-reader
+     reader-continuation
+     (lambda (current-reader)
+       (set-editor-frame-reader-continuation!
+	old-window
+	current-reader)))))
+|#
 (define-method editor-frame (:update-root-display! window display-style)
   (with-instance-variables editor-frame window (display-style)
     (with-screen-in-update! screen
@@ -132,6 +165,15 @@
 (define-integrable (editor-frame-screen window)
   (with-instance-variables editor-frame window ()
     screen))
+
+(define-integrable (editor-frame-typein-bufferset window)
+  (with-instance-variables editor-frame window ()
+    typein-bufferset))
+
+(define-integrable (editor-frame-input-port window)
+  (with-instance-variables editor-frame window ()
+    input-port))
+
 (define (editor-frame-windows window)
   (cons (editor-frame-typein-window window)
 	(let ((start (editor-frame-window0 window)))
diff --git a/v7/src/edwin/edtstr.scm b/v7/src/edwin/edtstr.scm
index 4ca6fb499..f96218cac 100644
--- a/v7/src/edwin/edtstr.scm
+++ b/v7/src/edwin/edtstr.scm
@@ -46,50 +46,71 @@
 
 (define-structure (editor (constructor %make-editor))
   (name false read-only true)
-  (screen false read-only true)
-  (input-port false read-only true)
-  (frame-window false read-only true)
+  (screens false)
+  (current-frame-window false)
   (bufferset false read-only true)
   (kill-ring false read-only true)
   (char-history false read-only true)
-  (button-event false))
+  (button-event false)
+  (frame-windows false))
 
-(define (make-editor name screen input-port)
+(define (make-editor name screen)
   (let ((initial-buffer (make-buffer initial-buffer-name initial-buffer-mode)))
     (let ((bufferset (make-bufferset initial-buffer)))
       (let ((frame
 	     (make-editor-frame screen
 				initial-buffer
-				(bufferset-create-buffer bufferset
-							 " *Typein-0*"))))
+				(make-buffer " *Typein-0*"))))
 	(set-screen-window! screen frame)
 	(%make-editor name
-		      screen
-		      input-port
+		      (list screen)
 		      frame
 		      bufferset
 		      (make-ring 10)
 		      (make-ring 100)
-		      false)))))
+		      false
+		      (list frame))))))
+
+(define (editor-add-screen! editor screen)
+  (if (not (memq screen (editor-screens editor)))
+      (set-editor-screens! editor
+			   (cons screen
+				 (editor-screens editor)))))
+
+(define (editor-delete-screen! editor screen)
+  (set-editor-screens! editor
+		       (delq screen
+			     (editor-screens editor))))
+
+(define (editor-add-frame! editor screen)
+  (if (not (memq screen (editor-frame-windows editor)))
+      (set-editor-frame-windows! editor
+			   (cons screen
+				 (editor-frame-windows editor)))))
+
+(define (editor-delete-frame! editor screen)
+  (set-editor-frame-windows! editor
+		       (delq screen
+			     (editor-frame-windows editor))))
 
 (define-integrable (current-screen)
-  (editor-screen current-editor))
+  (editor-frame-screen (current-editor-frame)))
 
 (define-integrable (all-screens)
-  (list (current-screen)))
+  (editor-screens current-editor))
 
 (define-integrable (current-editor-input-port)
-  (editor-input-port current-editor))
+  (editor-frame-input-port (current-editor-frame)))
 
 (define-integrable (current-editor-frame)
-  (editor-frame-window current-editor))
+  (editor-current-frame-window current-editor))
 
 (define-integrable (all-editor-frames)
-  (list (current-editor-frame)))
+  (editor-frame-windows current-editor))
 
 (define-integrable (all-windows)
-  #|(append-map editor-frame-windows (all-editor-frames))|#
-  (editor-frame-windows (current-editor-frame)))
+  (append-map editor-frame-windows (all-editor-frames)))
+
 (define-integrable (current-bufferset)
   (editor-bufferset current-editor))
 
diff --git a/v7/src/edwin/edwin.ldr b/v7/src/edwin/edwin.ldr
index a3635af01..64c618219 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.7 1989/08/12 08:31:57 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.ldr,v 1.8 1990/08/31 20:17:56 markf Exp $
 ;;; program to load package contents
 ;;; **** This program (unlike most .ldr files) is not generated by a program.
 
@@ -101,6 +101,7 @@
     (load "iserch" (->environment '(EDWIN INCREMENTAL-SEARCH)))
     (load "texcom" environment)
     (load "wincom" environment)
+    (load "scrcom" environment)
     (load "xcom" (->environment '(EDWIN X-COMMANDS)))
     (load "modefs" environment)
     (load "rename" environment)
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index ddb41b636..71a27042f 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.14 1989/08/14 10:23:37 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.15 1990/08/31 20:18:01 markf Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -85,6 +85,7 @@ MIT in each case. |#
 	 "motcom"			; motion commands
 	 "replaz"			; replace commands
 	 "schmod"			; scheme mode
+	 "scrcom"			; screen commands
 	 "sercom"			; search commands
 	 "texcom"			; text commands
 	 "wincom"			; window commands
@@ -241,7 +242,8 @@ MIT in each case. |#
 	  button3-up
 	  button4-up
 	  button5-up
-	  x-display-type)
+	  x-display-type
+	  x-display-type-name)
   (export (edwin x-commands)
 	  screen-xterm)
   (initialization (initialize-package!)))
@@ -276,12 +278,16 @@ MIT in each case. |#
 	  button-downify
 	  button-upify
 	  button?
+	  change-reading
+	  editor-frame-input-port
 	  editor-frame-select-cursor!
 	  editor-frame-select-window!
 	  editor-frame-selected-window
 	  editor-frame-typein-window
+	  editor-frame-typein-bufferset
 	  editor-frame-window0
 	  editor-frame-windows
+	  editor-frame-screen
 	  edwin-variable$cursor-centering-point
 	  edwin-variable$mode-line-inverse-video
 	  edwin-variable$scroll-step
@@ -315,6 +321,7 @@ MIT in each case. |#
 	  window-point-coordinates
 	  window-point-x
 	  window-point-y
+	  window-root-window
 	  window-redraw!
 	  window-redraw-preserving-point!
 	  window-scroll-y-absolute!
@@ -407,6 +414,8 @@ MIT in each case. |#
 	  message-args->string
 	  reset-command-prompt!
 	  set-command-prompt!
+	  set-editor-input-port!
+	  set-reader-do-before-next-read!
 	  temporary-message
 	  with-editor-input-port))
 
diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm
index 0bfe104ae..229c540d4 100644
--- a/v7/src/edwin/filcom.scm
+++ b/v7/src/edwin/filcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.139 1989/08/12 08:32:08 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.140 1990/08/31 20:12:39 markf Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -52,6 +52,9 @@
 (define (find-file-other-window filename)
   (select-buffer-other-window (find-file-noselect filename true)))
 
+(define (find-file-in-new-screen filename)
+  (create-new-frame (find-file-noselect filename true)))
+
 (define (find-file-noselect filename warn?)
   (let ((pathname (pathname->absolute-pathname (->pathname filename))))
     (if (file-directory? pathname)
@@ -107,6 +110,11 @@ Like \\[kill-buffer] followed by \\[find-file]."
 	    (let ((buffer* (new-buffer "*dummy*")))
 	      (do-it)
 	      (kill-buffer buffer*)))))))
+
+(define-command find-file-in-new-screen
+  "Visit a file in a new screen."
+  "FFind file in new screen"
+  find-file-in-new-screen)
 
 (define-command revert-buffer
   "Replace the buffer text with the text of the visited file on disk.
diff --git a/v7/src/edwin/input.scm b/v7/src/edwin/input.scm
index b8eb8d172..10954dd48 100644
--- a/v7/src/edwin/input.scm
+++ b/v7/src/edwin/input.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/input.scm,v 1.81 1989/08/12 08:32:19 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/input.scm,v 1.82 1990/08/31 20:12:44 markf Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -172,12 +172,21 @@ B 3BAB8C
 	(if (not command-prompt-displayed?)
 	    (clear-message!)))))
 
+;; The reader-continuation is intended to be used to switch
+;; between reader loops for different editor frames. However,
+;; its interactions with typein and typeout don't quite work, so
+;; I'm commenting out the code that deals with this.
+;(define *reader-continuation* #f)
+
 (define editor-input-port)
 
 (define (with-editor-input-port new-port thunk)
   (fluid-let ((editor-input-port new-port))
     (thunk)))
 
+(define-integrable (set-editor-input-port! new-port)
+  (set! editor-input-port new-port))
+
 (define-integrable (keyboard-active? delay)
   (char-ready? editor-input-port delay))
 
@@ -231,4 +240,39 @@ B 3BAB8C
 	       (set! command-prompt-displayed? true)
 	       (set-message! command-prompt-string))
 	     (clear-message!))))
-  (remap-alias-char (read-char editor-input-port)))
\ No newline at end of file
+  (remap-alias-char
+   (let loop ()
+     (before-reading-maybe-do-something)
+     (let ((char
+#| see comment for *reader-continuation* 
+	    (call-with-current-continuation
+	     (lambda (continuation)
+	       (fluid-let ((*reader-continuation* continuation))
+|#
+		 (read-char editor-input-port)))
+#|
+	     )))
+|#
+       (if (and char (not (eof-object? char)))
+	   char
+	   (loop))))))
+
+#| see comment for *reader-continuation*
+(define (switch-reader new-reader save-old-reader)
+  (if *reader-continuation*
+      (save-old-reader *reader-continuation*))
+  (if (within-typein-edit?)
+      (abort-current-command (lambda () (new-reader #f)))
+      (new-reader #f)))
+|#
+
+(define *reader-do-before-next-read* #f)
+
+(define (set-reader-do-before-next-read! to-do)
+  (set! *reader-do-before-next-read* to-do))
+
+(define (before-reading-maybe-do-something)
+  (if *reader-do-before-next-read*
+      (begin
+	(*reader-do-before-next-read*)
+	(set! *reader-do-before-next-read* #f))))
\ No newline at end of file
diff --git a/v7/src/edwin/prompt.scm b/v7/src/edwin/prompt.scm
index e11ec3d06..b8ddb4b93 100644
--- a/v7/src/edwin/prompt.scm
+++ b/v7/src/edwin/prompt.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/prompt.scm,v 1.136 1989/08/14 09:49:13 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/prompt.scm,v 1.137 1990/08/31 20:12:48 markf Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -89,7 +89,8 @@ recursive minibuffers."
 		 (let ((window (typein-window)))
 		   (select-window window)
 		   (select-buffer
-		    (find-or-create-buffer
+		    (bufferset-find-or-create-buffer
+		     (editor-frame-typein-bufferset (current-editor-frame))
 		     (string-append " *Typein-"
 				    (number->string typein-edit-depth)
 				    "*")))
@@ -516,11 +517,13 @@ a repetition of this command will exit."
 	 (lambda (new-string)
 	   (let ((end (string-length new-string)))
 	     (let ((index
-		    (substring-find-next-char-not-of-syntax
-		     new-string
-		     (string-length string)
-		     end
-		     #\w)))	       (if index
+		    (and (string-prefix? string new-string)
+			 (substring-find-next-char-not-of-syntax
+			  new-string
+			  (string-length string)
+			  end
+			  #\w))))
+	       (if index
 		   (substring new-string 0 (1+ index))
 		   new-string))))))
     (let ((if-unique
diff --git a/v7/src/edwin/scrcom.scm b/v7/src/edwin/scrcom.scm
new file mode 100644
index 000000000..0b9be7c88
--- /dev/null
+++ b/v7/src/edwin/scrcom.scm
@@ -0,0 +1,61 @@
+;;; -*-Scheme-*-
+;;;
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/scrcom.scm,v 1.1 1990/08/31 20:12:53 markf Exp $
+;;;
+;;;	Copyright (c) 1987, 1989 Massachusetts Institute of Technology
+;;;
+;;;	This material was developed by the Scheme project at the
+;;;	Massachusetts Institute of Technology, Department of
+;;;	Electrical Engineering and Computer Science.  Permission to
+;;;	copy this software, to redistribute it, and to use it for any
+;;;	purpose is granted, subject to the following restrictions and
+;;;	understandings.
+;;;
+;;;	1. Any copy made of this software must include this copyright
+;;;	notice in full.
+;;;
+;;;	2. Users of this software agree to make their best efforts (a)
+;;;	to return to the MIT Scheme project any improvements or
+;;;	extensions that they make, so that these may be included in
+;;;	future releases; and (b) to inform MIT of noteworthy uses of
+;;;	this software.
+;;;
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
+;;;	research.
+;;;
+;;;	4. MIT has made no warrantee or representation that the
+;;;	operation of this software will be error-free, and MIT is
+;;;	under no obligation to provide any services, by way of
+;;;	maintenance, update, or otherwise.
+;;;
+;;;	5. In conjunction with products arising from the use of this
+;;;	material, there shall be no use of the name of the
+;;;	Massachusetts Institute of Technology nor of any adaptation
+;;;	thereof in any advertising, promotional, or sales literature
+;;;	without prior written consent from MIT in each case.
+;;;
+;;; NOTE: Parts of this program (Edwin) were created by translation
+;;; from corresponding parts of GNU Emacs.  Users should be aware that
+;;; the GNU GENERAL PUBLIC LICENSE may apply to these parts.  A copy
+;;; of that license should have been included along with this file.
+;;;
+
+;;;; Screen Commands
+
+(declare (usual-integrations))
+
+(define-command delete-screen
+  "Delete the screen that point is in. If this is the last screen,
+then a message is diplayed and the screen is not deleted."
+  ()
+  (lambda ()
+    (if (> (length (all-screens)) 1)
+	(delete-current-screen!)
+	(message "Can't delete the last screen."))))
+
+(define-command create-new-screen
+  "Create a new screen with the current buffer in it."
+  ()
+  (lambda () (create-new-frame (current-buffer))))
\ No newline at end of file
diff --git a/v7/src/edwin/xcom.scm b/v7/src/edwin/xcom.scm
index d84acb447..5898bac65 100644
--- a/v7/src/edwin/xcom.scm
+++ b/v7/src/edwin/xcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xcom.scm,v 1.3 1989/08/12 08:32:52 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xcom.scm,v 1.4 1990/08/31 20:13:00 markf Exp $
 ;;;
 ;;;	Copyright (c) 1989 Massachusetts Institute of Technology
 ;;;
@@ -69,7 +69,9 @@
   (x-window-set-internal-border-width 2)
   (xterm-x-size 1)
   (xterm-y-size 1)
-  (xterm-set-size 3))
+  (xterm-set-size 3)
+  (x-set-window-name 2)
+  (x-set-icon-name 2))
 
 (define (current-xterm)
   (screen-xterm (current-screen)))
@@ -243,6 +245,18 @@ When called interactively, completion is available on the input."
      "watch"
      "xterm"))
 
+(define-command x-set-window-name
+  "Set X window name to NAME."
+  "sSet X window name"
+  (lambda (name)
+    (x-set-window-name (current-xterm) name)))
+
+(define-command x-set-icon-name
+  "Set X window icon name to NAME."
+  "sSet X window icon name"
+  (lambda (name)
+    (x-set-icon-name (current-xterm) name)))
+
 ;;;; Mouse Commands
 
 (define-command x-mouse-select
@@ -316,4 +330,23 @@ Display cursor at that position for a second."
 (define-key 'fundamental button4-up 'x-mouse-ignore)
 (define-key 'fundamental button5-up 'x-mouse-ignore)
 
-(define-key 'fundamental button1-down 'x-mouse-set-point)
\ No newline at end of file
+(define-key 'fundamental button1-down 'x-mouse-set-point)
+
+;;; set X window name and X icon name to current buffer name
+(let ((old-hook (ref-variable select-buffer-hook))
+      (new-hook
+       (lambda (buffer window)
+	 (if (eq? (editor-display-type) x-display-type-name)
+	     (let ((xterm
+		    (screen-xterm
+		     (editor-frame-screen (window-root-window window))))
+		   (name (buffer-name buffer)))
+	       (x-set-window-name xterm name)
+	       (x-set-icon-name xterm name))))))
+  (set-variable!
+   select-buffer-hook
+   (if old-hook
+       (lambda (buffer window)
+	 (old-hook buffer window)
+	 (new-hook buffer window))
+       new-hook)))
\ No newline at end of file
diff --git a/v7/src/edwin/xterm.scm b/v7/src/edwin/xterm.scm
index 665b6e782..8adffea95 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.8 1989/08/12 08:32:56 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.9 1990/08/31 20:13:06 markf Exp $
 ;;;
 ;;;	Copyright (c) 1989 Massachusetts Institute of Technology
 ;;;
@@ -65,7 +65,11 @@
   (xterm-read-chars 2)
   (xterm-button 1)
   (xterm-pointer-x 1)
-  (xterm-pointer-y 1))
+  (xterm-pointer-y 1)
+  (x-dequeue-global-event 0)
+  (x-window-pixel-coord->char-coord 2)
+  (x-set-window-name 2)
+  (x-set-icon-name 2))
 
 (define-structure (xterm-screen-state
 		   (constructor make-xterm-screen-state (xterm))
@@ -74,40 +78,52 @@
   (highlight 0))
 
 (define (make-xterm-screen #!optional geometry)
-  (make-screen (make-xterm-screen-state
-		(xterm-open-window (or (get-x-display)
+  (let* ((xterm (xterm-open-window (or (get-x-display)
 				       (error "unable to open display"))
 				   (and (not (default-object? geometry))
 					geometry)
 				   false))
-	       xterm-screen/beep
-	       xterm-screen/finish-update!
-	       xterm-screen/flush!
-	       xterm-screen/inverse-video!
-	       xterm-screen/start-update!
-	       xterm-screen/subscreen-clear!
-	       xterm-screen/write-char!
-	       xterm-screen/write-cursor!
-	       xterm-screen/write-substring!
-	       xterm-screen/write-substrings!
-	       xterm-screen/x-size
-	       xterm-screen/y-size
-	       xterm-screen/wipe!
-	       xterm-screen/enter!
-	       xterm-screen/exit!
-	       xterm-screen/discard!))
+	 (screen (make-screen (make-xterm-screen-state xterm)
+			      xterm-screen/beep
+			      xterm-screen/finish-update!
+			      xterm-screen/flush!
+			      xterm-screen/inverse-video!
+			      xterm-screen/start-update!
+			      xterm-screen/subscreen-clear!
+			      xterm-screen/write-char!
+			      xterm-screen/write-cursor!
+			      xterm-screen/write-substring!
+			      xterm-screen/write-substrings!
+			      xterm-screen/x-size
+			      xterm-screen/y-size
+			      xterm-screen/wipe!
+			      xterm-screen/enter!
+			      xterm-screen/exit!
+			      xterm-screen/discard!)))
+    (add-to-xterm-screen-alist xterm screen)
+    screen))
 
 (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 xterm-screen-alist '())
+
+(define (add-to-xterm-screen-alist xterm screen)
+  (set! xterm-screen-alist (cons (cons xterm screen) xterm-screen-alist)))
+
+(define (xterm->screen xterm)
+  (let ((entry (assv xterm xterm-screen-alist)))
+    (and entry (cdr entry))))
 
 (define-integrable (set-screen-highlight! screen highlight)
   (set-xterm-screen-state/highlight! (screen-state screen) highlight))
 
 (define (xterm-screen/start-update! screen)
-  (xterm-screen/process-events! screen))
+  screen				;ignored
+  unspecific)
 
 (define (xterm-screen/finish-update! screen)
   (x-window-flush (screen-xterm screen)))
@@ -176,7 +192,8 @@
   unspecific)
 
 (define (xterm-screen/enter! screen)
-  screen				; ignored
+  (if (not (eq? screen (current-screen)))
+      (change-screen screen))
   unspecific)
 
 (define (xterm-screen/exit! screen)
@@ -259,19 +276,17 @@
 
 (define (refill-buffer! state index)
   (let ((screen (xterm-input-port-state/screen state)))
-    (let loop ()
-      (let ((buffer (xterm-screen/read-chars screen false)))
-	(if (not buffer)
-	    (loop)
-	    (begin
-	      (check-for-interrupts! state buffer index)
-	      (string-ref buffer 0)))))))
+    (let ((buffer (xterm-screen/read-chars screen #f)))
+      (and buffer
+	   (begin
+	     (check-for-interrupts! state buffer index)
+	     (string-ref buffer 0))))))
 
 (define (xterm-screen/read-chars screen interval)
   (let ((result (xterm-read-chars (screen-xterm screen) interval)))
     (if (and (not (screen-in-update? screen))
-	     (xterm-screen/process-events! screen))
-	(update-screen! screen false))
+	     (xterm-process-events!))
+	(update-screens! false))
     result))
 
 (define (check-for-interrupts! state buffer index)
@@ -319,76 +334,91 @@
 		    (if (and old-mask pending-interrupt?)
 			(signal-interrupt!))))))
 
-(define (xterm-screen/process-events! screen)
-  (let ((xterm (screen-xterm screen))
-	(window (screen-window screen)))
-    (and window
-	 (let ((handlers
-		(vector-ref xterm-event-flags->handlers
-			    (x-window-read-event-flags! xterm))))
-	   (and (not (null? handlers))
-		(begin
-		  (for-each (lambda (handler) (handler xterm window)) handlers)
-		  true))))))
-
-(define-integrable xterm-event-flag:resized 0)
-(define-integrable xterm-event-flag:button-down 1)
-(define-integrable xterm-event-flag:button-up 2)
-(define-integrable xterm-number-of-event-flags 3)
+
+;;; The values of these flags must be equal to the corresponding 
+;;; event types in microcode/x11.h
+
+(define-integrable x-event-type:unknown 0)
+(define-integrable x-event-type:resized 1)
+(define-integrable x-event-type:button-down 2)
+(define-integrable x-event-type:button-up 3)		
+(define-integrable x-event-type:focus_in 4)	
+(define-integrable x-event-type:focus_out 5)		
+(define-integrable x-event-type:enter 6)		
+(define-integrable x-event-type:leave 7)		
+(define-integrable x-event-type:motion 8)		
+(define-integrable x-event-type:configure 9)			
+(define-integrable x-event-type:map 10)		
+(define-integrable x-event-type:unmap 11)		
+(define-integrable x-event-type:expose 12)
+(define-integrable x-event-type:no_expose 13) 
+(define-integrable x-event-type:graphics_expose 14) 
+(define-integrable x-event-type:key_press 15) 
+
+(define-integrable xterm-number-of-event-types 16)
+
+(define-integrable event-type car)
+(define-integrable event-xterm cadr)
+(define-integrable event-extra cddr)
+
+(define (xterm-process-events!)
+  (let ((event (x-dequeue-global-event)))
+    (and event
+	 (let loop ((event event))
+	   (if (null? event)
+	       true
+	       (let ((event-type (event-type event))
+		     (screen (xterm->screen (event-xterm event)))
+		     (extra (event-extra event)))
+		 (let ((handler (x-event-type->handler event-type)))
+		   (if handler (apply handler screen extra))
+		   (if (eq? event-type x-event-type:key_press)
+		       true
+		       (loop (x-dequeue-global-event))))))))))
+
+(define xterm-event-handlers
+  (make-vector xterm-number-of-event-types false))
+
+(define-integrable (x-event-type->handler event-type)
+  (vector-ref xterm-event-handlers event-type))
 
 (define (define-xterm-event-handler event handler)
   (vector-set! xterm-event-handlers event handler)
-  (set! xterm-event-flags->handlers
-	(binary-powerset-vector xterm-event-handlers))
   unspecific)
 
-(define (binary-powerset-vector items)
-  (let ((n-items (vector-length items)))
-    (let ((table-length (expt 2 n-items)))
-      (let ((table (make-vector table-length '())))
-	(let loop ((i 1))
-	  (if (< i table-length)
-	      (begin
-		(vector-set!
-		 table
-		 i
-		 (let loop ((i i) (index 0))
-		   (if (zero? i)
-		       '()
-		       (let ((qr (integer-divide i 2)))
-			 (let ((rest
-				(loop (integer-divide-quotient qr)
-				      (1+ index))))
-			   (if (zero? (integer-divide-remainder qr))
-			       rest
-			       (cons (vector-ref items index) rest)))))))
-		(loop (1+ i)))))
-	table))))
+(define-xterm-event-handler x-event-type:configure
+  (lambda (screen)
+    (let ((xterm (screen-xterm screen)))
+      (send (screen-window screen) ':set-size!
+	    (xterm-x-size xterm)
+	    (xterm-y-size xterm)))))
+
+(define-xterm-event-handler x-event-type:button-down
+  (lambda (screen button x y)
+    (let ((character-coords
+	  (x-window-pixel-coord->char-coord
+	   (screen-xterm screen)
+	   (cons x y))))
+      (send (screen-window screen) ':button-event!
+	    (button-downify button)
+	    (car character-coords)
+	    (cdr character-coords)))))
+
+(define-xterm-event-handler x-event-type:button-up
+  (lambda (screen button x y)
+    (let ((character-coords
+	  (x-window-pixel-coord->char-coord
+	   (screen-xterm screen)
+	   (cons x y))))
+      (send (screen-window screen) ':button-event!
+	    (button-upify button)
+	    (car character-coords)
+	    (cdr character-coords)))))
+
+(define-xterm-event-handler x-event-type:focus_in
+  (lambda (screen)
+    (xterm-screen/enter! screen)))
 
-(define xterm-event-handlers
-  (make-vector xterm-number-of-event-flags false))
-
-(define xterm-event-flags->handlers)
-  
-(define-xterm-event-handler xterm-event-flag:resized
-  (lambda (xterm window)
-    (send window ':set-size!
-	  (xterm-x-size xterm)
-	  (xterm-y-size xterm))))
-
-(define-xterm-event-handler xterm-event-flag:button-down
-  (lambda (xterm window)
-    (send window ':button-event!
-	  (button-downify (xterm-button xterm))
-	  (xterm-pointer-x xterm)
-	  (xterm-pointer-y xterm))))
-
-(define-xterm-event-handler xterm-event-flag:button-up
-  (lambda (xterm window)
-    (send window ':button-event!
-	  (button-upify (xterm-button xterm))
-	  (xterm-pointer-x xterm)
-	  (xterm-pointer-y xterm))))
 
 (define button1-down)
 (define button2-down)
@@ -417,9 +447,11 @@
   (set! x-display-data false)
   unspecific)
 
+(define x-display-type-name 'X)
+
 (define (initialize-package!)
   (set! x-display-type
-	(make-display-type 'X
+	(make-display-type x-display-type-name
 			   get-x-display
 			   make-xterm-screen
 			   make-xterm-input-port
@@ -437,4 +469,4 @@
   (set! button3-up (button-upify 2))
   (set! button4-up (button-upify 3))
   (set! button5-up (button-upify 4))
-  unspecific)
\ No newline at end of file
+  unspecific)