fixed a bug, worked around a windows bug
svn: r6672
This commit is contained in:
parent
1f749fae97
commit
ec718f269d
|
@ -254,7 +254,7 @@ profile todo:
|
|||
(write-special note (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
|
||||
(and (exn? exn)
|
||||
(continuation-mark-set? (exn-continuation-marks exn))
|
||||
|
|
|
@ -232,9 +232,7 @@ TODO
|
|||
(parameterize ([current-eventspace drscheme:init:system-eventspace])
|
||||
(queue-callback
|
||||
(λ ()
|
||||
(send rep highlight-errors
|
||||
src-locs
|
||||
(filter (λ (x) (is-a? (car x) text%)) stack)))))))))
|
||||
(send rep highlight-errors src-locs stack))))))))
|
||||
|
||||
(define (main-user-eventspace-thread?)
|
||||
(let ([rep (current-rep)])
|
||||
|
@ -754,7 +752,10 @@ TODO
|
|||
;; (union #f (listof (list (is-a?/c text:basic<%>) number number)))
|
||||
;; -> (void)
|
||||
(define/public (highlight-errors raw-locs error-arrows)
|
||||
(let ([locs (filter (λ (loc) (and (is-a? (srcloc-source loc) text:basic<%>)
|
||||
(let ([locs (filter (λ (loc) (and (or (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-span loc))))
|
||||
raw-locs)])
|
||||
|
@ -762,7 +763,12 @@ TODO
|
|||
|
||||
(set! error-ranges locs)
|
||||
|
||||
(for-each (λ (loc) (send (srcloc-source loc) begin-edit-sequence)) locs)
|
||||
(for-each (λ (loc)
|
||||
(let ([ed (if (path? (srcloc-source loc))
|
||||
(get-definitions-text)
|
||||
(srcloc-source loc))])
|
||||
(send ed begin-edit-sequence)))
|
||||
locs)
|
||||
|
||||
(when color?
|
||||
(let ([resets
|
||||
|
@ -802,7 +808,11 @@ TODO
|
|||
(send first-file set-position first-start first-start))
|
||||
(send first-file scroll-to-position first-start #f first-finish)))
|
||||
|
||||
(for-each (λ (loc) (send (srcloc-source loc) end-edit-sequence)) locs)
|
||||
(λ (loc)
|
||||
(let ([ed (if (path? (srcloc-source loc))
|
||||
(get-definitions-text)
|
||||
(srcloc-source loc))])
|
||||
(send ed end-edit-sequence)))
|
||||
|
||||
(when first-loc
|
||||
(send first-file set-caret-owner (get-focus-snip) 'global)))))
|
||||
|
|
|
@ -3456,14 +3456,15 @@ module browser threading seems wrong.
|
|||
(compute-new-string))
|
||||
(let ([dc (get-dc)])
|
||||
(send dc set-font small-control-font)
|
||||
(let-values ([(w h) (get-client-size)])
|
||||
(let*-values ([(tw th _1 _2) (send dc get-text-extent to-draw-message)]
|
||||
[(w h) (values (+ tw (get-left-side-padding)) th)])
|
||||
(send dc set-pen (get-panel-background) 1 'transparent)
|
||||
(send dc set-brush (get-panel-background) 'transparent)
|
||||
(send dc draw-rectangle 0 0 w h)
|
||||
(when yellow?
|
||||
(send dc set-pen "black" 1 'transparent)
|
||||
(send dc set-brush "yellow" 'solid)
|
||||
(send dc draw-rectangle (get-left-side-padding) 0 (- w (get-left-side-padding)) h))
|
||||
(send dc draw-rectangle (get-left-side-padding) 0 tw th))
|
||||
(send dc draw-text to-draw-message (get-left-side-padding) 0))))
|
||||
|
||||
(super-new [style '(transparent)])
|
||||
|
@ -3473,7 +3474,7 @@ module browser threading seems wrong.
|
|||
|
||||
(inherit min-height)
|
||||
(let ([dc (get-dc)])
|
||||
(let-values ([(w2 h2 _3 _4) (send dc get-text-extent message small-control-font)])
|
||||
(let-values ([(w2 h2 _3 _4) (send dc get-text-extent "x" small-control-font)])
|
||||
(min-height (inexact->exact (floor h2)))))))
|
||||
|
||||
(define language-label-message%
|
||||
|
|
Loading…
Reference in New Issue
Block a user