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

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

@ -1148,7 +1148,7 @@ TODO
(break-enabled #f) (break-enabled #f)
(set! user-thread-box (make-weak-box (current-thread))) (set! user-thread-box (make-weak-box (current-thread)))
(initialize-parameters snip-classes)))) (initialize-parameters snip-classes))))
;; disable breaks until an evaluation actually occurs ;; disable breaks until an evaluation actually occurs
(send context set-breakables #f #f) (send context set-breakables #f #f)
@ -1187,6 +1187,10 @@ TODO
(set! in-evaluation? #f) (set! in-evaluation? #f)
(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
@ -1290,71 +1294,72 @@ 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) (error-print-source-location #f)
(error-print-source-location #f) (error-display-handler drscheme-error-display-handler)
(error-display-handler drscheme-error-display-handler) (current-load-relative-directory #f)
(current-load-relative-directory #f) (current-custodian user-custodian)
(current-custodian user-custodian) (current-load text-editor-load-handler)
(current-load text-editor-load-handler)
(drscheme:eval:set-basic-parameters snip-classes)
(drscheme:eval:set-basic-parameters snip-classes) (current-rep this)
(current-rep this) (let ([dir (or (send context get-directory)
(let ([dir (or (send context get-directory)
drscheme:init:first-dir)]) drscheme:init:first-dir)])
(current-directory dir) (current-directory dir)
(current-load-relative-directory dir)) (current-load-relative-directory dir))
(set! user-namespace-box (make-weak-box (current-namespace))) (set! user-namespace-box (make-weak-box (current-namespace)))
(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)))
(let* ([primitive-dispatch-handler (event-dispatch-handler)])
(event-dispatch-handler (define/private (initialize-dispatch-handler) ;;; =User=
(rec drscheme-event-dispatch-handler ; <= a name for #<...> printout (let* ([primitive-dispatch-handler (event-dispatch-handler)])
(λ (eventspace) ; =User=, =Handler= (event-dispatch-handler
; Breaking is enabled if the user turned on breaks and (rec drscheme-event-dispatch-handler ; <= a name for #<...> printout
; is in a `yield'. If we get a break, that's ok, because (λ (eventspace) ; =User=, =Handler=
; the kernel never queues an event in the user's eventspace. ; Breaking is enabled if the user turned on breaks and
(cond ; is in a `yield'. If we get a break, that's ok, because
[(eq? eventspace (get-user-eventspace)) ; the kernel never queues an event in the user's eventspace.
; =User=, =Handler= (cond
[(eq? eventspace (get-user-eventspace))
; We must distinguish between "top-level" events and ; =User=, =Handler=
; those within `yield' in the user's program.
(cond ; We must distinguish between "top-level" events and
[(not in-evaluation?) ; those within `yield' in the user's program.
;; at this point, we must not be in a nested dispatch, so we can (cond
;; just disable breaks and rely on call-with-break-parameterization [(not in-evaluation?)
;; to restore them to the user's setting. ;; at this point, we must not be in a nested dispatch, so we can
(call-with-break-parameterization ;; just disable breaks and rely on call-with-break-parameterization
no-breaks-break-parameterization ;; to restore them to the user's setting.
(λ () (call-with-break-parameterization
; =No-Breaks= no-breaks-break-parameterization
(send context reset-offer-kill) (λ ()
(send context set-breakables (get-user-thread) (get-user-custodian)) ; =No-Breaks=
(call-with-continuation-prompt (send context reset-offer-kill)
(λ () ; =User=, =Handler=, =No-Breaks= (send context set-breakables (get-user-thread) (get-user-custodian))
(call-with-break-parameterization (call-with-continuation-prompt
user-break-parameterization (λ () ; =User=, =Handler=, =No-Breaks=
(λ () (primitive-dispatch-handler eventspace))))) (call-with-break-parameterization
user-break-parameterization
;; in principle, the line below might cause (λ () (primitive-dispatch-handler eventspace)))))
;; "race conditions" in the GUI. That is, there might
;; be many little events that the user won't quite ;; in principle, the line below might cause
;; be able to break. ;; "race conditions" in the GUI. That is, there might
(send context set-breakables #f #f)))] ;; be many little events that the user won't quite
[else ;; be able to break.
; Nested dispatch; don't adjust interface (send context set-breakables #f #f)))]
(primitive-dispatch-handler eventspace)])] [else
[else ; Nested dispatch; don't adjust interface
; =User=, =Non-Handler=, =No-Breaks= (primitive-dispatch-handler eventspace)])]
(primitive-dispatch-handler eventspace)]))))))) [else
; =User=, =Non-Handler=, =No-Breaks=
(primitive-dispatch-handler eventspace)]))))))
(define/public (new-empty-console) (define/public (new-empty-console)
(queue-user/wait (queue-user/wait
@ -1451,7 +1456,7 @@ TODO
(λ () ; =User=, =No-Breaks= (λ () ; =User=, =No-Breaks=
(send (drscheme:language-configuration:language-settings-language user-language-settings) (send (drscheme:language-configuration:language-settings-language user-language-settings)
first-opened))) first-opened)))
(insert-prompt) (insert-prompt)
(send context enable-evaluation) (send context enable-evaluation)
(end-edit-sequence) (end-edit-sequence)

37
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)
(cond (let ([thread-to-break (weak-box-value thread-to-break-box)]
[(or (not (weak-box-value thread-to-break-box)) [custodian-to-kill (weak-box-value custodian-to-kill-box)])
(not (weak-box-value custodian-to-kill-box))) (cond
(bell)] [(or (not thread-to-break)
[offer-kill? (not custodian-to-kill))
(if (user-wants-kill?) (bell)]
(let ([thd (weak-box-value thread-to-break-box)]) [offer-kill?
(when thd (if (user-wants-kill?)
(break-thread thd))) (when thread-to-break
(let ([cust (weak-box-value custodian-to-kill-box)]) (break-thread thread-to-break))
(when cust (when custodian-to-kill
(custodian-shutdown-all cust))))] (custodian-shutdown-all custodian-to-kill)))]
[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