suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

improved printouts for syntax errors that have multiple source locations

Browse Source 
svn: r5649
This commit is contained in:
Robby Findler 2007-02-20 19:08:49 +00:00
parent 815c6669ba
commit 76952ae26b
1 changed files with 18 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/drscheme/private/debug.ss
View File

@ -362,15 +362,24 @@ profile todo:
(display msg (current-error-port))))]) (display msg (current-error-port))))])
(send error-text-style-delta set-delta-foreground (make-object color% 200 0 0)) (send error-text-style-delta set-delta-foreground (make-object color% 200 0 0))
(send-out " in:" void) (send-out " in:" void)
(for-each (λ (expr) (let ([show-one
(λ (expr)
(display " " (current-error-port)) (display " " (current-error-port))
(send-out (format "~s" (syntax-object->datum expr)) (send-out (format "~s" (syntax-object->datum expr))
(λ (snp) (λ (snp)
(send snp set-style (send snp set-style
(send the-style-list find-or-create-style (send the-style-list find-or-create-style
(send snp get-style) (send snp get-style)
error-text-style-delta))))) error-text-style-delta)))))]
(exn:fail:syntax-exprs exn)))) [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 ;; 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 ;; adds in the bug icon, if there are contexts to display