in-terminal: add a close-calllback argument

original commit: 4fee662ad87a50a700cde42847e563c03024a845

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].                                          

pkgs/gui-pkgs/gui-lib/info.rkt

@@ -30,4 +30,4 @@
 
 (define pkg-authors '(mflatt robby))
 
-(define version "1.3")
+(define version "1.4")

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))))))