From: Chris Hanson Date: Mon, 15 Aug 1994 20:12:06 +0000 (+0000) Subject: Change previous kludge: now, PROMPT-FOR-COMMAND- procedures accept a X-Git-Tag: 20090517-FFI~7132 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f075a08d3d86ffc5fbe8324cb41c3f1ee307bdd2;p=mit-scheme.git Change previous kludge: now, PROMPT-FOR-COMMAND- procedures accept a prompt which is a pair whose car is the symbol STANDARD and whose cdr is a string. Such a prompt is treated exactly as a bare string used to be. Now, a bare string is used directly as the prompt with no modification at all. --- diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm index ce1f9ea59..962c36ec7 100644 --- a/v7/src/edwin/intmod.scm +++ b/v7/src/edwin/intmod.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: intmod.scm,v 1.81 1994/08/15 18:46:36 cph Exp $ +;;; $Id: intmod.scm,v 1.82 1994/08/15 20:12:06 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-94 Massachusetts Institute of Technology ;;; @@ -930,19 +930,13 @@ If this is an error, the debugger examines the error condition." (define (parse-command-prompt port prompt) (standard-prompt-spacing port) - (if (not (and suppress-standard-prompts? - (or (string=? prompt user-initial-prompt) - (member prompt standard-prompts)))) + (if (and (pair? prompt) + (eq? 'STANDARD (car prompt))) + (if (not suppress-standard-prompts?) + (write-string (cdr prompt) port)) (write-string prompt port))) (define suppress-standard-prompts? #t) -(define standard-prompts - '("]=> " - "error> " - "break> " - "bkpt> " - "debug> " - "where> ")) ;;; Miscellaneous diff --git a/v7/src/runtime/dbgcmd.scm b/v7/src/runtime/dbgcmd.scm index 0b7f7d6ae..ec1d8e8ed 100644 --- a/v7/src/runtime/dbgcmd.scm +++ b/v7/src/runtime/dbgcmd.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: dbgcmd.scm,v 14.14 1993/10/16 10:10:56 cph Exp $ +$Id: dbgcmd.scm,v 14.15 1994/08/15 20:11:46 cph Exp $ -Copyright (c) 1988-93 Massachusetts Institute of Technology +Copyright (c) 1988-94 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -86,7 +86,8 @@ MIT in each case. |# (let loop () (let ((entry (assv (char-upcase - (prompt-for-command-char prompt port)) + (prompt-for-command-char (cons 'STANDARD prompt) + port)) (cdr command-set)))) (if entry ((cadr entry) state port) diff --git a/v7/src/runtime/emacs.scm b/v7/src/runtime/emacs.scm index 670ec02b3..ba0b25c5b 100644 --- a/v7/src/runtime/emacs.scm +++ b/v7/src/runtime/emacs.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: emacs.scm,v 14.21 1994/08/15 19:14:42 cph Exp $ +$Id: emacs.scm,v 14.22 1994/08/15 20:11:32 cph Exp $ Copyright (c) 1988-94 Massachusetts Institute of Technology @@ -54,18 +54,18 @@ MIT in each case. |# (transmit-signal-with-argument port #\p - (let ((prefix (number->string level))) - (let ((entry (assoc prompt cmdl-prompt-alist))) - (if entry - (string-append prefix " " (cadr entry)) - (string-append prefix " [Evaluator] " prompt)))))) + (string-append (number->string level) + " " + (if (and (pair? prompt) + (eq? 'STANDARD (car prompt))) + (let ((entry (assoc (cdr prompt) cmdl-prompt-alist))) + (if entry + (cadr entry) + "[Evaluator]")) + (string-append "[Evaluator] " prompt))))) (define cmdl-prompt-alist - '(("]=> " "[Evaluator]") - ("error> " "[Evaluator]") - ("break> " "[Evaluator]") - ("bkpt> " "[Evaluator]") - ("debug> " "[Debug]") + '(("debug> " "[Debug]") ("where> " "[Where]"))) (define (emacs/prompt-for-expression port prompt) diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm index e4f7a3c99..927bebcef 100644 --- a/v7/src/runtime/rep.scm +++ b/v7/src/runtime/rep.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: rep.scm,v 14.49 1993/12/29 18:46:41 cph Exp $ +$Id: rep.scm,v 14.50 1994/08/15 20:11:55 cph Exp $ Copyright (c) 1988-93 Massachusetts Institute of Technology @@ -445,7 +445,7 @@ MIT in each case. |# (port/set-default-syntax-table (cmdl/port repl) (repl/syntax-table repl)) (do () (false) (let ((s-expression - (prompt-for-command-expression (repl/prompt repl) + (prompt-for-command-expression (cons 'STANDARD (repl/prompt repl)) (cmdl/port repl)))) (repl-history/record! reader-history s-expression) (let ((value diff --git a/v7/src/runtime/usrint.scm b/v7/src/runtime/usrint.scm index 98a29db64..ff0fbc32e 100644 --- a/v7/src/runtime/usrint.scm +++ b/v7/src/runtime/usrint.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: usrint.scm,v 1.11 1994/08/15 19:36:15 cph Exp $ +$Id: usrint.scm,v 1.12 1994/08/15 20:08:31 cph Exp $ Copyright (c) 1991-94 Massachusetts Institute of Technology @@ -47,31 +47,29 @@ MIT in each case. |# (string-append prompt suffix))) (define (canonicalize-command-prompt prompt) - (let ((prompt* (canonicalize-prompt prompt " "))) - (if (member prompt* standard-command-prompts) - prompt* - prompt))) + (cond ((string? prompt) + prompt) + ((and (pair? prompt) + (eq? 'STANDARD (car prompt)) + (string? (cdr prompt))) + (cons (car prompt) (canonicalize-prompt (cdr prompt) " "))) + (else + (error:wrong-type-datum prompt)))) (define (write-command-prompt port prompt level) (port/with-output-terminal-mode port 'COOKED (lambda () (fresh-line port) (newline port) - (if (member prompt standard-command-prompts) + (if (and (pair? prompt) + (eq? 'STANDARD (car prompt))) (begin (write level port) - (write-string " " port))) - (write-string prompt port) + (write-string " " port) + (write-string (cdr prompt) port)) + (write-string prompt port)) (flush-output port)))) -(define standard-command-prompts - '("]=> " - "error> " - "break> " - "bkpt> " - "debug> " - "where> ")) - (define (prompt-for-command-expression prompt #!optional port) (let ((prompt (canonicalize-command-prompt prompt)) (port (if (default-object? port) (interaction-i/o-port) port))