Tweak error-reporting mechanism to make it more reliable. Trouble is

that this isn't the right place for it -- it should be integrated into
the debugger interface.

diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm
index 54a0b390d2163321fd016b3054cede3b018bc7b6..aca29aadde9b032d50fc91a7024275a411ac99c2 100644 (file)
--- a/v7/src/edwin/evlcom.scm
+++ b/v7/src/edwin/evlcom.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: evlcom.scm,v 1.53 1997/06/10 05:58:13 cph Exp $
+;;;    $Id: evlcom.scm,v 1.54 1998/03/07 08:54:02 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-97 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-98 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -508,39 +508,48 @@ Set by Scheme evaluation code to update the mode line."
          (error-buffer-report
           (lambda ()
             (string->temporary-buffer report-string "*error*")
-            (message (string-capitalize error-type-name) " error"))))
-      (case (ref-variable error-display-mode)
-       ((TRANSCRIPT)
-        (if (ref-variable enable-transcript-buffer)
-            (with-output-to-transcript-buffer
-              (lambda ()
-                (fresh-line)
-                (write-string ";Error: ")
-                (write-string report-string)
-                (newline)
-                (newline)))
-            (error-buffer-report)))
-       ((ERROR-BUFFER)
-        (error-buffer-report))
-       ((TYPEIN)
-        (typein-report))
-       ((FIT)
-        (if (and (not (string-find-next-char report-string #\newline))
-                 (< (string-columns report-string 8
-                                    default-char-image-strings)
-                    (window-x-size (typein-window))))
-            (typein-report)
-            (error-buffer-report)))))))
+            (update-screens! #f)
+            (message (string-capitalize error-type-name) " error")))
+         (transcript-report
+          (lambda ()
+            (and (ref-variable enable-transcript-buffer)
+                 (begin
+                   (with-output-to-transcript-buffer
+                       (lambda ()
+                         (fresh-line)
+                         (write-string ";Error: ")
+                         (write-string report-string)
+                         (newline)
+                         (newline)))
+                   #t)))))
+      (let ((fit-report
+            (lambda ()
+              (if (and (not (string-find-next-char report-string #\newline))
+                       (< (string-columns report-string 0 8
+                                          default-char-image-strings)
+                          (window-x-size (typein-window))))
+                  (typein-report)
+                  (error-buffer-report)))))
+       (case (ref-variable error-display-mode)
+         ((STANDARD) (transcript-report) (fit-report))
+         ((TRANSCRIPT) (or (transcript-report) (fit-report)))
+         ((ERROR-BUFFER) (error-buffer-report))
+         ((TYPEIN) (typein-report))
+         ((FIT) (fit-report)))))))
 
 (define-variable error-display-mode
-  "Value of this variable controls the way evaluation errors are displayed:
-TRANSCRIPT    Error messages appear in transcript buffer.
-ERROR-BUFFER  Error messages appear in *error* buffer.
-TYPEIN        Error messages appear in typein window.
-FIT           Error messages appear in typein window if they fit;
-                in *error* buffer if they don't."
-  'TRANSCRIPT
-  (lambda (value) (memq value '(TRANSCRIPT ERROR-BUFFER TYPEIN FIT))))
+  "Value of this variable controls the way evaluation error messages
+are displayed:
+STANDARD      like FIT, except messages also appear in transcript buffer,
+                if it is enabled.
+FIT           messages appear in typein window if they fit;
+                in *error* buffer if they don't.
+TYPEIN        messages appear in typein window.
+ERROR-BUFFER  messages appear in *error* buffer.
+TRANSCRIPT    messages appear in transcript buffer, if it is enabled;
+                otherwise this is the same as FIT."
+  'STANDARD
+  (lambda (value) (memq value '(STANDARD TRANSCRIPT ERROR-BUFFER TYPEIN FIT))))
 \f
 ;;;; Transcript Buffer