From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 6 Oct 1990 00:16:37 +0000 (+0000)
Subject: * Add new procedure `window-override-message' that returns the
X-Git-Tag: 20090517-FFI~11138
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=28699b365dd10cf8d797b3e879af9500637e4b2e;p=mit-scheme.git

* Add new procedure `window-override-message' that returns the
  override message, or #F if none.  This is used to implement
  `current-message', which operates on the current typein window.
  `clear-message!' renamed to `clear-current-message!'.
  `set-message!', renamed to `set-current-message!', now accepts #F as
  an argument, in which case it acts like `clear-current-message!'.

* Split `select-buffer-in-new-screen' into two parts: a procedure
  `make-screen' that generates a new screen, and a call to
  `select-screen'.  The new procedure `make-screen' replaces the
  procedure of the same name which is now considered internal to the
  screen abstraction.

* Change `select-screen' not to abort to top level, to run the
  `select-buffer-hook', and to transfer the typein override message
  from the previously-selected screen to the newly-selected one.  The
  X screen event handler now does the abort to top level, since it is
  still needed in that case.

* Eliminate the typein bufferset -- typein buffers are shared by all
  screens.  Display of the typein buffers is suppressed in
  non-selected screens by a blank override message.  This has the
  drawback that direct update of the typein window does not work if
  there are multiple screens, which makes typein feel sluggish.

* Implement procedures `screen0', `screen1+', `screen-1+', and
  `screen+' for moving around the screen list.

* `buffer-list' no longer copies its result -- don't clobber it!

* New procedure `change-selected-buffer' makes the handling of buffer
  selection more uniform.

* Eliminate cacheing of `editor-input-port' from "input.scm".  Just
  extract the input port from `current-editor' every time.  Change the
  keyboard reader to use `input-port/read-char' instead of
  `read-char', since the former is faster.

* Redesign the `button' abstraction to make it cleaner and more
  general.  Rename the `buttonN-down' and `buttonN-up' variables to
  `x-buttonN-down' and `x-buttonN-up'.  Change button-handling code so
  that up buttons don't beep if they aren't bound to commands.

* Updating of an X screen is now terminated if a non-keypress event
  arrives while checking for update preemption.  This is done by
  throwing out of the update.  I believe this test only happens in
  places where it is safe to do this.

* Make screen highlight control independent of the screen type.
  Change screen abstractions so that screens support two operations,
  one to turn on highlighting, and the other to turn it off.
---

diff --git a/v7/src/edwin/buffrm.scm b/v7/src/edwin/buffrm.scm
index 6a94b8d1f..011b888f0 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.35 1990/10/03 04:54:12 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffrm.scm,v 1.36 1990/10/06 00:15:22 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -47,7 +47,11 @@
 (declare (usual-integrations))
 
 (define-class buffer-frame combination-leaf-window
-  (text-inferior border-inferior modeline-inferior last-select-time))
+  (text-inferior
+   border-inferior
+   modeline-inferior
+   last-select-time
+   override-message))
 
 (define-integrable (buffer-frame? object)
   (object-of-class? buffer-frame object))
@@ -71,6 +75,7 @@
   (set! text-inferior (make-inferior frame buffer-window))
   (set! border-inferior (make-inferior frame vertical-border-window))
   (set! last-select-time 0)
+  (set! override-message false)
   unspecific)
 
 ;;; **** Kludge: The text-inferior will generate modeline events, so
@@ -188,11 +193,19 @@
 	(=> (inferior-window modeline-inferior) :event! type)))
   (screen-modeline-event! (window-screen frame) frame type))
 
-(define-integrable (window-set-override-message! window message)
+(define (window-set-override-message! window message)
+  (with-instance-variables buffer-frame window (message)
+    (set! override-message message))
   (set-override-message! (frame-text-inferior window) message))
 
-(define-integrable (window-clear-override-message! window)
-  (clear-override-message! (frame-text-inferior window)))
+(define (window-clear-override-message! window)
+  (clear-override-message! (frame-text-inferior window))
+  (with-instance-variables buffer-frame window ()
+    (set! override-message false)))
+
+(define (window-override-message window)
+  (with-instance-variables buffer-frame window ()
+    override-message))
 
 (define-integrable (window-home-cursor! window)
   (home-cursor! (frame-text-inferior window)))
diff --git a/v7/src/edwin/curren.scm b/v7/src/edwin/curren.scm
index 12916ef99..c029a8603 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.88 1990/10/03 04:54:33 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.89 1990/10/06 00:15:33 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -48,33 +48,34 @@
 
 ;;;; Screens
 
-(define (select-buffer-in-new-screen buffer)
+(define (make-screen buffer)
   (without-interrupts
    (lambda ()
      (let ((screen (make-editor-screen)))
-       (initialize-screen-root-window! screen buffer)
+       (initialize-screen-root-window! screen (current-bufferset) buffer)
        (editor-add-screen! current-editor screen)
-       (select-screen screen)
-       (event-distributor/invoke! (ref-variable select-buffer-hook)
-				  buffer
-				  (screen-selected-window screen))))))
-
-(define (select-screen screen)
-  (command-reader/reset-and-execute
-   (lambda ()
-     (without-interrupts
-      (lambda ()
-	(let ((buffer (window-buffer (screen-selected-window screen))))
-	  (change-local-bindings!
-	   (window-buffer (screen-selected-window (selected-screen)))
-	   buffer
-	   (lambda () (set-editor-selected-screen! current-editor screen)))
-	  (bufferset-select-buffer! (current-bufferset) buffer)))))))
+       (update-screen! screen false)
+       screen))))
 
 (define (delete-screen! screen)
   (editor-delete-screen! current-editor screen)
   (screen-discard! screen))
 
