From 1b7033031ab7862bc178ffd3f16facae62e7ca1b Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 17 Feb 1992 22:09:58 +0000
Subject: [PATCH] Various window-manager events, such as focus selection and
 closing of X windows, are passed back from KEYBOARD-READ as special events to
 be executed by the caller.  Previously, these were handled by the X terminal
 abstraction.  This allows the caller to recognize that the user is doing
 something unusual, and to behave accordingly.  For example, incremental
 search treats such events exactly like other complicated editor commands: the
 search is terminated before the command is executed.

---
 v7/src/edwin/basic.scm  |  32 ++++---
 v7/src/edwin/comred.scm | 164 +++++++++++++++++---------------
 v7/src/edwin/curren.scm |  69 ++++++++------
 v7/src/edwin/edwin.pkg  |  15 +--
 v7/src/edwin/input.scm  |  23 +++--
 v7/src/edwin/iserch.scm |  89 ++++++++++--------
 v7/src/edwin/kmacro.scm |  19 ++--
 v7/src/edwin/prompt.scm |  86 +++++++++--------
 v7/src/edwin/simple.scm |  13 ++-
 v7/src/edwin/tterm.scm  |  10 +-
 v7/src/edwin/xterm.scm  | 202 +++++++++++++++++++---------------------
 11 files changed, 384 insertions(+), 338 deletions(-)

