diff --git a/pkgs/gui-pkgs/gui-doc/mrlib/scribblings/terminal.scrbl b/pkgs/gui-pkgs/gui-doc/mrlib/scribblings/terminal.scrbl index 12e680b8..b05eb505 100644 --- a/pkgs/gui-pkgs/gui-doc/mrlib/scribblings/terminal.scrbl +++ b/pkgs/gui-pkgs/gui-doc/mrlib/scribblings/terminal.scrbl @@ -19,7 +19,8 @@ in command-line scripts.} [#:canvas-min-width canvas-min-width (or/c #f (integer-in 0 10000)) #f] [#:canvas-min-height canvas-min-height (or/c #f (integer-in 0 10000)) #f] [#:close-button? close-button? boolean? #t] - [#:close-label close-label string? (string-constant close)]) + [#:close-label close-label string? (string-constant close)] + [#:close-callback close-callback (-> any) void]) (is-a?/c terminal<%>)]{ Creates a GUI, sets up the current error and output ports to @@ -40,7 +41,7 @@ in command-line scripts.} just after @racket[doit] is started. The @racket[cleanup-thunk] is called on a queued callback to the - eventspace active when @racket[with-installer-window] is invoked + eventspace active when @racket[in-terminal] is invoked after @racket[doit] completes. In addition to the I/O generated by @racket[doit], the generated GUI @@ -66,7 +67,11 @@ in command-line scripts.} The value of @racket[on-terminal-run] is invoked after @racket[doit] returns, but not if it is aborted or an exception is raised. -} + + The @racket[close-callback] function is called after the terminal + frame is closed or container is removed. + + @history[#:changed "1.4" @elem{Added the @racket[#:close-callback] argument.}]} @defparam[on-terminal-run run (-> void?)]{ Invoked by @racket[in-terminal]. diff --git a/pkgs/gui-pkgs/gui-lib/info.rkt b/pkgs/gui-pkgs/gui-lib/info.rkt index d378cc66..a9b19e14 100644 --- a/pkgs/gui-pkgs/gui-lib/info.rkt +++ b/pkgs/gui-pkgs/gui-lib/info.rkt @@ -30,4 +30,4 @@ (define pkg-authors '(mflatt robby)) -(define version "1.3") +(define version "1.4") diff --git a/pkgs/gui-pkgs/gui-lib/mrlib/terminal.rkt b/pkgs/gui-pkgs/gui-lib/mrlib/terminal.rkt index 89fdbc48..7f5e1aa9 100644 --- a/pkgs/gui-pkgs/gui-lib/mrlib/terminal.rkt +++ b/pkgs/gui-pkgs/gui-lib/mrlib/terminal.rkt @@ -17,7 +17,8 @@ #:canvas-min-width (or/c #f exact-nonnegative-integer?) #:canvas-min-height (or/c #f exact-nonnegative-integer?) #:close-button? boolean? - #:close-label string?) + #:close-label string? + #:close-callback (-> any)) (is-a?/c terminal<%>))]) terminal<%>) @@ -43,7 +44,8 @@ #:canvas-min-width [canvas-min-width #f] #:canvas-min-height [canvas-min-height #f] #:close-button? [close-button? #t] - #:close-label [close-button-label (string-constant close)]) + #:close-label [close-button-label (string-constant close)] + #:close-callback [user-close-callback void]) (define orig-eventspace (current-eventspace)) (define orig-custodian (current-custodian)) (define inst-eventspace (if container @@ -65,7 +67,8 @@ (if frame (send frame show #f) (send container delete-child sub-container)) - (close-callback)) + (close-callback) + (user-close-callback)) (define (close-callback) (custodian-shutdown-all installer-cust)) @@ -78,7 +81,9 @@ (set! frame (new (class frame% (define/augment (can-close?) currently-can-close?) - (define/augment (on-close) (close-callback)) + (define/augment (on-close) + (close-callback) + (user-close-callback)) (super-new [label title] [width 600] [height 300])))) @@ -116,7 +121,8 @@ (new (class vertical-panel% (super-new) (define/override (on-superwindow-show on?) - (unless on? (close-callback)))) + (unless on? + (close-callback)))) [parent container]))) (set! text (new (text:hide-caret/selection-mixin text:standard-style-list%))) @@ -139,12 +145,6 @@ [parent button-panel] [callback (λ (b e) (close))]))) - (define (close) - (if frame - (send frame show #f) - (send container delete-child sub-container)) - (close-callback)) - (define (kill-callback) (custodian-shutdown-all installer-cust) (fprintf output-port "\n~a\n" aborted-message)) @@ -253,6 +253,8 @@ (cleanup-thunk) (custodian-shutdown-all installer-cust)))))))) + (define (outside-close) (close)) + (new (class* object% (terminal<%>) (super-new) (define/public (get-button-panel) @@ -265,6 +267,4 @@ currently-can-close?) (define/public (close) (unless (is-closed?) - (if frame - (send frame show #f) - (send container delete-child sub-container))))))) + (outside-close))))))