+(define (select-screen screen)
+  (without-interrupts
+   (lambda ()
+     (let ((message (current-message)))
+       (set-current-message! "")
+       (change-selected-buffer
+	(window-buffer (screen-selected-window screen))
+	true
+	(lambda ()
+	  (set-editor-selected-screen! current-editor screen)))
+       (set-current-message! message)))))
+
+(define (select-buffer-in-new-screen buffer)
+  (select-screen (make-screen buffer)))
+
 (define (update-screens! display-style)
   (let loop ((screens (screen-list)))
     (or (null? screens)
@@ -88,10 +89,10 @@
 (define-integrable (selected-screen? screen)
   (eq? screen (selected-screen)))
 
-(define-integrable (current-typein-bufferset)
-  (screen-typein-bufferset (selected-screen)))
+(define-integrable (screen0)
+  (car (screen-list)))
 
-(define (screen-next screen)
+(define (screen1+ screen)
   (let ((screens (screen-list)))
     (let ((s (memq screen screens)))
       (if (not s)
@@ -100,7 +101,7 @@
 	  (car screens)
 	  (cadr s)))))
 
-(define (screen-previous screen)
+(define (screen-1+ screen)
   (let ((screens (screen-list)))
     (if (eq? screen (car screens))
 	(car (last-pair screens))
@@ -110,6 +111,20 @@
 	  (if (eq? screen (car screens))
 	      (car previous)
 	      (loop screens (cdr screens)))))))
+
+(define (screen+ screen n)
+  (cond ((positive? n)
+	 (let loop ((n n) (screen screen))
+	   (if (= n 1)
+	       (screen1+ screen)
+	       (loop (-1+ n) (screen1+ screen)))))
+	((negative? n)
+	 (let loop ((n n) (screen screen))
+	   (if (= n -1)
+	       (screen-1+ screen)
+	       (loop (1+ n) (screen-1+ screen)))))
+	(else
+	 screen)))
 
 ;;;; Windows
 
@@ -125,22 +140,15 @@
 (define-integrable (window0)
   (screen-window0 (selected-screen)))
 
-(define-integrable (typein-window)
-  (screen-typein-window (selected-screen)))
-
-(define-integrable (typein-window? window)
-  (eq? window (screen-typein-window (window-screen window))))
-
 (define (select-window window)
   (without-interrupts
    (lambda ()
-     (let ((screen (window-screen window))
-	   (buffer (window-buffer window)))
-       (change-local-bindings!
-	(window-buffer (screen-selected-window screen))
-	buffer
-	(lambda () (screen-select-window! screen window)))
-       (bufferset-select-buffer! (current-bufferset) buffer)))))
+     (let ((screen (window-screen window)))
+       (if (selected-screen? screen)
+	   (change-selected-buffer (window-buffer window) true
+	     (lambda ()
+	       (screen-select-window! screen window)))
+	   (screen-select-window! screen window))))))
 
 (define-integrable (select-cursor window)
   (screen-select-cursor! (window-screen window) window))
@@ -182,13 +190,36 @@
 	  (else
 	   window))))
 
+(define-integrable (typein-window)
+  (screen-typein-window (selected-screen)))
+
+(define-integrable (typein-window? window)
+  (eq? window (screen-typein-window (window-screen window))))
+
+(define-integrable (current-message)
+  (window-override-message (typein-window)))
+
+(define (set-current-message! message)
+  (let ((window (typein-window)))
+    (if message
+	(window-set-override-message! window message)
+	(window-clear-override-message! window))
+    (if (not *executing-keyboard-macro?*)
+	(window-direct-update! window true))))
+
+(define (clear-current-message!)
+  (let ((window (typein-window)))
+    (window-clear-override-message! window)
+    (if (not *executing-keyboard-macro?*)
+	(window-direct-update! window true))))
+
 ;;;; Buffers
 
 (define-integrable (buffer-list)
-  (list-copy (bufferset-buffer-list (current-bufferset))))
+  (bufferset-buffer-list (current-bufferset)))
 
 (define-integrable (buffer-alive? buffer)
-  (memq buffer (bufferset-buffer-list (current-bufferset))))
+  (memq buffer (buffer-list)))
 
 (define-integrable (buffer-names)
   (bufferset-names (current-bufferset)))
@@ -242,12 +273,6 @@
 	  (loop (cdr windows) new-buffer))))
   (bufferset-kill-buffer! (current-bufferset) buffer))
 
-(define-variable select-buffer-hook
-  "An event distributor that is invoked when a buffer is selected.
-The new buffer and the window in which it is selected are passed as arguments.
-The buffer is guaranteed to be selected at that time."
-  (make-event-distributor))
-
 (define-integrable (select-buffer buffer)
   (set-window-buffer! (current-window) buffer true))
 
@@ -261,19 +286,24 @@ The buffer is guaranteed to be selected at that time."
   (without-interrupts
    (lambda ()
      (if (current-window? window)
-	 (begin
-	   (change-local-bindings!
-	    (window-buffer window)
-	    buffer
-	    (lambda () (%set-window-buffer! window buffer)))
-	   (if record?
-	       (bufferset-select-buffer! (current-bufferset) buffer))
-	   (if (not (minibuffer? buffer))
-	       (event-distributor/invoke! (ref-variable select-buffer-hook)
-					  buffer
-					  window)))
+	 (change-selected-buffer buffer record?
+	   (lambda ()
+	     (%set-window-buffer! window buffer)))
 	 (%set-window-buffer! window buffer)))))
 
