#lang scheme
(require "../../mred-plugin.ss"
"../../mreddesigner-misc.ss"
"../../default-values.ss"
"../../controller.ss"
scheme/gui/base
framework
)
(define tab-panel-preview%
(class tab-panel% (super-new)
(define single-panel (new panel:single% [parent this]))
(define/public (get-single-panel) single-panel)
(define child-panels '())
(define/public (add-child-panel p label)
(set! child-panels (append child-panels (list p)))
(send this append label))
(define/public (active-child n)
(let ([child-panel (list-ref child-panels n)])
(send single-panel active-child child-panel)
(controller-select-mred-id (send child-panel get-mred-id))
))
(define/override (delete-child c)
(send single-panel delete-child c)
(send this delete (list-pos child-panels c))
(set! child-panels (remq c child-panels))
(send this refresh)
)
))
(make-plugin
[type 'tab-panel]
[tooltip "Tab Panel"]
[button-group "Containers"]
[widget-class tab-panel-preview%]
[code-gen-class
(class tab-panel% (super-new)
(define single-panel (new panel:single% [parent this]))
(define/public (get-single-panel) single-panel)
(define child-panels '())
(define/public (add-child-panel p label)
(set! child-panels (append child-panels (list p)))
(send this append label))
(define/public (active-child n)
(send single-panel active-child (list-ref child-panels n)))
)]
[parent-class container-classes]
[necessary '(parent choices)] [options '(id)]
( [choices '()]
[callback (prop:code (λ(tp e)
(send tp active-child (send tp get-selection))))]
[style (prop:some-of '(no-border deleted) '())]
[enabled #t]
[vert-margin 0]
[horiz-margin 0]
[border 0]
[spacing 0]
[alignment (alignment-values 'center 'center)]
[min-width 0]
[min-height 0]
[stretchable-width #t]
[stretchable-height #t]
))