From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 23 May 2000 02:09:15 +0000 (+0000)
Subject: Suppress messages and command prompts while doing completion
X-Git-Tag: 20090517-FFI~3726
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=bcf3839b08e850ea92e03a1d1e82a16b631df07a;p=mit-scheme.git

Suppress messages and command prompts while doing completion
operations in the minibuffer.
---

diff --git a/v7/src/edwin/curren.scm b/v7/src/edwin/curren.scm
index 5be9310dd..ffc89f56e 100644
--- a/v7/src/edwin/curren.scm
+++ b/v7/src/edwin/curren.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: curren.scm,v 1.124 2000/04/07 20:12:50 cph Exp $
+;;; $Id: curren.scm,v 1.125 2000/05/23 02:08:59 cph Exp $
 ;;;
-;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -318,7 +318,7 @@ The frame is guaranteed to be deselected at that time."
 
 (define (set-current-message! message)
   (let ((window (typein-window)))
-    (if message
+    (if (and message (not *suppress-messages?*))
 	(window-set-override-message! window message)
 	(window-clear-override-message! window))
     (if (not *executing-keyboard-macro?*)
@@ -329,6 +329,13 @@ The frame is guaranteed to be deselected at that time."
     (window-clear-override-message! window)
     (if (not *executing-keyboard-macro?*)
 	(window-direct-update! window true))))
+
+(define (with-messages-suppressed thunk)
+  (fluid-let ((*suppress-messages?* #t))
+    (clear-current-message!)
+    (thunk)))
+
+(define *suppress-messages?* #f)
 
 ;;;; Buffers
 
diff --git a/v7/src/edwin/prompt.scm b/v7/src/edwin/prompt.scm
index ac74de47e..970b32792 100644
--- a/v7/src/edwin/prompt.scm
+++ b/v7/src/edwin/prompt.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: prompt.scm,v 1.184 1999/08/10 16:53:42 cph Exp $
+;;; $Id: prompt.scm,v 1.185 2000/05/23 02:09:15 cph Exp $
 ;;;
-;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -546,7 +546,9 @@ The following commands are special to this mode:
   (lambda ()
     (minibuffer-completion-help
      (lambda ()
-       ((options/list-completions *options*) (typein-string))))))
+       (with-messages-suppressed
+	(lambda ()
+	  ((options/list-completions *options*) (typein-string))))))))
 
 (define (minibuffer-completion-help list-completions)
   (pop-up-generated-completions
@@ -612,43 +614,45 @@ a repetition of this command will exit."
 		   (temporary-typein-message " [Error]")
 		   (k 'NO-MATCH))))
 	 (lambda ()
-	   (complete-string original
-	     (lambda (string)
-	       (set! effected? #t)
-	       (if (not (string=? string original))
-		   (set-typein-string! string update?))
-	       (if (if (case-insensitive-completion?)
-		       (string-ci=? string original)
-		       (string=? string original))
-		   'WAS-ALREADY-EXACT-AND-UNIQUE-COMPLETION
-		   'COMPLETED-TO-EXACT-AND-UNIQUE-COMPLETION))
-	     (lambda (string list-completions)
-	       (let ((verified?
-		      ((options/verify-final-value *options*) string)))
-		 (set! effected? #t)
-		 (if (not (string=? string original))
-		     (set-typein-string! string update?))
-		 (if verified?
-		     (if (if (case-insensitive-completion?)
-			     (string-ci=? string original)
-			     (string=? string original))
-			 'WAS-ALREADY-EXACT-COMPLETION
-			 'COMPLETED-TO-EXACT-COMPLETION)
-		     (if (if (case-insensitive-completion?)
-			     (string-ci=? string original)
-			     (string=? string original))
-			 (begin
-			   (if (ref-variable completion-auto-help)
-			       (minibuffer-completion-help list-completions)
-			       (temporary-typein-message
-				" [Next char not unique]"))
-			   'NO-COMPLETION-HAPPENED)
-			 'SOME-COMPLETION-HAPPENED))))
-	     (lambda ()
-	       (set! effected? #t)
-	       (editor-beep)
-	       (temporary-typein-message " [No match]")
-	       'NO-MATCH))))))))
+	   (with-messages-suppressed
+	    (lambda ()
+	      (complete-string original
+		(lambda (string)
+		  (set! effected? #t)
+		  (if (not (string=? string original))
+		      (set-typein-string! string update?))
+		  (if (if (case-insensitive-completion?)
+			  (string-ci=? string original)
+			  (string=? string original))
+		      'WAS-ALREADY-EXACT-AND-UNIQUE-COMPLETION
+		      'COMPLETED-TO-EXACT-AND-UNIQUE-COMPLETION))
+		(lambda (string list-completions)
+		  (let ((verified?
+			 ((options/verify-final-value *options*) string)))
+		    (set! effected? #t)
+		    (if (not (string=? string original))
+			(set-typein-string! string update?))
+		    (if verified?
+			(if (if (case-insensitive-completion?)
+				(string-ci=? string original)
+				(string=? string original))
+			    'WAS-ALREADY-EXACT-COMPLETION
+			    'COMPLETED-TO-EXACT-COMPLETION)
+			(if (if (case-insensitive-completion?)
+				(string-ci=? string original)
+				(string=? string original))
+			    (begin
+			      (if (ref-variable completion-auto-help)
+				  (minibuffer-completion-help list-completions)
+				  (temporary-typein-message
+				   " [Next char not unique]"))
+			      'NO-COMPLETION-HAPPENED)
+			    'SOME-COMPLETION-HAPPENED))))
+		(lambda ()
+		  (set! effected? #t)
+		  (editor-beep)
+		  (temporary-typein-message " [No match]")
+		  'NO-MATCH))))))))))
 
 (define (completion-procedure/complete-word string
 					    if-unique