+(define-variable select-buffer-hook
+  "An event distributor that is invoked when a buffer is selected.
+The new buffer and the window in which it is selected are passed as arguments.
+The buffer is guaranteed to be selected at that time."
+  (make-event-distributor))
+
+(define (change-selected-buffer buffer record? selection-thunk)
+  (change-local-bindings! (current-buffer) buffer selection-thunk)
+  (if record?
+      (bufferset-select-buffer! (current-bufferset) buffer))
+  (if (not (minibuffer? buffer))
+      (event-distributor/invoke! (ref-variable select-buffer-hook) buffer)))
+
 (define (with-selected-buffer buffer thunk)
   (let ((old-buffer))
     (dynamic-wind (lambda ()
diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index 560b7b825..41008ee3e 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.195 1990/10/03 04:54:47 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.196 1990/10/06 00:15:39 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -176,10 +176,7 @@ with the contents of the startup message."
   (fluid-let ((current-editor editor)
 	      (recursive-edit-continuation false)
 	      (recursive-edit-level 0))
-    (using-screen (selected-screen)
-      (lambda ()
-	(with-editor-input-port (current-editor-input-port)
-	  thunk)))))
+    (using-screen (selected-screen) thunk)))
 
 (define (within-editor?)
   (not (unassigned? current-editor)))
diff --git a/v7/src/edwin/edtfrm.scm b/v7/src/edwin/edtfrm.scm
index 9c3cff380..78b6f13f9 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.81 1990/10/03 04:54:53 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtfrm.scm,v 1.82 1990/10/06 00:15:44 cph Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -171,8 +171,6 @@
     (=> (window-cursor cursor-window) :disable!)
     (set! cursor-window window*)
     (=> (window-cursor cursor-window) :enable!)))
-
-;;;; Button Events
 
 (define-method editor-frame (:button-event! editor-frame button x y)
   (with-values
@@ -187,44 +185,11 @@
 		 (let ((command
 			(comtab-entry (buffer-comtabs (window-buffer frame))
 				      button)))
-		   (if command
-		       (with-current-button-event
-			(make-button-event frame relative-x relative-y)
-			(lambda () (execute-command command)))
-		       (editor-beep))))
-		((down-button? button)
-		 (editor-beep)))))))
-
-(define-integrable (button-upify button-number)
-  (vector-ref up-buttons button-number))
-
-(define-integrable (button-downify button-number)
-  (vector-ref down-buttons button-number))
-
-(define (button? object)
-  (or (up-button? object)
-      (down-button? object)))
-
-(define-integrable (up-button? object)
-  (vector-find-next-element up-buttons object))
-
-(define-integrable (down-button? object)
-  (vector-find-next-element down-buttons object))
-
-(define up-buttons '#())
-(define down-buttons '#())
-
-(define (initialize-buttons! number-of-buttons)
-  (set! up-buttons
-	(make-initialized-vector number-of-buttons make-up-button))
-  (set! down-buttons
-	(make-initialized-vector number-of-buttons make-down-button))
-  unspecific)
-
-(define (make-down-button button-number)
-  (string->symbol
-   (string-append "#[button-down-" (number->string button-number) "]")))
-
-(define (make-up-button button-number)
-  (string->symbol
-   (string-append "#[button-up-" (number->string button-number) "]")))
\ No newline at end of file
+		   (cond (command
+			  (with-current-button-event
+			   (make-button-event frame relative-x relative-y)
+			   (lambda () (execute-command command))))
+			 ((button/down? button)
+			  (editor-beep)))))
+		((button/down? button)
+		 (editor-beep)))))))
\ No newline at end of file
diff --git a/v7/src/edwin/edtstr.scm b/v7/src/edwin/edtstr.scm
index 913e81c01..e5d0f8f4a 100644
--- a/v7/src/edwin/edtstr.scm
+++ b/v7/src/edwin/edtstr.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtstr.scm,v 1.9 1990/10/03 04:54:57 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtstr.scm,v 1.10 1990/10/06 00:15:49 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -58,18 +58,21 @@
 
 (define (make-editor name screen)
   (let ((initial-buffer (make-buffer initial-buffer-name initial-buffer-mode)))
-    (initialize-screen-root-window! screen initial-buffer)
-    (%make-editor name
-		  (list screen)
-		  screen
-		  (make-bufferset initial-buffer)
-		  (make-ring 10)
-		  (make-ring 100)
-		  (make-editor-input-port screen)
-		  false)))
+    (let ((bufferset (make-bufferset initial-buffer)))
+      (initialize-screen-root-window! screen bufferset initial-buffer)
+      (%make-editor name
+		    (list screen)
+		    screen
+		    bufferset
+		    (make-ring 10)
+		    (make-ring 100)
+		    (make-editor-input-port screen)
+		    false))))
 
 (define (editor-add-screen! editor screen)
-  (set-editor-screens! editor (cons screen (editor-screens editor))))
+  (set-editor-screens! editor
+		       (append! (editor-screens editor)
+				(list screen))))
 
 (define (editor-delete-screen! editor screen)
   (let ((screens (delq! screen (editor-screens editor))))
@@ -78,7 +81,7 @@
     (set-editor-screens! editor screens)
     (if (eq? screen (editor-selected-screen editor))
 	(set-editor-selected-screen! editor (car screens)))))
-
+
 (define (screen-list)
   (editor-screens (if (within-editor?) current-editor edwin-editor)))
 
@@ -93,10 +96,7 @@
 
 (define-integrable (current-char-history)
   (editor-char-history current-editor))
