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

add an exit handler setting for the drracket:eval:* functions

Browse Source 
(and then adjust the drracket-repl exit handler to take
   precedence over that one)
 closes PR 12071
This commit is contained in:
Robby Findler 2011-07-21 13:34:54 -05:00
parent 7820db9f8d
commit 1c2f4ab05c
2 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/drracket/private/eval.rkt
View File

@ -167,6 +167,11 @@
(for-each (λ (snip-class) (send (get-the-snip-class-list) add snip-class)) (for-each (λ (snip-class) (send (get-the-snip-class-list) add snip-class))
snip-classes) snip-classes)
(let ([cust (current-custodian)])
(define (drracket-plain-exit-handler arg)
(custodian-shutdown-all cust))
(exit-handler drracket-plain-exit-handler))
(current-thread-group (make-thread-group)) (current-thread-group (make-thread-group))
(current-command-line-arguments #()) (current-command-line-arguments #())
(current-pseudo-random-generator (make-pseudo-random-generator)) (current-pseudo-random-generator (make-pseudo-random-generator))

11
collects/drracket/private/rep.rkt
View File

@ -1280,7 +1280,8 @@ TODO
(queue-callback (λ () (new-log-message vec)))) (queue-callback (λ () (new-log-message vec))))
(loop)))))))) (loop))))))))
(let ([drscheme-exit-handler (initialize-parameters snip-classes)
(let ([drracket-exit-handler
(λ (x) (λ (x)
(parameterize-break (parameterize-break
#f #f
@ -1289,15 +1290,13 @@ TODO
(queue-callback (queue-callback
(λ () (λ ()
(set! user-exit-code (set! user-exit-code
(if (and (integer? x) (if (exact-integer? x)
(<= 0 x 255)) (modulo x 256)
x
0)) 0))
(semaphore-post s)))) (semaphore-post s))))
(semaphore-wait s) (semaphore-wait s)
(custodian-shutdown-all user-custodian))))]) (custodian-shutdown-all user-custodian))))])
(exit-handler drscheme-exit-handler)) (exit-handler drracket-exit-handler)))))
(initialize-parameters snip-classes))))
(queue-user/wait (queue-user/wait