From: Chris Hanson Date: Sat, 16 Oct 1993 07:32:43 +0000 (+0000) Subject: Change prompting commands to do standard modifications to prompt X-Git-Tag: 20090517-FFI~7745 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ead73dd2fb84d109903228a569ad0c1f59cf122c;p=mit-scheme.git Change prompting commands to do standard modifications to prompt strings BEFORE passing them to custom operations. --- diff --git a/v7/src/runtime/emacs.scm b/v7/src/runtime/emacs.scm index 630264941..d089e9238 100644 --- a/v7/src/runtime/emacs.scm +++ b/v7/src/runtime/emacs.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: emacs.scm,v 14.15 1993/10/16 05:59:35 cph Exp $ +$Id: emacs.scm,v 14.16 1993/10/16 07:32:43 cph Exp $ Copyright (c) 1988-93 Massachusetts Institute of Technology @@ -57,10 +57,11 @@ MIT in each case. |# (let ((prefix (string-append (number->string (nearest-cmdl/level)) " "))) (string-append prefix (let ((prompt - (if (and (string-prefix? prefix prompt) - (not (string=? prefix prompt))) - (string-tail prompt (string-length prefix)) - prompt))) + (string-trim-right + (if (and (string-prefix? prefix prompt) + (not (string=? prefix prompt))) + (string-tail prompt (string-length prefix)) + prompt)))) (let ((entry (assoc prompt cmdl-prompt-alist))) (if entry (cadr entry) @@ -75,11 +76,20 @@ MIT in each case. |# ("where>" "[Where]"))) (define (emacs/prompt-for-expression port prompt) - (transmit-signal-with-argument port #\i (string-append prompt ": ")) + (transmit-signal-with-argument port #\i prompt) (read port)) (define (emacs/prompt-for-confirmation port prompt) - (transmit-signal-with-argument port #\n (string-append prompt "? ")) + (transmit-signal-with-argument + port + #\n + (let ((suffix " (y or n)? ")) + (if (string-suffix? suffix prompt) + (string-append (string-head prompt + (fix:- (string-length prompt) + (string-length suffix))) + "? ") + prompt))) (char=? #\y (read-char-internal port))) (define (read-char-internal port) diff --git a/v7/src/runtime/usrint.scm b/v7/src/runtime/usrint.scm index 0545ec6f1..756ea2d80 100644 --- a/v7/src/runtime/usrint.scm +++ b/v7/src/runtime/usrint.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: usrint.scm,v 1.6 1993/10/16 06:33:09 cph Exp $ +$Id: usrint.scm,v 1.7 1993/10/16 07:32:34 cph Exp $ Copyright (c) 1991-93 Massachusetts Institute of Technology @@ -39,8 +39,16 @@ MIT in each case. |# ;;;; Prompting +(define (canonicalize-prompt prompt suffix) + (if (let ((length (string-length prompt))) + (and (not (fix:= length 0)) + (char=? (string-ref prompt (fix:- length 1)) #\space))) + prompt + (string-append prompt suffix))) + (define (prompt-for-command-expression prompt #!optional port) - (let ((port (if (default-object? port) (nearest-cmdl/port) port))) + (let ((prompt (canonicalize-prompt prompt " ")) + (port (if (default-object? port) (nearest-cmdl/port) port))) (let ((operation (port/operation port 'PROMPT-FOR-COMMAND-EXPRESSION))) (if operation (operation port prompt) @@ -59,14 +67,15 @@ MIT in each case. |# (read port)))) (define (prompt-for-expression prompt #!optional port) - (let ((port (if (default-object? port) (nearest-cmdl/port) port))) + (let ((prompt (canonicalize-prompt prompt ": ")) + (port (if (default-object? port) (nearest-cmdl/port) port))) (let ((operation (port/operation port 'PROMPT-FOR-EXPRESSION))) (if operation (operation port prompt) (default/prompt-for-expression port prompt))))) -(define (default/prompt-for-expression port prompt) - (default/prompt-for-command-expression port (string-append prompt ":"))) +(define default/prompt-for-expression + default/prompt-for-command-expression) (define (prompt-for-evaluated-expression prompt #!optional environment port) (hook/repl-eval #f @@ -80,7 +89,8 @@ MIT in each case. |# (nearest-repl/syntax-table))) (define (prompt-for-command-char prompt #!optional port) - (let ((port (if (default-object? port) (nearest-cmdl/port) port))) + (let ((prompt (canonicalize-prompt prompt " ")) + (port (if (default-object? port) (nearest-cmdl/port) port))) (let ((operation (port/operation port 'PROMPT-FOR-COMMAND-CHAR))) (if operation (operation port prompt) @@ -94,7 +104,6 @@ MIT in each case. |# (fresh-line port) (newline port) (write-string prompt port) - (write-string " " port) (flush-output port) (let loop () (let ((char (read-char port))) @@ -106,40 +115,40 @@ MIT in each case. |# (loop))))))))) (define (prompt-for-confirmation prompt #!optional port) - (let ((port (if (default-object? port) (nearest-cmdl/port) port))) + (let ((prompt (canonicalize-prompt prompt " (y or n)? ")) + (port (if (default-object? port) (nearest-cmdl/port) port))) (let ((operation (port/operation port 'PROMPT-FOR-CONFIRMATION))) (if operation (operation port prompt) (default/prompt-for-confirmation port prompt))))) (define (default/prompt-for-confirmation port prompt) - (let ((prompt (string-append prompt " (y or n)? "))) - (port/with-output-terminal-mode port 'COOKED - (lambda () - (port/with-input-terminal-mode port 'RAW - (lambda () - (fresh-line port) - (let loop () - (newline port) - (write-string prompt port) - (flush-output port) - (let ((char (read-char port))) - (case char - ((#\y #\Y #\space) - (write-string "Yes" port) - (flush-output port) - true) - ((#\n #\N #\rubout) - (write-string "No" port) - (flush-output port) - false) - ((#\newline) - (loop)) - (else - (write char port) - (beep port) - (flush-output port) - (loop))))))))))) + (port/with-output-terminal-mode port 'COOKED + (lambda () + (port/with-input-terminal-mode port 'RAW + (lambda () + (fresh-line port) + (let loop () + (newline port) + (write-string prompt port) + (flush-output port) + (let ((char (read-char port))) + (case char + ((#\y #\Y #\space) + (write-string "Yes" port) + (flush-output port) + true) + ((#\n #\N #\rubout) + (write-string "No" port) + (flush-output port) + false) + ((#\newline) + (loop)) + (else + (write char port) + (beep port) + (flush-output port) + (loop)))))))))) ;;;; Debugger Support