-
-(define-integrable (current-editor-input-port)
-  (editor-input-port current-editor))
-
+
 (define-structure (button-event (conc-name button-event/))
   (window false read-only true)
   (x false read-only true)
@@ -124,4 +124,54 @@
        (set! button-event (editor-button-event current-editor))
        (set-editor-button-event! current-editor old-button-event)
        (set! old-button-event false)
-       unspecific))))
\ No newline at end of file
+       unspecific))))
+
+(define button-record-type
+  (make-record-type 'BUTTON '(NUMBER DOWN?)))
+
+(define make-down-button)
+(define make-up-button)
+(let ((%make-button
+       (let ((constructor
+	      (record-constructor button-record-type '(NUMBER DOWN?))))
+	 (lambda (buttons number down?)
+	   (or (vector-ref buttons number)
+	       (let ((button (constructor number down?)))
+		 (vector-set! buttons number button)
+		 button)))))
+      (down-buttons '#())
+      (up-buttons '#()))
+  (set! make-down-button
+	(lambda (number)
+	  (if (>= number (vector-length down-buttons))
+	      (set! down-buttons (vector-grow down-buttons (1+ number))))
+	  (%make-button down-buttons number true)))
+  (set! make-up-button
+	(lambda (number)
+	  (if (>= number (vector-length up-buttons))
+	      (set! up-buttons (vector-grow up-buttons (1+ number))))
+	  (%make-button up-buttons number false))))
+
+(define button?
+  (record-predicate button-record-type))
+
+(define button/number
+  (record-accessor button-record-type 'NUMBER))
+
+(define button/down?
+  (record-accessor button-record-type 'DOWN?))
+
+(define (down-button? object)
+  (and (button? object)
+       (button/down? object)))
+
+(define (up-button? object)
+  (and (button? object)
+       (not (button/down? object))))
+
+(set-record-type-unparser-method! button-record-type
+  (unparser/standard-method (record-type-name button-record-type)
+    (lambda (state button)
+      (unparse-string state (if (button/down? button) "down" "up"))
+      (unparse-char state #\space)
+      (unparse-object state (button/number button)))))
\ No newline at end of file
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index af4cc1101..795601a42 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.18 1990/10/03 04:55:02 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.19 1990/10/06 00:15:54 cph Exp $
 
 Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 
@@ -206,12 +206,12 @@ MIT in each case. |#
   (parent (edwin))
   (export (edwin)
 	  initialize-screen-root-window!
-	  make-screen
 	  screen-beep
 	  screen-discard!
 	  screen-enter!
 	  screen-exit!
 	  screen-flush!
+	  screen-highlight?
 	  screen-in-update?
 	  screen-modeline-event!
 	  screen-root-window
@@ -219,7 +219,6 @@ MIT in each case. |#
 	  screen-select-window!
 	  screen-selected-window
 	  screen-state
-	  screen-typein-bufferset
 	  screen-typein-window
 	  screen-window-list
 	  screen-window0
@@ -236,7 +235,10 @@ MIT in each case. |#
 	  window-screen
 	  with-screen-in-update!
 	  with-screen-inverse-video!)
+  (export (edwin console-screen)
+	  make-screen)
   (export (edwin x-screen)
+	  make-screen
 	  set-screen-x-size!
 	  set-screen-y-size!))
 
@@ -244,18 +246,7 @@ MIT in each case. |#
   (files "xterm")
   (parent (edwin))
   (export (edwin)
-	  button1-down
-	  button2-down
-	  button3-down
-	  button4-down
-	  button5-down
-	  button1-up
-	  button2-up
-	  button3-up
-	  button4-up
-	  button5-up
-	  x-display-type
-	  x-display-type-name)
+	  x-display-type)
   (export (edwin x-commands)
 	  screen-xterm)
   (initialization (initialize-package!)))
@@ -263,6 +254,17 @@ MIT in each case. |#
 (define-package (edwin x-commands)
   (files "xcom")
   (parent (edwin))
+  (export (edwin)
+	  x-button1-down
+	  x-button2-down
+	  x-button3-down
+	  x-button4-down
+	  x-button5-down
+	  x-button1-up
+	  x-button2-up
+	  x-button3-up
+	  x-button4-up
+	  x-button5-up)
   (export (edwin x-screen)
 	  update-xterm-screen-names!))
 
@@ -289,15 +291,11 @@ MIT in each case. |#
   (export ()
 	  reset-editor-windows)
   (export (edwin)
-	  button-downify
-	  button-upify
-	  button?
 	  edwin-variable$cursor-centering-point
 	  edwin-variable$mode-line-inverse-video
 	  edwin-variable$scroll-step
 	  edwin-variable$truncate-lines
 	  edwin-variable$truncate-partial-width-windows
-	  initialize-buttons!
 	  set-window-point!
 	  set-window-start-mark!
 	  window-buffer
@@ -317,6 +315,7 @@ MIT in each case. |#
 	  window-mark-visible?
 	  window-modeline-event!
 	  window-needs-redisplay?
+	  window-override-message
 	  window-point
 	  window-point-coordinates
 	  window-point-x
@@ -331,11 +330,6 @@ MIT in each case. |#
 	  window-setup-truncate-lines!
 	  window-start-index
 	  window-y-center)
-  (export (edwin prompt)
-	  clear-override-message!
-	  frame-text-inferior
-	  home-cursor!
-	  set-override-message!)
   (export (edwin screen)
 	  editor-frame-screen
 	  editor-frame-select-cursor!
@@ -426,9 +420,7 @@ MIT in each case. |#
 	  message-args->string
 	  reset-command-prompt!
 	  set-command-prompt!
-	  set-editor-input-port!
-	  temporary-message
-	  with-editor-input-port))
+	  temporary-message))
 
 (define-package (edwin prompt)
   (files "prompt")
@@ -453,9 +445,6 @@ MIT in each case. |#
 	  typein-edit-other-window
 	  within-typein-edit
 	  within-typein-edit?)
-  (export (edwin keyboard)
-	  clear-message!
-	  set-message!)
   (export (edwin screen)
 	  make-typein-buffer-name))
 
diff --git a/v7/src/edwin/input.scm b/v7/src/edwin/input.scm
index 43f3a2f16..23f1a4945 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.84 1990/10/03 04:55:17 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/input.scm,v 1.85 1990/10/06 00:16:04 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -131,7 +131,7 @@ B 3BAB8C
       (begin
 	(set! command-prompt-string string)
 	(if command-prompt-displayed?
-	    (set-message! string)))))
+	    (set-current-message! string)))))
 
 (define (append-command-prompt! string)
   (if (not (string-null? string))
@@ -150,7 +150,7 @@ B 3BAB8C
 	(set! command-prompt-displayed? false)))
   (set! message-string string)
   (set! message-should-be-erased? temporary?)
