(module wxpanel racket/base
  (require mzlib/class
           mzlib/class100
           mzlib/list
           (prefix-in wx: "kernel.rkt")
           "lock.rkt"
           "const.rkt"
           "helper.rkt"
           "check.rkt"
           "wx.rkt"
           "wxwindow.rkt"
           "wxitem.rkt"
           "wxcontainer.rkt")

  (provide (protect-out wx-panel%
                        wx-vertical-panel%
                        wx-vertical-tab-panel%
                        wx-vertical-group-panel%
                        wx-horizontal-panel%
                        wx-control-horizontal-panel%
                        wx-pane%
                        wx-vertical-pane%
                        wx-horizontal-pane%
                        wx-grow-box-pane%
                        wx-canvas-panel%
                        wx-vertical-canvas-panel%
                        wx-horizontal-canvas-panel%))

  (define wx:windowless-panel%
    (class100 object% (prnt x y w h style label)
      (private-field
       [pos-x 0] [pos-y 0] [width 1] [height 1]
       [parent prnt])
      (public
	[drag-accept-files (lambda () (void))]
	[on-drop-file (lambda () (void))]
	[on-set-focus (lambda () (void))]
	[on-kill-focus (lambda () (void))]
	[set-focus (lambda () (void))]
        [gets-focus? (lambda () #f)]
	[enable (lambda () (void))]
	[show (lambda (on?) (void))]
        [is-shown? (lambda () #f)]
	[is-shown-to-root? (lambda () (send parent is-shown-to-root?))]
	[is-enabled-to-root? (lambda () (send parent is-enabled-to-root?))]
	[get-parent (lambda () parent)]
	[get-client-size (lambda (wb hb)
			   (when wb (set-box! wb width))
			   (when hb (set-box! hb height)))]
	[set-size (lambda (x y w h) 
		    (unless (negative? x) (set! pos-x x))
		    (unless (negative? y) (set! pos-y y))
		    (unless (negative? w) (set! width w))
		    (unless (negative? h) (set! height h)))]
	[get-x (lambda () pos-x)]
	[get-y (lambda () pos-y)]
	[get-width (lambda () width)]
	[get-height (lambda () height)])
      (sequence (super-init))))

  (define tab-h-border (if (eq? (system-type) 'unix)
			   2
			   3))
  (define tab-v-bottom-border (if (memq (system-type) '(macosx macos))
				  0
				  2))

  (define (wx-make-basic-panel% wx:panel% stretch? [x-m 0] [y-m 0])
    (class100* (wx-make-container% (make-item% wx:panel% x-m y-m stretch? stretch?)) (wx-basic-panel<%>) (parent style label)
	       (inherit get-x get-y get-width get-height
			min-width min-height set-min-width set-min-height
			x-margin y-margin
			get-client-size area-parent
			get-hard-minimum-size
			get-top-level)
	       
	       (rename [super-set-focus set-focus])
	       
	       (private-field
		;; cache to prevent on-size from recomputing its result every
		;; time. when curr-width is #f, cache invalid.
		curr-width
		curr-height
		
		;; list of child-info structs corresponding to the children.  (#f
		;;  if no longer valid.)
		[children-info null]
		
		;; Not used by linear panels
		[h-align 'center] [v-align 'center]

		;; Needed for windowless panes
		[move-children? #f]

		[ignore-redraw-request? #f]


                [auto-scroll-x? (and (memq 'auto-hscroll style) #t)]
                [auto-scroll-y? (and (memq 'auto-vscroll style) #t)]

                [can-scroll-x? (or auto-scroll-x?
                                   (and (memq 'hscroll style) #t))]
                [can-scroll-y? (or auto-scroll-y?
                                   (and (memq 'vscroll style) #t))]
                
                [scroll-x? can-scroll-x?]
                [scroll-y? can-scroll-y?])
	       
	       (override
		 [has-tabbing-children? (lambda () #t)]

		 [set-focus ; dispatch focus to a child panel
		  (lambda ()
                    (if (focus-on-self?)
                        (super-set-focus)
                        (if (null? children)
                            (super-set-focus)
                            (send (car children) set-focus))))]

		 [ext-dx (lambda () (if hidden-child
					tab-h-border
					0))]
		 [ext-dy (lambda () (if hidden-child
					(let-values ([(mw mh) (get-hard-minimum-size)])
					  (- mh tab-v-bottom-border 1))
					0))])
	       
	       (private-field
		;; list of panel's contents.
		[children null]
		[hidden-child #f]
		[curr-border const-default-border]
		[border? (memq 'border style)])
	       
	       (public
		 [need-move-children (lambda () (set! move-children? #t))]
                 [focus-on-self? (lambda () #f)]

		 [get-children (lambda () children)]
		 [get-hidden-child (lambda () hidden-child)]
		 [set-first-child-is-hidden (lambda ()
					      (set! hidden-child (car children))
					      (let ([i (send hidden-child get-info)])
						(set-min-width (child-info-x-min i))
						(set-min-height (child-info-y-min i))))]

		 [border
		  (case-lambda
		   [() curr-border]
		   [(new-val)
		    (check-margin-integer '(method area-container<%> border) new-val)
		    (set! curr-border new-val)
		    (force-redraw)])]

		 ;; add-child: adds an existing child to the panel.
		 ;; input: new-child: item% descendant to add
		 ;; returns: nothing
		 ;; effects: adds new-child to end of list of children.
		 [add-child
		  (lambda (new-child)
		    (unless (eq? this (send new-child area-parent))
		      (raise-mismatch-error 'add-child 
					    "not a child of this container: "
					    (wx->proxy new-child)))
		    (when (memq new-child children)
		      (raise-mismatch-error 'add-child "child already active: "
					    (wx->proxy new-child)))
		    (change-children
		     (lambda (l)
		       (append l (list new-child)))))]
		 
		 ;; change-children: changes the list of children.
		 ;; input: f is a function which takes the current list of children
		 ;;   and returns a new list of children.
		 ;; returns: nothing
		 ;; effects: sets the list of children to the value of applying f.
		 [change-children
		  (lambda (f)
		    (let ([new-children (f children)]) ;; hidden child, if any , must be first!
		      (unless (andmap (lambda (child)
					(eq? this (send child area-parent)))
				      new-children)
			(raise-mismatch-error 'change-children
					      (format
					       (string-append 
						"not all members of the returned list are "
						"children of the container ~e; list: ")
					       (wx->proxy this))
					      (map wx->proxy (remq hidden-child new-children))))
		      (let loop ([l new-children])
			(unless (null? l)
			  (if (memq (car l) (cdr l))
			      (raise-mismatch-error 'change-children 
						    "child in the returned list twice: " 
						    (wx->proxy (car l)))
			      (loop (cdr l)))))
		      ;; show all new children, hide all deleted children.
		      (let ([added-children (list-diff new-children children)]
			    [removed-children (list-diff children new-children)])
			(let ([non-window (ormap (lambda (child)
						   (and (not (is-a? child wx:window%))
							child))
						 removed-children)])
			  (when non-window
			    (raise-mismatch-error 'change-children
						  (format "cannot delete non-window area in ~e: "
							  (wx->proxy this))
						  non-window)))

			;; Newly-added children may have been removed when
			;;  disabled, or now added into a disabled panel:
			(for-each (lambda (child) (send child queue-active))
				  added-children)

			(let ([top (get-top-level)])
			  (for-each (lambda (child) (send top show-child child #f))
				    removed-children)
			  (set! children new-children)
			  (force-redraw)
			  (for-each (lambda (child) (send top show-child child #t))
				    added-children)))))]
		 
		 ;; delete-child: removes a child from the panel.
		 ;; input: child: child to delete.
		 ;; returns: nothing
		 ;; effects: removes child from list; forces redraw.
		 [delete-child
		  (lambda (child)
		    (unless (memq child children)
		      (raise-mismatch-error 'delete-child 
					    "not a child of this container or child is not active: " 
					    (wx->proxy child)))
		    (change-children (lambda (child-list)
				       (remq child child-list))))]
		 
		 ;; get-children-info: returns children info list, recomputing it
		 ;;   if needed.
		 ;; input: none
		 ;; returns: list of child-info structs.
		 ;; effects: upon exit, children-info is eq? to result.
		 [get-children-info
		  (lambda ()
		    (unless children-info
		      (let* ([childs children]
			     [info (map (lambda (child)
					  (send child get-info))
					childs)])
			(if (and (= (length childs) (length children))
				 (andmap eq? childs children))
			    ;; Got the info for the right set of children
			    (set! children-info info)
			    
			    ;; During the call to some get-info, the set of children changed;
			    ;; try again
			    (get-children-info))))
		    children-info)]
		 
		 [child-redraw-request
		  (lambda (from)
		    (unless (or ignore-redraw-request?
				(not (memq from children)))
		      (force-redraw)))]
		 
		 ;; do-graphical-size: creates a function which returns the minimum
		 ;;   possible size for a horizontal-panel% or vertical-panel% object.
		 ;; input: compute-x/compute-y: functions which take the current x/y
		 ;;          location, the amount of spacing which will come after the
		 ;;          current object, and the list of child-info structs beginning
		 ;;          with the current object, and return the new x/y locations.
		 ;; returns: a thunk which returns the minimum possible size of the
		 ;;   entire panel (not just client) as a list of two elements:
		 ;;   (min-x min-y). 
		 [do-graphical-size
		  (lambda (ignore-scroll? compute-x compute-y)
		    (letrec ([gms-help
			      (lambda (kid-info x-accum y-accum first?)
				(if (null? kid-info)
				    (list x-accum y-accum)
				    (gms-help
				     (cdr kid-info)
                                     (if (and can-scroll-x? (not ignore-scroll?))
                                         x-accum
                                         (compute-x x-accum kid-info (and hidden-child first?)))
                                     (if (and can-scroll-y? (not ignore-scroll?))
                                         y-accum
                                         (compute-y y-accum kid-info (and hidden-child first?)))
				     #f)))])
		      (let-values ([(client-w client-h)
				    (get-two-int-values (lambda (a b) (get-client-size a b)))])
			(let* ([border (border)]
			       [min-client-size
				(gms-help (get-children-info)
					  (* 2 border) (* 2 border)
					  #t)]
			       [delta-w (if ignore-scroll? 0 (- (get-width) client-w))]
			       [delta-h (if ignore-scroll? 0 (- (get-height) client-h))])
                          (list (+ delta-w (car min-client-size) (if hidden-child (* 2 tab-h-border) 0))
				(+ delta-h (cadr min-client-size)))))))]
		 
		 ;; do-get-min-graphical-size: poll children and return minimum possible
		 ;;   size, as required by the graphical representation of the tree,
		 ;;   of the panel.
		 ;; input: none
		 ;; returns: minimum full size (as a list, width & height) of the
		 ;;   container.
		 ;; effects: none
		 [get-graphical-min-size (lambda () (void))]
		 [do-get-graphical-min-size
		  (lambda ([ignore-scroll? #f])
		    (do-graphical-size 
                     ignore-scroll?
		     (lambda (x-accum kid-info first?)
		       (max x-accum (+ (* 2 (border))
				       (child-info-x-min (car kid-info)))))
		     (lambda (y-accum kid-info first?)
		       (max y-accum (+ (* 2 (border))
				       (child-info-y-min (car kid-info)))))))])
	       
	       (override
		 [force-redraw
		  (lambda ()
		    (set! children-info #f)
		    (set! curr-width #f)
		    (let ([parent (area-parent)])
		      (send parent child-redraw-request this)))]

		 ;; get-min-size: poll children and return minimum possible size
		 ;;   for the container which considers the user min sizes.
		 ;; input: none
		 ;; returns: minimum full size (as a list, width & height) of
		 ;;   container.
		 ;; effects: none.
		 [get-min-size
		  (lambda ()
		    (let ([graphical-min-size (get-graphical-min-size)])
		      (list (+ (* 2 (x-margin))
			       (max (car graphical-min-size) (min-width)))
			    (+ (* 2 (y-margin))
			       (max (cadr graphical-min-size) (min-height))))))]
		 
		 [on-container-resize
		  (lambda ()
		    (let-values ([(client-width client-height)
				  (get-two-int-values (lambda (a b) (get-client-size a b)))])
		      (unless (and (number? curr-width)
				   (number? curr-height)
				   (= curr-width client-width)
				   (= curr-height client-height)
				   (not move-children?))
			(set! curr-width client-width)
			(set! curr-height client-height)
			(set! move-children? #f)
			(redraw client-width client-height))))]

		 [init-min (lambda (x) (if border? 8 0))])
	       
	       (public
		 ;; place-children: determines where each child of panel should be
		 ;; placed.
		 ;; input: children-info: list of (int int bool bool)
		 ;;        width/height: size of panel's client area.
		 ;; returns: list of placement info for children; each item in list
		 ;;   is a list of 4 elements, consisting of child's x-posn,
		 ;;   y-posn, x-size, y-size (including margins).  Items are in same 
		 ;;   order as children-info list.
		 [place-children (lambda (l w h) (void))]
		 [check-place-children
		  (lambda (children-info width height)
		    (unless (and (list? children-info)
				 (andmap (lambda (x) (and (list? x)
							  (= 4 (length x))
							  (integer? (car x)) (not (negative? (car x))) (exact? (car x))
							  (integer? (cadr x)) (not (negative? (cadr x))) (exact? (cadr x))))
					 children-info))
		      (raise-type-error (who->name '(method area-container-window<%> place-children))
					"list of (list of non-negative-integer non-negative-integer boolean boolean)"
					children-info))
		    (check-non-negative-integer '(method area-container-window<%> place-children) width)
		    (check-non-negative-integer '(method area-container-window<%> place-children) height))]
		 [do-place-children
		  (lambda (children-info width height)
		    (check-place-children children-info width height)
		    (let loop ([children-info children-info])
		      (if (null? children-info)
			  null
			  (let ([curr-info (car children-info)])
			    (cons
			     (list
			      0 0
			      (car curr-info) ; child-info-x-min
			      (cadr curr-info)) ; child-info-y-min
			     (loop (cdr children-info)))))))])

	       (private-field
		[curr-spacing const-default-spacing])
	       
	       (public
		 [spacing ; does nothing!
		  (case-lambda
		   [() curr-spacing]
		   [(new-val)
		    (check-margin-integer '(method area-container<%> spacing) new-val)
		    (set! curr-spacing new-val)])]

		 [do-align (lambda (h v set-h set-v)
			     (unless (memq h '(left center right))
			       (raise-type-error 'set-alignment "horizontal alignment symbol: left, center, or right" h))
			     (unless (memq v '(top center bottom))
			       (raise-type-error 'set-alignment "vertical alignment symbol: top, center, or bottom" v))
			     (set-h h)
			     (set-v (case v [(top) 'left] [(center) 'center] [(bottom) 'right])))]
		 [alignment (lambda (h v) 
			      (do-align h v (lambda (h) (set! h-align h)) (lambda (h) (set! v-align v)))
			      (force-redraw))]
		 [get-alignment (lambda () (values h-align v-align))]

                 [adjust-panel-size (lambda (w h) 
                                      (if (or can-scroll-x? can-scroll-y?)
                                          (let ([ms (do-get-graphical-min-size #t)])
                                            ;; loop for fix-point on x and y scroll
                                            (let loop ([w w] [h h] [iters 0])
                                              (let ([want-scroll-x?
                                                     (if auto-scroll-x?
                                                         ((car ms) . > . w)
                                                         scroll-x?)]
                                                    [want-scroll-y?
                                                     (if auto-scroll-y?
                                                         ((cadr ms) . > . h)
                                                         scroll-y?)])
                                                (if (and (eq? scroll-x? want-scroll-x?)
                                                         (eq? scroll-y? want-scroll-y?))
                                                    (values (if can-scroll-x?
                                                                (max w (car ms))
                                                                w)
                                                            (if can-scroll-y?
                                                                (max h (cadr ms))
                                                                h))
                                                    (begin
                                                      (set! scroll-x? want-scroll-x?)
                                                      (set! scroll-y? want-scroll-y?)
                                                      (send this show-scrollbars scroll-x? scroll-y?)
                                                      (let-values ([(w h)
                                                                    (get-two-int-values (lambda (a b) (get-client-size a b)))])
                                                        (if (= iters 2)
                                                            (values w h)
                                                            (loop w h (add1 iters)))))))))
                                          (values w h)))]

		 ;; redraw: redraws panel and all children
		 ;; input: width, height: size of area area in panel.
		 ;; returns: nothing
		 ;; effects: places children at default positions in panel.
		 [redraw
		  (lambda (in-width in-height)
		    (let-values ([(children-info) (get-children-info)]
                                 [(children) children] ; keep list of children matching children-info
                                 [(width height) (adjust-panel-size in-width in-height)])
		      (let ([l (place-children (map (lambda (i)
						      (list (child-info-x-min i) (child-info-y-min i)
							    (child-info-x-stretch i) (child-info-y-stretch i)))
						    (if hidden-child
							(cdr children-info)
							children-info))
					       (if hidden-child
						   (- width (* 2 tab-h-border))
						   width)
					       (if hidden-child
						   (- height (child-info-y-min (car children-info))) ;; 2-pixel border here, too
						   height))])
			(unless (and (list? l)
				     (= (length l) (- (length children-info) (if hidden-child 1 0)))
				     (andmap (lambda (x) (and (list? x)
							      (= 4 (length x))
							      (andmap (lambda (x) (and (integer? x) (exact? x))) x)))
					     l))
			  (raise-mismatch-error 'container-redraw 
						"result from place-children is not a list of 4-integer lists with the correct length: "
						l))
			(panel-redraw children children-info (if hidden-child
								 (cons (list 0 0 width height)
								       (let ([dy (child-info-y-min (car children-info))])
									 (map (lambda (i)
										(list (+ (car i) tab-h-border)
										      (+ dy (cadr i) (- tab-v-bottom-border) -1)
										      (caddr i)
										      (cadddr i)))
									      l)))
								 l)))))]
		 [panel-redraw
		  (lambda (childs child-infos placements)
                    (when (or scroll-y? scroll-x?)
                      (let ([w (if scroll-x?
                                   (+ (for/fold ([x 0]) ([p (in-list placements)]
                                                         [i (in-list child-infos)])
                                        (max x (+ (max 0 (car p))
                                                  (max (+ (child-info-x-min i)
                                                          (* 2 (child-info-x-margin i)))
                                                       (caddr p)))))
                                      (* 2 (border)))
                                   0)]
                            [h (if scroll-y?
                                   (+ (for/fold ([y 0]) ([p (in-list placements)]
                                                         [i (in-list child-infos)])
                                        (max y (+ (max 0 (cadr p))
                                                  (max (+ (child-info-y-min i)
                                                          (* 2 (child-info-y-margin i)))
                                                       (cadddr p)))))
                                      (* 2 (border)))
                                   0)]
                            [wb (box 0)]
                            [hb (box 0)])
                        (get-client-size wb hb)
                        (let ([do-x-scroll? (w . > . (unbox wb))]
                              [do-y-scroll? (h . > . (unbox hb))])
                          (send this set-scrollbars
                                (if do-x-scroll? 1 0) (if do-y-scroll? 1 0)
                                w h
                                (unbox wb) (unbox hb)
                                -1 -1
                                #t))))
		    (for-each
		     (lambda (child info placement)
		       (let-values ([(x y w h) (apply values placement)])
			 (let ([minw (child-info-x-min info)]
			       [minh (child-info-y-min info)]
			       [xm (child-info-x-margin info)]
			       [ym (child-info-y-margin info)])
			   (dynamic-wind
			       (lambda () (set! ignore-redraw-request? #t))
			       (lambda ()
				 (send child set-size
				       (max 0 (+ x xm)) (max 0 (+ y ym))
				       (- (max minw w) (* 2 xm))
				       (- (max minh h) (* 2 ym))))
			       (lambda () (set! ignore-redraw-request? #f)))
			   (send child on-container-resize))))
		     childs
		     child-infos
		     placements))])
	       (sequence
		 (super-init style parent -1 -1
                             (if can-scroll-y? 20 (if can-scroll-x? 1 0))
                             (if can-scroll-x? 20 (if can-scroll-y? 1 0))
                             (cons 'deleted style) label)
                 (unless (memq 'deleted style)
                   (send (get-top-level) show-control this #t)))))

  (define (wx-make-pane% wx:panel% stretch?)
    (class100 (make-container-glue% (make-glue% (wx-make-basic-panel% wx:panel% stretch?))) args
      (inherit get-parent get-x get-y need-move-children get-children)
      (rename [super-set-size set-size])
      (override
	[on-visible
	 (lambda ()
	   (for-each (lambda (c) (send c queue-visible)) (get-children)))]
	[on-active
	 (lambda ()
	   (for-each (lambda (c) (send c queue-active)) (get-children)))]

	[get-window (lambda () (send (get-parent) get-window))]
	[set-size (lambda (x y w h) 
		    (super-set-size x y w h)
		    (need-move-children))]
	[dx (lambda () (get-x))]
	[dy (lambda () (get-y))])
      (sequence
	(apply super-init args))))

  (define (wx-make-panel% wx:panel% [x-m 0] [y-m 0])
    (class100 (make-container-glue% (make-window-glue% (wx-make-basic-panel% wx:panel% #t x-m y-m))) args
      (rename [super-on-visible on-visible]
	      [super-on-active on-active])
      (inherit get-children)
      (override 
	[on-visible
	 (lambda ()
	   (for-each (lambda (c) (send c queue-visible)) (get-children))
	   (super-on-visible))]
	[on-active
	 (lambda ()
	   (for-each (lambda (c) (send c queue-active)) (get-children))
	   (super-on-active))])
      (sequence (apply super-init args))))

  (define (wx-make-linear-panel% wx-panel%)
    (class100 wx-panel% args
      (private-field
       [major-align-pos 'left]
       [minor-align-pos 'center])
      
      (inherit force-redraw border get-width get-height
               do-get-graphical-min-size)
      (private-field [curr-spacing const-default-spacing])
      (override
	[spacing
	 (case-lambda
	  [() curr-spacing]
	  [(new-val)
	   (check-margin-integer '(method area-container<%> spacing) new-val)
	   (set! curr-spacing new-val)
	   (force-redraw)])])
      (public
	[minor-align (lambda (a) (set! minor-align-pos a) (force-redraw))]
	[major-align (lambda (a) (set! major-align-pos a) (force-redraw))]
	[major-offset (lambda (space)
			(case major-align-pos
			  [(center) (quotient space 2)]
			  [(left) 0]
			  [(right) space]))]
	[minor-offset (lambda (width size)
			(case minor-align-pos
			  [(center) (quotient (- width size) 2)]
			  [(left) 0]
			  [(right) (- width size)]))]
	
	[do-get-alignment (lambda (pick) (values (pick major-align-pos minor-align-pos)
						 (case (pick minor-align-pos major-align-pos)
						   [(left) 'top] [(center) 'center] [(right) 'bottom])))]

	;; place-linear-children: implements place-children functions for
	;; horizontal-panel% or vertical-panel% classes.
	;; input: child-major-size: function which takes a child-info struct
	;;          and returns the child's minimum size in the major direction
	;;          of the panel.
	;;        child-major-stretch: function which takes a child-info
	;;          struct and returns the child's stretchability in the major
	;;          direction of the panel.
	;;        child-minor-size/child-minor-stretch: see above.
	;;        major-dim/minor-dim: functions which take the width and the
	;;          height of the panel and return the panel's major and minor
	;;          dimensions, respectively.
	;;        get-h-info/get-v-info: functions which take info lists
	;;          describing the major and minor directions and select the
	;;          appropriate one.
	;; returns: a function which takes the children info, the width and the
	;;   height of the panel's client and returns a list which contains
	;;   posn&size info for each child. 
	[place-linear-children
	 (lambda (kid-info width height
			   child-major-size
			   child-major-stretch
			   child-major-offset
			   child-minor-size
			   child-minor-stretch
			   child-minor-position
			   major-dim minor-dim
			   get-x-info get-y-info)
	   (letrec ([count-stretchable
		     (lambda (kid-info)
		       (if (null? kid-info)
			   0
			   (let ([curr-info (car kid-info)])
			     (if (child-major-stretch curr-info)
				 (add1 (count-stretchable (cdr kid-info)))
				 (count-stretchable (cdr kid-info))))))])
	     (let* ([spacing (spacing)]
		    [border (border)]
		    [num-stretchable (count-stretchable kid-info)]
		    [extra-space (max 0
                                      (- (major-dim width height)
                                         (apply 
                                          major-dim
                                          (do-get-graphical-min-size #t))))]
		    [extra-per-stretchable (if (zero? num-stretchable)
					       0
					       (inexact->exact
						(floor
						 (/ extra-space
						    num-stretchable))))]
		    [leftover (- extra-space (* extra-per-stretchable num-stretchable))]
		    [num-children (length kid-info)]
		    [major-offset (if (= num-stretchable 0)
				      (child-major-offset extra-space)
				      0)])
	       (letrec
		   ([pc-help
		     (lambda (kid-info left-edge leftover)
		       (if (null? kid-info)
			   null
			   (let* ([curr-info (car kid-info)]
				  [rest (cdr kid-info)]
				  [major-posn left-edge]
				  [next-leftover (if (zero? leftover)
						     0
						     (- leftover 1))]
				  [extra-this-stretchable (if (zero? leftover)
							      extra-per-stretchable
							      (+ extra-per-stretchable 1))]
				  [major-size
				   (if (child-major-stretch curr-info)
				       (+ extra-this-stretchable
					  (child-major-size curr-info))
				       (child-major-size curr-info))]
				  [minor-posn (if (child-minor-stretch
						   curr-info)
						  border
						  (inexact->exact
						   (round
						    (child-minor-position 
						     (minor-dim width height) 
						     (child-minor-size curr-info)))))]
				  [minor-size (if (child-minor-stretch
						   curr-info)
						  (- (minor-dim width height)
						     (* 2 border))
						  (child-minor-size
						   curr-info))])
			     (cons
			      (list
			       (get-x-info major-posn minor-posn)
			       (get-y-info major-posn minor-posn)
			       (get-x-info major-size minor-size)
			       (get-y-info major-size minor-size))
			      (pc-help rest
				       (+ major-size major-posn spacing)
				       next-leftover)))))])
		 (pc-help kid-info (+ border major-offset) leftover)))))])
      
      (sequence (apply super-init args))))

  
  (define (wx-make-horizontal/vertical-panel% wx-linear-panel% init-horizontal?)
    (class100 wx-linear-panel% args
      (inherit major-align minor-align do-align do-get-alignment major-offset minor-offset
	       spacing border do-graphical-size place-linear-children check-place-children
               force-redraw)
      (private-field [horizontal? init-horizontal?])
      (public [get-orientation (λ () horizontal?)]
              [set-orientation (λ (h?) 
                                 (unless (equal? h? horizontal?)
                                   (set! horizontal? h?)
                                   (force-redraw)))])
      (override
	[alignment (lambda (h v) 
                     (if horizontal?
                         (do-align h v 
                                   (lambda (x) (major-align x)) 
                                   (lambda (x) (minor-align x)))
                         (do-align h v 
                                   (lambda (x) (minor-align x)) 
                                   (lambda (x) (major-align x)))))]
	[get-alignment (λ () (do-get-alignment (if horizontal? (λ (x y) x) (λ (x y) y))))]
        
	[do-get-graphical-min-size
	 (lambda ([ignore-scroll? #f])
           (if horizontal?
               (do-graphical-size 
                ignore-scroll?
                (lambda (x-accum kid-info hidden?)
                  (+ x-accum (child-info-x-min (car kid-info))
                     (if (or hidden? (null? (cdr kid-info)))
                         0
                         (spacing))))
                (lambda (y-accum kid-info hidden?)
                  (max y-accum
                       (+ (child-info-y-min (car kid-info))
                          (* 2 (border))))))
               (do-graphical-size
                ignore-scroll?
                (lambda (x-accum kid-info hidden?)
                  (max x-accum
                       (+ (child-info-x-min (car kid-info))
                          (* 2 (border)))))
                (lambda (y-accum kid-info hidden?)
                  (+ y-accum (child-info-y-min (car kid-info))
                     (if (or (null? (cdr kid-info)) hidden?)
                         0
                         (spacing)))))))]
 
	[do-place-children
         (lambda (l w h)
           (cond
             [horizontal?
              (check-place-children l w h)
              (place-linear-children l w h
                                     car    ; child-info-x-min
                                     caddr  ; child-info-x-stretch
                                     (lambda (s) (major-offset s))
                                     cadr   ; child-info-y-min
                                     cadddr ; child-info-y-stretch
                                     (lambda (s t) (minor-offset s t))
                                     (lambda (width height) width)
                                     (lambda (width height) height)
                                     (lambda (major minor) major)
                                     (lambda (major minor) minor))]
             [else
              (check-place-children l w h)
              (place-linear-children l w h
                                     cadr   ; child-info-y-min
                                     cadddr ; child-info-y-stretch
                                     (lambda (s) (major-offset s))
                                     car    ; child-info-x-min
                                     caddr  ; child-info-x-stretch
                                     (lambda (s t) (minor-offset s t))
                                     (lambda (width height) height)
                                     (lambda (width height) width)
                                     (lambda (major minor) minor)
                                     (lambda (major minor) major))]))])
      (sequence (apply super-init args))))
  
  
  ;; horizontal-panel%: a panel which arranges its children in an evenly
  ;; spaced horizontal row.  Items are vertically centered (or stretched
  ;; to fit the dialog box if they are stretchable).  The items are evenly
  ;; spaced horizontally, with any extra space divided evenly among the
  ;; stretchable items. 
  (define (wx-make-horizontal-panel% wx-linear-panel%) (wx-make-horizontal/vertical-panel% wx-linear-panel% #t))

  ;; vertical-panel%.  See horizontal-panel%, but reverse
  ;; "horizontal" and "vertical."
  (define (wx-make-vertical-panel% wx-linear-panel%) (wx-make-horizontal/vertical-panel% wx-linear-panel% #f))

  (define (wx-make-tab% %)
    (class %
      (inherit gets-focus?)
      (super-new)
      (define/override (tabbing-position x y w h)
        ;; claim that the panel is short:
        (list this x y w 16))
      (define/override (focus-on-self?) (gets-focus?))))

  (define wx-panel% (wx-make-panel% wx:panel%))
  (define wx-control-panel% (wx-make-panel% wx:panel% const-default-x-margin const-default-y-margin))
  (define wx-canvas-panel% (wx-make-panel% wx:canvas-panel%))
  (define wx-tab-panel% (wx-make-tab% (wx-make-panel% wx:tab-panel%)))
  (define wx-group-panel% (wx-make-panel% wx:group-panel%))
  (define wx-linear-panel% (wx-make-linear-panel% wx-panel%))
  (define wx-linear-canvas-panel% (wx-make-linear-panel% wx-canvas-panel%))
  (define wx-control-linear-panel% (wx-make-linear-panel% wx-control-panel%))
  (define wx-linear-tab-panel% (wx-make-tab% (wx-make-linear-panel% wx-tab-panel%)))
  (define wx-linear-group-panel% (wx-make-linear-panel% wx-group-panel%))
  (define wx-horizontal-panel% (wx-make-horizontal-panel% wx-linear-panel%))
  (define wx-vertical-panel% (wx-make-vertical-panel% wx-linear-panel%))
  (define wx-vertical-tab-panel% (wx-make-tab% (wx-make-vertical-panel% wx-linear-tab-panel%)))
  (define wx-vertical-group-panel% (wx-make-vertical-panel% wx-linear-group-panel%))
  (define wx-control-horizontal-panel% (wx-make-horizontal-panel% wx-control-linear-panel%))
  (define wx-horizontal-canvas-panel% (wx-make-horizontal-panel% wx-linear-canvas-panel%))
  (define wx-vertical-canvas-panel% (wx-make-vertical-panel% wx-linear-canvas-panel%))

  (define wx-pane% (wx-make-pane% wx:windowless-panel% #t))
  (define wx-grow-box-pane%
    (class100 (wx-make-pane% wx:windowless-panel% #f) (mred proxy parent style label)
      (override
	[init-min (lambda (x) (if (wx:needs-grow-box-spacer?)
				  15
				  0))])
      (sequence
	(super-init mred proxy parent style label))))
  (define wx-linear-pane% (wx-make-linear-panel% wx-pane%))
  (define wx-horizontal-pane% (wx-make-horizontal-panel% wx-linear-pane%))
  (define wx-vertical-pane% (wx-make-vertical-panel% wx-linear-pane%)))