diff --git a/v7/src/edwin/basic.scm b/v7/src/edwin/basic.scm
index adb3c6d77..cf797637f 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.121 1992/02/10 15:31:50 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.122 1992/02/17 22:06:10 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -57,13 +57,15 @@ With an argument, insert the character that many times."
 (define (read-quoted-char prompt-string)
   (let ((read-ascii-char
 	 (lambda ()
-	   (let ((key (with-editor-interrupts-disabled keyboard-read)))
-	     (or (and (char? key)
-		      (char-ascii? key))
-		 (editor-error "Not an ASCII character" (key-name key)))
-	     (set-command-prompt!
-	      (string-append (command-prompt) (key-name key)))
-	     key))))
+	   (let ((input (with-editor-interrupts-disabled keyboard-read)))
+	     (if (input-event? input)
+		 (abort-current-command input)
+		 (begin
+		   (if (not (and (char? input) (char-ascii? input)))
+		       (editor-error "Can't quote non-ASCII char:" input))
+		   (set-command-prompt!
+		    (string-append (command-prompt) (key-name input)))
+		   input))))))
     (let ((read-digit
 	   (lambda ()
 	     (or (char->digit (read-ascii-char) 8)
@@ -177,12 +179,14 @@ It reads another character (a subcommand) and dispatches on it."
   ()
   (lambda ()
     (set-command-prompt-prefix!)
-    (let ((prefix-key (current-command-key)))
-      (dispatch-on-key
-       (current-comtabs)
-       ((if (pair? prefix-key) append cons)
-	prefix-key
-	(list (with-editor-interrupts-disabled keyboard-read)))))))
+    (let ((input (with-editor-interrupts-disabled keyboard-read)))
+      (if (input-event? input)
+	  (apply-input-event input)
+	  (dispatch-on-key (current-comtabs)
+			   (let ((prefix-key (current-command-key)))
+			     ((if (pair? prefix-key) append cons)
+			      prefix-key
+			      (list input))))))))
 
 (define (set-command-prompt-prefix!)
   (set-command-prompt!
diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm
index cf99bfbcc..106715326 100644
--- a/v7/src/edwin/comred.scm
+++ b/v7/src/edwin/comred.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.91 1992/02/04 04:01:50 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.92 1992/02/17 22:08:30 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -58,14 +58,11 @@
 (define keyboard-keys-read)	;# of keys read from keyboard
 (define command-history)
 (define command-history-limit 30)
-(define command-reader-reset-thunk)
-(define command-reader-reset-continuation)
 (define command-reader-override-queue)
 
 (define (initialize-command-reader!)
   (set! keyboard-keys-read 0)
   (set! command-history (make-circular-list command-history-limit false))
-  (set! command-reader-reset-thunk false)
   (set! command-reader-override-queue (make-queue))
   unspecific)
 
@@ -73,79 +70,92 @@
   (let loop ((initialization initialization))
     (with-keyboard-macro-disabled
      (lambda ()
-       (call-with-protected-continuation
-	(lambda (continuation)
-	  (fluid-let ((command-reader-reset-continuation continuation))
-	    (unwind-protect
-	     false
-	     (lambda ()
-	       (intercept-^G-interrupts (lambda () unspecific)
-		 (lambda ()
-		   (command-reader initialization))))
-	     (lambda ()
-	       (let ((thunk command-reader-reset-thunk))
-		 (if thunk
-		     (begin
-		       (set! command-reader-reset-thunk false)
-		       (thunk)))))))))))
+       (intercept-^G-interrupts (lambda () unspecific)
+	 (lambda ()
+	   (command-reader initialization)))))
     (loop false)))
 
-(define (command-reader/reset-and-execute thunk)
-  (set! command-reader-reset-thunk thunk)
-  (command-reader-reset-continuation false))
-
 (define (override-next-command! override)
   (enqueue! command-reader-override-queue override))
-
-(define (command-reader #!optional initialization)
-  (define (command-reader-loop)
-    (let ((value (with-command-variables start-next-command)))
-      (if (not (eq? value 'ABORT))
-	  (value)))
-    (command-reader-loop))
 
-  (define (with-command-variables start-next-command)
-    (call-with-protected-continuation
-     (lambda (continuation)
-       (fluid-let ((*command-continuation* continuation)
-		   (*command-key* false)
-		   (*command* false)
-		   (*next-argument* false)
-		   (*next-message* false))
-	 (bind-condition-handler (list condition-type:editor-error)
-	     editor-error-handler
-	   start-next-command)))))
+(define (abort-current-command #!optional input)
+  (keyboard-macro-disable)
+  (if (or (default-object? input) (not input))
+      (*command-continuation* 'ABORT)
+      (within-continuation *command-continuation*
+	(lambda ()
+	  (cond ((input-event? input)
+		 (apply-input-event input))
+		((command? input)
+		 (execute-command input))
+		(else
+		 (execute-key (current-comtabs) input)))
+	  'ABORT))))
+
+(define-structure (input-event
+		   (constructor %make-input-event)
+		   (conc-name input-event/))
+  (operator false read-only true)
+  (operands false read-only true))
 
-  (define (start-next-command)
-    (reset-command-state!)
-    (if (queue-empty? command-reader-override-queue)
-	(let ((key (with-editor-interrupts-disabled keyboard-read)))
-	  (set! *command-key* key)
-	  (clear-message)
-	  (set-command-prompt!
-	   (if (not (command-argument))
-	       (key-name key)
-	       (string-append-separated (command-argument-prompt)
-					(key-name key))))
-	  (let ((window (current-window)))
-	    (%dispatch-on-command window
-				  (comtab-entry (buffer-comtabs
-						 (window-buffer window))
-						key)
-				  false)))
-	((dequeue! command-reader-override-queue)))
-    (start-next-command))
+(define (make-input-event operator . operands)
+  (%make-input-event operator operands))
 
+(define (apply-input-event input-event)
+  (if (not (input-event? input-event))
+      (error:wrong-type-argument input-event "input event" apply-input-event))
+  (clear-message)
+  (reset-command-state!)
+  (apply (input-event/operator input-event)
+	 (input-event/operands input-event)))
+
+(define (command-reader #!optional initialization)
   (fluid-let ((*last-command* false)
+	      (*command* false)
 	      (*command-argument*)
+	      (*next-argument* false)
 	      (*command-message*)
-	      (*non-undo-count* 0))
-    (if (and (not (default-object? initialization)) initialization)
-	(with-command-variables
-	 (lambda ()
-	   (reset-command-state!)
-	   (initialization))))
-    (command-reader-loop)))
+	      (*next-message* false)
+	      (*non-undo-count* 0)
+	      (*command-key* false)
+	      (*command-continuation*))
+    (bind-condition-handler (list condition-type:editor-error)
+	editor-error-handler
+      (lambda ()
+	(if (and (not (default-object? initialization)) initialization)
+	    (call-with-current-continuation
+	     (lambda (continuation)
+	       (set! *command-continuation* continuation)
+	       (reset-command-state!)
+	       (initialization))))
+	(do () (false)
+	  (call-with-current-continuation
+	   (lambda (continuation)
+	     (set! *command-continuation* continuation)
+	     (do () (false)
+	       (reset-command-state!)
+	       (if (queue-empty? command-reader-override-queue)
+		   (let ((input
+			  (with-editor-interrupts-disabled keyboard-read)))
+		     (if (input-event? input)
+			 (apply-input-event input)
+			 (begin
+			   (set! *command-key* input)
+			   (clear-message)
+			   (set-command-prompt!
+			    (if (not (command-argument))
+				(key-name input)
+				(string-append-separated
+				 (command-argument-prompt)
+				 (key-name input))))
+			   (let ((window (current-window)))
+			     (%dispatch-on-command
+			      window
+			      (comtab-entry (buffer-comtabs
+					     (window-buffer window))
+					    input)
+			      false)))))
+		   ((dequeue! command-reader-override-queue)))))))))))
 
 (define (reset-command-state!)
   (set! *last-command* *command*)
@@ -160,10 +170,6 @@
   (if *defining-keyboard-macro?*
       (keyboard-macro-finalize-keys)))
 
-(define (abort-current-command #!optional value)
-  (keyboard-macro-disable)
-  (*command-continuation* (if (default-object? value) 'ABORT value)))
-
 (define-integrable (current-command-key)
   *command-key*)
 
@@ -231,15 +237,23 @@
   (reset-command-state!)
   (%dispatch-on-command (current-window) command false))
 
+(define (execute-button-command screen button x y)
+  (send (screen-root-window screen) ':button-event! button x y))
+
 (define (read-and-dispatch-on-key)
   (dispatch-on-key (current-comtabs)
 		   (with-editor-interrupts-disabled keyboard-read)))
 
 (define (dispatch-on-key comtab key)
-  (set! *command-key* key)
-  (set-command-prompt!
-   (string-append-separated (command-argument-prompt) (xkey->name key)))
-  (%dispatch-on-command (current-window) (comtab-entry comtab key) false))
+  (if (input-event? key)
+      (apply-input-event key)
+      (begin
+	(set! *command-key* key)
+	(set-command-prompt!
+	 (string-append-separated (command-argument-prompt) (xkey->name key)))
+	(%dispatch-on-command (current-window)
+			      (comtab-entry comtab key)
+			      false))))
 
 (define (dispatch-on-command command #!optional record?)
   (%dispatch-on-command (current-window)
diff --git a/v7/src/edwin/curren.scm b/v7/src/edwin/curren.scm
index 91dfebc0d..0cf967217 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.98 1992/02/12 23:52:51 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.99 1992/02/17 22:08:43 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -79,15 +79,16 @@
 (define (delete-screen! screen)
   (without-interrupts
    (lambda ()
-     (if (selected-screen? screen)
-	 (select-screen
-	  (or (other-screen screen false)
-	      (other-screen screen true)
-	      (error "Can't delete only screen:" screen))))
-     (screen-discard! screen)
-     (set-editor-screens! current-editor
-			  (delq! screen
-				 (editor-screens current-editor))))))
+     (let ((other (other-screen screen true)))
+       (if other
+	   (begin
+	     (if (selected-screen? screen)
+		 (select-screen (or (other-screen screen false) other)))
+	     (screen-discard! screen)
+	     (set-editor-screens! current-editor
+				  (delq! screen
+					 (editor-screens current-editor))))
+	   (save-buffers-kill-edwin))))))
 
 (define (select-screen screen)
   (without-interrupts
@@ -405,19 +406,21 @@ The buffer is guaranteed to be selected at that time."
 
 (define (with-selected-buffer buffer thunk)
   (let ((old-buffer))
-    (unwind-protect (lambda ()
-		      (let ((window (current-window)))
-			(set! old-buffer (window-buffer window))
-			(if (buffer-alive? buffer)
-			    (set-window-buffer! window buffer true)))
-		      (set! buffer)
-		      unspecific)
-		    thunk
-		    (lambda ()
+    (dynamic-wind (lambda ()
+		    (let ((window (current-window)))
+		      (set! old-buffer (window-buffer window))
+		      (if (buffer-alive? buffer)
+			  (set-window-buffer! window buffer true)))
+		    (set! buffer)
+		    unspecific)
+		  thunk
+		  (lambda ()
+		    (let ((window (current-window)))
+		      (set! buffer (window-buffer window))
 		      (if (buffer-alive? old-buffer)
-			  (set-window-buffer! (current-window)
-					      old-buffer
-					      true))))))
+			  (set-window-buffer! window old-buffer true)))
+		    (set! old-buffer)
+		    unspecific))))
 
 (define (current-process)
   (let ((process (get-buffer-process (current-buffer))))
@@ -443,15 +446,19 @@ The buffer is guaranteed to be selected at that time."
 
 (define (with-current-point point thunk)
   (let ((old-point))
-    (unwind-protect (lambda ()
-		      (let ((window (current-window)))
-			(set! old-point (window-point window))
-			(set-window-point! window point))
-		      (set! point)
-		      unspecific)
-		    thunk
-		    (lambda ()
-		      (set-window-point! (current-window) old-point)))))
+    (dynamic-wind (lambda ()
+		    (let ((window (current-window)))
+		      (set! old-point (window-point window))
+		      (set-window-point! window point))
+		    (set! point)
+		    unspecific)
+		  thunk
+		  (lambda ()
+		    (let ((window (current-window)))
+		      (set! point (window-point window))
+		      (set-window-point! window old-point))
+		    (set! old-point)
+		    unspecific))))
 
 (define (current-column)
   (mark-column (current-point)))
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 38b0c3ecd..ca69115f6 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.76 1992/02/12 06:40:22 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.77 1992/02/17 22:09:04 cph Exp $
 
 Copyright (c) 1989-92 Massachusetts Institute of Technology
 
@@ -100,7 +100,8 @@ MIT in each case. |#
 	 "pasmod"
 	 "tximod"
 	 "manual"			; man page display
-	 "print")			; printer output
+	 "print"			; printer output
+	 "notify")			; mode line notifications
   (parent ())
   (import (runtime rep)
 	  hook/repl-eval)
@@ -452,31 +453,32 @@ MIT in each case. |#
   (parent (edwin))
   (export (edwin)
 	  abort-current-command
+	  apply-input-event
 	  auto-argument-mode?
 	  command-argument
 	  command-history-list
 	  command-message-receive
 	  command-reader
-	  command-reader/reset-and-execute
 	  current-command
 	  current-command-key
 	  dispatch-on-key
 	  dispatch-on-command
+	  execute-button-command
 	  execute-key
 	  execute-command
 	  execute-command-history-entry
 	  initialize-command-reader!
+	  input-event?
 	  keyboard-keys-read
 	  last-command
 	  last-command-key
+	  make-input-event
 	  override-next-command!
 	  read-and-dispatch-on-key
 	  set-command-argument!
 	  set-command-message!
 	  set-current-command!
-	  top-level-command-reader)
-  (export (edwin inferior-repl)
-	  command-reader-reset-continuation))
+	  top-level-command-reader))
 
 (define-package (edwin keyboard)
   (files "input")
@@ -493,6 +495,7 @@ MIT in each case. |#
 	  initialize-typeout!
 	  keyboard-read
 	  keyboard-peek
+	  keyboard-peek-no-hang
 	  keyboard-read-char
 	  message
 	  message-args->string
diff --git a/v7/src/edwin/input.scm b/v7/src/edwin/input.scm
index 1cbc9df37..f5a994a3f 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.91 1992/02/04 04:03:08 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/input.scm,v 1.92 1992/02/17 22:09:14 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -178,18 +178,21 @@ B 3BAB8C
 (define (keyboard-peek)
   (if *executing-keyboard-macro?*
       (keyboard-macro-peek-key)
-      (keyboard-read-1 (editor-peek-char current-editor))))
+      (keyboard-read-1 (editor-peek current-editor))))
 
 (define (keyboard-read)
   (set! keyboard-keys-read (1+ keyboard-keys-read))
   (if *executing-keyboard-macro?*
       (keyboard-macro-read-key)
-      (let ((key (keyboard-read-1 (editor-read-char current-editor))))
+      (let ((key (keyboard-read-1 (editor-read current-editor))))
 	(set! auto-save-keystroke-count (fix:+ auto-save-keystroke-count 1))
 	(ring-push! (current-char-history) key)
 	(if *defining-keyboard-macro?* (keyboard-macro-write-key key))
 	key)))
 
+(define (keyboard-peek-no-hang)
+  ((editor-peek-no-hang current-editor)))
+
 (define (keyboard-read-char)
   (let loop ((key (keyboard-read)))
     (if (char? key)
@@ -199,12 +202,11 @@ B 3BAB8C
 (define read-key-timeout/fast 500)
 (define read-key-timeout/slow 2000)
 
-(define (keyboard-read-1 read-key)
+(define (keyboard-read-1 reader)
   (remap-alias-key
-   (let ((char-ready? (editor-char-ready? current-editor)))
-     (if (not (char-ready?))
+   (let ((peek-no-hang (editor-peek-no-hang current-editor)))
+     (if (not (peek-no-hang))
 	 (begin
-	   (update-screens! false)
 	   (if (let ((interval (ref-variable auto-save-interval))
 		     (count auto-save-keystroke-count))
 		 (and (fix:> count 20)
@@ -212,12 +214,13 @@ B 3BAB8C
 		      (> count interval)))
 	       (begin
 		 (do-auto-save)
-		 (set! auto-save-keystroke-count 0)))))
+		 (set! auto-save-keystroke-count 0)))
+	   (update-screens! false)))
      (let ((wait
 	    (lambda (timeout)
 	      (let ((t (+ (real-time-clock) timeout)))
 		(let loop ()
-		  (cond ((char-ready?) false)
+		  (cond ((peek-no-hang) false)
 			((>= (real-time-clock) t) true)
 			(else (loop))))))))
        ;; Perform the appropriate juggling of the minibuffer message.
@@ -239,4 +242,4 @@ B 3BAB8C
 		    (set! command-prompt-displayed? true)
 		    (set-current-message! command-prompt-string))
 		  (clear-current-message!)))))
-     (read-key))))
\ No newline at end of file
+     (reader))))
\ No newline at end of file
diff --git a/v7/src/edwin/iserch.scm b/v7/src/edwin/iserch.scm
index c04aed390..4d4c32200 100644
--- a/v7/src/edwin/iserch.scm
+++ b/v7/src/edwin/iserch.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/iserch.scm,v 1.16 1992/02/04 04:03:19 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/iserch.scm,v 1.17 1992/02/17 22:09:23 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -52,8 +52,8 @@
     (let ((point (window-point window))
 	  (y-point (window-point-y window)))
       (let ((result
-	     (unwind-protect
-	      false
+	     (dynamic-wind
+	      (lambda () unspecific)
 	      (lambda ()
 		(with-editor-interrupts-disabled
 		 (lambda ()
@@ -70,21 +70,28 @@
 	       (if result (execute-key (current-comtabs) result))))))))
 
 (define (isearch-loop state)
-  (if (not ((editor-char-ready? current-editor)))
+  (if (not (keyboard-peek-no-hang))
       (begin
 	(set-current-point! (search-state-point state))
 	(message (search-state-message state))))
-  (let ((char (keyboard-read-char)))
+  (let ((char (keyboard-read)))
     (let ((test-for
 	   (lambda (char*)
 	     (char=? char (remap-alias-key char*)))))
-      (cond ((test-for (ref-variable search-quote-char))
-	     (isearch-append-char
-	      state
-	      (prompt-for-typein
-	       (string-append (search-state-message state) "^Q")
-	       false
-	       keyboard-read-char)))
+      (cond ((not (char? char))
+	     (isearch-exit state)
+	     char)
+	    ((test-for (ref-variable search-quote-char))
+	     (let ((char
+		    (prompt-for-typein
+		     (string-append (search-state-message state) "^Q")
+		     false
+		     keyboard-read)))
+	       (if (char? char)
+		   (isearch-append-char state char)
+		   (begin
+		     (isearch-exit state)
+		     char))))
 	    ((test-for (ref-variable search-exit-char))
 	     (if (string-null? (search-state-text state))
 		 (nonincremental-search (search-state-forward? state)
@@ -120,31 +127,37 @@
 	     (isearch-append-char state char))))))
 
 (define (nonincremental-search forward? regexp?)
-  (cond ((let ((key (remap-alias-key (ref-variable search-yank-word-char))))
-	   (and (char? key)
-		(char=?
-		 key
-		 (prompt-for-typein
-		  (if regexp?
-		      (prompt-for-string/prompt
-		       (if forward? "RE search" "RE search backward")
-		       (write-to-string (ref-variable search-last-regexp)))
-		      (prompt-for-string/prompt
-		       (if forward? "Search" "Search backward")
-		       (write-to-string (ref-variable search-last-string))))
-		  false
-		  (lambda () (keyboard-peek))))))
-	 (if forward?
-	     (ref-command-object word-search-forward)
-	     (ref-command-object word-search-backward)))
-	(regexp?
-	 (if forward?
-	     (ref-command-object re-search-forward)
-	     (ref-command-object re-search-backward)))
-	(else
-	 (if forward?
-	     (ref-command-object search-forward)
-	     (ref-command-object search-backward)))))
+  (let ((yank-word (remap-alias-key (ref-variable search-yank-word-char)))
+	(not-word-search
+	 (lambda ()
+	   (if regexp?
+	       (if forward?
+		   (ref-command-object re-search-forward)
+		   (ref-command-object re-search-backward))
+	       (if forward?
+		   (ref-command-object search-forward)
+		   (ref-command-object search-backward))))))
+    (if (char? yank-word)
+	(let ((char
+	       (prompt-for-typein
+		(if regexp?
+		    (prompt-for-string/prompt
+		     (if forward? "RE search" "RE search backward")
+		     (write-to-string (ref-variable search-last-regexp)))
+		    (prompt-for-string/prompt
+		     (if forward? "Search" "Search backward")
+		     (write-to-string (ref-variable search-last-string))))
+		false
+		keyboard-peek)))
+	  (cond ((not (char? char))
+		 char)
+		((char=? yank-word char)
+		 (if forward?
+		     (ref-command-object word-search-forward)
+		     (ref-command-object word-search-backward)))
+		(else
+		 (not-word-search))))
+	(not-word-search))))
 
 (define (isearch-append-char state char)
   (isearch-append-string state (string char)))
@@ -348,7 +361,7 @@
 	      initial-point))))))
 
 (define (perform-search forward? regexp? text start)
-  (call-with-protected-continuation
+  (call-with-current-continuation
    (lambda (continuation)
      (bind-condition-handler (list condition-type:re-compile-pattern)
 	 (lambda (condition)
diff --git a/v7/src/edwin/kmacro.scm b/v7/src/edwin/kmacro.scm
index 40353fd00..1f4312819 100644
--- a/v7/src/edwin/kmacro.scm
+++ b/v7/src/edwin/kmacro.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/kmacro.scm,v 1.36 1992/02/04 04:03:23 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/kmacro.scm,v 1.37 1992/02/17 22:09:31 cph Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -58,9 +58,9 @@
 (define (with-keyboard-macro-disabled thunk)
   (fluid-let ((*executing-keyboard-macro?* false)
 	      (*defining-keyboard-macro?* false))
-    (unwind-protect keyboard-macro-event
-		    thunk
-		    keyboard-macro-event)))
+    (dynamic-wind keyboard-macro-event
+		  thunk
+		  keyboard-macro-event)))
 
 (define (keyboard-macro-disable)
   (set! *defining-keyboard-macro?* false)
@@ -92,7 +92,7 @@
 	      (*keyboard-macro-continuation*))
     (define (loop n)
       (set! *keyboard-macro-position* *macro)
-      (if (call-with-protected-continuation
+      (if (call-with-current-continuation
 	   (lambda (c)
 	     (set! *keyboard-macro-continuation* c)
 	     (command-reader)))
@@ -247,11 +247,16 @@ Without argument, reads a character.  Your options are:
 		     (lambda ()
 		       (set-command-prompt!
 			"Proceed with macro? (Space, DEL, C-d, C-r or C-l)")
-		       (keyboard-read-char)))))
+		       (keyboard-read)))))
 	       (let ((test-for
 		      (lambda (char*)
 			(char=? char (remap-alias-key char*)))))
-		 (cond ((test-for #\space)
+		 (cond ((input-event? char)
+			(abort-current-command char))
+		       ((not (char? char))
+			(editor-beep)
+			(loop))
+		       ((test-for #\space)
 			unspecific)
 		       ((test-for #\rubout)
 			(*keyboard-macro-continuation* true))
diff --git a/v7/src/edwin/prompt.scm b/v7/src/edwin/prompt.scm
index e6c6859e5..7e2467f3c 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.152 1992/02/04 04:03:38 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/prompt.scm,v 1.153 1992/02/17 22:09:37 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -69,7 +69,7 @@
 
 (define (within-typein-edit thunk)
   (let ((value
-	 (call-with-protected-continuation
+	 (call-with-current-continuation
 	  (lambda (continuation)
 	    (fluid-let ((typein-edit-continuation continuation)
 			(typein-edit-depth (1+ typein-edit-depth))
@@ -79,8 +79,8 @@
 			(typein-saved-windows
 			 (cons (current-window)
 			       typein-saved-windows)))
-	      (unwind-protect
-	       false
+	      (dynamic-wind
+	       (lambda () unspecific)
 	       (lambda ()
 		 (let ((window (typein-window)))
 		   (select-window window)
@@ -608,51 +608,57 @@ a repetition of this command will exit."
 
 (define (temporary-typein-message string)
   (let ((point) (start) (end))
-    (unwind-protect (lambda ()
-		      (set! point (current-point))
-		      (set! end (buffer-end (current-buffer)))
-		      (set! start (mark-right-inserting end))
-		      unspecific)
-		    (lambda ()
-		      (insert-string string start)
-		      (set-current-point! start)
-		      (sit-for 2000))
-		    (lambda ()
-		      (delete-string start end)
-		      (set-current-point! point)))))
+    (dynamic-wind (lambda ()
+		    (set! point (current-point))
+		    (set! end (buffer-end (current-buffer)))
+		    (set! start (mark-right-inserting end))
+		    unspecific)
+		  (lambda ()
+		    (insert-string string start)
+		    (set-current-point! start)
+		    (sit-for 2000))
+		  (lambda ()
+		    (delete-string start end)
+		    (set-current-point! point)))))
 
 ;;;; Character Prompts
 
 (define (prompt-for-char prompt)
-  (with-editor-interrupts-disabled
-   (lambda ()
-     (prompt-for-typein (string-append prompt ": ") false
-       (lambda ()
-	 (let ((key (keyboard-read)))
-	   (if (not (and (char? key)
-			 (char-ascii? key)))
-	       (editor-error "Not an ASCII character" key))
-	   (set-typein-string! (key-name key) true)
-	   key))))))
+  (let ((input
+	 (prompt-for-typein (string-append prompt ": ") false
+	   (lambda ()
+	     (let ((input (with-editor-interrupts-disabled keyboard-read)))
+	       (if (and (char? input) (char-ascii? input))
+		   (set-typein-string! (key-name input) true))
+	       input)))))
+    (cond ((and (char? input) (char-ascii? input))
+	   input)
+	  ((input-event? input)
+	   (abort-current-command input))
+	  (else
+	   (editor-error "Not an ASCII character:" input)))))
 
 (define (prompt-for-key prompt #!optional comtab)
   (let ((comtab (if (default-object? comtab) (current-comtabs) comtab)))
     (prompt-for-typein (string-append prompt ": ") false
       (lambda ()
-	(with-editor-interrupts-disabled
-	 (lambda ()
-	   (let outer-loop ((prefix '()))
-	     (let inner-loop ((char (keyboard-read)))
-	       (let ((chars (append! prefix (list char))))
-		 (set-typein-string! (xkey->name chars) true)
-		 (if (prefix-key-list? comtab chars)
-		     (outer-loop chars)
-		     (let ((command (comtab-entry comtab chars)))
-		       (if (memq command extension-commands)
-			   (inner-loop
-			    (fluid-let ((execute-extended-keys? false))
-			      (dispatch-on-command command)))
-			   chars))))))))))))
+	(let outer-loop ((prefix '()))
+	  (let inner-loop
+	      ((char (with-editor-interrupts-disabled keyboard-read)))
+	    (if (input-event? char)
+		(within-continuation typein-edit-continuation
+		  (lambda ()
+		    (abort-current-command char))))
+	    (let ((chars (append! prefix (list char))))
+	      (set-typein-string! (xkey->name chars) true)
+	      (if (prefix-key-list? comtab chars)
+		  (outer-loop chars)
+		  (let ((command (comtab-entry comtab chars)))
+		    (if (memq command extension-commands)
+			(inner-loop
+			 (fluid-let ((execute-extended-keys? false))
+			   (dispatch-on-command command)))
+			chars))))))))))
 
 ;;;; Confirmation Prompts
 
diff --git a/v7/src/edwin/simple.scm b/v7/src/edwin/simple.scm
index 7e67b1c15..08810f974 100644
--- a/v7/src/edwin/simple.scm
+++ b/v7/src/edwin/simple.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/simple.scm,v 1.40 1991/11/26 07:58:17 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/simple.scm,v 1.41 1992/02/17 22:09:45 cph Exp $
 ;;;
-;;;	Copyright (c) 1985, 1989-91 Massachusetts Institute of Technology
+;;;	Copyright (c) 1985, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -216,7 +216,7 @@
   (cond (*executing-keyboard-macro?* unspecific)
 	((not mark) (editor-beep))
 	((window-mark-visible? (current-window) mark)
-	 (if (not ((editor-char-ready? current-editor)))
+	 (if (not (keyboard-peek-no-hang))
 	     (with-current-point mark
 	       (lambda ()
 		 (sit-for 500)))))
@@ -231,13 +231,12 @@
 	      (else (extract-string start end))))))))
 
 (define (sit-for interval)
-  (let ((time-limit (+ (real-time-clock) interval))
-	(char-ready? (editor-char-ready? current-editor)))
-    (if (not (char-ready?))
+  (let ((time-limit (+ (real-time-clock) interval)))
+    (if (not (keyboard-peek-no-hang))
 	(begin
 	 (update-screens! false)
 	 (let loop ()
-	   (if (and (not (char-ready?))
+	   (if (and (not (keyboard-peek-no-hang))
 		    (< (real-time-clock) time-limit))
 	       (loop)))))))
 
diff --git a/v7/src/edwin/tterm.scm b/v7/src/edwin/tterm.scm
index 3c89af755..aa8d64442 100644
--- a/v7/src/edwin/tterm.scm
+++ b/v7/src/edwin/tterm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tterm.scm,v 1.11 1992/02/12 12:06:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tterm.scm,v 1.12 1992/02/17 22:09:51 cph Exp $
 
 Copyright (c) 1990-92 Massachusetts Institute of Technology
 
@@ -176,7 +176,7 @@ MIT in each case. |#
 			(if transcript-port
 			    (output-port/write-substring
 			     transcript-port string 0 n))
-			true)
+			(string-ref string 0))
 		       ((or (fix:= n event:process-output)
 			    (fix:= n event:process-status))
 			(maybe-process-changes n))
@@ -198,15 +198,15 @@ MIT in each case. |#
 	 (or pending-event
 	     (fix:< start end)
 	     (fill-buffer 'NO-PROCESSING)))
-       (lambda ()			;char-ready?
+       (lambda ()			;peek-no-hang
 	 (if pending-event (process-pending-event))
 	 (or (fix:< start end)
 	     (fill-buffer 'NONBLOCKING)))
-       (lambda ()			;peek-char
+       (lambda ()			;peek
 	 (if pending-event (process-pending-event))
 	 (if (not (fix:< start end)) (fill-buffer 'BLOCKING))
 	 (string-ref string start))
-       (lambda ()			;read-char
+       (lambda ()			;read
 	 (if pending-event (process-pending-event))
 	 (if (not (fix:< start end)) (fill-buffer 'BLOCKING))
 	 (let ((char (string-ref string start)))
diff --git a/v7/src/edwin/xterm.scm b/v7/src/edwin/xterm.scm
index cc38fddf4..a3dbe33a7 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.27 1992/02/11 19:01:23 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.28 1992/02/17 22:09:58 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -177,7 +177,7 @@
 	     (loop (cdr screens))))))
 
 (define (xterm-screen/wrap-update! screen thunk)
-  (unwind-protect
+  (dynamic-wind
    (lambda ()
      (xterm-enable-cursor (screen-xterm screen) false))
    thunk
@@ -258,7 +258,7 @@
 (define (get-xterm-input-operations)
   (let ((display x-display-data)
 	(queue x-display-events)
-	(pending-key false)
+	(pending-result false)
 	(string false)
 	(start 0)
 	(end 0)
@@ -277,10 +277,8 @@
 	     (set! end (string-length string))
 	     (set! start end)
 	     (cond ((fix:= end 0)
-		    (set! pending-key
-			  (x-make-special-key (vector-ref event 4)
-					      (vector-ref event 3)))
-		    true)
+		    (x-make-special-key (vector-ref event 4)
+					(vector-ref event 3)))
 		   ((fix:= end 1)
 		    (let ((char
 			   (if (or (fix:= (vector-ref event 3) 0)
@@ -290,25 +288,25 @@
 					  (fix:andc (vector-ref event 3) 2)))))
 		      (if (and signal-interrupts? (char=? char #\BEL))
 			  (begin
-			    (set! pending-key false)
 			    (signal-interrupt!)
 			    false)
-			  (begin
-			    (set! pending-key char)
-			    true))))
+			  char)))
 		   (else
-		    (set! start 0)
-		    (set! pending-key false)
-		    (if signal-interrupts?
-			(let ((i (string-find-previous-char string #\BEL)))
-			  (if i
-			      (begin
-				(set! start (fix:+ i 1))
-				(signal-interrupt!)
-				(fix:< start end))
-			      true))
-			true))))))
-      (let ((read-until-key
+		    (let ((i
+			   (and signal-interrupts?
+				(string-find-previous-char string #\BEL))))
+		      (if i
+			  (begin
+			    (set! start (fix:+ i 1))
+			    (signal-interrupt!)
+			    (and (fix:< start end)
+				 (let ((result (string-ref string start)))
+				   (set! start (fix:+ start 1))
+				   result)))
+			  (begin
+			    (set! start 1)
+			    (string-ref string 0)))))))))
+      (let ((read-until-result
 	     (lambda (time-limit)
 	       (let loop ()
 		 (let ((event (get-next-event time-limit)))
@@ -322,46 +320,44 @@
 			 ((fix:= event-type:key-press (vector-ref event 0))
 			  (or (process-key-press-event event) (loop)))
 			 (else
-			  (process-special-event event)
-			  (loop))))))))
+			  (or (process-special-event event) (loop)))))))))
 	(values
 	 (lambda ()			;halt-update?
-	   (or pending-key
+	   (or pending-result
 	       (fix:< start end)
 	       pending-event
-	       (let ((event (get-next-event 0)))
+	       (let ((event (read-event queue display 0)))
 		 (if event (set! pending-event event))
 		 event)))
-	 (lambda ()			;char-ready?
-	   (or pending-key
+	 (lambda ()			;peek-no-hang
+	   (or pending-result
 	       (fix:< start end)
-	       (read-until-key 0)))
-	 (letrec ((peek-char
-		   (lambda ()
-		     (or pending-key
-			 (if (fix:< start end)
-			     (string-ref string start)
-			     (begin
-			       (read-until-key false)
-			       (peek-char)))))))
-	   peek-char)
-	 (letrec ((read-char
-		   (lambda ()
-		     (cond (pending-key
-			    => (lambda (key)
-				 (set! pending-key false)
-				 key))
-			   ((fix:< start end)
-			    (let ((char (string-ref string start)))
-			      (set! start (fix:+ start 1))
-			      char))
-			   (else
-			    (read-until-key false)
-			    (read-char))))))
-	   read-char))))))
+	       (let ((result (read-until-result 0)))
+		 (if result
+		     (set! pending-result result))
+		 result)))
+	 (lambda ()			;peek
+	   (or pending-result
+	       (if (fix:< start end)
+		   (string-ref string start)
+		   (let ((result (read-until-result false)))
+		     (if result
+			 (set! pending-result result))
+		     result))))
+	 (lambda ()			;read
+	   (cond (pending-result
+		  => (lambda (key)
+		       (set! pending-result false)
+		       key))
+		 ((fix:< start end)
+		  (let ((char (string-ref string start)))
+		    (set! start (fix:+ start 1))
+		    char))
+		 (else
+		  (read-until-result false)))))))))
 
 (define (read-event queue display time-limit)
-  (unwind-protect
+  (dynamic-wind
    (lambda ()
      (lock-thread-mutex event-stream-mutex))
    (lambda ()
@@ -382,7 +378,11 @@
 		(if inferior-thread-changes? event (loop)))
 	       ((and (vector? event)
 		     (fix:= (vector-ref event 0) event-type:expose))
-		(process-expose-event event)
+		(xterm-dump-rectangle (vector-ref event 1)
+				      (vector-ref event 2)
+				      (vector-ref event 3)
+				      (vector-ref event 4)
+				      (vector-ref event 5))
 		(loop))
 	       (else event)))))
    (lambda ()
@@ -441,18 +441,12 @@
 	     (error "Illegal change event:" event)))
       (update-screens! false)))
 
-(define (process-expose-event event)
-  (xterm-dump-rectangle (vector-ref event 1)
-			(vector-ref event 2)
-			(vector-ref event 3)
-			(vector-ref event 4)
-			(vector-ref event 5)))
-
 (define (process-special-event event)
   (let ((handler (vector-ref event-handlers (vector-ref event 0)))
 	(screen (xterm->screen (vector-ref event 1))))
-    (if (and handler screen)
-	(handler screen event))))
+    (and handler
+	 screen
+	 (handler screen event))))
 
 (define event-handlers
   (make-vector number-of-event-types false))
@@ -472,47 +466,43 @@
 		      (= y-size (screen-y-size screen))))
 	    (begin
 	      (set-screen-size! screen x-size y-size)
-	      (update-screen! screen true)))))))
+	      (update-screen! screen true)))))
+    false))
 
 (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))
-	    (xterm-map-x-coordinate xterm (vector-ref event 2))
-	    (xterm-map-y-coordinate xterm (vector-ref event 3))))
-    (update-screen! screen false)))
+      (make-input-event execute-button-command
+			screen
+			(make-down-button (vector-ref event 4))
+			(xterm-map-x-coordinate xterm (vector-ref event 2))
+			(xterm-map-y-coordinate xterm (vector-ref event 3))))))
 
 (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)))