-  (set-message! string))
+  (set-current-message! string))
 
 (define (message-args->string args)
   (apply string-append
@@ -162,7 +162,7 @@ B 3BAB8C
       (error "Attempt to append to nonexistent message"))
   (let ((string (string-append message-string (message-args->string args))))
     (set! message-string string)
-    (set-message! string)))
+    (set-current-message! string)))
 
 (define (clear-message)
   (if message-string
@@ -170,31 +170,21 @@ B 3BAB8C
 	(set! message-string false)
 	(set! message-should-be-erased? false)
 	(if (not command-prompt-displayed?)
-	    (clear-message!)))))
+	    (clear-current-message!)))))
 
-(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)
-  unspecific)
-
 (define-integrable (keyboard-active? interval)
-  (char-ready? editor-input-port interval))
+  (char-ready? (editor-input-port current-editor) interval))
 
 (define (keyboard-peek-char)
   (if *executing-keyboard-macro?*
       (keyboard-macro-peek-char)
-      (keyboard-read-char-1 peek-char)))
+      (keyboard-read-char-1 input-port/peek-char)))
 
 (define (keyboard-read-char)
   (set! keyboard-chars-read (1+ keyboard-chars-read))
   (if *executing-keyboard-macro?*
       (keyboard-macro-read-char)
-      (let ((char (keyboard-read-char-1 read-char)))
+      (let ((char (keyboard-read-char-1 input-port/read-char)))
 	(set! *auto-save-keystroke-count* (1+ *auto-save-keystroke-count*))
 	(ring-push! (current-char-history) char)
 	(if *defining-keyboard-macro?* (keyboard-macro-write-char char))
@@ -223,7 +213,7 @@ B 3BAB8C
 	       (keyboard-active? read-char-timeout/slow)
 	       (set! message-string false)
 	       (set! message-should-be-erased? false)
-	       (clear-message!))))
+	       (clear-current-message!))))
 	((and (or message-should-be-erased?
 		  (and command-prompt-string
 		       (not command-prompt-displayed?)))
@@ -233,6 +223,6 @@ B 3BAB8C
 	 (if command-prompt-string
 	     (begin
 	       (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
+	       (set-current-message! command-prompt-string))
+	     (clear-current-message!))))
+  (remap-alias-char (read-char (editor-input-port current-editor))))
\ No newline at end of file
diff --git a/v7/src/edwin/prompt.scm b/v7/src/edwin/prompt.scm
index 63b3001dd..bc004b1e9 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.138 1990/10/03 04:55:53 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/prompt.scm,v 1.139 1990/10/06 00:16:12 cph Rel $
 ;;;
 ;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -84,8 +84,7 @@
 		 (let ((window (typein-window)))
 		   (select-window window)
 		   (select-buffer
-		    (bufferset-find-or-create-buffer
-		     (current-typein-bufferset)
+		    (find-or-create-buffer
 		     (make-typein-buffer-name typein-edit-depth)))
 		   (buffer-reset! (current-buffer))
 		   (reset-command-prompt!)
@@ -95,8 +94,7 @@
 		 (let ((window (typein-window)))
 		   (select-window window)
 		   (let ((buffer (car typein-saved-buffers)))
-		     (bufferset-guarantee-buffer! (current-typein-bufferset)
-						  buffer)
+		     (bufferset-guarantee-buffer! (current-bufferset) buffer)
 		     (select-buffer buffer))
 		   (reset-command-prompt!)
 		   (window-clear-override-message! window))
@@ -176,21 +174,6 @@ recursive minibuffers."
     (region-delete! (buffer-region (current-buffer)))
     (insert-string (map-name/internal->external string))
     (if (not dont-update?) (update-typein!))))
-
-;;; The following are used by MESSAGE and friends.
-
-(define (set-message! message)
-  (let ((window (typein-window)))
-    (window-set-override-message! window message)
-    (if (not *executing-keyboard-macro?*)
-	(window-direct-update! window true))))
-
-(define (clear-message!)
-  (let ((window (typein-window)))
-    (window-clear-override-message! window)
-    (if (not *executing-keyboard-macro?*)
-	(window-direct-update! window true))
-    (window-direct-update! window true)))
 
 (define (update-typein!)
     (if (not *executing-keyboard-macro?*)
diff --git a/v7/src/edwin/screen.scm b/v7/src/edwin/screen.scm
index 04784def3..b1fd5d577 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.82 1990/10/03 04:56:04 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.83 1990/10/06 00:16:20 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -57,6 +57,7 @@
 				 operation/flush!
 				 operation/inverse-video!
 				 operation/modeline-event!
+				 operation/normal-video!
 				 operation/start-update!
 				 operation/subscreen-clear!
 				 operation/wipe!
@@ -75,6 +76,7 @@
   (operation/flush! false read-only true)
   (operation/inverse-video! false read-only true)
   (operation/modeline-event! false read-only true)
+  (operation/normal-video! false read-only true)
   (operation/start-update! false read-only true)
   (operation/subscreen-clear! false read-only true)
   (operation/wipe! false read-only true)
@@ -88,18 +90,15 @@
   (in-update? false)
   (x-size false)
   (y-size false)
-  (typein-bufferset (make-bufferset 
-		     (make-buffer (make-typein-buffer-name 0)
-				  (ref-mode-object fundamental)))
-		    read-only true))
+  (highlight? false))
 
