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 ce1f9ea5901c31e8ead076e75f0f7740daf108be..962c36ec7d27c682ad97bfb3d66befaffb30f422 100644 (file)
--- 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> "))
 \f
 ;;; Miscellaneous
 

diff --git a/v7/src/runtime/dbgcmd.scm b/v7/src/runtime/dbgcmd.scm
index 0b7f7d6ae689528533cb748c672431c4f94d8b27..ec1d8e8ed47c67d1ecfa71f1751c5fa6f43f129b 100644 (file)
--- 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 670ec02b3e11a4e111e71da8216d09b06230793d..ba0b25c5b14b728104300684b80f8348aa052d66 100644 (file)
--- 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 e4f7a3c99330d89cc0acc5f5feae2082a705da8c..927bebcef89656700722f35001152d17c2ab36f9 100644 (file)
--- 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 98a29db6473adf21059aae35ebebba1ebcec6519..ff0fbc32e9a46644d9c4975340be8a4bb7feb03a 100644 (file)
--- 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))