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

mrlib/terminal: add options

Browse Source
This commit is contained in:
Matthew Flatt 2013-08-21 10:55:25 -06:00
parent 76aa80c0e9
commit ef54fc470c
2 changed files with 100 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/gui-pkgs/gui-doc/mrlib/scribblings/terminal.scrbl
View File

@ -18,7 +18,8 @@ in command-line scripts.}
[#: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])
[#:close-button? close-button? boolean? #t]
[#:close-label close-label string? (string-constant close)])
(is-a?/c terminal<%>)]{
Creates a GUI, sets up the current error and output ports to
@ -45,7 +46,7 @@ in command-line scripts.}
In addition to the I/O generated by @racket[doit], the generated GUI
contains two buttons: the abort button (with label
@racket[abort-label]) and the close button (with label
@racket[(string-constant close)]). The close button is present only
@racket[close-label]). The close button is present only
if @racket[close-button?] is @racket[#t].
When the abort button is pushed,
@ -96,4 +97,8 @@ enabled).}
Returns a synchronizable event that becomes ready for synchronization
when the terminal GUI can be closed.}
@defmethod[(get-button-panel) (is-a?/c horizontal-panel%)]{
Returns a panel that contains the abort and close buttons.}
}

13
pkgs/gui-pkgs/gui-lib/mrlib/terminal.rkt
View File

@ -16,7 +16,8 @@
#:cleanup-thunk (-> void?)
#:canvas-min-width (or/c #f exact-nonnegative-integer?)
#:canvas-min-height (or/c #f exact-nonnegative-integer?)
#:close-button? boolean?)
#:close-button? boolean?
#:close-label string?)
(is-a?/c terminal<%>))])
terminal<%>)
@ -41,7 +42,8 @@
#:cleanup-thunk [cleanup-thunk void]
#:canvas-min-width [canvas-min-width #f]
#:canvas-min-height [canvas-min-height #f]
#:close-button? [close-button? #t])
#:close-button? [close-button? #t]
#:close-label [close-button-label (string-constant close)])
(define orig-eventspace (current-eventspace))
(define orig-custodian (current-custodian))
(define inst-eventspace (if container
@ -67,6 +69,8 @@
(define (close-callback)
(custodian-shutdown-all installer-cust))
(define saved-button-panel #f)
(parameterize ([current-eventspace inst-eventspace])
(queue-callback
(λ ()
@ -131,7 +135,7 @@
[callback (λ (b e) (kill-callback))]))
(when close-button?
(set! close-button (new button%
[label (string-constant close)]
[label close-button-label]
[parent button-panel]
[callback (λ (b e) (close))])))
@ -151,6 +155,7 @@
(send text set-styles-sticky #f)
(send text lock #t)
(send text hide-caret #t)
(set! saved-button-panel button-panel)
(semaphore-post setup-sema)
(when container
(send container end-container-sequence))
@ -244,6 +249,8 @@
(new (class* object% (terminal<%>)
(super-new)
(define/public (get-button-panel)
saved-button-panel)
(define/public (can-close-evt)
(semaphore-peek-evt can-close-sema))
(define/public (is-closed?)