-(define (initialize-screen-root-window! screen buffer)
+(define (initialize-screen-root-window! screen bufferset buffer)
   (set-screen-root-window!
    screen
-   (make-editor-frame screen
-		      buffer
-		      (bufferset-find-buffer (screen-typein-bufferset screen)
-					     (make-typein-buffer-name 0)))))
+   (make-editor-frame
+    screen
+    buffer
+    (bufferset-find-or-create-buffer bufferset (make-typein-buffer-name 0)))))
 
 (define (using-screen screen thunk)
   (dynamic-wind (lambda ()
@@ -109,40 +108,50 @@
 		  ((screen-operation/exit! screen) screen))))   
 
 (define (with-screen-in-update! screen thunk)
-  (let ((old-flag)
-	(new-flag true)
+  (call-with-current-continuation
+   (lambda (continuation)
+     (let ((old-flag)
+	   (new-flag true)
+	   (transition
+	    (lambda (old new)
+	      (if old
+		  (if (not new)
+		      (begin
+			((screen-operation/finish-update! screen) screen)
+			(set-screen-in-update?! screen false)))
+		  (if new
+		      (begin
+			((screen-operation/start-update! screen) screen)
+			(set-screen-in-update?! screen continuation)))))))
+       (dynamic-wind (lambda ()
+		       (set! old-flag (screen-in-update? screen))
+		       (transition old-flag new-flag))
+		     thunk
+		     (lambda ()
+		       (set! new-flag (screen-in-update? screen))
+		       (transition new-flag old-flag)))))))
+
+(define (with-screen-inverse-video! screen thunk)
+  (let ((old-highlight?)
+	(new-highlight? true)
 	(transition
 	 (lambda (old new)
 	   (if old
 	       (if (not new)
-		   ((screen-operation/finish-update! screen) screen))
+		   (begin
+		     ((screen-operation/normal-video! screen) screen)
+		     (set-screen-highlight?! screen false)))
 	       (if new
-		   ((screen-operation/start-update! screen) screen))))))
-    (dynamic-wind (lambda ()
-		    (set! old-flag (screen-in-update? screen))
-		    (set-screen-in-update?! screen new-flag)
-		    (transition old-flag new-flag))
-		  thunk
-		  (lambda ()
-		    (set! new-flag (screen-in-update? screen))
-		    (set-screen-in-update?! screen old-flag)
-		    (transition new-flag old-flag)))))
-
-(define (with-screen-inverse-video! screen thunk)
-  (let ((old-highlight?)
-	(new-highlight? true))
+		   (begin
+		     ((screen-operation/inverse-video! screen) screen)
+		     (set-screen-highlight?! screen true)))))))
     (dynamic-wind (lambda ()
-		    (set! old-highlight?
-			  (screen-inverse-video! screen new-highlight?))
-		    unspecific)
+		    (set! old-highlight? (screen-highlight? screen))
+		    (transition old-highlight? new-highlight?))
 		  thunk
 		  (lambda ()
-		    (set! new-highlight?
-			  (screen-inverse-video! screen old-highlight?))
-		    unspecific))))
-
-(define (screen-inverse-video! screen highlight?)
-  ((screen-operation/inverse-video! screen) screen highlight?))
+		    (set! new-highlight? (screen-highlight? screen))
+		    (transition new-highlight? old-highlight?)))))
 
 (define (screen-beep screen)
   ((screen-operation/beep screen) screen))
diff --git a/v7/src/edwin/xcom.scm b/v7/src/edwin/xcom.scm
index b910a1c85..e773bca91 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.5 1990/10/03 04:56:24 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xcom.scm,v 1.6 1990/10/06 00:16:28 cph Rel $
 ;;;
 ;;;	Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -363,12 +363,15 @@ Display cursor at that position for a second."
   ()
   (lambda () unspecific))
 
-;;; Prevent beeps on button-up.  If the button isn't bound to
-;;; anything, it will beep on button-down.
-(define-key 'fundamental button1-up 'x-mouse-ignore)
-(define-key 'fundamental button2-up 'x-mouse-ignore)
-(define-key 'fundamental button3-up 'x-mouse-ignore)
-(define-key 'fundamental button4-up 'x-mouse-ignore)
-(define-key 'fundamental button5-up 'x-mouse-ignore)
+(define x-button1-down (make-down-button 0))
+(define x-button2-down (make-down-button 1))
+(define x-button3-down (make-down-button 2))
+(define x-button4-down (make-down-button 3))
+(define x-button5-down (make-down-button 4))
+(define x-button1-up (make-up-button 0))
+(define x-button2-up (make-up-button 1))
+(define x-button3-up (make-up-button 2))
+(define x-button4-up (make-up-button 3))
+(define x-button5-up (make-up-button 4))
 
-(define-key 'fundamental button1-down 'x-mouse-set-point)
\ No newline at end of file
+(define-key 'fundamental x-button1-down 'x-mouse-set-point)
\ No newline at end of file
diff --git a/v7/src/edwin/xterm.scm b/v7/src/edwin/xterm.scm
index 24c2886cc..42657ae61 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.10 1990/10/03 04:56:28 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.11 1990/10/06 00:16:37 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -80,7 +80,6 @@
 		   (conc-name xterm-screen-state/))
   (xterm false read-only true)
   (display false read-only true)
