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

previous commit was accidental ... this is a fix to the broken fix from last night

Browse Source 
svn: r3999
This commit is contained in:
Robby Findler 2006-08-09 14:21:53 +00:00
parent 97e613ac54
commit 124b4ebaf3
1 changed files with 29 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -54,6 +54,11 @@ TODO
(let-syntax ([m (λ (x) (with-syntax ([x (syntax-local-value #'stacktrace-name)]) (let-syntax ([m (λ (x) (with-syntax ([x (syntax-local-value #'stacktrace-name)])
(syntax 'x)))]) (syntax 'x)))])
(m))) (m)))
(define no-breaks-break-parameterization
(parameterize-break
#f
(current-break-parameterization)))
(define rep@ (define rep@
(unit/sig drscheme:rep^ (unit/sig drscheme:rep^
@ -903,7 +908,7 @@ TODO
(define/public (get-user-namespace) (weak-box-value user-namespace-box)) (define/public (get-user-namespace) (weak-box-value user-namespace-box))
(define/pubment (get-user-break-parameterization) user-break-parameterization) ;; final method (define/pubment (get-user-break-parameterization) user-break-parameterization) ;; final method
(field (in-evaluation? #f) ; a heursitic for making the Break button send a break (field (in-evaluation? #f)
(should-collect-garbage? #f) (should-collect-garbage? #f)
(ask-about-kill? #f)) (ask-about-kill? #f))
(define/public (get-in-evaluation?) in-evaluation?) (define/public (get-in-evaluation?) in-evaluation?)
@ -1152,11 +1157,10 @@ TODO
(current-error-escape-k (λ () (current-error-escape-k (λ ()
(set! cleanup? #t) (set! cleanup? #t)
(k (void))))) (k (void)))))
(rec cut-stacktrace-above-here2 (λ ()
(λ () (thunk)
(thunk) ; Breaks must be off!
; Breaks must be off! (set! cleanup? #t))
(set! cleanup? #t)))
(λ () (λ ()
(current-error-escape-k saved-error-escape-k) (current-error-escape-k saved-error-escape-k)
(when cleanup? (when cleanup?
@ -1387,23 +1391,26 @@ TODO
;; at this point, we must not be in a nested dispatch, so we can ;; at this point, we must not be in a nested dispatch, so we can
;; just disable breaks and rely on call-with-break-parameterization ;; just disable breaks and rely on call-with-break-parameterization
;; to restore them to the user's setting. ;; to restore them to the user's setting.
(break-enabled #f)
; =No-Breaks= (call-with-break-parameterization
(send context reset-offer-kill) no-breaks-break-parameterization
(send context set-breakables (get-user-thread) (get-user-custodian))
(protect-user-evaluation
; Run the dispatch:
(λ () ; =User=, =Handler=, =No-Breaks=
(call-with-break-parameterization
user-break-parameterization
(λ () (primitive-dispatch-handler eventspace))))
; Cleanup after dispatch
(λ () (λ ()
;; in principle, the line below might cause ; =No-Breaks=
;; a "race conditions" in the GUI. That is, there might (send context reset-offer-kill)
;; be many little events that the user won't quite (send context set-breakables (get-user-thread) (get-user-custodian))
;; be able to break. (protect-user-evaluation
(send context set-breakables #f #f)))] ; Run the dispatch:
(λ () ; =User=, =Handler=, =No-Breaks=
(call-with-break-parameterization
user-break-parameterization
(λ () (primitive-dispatch-handler eventspace))))
; Cleanup after dispatch
(λ ()
;; in principle, the line below might cause
;; a "race conditions" in the GUI. That is, there might
;; be many little events that the user won't quite
;; be able to break.
(send context set-breakables #f #f)))))]
[else [else
; Nested dispatch; don't adjust interface ; Nested dispatch; don't adjust interface
(primitive-dispatch-handler eventspace)])] (primitive-dispatch-handler eventspace)])]