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

Unbreak source locations for errors off the REPL in teaching languages.

Browse Source 
Make sure we notice when the error source is the REPL, not the
definitions.
This commit is contained in:
Mike Sperber 2010-10-08 14:50:01 +02:00
parent d0fd2c40ad
commit 02cde446cc
1 changed files with 21 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/test-engine/test-display.scm
View File

@ -354,7 +354,7 @@
(send text set-clickback (send text set-clickback
start (send text get-end-position) start (send text get-end-position)
(lambda (t s e) (lambda (t s e)
(highlight-error line column pos span src-editor)) (highlight-error source line column pos span src-editor))
#f #f) #f #f)
(set-clickback-style text start "blue"))) (set-clickback-style text start "blue")))
(send text insert ", ") (send text insert ", ")
@ -416,25 +416,28 @@
(format (string-constant test-engine-at-line-column) (format (string-constant test-engine-at-line-column)
line col)))) line col))))
(define (highlight-error line column position span src-editor) (define (highlight-error source line column position span src-editor)
(when (and current-rep src-editor) (when (and current-rep src-editor)
(cond (cond
[(is-a? src-editor text:basic<%>) [(is-a? src-editor text:basic<%>)
(let ((highlight (let ((highlight
(lambda () (lambda ()
(send current-rep highlight-errors (let ((error-src (if (send src-editor port-name-matches? source) ; definitions or REPL?
(list (make-srcloc src-editor src-editor
line current-rep)))
column (send current-rep highlight-errors
position span)) #f) (list (make-srcloc error-src
(let ([frame (send current-tab get-frame)]) line
(unless (send current-tab is-current-tab?) column
(let loop ([tabs (send frame get-tabs)] [i 0]) position span)) #f)
(unless (null? tabs) (let ([frame (send current-tab get-frame)])
(if (eq? (car tabs) current-tab) (unless (send current-tab is-current-tab?)
(send frame change-to-nth-tab i) (let loop ([tabs (send frame get-tabs)] [i 0])
(loop (cdr tabs) (add1 i)))))) (unless (null? tabs)
(send frame show #t))))) (if (eq? (car tabs) current-tab)
(send frame change-to-nth-tab i)
(loop (cdr tabs) (add1 i))))))
(send frame show #t))))))
(queue-callback highlight))]))) (queue-callback highlight))])))
(define (highlight-check-error srcloc src-editor) (define (highlight-check-error srcloc src-editor)
@ -442,12 +445,12 @@
[src-span (lambda (l) (car (cddddr l)))] [src-span (lambda (l) (car (cddddr l)))]
[position (src-pos srcloc)] [position (src-pos srcloc)]
[span (src-span srcloc)]) [span (src-span srcloc)])
(highlight-error (cadr srcloc) (caddr srcloc) (highlight-error (car srcloc) (cadr srcloc) (caddr srcloc)
position span position span
src-editor))) src-editor)))
(define (highlight-error/syntax stx src-editor) (define (highlight-error/syntax stx src-editor)
(highlight-error (syntax-line stx) (syntax-column stx) (highlight-error (syntax-source stx) (syntax-line stx) (syntax-column stx)
(syntax-position stx) (syntax-span stx) (syntax-position stx) (syntax-span stx)
src-editor)) src-editor))