tweak the printing of syntax errors again so the "in:" part is in tt font

merge to the release branch, please
(cherry picked from commit 9aecc08579)
This commit is contained in:
Robby Findler 2012-01-11 12:31:41 -06:00 committed by Ryan Culpepper
parent e6285227f1
commit ca73b0569d

View File

@ -515,27 +515,31 @@ profile todo:
(write-special snp (current-error-port))) (write-special snp (current-error-port)))
(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))
(let ([show-one (define (show-one expr)
(λ (expr) (display " " (current-error-port))
(display " " (current-error-port)) (send-out (format "~s" (syntax->datum expr))
(send-out (format "~s" (syntax->datum expr)) (λ (snp)
(λ (snp) (send snp set-style
(send snp set-style (send (editor:get-standard-style-list) find-or-create-style
(send (editor:get-standard-style-list) find-or-create-style (send (editor:get-standard-style-list) find-named-style "Standard")
(send (editor:get-standard-style-list) find-named-style "Standard") error-text-style-delta)))))
error-text-style-delta)))))] (define exprs (exn:fail:syntax-exprs exn))
[exprs (exn:fail:syntax-exprs exn)]) (define (show-in)
(cond (send-out " in:"
[(null? exprs) (void)] (λ (snp)
[(null? (cdr exprs)) (send snp set-style
(send-out " in:" void) (send (editor:get-standard-style-list) find-named-style "Standard")))))
(show-one (car exprs))] (cond
[else [(null? exprs) (void)]
(send-out " in:" void) [(null? (cdr exprs))
(for-each (λ (expr) (show-in)
(display "\n " (current-error-port)) (show-one (car exprs))]
(show-one expr)) [else
exprs)])))) (show-in)
(for-each (λ (expr)
(display "\n " (current-error-port))
(show-one expr))
exprs)])))
;; insert/clickback : (instanceof text%) (union string (instanceof snip%)) (-> void) ;; insert/clickback : (instanceof text%) (union string (instanceof snip%)) (-> void)