Change handling of command prompts so that only the standard prompts
authorChris Hanson <org/chris-hanson/cph>
Thu, 12 Aug 1993 07:40:36 +0000 (07:40 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 12 Aug 1993 07:40:36 +0000 (07:40 +0000)
are ignored; other prompts are printed.  The standard prompts can also
be printed by changing the value of a flag.  The set of standard
prompts is defined by a list which can be augmented.  These changes
make the prompt argument of PROMPT-FOR-COMMAND-EXPRESSION useful.

v7/src/edwin/intmod.scm

index 997beaf0bc36755ae8eef59c012a684513673925..7bedbf74828f2398b96d0b8426d243b90f873f94 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: intmod.scm,v 1.61 1993/08/05 08:36:45 cph Exp $
+;;;    $Id: intmod.scm,v 1.62 1993/08/12 07:40:36 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -746,6 +746,7 @@ If this is an error, the debugger examines the error condition."
 
 (define (operation/read port parser-table)
   parser-table
+  (standard-prompt-spacing port)
   (read-expression port (number->string (nearest-cmdl/level))))
 
 (define read-expression
@@ -759,7 +760,6 @@ If this is an error, the debugger examines the error condition."
          (let ((expression (dequeue! (port/expression-queue port) empty)))
            (if (eq? expression empty)
                (begin
-                 (standard-prompt-spacing port)
                  (wait-for-input port level mode ready?)
                  (loop))
                expression)))))))
@@ -844,25 +844,42 @@ If this is an error, the debugger examines the error condition."
              (thunk)
              (remove-select-buffer-hook buffer hook))))
        (add-select-buffer-hook buffer hook))))
-
+\f
 (define (operation/prompt-for-command-expression port prompt)
-  (read-expression port (parse-command-prompt prompt)))
+  (read-expression port (parse-command-prompt port prompt)))
 
 (define (operation/prompt-for-command-char port prompt)
-  (standard-prompt-spacing port)
-  (read-command-char port (parse-command-prompt prompt)))
+  (read-command-char port (parse-command-prompt port prompt)))
 
 (define (read-command-char port level)
   (set-port/command-char! port false)
   (wait-for-input port level (ref-mode-object inferior-cmdl) port/command-char)
   (port/command-char port))
 
-(define (parse-command-prompt prompt)
-  (and (re-match-string-forward (re-compile-pattern "\\([0-9]+\\) " false)
-                               false false prompt)
-       (substring prompt
-                 (re-match-start-index 1)
-                 (re-match-end-index 1))))
+(define (parse-command-prompt port prompt)
+  (standard-prompt-spacing port)
+  (let ((index
+        (re-match-string-forward (re-compile-pattern "\\([0-9]+\\) " false)
+                                 false false prompt)))
+    (let ((level
+          (and index
+               (substring prompt
+                          (re-match-start-index 1)
+                          (re-match-end-index 1))))
+         (tail (if index (string-tail prompt index) prompt)))
+      (if (not (and suppress-standard-prompts?
+                   (or (string=? tail user-initial-prompt)
+                       (member tail standard-prompts))))
+         (begin
+           (write-string prompt port)
+           (if (let ((n (string-length prompt)))
+                 (and (> n 0)
+                      (not (char=? #\space (string-ref prompt (- n 1))))))
+               (write-char #\space port))))
+      level)))
+
+(define suppress-standard-prompts? #t)
+(define standard-prompts '("]=>" "error>" "break>" "bkpt"))
 \f
 ;;; Miscellaneous