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

fix for PR 8496

Browse Source 
svn: r5438
This commit is contained in:
Robby Findler 2007-01-23 20:02:05 +00:00
parent 69a6c8a5cb
commit 9bcd4aafe7
2 changed files with 89 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/drscheme/private/rep.ss
View File

@ -1188,6 +1188,10 @@ TODO
(update-running #f) (update-running #f)
(send context set-breakables #f #f) (send context set-breakables #f #f)
;; after this returns, future event dispatches
;; will use the user's break parameterization
(initialize-dispatch-handler)
;; let init-thread procedure return, ;; let init-thread procedure return,
;; now that parameters are set ;; now that parameters are set
(semaphore-post init-thread-complete) (semaphore-post init-thread-complete)
@ -1290,8 +1294,7 @@ TODO
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; initialize-paramters : (listof snip-class%) -> void ;; initialize-paramters : (listof snip-class%) -> void
(define/private initialize-parameters ; =User= (define/private (initialize-parameters snip-classes) ; =User=
(λ (snip-classes)
(current-language-settings user-language-settings) (current-language-settings user-language-settings)
(error-value->string-handler drscheme-error-value->string-handler) (error-value->string-handler drscheme-error-value->string-handler)
@ -1313,7 +1316,9 @@ TODO
(current-output-port (get-out-port)) (current-output-port (get-out-port))
(current-error-port (get-err-port)) (current-error-port (get-err-port))
(current-value-port (get-value-port)) (current-value-port (get-value-port))
(current-input-port (get-in-box-port)) (current-input-port (get-in-box-port)))
(define/private (initialize-dispatch-handler) ;;; =User=
(let* ([primitive-dispatch-handler (event-dispatch-handler)]) (let* ([primitive-dispatch-handler (event-dispatch-handler)])
(event-dispatch-handler (event-dispatch-handler
(rec drscheme-event-dispatch-handler ; <= a name for #<...> printout (rec drscheme-event-dispatch-handler ; <= a name for #<...> printout
@ -1354,7 +1359,7 @@ TODO
(primitive-dispatch-handler eventspace)])] (primitive-dispatch-handler eventspace)])]
[else [else
; =User=, =Non-Handler=, =No-Breaks= ; =User=, =Non-Handler=, =No-Breaks=
(primitive-dispatch-handler eventspace)]))))))) (primitive-dispatch-handler eventspace)]))))))
(define/public (new-empty-console) (define/public (new-empty-console)
(queue-user/wait (queue-user/wait

23
collects/drscheme/private/unit.ss
View File

@ -960,25 +960,24 @@ module browser threading seems wrong.
;; break-callback : -> void ;; break-callback : -> void
(define/public (break-callback) (define/public (break-callback)
(let ([thread-to-break (weak-box-value thread-to-break-box)]
[custodian-to-kill (weak-box-value custodian-to-kill-box)])
(cond (cond
[(or (not (weak-box-value thread-to-break-box)) [(or (not thread-to-break)
(not (weak-box-value custodian-to-kill-box))) (not custodian-to-kill))
(bell)] (bell)]
[offer-kill? [offer-kill?
(if (user-wants-kill?) (if (user-wants-kill?)
(let ([thd (weak-box-value thread-to-break-box)]) (when thread-to-break
(when thd (break-thread thread-to-break))
(break-thread thd))) (when custodian-to-kill
(let ([cust (weak-box-value custodian-to-kill-box)]) (custodian-shutdown-all custodian-to-kill)))]
(when cust
(custodian-shutdown-all cust))))]
[else [else
(let ([thd (weak-box-value thread-to-break-box)]) (when thread-to-break
(when thd (break-thread thread-to-break))
(break-thread thd)))
;; only offer a kill the next time if ;; only offer a kill the next time if
;; something got broken. ;; something got broken.
(set! offer-kill? #t)])) (set! offer-kill? #t)])))
;; user-wants-kill? : -> boolean ;; user-wants-kill? : -> boolean
;; handles events, so be sure to check state ;; handles events, so be sure to check state