-  (highlight 0)
   (redisplay-flag true))
 
 (define screen-list)
@@ -104,6 +103,7 @@
 			xterm-screen/flush!
 			xterm-screen/inverse-video!
 			xterm-screen/modeline-event!
+			xterm-screen/normal-video!
 			xterm-screen/start-update!
 			xterm-screen/subscreen-clear!
 			xterm-screen/wipe!
@@ -123,10 +123,7 @@
   (xterm-screen-state/display (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))
+  (if (screen-highlight? screen) 1 0))
 
 (define-integrable (screen-redisplay-flag screen)
   (xterm-screen-state/redisplay-flag (screen-state screen)))
@@ -152,6 +149,30 @@
 	(set-screen-redisplay-flag! screen false)))
   (xterm-screen/flush! screen))
 
+(define (xterm-screen/discard! screen)
+  (set! screen-list (delq! screen screen-list))
+  (x-close-window (screen-xterm screen)))
+
+(define (xterm-screen/modeline-event! screen window type)
+  window type				; ignored
+  (set-screen-redisplay-flag! screen true))
+
+(define (xterm-screen/enter! screen)
+  screen				; ignored
+  unspecific)
+
+(define (xterm-screen/exit! screen)
+  screen				; ignored
+  unspecific)
+
+(define (xterm-screen/inverse-video! screen)
+  screen				; ignored
+  unspecific)
+
+(define (xterm-screen/normal-video! screen)
+  screen				; ignored
+  unspecific)
+
 (define (xterm-screen/beep screen)
   (x-window-beep (screen-xterm screen))
   (xterm-screen/flush! screen))
@@ -159,11 +180,6 @@
 (define-integrable (xterm-screen/flush! screen)
   (x-display-flush (screen-display screen)))
 
-(define (xterm-screen/inverse-video! screen highlight?)
-  (let ((result (not (zero? (screen-highlight screen)))))
-    (set-screen-highlight! screen (if highlight? 1 0))
-    result))
-
 (define (xterm-screen/write-char! screen x y char)
   (xterm-write-char! (screen-xterm screen) x y char (screen-highlight screen)))
 
@@ -206,48 +222,29 @@
 
 (define (xterm-screen/wipe! screen)
   (x-window-clear (screen-xterm screen)))
