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

removed a race condition in the way the colors were initialized

Browse Source 
svn: r11757
This commit is contained in:
Robby Findler 2008-09-15 12:52:55 +00:00
parent f25da8fd7d
commit 9c1f3eda0c
1 changed files with 17 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/lang/htdp-langs.ss
View File

@ -48,8 +48,6 @@
(define o (current-output-port)) (define o (current-output-port))
(define (oprintf . args) (apply fprintf o args)) (define (oprintf . args) (apply fprintf o args))
(define init-eventspace (current-eventspace))
(define user-installed-teachpacks-collection "installed-teachpacks") (define user-installed-teachpacks-collection "installed-teachpacks")
(define teachpack-installation-dir (build-path (find-user-collects-dir) user-installed-teachpacks-collection)) (define teachpack-installation-dir (build-path (find-user-collects-dir) user-installed-teachpacks-collection))
@ -981,7 +979,7 @@
'()))] '()))]
[else '()])]) [else '()])])
(parameterize ([current-eventspace init-eventspace]) (parameterize ([current-eventspace drs-eventspace])
(queue-callback (queue-callback
(lambda () (lambda ()
;; need to make sure that the user's eventspace is still the same ;; need to make sure that the user's eventspace is still the same
@ -1033,16 +1031,22 @@
(thread-cell-set! current-test-coverage-info ht) (thread-cell-set! current-test-coverage-info ht)
(let ([rep (drscheme:rep:current-rep)]) (let ([rep (drscheme:rep:current-rep)])
(when rep (when rep
(let ([on-sd (make-object style-delta%)] (let ([s (make-semaphore 0)])
[off-sd (make-object style-delta%)]) (parameterize ([current-eventspace drs-eventspace])
(cond (queue-callback
[(preferences:get 'framework:white-on-black?) (λ ()
(send on-sd set-delta-foreground "white") (let ([on-sd (make-object style-delta%)]
(send off-sd set-delta-foreground "indianred")] [off-sd (make-object style-delta%)])
[else (cond
(send on-sd set-delta-foreground "black") [(preferences:get 'framework:white-on-black?)
(send off-sd set-delta-foreground "firebrick")]) (send on-sd set-delta-foreground "white")
(send rep set-test-coverage-info ht on-sd off-sd #f)))))) (send off-sd set-delta-foreground "indianred")]
[else
(send on-sd set-delta-foreground "black")
(send off-sd set-delta-foreground "firebrick")])
(send rep set-test-coverage-info ht on-sd off-sd #f))
(semaphore-post s))))
(semaphore-wait s))))))
(let ([ht (thread-cell-ref current-test-coverage-info)]) (let ([ht (thread-cell-ref current-test-coverage-info)])
(when ht (when ht
(hash-set! ht key (mcons #f expr))))) (hash-set! ht key (mcons #f expr)))))