undid the previous change (didnt mean to commit it ...)
svn: r6673
This commit is contained in:
parent
ec718f269d
commit
97f6934eba
|
@ -254,7 +254,7 @@ profile todo:
|
||||||
(write-special note (current-error-port))
|
(write-special note (current-error-port))
|
||||||
(display #\space (current-error-port)))))))
|
(display #\space (current-error-port)))))))
|
||||||
|
|
||||||
(define (show-error-and-highlight msg exn highlight-errors)
|
(define (show-error-and-highlight msg exn highlight-errors)
|
||||||
(let ([cms
|
(let ([cms
|
||||||
(and (exn? exn)
|
(and (exn? exn)
|
||||||
(continuation-mark-set? (exn-continuation-marks exn))
|
(continuation-mark-set? (exn-continuation-marks exn))
|
||||||
|
|
|
@ -232,7 +232,9 @@ TODO
|
||||||
(parameterize ([current-eventspace drscheme:init:system-eventspace])
|
(parameterize ([current-eventspace drscheme:init:system-eventspace])
|
||||||
(queue-callback
|
(queue-callback
|
||||||
(λ ()
|
(λ ()
|
||||||
(send rep highlight-errors src-locs stack))))))))
|
(send rep highlight-errors
|
||||||
|
src-locs
|
||||||
|
(filter (λ (x) (is-a? (car x) text%)) stack)))))))))
|
||||||
|
|
||||||
(define (main-user-eventspace-thread?)
|
(define (main-user-eventspace-thread?)
|
||||||
(let ([rep (current-rep)])
|
(let ([rep (current-rep)])
|
||||||
|
@ -752,10 +754,7 @@ TODO
|
||||||
;; (union #f (listof (list (is-a?/c text:basic<%>) number number)))
|
;; (union #f (listof (list (is-a?/c text:basic<%>) number number)))
|
||||||
;; -> (void)
|
;; -> (void)
|
||||||
(define/public (highlight-errors raw-locs error-arrows)
|
(define/public (highlight-errors raw-locs error-arrows)
|
||||||
(let ([locs (filter (λ (loc) (and (or (is-a? (srcloc-source loc) text:basic<%>)
|
(let ([locs (filter (λ (loc) (and (is-a? (srcloc-source loc) text:basic<%>)
|
||||||
(and (path? (srcloc-source loc))
|
|
||||||
(equal? (normalize-path (srcloc-source loc))
|
|
||||||
(send (get-definitions-text) get-filename))))
|
|
||||||
(number? (srcloc-position loc))
|
(number? (srcloc-position loc))
|
||||||
(number? (srcloc-span loc))))
|
(number? (srcloc-span loc))))
|
||||||
raw-locs)])
|
raw-locs)])
|
||||||
|
@ -763,12 +762,7 @@ TODO
|
||||||
|
|
||||||
(set! error-ranges locs)
|
(set! error-ranges locs)
|
||||||
|
|
||||||
(for-each (λ (loc)
|
(for-each (λ (loc) (send (srcloc-source loc) begin-edit-sequence)) locs)
|
||||||
(let ([ed (if (path? (srcloc-source loc))
|
|
||||||
(get-definitions-text)
|
|
||||||
(srcloc-source loc))])
|
|
||||||
(send ed begin-edit-sequence)))
|
|
||||||
locs)
|
|
||||||
|
|
||||||
(when color?
|
(when color?
|
||||||
(let ([resets
|
(let ([resets
|
||||||
|
@ -808,11 +802,7 @@ TODO
|
||||||
(send first-file set-position first-start first-start))
|
(send first-file set-position first-start first-start))
|
||||||
(send first-file scroll-to-position first-start #f first-finish)))
|
(send first-file scroll-to-position first-start #f first-finish)))
|
||||||
|
|
||||||
(λ (loc)
|
(for-each (λ (loc) (send (srcloc-source loc) end-edit-sequence)) locs)
|
||||||
(let ([ed (if (path? (srcloc-source loc))
|
|
||||||
(get-definitions-text)
|
|
||||||
(srcloc-source loc))])
|
|
||||||
(send ed end-edit-sequence)))
|
|
||||||
|
|
||||||
(when first-loc
|
(when first-loc
|
||||||
(send first-file set-caret-owner (get-focus-snip) 'global)))))
|
(send first-file set-caret-owner (get-focus-snip) 'global)))))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user