diff --git a/collects/drscheme/private/eval.ss b/collects/drscheme/private/eval.ss index 1ccafbb849..54a6c90c38 100644 --- a/collects/drscheme/private/eval.ss +++ b/collects/drscheme/private/eval.ss @@ -172,9 +172,6 @@ (error-print-width 250) (current-ps-setup (make-object ps-setup%)) - (let ([user-custodian (current-custodian)]) - (exit-handler (λ (arg) ; =User= - (custodian-shutdown-all user-custodian)))) (current-namespace (make-namespace 'empty)) (for-each (λ (x) (namespace-attach-module drscheme:init:system-namespace x)) to-be-copied-module-names)) diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss index b0f215a5b6..ac784ad53d 100644 --- a/collects/drscheme/private/rep.ss +++ b/collects/drscheme/private/rep.ss @@ -531,11 +531,18 @@ TODO (make-object image-snip% bitmap) (make-object string-snip% "[err]")))) - (define (no-user-evaluation-message frame) - (message-box - (string-constant evaluation-terminated) - (format (string-constant evaluation-terminated-explanation)) - frame)) + (define (no-user-evaluation-message frame exit-code) + (message-box + (string-constant evaluation-terminated) + (if exit-code + (string-append + (string-constant evaluation-terminated-explanation) + "\n\n" + (if (zero? exit-code) + (string-constant exited-successfully) + (format (string-constant exited-with-error-code) exit-code))) + (string-constant evaluation-terminated-explanation)) + frame)) ;; insert/delta : (instanceof text%) (union snip string) (listof style-delta%) *-> (values number number) ;; inserts the string/stnip into the text at the end and changes the @@ -892,7 +899,11 @@ TODO (user-eventspace-box (make-weak-box #f)) (user-namespace-box (make-weak-box #f)) (user-eventspace-main-thread #f) - (user-break-parameterization #f)) + (user-break-parameterization #f) + + ;; user-exit-code (union #f (integer-in 0 255)) + ;; #f indicates that exit wasn't called. Integer indicates exit code + (user-exit-code #f)) (define/public (get-user-language-settings) user-language-settings) (define/public (get-user-custodian) user-custodian) @@ -928,7 +939,8 @@ TODO (no-user-evaluation-message (let ([canvas (get-active-canvas)]) (and canvas - (send canvas get-top-level-window))))))) + (send canvas get-top-level-window))) + user-exit-code)))) (field (need-interaction-cleanup? #f)) (define/private (cleanup-interaction) ; =Kernel=, =Handler= @@ -1138,6 +1150,7 @@ TODO (set! eval-thread-thunks null) (set! eval-thread-state-sema (make-semaphore 1)) (set! eval-thread-queue-sema (make-semaphore 0)) + (set! user-exit-code #f) (let* ([init-thread-complete (make-semaphore 0)] [goahead (make-semaphore)]) @@ -1145,12 +1158,29 @@ TODO ; setup standard parameters (let ([snip-classes ; the snip-classes in the DrScheme eventspace's snip-class-list - (drscheme:eval:get-snip-classes)]) + (drscheme:eval:get-snip-classes)] + [drs-eventspace (current-eventspace)]) (queue-user/wait (λ () ; =User=, =No-Breaks= ; No user code has been evaluated yet, so we're in the clear... (break-enabled #f) (set! user-eventspace-main-thread (current-thread)) + + (let ([drscheme-exit-handler + (λ (x) + (let ([s (make-semaphore)]) + (parameterize ([current-eventspace drs-eventspace]) + (queue-callback + (λ () + (set! user-exit-code + (if (and (integer? x) + (<= 0 x 255)) + x + 0)) + (semaphore-post s)))) + (semaphore-wait s) + (custodian-shutdown-all user-custodian)))]) + (exit-handler drscheme-exit-handler)) (initialize-parameters snip-classes)))) ;; disable breaks until an evaluation actually occurs diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss index c557ca28a6..18512a68c1 100644 --- a/collects/string-constants/english-string-constants.ss +++ b/collects/string-constants/english-string-constants.ss @@ -1041,6 +1041,11 @@ please adhere to these guidelines: (evaluation-terminated "Evaluation Terminated") (evaluation-terminated-explanation "The evaluation thread is no longer running, so no evaluation can take place until the next execution.") + + ; next two constants show up in the same dialog as the above evaluation-terminated string + ; constants, but only when the user calls 'exit' (possibly with a status code). + (exited-successfully "Exited successfully.") + (exited-with-error-code "Exited with error code ~a.") ;; ~a is filled in with a number between 1 and 255 (last-stack-frame "show the last stack frame") (last-stack-frames "show the last ~a stack frames") (next-stack-frames "show the next ~a stack frames")