-
+      (make-input-event execute-button-command
+			screen
+			(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))))))
+
 (define-event-handler event-type:focus-in
   (lambda (screen event)
     event
-    (if (not (selected-screen? screen))
-	(command-reader/reset-and-execute
-	 (lambda ()
-	   (select-screen screen))))))
+    (make-input-event select-screen screen)))
 
 (define-event-handler event-type:delete-window
   (lambda (screen event)
     event
-    (if (not (screen-deleted? screen))
-	(if (other-screen screen true)
-	    (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))))))
+    (and (not (screen-deleted? screen))
+	 (if (selected-screen? screen)
+	     (make-input-event delete-screen! screen)
+	     (begin
+	       (delete-screen! screen)
+	       false)))))
 
 (define-event-handler event-type:map
   (lambda (screen event)
@@ -520,23 +510,24 @@
     (if (not (screen-deleted? screen))
 	(begin
 	  (set-screen-visibility! screen 'VISIBLE)
-	  (update-screen! screen true)))))
+	  (update-screen! screen true)))
+    false))
 
 (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 false)))
-		(if screen
-		    (select-screen screen))))))))
+    (and (not (screen-deleted? screen))
+	 (begin
+	   (set-screen-visibility! screen 'INVISIBLE)
+	   (and (selected-screen? screen)
+		(let ((screen (other-screen screen false)))
+		  (and screen
+		       (make-input-event select-screen screen))))))))
 
 (define-event-handler event-type:take-focus
   (lambda (screen event)
     (set! last-focus-time (vector-ref event 2))
-    (select-screen screen)))
+    (make-input-event select-screen screen)))
 
 (define signal-interrupts?)
 (define event-stream-mutex)
@@ -558,14 +549,15 @@
 
 (define (with-signal-interrupts enabled? thunk)
   (let ((old))
-    (unwind-protect (lambda ()
-		      (set! old signal-interrupts?)
-		      (set! signal-interrupts? enabled?)
-		      unspecific)
-		    thunk
-		    (lambda ()
-		      (set! signal-interrupts? old)
-		      unspecific))))
+    (dynamic-wind (lambda ()
+		    (set! old signal-interrupts?)
+		    (set! signal-interrupts? enabled?)
+		    unspecific)
+		  thunk
+		  (lambda ()
+		    (set! enabled? signal-interrupts?)
+		    (set! signal-interrupts? old)
+		    unspecific))))
 
 (define (signal-interrupt!)
   (editor-beep)
-- 
2.25.1