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)] [#: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-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] [#: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<%>)]{ (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
@ -45,7 +46,7 @@ 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)]). The close button is present only @racket[close-label]). The close button is present only
if @racket[close-button?] is @racket[#t]. if @racket[close-button?] is @racket[#t].
When the abort button is pushed, When the abort button is pushed,
@ -96,4 +97,8 @@ enabled).}
Returns a synchronizable event that becomes ready for synchronization Returns a synchronizable event that becomes ready for synchronization
when the terminal GUI can be closed.} 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?) #:cleanup-thunk (-> void?)
#:canvas-min-width (or/c #f exact-nonnegative-integer?) #:canvas-min-width (or/c #f exact-nonnegative-integer?)
#:canvas-min-height (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<%>))]) (is-a?/c terminal<%>))])
terminal<%>) terminal<%>)
@ -41,7 +42,8 @@
#:cleanup-thunk [cleanup-thunk void] #:cleanup-thunk [cleanup-thunk void]
#:canvas-min-width [canvas-min-width #f] #:canvas-min-width [canvas-min-width #f]
#:canvas-min-height [canvas-min-height #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-eventspace (current-eventspace))
(define orig-custodian (current-custodian)) (define orig-custodian (current-custodian))
(define inst-eventspace (if container (define inst-eventspace (if container
@ -67,6 +69,8 @@
(define (close-callback) (define (close-callback)
(custodian-shutdown-all installer-cust)) (custodian-shutdown-all installer-cust))
(define saved-button-panel #f)
(parameterize ([current-eventspace inst-eventspace]) (parameterize ([current-eventspace inst-eventspace])
(queue-callback (queue-callback
(λ () (λ ()
@ -131,7 +135,7 @@
[callback (λ (b e) (kill-callback))])) [callback (λ (b e) (kill-callback))]))
(when close-button? (when close-button?
(set! close-button (new button% (set! close-button (new button%
[label (string-constant close)] [label close-button-label]
[parent button-panel] [parent button-panel]
[callback (λ (b e) (close))]))) [callback (λ (b e) (close))])))
@ -151,6 +155,7 @@
(send text set-styles-sticky #f) (send text set-styles-sticky #f)
(send text lock #t) (send text lock #t)
(send text hide-caret #t) (send text hide-caret #t)
(set! saved-button-panel button-panel)
(semaphore-post setup-sema) (semaphore-post setup-sema)
(when container (when container
(send container end-container-sequence)) (send container end-container-sequence))
@ -244,6 +249,8 @@
(new (class* object% (terminal<%>) (new (class* object% (terminal<%>)
(super-new) (super-new)
(define/public (get-button-panel)
saved-button-panel)
(define/public (can-close-evt) (define/public (can-close-evt)
(semaphore-peek-evt can-close-sema)) (semaphore-peek-evt can-close-sema))
(define/public (is-closed?) (define/public (is-closed?)