-
-(define (xterm-screen/discard! screen)
-  (set! screen-list (delq! screen screen-list))
-  (x-close-window (screen-xterm screen)))
-
-(define (xterm-screen/enter! screen)
-  screen				; ignored
-  unspecific)
-
-(define (xterm-screen/exit! screen)
-  screen				; ignored
-  unspecific)
-
-(define (xterm-screen/modeline-event! screen window type)
-  window type				; ignored
-  (set-screen-redisplay-flag! screen true))
 
 ;;;; Input Port
 
 (define (make-xterm-input-port screen)
   (input-port/copy xterm-input-port-template
-		   (make-xterm-input-port-state screen)))
+		   (make-xterm-input-port-state (screen-display screen))))
 
 (define-structure (xterm-input-port-state
-		   (constructor make-xterm-input-port-state (screen))
+		   (constructor make-xterm-input-port-state (display))
 		   (conc-name xterm-input-port-state/))
-  (screen false read-only true)
+  (display false read-only true)
   (buffer "")
-  (index 0))
+  (index 0)
+  ;; If we receive a non-keypress event while in a display update, we
+  ;; stash it here and abort the update.
+  (pending-event false))
 
 (define (operation/char-ready? port interval)
   (let ((state (input-port/state port)))
     (if (< (xterm-input-port-state/index state)
 	   (string-length (xterm-input-port-state/buffer state)))
 	true
-	(let ((buffer
-	       (xterm-screen/read-chars (xterm-input-port-state/screen state)
-					(+ (real-time-clock) interval))))
-	  (and buffer
-	       (begin
-		 (check-for-interrupts! state buffer 0)
-		 true))))))
+	(xterm-read-chars! state (+ (real-time-clock) interval)))))
 
 (define (operation/peek-char port)
   (let ((state (input-port/state port)))
@@ -255,7 +252,9 @@
 	  (index (xterm-input-port-state/index state)))
       (if (< index (string-length buffer))
 	  (string-ref buffer index)
-	  (refill-buffer! state 0)))))
+	  (let ((buffer (xterm-read-chars! state false)))
+	    (and buffer
+		 (string-ref buffer 0)))))))
 
 (define (operation/discard-char port)
   (let ((state (input-port/state port)))
@@ -271,12 +270,16 @@
 	  (begin
 	    (set-xterm-input-port-state/index! state (1+ index))
 	    (string-ref buffer index))
-	  (refill-buffer! state 1)))))
+	  (let ((buffer (xterm-read-chars! state false)))
+	    (and buffer
+		 (begin
+		   (set-xterm-input-port-state/index! state 1)
+		   (string-ref buffer 0))))))))
 
 (define (operation/print-self state port)
-  (unparse-string state "from screen ")
+  (unparse-string state "from display ")
   (unparse-object state
-		  (xterm-input-port-state/screen (input-port/state port))))
+		  (xterm-input-port-state/display (input-port/state port))))
 
 (define xterm-input-port-template
   (make-input-port `((CHAR-READY? ,operation/char-ready?)
@@ -286,27 +289,51 @@
 		     (READ-CHAR ,operation/read-char))
 		   false))
 
-(define (refill-buffer! state index)
-  (let ((screen (xterm-input-port-state/screen state)))
-    (let ((buffer (xterm-screen/read-chars screen false)))
-      (and buffer
-	   (begin
-	     (check-for-interrupts! state buffer index)
-	     (string-ref buffer 0))))))
-
-(define-integrable (xterm-screen/read-chars screen time-limit)
-  (process-events! (screen-display screen) time-limit))
-
-(define (check-for-interrupts! state buffer index)
-  (set-xterm-input-port-state/buffer! state buffer)
-  (let ((^g-index
-	 (and signal-interrupts?
-	      (string-find-previous-char buffer #\BEL))))
-    (if ^g-index
-	(begin
-	  (set-xterm-input-port-state/index! state (1+ ^g-index))
-	  (signal-interrupt!))
-	(set-xterm-input-port-state/index! state index))))
+;;;; Event Handling
+
+(define (xterm-read-chars! state time-limit)
+  (let ((display (xterm-input-port-state/display state)))
+    (letrec
+	((loop
+	  (lambda ()
+	    (let ((event (x-display-process-events display time-limit)))
+	      (cond ((not event)
+		     false)
+		    ((= (vector-ref event 0) event-type:key-press)
+		     (let ((buffer (vector-ref event 2)))
+		       (set-xterm-input-port-state/buffer! state buffer)
+		       (set-xterm-input-port-state/index! state 0)
+		       (if signal-interrupts?
+			   (let ((^g-index
+				  (string-find-previous-char buffer #\BEL)))
+			     (if ^g-index
+				 (begin
+				   (set-xterm-input-port-state/index!
+				    state (1+ ^g-index))
+				   (signal-interrupt!)))))
+		       buffer))
+		    (else
+		     (process-special-event event))))))
+	 (process-special-event
+	  (lambda (event)
+	    (let ((handler (vector-ref event-handlers (vector-ref event 0)))
+		  (screen (xterm->screen (vector-ref event 1))))
+	      (if (and handler screen)
+		  (begin
+		    (let ((continuation (screen-in-update? screen)))
+		      (if continuation
+			  (begin
+			    (set-xterm-input-port-state/pending-event! state
+								       event)
+			    (continuation false))))
+		    (handler screen event))))
+	    (loop))))
+      (let ((event (xterm-input-port-state/pending-event state)))
+	(if event
+	    (begin
+	      (set-xterm-input-port-state/pending-event! state false)
+	      (process-special-event event))
+	    (loop))))))
 
 (define signal-interrupts?)
 (define pending-interrupt?)
@@ -360,29 +387,12 @@
 ;; key-press.
 (define-integrable event-mask #x057)
 
-(define (process-events! display time-limit)
-  (let loop ()
-    (let ((event (x-display-process-events display time-limit)))
-      (and event
-	   (if (= (vector-ref event 0) event-type:key-press)
-	       (vector-ref event 2)
-	       (begin
-		 (let ((handler
-			(vector-ref event-handlers (vector-ref event 0)))
-		       (screen (xterm->screen (vector-ref event 1))))
-		   (if (and handler screen)
-		       (handler screen event)))
-		 (loop)))))))
-
 (define event-handlers
   (make-vector number-of-event-types false))
 
 (define-integrable (define-event-handler event-type handler)
   (vector-set! event-handlers event-type handler))
 
-;; These events can cause problems if they are handled during an
-;; update.  Unfortunately, there's no mechanism to check for other
-;; events while ignoring these.
 (define-event-handler event-type:configure
   (lambda (screen event)
     (let ((x-size (vector-ref event 2))
@@ -398,7 +408,7 @@
 (define-event-handler event-type:button-down
   (lambda (screen event)
     (send (screen-root-window screen) ':button-event!
-	  (button-downify (vector-ref event 4))
+	  (make-down-button (vector-ref event 4))
 	  (vector-ref event 2)
 	  (vector-ref event 3))
     (update-screen! screen false)))
@@ -406,7 +416,7 @@
 (define-event-handler event-type:button-up
   (lambda (screen event)
     (send (screen-root-window screen) ':button-event!
-	  (button-upify (vector-ref event 4))
+	  (make-up-button (vector-ref event 4))
 	  (vector-ref event 2)
 	  (vector-ref event 3))
     (update-screen! screen false)))
@@ -415,19 +425,10 @@
   (lambda (screen event)
     event
     (if (not (selected-screen? screen))
-	(select-screen screen))))
+	(command-reader/reset-and-execute
+	 (lambda ()
+	   (select-screen screen))))))
 
-(define button1-down)
-(define button2-down)
-(define button3-down)
-(define button4-down)
-(define button5-down)
-(define button1-up)
-(define button2-up)
-(define button3-up)
-(define button4-up)
-(define button5-up)
-
 (define x-display-type)
 (define x-display-data)
 
@@ -437,12 +438,10 @@
 	(set! x-display-data display)
 	display)))
 
-(define x-display-type-name 'X)
-
 (define (initialize-package!)
   (set! screen-list '())
   (set! x-display-type
-	(make-display-type x-display-type-name
+	(make-display-type 'X
 			   get-x-display
 			   make-xterm-screen
 			   make-xterm-input-port
@@ -450,15 +449,4 @@
 			   with-x-interrupts-enabled
 			   with-x-interrupts-disabled))
   (set! x-display-data false)
-  (initialize-buttons! 5)
-  (set! button1-down (button-downify 0))
-  (set! button2-down (button-downify 1))
-  (set! button3-down (button-downify 2))
-  (set! button4-down (button-downify 3))
-  (set! button5-down (button-downify 4))
-  (set! button1-up (button-upify 0))
-  (set! button2-up (button-upify 1))
-  (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