diff --git a/collects/embedded-gui/embedded-gui.ss b/collects/embedded-gui/embedded-gui.ss
new file mode 100644
index 00000000..8e693ab0
--- /dev/null
+++ b/collects/embedded-gui/embedded-gui.ss
@@ -0,0 +1,26 @@
+(module embedded-gui mzscheme
+  
+  (require
+   "private/grid-alignment.ss"
+   "private/aligned-pasteboard.ss"
+   "private/interface.ss"
+   "private/snip-lib.ss"
+   "private/button-snip.ss"
+   "private/stretchable-editor-snip.ss"
+   "private/tabbable-text.ss"
+   "private/fixed-width-label-snip.ss"
+   "private/grey-editor.ss"
+   "private/verthoriz-alignment.ss")
+
+  (provide
+   (all-from "private/grid-alignment.ss")
+   (all-from "private/aligned-pasteboard.ss")
+   (all-from "private/interface.ss")
+   (all-from "private/snip-lib.ss")
+   (all-from "private/button-snip.ss")
+   (all-from "private/stretchable-editor-snip.ss")
+   (all-from "private/tabbable-text.ss")
+   (all-from "private/fixed-width-label-snip.ss")
+   (all-from "private/grey-editor.ss")
+   (all-from "private/verthoriz-alignment.ss"))
+  )
diff --git a/collects/embedded-gui/private/aligned-pasteboard.ss b/collects/embedded-gui/private/aligned-pasteboard.ss
new file mode 100644
index 00000000..d24f6585
--- /dev/null
+++ b/collects/embedded-gui/private/aligned-pasteboard.ss
@@ -0,0 +1,85 @@
+(module aligned-pasteboard mzscheme
+  
+  (provide aligned-pasteboard%)
+  
+  (require
+   (lib "class.ss")
+   (lib "mred.ss" "mred")
+   (lib "etc.ss")
+   (lib "list.ss")
+   (lib "match.ss")
+   (prefix a: "alignment.ss")
+   (lib "click-forwarding-editor.ss" "mrlib")
+   "on-show-pasteboard.ss"
+   "really-resized-pasteboard.ss"
+   "interface.ss"
+   "snip-lib.ss"
+   "verthoriz-alignment.ss")
+  
+  (define aligned-pasteboard%
+    (class (click-forwarding-editor-mixin
+            (on-show-pasteboard-mixin
+             (really-resized-pasteboard-mixin pasteboard%)))
+      
+      (inherit begin-edit-sequence end-edit-sequence get-max-view-size refresh-delayed?)
+      (field
+       [alignment (new vertical-alignment%)]
+       [lock-alignment? false]
+       [needs-alignment? false])
+      
+      (define/public (add i) (send alignment add i))
+      
+      #|
+        snip : snip% object
+        before : snip% object or #f
+        x : real number
+        y : real number
+      |#
+      (rename [super-after-insert after-insert])
+      (define/override (after-insert snip before x y)
+        (super-after-insert snip before x y)
+        (realign))
+      
+      #|
+        snip : snip% object
+      |#
+      (rename [super-after-delete after-delete])
+      (define/override (after-delete snip)
+        (super-after-delete snip)
+        (realign))
+      
+      #|
+        snip : snip% object
+      |#
+      (rename [super-really-resized really-resized])
+      (define/override (really-resized snip)
+        (super-really-resized snip)
+        (realign))
+      
+      (rename [super-on-show on-show])
+      (define/override (on-show)
+        (realign)
+        (super-on-show))
+      
+      (define/public (lock-alignment lock?)
+        (set! lock-alignment? lock?)
+        (when (and needs-alignment? (not lock-alignment?))
+          (realign))
+        (if lock?
+            (begin-edit-sequence)
+            (end-edit-sequence)))
+      
+      (define/public (realign)
+        (if lock-alignment?
+            (set! needs-alignment? true)
+            (fluid-let ([lock-alignment? true])
+              (send alignment set-min-sizes)
+              (let ([width (send alignment get-min-width)]
+                    [height (send alignment get-min-height)])
+                (unless (or (zero? width) (zero? height))
+                  (send alignment align 0 0 width height)
+                  (set! needs-alignment? false))))))
+      
+      (super-new)
+      (send alignment set-pasteboard this)))
+  )
diff --git a/collects/embedded-gui/private/alignment-helpers.ss b/collects/embedded-gui/private/alignment-helpers.ss
new file mode 100644
index 00000000..f480dd97
--- /dev/null
+++ b/collects/embedded-gui/private/alignment-helpers.ss
@@ -0,0 +1,29 @@
+(module alignment-helpers mzscheme
+  
+  (require
+   (lib "list.ss")
+   (lib "class.ss")
+   (lib "mred.ss" "mred")
+   
+   "interface.ss"
+   "snip-lib.ss")
+  
+  (provide vacuous-max
+           child-height
+           child-width)
+  
+  (define (vacuous-max . n)
+    (if (empty? n)
+        0
+        (apply max n)))
+  
+  (define (child-height item)
+    (cond
+      [(is-a? item snip%) (snip-min-height item)]
+      [(is-a? item alignment<%>) (send item get-min-height)]))
+  
+  (define (child-width item)
+    (cond
+      [(is-a? item snip%) (snip-min-width item)]
+      [(is-a? item alignment<%>) (send item get-min-width)]))
+  )
\ No newline at end of file
diff --git a/collects/embedded-gui/private/alignment.ss b/collects/embedded-gui/private/alignment.ss
new file mode 100644
index 00000000..d065b136
--- /dev/null
+++ b/collects/embedded-gui/private/alignment.ss
@@ -0,0 +1,164 @@
+#|
+This code computes the sizes for the rectangles in the space using the on dimention
+off dimention method of referencing sizes. This means for example instead of saying
+width we say off dimention for vertical alignment. Inorder to consume and return
+the values in terms of width and height manipulation had to be done. I chose to create
+a struct abs-rect (abstract rectangle) and have code map horizontal and vertical rect
+stucts on to them. This code is a bit long but more readable than the other two options
+I came up with.
+  1) define all functions to be letrec bound functions inside align. align then take
+     accessors for the rect struct. The caller of align swaps the order of ondimention
+     and off dimention accessors for vertical or horizontal code. This method does not
+     allow the use of the readable, short, consis pattern matching code. As some of the
+     matching code is easily removed this may be a good option but a large letrec
+     is harder to write tests for.
+  2) define a pattern matcher syntax that will match the struct rect but swap the fields
+     based on wich on is the on or off dimention. This would have been shorter but much
+     more confusing.
+The current implementation requires align to map over the rects and allocate new stucts
+for each one on both passing into and returning from stretch-to-fit; This is not a bottle
+neck and it is the most readable solution.
+|#
+
+(module alignment mzscheme
+  
+  (require
+   (lib "match.ss")
+   (lib "contract.ss")
+   (lib "etc.ss")
+   (lib "list.ss"))
+  
+  (define-struct rect (x y) (make-inspector))
+  (define-struct abs-rect (ondim offdim) (make-inspector))
+  (define-struct dim (pos size stretchable?) (make-inspector))
+  
+  (define (nonnegative? n)
+    (and (number? n)
+         (or (positive? n)
+             (zero? n))))
+  
+  (provide/contract
+   (struct rect ((x dim?) (y dim?)))
+   (struct abs-rect ((ondim dim?) (offdim dim?)))
+   (struct dim ((pos nonnegative?) (size nonnegative?) (stretchable? boolean?)))
+   (align ((symbols 'horizontal 'vertical)
+           positive? positive? (listof rect?)
+           . -> . (listof rect?)))
+   (rect-print ((listof rect?) . -> . void?)))
+  
+  ;; align the rectangles within the given space
+  (define (align type width height rects)
+    (cond
+      [(symbol=? type 'horizontal)
+       (map abs->horiz (stretch-to-fit width height (map horiz->abs rects)))]
+      [(symbol=? type 'vertical)
+       (map abs->vert (stretch-to-fit height width (map vert->abs rects)))]))
+  
+  #;(abs-rect? . -> . rect?)
+  ;; convert an abstract rect to a horizontal rect
+  (define abs->horiz
+    (match-lambda
+      [($ abs-rect ondim offdim)
+       (make-rect ondim offdim)]))
+  
+  #;(abs-rect? . -> . rect?)
+  ;; convert an abstract rect to a vertical rect
+  (define abs->vert
+    (match-lambda
+      [($ abs-rect ondim offdim)
+       (make-rect offdim ondim)]))
+  
+  #;(rect? . -> . abs-rect?)
+  ;; convert a horizontal rect to an abstract rect
+  (define horiz->abs
+    (match-lambda
+      [($ rect x y)
+       (make-abs-rect x y)]))
+  
+  #;(rect? . -> . abs-rect?)
+  ;; convert a vertical rect to an abstract rect
+  (define vert->abs
+    (match-lambda
+      [($ rect x y)
+       (make-abs-rect y x)]))
+  
+  #;(positive? positive? (listof abs-rect?) . -> . (listof abs-rect?))
+  ;; stretch the rectangles to fit with the given space
+  (define (stretch-to-fit onsize offsize rects)
+    (let-values ([(total-unstretchable-size stretchable-sizes)
+                  (get-onsizes rects)])
+      (let-values ([(extra-div extra-mod)
+                    (get-extra/rect
+                     (- onsize total-unstretchable-size)
+                     (quicksort stretchable-sizes >))])
+        (allocate-evenly/position extra-div extra-mod offsize rects))))
+  
+  #;(((listof rect?)) . ->* . (nonnegative? (listof nonnegative?)))
+  ;; gets the unstretchable total size and a list of the stretchable sizes
+  (define (get-onsizes init-rects)
+    (let loop ([extra 0]
+               [stretchables empty]
+               [rects init-rects])
+      (match rects
+        [() (values extra stretchables)]
+        [(($ abs-rect ($ dim _ onsize #f) _) rest-rects ...)
+         (loop (+ onsize extra) stretchables rest-rects)]
+        [(($ abs-rect ($ dim _ onsize #t) _) rest-rects ...)
+         (loop extra (cons onsize stretchables) rest-rects)])))
+  
+  #;((nonnegative? (listof nonnegative?)) . ->* . (nonnegative? nonnegative?))
+  ;; get the space that each stretchable snip will have
+  (define (get-extra/rect init-extra init-sizes)
+    (let loop ([sizes init-sizes]
+               [extra init-extra]
+               [count (length init-sizes)])
+      (cond
+        [(empty? sizes) (values 0 0)]
+        [else
+         (let ([extra/rect (quotient (floor extra) count)]
+               [onsize (first sizes)])
+           (if (> onsize extra/rect)
+               (loop (rest sizes) (- extra onsize) (sub1 count))
+               (values extra/rect (modulo (floor extra) count))))])))
+  
+  #;((cons/p nonnegative? nonnegative?) positive? (listof abs-rect?) . -> .
+                                        (listof abs->rect?))
+  ;; allocate the extra per rectangle to the stretchable rects and move them to their positions
+  (define (allocate-evenly/position extra-div extra-mod offsize init-rects)
+    (let ([mod (waner extra-mod)])
+      (let loop ([rects init-rects]
+                 [onpos 0])
+        (match rects
+          [() empty]
+          [(($ abs-rect ($ dim _ min-onsize onstretch?)
+               ($ dim _ min-offsize offstretch?)) rest-rects ...)
+           (let ([onsize (if (and onstretch?
+                                  (< min-onsize extra-div))
+                             (+ extra-div (mod)) min-onsize)]
+                 [offsize (if offstretch? offsize min-offsize)])
+             (cons (make-abs-rect (make-dim onpos onsize onstretch?)
+                                  (make-dim 0 offsize offstretch?))
+                   (loop rest-rects (+ onpos onsize))))]))))
+  
+  #;(natural-number? . -> . (-> (union 1 0)))
+  ;; makes a thunk that returns 1 for it's first n applications, zero otherwise
+  (define (waner n)
+    (lambda ()
+      (if (zero? n)
+          0
+          (begin
+            (set! n (sub1 n))
+            1))))
+  
+  (define rect-print
+    (match-lambda
+      [() (void)]
+      [(($ rect
+           ($ dim x width stretchable-width?)
+           ($ dim y height stretchable-height?))
+        others ...)
+       (printf "(make-rect (make-dim ~s ~s ~s) (make-dim ~s ~s ~s))~n"
+               x width stretchable-width?
+               y height stretchable-height?)
+       (rect-print others)]))
+  )
\ No newline at end of file
diff --git a/collects/embedded-gui/private/button-snip.ss b/collects/embedded-gui/private/button-snip.ss
new file mode 100644
index 00000000..73628c71
--- /dev/null
+++ b/collects/embedded-gui/private/button-snip.ss
@@ -0,0 +1,148 @@
+(module button-snip mzscheme
+  
+  (require
+   (lib "mred.ss" "mred")
+   (lib "class.ss")
+   (lib "etc.ss"))
+  
+  (provide
+   text-button-snip%
+   button-snip%
+   toggle-button-snip%)
+  
+  ;; a snip of a button that can be pushed to invoke a given callback
+  (define button-snip%
+    (class image-snip%
+      (inherit load-file)
+      (init images)
+      (init-field callback)
+      (field
+       [got-click? false]
+       [inside? false]
+       [image (car images)]
+       [depressed (cdr images)])
+      
+      ;; (string? . -> . void?)
+      ;; set the image to be displayed on the button when it is not clicked
+      (define/public (set-images i)
+        (set! image (car i))
+        (set! depressed (cdr i))
+        (load-file image))
+      
+      ;; Should I be calling super-on-event?
+      (rename [super-on-event on-event])
+      (define/override (on-event dc x y editorx editory event)
+        (case (send event get-event-type)
+          [(left-down)
+           (set! got-click? true)
+           (set! inside? true)
+           (load-file depressed)]
+          [(left-up)
+           (load-file image)
+           (when (and got-click? inside?)
+             (callback this event))
+           (set! got-click? false)
+           (set! inside? false)]
+          [(enter)
+           (set! inside? true)
+           (when got-click?
+             (load-file depressed))]
+          [(leave)
+           (set! inside? false)
+           (when got-click?
+             (load-file image))]
+          [else (void)]))
+      
+      (super-new)
+      (load-file image)))
+  
+  ;; a textual button of the same type
+  (define text-button-snip%
+    (class string-snip%
+      (init label)
+      (init-field callback)
+      (field
+       [got-click? false]
+       [inside? false])
+      
+      (rename [super-on-event on-event])
+      (define/override (on-event dc x y editorx editory event)
+        (case (send event get-event-type)
+          [(left-down)
+           (set! got-click? true)
+           (set! inside? true)]
+          [(left-up)
+           (when (and got-click? inside?)
+             (callback this event))
+           (set! got-click? false)
+           (set! inside? false)]
+          [(enter)
+           (set! inside? true)]
+          [(leave)
+           (set! inside? false)]
+          [else (void)]))
+      
+      (super-make-object label)))
+  
+  ;; a toggle button that displays different images
+  (define toggle-button-snip%
+    (class button-snip%
+      (inherit set-images)
+      (init-field images1 images2 callback1 callback2 (state 1))
+      (super-new
+       (images images1)
+       (callback
+        (lambda (b e)
+          (if (= state 1)
+              (begin
+                (set-images images2)
+                (set! state 2)
+                (callback1 b e))
+              (begin
+                (set-images images1)
+                (set! state 1)
+                (callback2 b e))))))))
+  
+  ;;;;;;;;;;
+  ;; tests
+  
+  (require
+   (lib "locked-pasteboard.ss" "mrlib" "private" "aligned-pasteboard")
+   (lib "click-forwarding-editor.ss" "mrlib"))
+  
+  (define (test)
+    (define f (new frame% (label "test") (width 200) (height 200)))
+    (define e (new (locked-pasteboard-mixin
+                    (click-forwarding-editor-mixin pasteboard%))))
+    (define c (new editor-canvas% (editor e) (parent f)))
+    (define b (new button-snip%
+                   (images (cons (build-path (collection-path "icons") "turn-up.gif")
+                                 (build-path (collection-path "icons") "turn-up-click.gif")))
+                   (callback
+                    (lambda (b e)
+                      (message-box "Test" "Horray!")))))
+    (send e insert b)
+    (send f show #t))
+  
+  (define (test2)
+    (define f (new frame% (label "test") (width 200) (height 200)))
+    (define e (new (locked-pasteboard-mixin
+                    (click-forwarding-editor-mixin pasteboard%))))
+    (define c (new editor-canvas% (editor e) (parent f)))
+    (define t (new text%))
+    (define es (new editor-snip% (editor t)))
+    (define b (new toggle-button-snip%
+                   (images1 (cons (build-path (collection-path "icons") "turn-up.gif")
+                                  (build-path (collection-path "icons") "turn-up-click.gif")))
+                   (images2 (cons (build-path (collection-path "icons") "turn-down.gif")
+                                  (build-path (collection-path "icons") "turn-down-click.gif")))
+                   (callback1
+                    (lambda (b e)
+                      (send* t (erase) (insert "Up"))))
+                   (callback2
+                    (lambda (b e)
+                      (send* t (erase) (insert "Down"))))))
+    (send e insert es 50 0)
+    (send e insert b)
+    (send f show #t))
+)
\ No newline at end of file
diff --git a/collects/embedded-gui/private/fixed-width-label-snip.ss b/collects/embedded-gui/private/fixed-width-label-snip.ss
new file mode 100644
index 00000000..6b2c2e26
--- /dev/null
+++ b/collects/embedded-gui/private/fixed-width-label-snip.ss
@@ -0,0 +1,131 @@
+(module fixed-width-label-snip mzscheme
+  
+  (require
+   (lib "class.ss")
+   (lib "list.ss")
+   (lib "mred.ss" "mred"))
+  
+  (provide fixed-width-label-snip)
+  
+  (define (fixed-width-label-snip labels)
+    (define label-snip%
+      (class snip%
+        (inherit set-snipclass)
+        (init-field
+         label
+         (with-border? #f)
+         (left-margin 5)
+         (right-margin 5)
+         (top-margin 5)
+         (bottom-margin 5)
+         (left-inset 1)
+         (top-inset 1)
+         (right-inset 1)
+         (bottom-inset 1))
+        
+        (field [font (make-object font% 10 'roman 'normal 'normal)])
+        
+        (unless (member label labels)
+          (error 'fixed-width-label-snip
+                 "Instantiation of label-snip expected one of ~s. Given ~s"
+                 labels
+                 label))
+        
+        (define (get-string-width dc string)
+          (let-values ([(width height baseline vspace)
+                        (send dc get-text-extent string font)])
+            width))
+        
+        (define (get-string-height dc string)
+          (let-values ([(width height baseline vspace)
+                        (send dc get-text-extent string font)])
+            height))
+        
+        (define (get-max-string-width dc strings)
+          (foldl
+           (lambda (str max-width)
+             (max (get-string-width dc str) max-width))
+           (get-string-width dc (first strings))
+           (rest strings)))
+        
+        (define (get-max-string-height dc strings)
+          (foldl
+           (lambda (str max-height)
+             (max (get-string-height dc str) max-height))
+           (get-string-height dc (first strings))
+           (rest strings)))
+        
+        (define/override (get-extent dc x y w h descent space lspace rspace)
+          (let ([width (get-max-string-width dc labels)]
+                [height (get-max-string-height dc labels)])
+            (when w (set-box! w (+ left-margin width right-margin)))
+            (when h (set-box! h (+ top-margin height bottom-margin)))))
+        
+        (rename [super-draw draw])
+        (define/override (draw dc x y left top right bottom dx dy draw-caret)
+          (super-draw dc x y left top right bottom dx dy draw-caret)
+          (let ([max-width (get-max-string-width dc labels)]
+                [width (get-string-width dc label)]
+                [max-height (get-max-string-height dc labels)])
+            (let ([f (send dc get-font)])
+              (send dc set-font font)
+              (send dc draw-text label
+                    (+ left-margin x (- max-width width))
+                    (+ y top-margin))
+              (send dc set-font f))
+            (when with-border?
+              (let ((w (+ left-margin max-width right-margin))
+                    (h (+ top-margin max-height bottom-margin)))
+                (send dc draw-lines 
+                      (list (make-object point% left-inset top-inset)
+                            (make-object point% left-inset (- h bottom-inset))
+                            (make-object point% (- w right-inset) (- h bottom-inset))
+                            (make-object point% (- w right-inset) top-inset)
+                            (make-object point% left-inset top-inset))
+                    x 
+                    y)))))
+        
+        ;(rename [super-copy copy])
+        ;(define/override (copy)
+        ;  (super-copy))
+        
+        (define/override (resize w h) #f)
+        
+        ;; write ((is-a?/c editor-stream-out%) . -> . void?)
+        ;; write the snip out to the stream
+        (define/override (write f)
+          (send f put label))
+        
+        (super-new)
+        (set-snipclass (new label-snip-class%))))
+    
+    (define label-snip-class%
+      (class snip-class%
+        ;; read ((is-a?/c editor-stream-in%) . -> . snip%)
+        ;; read a snip from the stream
+        (define/override (read f)
+          (new label-snip% (label (send f get-string))))
+        (super-new)))
+    
+    (let ([lsc (new label-snip-class%)])
+      (send lsc set-classname "...")
+      (send lsc set-version 1)
+      (send (get-the-snip-class-list) add lsc))
+    
+    label-snip%)
+
+  ;;;;;;;;;;
+  ;; tests
+  
+  ;(define mylabels (list "Call" "Expected" "Actual"))
+  ;(define label% (fixed-width-label-snip mylabels))
+  ;(define align? #t)
+  ;(define f (new frame% (label "test") (width 175) (height 175)))
+  ;(define e (new pasteboard%))
+  ;(define c (new editor-canvas% (editor e) (parent f)))
+  ;(for-each
+  ; (lambda (s)
+  ;   (send e insert (new label% (label s))))
+  ; '("Expected"))
+  ;(send f show #t)
+  )
\ No newline at end of file
diff --git a/collects/embedded-gui/private/grey-editor.ss b/collects/embedded-gui/private/grey-editor.ss
new file mode 100644
index 00000000..01a42372
--- /dev/null
+++ b/collects/embedded-gui/private/grey-editor.ss
@@ -0,0 +1,56 @@
+(module grey-editor mzscheme
+  
+  (provide grey-editor-snip-mixin grey-editor-mixin)
+  
+  (require
+   (lib "mred.ss" "mred")
+   (lib "class.ss")
+   (lib "framework.ss" "framework"))
+  
+  (define *disable-color* (make-object color% 235 235 255))
+  
+  (define grey-editor-snip-mixin
+    (mixin ((class->interface editor-snip%)) ()
+      (rename [super-draw draw])
+      (inherit get-admin get-inset)
+      (define/override (draw dc x y left top right bottom dx dy draw-caret)
+        (let ([old-pen (send dc get-pen)]
+              [old-brush (send dc get-brush)]
+              [admin (get-admin)]
+              [left-inset (box 0)]
+              [top-inset (box 0)]
+              [right-inset (box 0)]
+              [bottom-inset (box 0)]
+              [xb (box 0)]
+              [yb (box 0)]
+              [wb (box 0)]
+              [hb (box 0)])
+          (when admin
+            (send admin get-view xb yb wb hb this)
+            (get-inset left-inset top-inset right-inset bottom-inset)
+            (send dc set-pen (send the-pen-list find-or-create-pen *disable-color* 1 'solid))
+            (send dc set-brush (send the-brush-list find-or-create-brush *disable-color* 'solid))
+            (send dc draw-rectangle
+                  (+ x (unbox xb) (unbox left-inset))
+                  (+ y (unbox yb) (unbox top-inset))
+                  (max 0 (- (unbox wb) (+ (unbox left-inset) (unbox right-inset))))
+                  (max 0 (- (unbox hb) (+ (unbox top-inset) (unbox bottom-inset)))))
+            (send dc set-pen old-pen)
+            (send dc set-brush old-brush)))
+        (super-draw dc x y left top right bottom dx dy draw-caret))
+      (super-new)))
+  
+  (define grey-editor-mixin
+    (mixin (editor<%>) ()
+      (rename [super-on-paint on-paint])
+      (define/override (on-paint before? dc left top right bottom dx dy draw-caret)
+        (when before?
+          (let ([old-pen (send dc get-pen)]
+                [old-brush (send dc get-brush)])
+            (send dc set-pen (send the-pen-list find-or-create-pen *disable-color* 1 'solid))
+            (send dc set-brush (send the-brush-list find-or-create-brush *disable-color* 'solid))
+            (send dc draw-rectangle (+ left dx) (+ top dy) (+ right dx) (+ bottom dy))
+            (send dc set-pen old-pen)
+            (send dc set-brush old-brush)))
+        (super-on-paint before? dc left top right bottom dx dy draw-caret))
+      (super-new))))
\ No newline at end of file
diff --git a/collects/embedded-gui/private/grid-alignment.ss b/collects/embedded-gui/private/grid-alignment.ss
new file mode 100644
index 00000000..b776bbc5
--- /dev/null
+++ b/collects/embedded-gui/private/grid-alignment.ss
@@ -0,0 +1,135 @@
+(module grid-alignment mzscheme
+  
+  (require
+   (lib "class.ss")
+   (lib "mred.ss" "mred")
+   (lib "etc.ss")
+   (lib "list.ss")
+   (lib "match.ss")
+   (prefix a: "alignment.ss")
+   (lib "click-forwarding-editor.ss" "mrlib")
+   
+   "on-show-pasteboard.ss"
+   "really-resized-pasteboard.ss"
+   "interface.ss"
+   "snip-lib.ss"
+   "alignment-helpers.ss")
+  
+  (provide grid-alignment%)
+  
+  (define grid-alignment%
+    (class* object% (alignment<%>)
+      (init-field
+       columns
+       (parent false))
+      (field
+       [pasteboard false]
+       [rows empty]
+       [row-heights 0]
+       [column-widths 0]
+       [show? true])
+      
+      ;; need base class for this method
+      (define (show/hide-child child show?)
+        (if (is-a? child alignment<%>)
+            (send child show show?)
+            (if show?
+                (send pasteboard insert child)
+                (send pasteboard release-snip child))))
+      
+      (define/public (add row)
+        (set! rows (append rows (list row)))
+        (unless (= (vector-length row) columns)
+          (error 'add "Invalid number of rows"))
+        (send pasteboard lock-alignment true)
+        (let loop ([column 0])
+          (unless (>= column columns)
+            (let ([child (vector-ref row column)])
+              (cond
+                [(is-a? child snip%)
+                 (when show?
+                   (send pasteboard insert child false))]
+                [(is-a? child alignment<%>)
+                 (send child set-pasteboard pasteboard)])
+              (loop (add1 column)))))
+        (send pasteboard lock-alignment false))
+      
+      (define/public (set-min-sizes)
+        
+        (set! column-widths
+              (map
+               (lambda (column)
+                 (apply vacuous-max
+                        (map (lambda (row)
+                               (child-width
+                                (vector-ref row column)))
+                             rows)))
+               (build-list columns identity)))
+        
+        (set! row-heights
+              (map
+               (lambda (row)
+                 (apply vacuous-max
+                        (map (lambda (column)
+                               (child-height
+                                (vector-ref row column)))
+                             (build-list columns identity))))
+               rows)))
+      
+      ;; STATUS: This function currently doesn't stretch snips.
+      (define/public (align x-offset y-offset width height)
+          (define (align-row row init-x y)
+            (let xloop ([x init-x]
+                        [column 0]
+                        [widths column-widths])
+              (unless (or (>= column columns) (empty? widths))
+                (move-child (vector-ref row column) pasteboard x y)
+                (xloop (+ x (first widths))
+                       (add1 column)
+                       (rest widths)))))
+          (when show?
+            (let yloop ([y y-offset]
+                        [the-rows rows]
+                        [heights row-heights])
+              (unless (or (empty? the-rows) (empty? heights))
+                (align-row (first the-rows) x-offset y)
+                (yloop (+ y (first heights))
+                       (rest the-rows)
+                       (rest heights))))))
+      
+      (define/public (get-min-width)
+        (if show?
+            (apply + column-widths)
+            0))
+      (define/public (get-min-height)
+        (if show?
+            (apply + row-heights)
+            0))
+      
+      (define/public (show bool)
+        (define (show/hide-row row)
+          (let loop ([column 0])
+            (unless (>= column columns)
+              (let ([child (vector-ref row column)])
+                (show/hide-child child bool)
+                (loop (add1 column))))))
+        (unless (boolean=? bool show?)
+          (set! show? bool)
+          (send pasteboard lock-alignment true)
+          (for-each show/hide-row rows)
+          (send pasteboard lock-alignment false)))
+      
+      (define/public (stretchable-width?) false)
+      (define/public (stretchable-height?) false)
+      (define/public (set-pasteboard pb) (set! pasteboard pb))
+      
+      (super-new)
+      (when parent (send parent add this))))
+  
+  (define (move-child child pasteboard x y)
+    (cond
+      [(is-a? child snip%)
+       (send pasteboard move-to child x y)]
+      [(is-a? child alignment<%>)
+       (send child align x y)]))
+  )
diff --git a/collects/embedded-gui/private/interface.ss b/collects/embedded-gui/private/interface.ss
new file mode 100644
index 00000000..ba1c7563
--- /dev/null
+++ b/collects/embedded-gui/private/interface.ss
@@ -0,0 +1,46 @@
+(module interface mzscheme
+  
+  (require (lib "class.ss"))
+  
+  (provide stretchable-snip<%>
+           alignment<%>)
+  
+  (define alignment<%>
+    (interface ()
+      set-min-sizes
+      align
+      get-min-width
+      get-min-height
+      stretchable-width?
+      stretchable-height?
+      show))
+  
+  #| the interface that must be implemented by a class to be inserted into an
+     aligned-pasteboard<%> and be stretched and shrunk according to the geometry managment.
+  
+     note: any snip may be insert... those
+     that do not implement stretchable-snip<%> will simply not be stretched.
+  |#
+  (define stretchable-snip<%>
+    (interface ()
+      ;; (positive? positive? . ->  . void?)
+      ;; called by the parent editor to stretch the snip to an specific size
+      stretch
+      
+      ;; get-aligned-min-width (-> positive?)
+      ;; get the minimum width of the snip
+      get-aligned-min-width
+      
+      ;; get-aligned-min-height (-> positive?)
+      ;; get the minmum height of the snip
+      get-aligned-min-height
+      
+      ;; stretchable-width (case-> (boolean . -> . void?) (-> boolean?))
+      ;; get or set the stretchablity of the pasteboards width
+      stretchable-width
+      
+      ;; stretchable-height (case-> (boolean . -> . void?) (-> boolean?))
+      ;; get or set the stretchablity of the pasteboards height
+      stretchable-height
+      ))
+  )
\ No newline at end of file
diff --git a/collects/embedded-gui/private/on-show-pasteboard.ss b/collects/embedded-gui/private/on-show-pasteboard.ss
new file mode 100644
index 00000000..348e1778
--- /dev/null
+++ b/collects/embedded-gui/private/on-show-pasteboard.ss
@@ -0,0 +1,43 @@
+(module on-show-pasteboard mzscheme
+  
+  (require
+   (lib "class.ss")
+   (lib "etc.ss")
+   (lib "mred.ss" "mred"))
+  
+  (provide
+   on-show-pasteboard%
+   on-show-pasteboard-mixin)
+  
+  (define (on-show-pasteboard-mixin super%)
+    (class super%
+      (field [shown? false])
+      (rename [super-refresh refresh])
+      (define/override (refresh x y w h d-c)
+        (super-refresh x y w h d-c)
+        (unless shown?
+          (set! shown? true)
+          (on-show)))
+      (define/public (showing?)
+        shown?)
+      (define/public (on-show)
+        (void))
+      (super-new)))
+  
+  (define on-show-pasteboard%
+    (on-show-pasteboard-mixin
+     pasteboard%))
+  
+  #|
+  (define f (new frame% (label "f") (width 400) (height 400)))
+  (send f show true)
+  (define e (new pasteboard%))
+  (define c (new editor-canvas% (editor e) (parent f)))
+  (define pb (new on-show-pasteboard%))
+  (define es (new editor-snip% (editor pb)))
+  (send e insert es)
+  (send pb showing?)
+  (send e remove es)
+  (not (send pb showing?))
+  |#
+  )
diff --git a/collects/embedded-gui/private/program-editor.ss b/collects/embedded-gui/private/program-editor.ss
new file mode 100644
index 00000000..3398477b
--- /dev/null
+++ b/collects/embedded-gui/private/program-editor.ss
@@ -0,0 +1,86 @@
+#|
+
+This file contains a mixin that should be used my any embedded editor that contains
+code. What is does is tells the drscheme frame that the program has changed and
+drscheme can appropriately reset highlighting and display the "save" button. There
+is a facility of drscheme to do this but to my knowledge it is not working properly.
+
+|#
+
+#|NOTES:
+
+This code is copied from the test suite tool and the test suite tool should be
+rewritten to use this copy of the program. This is not a trivial change since the
+alert-of-modify method in test-suite is currently clearing the test cases to reset
+them.
+
+This code can be replaced by drscheme:unit:program-editor-mixin when I figure out how
+to make the results of the test case boxes be reset when (and only when) highlighting
+is being reset.
+|#
+
+(module program-editor mzscheme
+  
+  (require
+   (lib "mred.ss" "mred")
+   (lib "etc.ss")
+   (lib "class.ss")
+   "snip-lib.ss")
+  
+  (provide program-editor-mixin)
+  
+  (define (program-editor-mixin %)
+    (class %
+      (inherit get-admin begin-edit-sequence end-edit-sequence)
+      (rename [super-after-insert after-insert]
+              [super-after-delete after-delete])
+      (define (get-frame)
+        ;; gets the top most editor in the tree of snips and editors
+        (define (editor-root ed)
+          (let ([parent (editor-parent ed)])
+            (cond
+              [(is-a? parent area<%>) parent]
+              [(is-a? parent snip%)
+               (editor-root (snip-parent parent))]
+              [else false])))
+        
+        ;; gets the canvas or snip that the pasteboard is displayed in
+        ;; status: what if there is more than one canvas?
+        (define (editor-parent ed)
+          (let ([admin (send ed get-admin)])
+            (cond
+              [(is-a? admin editor-snip-editor-admin<%>)
+               (send admin get-snip)]
+              [(is-a? admin editor-admin%)
+               (send ed get-canvas)]
+              [else false])))
+        
+        (let ([er (editor-root this)])
+          (if er
+              (send er get-top-level-window)
+              false)))
+      
+      (define (alert-of-modify)
+        (let ([frame (get-frame)])
+          (when frame
+            (send (send frame get-interactions-text) reset-highlighting)
+            (send* (send frame get-definitions-text)
+              (set-modified true)))))
+      
+      ;(rename [super-on-insert on-insert])
+      ;(define/override (on-insert start len)
+      ;  (begin-edit-sequence)
+      ;  (super-on-insert start len)
+      ;  (end-edit-sequence))
+      
+      (define/override (after-insert start len)
+        (alert-of-modify)
+        ;(begin-edit-sequence)
+        (super-after-insert start len)
+        ;(end-edit-sequence)
+        )
+      (define/override (after-delete start len)
+        (alert-of-modify)
+        (super-after-delete start len))
+      (super-new)))
+  )
\ No newline at end of file
diff --git a/collects/embedded-gui/private/really-resized-pasteboard.ss b/collects/embedded-gui/private/really-resized-pasteboard.ss
new file mode 100644
index 00000000..fe7eaad0
--- /dev/null
+++ b/collects/embedded-gui/private/really-resized-pasteboard.ss
@@ -0,0 +1,85 @@
+#|
+
+This module provides a really-resized pasteboard that calls the really-resized
+method when a snip in the editor is really resized, not when pasteboard says
+it's resized. This file was written because sometimes I need to override resized
+to adjust my editors layout however the resized method of the pasteboard is
+invoked whenever editor snips get focus, lose focus, get text typed into them,
+get text deteleted from them, etc.
+
+|#
+
+(module really-resized-pasteboard mzscheme
+  
+  (require
+   (lib "etc.ss")
+   (lib "class.ss")
+   (lib "mred.ss" "mred"))
+  
+  (provide
+   really-resized-pasteboard-mixin
+   really-resized-pasteboard%)
+  
+  (define (really-resized-pasteboard-mixin super%)
+    (class super%
+      (inherit refresh-delayed? get-snip-location)
+      (field [snip-cache (make-hash-table)]
+             [ignore-resizing? false])
+      
+      ;; Called whenever a snip within the editor is resized, just like the
+      ;; resized method but excludes suchs events as when and editor-snip gets
+      ;; focus.
+      (define/public (really-resized snip) (void))
+      
+      #|
+      snip : snip% object 
+      redraw-now? : boolean
+      |#
+      (rename [super-resized resized])
+      (define/override (resized snip redraw-now?)
+        (super-resized snip redraw-now?)
+        (unless ignore-resizing?
+          (let ([size (snip-size snip)])
+            (unless (equal? size (hash-table-get snip-cache snip))
+              (hash-table-put! snip-cache snip size)
+              (really-resized snip)))))
+      
+      #|
+      snip : snip% object 
+      before : snip% object or #f 
+      x : real number 
+      y : real number
+      |#
+      (rename [super-after-insert after-insert])
+      (define/override (after-insert snip before x y)
+        (super-after-insert snip before x y)
+        (hash-table-put! snip-cache snip (snip-size snip)))
+      
+      #|
+      snip : snip% object
+      |#
+      (rename [super-after-delete after-delete])
+      (define/override (after-delete snip)
+        (super-after-delete snip)
+        (hash-table-remove! snip-cache snip))
+      
+      #;((is-a?/c snip%) . -> . (cons/p natural-number? natural-number?))
+      ;; The width and height of the given snip in this pasteboard.
+      (define (snip-size snip)
+        (let ([top (box 0)]
+              [bottom (box 0)]
+              [left (box 0)]
+              [right (box 0)])
+          (fluid-let ([ignore-resizing? true])
+            (get-snip-location snip left top false)
+            (get-snip-location snip right bottom true))
+          (cons (- (unbox right) (unbox left))
+                (- (unbox bottom) (unbox top)))))
+      
+      (super-new)
+      ))
+  
+  (define really-resized-pasteboard%
+    (really-resized-pasteboard-mixin
+     pasteboard%))
+  )
diff --git a/collects/embedded-gui/private/snip-lib.ss b/collects/embedded-gui/private/snip-lib.ss
new file mode 100644
index 00000000..e9c8baa2
--- /dev/null
+++ b/collects/embedded-gui/private/snip-lib.ss
@@ -0,0 +1,119 @@
+#| WARNING: DUPLICATED FILE |#
+
+(module snip-lib mzscheme
+  
+  (require
+   (lib "class.ss")
+   (lib "etc.ss")
+   (lib "mred.ss" "mred")
+   (lib "list.ss")
+   (lib "contract.ss")
+   "interface.ss")
+  
+  ;; a snip
+  (define snip? (is-a?/c snip%))
+  ;; a snip to act as the varying argument to a recursive functions
+  (define linked-snip? (union snip? false?))
+  ;; a function to act on snips being mapped
+  (define snip-visitor? any? #;((snip?) (listof any?) . ->* . (void)))
+  ;; the rest of the lists passed to a snip mapping function
+  (define rest-lists? (listof (listof any?)))
+  ;; a class that contains a snip
+  (define editor? (is-a?/c editor<%>))
+  
+  (provide/contract
+   (snip-width (snip? . -> . number?))
+   (snip-height (snip? . -> . number?))
+   (snip-min-width (snip? . -> . number?))
+   (snip-min-height (snip? . -> . number?))
+   (snip-parent (snip? . -> . (union editor? false?)))
+   (fold-snip ((snip? any? . -> . any?) any? linked-snip? . -> . any?))
+   (for-each-snip any? #;((snip-visitor? linked-snip?) rest-lists? . ->* . (void)))
+   (map-snip any? #;((snip-visitor? linked-snip?) rest-lists? . ->* . ((listof any?))))
+   (stretchable-width? (snip? . -> . boolean?))
+   (stretchable-height? (snip? . -> . boolean?)))
+  
+  ;; the width of a snip in the parent pasteboard
+  (define (snip-width snip)
+    (let ([left (box 0)]
+          [right (box 0)]
+          [pasteboard (snip-parent snip)])
+      (send pasteboard get-snip-location snip left (box 0) false)
+      (send pasteboard get-snip-location snip right (box 0) true)
+      (- (unbox right) (unbox left))))
+    
+  ;; the height of a snip in the parent pasteboard
+  (define (snip-height snip)
+    (let ([top (box 0)]
+          [bottom (box 0)]
+          [pasteboard (snip-parent snip)])
+      (send pasteboard get-snip-location snip (box 0) top false)
+      (send pasteboard get-snip-location snip (box 0) bottom true)
+      (- (unbox bottom) (unbox top))))
+  
+  ;; the minimum width of the snip
+  (define (snip-min-width snip)
+    (cond
+      [(is-a? snip stretchable-snip<%>)
+       (send snip get-aligned-min-width)]
+      [else (snip-width snip)]))
+  
+  ;; the minimum height of the snip
+  (define (snip-min-height snip)
+    (cond
+      [(is-a? snip stretchable-snip<%>)
+       (send snip get-aligned-min-height)]
+      [else (snip-height snip)]))
+  
+  ;; the pasteboard that contains the snip
+  (define (snip-parent snip)
+    (let ([admin (send snip get-admin)])
+      (if admin
+          (send admin get-editor)
+          false)))
+  
+  ;; the application of f on all snips from snip to the end in a foldl foldr mannor
+  (define (fold-snip f init-acc snip)
+    (let loop ([snip snip]
+               [acc init-acc])
+      (cond
+        [(is-a? snip snip%)
+         (loop (send snip next) (f snip acc))]
+        [else acc])))
+  
+  ;; applies the function to all the snips
+  (define (for-each-snip f first-snip . init-lists)
+    (let loop ([snip first-snip]
+               [lists init-lists])
+      (cond
+        [(is-a? snip snip%)
+         (apply f (cons snip (map first lists)))
+         (loop (send snip next)
+               (map rest lists))]
+        [else (void)])))
+  
+  ;; a list of f applied to each snip
+  (define (map-snip f first-snip . init-lists)
+    (let loop ([snip first-snip]
+               [lists init-lists])
+      (cond
+        [(is-a? snip snip%)
+         (cons (apply f (cons snip (map first lists)))
+               (loop (send snip next)
+                     (map rest lists)))]
+        [else empty])))
+  
+  ;; true if the snip can be resized in the x dimention
+  (define (stretchable-width? snip)
+    (cond
+      [(is-a? snip stretchable-snip<%>)
+       (send snip stretchable-width)]
+      [else false]))
+  
+  ;; true if the snip can be resized in the y dimention
+  (define (stretchable-height? snip)
+    (cond
+      [(is-a? snip stretchable-snip<%>)
+       (send snip stretchable-height)]
+      [else false]))
+  )
diff --git a/collects/embedded-gui/private/stretchable-editor-snip.ss b/collects/embedded-gui/private/stretchable-editor-snip.ss
new file mode 100644
index 00000000..4220d776
--- /dev/null
+++ b/collects/embedded-gui/private/stretchable-editor-snip.ss
@@ -0,0 +1,119 @@
+(module stretchable-editor-snip mzscheme
+  
+  (provide
+   stretchable-editor-snip%
+   stretchable-editor-snip-mixin)
+  
+  (require
+   (lib "class.ss")
+   (lib "mred.ss" "mred")
+   (lib "etc.ss")
+   
+   "interface.ss")
+  
+  (define (stretchable-editor-snip-mixin super%)
+    (class* super% (stretchable-snip<%>)
+      
+      (init
+       (stretchable-width true)
+       (stretchable-height true))
+      
+      (field
+       (aligned-min-width 0)
+       (aligned-min-height 0)
+       (stretchable-width-field stretchable-width)
+       (stretchable-height-field stretchable-height))
+      
+      (public (stretchable-width-method stretchable-width)
+              (stretchable-height-method stretchable-height))
+      
+      ;; stretchable-width (case-> (Boolean . -> . (void)) (-> Boolean))
+      ;; get or set the stretchablity of the pasteboards width
+      (define stretchable-width-method
+        (case-lambda
+          [(value) (set! stretchable-width-field value)]
+          [() stretchable-width-field]))
+      
+      ;; stretchable-height (case-> (Boolean . -> .(void)) (-> Boolean))
+      ;; get or set the stretchablity of the pasteboards height
+      (define stretchable-height-method
+        (case-lambda
+          [(value) (set! stretchable-height-field value)]
+          [() stretchable-height-field]))
+      
+      (define/public (get-aligned-min-width) aligned-min-width)
+      (define/public (get-aligned-min-height) aligned-min-height)
+      
+      (inherit get-margin get-editor get-admin)
+      (define/override (resize w h)
+        (set! aligned-min-width w)
+        (set! aligned-min-height h)
+        (super-resize w h))
+        
+      (define/public (stretch w h)
+        (super-resize w h))
+      
+      (rename [super-get-extent get-extent])
+      (define/override (get-extent dc x y w h descent space lspace rspace)
+        (super-get-extent dc x y w h descent space lspace rspace)
+        (when (is-a? (get-editor) text%)
+          (set-box! w (sub1 (unbox w))))
+        (go))
+      
+      (define/override (set-min-width w)
+        ;; account for margin !!!!!!
+        (send (get-editor) set-min-width w))
+      
+      (define/override (set-min-height h)
+        ;; account for margin !!!!!!
+        (send (get-editor) set-min-height h))
+      
+      ;; NOTE: Can I make this not public? I don't think it
+      ;; should be but it's been a while since I wrote this class.
+      (rename [super-set-min-width set-min-width]
+              [super-set-min-height set-min-height])
+      (define/public (super-resize w h)
+        (let ((top (box 0))
+              (bot (box 0))
+              (lef (box 0))
+              (rit (box 0)))
+          (get-margin top bot lef rit)
+          (let ((w (max (- w (unbox lef) (unbox rit)) 0))
+                (h (max (- h (unbox top) (unbox bot)) 0))
+                (e (get-editor))
+                (a (get-admin)))
+            ;; subtracting 1 from W seems to make it act more like the editor-snip
+            ;; because the C code has a hack to sub1 to make it look better. I am not
+            ;; sure if this change here is sound and works for every part of this
+            ;; class.
+            (if (> w aligned-min-width)
+                (super-set-min-width w)
+                (super-set-min-width 'none))
+            (if (> h aligned-min-height)
+                (super-set-min-height h)
+                (super-set-min-height 'none))
+            (when a (send a resized this #t)))))
+      
+      ;; call this from within get extent and use the values it produces by subtracting the
+      ;; margin instead of calling the editors get-extent and adding the margin.
+      (define (go)
+        (let ([w (box 0)]
+              [h (box 0)]
+              (top (box 0))
+              (bot (box 0))
+              (lef (box 0))
+              (rit (box 0)))
+          (get-margin top bot lef rit)
+          (send (get-editor) get-extent w h)
+          (set! aligned-min-width (+ (unbox w) (unbox lef) (unbox rit)))
+          (set! aligned-min-height (+ (unbox h) (unbox top) (unbox rit)))))
+            
+      (super-new)
+      (inherit get-min-width get-min-height)
+      (set-min-width (get-min-width))
+      (set-min-height (get-min-height))))
+  
+  (define stretchable-editor-snip%
+    (stretchable-editor-snip-mixin
+     editor-snip%))
+  )
\ No newline at end of file
diff --git a/collects/embedded-gui/private/tabbable-text.ss b/collects/embedded-gui/private/tabbable-text.ss
new file mode 100644
index 00000000..59a27437
--- /dev/null
+++ b/collects/embedded-gui/private/tabbable-text.ss
@@ -0,0 +1,56 @@
+(module tabbable-text mzscheme
+  
+  (require
+   (lib "class.ss")
+   (lib "list.ss")
+   (lib "etc.ss")
+   (lib "framework.ss" "framework")
+   (lib "mred.ss" "mred")
+   (lib "contract.ss"))
+  
+  (define tabbable-text<%> (interface () set-caret-owner))
+  
+  (provide/contract
+   (tabbable-text<%> interface?)
+   (tabbable-text-mixin mixin-contract)
+   (set-tabbing (() (listof (is-a?/c tabbable-text<%>)) . ->* . (void?))))
+  
+  (define tabbable-text-mixin
+    (mixin (editor:keymap<%>) (tabbable-text<%>)
+      
+      (init-field
+       [ahead void]
+       [back void])
+      
+      ;; get-keymaps (-> (listof keymap%))
+      ;; the list of keymaps associated with this text
+      (rename [super-get-keymaps get-keymaps])
+      (define/override (get-keymaps)
+        (let ([keymap (make-object keymap%)])
+          (send keymap add-function "tab-ahead"
+                (lambda (ignored event)
+                  (ahead)))
+          (send keymap map-function ":tab" "tab-ahead")
+          (send keymap add-function "tab-back"
+                (lambda (ignored event)
+                  (back)))
+          (send keymap map-function "s:tab" "tab-back")
+          (cons keymap (super-get-keymaps))))
+      
+      (define/public (set-ahead t) (set! ahead t))
+      (define/public (set-back t) (set! back t))
+      
+      (super-new)))
+  
+  
+  ;; sets the tabbing of all of the texts in the order of the list
+  (define (set-tabbing . l)
+    (cond
+      [(or (empty? l) (empty? (rest l))) (void)]
+      [else
+       (send (first l) set-ahead
+             (lambda () (send (second l) set-caret-owner false 'global)))
+       (send (second l) set-back
+             (lambda () (send (first l) set-caret-owner false 'global)))
+       (apply set-tabbing (rest l))]))
+  )
\ No newline at end of file
diff --git a/collects/embedded-gui/private/tests/alignment-test.ss b/collects/embedded-gui/private/tests/alignment-test.ss
new file mode 100644
index 00000000..bfa9a732
--- /dev/null
+++ b/collects/embedded-gui/private/tests/alignment-test.ss
@@ -0,0 +1,30 @@
+(require
+ (lib "class.ss")
+ (lib "etc.ss")
+ (lib "mred.ss" "mred")
+ (lib "print-debug.ss" "mike-lib")
+ "../stretchable-editor-snip.ss"
+ "../verthoriz-alignment.ss"
+ "../aligned-pasteboard.ss"
+ "../grid-alignment.ss")
+
+(define f (new frame% (label "f") (height 500) (width 500)))
+(send f show true)
+(define a1 (new aligned-pasteboard%))
+(define c (new editor-canvas% (editor a1) (parent f)))
+(define a2 (new horizontal-alignment% (parent a1)))
+(define a3 (new horizontal-alignment% (parent a1)))
+(define a4 (new grid-alignment% (parent a1) (columns 4)))
+(send a2 add (make-object string-snip% "One"))
+(send a2 add (make-object string-snip% "Two"))
+(send a3 add (make-object string-snip% "Three"))
+(send a3 add (make-object string-snip% "Four"))
+(send a4 add (vector (make-object string-snip% "This is really long")
+                     (new editor-snip% (editor (new text%)))
+                     (make-object string-snip% "short")
+                     (make-object string-snip% "meduim")))
+(send a4 add (vector (make-object string-snip% "short")
+                     (make-object string-snip% "This is really long")
+                     (new editor-snip% (editor (new text%)))
+                     (make-object string-snip% "meduim")))
+(send f show true)
\ No newline at end of file
diff --git a/collects/embedded-gui/private/tests/not-stetching.ss b/collects/embedded-gui/private/tests/not-stetching.ss
new file mode 100644
index 00000000..8e4a2e22
--- /dev/null
+++ b/collects/embedded-gui/private/tests/not-stetching.ss
@@ -0,0 +1,31 @@
+(module not-stetching mzscheme
+  
+  (require
+   (lib "debug.ss" "mike-lib")
+   (lib "class.ss")
+   (lib "etc.ss")
+   (lib "mred.ss" "mred")
+   (lib "aligned-pasteboard.ss" "embedded-gui")
+   (lib "stretchable-editor-snip.ss" "embedded-gui")
+   (lib "verthoriz-alignment.ss" "embedded-gui"))
+  
+  (define traced-ses%
+    (override/trace stretchable-editor-snip%
+                    (stretch
+                     get-aligned-min-width
+                     get-aligned-min-height
+                     stretchable-width
+                     stretchable-height)))
+  
+  (define f (new frame% (label "f") (width 400) (height 400)))
+  (define e (new text%))
+  (define c (new editor-canvas% (parent f) (editor e)))
+  (define main (new aligned-pasteboard%))
+  (define j (new editor-snip% (editor main)))
+  (define line (new horizontal-alignment% (parent main)))
+  (define ses (new traced-ses% (editor (new text%))))
+  (send line add ses)
+  (send main add (make-object string-snip% "super duper very long snip"))
+  (send e insert j)
+  (send f show true)
+  )
\ No newline at end of file
diff --git a/collects/embedded-gui/private/tests/peer-stretchables.ss b/collects/embedded-gui/private/tests/peer-stretchables.ss
new file mode 100644
index 00000000..b76524b7
--- /dev/null
+++ b/collects/embedded-gui/private/tests/peer-stretchables.ss
@@ -0,0 +1,25 @@
+(require
+ (lib "class.ss")
+ (lib "etc.ss")
+ (lib "mred.ss" "mred")
+ "../stretchable-editor-snip.ss"
+ "../verthoriz-alignment.ss"
+ "../aligned-pasteboard.ss")
+
+(define f (new frame% (label "f") (width 400) (height 400)))
+(define e (new text%))
+(define c (new editor-canvas% (parent f) (editor e)))
+(define main (new aligned-pasteboard%))
+(define horiz (new vertical-alignment% (parent main)))
+(define es (new editor-snip% (editor main)))
+(define ses1 (new stretchable-editor-snip% (editor (new text%))))
+(define ses2 (new stretchable-editor-snip% (editor (new text%))))
+(send* horiz (add ses1) (add ses2))
+(send e insert es)
+(send f show true)
+
+(let ([e (send ses2 get-editor)]
+      [ses1-mw (send ses1 get-min-width)])
+  (send e insert "sdflsdfnsknbskdlf")
+  (send e erase)
+  (equal? ses1-mw (send ses1 get-min-width)))
\ No newline at end of file
diff --git a/collects/embedded-gui/private/tests/stretching-in-alignment.ss b/collects/embedded-gui/private/tests/stretching-in-alignment.ss
new file mode 100644
index 00000000..1921ee90
--- /dev/null
+++ b/collects/embedded-gui/private/tests/stretching-in-alignment.ss
@@ -0,0 +1,30 @@
+(module stretching-in-alignment mzscheme
+    
+  (require
+   (lib "mred.ss" "mred")
+   (lib "etc.ss")
+   (lib "class.ss")
+   (lib "interface.ss" "mrlib" "private" "aligned-pasteboard")
+   (lib "debug.ss" "mike-lib")
+   (lib "list.ss")
+   (lib "match.ss")
+   (prefix a: "alignment.ss")
+   (lib "click-forwarding-editor.ss" "mrlib")
+   (lib "snip-lib.ss" "mrlib" "private" "aligned-pasteboard")
+   (lib "aligned-pasteboard.ss" "embedded-gui")
+   (lib "stretchable-editor-snip.ss" "embedded-gui"))
+  
+  (define f (new frame% (label "f") (width 400) (height 400)))
+  (define e (new text%))
+  (define c (new editor-canvas% (editor e) (parent f)))
+  (define pb (new aligned-pasteboard%))
+  (define es (new editor-snip% (editor pb)))
+  (define ses (new (stretchable-editor-snip-mixin editor-snip%)
+                   (editor (new text%))))
+  (send* pb
+    (add (new (stretchable-editor-snip-mixin editor-snip%)
+              (editor (new text%))))
+    (add (make-object string-snip% "This snip is very long")))
+  (send e insert es)
+  (send f show true)
+  )
\ No newline at end of file
diff --git a/collects/embedded-gui/private/tests/unaligned-childless-redux.ss b/collects/embedded-gui/private/tests/unaligned-childless-redux.ss
new file mode 100644
index 00000000..7db231f7
--- /dev/null
+++ b/collects/embedded-gui/private/tests/unaligned-childless-redux.ss
@@ -0,0 +1,20 @@
+(require (lib "aligned-pasteboard.ss" "embedded-gui")
+         (lib "debug.ss" "mike-lib"))
+
+(define f (new frame% (label "f") (width 100) (height 100)))
+(define e (new text%))
+(define c (new editor-canvas% (parent f) (editor e)))
+(define main (new aligned-pasteboard%))
+(define j (new editor-snip% (editor main)))
+(define line (new horizontal-alignment% (parent main)))
+(send e insert j)
+(zero? (send line get-min-width))
+(send line add (make-object string-snip% "foo"))
+(send line add (make-object string-snip% "foo"))
+(send f show #t)
+;; If the following test case is delayed it's true.
+;; is this a problem? It could be if this attempt
+;; to read the min-width when aligning. However, this
+;; program prints out foofoo like it should and doesn't
+;; overlap them so maybe we're okay.
+(not (zero? (send line get-min-width)))
diff --git a/collects/embedded-gui/private/verthoriz-alignment.ss b/collects/embedded-gui/private/verthoriz-alignment.ss
new file mode 100644
index 00000000..eaeeab00
--- /dev/null
+++ b/collects/embedded-gui/private/verthoriz-alignment.ss
@@ -0,0 +1,130 @@
+(module verthoriz-alignment mzscheme
+  
+  (require
+   (lib "class.ss")
+   (lib "mred.ss" "mred")
+   (lib "etc.ss")
+   (lib "list.ss")
+   (lib "match.ss")
+   (prefix a: "alignment.ss")
+   
+   "snip-lib.ss"
+   "interface.ss"
+   "alignment-helpers.ss")
+   
+  (provide
+   horizontal-alignment%
+   vertical-alignment%)
+  
+  (define (vert/horiz-alignment type)
+    (class* object% (alignment<%>)
+      
+      (init-field (parent false))
+      
+      (field
+       [pasteboard false]
+       [children empty]
+       [min-width 0]
+       [min-height 0]
+       [show? true])
+      
+      ;; need base class for this method
+      (define (show/hide-child child show?)
+        (if (is-a? child alignment<%>)
+            (send child show show?)
+            (if show?
+                (send pasteboard insert child)
+                (send pasteboard release-snip child))))
+      
+      ;; STATUS: This function (through lock-alignment false) invokes a call
+      ;; to realign of the pasteboard even when this alignement has show? = false
+      ;; so the call is not needed.
+      (define/public (add child)
+        (set! children (append children (list child)))
+        (send pasteboard lock-alignment true)
+        (cond
+          [(is-a? child snip%)
+           (when show?
+             (send pasteboard insert child false))]
+          [(is-a? child alignment<%>)
+           (send child set-pasteboard pasteboard)])
+        (send pasteboard lock-alignment false))
+      
+      (define/public (get-min-width)
+        (if show? min-width 0))
+      (define/public (get-min-height)
+        (if show? min-height 0))
+      (define/public (set-pasteboard pb) (set! pasteboard pb))
+      (define/public (stretchable-width?) true)
+      (define/public (stretchable-height?) true)
+      (define/public (show bool)
+        (unless (boolean=? bool show?)
+          (set! show? bool)
+          (send pasteboard lock-alignment true)
+          (for-each (lambda (c)
+                      (show/hide-child c bool))
+                    children)
+          (send pasteboard lock-alignment false)))
+      
+      (define/public (align x-offset y-offset width height)
+          
+          (define move/resize
+            (match-lambda*
+              [(child ($ a:rect
+                         ($ a:dim x w stretchable-width?)
+                         ($ a:dim y h stretchable-height?)))
+               (let ([global-x (+ x x-offset)]
+                     [global-y (+ y y-offset)])
+                 (cond
+                   [(is-a? child snip%)
+                    (send pasteboard move-to child global-x global-y)
+                    (when (or stretchable-width? stretchable-height?)
+                      (send child stretch w h))]
+                   [(is-a? child alignment<%>)
+                    (send child align global-x global-y w h)]))]))
+          
+          (when (and show? (not (empty? children)))
+            (for-each move/resize
+                      children
+                      (a:align type width height
+                               (map build-rect children)))))
+      
+      (define/public (set-min-sizes)
+        (when show?
+          (for-each
+           (lambda (child)
+             (when (is-a? child alignment<%>)
+               (send child set-min-sizes)))
+           children)
+          (let-values ([(x-accum y-accum)
+                        (if (symbol=? type 'vertical)
+                            (values vacuous-max +)
+                            (values + vacuous-max))])
+            (set! min-width
+                  (apply x-accum
+                         (map child-width
+                              children)))
+            (set! min-height
+                  (apply y-accum
+                         (map child-height
+                              children))))))
+      
+      (super-new)
+      (when parent (send parent add this))))
+  
+  (define vertical-alignment% (vert/horiz-alignment 'vertical))
+  (define horizontal-alignment% (vert/horiz-alignment 'horizontal))
+  
+  ;; build-rect ((is-a?/c snip%) . -> . rect?)
+  ;; makes a new default rect out of a snip
+  (define (build-rect item)
+    (cond
+      [(is-a? item snip%)
+       (a:make-rect
+        (a:make-dim 0 (snip-min-width item) (stretchable-width? item))
+        (a:make-dim 0 (snip-min-height item) (stretchable-height? item)))]
+      [(is-a? item alignment<%>)
+       (a:make-rect
+        (a:make-dim 0 (send item get-min-width) (send item stretchable-width?))
+        (a:make-dim 0 (send item get-min-height) (send item stretchable-height?)))]))
+  )