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

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

Browse Source 
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
1 changed files with 25 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/drracket/private/debug.rkt
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)))))
[exprs (exn:fail:syntax-exprs exn)]) (define exprs (exn:fail:syntax-exprs exn))
(define (show-in)
(send-out " in:"
(λ (snp)
(send snp set-style
(send (editor:get-standard-style-list) find-named-style "Standard")))))
(cond (cond
[(null? exprs) (void)] [(null? exprs) (void)]
[(null? (cdr exprs)) [(null? (cdr exprs))
(send-out " in:" void) (show-in)
(show-one (car exprs))] (show-one (car exprs))]
[else [else
(send-out " in:" void) (show-in)
(for-each (λ (expr) (for-each (λ (expr)
(display "\n " (current-error-port)) (display "\n " (current-error-port))
(show-one expr)) (show-one expr))
exprs)])))) exprs)])))
;; insert/clickback : (instanceof text%) (union string (instanceof snip%)) (-> void) ;; insert/clickback : (instanceof text%) (union string (instanceof snip%)) (-> void)