From bcf3839b08e850ea92e03a1d1e82a16b631df07a Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 23 May 2000 02:09:15 +0000 Subject: [PATCH] Suppress messages and command prompts while doing completion operations in the minibuffer. --- v7/src/edwin/curren.scm | 13 +++++-- v7/src/edwin/prompt.scm | 84 +++++++++++++++++++++-------------------- 2 files changed, 54 insertions(+), 43 deletions(-) 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 -- 2.25.1