* boot-9.scm: Renamed %%throw-handler-default -->

throw-handler-default.
((handle-system-error key . arg-list)): Changed the way errors are
reported.
((scm-style-repl)): Wrap up the call to eval in a start-stack
acro.
((error-catching-loop thunk)): Introduce a lazy-catch into
error-catching-loop so that the stack can be captured.

ice-9/boot-9.scm

@@ -675,61 +675,25 @@
 			    (list n))
 			(list n)))))))
 
-(define display-error-message
-  (lambda (message args port)
-    (if (or (not (list? args))
-	    (null? args))
-	(display message port)
-	(let ((len (string-length message)))
-	  (cond ((< len 2)
-		 (display message port))
-		((string=? (substring message 0 2)
-			   "%s")
-		 (display (car args) port)
-		 (display-error-message (substring message 2 len)
-					(cdr args)
-					port))
-		((string=? (substring message 0 2)
-			   "%S")
-		 (write (car args) port)
-		 (display-error-message (substring message 2 len)
-					(cdr args)
-					port))
-		(else
-		 (display (substring message 0 1)
-			  port)
-		 (display-error-message (substring message 1 len)
-					args
-					port)))))))
-
 ;; The default handler for built-in error types when thrown by their
 ;; symbolic names.
-(define (%%handle-system-error key . arg-list)
+(define (handle-system-error key . arg-list)
   (let ((cep (current-error-port)))
     (cond ((not (= (length arg-list) 4))
 	   (display "ERROR: bad error throw: " cep)
-	   (write arg-list cep))
+	   (write arg-list cep)
+	   (newline cep))
 	  (else
-	   (let ((subr (car arg-list))
-		 (message (cadr arg-list))
-		 (args (or (caddr arg-list)
-			   '()))
-		 (rest (or (cadddr arg-list)
-			   '())))
-	     (display "ERROR: " cep)
-	     (cond (subr
-		    (display subr cep)
-		    (display ": " cep)))
-	     (cond ((list? args)
-		    (display-error-message message args cep))
-		   (else
-		    (display message cep)
-		    (display " (bad message args)" cep))))))
+	   (if (memq 'backtrace (debug-options))
+	       (begin
 		 (newline cep)
+		 (display-backtrace the-last-stack cep)
+		 (newline cep)))
+	   (apply display-error the-last-stack cep arg-list)))
     (force-output cep)
     (throw 'abort key)))
 
-;; associate error symbols with %%handle-system-error.
+;; associate error symbols with handle-system-error.
 (let ((keys '(error-signal system-error numerical-overflow
 			   out-of-range wrong-type-arg
 			   wrong-number-of-args
@@ -741,7 +705,7 @@
     (cond ((not (null? keys))
 	   (set-symbol-property! (car keys)
 				 'throw-handler-default
-				 %%handle-system-error)
+				 handle-system-error)
 	   (loop (cdr keys))))))
 
 
@@ -2093,11 +2057,14 @@
 
 (define the-prompt-string "guile> ")
 
+(define the-last-stack #f)
+
 (define (error-catching-loop thunk)
   (define (loop first)
     (let ((next 
 	   (catch #t
-		  
+	     (lambda ()
+	       (lazy-catch #t
                  (lambda ()
 		   (dynamic-wind
 		    (lambda () (unmask-signals))
@@ -2113,6 +2080,14 @@
 		      #f)
 		    (lambda () (mask-signals))))
 
+		 (lambda (key . args)
+		   (let ((options (debug-options)))
+		     (if (and (or (memq 'deval options)
+				  (memq 'backtrace options))
+			      (not (memq key '(quit switch-repl abort))))
+			 (set! the-last-stack (make-stack #f 6 1)))
+		     (apply throw key args)))))
+	       
 	     (lambda (key . args)
 	       (case key
 		 ((quit)
@@ -2186,7 +2161,7 @@
 
 	   (-eval (lambda (sourc)
 		    (repl-report-start-timing)
-		    (eval sourc)))
+		    (start-stack (eval sourc))))
 
 	   (-print (lambda (result)
 		     (if (not scm-repl-silent)