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

add #:close-button?, #:canvas-min-width, and #:canvas-min-height

Browse Source 
arguments to in-terminal
This commit is contained in:
Robby Findler 2013-05-11 16:18:04 -05:00
parent 15408f0c7b
commit 19c1c02823
2 changed files with 40 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/mrlib/scribblings/terminal.scrbl
View File

@ -15,7 +15,10 @@ in command-line scripts.}
[#:cleanup-thunk cleanup-thunk (-> void?) void] [#:cleanup-thunk cleanup-thunk (-> void?) void]
[#:title title string? "mrlib/terminal"] [#:title title string? "mrlib/terminal"]
[#:abort-label abort-label string? (string-constant plt-installer-abort-installation)] [#:abort-label abort-label string? (string-constant plt-installer-abort-installation)]
[#:aborted-message aborted-message string? (string-constant plt-installer-aborted)]) [#:aborted-message aborted-message string? (string-constant plt-installer-aborted)]
[#: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])
(is-a?/c terminal<%>)]{ (is-a?/c terminal<%>)]{
Creates a GUI, sets up the current error and output ports to Creates a GUI, sets up the current error and output ports to
@ -42,7 +45,10 @@ in command-line scripts.}
In addition to the I/O generated by @racket[doit], the generated GUI In addition to the I/O generated by @racket[doit], the generated GUI
contains two buttons: the abort button (with label contains two buttons: the abort button (with label
@racket[abort-label]) and the close button (with label @racket[abort-label]) and the close button (with label
@racket[(string-constant close)]). When the abort button is pushed, @racket[(string-constant close)]). The close button is present only
if @racket[close-button?] is @racket[#t].
When the abort button is pushed,
the newly created custodian is shut down and the the newly created custodian is shut down and the
@racket[aborted-message] is printed in the dialog. The close button @racket[aborted-message] is printed in the dialog. The close button
becomes active when @racket[doit] returns or when the thread running becomes active when @racket[doit] returns or when the thread running
@ -52,6 +58,11 @@ in command-line scripts.}
the frame; otherwise, the close button causes the container created the frame; otherwise, the close button causes the container created
for the terminal's GUI to be removed from its parent. for the terminal's GUI to be removed from its parent.
The @racket[canvas-min-width] and @racket[canvas-min-height] are passed
to the @racket[_min-width] and @racket[_min-height] initialization arguments
of the @racket[editor-canvas%] object that holds the output generated
by @racket[doit].
The value of @racket[on-terminal-run] is invoked after @racket[doit] The value of @racket[on-terminal-run] is invoked after @racket[doit]
returns, but not if it is aborted or an exception is raised. returns, but not if it is aborted or an exception is raised.
} }

28
collects/mrlib/terminal.rkt
View File

@ -13,7 +13,10 @@
#:title string? #:title string?
#:abort-label string? #:abort-label string?
#:aborted-message string? #:aborted-message string?
#:cleanup-thunk (-> void?)) #:cleanup-thunk (-> void?)
#:canvas-min-width (or/c #f exact-nonnegative-integer?)
#:canvas-min-height (or/c #f exact-nonnegative-integer?)
#:close-button? boolean?)
(is-a?/c terminal<%>))]) (is-a?/c terminal<%>))])
terminal<%>) terminal<%>)
@ -35,7 +38,10 @@
#:title [title "mrlib/terminal"] #:title [title "mrlib/terminal"]
#:abort-label [abort-label (string-constant plt-installer-abort-installation)] #:abort-label [abort-label (string-constant plt-installer-abort-installation)]
#:aborted-message [aborted-message (string-constant plt-installer-aborted)] #:aborted-message [aborted-message (string-constant plt-installer-aborted)]
#:cleanup-thunk [cleanup-thunk void]) #:cleanup-thunk [cleanup-thunk void]
#:canvas-min-width [canvas-min-width #f]
#:canvas-min-height [canvas-min-height #f]
#:close-button? [close-button? #t])
(define orig-eventspace (current-eventspace)) (define orig-eventspace (current-eventspace))
(define orig-custodian (current-custodian)) (define orig-custodian (current-custodian))
(define inst-eventspace (make-eventspace)) (define inst-eventspace (make-eventspace))
@ -49,6 +55,7 @@
(define kill-button #f) (define kill-button #f)
(define setup-sema (make-semaphore 0)) (define setup-sema (make-semaphore 0))
(define can-close-sema (make-semaphore)) (define can-close-sema (make-semaphore))
(define currently-can-close? #t)
(define (close) (define (close)
(if frame (if frame
@ -64,7 +71,7 @@
(unless container (unless container
(set! frame (set! frame
(new (class frame% (new (class frame%
(define/augment (can-close?) (send close-button is-enabled?)) (define/augment (can-close?) currently-can-close?)
(define/augment (on-close) (close-callback)) (define/augment (on-close) (close-callback))
(super-new [label title] (super-new [label title]
[width 600] [width 600]
@ -109,7 +116,9 @@
(set! text (new (text:hide-caret/selection-mixin text:standard-style-list%))) (set! text (new (text:hide-caret/selection-mixin text:standard-style-list%)))
(define canvas (new editor-canvas% (define canvas (new editor-canvas%
[parent sub-container] [parent sub-container]
[editor text])) [editor text]
[min-width canvas-min-width]
[min-height canvas-min-height]))
(define button-panel (new horizontal-panel% (define button-panel (new horizontal-panel%
[parent sub-container] [parent sub-container]
[stretchable-height #f] [stretchable-height #f]
@ -118,10 +127,11 @@
[label abort-label] [label abort-label]
[parent button-panel] [parent button-panel]
[callback (λ (b e) (kill-callback))])) [callback (λ (b e) (kill-callback))]))
(when close-button?
(set! close-button (new button% (set! close-button (new button%
[label (string-constant close)] [label (string-constant close)]
[parent button-panel] [parent button-panel]
[callback (λ (b e) (close))])) [callback (λ (b e) (close))])))
(define (close) (define (close)
(if frame (if frame
@ -132,7 +142,8 @@
(define (kill-callback) (define (kill-callback)
(custodian-shutdown-all installer-cust) (custodian-shutdown-all installer-cust)
(fprintf output-port "\n~a\n" aborted-message)) (fprintf output-port "\n~a\n" aborted-message))
(send close-button enable #f) (set! currently-can-close? #f)
(when close-button (send close-button enable #f))
(send canvas allow-tab-exit #t) (send canvas allow-tab-exit #t)
((current-text-keymap-initializer) (send text get-keymap)) ((current-text-keymap-initializer) (send text get-keymap))
(send text set-styles-sticky #f) (send text set-styles-sticky #f)
@ -198,7 +209,8 @@
(queue-callback (queue-callback
(λ () (λ ()
(send kill-button enable #f) (send kill-button enable #f)
(send close-button enable #t) (when close-button (send close-button enable #t))
(set! currently-can-close? #t)
(semaphore-post can-close-sema)))) (semaphore-post can-close-sema))))
(unless completed-successfully? (unless completed-successfully?
(parameterize ([current-eventspace orig-eventspace]) (parameterize ([current-eventspace orig-eventspace])
@ -233,7 +245,7 @@
(define/public (is-closed?) (define/public (is-closed?)
(not (send sub-container is-shown?))) (not (send sub-container is-shown?)))
(define/public (can-close?) (define/public (can-close?)
(send close-button is-enabled?)) currently-can-close?)
(define/public (close) (define/public (close)
(unless (is-closed?) (unless (is-closed?)
(if frame (if frame