From 76952ae26bcb78cf45dd92282155e3d0c85929c7 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 20 Feb 2007 19:08:49 +0000 Subject: [PATCH] improved printouts for syntax errors that have multiple source locations svn: r5649 --- collects/drscheme/private/debug.ss | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/collects/drscheme/private/debug.ss b/collects/drscheme/private/debug.ss index 5321480ede..13e5b2e95d 100644 --- a/collects/drscheme/private/debug.ss +++ b/collects/drscheme/private/debug.ss @@ -362,15 +362,24 @@ profile todo: (display msg (current-error-port))))]) (send error-text-style-delta set-delta-foreground (make-object color% 200 0 0)) (send-out " in:" void) - (for-each (λ (expr) - (display " " (current-error-port)) - (send-out (format "~s" (syntax-object->datum expr)) - (λ (snp) - (send snp set-style - (send the-style-list find-or-create-style - (send snp get-style) - error-text-style-delta))))) - (exn:fail:syntax-exprs exn)))) + (let ([show-one + (λ (expr) + (display " " (current-error-port)) + (send-out (format "~s" (syntax-object->datum expr)) + (λ (snp) + (send snp set-style + (send the-style-list find-or-create-style + (send snp get-style) + error-text-style-delta)))))] + [exprs (exn:fail:syntax-exprs exn)]) + (cond + [(null? exprs) (void)] + [(null? (cdr exprs)) (show-one (car exprs))] + [else + (for-each (λ (expr) + (display "\n " (current-error-port)) + (show-one expr)) + exprs)])))) ;; make-debug-error-display-handler : (string (union TST exn) -> void) -> string (union TST exn) -> void ;; adds in the bug icon, if there are contexts to display