widgets/tab-panel/widget.ss
#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 
 ; here we could now use `precode' to avoid writing this class each time:
  (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)]     ; necessary properties
 [options '(id)]
 ( ; widget properties
  [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]
  ))