From 8378b742c7f3cd2e45654d074954f1f55e5483c0 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 17 Feb 2012 10:20:59 -0500
Subject: [PATCH] Remove guibuilder.  See mred-designer on planet for a
 maintained alterative.

---
 collects/guibuilder/base.rkt            | 583 ----------------------
 collects/guibuilder/button.xpm          |  22 -
 collects/guibuilder/canvas.rkt          | 154 ------
 collects/guibuilder/canvas.xpm          |  22 -
 collects/guibuilder/checkbox.xpm        |  22 -
 collects/guibuilder/choice.xpm          |  25 -
 collects/guibuilder/doc.txt             |  12 -
 collects/guibuilder/feature.rkt         | 352 -------------
 collects/guibuilder/gauge.xpm           |  26 -
 collects/guibuilder/guibuilder.rkt      | 100 ----
 collects/guibuilder/help.mre            |   1 -
 collects/guibuilder/hpanel.xpm          |  22 -
 collects/guibuilder/info.rkt            |   4 -
 collects/guibuilder/list.xpm            |  22 -
 collects/guibuilder/mcanvas.xpm         |  22 -
 collects/guibuilder/message.xpm         |  21 -
 collects/guibuilder/multiple-choice.rkt | 269 ----------
 collects/guibuilder/panel.rkt           | 157 ------
 collects/guibuilder/radiobox.xpm        |  23 -
 collects/guibuilder/readable.rkt        |  54 --
 collects/guibuilder/simple-control.rkt  | 101 ----
 collects/guibuilder/slider-guage.rkt    | 192 -------
 collects/guibuilder/slider.xpm          |  26 -
 collects/guibuilder/text-field.rkt      | 135 -----
 collects/guibuilder/text.xpm            |  22 -
 collects/guibuilder/tool.rkt            |  76 ---
 collects/guibuilder/toolbar.rkt         | 159 ------
 collects/guibuilder/top-level.rkt       | 633 ------------------------
 collects/guibuilder/utils.rkt           | 101 ----
 collects/guibuilder/vpanel.xpm          |  22 -
 30 files changed, 3380 deletions(-)
 delete mode 100644 collects/guibuilder/base.rkt
 delete mode 100644 collects/guibuilder/button.xpm
 delete mode 100644 collects/guibuilder/canvas.rkt
 delete mode 100644 collects/guibuilder/canvas.xpm
 delete mode 100644 collects/guibuilder/checkbox.xpm
 delete mode 100644 collects/guibuilder/choice.xpm
 delete mode 100644 collects/guibuilder/doc.txt
 delete mode 100644 collects/guibuilder/feature.rkt
 delete mode 100644 collects/guibuilder/gauge.xpm
 delete mode 100644 collects/guibuilder/guibuilder.rkt
 delete mode 100644 collects/guibuilder/help.mre
 delete mode 100644 collects/guibuilder/hpanel.xpm
 delete mode 100644 collects/guibuilder/info.rkt
 delete mode 100644 collects/guibuilder/list.xpm
 delete mode 100644 collects/guibuilder/mcanvas.xpm
 delete mode 100644 collects/guibuilder/message.xpm
 delete mode 100644 collects/guibuilder/multiple-choice.rkt
 delete mode 100644 collects/guibuilder/panel.rkt
 delete mode 100644 collects/guibuilder/radiobox.xpm
 delete mode 100644 collects/guibuilder/readable.rkt
 delete mode 100644 collects/guibuilder/simple-control.rkt
 delete mode 100644 collects/guibuilder/slider-guage.rkt
 delete mode 100644 collects/guibuilder/slider.xpm
 delete mode 100644 collects/guibuilder/text-field.rkt
 delete mode 100644 collects/guibuilder/text.xpm
 delete mode 100644 collects/guibuilder/tool.rkt
 delete mode 100644 collects/guibuilder/toolbar.rkt
 delete mode 100644 collects/guibuilder/top-level.rkt
 delete mode 100644 collects/guibuilder/utils.rkt
 delete mode 100644 collects/guibuilder/vpanel.xpm

diff --git a/collects/guibuilder/base.rkt b/collects/guibuilder/base.rkt
deleted file mode 100644
index f30c74115c..0000000000
--- a/collects/guibuilder/base.rkt
+++ /dev/null
@@ -1,583 +0,0 @@
-(module base mzscheme
-  (require (prefix mred: mred)
-           mzlib/class
-           mzlib/file
-           mzlib/pretty
-           mzlib/etc
-           mzlib/list
-           "utils.rkt")
-
-  (define GB:SNIP-VERSION 5)
-  (define MINOR-VERSION 0)
-
-  ;; Info about the output mode:
-  (define-struct output-mode (as-class? no-free-vars?))
-
-  (define gb:snip%
-    (class mred:snip% 
-      (init-field [lm 5][tm 5][rm 5][bm 5])
-      (inherit get-admin set-snipclass set-count)
-      (private-field
-	(need-recalc? #t)
-	(prev-min-w 0)
-	(prev-min-h 0))
-      (field
-       [x 0]
-       [stable-x 0]
-       [y 0]
-       [stable-y 0]
-       [w (+ lm rm)]
-       [h (+ tm bm)]
-       [spacing 3]
-       [hilited? #f])
-      (public*
-       [spacing-+
-	(lambda args
-	  (+ (apply + args)
-	     (let ([c (let loop ([l args])
-			(cond
-			 [(null? l) 0]
-			 [(zero? (car l)) (loop (cdr l))]
-			 [else (add1 (loop (cdr l)))]))])
-	       (if (positive? c)
-		   (* spacing (sub1 c))
-		   0))))])
-      (public*
-       [init-horizontal-child-alignment (lambda () 2)]
-       [init-vertical-child-alignment (lambda () 2)]
-       [init-name (lambda () (new-name "item"))]
-       [get-classname (lambda () "gb:core")]
-       [container? (lambda () #t)]
-       [init-y-stretch? (lambda () #t)]
-       [init-x-stretch? (lambda () #t)])
-      (field
-       [horizontal-child-alignment (init-horizontal-child-alignment)]
-       [vertical-child-alignment (init-vertical-child-alignment)]
-       [with-border? #f]
-       [dialog #f]
-       [name (init-name)]
-       [id #f]
-       [original-id #f]
-       [original-children-ids #f]
-       (parent #f)
-       (pb #f)
-       (children null)
-       (y-stretch? (init-y-stretch?))
-       (x-stretch? (init-x-stretch?)))
-      (public*
-       (set-id (lambda (x) (set! id x)))
-       (set-horizontal-child-alignment
-	(lambda (v) (set! horizontal-child-alignment v)))
-       (set-vertical-child-alignment
-	(lambda (v) (set! vertical-child-alignment v)))
-       (set-with-border
-	(lambda (v) (set! with-border? v)))
-
-       (get-frame%
-	(lambda ()
-	  (class mred:frame%
-	    (init-field do-on-close)
-	    (inherit show)
-	    (public*
-	      [get-kind (lambda () "Panel")]
-	      [on-main (lambda (x) x)]
-	      [find-control (lambda (tag) #f)])
-	    (super-make-object (format "~a Settings" (get-kind)) #f 200 10)
-	    (private-field
-	      [main (on-main (make-object mred:vertical-panel% this))]
-	      [name-edit (make-one-line/callback-edit main "Scheme Name:"
-						      (lambda (txt)
-							(set! name txt))
-						      name)])
-	    (field
-	      [controls (make-object mred:vertical-panel% main)])
-	    (augment*
-	     [on-close (lambda () (do-on-close))])
-	    (send controls set-alignment 'left 'center)
-	    (let* ([p (make-object mred:vertical-panel% main)]
-		   [make-sc
-		    (lambda (name set)
-		      (make-object mred:check-box% 
-				   name
-				   p
-				   (lambda (c e)
-				     (set (send c get-value))
-				     (gb-need-recalc-size))))]
-		   [xsc (make-sc "Allow Horizontal Stretching"
-				 (lambda (on?) (set! x-stretch? on?)))]
-		   [ysc (make-sc "Allow Vertical Stretching"
-				 (lambda (on?) (set! y-stretch? on?)))])
-	      (send p set-alignment 'left 'center)
-	      (send xsc set-value x-stretch?)
-	      (send ysc set-value y-stretch?)
-	      (let ([p (make-object mred:vertical-panel% p)])
-		(send p stretchable-height #f))))))
-       
-       (gb-add-child 
-	(case-lambda 
-	 [(c) (gb-add-child c (length children))]
-	 [(c pos)
-	  (set! children 
-		(let loop ([l children][p pos])
-		  (cond
-		   [(or (zero? p) (null? l)) (cons c l)]
-		   [else (cons (car l) (loop (cdr l) (sub1 p)))]))) 
-	  (when pb
-	    (send c gb-install pb this)
-	    (send pb insert c (send pb find-first-snip) x (+ y h)))
-	  (gb-need-recalc-size)]))
-       (gb-remove-child 
-	(lambda (c) 
-	  (set! children (remq c children))
-	  (gb-need-recalc-size)))
-       
-       (gb-need-recalc-size
-	(lambda ()
-	  (set! need-recalc? #t)
-	  (resized)))
-       
-       (gb-install
-	(lambda (pb-in parent-in)
-	  (set! parent parent-in)
-	  (if pb
-	      (when parent
-		(send pb set-before this parent))
-	      (set! pb pb-in))
-	  (set! id (send pb new-id))
-	  (for-each
-	   (lambda (c)
-	     (send pb insert c (send pb find-first-snip) x (+ y h))
-	     (send c gb-install pb this))
-	   children)))
-       
-       (gb-get-child-x-start
-	(lambda (mw mh w h) 
-	  0))
-       (gb-get-child-y-start
-	(lambda (mw mh w h)
-	  (if (or (= vertical-child-alignment 1)
-		  (ormap (lambda (c) (gb-y-stretch? c)) children))
-	      0
-	      (case vertical-child-alignment
-		[(2) (/ (- h mh) 2)]
-		[(3) (- h mh)]))))
-       (gb-combine-child-width (lambda (a b) (max a b)))
-       (gb-combine-child-height (lambda (a b) (spacing-+ a b)))
-       
-       (gb-compute-child-x-pos
-	(lambda (dc c w)
-	  (if (gb-x-stretch? c)
-	      0
-	      (case horizontal-child-alignment
-		[(2) (let-values ([(cw ch) (send c gb-get-min-size dc)])
-		       (/ (- w cw) 2))]
-		[(1) 0]
-		[(3) (let-values ([(cw ch) (send c gb-get-min-size dc)])
-		       (- w cw))]))))
-       (gb-compute-child-y-pos
-	(lambda (dc c h)
-	  0))
-       (gb-compute-child-width
-	(lambda (dc c w xsc dw)
-	  (if (gb-x-stretch? c)
-	      w
-	      (let-values ([(cw ch) (send c gb-get-min-size dc)])
-		cw))))
-       (gb-compute-child-height
-	(lambda (dc c h ysc dh)
-	  (let-values ([(cw ch) (send c gb-get-min-size dc)])
-	    (if (gb-y-stretch? c)
-		(+ ch (/ dh ysc))
-		ch))))
-       
-       (gb-combine-child-x-offset (lambda (a b) a))
-       (gb-combine-child-y-offset (lambda (a b) (spacing-+ a b)))
-       
-       (gb-get-min-size
-	(lambda (dc)
-	  (let loop ([lw 0][lh 0][l children])
-	    (cond
-	     [(null? l) (let* ([w (+ lw lm rm)]
-			       [h (+ lh tm bm)])
-			  (set! prev-min-h h)
-			  (values w h))]
-	     [else
-	      (let ([c (car l)])
-		(let-values ([(cw ch) (send c gb-get-min-size dc)])
-		  (loop (gb-combine-child-width lw cw) 
-			(gb-combine-child-height lh ch) 
-			(cdr l))))]))))
-       (gb-set-shape
-	(lambda (dc x-in y-in w-in h-in)
-	  (let*-values ([(xsc) (apply + (map 
-					 (lambda (c) (if (gb-x-stretch? c) 1 0))
-					 children))] 
-			[(ysc) (apply + (map 
-					 (lambda (c) (if (gb-y-stretch? c) 1 0))
-					 children))]
-			[(mw mh) (gb-get-min-size dc)]
-			[(ew eh) (values (- w-in lm rm) (- h-in tm bm))]
-			[(dw dh) (values (- w-in mw) (- h-in mh))])
-	    (let loop ([lx (+ lm x-in (gb-get-child-x-start mw mh w-in h-in))]
-		       [ly (+ tm y-in (gb-get-child-y-start mw mh w-in h-in))]
-		       [l children])
-	      (cond
-	       [(null? l) 0]
-	       [else
-		(let ([c (car l)])
-		  (let-values ([(cw ch)
-				(send c gb-set-shape dc
-				      (+ lx (gb-compute-child-x-pos dc c ew))
-				      (+ ly (gb-compute-child-y-pos dc c eh))
-				      (gb-compute-child-width dc c ew xsc dw)
-				      (gb-compute-child-height dc c eh ysc dh))])
-		    (loop (gb-combine-child-x-offset lx cw) 
-			  (gb-combine-child-y-offset ly ch) 
-			  (cdr l))))])))
-	  (unless parent
-	    (when (and pb (not (and (= w w-in) (= h h-in))))
-	      (send pb top-resized this w h w-in h-in)))
-	  (set! x x-in)
-	  (set! y y-in)
-	  (set! w w-in)
-	  (set! h h-in)
-	  (resized)
-	  (when pb
-	    (send pb move-to this x-in y-in))
-	  (values w-in h-in)))
-       
-       (find-position-<
-	(lambda (fx fy cx cy)
-	  (< fy cy)))
-       (gb-find-position
-	(lambda (fx fy)
-	  (let loop ([l children][pos 0])
-	    (if (null? l)
-		pos
-		(let*-values ([(c) (car l)]
-			      [(cx) (send c gb-get-stable-x)]
-			      [(cy) (send c gb-get-stable-y)]
-			      [(w h) (send c gb-get-size)])
-		  (if (find-position-< fx fy (+ cx w) (+ cy h))
-		      pos
-		      (loop (cdr l) (add1 pos))))))))
-       (gb-get-child-pos
-	(lambda (c)
-	  (let loop ([l children][pos 0])
-	    (cond
-	     [(null? l) pos]
-	     [(eq? (car l) c) pos]
-	     [else (loop (cdr l) (add1 pos))]))))
-       
-       (gb-get-saved-min-size
-	(lambda ()
-	  (values prev-min-w prev-min-h)))
-       
-       (gb-recalc-size
-	(lambda (dc)
-	  (if parent
-	      (send parent gb-recalc-size dc)
-	      (let-values ([(mw mh) (gb-get-min-size dc)]
-			   [(xb) (box 0)]
-			   [(yb) (box 0)])
-		(when pb 
-		  (send pb get-snip-location this xb yb #f)
-		  (send pb get-main-location this dc xb yb))
-		(gb-set-shape dc (unbox xb) (unbox yb) 
-			      (if x-stretch? (max w mw) mw)
-			      (if y-stretch? (max h mh) mh))))))
-       
-       (gb-hilite
-	(lambda (on?)
-	  (unless (eq? on? hilited?)
-	    (set! hilited? on?)
-	    (refresh))))
-       
-       (gb-get-parent
-	(lambda () parent))
-       (gb-get-children
-	(lambda () children))
-       (gb-get-size
-	(lambda () (values w h)))
-       (gb-get-x (lambda () x))
-       (gb-get-y (lambda () y))
-       (gb-get-stable-x (lambda () stable-x))
-       (gb-get-stable-y (lambda () stable-y))
-       (gb-get-position-and-size
-	(lambda () (values x y w h)))
-       
-       (gb-set-stable-position
-	(lambda ()
-	  (set! stable-x x)
-	  (set! stable-y y)))
-       
-       (gb-drag-children-along
-	(lambda (new-x new-y)
-	  (when (not (and (= x new-x) (= y new-y)))
-	    (for-each
-	     (lambda (c)
-	       (let ([cx (+ new-x (- (send c gb-get-stable-x) stable-x))]
-		     [cy (+ new-y (- (send c gb-get-stable-y) stable-y))])
-		 (send pb move-to c cx cy)
-		 (send c gb-drag-children-along cx cy)))
-	     children)
-	    (set! x new-x)
-	    (set! y new-y))))
-       
-       (gb-open-dialog
-	(lambda ()
-	  (if dialog
-	      (send dialog show #t)
-	      (let ([f (make-object (get-frame%) (lambda () (set! dialog #f)))])
-		(set! dialog f)
-		(send f show #t)))))
-       
-       (gb-reconnect-to-original-children
-	(lambda ()
-	  (if original-children-ids
-	      (let ([sl (map
-			 (lambda (id) (send pb find-snip-by-original-id id))
-			 original-children-ids)])
-		(set! original-children-ids #f)
-		(for-each
-		 (lambda (s)
-		   (when s
-		     (gb-add-child s)
-		     (send pb remove-selected s)))
-		 sl)
-		#t)
-	      #f)))
-       (gb-forget-original-id
-	(lambda ()
-	  ;; Make unique name
-	  (let ([orig-name name])
-	    (set! name #f)
-	    (let loop ([new-name orig-name])
-	      (if (send pb find-snip-by-name new-name)
-		  (loop (string-append new-name "+"))
-		  (set! name new-name))))
-	  (set! original-id #f)
-	  (set! original-children-ids #f)))
-       
-       (gb-get-instantiate-class-getter
-	(lambda ()
-	  `(,(string->symbol (string-append "get-" name "%")))))
-       (gb-get-style
-	(lambda ()
-	  (if with-border?
-	      '(border)
-	      null)))
-       (gb-local-instantiate
-	(lambda (parent mode)
-	  `(new ,(if (output-mode-as-class? mode)
-		     (gb-get-instantiate-class-getter)
-		     (gb-get-default-class))
-		[parent ,parent]
-		,@(gb-instantiate-arguments))))
-       (gb-instantiate-arguments
-	(lambda () `([style ',(gb-get-style)]
-		     [stretchable-width ,x-stretch?]
-		     [stretchable-height ,y-stretch?])))
-
-       (gb-get-default-class (lambda () 'vertical-panel%))
-       (gb-aux-instantiate
-	(lambda (mode)
-	  (if (output-mode-as-class? mode)
-	      `((public* [,(string->symbol (string-append "get-" name "%"))
-			  (lambda () ,(gb-get-default-class))]))
-	      null)))
-       (gb-instantiate
-	(lambda (parent mode)
-	  (let ([v (gb-local-instantiate parent mode)]
-		[name (string->symbol name)])
-	    `(,@(gb-aux-instantiate mode)
-	      ,(if (output-mode-as-class? mode)
-		   `(field [,name ,v])
-		   `(define ,name ,v))
-	      ,@(apply append
-		       (map (lambda (c) (send c gb-instantiate name mode)) children))))))
-
-       (draw-box
-	(lambda (dc x y w h)
-	  (let* ((xw (sub1 (+ x w)))
-		 (yh (sub1 (+ y h)))
-		 (x (add1 x))
-		 (y (add1 y)))
-	    (send dc draw-line x y xw y)
-	    (send dc draw-line xw y xw yh)
-	    (send dc draw-line x yh xw yh)
-	    (send dc draw-line x y x yh))))
-       
-       (base-setup
-	(lambda (nm xs? ys? nw nh hca vca wb? id children-ids)
-	  (set! name nm)
-	  (set! x-stretch? xs?)
-	  (set! y-stretch? ys?)
-	  (set! w nw)
-	  (set! h nh)
-	  (set! horizontal-child-alignment hca)
-	  (set! vertical-child-alignment vca)
-	  (set! with-border? wb?)
-	  (set! original-id id)
-	  (set! original-children-ids children-ids)))
-
-       [get-tagged-value
-	(lambda (tag) #f)]
-       [set-tagged-value (lambda (t v-in) (void))]
-
-	(refresh
-	 (lambda ()
-	   (let ([admin (get-admin)])
-	     (when admin
-	       (send admin needs-update this 0 0 w h)))))
-	(resized
-	 (lambda ()
-	   (let ([admin (get-admin)])
-	     (when admin
-	       (send admin resized this #t))))))
-
-      (override*
-       (get-extent
-	(lambda (dc x y wbox hbox descentbox spacebox
-		    lspacebox rspacebox)
-	  (when need-recalc?
-	    (set! need-recalc? #f)
-	    (gb-recalc-size dc))
-	  (when hbox
-	    (set-box! hbox h))
-	  (when wbox
-	    (set-box! wbox w))
-	  (when descentbox
-	    (set-box! descentbox 0))
-	  (when spacebox
-	    (set-box! spacebox 0))
-	  (when rspacebox
-	    (set-box! rspacebox 0))
-	  (when lspacebox
-	    (set-box! lspacebox 0))))
-       (draw
-	(lambda (dc x y . other)
-	  (draw-box dc x y w h)
-	  (when (or with-border? hilited?)
-	    (draw-box dc (add1 x) (add1 y) (- w 2) (- h 2)))
-	  (when (and with-border? hilited?)
-	    (draw-box dc (+ 2 x) (+ 2 y) (- w 4) (- h 4)))))
-       (copy
-	(lambda ()
-	  (let ([o (make-object (hash-table-get interface->class-table
-						(object-interface this))
-				lm tm rm bm)])
-	    (send o base-setup 
-		  name
-		  x-stretch? y-stretch? w h 
-		  horizontal-child-alignment
-		  vertical-child-alignment
-		  with-border?
-		  (or original-id id)
-		  (or original-children-ids 
-		      (and (pair? children)
-			   (map (lambda (child) (gb-id child)) children))))
-	    o)))
-       (write
-	(lambda (stream)
-	  (send stream put (string->bytes/utf-8 name))
-	  (send stream put (if x-stretch? 1 0))
-	  (send stream put (if y-stretch? 1 0))
-	  (send stream put (floor (inexact->exact w)))
-	  (send stream put (floor (inexact->exact h)))
-	  (send stream put horizontal-child-alignment)
-	  (send stream put vertical-child-alignment)
-	  (send stream put (if with-border? 1 0))
-	  (send stream put (string->bytes/utf-8 (if id id "BAD")))
-	  (stream-write-list stream (map (lambda (c) (gb-id c)) children)))))
-      (public*
-       (read
-	(lambda (stream version)
-	  (base-setup
-	   ;; name
-	   (if (>= version 3) 
-	       ((get-bytes->string version) (send stream get-bytes))
-	       name)
-	   (positive? (send stream get-exact))
-	   (positive? (send stream get-exact))
-	   (send stream get-exact) ; w
-	   (send stream get-exact) ; h
-	   (if (>= version 2) (send stream get-exact) horizontal-child-alignment) ; hca
-	   (if (>= version 2) (send stream get-exact) vertical-child-alignment) ; vca
-	   (if (>= version 2) (positive? (send stream get-exact)) #f) ; with-border?
-	   ((get-bytes->string version) (send stream get-bytes))
-	   (let ([v (stream-read-list stream version)])
-	     (if (null? v) #f v))))))
-      (override*
-       (resize 
-	(lambda (w-in h-in)
-	  (if (not parent) 
-	      (let-values ([(mw mh) (values prev-min-w prev-min-h)])
-		(if (or (and (> w-in mw) x-stretch?)
-			(and (> h-in mh) y-stretch?))
-		    (begin
-		      (when x-stretch? (set! w (max mw w-in)))
-		      (when y-stretch? (set! h (max mh h-in)))
-		      (gb-need-recalc-size)
-		      #t)
-		    #f))
-	      #f))))
-      (super-new)
-      (set-snipclass (send (mred:get-the-snip-class-list) find (get-classname)))
-      (set-count 1)))
-
-  (define gb:atomic-snip%
-    (class gb:snip%
-      (override*
-       (init-x-stretch? (lambda () #f))
-       (init-y-stretch? (lambda () #f))
-       (container? (lambda () #f)))
-      (super-new)))
-  
-  (define gb-y-stretch? (class-field-accessor gb:snip% y-stretch?))
-  (define gb-x-stretch? (class-field-accessor gb:snip% x-stretch?))
-  (define gb-id (class-field-accessor gb:snip% id))
-  (define gb-original-id (class-field-accessor gb:snip% original-id))
-  (define gb-parent (class-field-accessor gb:snip% parent))
-  (define gb-name (class-field-accessor gb:snip% name))
-  
-  (define interface->class-table (make-hash-table))
-
-  (define register-class
-    (lambda (class% classname)
-      (hash-table-put!
-       interface->class-table
-       (class->interface class%)
-       class%)
-      (let ([snipclass
-	     (make-object 
-	      (class mred:snip-class% ()
-		(inherit set-classname set-version reading-version)
-		(override*
-		  [read
-		   (lambda (stream)
-		     (let ([o (make-object class%)])
-		       (send o read stream (reading-version stream))
-		       o))])
-		(super-new)
-		(set-classname classname)
-		(set-version GB:SNIP-VERSION)))])
-	(send (mred:get-the-snip-class-list) add snipclass))))
-  
-  (register-class gb:snip% "gb:core")
-  
-  (provide gb:snip%
-	   gb:atomic-snip%
-
-	   gb-y-stretch?
-	   gb-x-stretch?
-	   gb-id
-	   gb-original-id
-	   gb-parent
-	   gb-name
-
-	   (struct output-mode (as-class? no-free-vars?))
-	   
-	   interface->class-table
-
-	   register-class))
diff --git a/collects/guibuilder/button.xpm b/collects/guibuilder/button.xpm
deleted file mode 100644
index cc931e8a84..0000000000
--- a/collects/guibuilder/button.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * button_xpm[] = {
-"16 16 3 1",
-" 	c #FFFFFFFFFFFF",
-".	c #000000000000",
-"X	c #A0A0A0A0A0A0",
-"                ",
-"                ",
-"                ",
-"                ",
-"   ..........   ",
-"  .          .  ",
-" .   XX  X X  . ",
-" .  X  X XX   . ",
-" .  X  X X X  . ",
-" .   XX  X X  . ",
-"  .          .  ",
-"   ..........   ",
-"                ",
-"                ",
-"                ",
-"                "};
diff --git a/collects/guibuilder/canvas.rkt b/collects/guibuilder/canvas.rkt
deleted file mode 100644
index 44f5b312af..0000000000
--- a/collects/guibuilder/canvas.rkt
+++ /dev/null
@@ -1,154 +0,0 @@
-(module canvas mzscheme
-  (require (prefix mred: mred)
-           mzlib/class
-           mzlib/file
-           mzlib/pretty
-           mzlib/etc
-           mzlib/list
-           "utils.rkt"
-           "base.rkt"
-           "feature.rkt")
-
-  (define gb:make-canvas-hscroll-checkable-snip%
-    (lambda (cl)
-      (class (gb:make-boolean-configure-snip% cl 'hscroll "Horizontal Scroll" #t
-					      void void)
-	(inherit get-tagged-value)
-	(public*
-	 [get-hscroll
-	  (lambda () (get-tagged-value 'hscroll))])
-	(super-new))))
-
-  (define gb:make-canvas-vscroll-checkable-snip%
-    (lambda (cl)
-      (class (gb:make-boolean-configure-snip% cl 'vscroll "Vertical Scroll" #t
-					      void void)
-	(inherit get-tagged-value)
-	(public*
-	 [get-vscroll
-	  (lambda () (get-tagged-value 'vscroll))])
-	(super-new))))
-
-  (define gb:make-sb-box-snip%
-    (lambda (cl item-kind)
-      (class cl
-	(inherit-field w h)
-	(inherit get-hscroll get-vscroll)
-	(field
-	  [sb-width 10]
-	  [canvas-min-space 15])
-	(override*
-	 [get-frame%
-	  (lambda ()
-	    (class (super get-frame%)
-	     (override*
-	      [get-kind (lambda () item-kind)])
-	     (super-new)))]
-	 [init-x-stretch? (lambda () #t)]
-	 [init-y-stretch? (lambda () #t)]
-	 [gb-get-min-size
-	  (lambda (dc)
-	    (values (+ sb-width canvas-min-space)
-		    (+ sb-width canvas-min-space)))]
-	 [draw
-	  (lambda (dc x y . other)
-	    (send dc draw-rectangle x y w h)
-	    (when (get-vscroll)
-	      (send dc draw-line 
-		    (+ x w (- sb-width)) y
-		    (+ x w (- sb-width)) (+ y h -1)))
-	    (when (get-hscroll)
-	      (send dc draw-line
-		    x (+ y h (- sb-width))
-		    (+ x w -1) (+ y h (- sb-width)))))])
-	(super-new))))
-
-  (define gb:make-canvas-snip%
-    (lambda (cl cn)
-      (class cl
-	(inherit get-hscroll get-vscroll gb-get-instantiate-class-getter)
-	(override*
-	  [gb-get-style
-	   (lambda ()
-	     (append
-	      (super gb-get-style)
-	      (cond
-	       [(and (get-hscroll) (get-vscroll)) '(hscroll vscroll)]
-	       [(get-hscroll) '(hscroll)]
-	       [(get-vscroll) '(vscroll)]
-	       [else null])))]
-	  [get-classname (lambda () cn)]
-	  [init-name (lambda () (new-name "canvas"))]
-	  
-	  [gb-get-default-class (lambda () 'canvas%)])
-	(super-new))))
-	  
-  (define gb:canvas-snip% (gb:make-canvas-snip%
-			   (gb:make-sb-box-snip%
-			    (gb:make-canvas-vscroll-checkable-snip%
-			     (gb:make-canvas-hscroll-checkable-snip%
-			      gb:atomic-snip%))
-			    "Canvas")
-			   "gb:canvas"))
-  
-  (register-class gb:canvas-snip% "gb:canvas")
-
-  (define gb:make-ecanvas-hscroll-select-snip%
-    (lambda (cl)
-      (class (gb:make-select-configure-snip% cl 'hscroll "Horizontal Scroll"
-					     '("Show" "Hide" "No Scrolling"))
-	(inherit get-tagged-value)
-	(public*
-	  [get-hscroll
-	   (lambda () (zero? (get-hscroll-val)))]
-	  [get-hscroll-val
-	   (lambda () (get-tagged-value 'hscroll))])
-	(super-new))))
-
-  (define gb:make-ecanvas-vscroll-select-snip%
-    (lambda (cl)
-      (class (gb:make-select-configure-snip% cl 'vscroll "Vertical Scroll"
-					     '("Show" "Hide" "No Scrolling"))
-	(inherit get-tagged-value)
-	(public*
-	  [get-vscroll
-	   (lambda () (zero? (get-vscroll-val)))]
-	  [get-vscroll-val
-	   (lambda () (get-tagged-value 'vscroll))])
-	(super-new))))
-
-  (define gb:make-editor-canvas-snip%
-    (lambda (cl cn)
-      (class cl
-	(inherit get-hscroll-val get-vscroll-val)
-	(override*
-	  [get-classname (lambda () cn)]
-	  [init-name (lambda () (new-name "ecanvas"))]
-	  
-	  [gb-get-default-class (lambda () 'editor-canvas%)]
-	  [gb-get-style
-	   (lambda ()
-	     (append
-	      (super gb-get-style)
-	      (case (get-hscroll-val)
-		[(0) null]
-		[(1) '(hide-hscroll)]
-		[(2) '(no-hscroll)])
-	      (case (get-vscroll-val)
-		[(0) ()]
-		[(1) '(hide-vscroll)]
-		[(2) '(no-vscroll)])))])
-	(super-new))))
-	  
-  (define gb:editor-canvas-snip% (gb:make-editor-canvas-snip%
-				 (gb:make-sb-box-snip%
-				  (gb:make-ecanvas-vscroll-select-snip%
-				   (gb:make-ecanvas-hscroll-select-snip%
-				    gb:atomic-snip%))
-				  "Editor Canvas")
-				 "gb:editor-canvas"))
-  
-  (register-class gb:editor-canvas-snip% "gb:editor-canvas")
-
-  (provide gb:canvas-snip%
-	   gb:editor-canvas-snip%))
diff --git a/collects/guibuilder/canvas.xpm b/collects/guibuilder/canvas.xpm
deleted file mode 100644
index 23190d8c73..0000000000
--- a/collects/guibuilder/canvas.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * canvas_xpm[] = {
-"16 16 3 1",
-" 	c #FFFFFFFFFFFF",
-".	c #A0A0A0A0A0A0",
-"X	c #000000000000",
-"                ",
-" .............. ",
-" . XXX      . . ",
-" .X   X     . . ",
-" .X XXXXX   . . ",
-" .X X X X   . . ",
-" . XXX  X   . . ",
-" .  XXXXX   . . ",
-" .       X  . . ",
-" .       XX . . ",
-" .       XXX. . ",
-" .       XXXX . ",
-" ........XXX... ",
-" .         XX . ",
-" ...........X.. ",
-"                "};
diff --git a/collects/guibuilder/checkbox.xpm b/collects/guibuilder/checkbox.xpm
deleted file mode 100644
index 6c7c069af4..0000000000
--- a/collects/guibuilder/checkbox.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * checkbox_xpm[] = {
-"16 16 3 1",
-" 	c #FFFFFFFFFFFF",
-".	c #000000000000",
-"X	c #A0A0A0A0A0A0",
-"                ",
-"                ",
-"                ",
-"                ",
-"                ",
-"                ",
-" ....           ",
-" .  . XXXXXXXXX ",
-" .  . XXXXXXXXX ",
-" ....           ",
-"                ",
-"                ",
-"                ",
-"                ",
-"                ",
-"                "};
diff --git a/collects/guibuilder/choice.xpm b/collects/guibuilder/choice.xpm
deleted file mode 100644
index 26f9d93b07..0000000000
--- a/collects/guibuilder/choice.xpm
+++ /dev/null
@@ -1,25 +0,0 @@
-/* XPM */
-static char *choice[] = {
-/* width height num_colors chars_per_pixel */
-"    16    16        2            1",
-/* colors */
-". c #000000",
-"# c #fefefe",
-/* pixels */
-"################",
-"################",
-"################",
-"################",
-"#.............##",
-"#.###########..#",
-"#.#.....#####..#",
-"#.##...######..#",
-"#.###.#######..#",
-"#.###########..#",
-"#..............#",
-"##.............#",
-"################",
-"################",
-"################",
-"################"
-};
diff --git a/collects/guibuilder/doc.txt b/collects/guibuilder/doc.txt
deleted file mode 100644
index c472c8cdfd..0000000000
--- a/collects/guibuilder/doc.txt
+++ /dev/null
@@ -1,12 +0,0 @@
-
-_GUI builder_
-
-To run the GUI builder, use DrRacket and select "Insert GUI"
-from the "Special" menu.
-
-Though less recommended, you can also run
-
-  (require guibuilder/guibuilder)
-
-to get a stand-alone builder. Save your files with the extension
-".gui" to ensure that they can be re-loaded later.
diff --git a/collects/guibuilder/feature.rkt b/collects/guibuilder/feature.rkt
deleted file mode 100644
index 7749f500a4..0000000000
--- a/collects/guibuilder/feature.rkt
+++ /dev/null
@@ -1,352 +0,0 @@
-(module feature mzscheme
-  (require (prefix mred: mred)
-           mzlib/class
-           mzlib/file
-           mzlib/pretty
-           mzlib/etc
-           mzlib/list
-           "base.rkt"
-           "utils.rkt")
-
-  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; Mixins for GUI features
-  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-  (define gb:make-text-label-snip%
-    (lambda (cl deflabel)
-      (class cl
-	(inherit get-style gb-need-recalc-size)
-	(override*
-	  [get-frame%
-	   (lambda ()
-	     (class (super get-frame%)
-	       (inherit-field controls)
-	       (override*
-		 [get-kind (lambda () deflabel)])
-	       (super-new)
-	       (private-field
-		 [label-buffer (make-one-line/callback-edit controls "Label:"
-							    (lambda (txt)
-							      (set! label txt)
-							      (gb-need-recalc-size))
-							    label)])))]
-	  [gb-instantiate-arguments
-	   (lambda ()
-	     `(,@(super gb-instantiate-arguments)
-	       [label ,(get-label)]))])
-	(field
-	  [label deflabel])
-	(public*
-	  [get-label
-	   (lambda ()
-	     label)]
-	  [get-label-size
-	   (lambda (dc)
-	     (let-values ([(w h d a) (send dc get-text-extent label 
-					   (send (get-style) get-font))])
-	       (values w h)))]
-	  [draw-label
-	   (lambda (dc x y)
-	     (send dc draw-text label x y))]
-	  
-	  [label-install
-	   (lambda (n)
-	     (set! label n))])
-	(override*
-	  [copy
-	   (lambda ()
-	     (let ([o (super copy)])
-	       (send o label-install label)
-	       o))]
-	  [write
-	   (lambda (stream)
-	     (super write stream)
-	     (send stream put (string->bytes/utf-8 label)))]
-	  [read
-	   (lambda (stream version)
-	     (super read stream version)
-	     (label-install ((get-bytes->string version) (send stream get-bytes))))])
-	(super-new))))
-
-  (define gb:make-callback-snip%
-    (lambda (cl)
-      (class cl
-	(inherit-field name)
-	(public*
-	  [get-callback-kinds (lambda () (list "-callback"))]
-	  [get-callback-code (lambda ()
-			       (map (lambda (x) '(lambda (w e) (void))) (get-callback-kinds)))]
-	  [get-callback-names
-	   (lambda ()
-	     (map
-	      (lambda (ct)
-		(string->symbol (string-append name ct)))
-	      (get-callback-kinds)))]
-	  [gb-get-unified-callback
-	   (lambda ()
-	     `(lambda (b e) (,(car (get-callback-names)) b e)))])
-	(override*
-	  [gb-instantiate-arguments
-	   (lambda ()
-	     `(,@(super gb-instantiate-arguments)
-	       [callback ,(gb-get-unified-callback)]))]
-	  [gb-aux-instantiate
-	   (lambda (mode)
-	     (append
-	      (if (or (output-mode-as-class? mode)
-		      (output-mode-no-free-vars? mode))
-		  (map (lambda (n c) 
-			 (if (output-mode-as-class? mode)
-			     `(public* [,n ,c])
-			     `(define ,n ,c)))
-		       (get-callback-names) (get-callback-code))
-		  null)
-	      (super gb-aux-instantiate mode)))])
-	(super-new))))
-  
-  (define gb:make-text-labelled-snip%
-    (lambda (cl deflabel)
-      (class (gb:make-text-label-snip% cl deflabel)
-	(inherit-field w h)
-	(inherit get-label-size draw-label gb-need-recalc-size)
-	(private-field
-	  [hmargin 2]
-	  [vertical-label? (init-vertical-label?)])
-	(public*
-	  [get-label-top-margin (lambda () 0)]
-	  [init-vertical-label? (lambda () #f)]
-
-	  [get-min-body-size
-	   (lambda (dc)
-	     (values 0 0))]
-	  [draw-body
-	   (lambda (dc x y w h)
-	     (void))]
-	  
-	  [labelpos-install
-	   (lambda (vert?)
-	     (set! vertical-label? vert?))])
-	(override*
-	  [get-frame%
-	   (lambda ()
-	     (class (super get-frame%)
-	       (inherit-field controls)
-	       (super-new)
-	       (private-field
-		 [direction-radio
-		  (make-object mred:radio-box% "Label Position:" '("Top" "Left")
-			       controls 
-			       (lambda (r e)
-				 (set! vertical-label? (zero? (send direction-radio get-selection)))
-				 (gb-need-recalc-size))
-			       '(horizontal))])
-	       (send direction-radio set-selection (if vertical-label? 0 1))))]
-	  [gb-get-min-size
-	   (lambda (dc)
-	     (let-values ([(x y) (get-label-size dc)]
-			  [(x2 y2) (get-min-body-size dc)]
-			  [(+x +y) (if vertical-label?
-				       (values max +)
-				       (values (lambda (a b) (+ a b hmargin)) max))])
-	       (values (+x x x2) (+y (+ y (get-label-top-margin)) y2))))]
-	  [draw
-	   (lambda (dc x y . other)
-	     (draw-label dc x (+ y (get-label-top-margin)))
-	     (let*-values ([(lw lh) (get-label-size dc)]
-			   [(dx dy) (if vertical-label?
-					(values 0 lh)
-					(values (+ lw hmargin) 0))])
-	       (with-clipping-region dc (+ x dx) (+ y dy) (- w dx) (- h dy)
-		 (lambda ()
-		   (draw-body dc (+ x dx) (+ y dy) (- w dx) (- h dy))))))]
-	  
-	  [gb-get-style
-	   (lambda ()
-	     (cons (if vertical-label?
-		       'vertical-label
-		       'horizontal-label)
-		   (super gb-get-style)))]
-
-	  [copy
-	   (lambda ()
-	     (let ([o (super copy)])
-	       (send o labelpos-install vertical-label?)
-	       o))]
-	  [write
-	   (lambda (stream)
-	     (super write stream)
-	     (send stream put (if vertical-label? 1 0)))]
-	  [read
-	   (lambda (stream version)
-	     (super read stream version)
-	     (labelpos-install (positive? (send stream get-exact))))])
-	(super-new))))
-
-
-  
-  (define gb:make-layout-snip%
-    (lambda (cl)
-      (class cl
-	(inherit gb-need-recalc-size)
-	(override*
-	  [get-frame%
-	   (lambda ()
-	     (class (super get-frame%)
-	       (inherit-field controls)
-	       (super-new)
-	       (private-field
-		 [layout-direction-radio
-		  (make-object mred:radio-box%
-			       "Layout:"
-			       '("Vertical" "Horizontal")
-			       controls 
-			       (lambda (r e)
-				 (set! vertical-layout? 
-				       (zero? (send layout-direction-radio get-selection)))
-				 (gb-need-recalc-size))
-			       '(horizontal))])
-	       (send layout-direction-radio set-selection (if vertical-layout? 0 1))))])
-	(field
-	  [vertical-layout? (init-vertical-layout?)])
-	(public*
-	  [init-vertical-layout? (lambda () #t)]
-	  [layout-install
-	   (lambda (vert?)
-	     (set! vertical-layout? vert?))])
-	(override*
-	 [gb-get-style
-	  (lambda ()
-	    (cons (if vertical-layout?
-		      'vertical
-		      'horizontal)
-		  (super gb-get-style)))]
-	 [copy
-	  (lambda ()
-	    (let ([o (super copy)])
-	      (send o layout-install vertical-layout?)
-	      o))]
-	 [write
-	  (lambda (stream)
-	    (super write stream)
-	    (send stream put (if vertical-layout? 1 0)))]
-	 [read
-	  (lambda (stream version)
-	    (super read stream version)
-	    (layout-install (positive? (send stream get-exact))))])
-	(super-new))))
-
-  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; Mixins for configuration options
-  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-  (define gb:make-configure-snip%
-    (lambda (cl tag init)
-      (class cl
-	(private-field
-	  [v init])
-	(override*
-	  [get-tagged-value
-	   (lambda (t)
-	     (if (eq? t tag)
-		 v
-		 (super get-tagged-value t)))]
-	  [set-tagged-value
-	   (lambda (t v-in)
-	     (if (eq? t tag)
-		 (set! v v-in)
-		 (super set-tagged-value t v-in)))]
-
-	  [copy
-	   (lambda ()
-	     (let ([o (super copy)])
-	       (send o set-tagged-value tag v)
-	       o))])
-	(super-new))))
-
-  (define gb:make-boolean-configure-snip%
-    (lambda (cl tag label init change-cb init-cb)
-      (class (gb:make-configure-snip% cl tag init)
-	(inherit gb-need-recalc-size get-tagged-value set-tagged-value)
-	(override*
-	  [get-frame%
-	   (lambda ()
-	     (define this-snip this)
-	     (class (super get-frame%)
-	       (inherit-field controls)
-	       (override*
-		[find-control
-		 (lambda (t)
-		   (if (eq? t tag)
-		       c
-		       (super find-control t)))])
-	       (super-new)
-	       (private-field
-		 [c (make-object mred:check-box% 
-				 label controls
-				 (lambda (c e)
-				   (set-tagged-value tag (send c get-value))
-				   (change-cb this this-snip)
-				   (gb-need-recalc-size)))])
-	       (send c set-value (get-tagged-value tag))
-	       (init-cb this this-snip)))]
-	  [write
-	   (lambda (stream)
-	     (super write stream)
-	     (send stream put (if (get-tagged-value tag) 1 0)))]
-	  [read
-	   (lambda (stream version)
-	     (super read stream version)
-	     (set-tagged-value tag (positive? (send stream get-exact))))])
-	(super-new))))
-
-  (define gb:make-multi-checkable-snip%
-    (lambda (cl)
-      (class (gb:make-boolean-configure-snip% cl 'multi "Multiple Lines" #f
-						  (lambda (f snip)
-						    (send snip multi-changed f))
-						  void)
-	 (inherit get-tagged-value)
-	 (public*
-	  [get-multi
-	   (lambda () (get-tagged-value 'multi))]
-	  [multi-changed
-	   (lambda (f)
-	     (send (send f find-control 'hscroll) enable (get-multi)))])
-	 (super-new))))
-  
-  (define gb:make-select-configure-snip%
-    (lambda (cl tag label choices)
-      (class (gb:make-configure-snip% cl tag 0)
-	(inherit gb-need-recalc-size get-tagged-value set-tagged-value)
-	(override*
-	  [get-frame%
-	   (lambda ()
-	     (class (super get-frame%)
-	       (inherit-field controls)
-	       (super-new)
-	       (private-field
-		 [c (make-object mred:choice% 
-				 label choices controls
-				 (lambda (c e)
-				   (set-tagged-value tag (send c get-selection))
-				   (gb-need-recalc-size)))])
-	       (send c set-selection (get-tagged-value tag))))]
-	  [write
-	   (lambda (stream)
-	     (super write stream)
-	     (send stream put (get-tagged-value tag)))]
-	  [read
-	   (lambda (stream version)
-	     (super read stream version)
-	     (set-tagged-value tag (send stream get-exact)))])
-	(super-new))))
-  
-  (provide gb:make-text-label-snip%
-	   gb:make-callback-snip%
-	   gb:make-text-labelled-snip%
-	   gb:make-layout-snip%
-
-	   gb:make-configure-snip%
-	   gb:make-boolean-configure-snip%
-	   gb:make-multi-checkable-snip%
-	   gb:make-select-configure-snip%))
diff --git a/collects/guibuilder/gauge.xpm b/collects/guibuilder/gauge.xpm
deleted file mode 100644
index a5e629f704..0000000000
--- a/collects/guibuilder/gauge.xpm
+++ /dev/null
@@ -1,26 +0,0 @@
-/* XPM */
-static char *gauge[] = {
-/* width height num_colors chars_per_pixel */
-"    16    16        3            1",
-/* colors */
-". c #000000",
-"# c #a0a0a0",
-"a c #ffffff",
-/* pixels */
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"a..............a",
-"a.######aaaaaa.a",
-"a.######aaaaaa.a",
-"a.######aaaaaa.a",
-"a.######aaaaaa.a",
-"a..............a",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa"
-};
diff --git a/collects/guibuilder/guibuilder.rkt b/collects/guibuilder/guibuilder.rkt
deleted file mode 100644
index 5bebee4d0a..0000000000
--- a/collects/guibuilder/guibuilder.rkt
+++ /dev/null
@@ -1,100 +0,0 @@
-(module guibuilder mzscheme
-  (require (prefix mred: mred)
-           mzlib/class
-           mzlib/file
-           mzlib/pretty
-           mzlib/etc
-           mzlib/list
-           (prefix framework: framework)
-           "utils.rkt"
-           "top-level.rkt"
-           "toolbar.rkt")
-
-  ;; These modules implement snips for the various
-  ;;  kinds of windows and controls.
-  (require "base.rkt"
-           "panel.rkt"
-           "simple-control.rkt"
-           "text-field.rkt"
-           "multiple-choice.rkt"
-           "slider-guage.rkt"
-           "canvas.rkt")
-
-  (define my-base-frame% framework:frame:editor%)
-
-  (define gb:frame%
-    (class my-base-frame% 
-      (init [file #f])
-      (inherit get-editor show get-area-container get-menu-bar)
-
-      (define gb-editor #f)
-      (define (get-gb-editor)
-	gb-editor)
-
-      (override*	
-	[get-editor% (lambda () 
-		       (class framework:text:info%
-			 (inherit insert)
-			 (super-new)
-			 (set! gb-editor (new gb:edit%))
-			 (insert (make-object mred:editor-snip% gb-editor))))])
-      
-      (define toolbar #f)
-      (public*
-	[init-tools
-	 (lambda (mb)
-	   (set! toolbar (make-object toolbar% (get-area-container)))
-	   (send (get-area-container) change-children
-		 (lambda (l)
-		   (cons toolbar (remove toolbar l))))
-	   
-	   (let* ([emenu (make-object mred:menu% "Element" mb)]
-		  [vmenu (make-object mred:menu% "Output" mb)])
-	     (make-object mred:menu-item% "Configure Selected" emenu
-			  (lambda (i e)
-			    (send (get-gb-editor)
-				  for-each-selected-snip
-				  (lambda (s)
-				    (send s gb-open-dialog)))))
-	     (make-object mred:separator-menu-item% emenu)
-	     (add-tools toolbar emenu (lambda (c%) (insert-element c%)))
-
-	     (make-object mred:menu-item% "Configure Output"  vmenu
-			  (lambda (i e) (send (get-gb-editor) open-dialog)))
-	     (make-object mred:separator-menu-item% vmenu)
-	     (make-object mred:menu-item%  "Make Sample Window" vmenu 
-			  (lambda (i e) (send (get-gb-editor) instantiate)))
-	     (make-object mred:menu-item%  "Make Source Code" vmenu 
-			  (lambda (i e) (send (get-gb-editor) view-source)))))]
-	[insert-element
-	 (lambda (c%)
-	   (let ([e (get-gb-editor)])
-	     (send e insert-element c%)))])
-
-      (super-make-object (or file "GUI Builder"))
-
-      (init-tools (get-menu-bar))
-      
-      (let ([file (and file (normalize-path file))])
-	(if (and file (file-exists? file) (send (get-gb-editor) load-file file))
-	    ;; Force title size calc:
-	    (let ([e (get-gb-editor)])
-	      (send e get-main-location 
-		    (send e get-main-panel)
-		    (send (send e get-canvas) get-dc)
-		    (box 0) (box 0)))
-	    (begin
-	      (send (get-gb-editor) create-main-panel)
-	      (when file
-		(send (get-gb-editor) set-filename file)))))
-      
-      (show #t)))
-  
-  (framework:handler:insert-format-handler "GUI Builder" "gui"
-					   (lambda (file)
-					     (make-object gb:frame% file)))
-  
-  (define (new-gui-builder-frame) (new gb:frame% [height 400]))
-					       
-
-  (new-gui-builder-frame))
diff --git a/collects/guibuilder/help.mre b/collects/guibuilder/help.mre
deleted file mode 100644
index e08669e2f1..0000000000
--- a/collects/guibuilder/help.mre
+++ /dev/null
@@ -1 +0,0 @@
-(The help document has not been written.)
diff --git a/collects/guibuilder/hpanel.xpm b/collects/guibuilder/hpanel.xpm
deleted file mode 100644
index 06c1d12b5f..0000000000
--- a/collects/guibuilder/hpanel.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * hpanel_xpm[] = {
-"16 16 3 1",
-" 	c #FFFFFFFFFFFF",
-".	c #000000000000",
-"X	c #A0A0A0A0A0A0",
-"                ",
-"                ",
-"                ",
-" .............. ",
-" .            . ",
-" .            . ",
-" .  X  XX  X  . ",
-" .  X  XX  X  . ",
-" .  X  XX  X  . ",
-" .  X  XX  X  . ",
-" .            . ",
-" .            . ",
-" .............. ",
-"                ",
-"                ",
-"                "};
diff --git a/collects/guibuilder/info.rkt b/collects/guibuilder/info.rkt
deleted file mode 100644
index 549754130b..0000000000
--- a/collects/guibuilder/info.rkt
+++ /dev/null
@@ -1,4 +0,0 @@
-#lang setup/infotab
-
-(define tools '(("tool.rkt")))
-(define tool-names '("GUI Builder"))
diff --git a/collects/guibuilder/list.xpm b/collects/guibuilder/list.xpm
deleted file mode 100644
index 1e2f1c089a..0000000000
--- a/collects/guibuilder/list.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * list_xpm[] = {
-"16 16 3 1",
-" 	c #FFFFFFFFFFFF",
-".	c #000000000000",
-"X	c #A0A0A0A0A0A0",
-"                ",
-"                ",
-"  ............  ",
-"  .        . .  ",
-"  .  XXXX  . .  ",
-"  .        . .  ",
-"  .  XXXX  . .  ",
-"  .        . .  ",
-"  .  XXXX  . .  ",
-"  .        . .  ",
-"  .  XXXX  . .  ",
-"  .        . .  ",
-"  .        . .  ",
-"  ............  ",
-"                ",
-"                "};
diff --git a/collects/guibuilder/mcanvas.xpm b/collects/guibuilder/mcanvas.xpm
deleted file mode 100644
index 3884e01d2d..0000000000
--- a/collects/guibuilder/mcanvas.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * mcanvas_xpm[] = {
-"16 16 3 1",
-" 	c #FFFFFFFFFFFF",
-".	c #A0A0A0A0A0A0",
-"X	c #000000000000",
-"                ",
-" .............. ",
-" .          . . ",
-" . XXXXX X X. . ",
-" . X X X  X . . ",
-" .   X    X . . ",
-" .   X    X . . ",
-" .  XXX   X . . ",
-" .        X . . ",
-" .        X . . ",
-" .       X X. . ",
-" .          . . ",
-" .............. ",
-" .          . . ",
-" .............. ",
-"                "};
diff --git a/collects/guibuilder/message.xpm b/collects/guibuilder/message.xpm
deleted file mode 100644
index a9deeccb27..0000000000
--- a/collects/guibuilder/message.xpm
+++ /dev/null
@@ -1,21 +0,0 @@
-/* XPM */
-static char * message_xpm[] = {
-"16 16 2 1",
-" 	c #FFFFFFFFFFFF",
-".	c #000000000000",
-"                ",
-"                ",
-"                ",
-"                ",
-"                ",
-"     ......     ",
-"     . .. .     ",
-"       ..       ",
-"       ..       ",
-"       ..       ",
-"      ....      ",
-"                ",
-"                ",
-"                ",
-"                ",
-"                "};
diff --git a/collects/guibuilder/multiple-choice.rkt b/collects/guibuilder/multiple-choice.rkt
deleted file mode 100644
index 2fa254b52e..0000000000
--- a/collects/guibuilder/multiple-choice.rkt
+++ /dev/null
@@ -1,269 +0,0 @@
-(module multiple-choice mzscheme
-  (require (prefix mred: mred)
-           mzlib/class
-           mzlib/file
-           mzlib/pretty
-           mzlib/etc
-           mzlib/list
-           "utils.rkt"
-           "base.rkt"
-           "feature.rkt")
-
-  (define gb:make-item-list-snip%
-    (lambda (cl)
-      (class cl
-	(inherit gb-need-recalc-size)
-	(private*
-	  [delete
-	   (lambda (l p)
-	     (let loop ([l l][p p])
-	       (cond
-		 [(null? l) l]
-		 [(zero? p) (cdr l)]
-		 [else (cons (car l) (loop (cdr l) (sub1 p)))])))])
-	(public*
-	  [get-items
-	   (lambda ()
-	     items)]
-	  [init-items (lambda () null)]
-	  [get-item-height
-	   (lambda (dc)
-	     (let-values ([(w h d a) (send dc get-text-extent "Xj")])
-	       h))]
-	  [get-max-item-width
-	   (lambda (dc)
-	     (let loop ([l items][mw 0])
-	       (if (null? l)
-		   mw
-		   (let-values ([(w h d a) (send dc get-text-extent (car l))])
-		     (loop (cdr l) (max mw w))))))]
-	  
-	  [items-install
-	   (lambda (l)
-	     (set! items l))])
-	(override*
-	 [get-frame%
-	  (lambda ()
-	    (class (super get-frame%)
-	      (inherit-field controls)
-	      (super-new)
-	      (public*
-	       [user-item (lambda (v)
-			    (mred:get-text-from-user "Item name:" "List Item Name" #f v))])
-	      (private-field
-		[items-panel (make-object mred:vertical-panel% controls)]
-		[items-list (make-object mred:list-box%
-					 "Items:" 
-					 items
-					 items-panel 
-					 (lambda (l e)
-					   (when (eq? 'list-box-dclick (send e get-event-type))
-					     (let ([pos (send items-list get-selection)])
-					       (unless (negative? pos)
-						 (let ([v (user-item (list-ref items pos))])
-						   (when v
-						     (send items-list set-string pos v)
-                                                     (set! items (let loop ([items items][pos pos])
-                                                                   (if (zero? pos)
-                                                                       (cons v (cdr items))
-                                                                       (cons (car items)
-                                                                             (loop (cdr items) (sub1 pos))))))
-						     (gb-need-recalc-size))))))))]
-		[item-buttons-panel (let ([v (make-object mred:horizontal-panel% items-panel)])
-				      (send v stretchable-width #f)
-				      v)]
-		[add-item (make-object mred:button% "Add Item" item-buttons-panel
-				       (lambda (b e)
-					 (let ([v (user-item (format 
-							      "Item~a" 
-							      (send items-list get-number)))])
-					   (when v
-					     (send items-list append v)
-					     (set! items (append items (list v)))
-					     (gb-need-recalc-size)))))]
-		[delete-item (make-object mred:button% "Delete Item" item-buttons-panel
-					  (lambda (b e)
-					    (let loop ([ls (reverse (send items-list get-selections))])
-					      (unless (null? ls)
-						(send items-list delete (car ls))
-						(set! items (delete items (car ls)))
-						(loop (cdr ls))))
-					    (gb-need-recalc-size)))])))]
-	  [gb-instantiate-arguments
-	   (lambda ()
-	     (cons
-	      `[choices ',(get-items)]
-	      (super gb-instantiate-arguments)))]
-	  [copy
-	   (lambda ()
-	     (let ([o (super copy)])
-	       (send o items-install items)
-	       o))]
-	  [write
-	   (lambda (stream)
-	     (super write stream)
-	     (stream-write-list stream items))]
-	  [read
-	   (lambda (stream version)
-	     (super read stream version)
-	     (items-install (stream-read-list stream version)))])
-	(private-field
-	  [items (init-items)])
-	(super-new))))
-   
-  (define gb:make-list-box-snip%
-    (lambda (cl cn)
-      (class cl
-	(inherit-field w h)
-	(inherit get-callback-names get-items get-item-height)
-	(field
-	  [min-body-width 50]
-	  [sb-width 10]
-	  [min-item-count 3])
-	(override*
-	  [get-classname (lambda () cn)]
-	  [init-name (lambda () (new-name "listbox"))]
-	  [init-y-stretch? (lambda () #t)]
-	  [init-x-stretch? (lambda () #t)]
-	  [get-min-body-size
-	   (lambda (dc)
-	     (let ([y (get-item-height dc)])
-	       (values min-body-width (* min-item-count y))))]
-	  [draw-body
-	   (lambda (dc x y w h)
-	     (send dc draw-rectangle x y w h)
-	     (send dc draw-line 
-		   (+ w x (- sb-width)) y
-		   (+ w x (- sb-width)) (+ y h))
-	     (with-clipping-region 
-	      dc x y (- w sb-width) h
-	      (lambda ()
-		(let ([ih (get-item-height dc)])
-		  (let loop ([l (get-items)][iy (add1 y)])
-		    (unless (or (>= iy (+ y h)) (null? l))
-		      (send dc draw-text (car l) (+ 2 x) iy)
-		      (loop (cdr l) (+ iy ih))))))))]
-	  [get-callback-kinds (lambda ()
-				(list "-select-callback" "-double-select-callback"))]
-	  [gb-get-default-class (lambda () 'list-box%)]
-	  [gb-get-style
-	   (lambda ()
-	     (cons 'single
-		   (super gb-get-style)))]
-	  [gb-get-unified-callback
-	   (lambda ()
-	     (let-values ([(sel dbl) (apply values (get-callback-names))])
-	       `(lambda (b e) 
-		  (case (send e get-event-type)
-		    [(list-box) (,sel b e)]
-		    [(list-box-dclick) (,dbl b e)]))))])
-	(super-new))))
-  
-  
-  (define gb:list-box-snip% (gb:make-list-box-snip%
-			     (gb:make-item-list-snip%
-			      (gb:make-callback-snip%
-			       (gb:make-text-labelled-snip% gb:atomic-snip% 
-							    "List")))
-			     "gb:listbox"))
-  
-  (register-class gb:list-box-snip% "gb:listbox")
-  
-  
-  (define gb:make-radio-box-snip%
-    (lambda (cl cn)
-      (class cl
-	(inherit-field w h vertical-layout?)
-	(inherit get-item-height get-max-item-width get-items
-		 gb-need-recalc-size)
-	(private-field
-	  [circle-size 10]
-	  [margin 2])
-	(override*
-	  [get-classname (lambda () cn)]
-	  [init-name (lambda () (new-name "radiobox"))]
-	  [init-items (lambda () (list "First" "Second"))]
-	  [get-min-body-size
-	   (lambda (dc)
-	     (let ([h (max (get-item-height dc) circle-size)]
-		   [w (get-max-item-width dc)]
-		   [l (length (get-items))])
-	       (let-values ([(x-l y-l) (if vertical-layout?
-					   (values 1 l)
-					   (values l 1))])
-		 (values (* (+ circle-size margin w) x-l)
-			 (* h y-l)))))]
-	  [draw-body
-	   (lambda (dc x y w h)
-	     (let ([ih (max (get-item-height dc) circle-size)]
-		   [iw (+ (get-max-item-width dc) circle-size margin)])
-	       (let loop ([l (get-items)][iy y][ix x])
-		 (unless (null? l)
-		   (send dc draw-ellipse ix (+ iy (/ (- ih circle-size) 2)) circle-size circle-size)
-		   (send dc draw-text (car l) (+ circle-size margin ix) iy)
-		   (if vertical-layout?
-		       (loop (cdr l) (+ iy ih) ix)
-		       (loop (cdr l) iy (+ ix iw)))))))]
-	  [gb-get-default-class (lambda () 'radio-box%)])
-	(super-new))))
-  
-  
-  (define gb:radio-box-snip% (gb:make-radio-box-snip%
-			      (gb:make-item-list-snip%
-			       (gb:make-layout-snip%
-				(gb:make-callback-snip%
-				 (gb:make-text-labelled-snip% gb:atomic-snip% 
-							      "Radiobox"))))
-			      "gb:radiobox"))
-  
-  (register-class gb:radio-box-snip% "gb:radiobox")
-  
-  
-  (define gb:make-choice-snip%
-    (lambda (cl cn)
-      (class cl
-	(inherit-field w h)
-	(inherit get-item-height get-max-item-width get-items
-		 gb-need-recalc-size)
-	(field
-	  [arrow-size 10]
-	  [lmargin 2]
-	  [amargin 2]
-	  [rmargin 2]
-	  [arrow (list (make-object mred:point% 0 0)
-		       (make-object mred:point% arrow-size 0)
-		       (make-object mred:point% (quotient arrow-size 2) (quotient arrow-size 2)))])
-	(override*
-	  [get-classname (lambda () cn)]
-	  [init-name (lambda () (new-name "choice"))]
-	  [init-items (lambda () (list "First"))]
-	  [get-min-body-size
-	   (lambda (dc)
-	     (let ([h (get-item-height dc)]
-		   [w (get-max-item-width dc)])
-	       (values (+ lmargin arrow-size amargin w rmargin 3) (+ 3 h))))]
-	  [draw-body
-	   (lambda (dc x y w h)
-	     (send dc draw-rectangle x y (sub1 w) (sub1 h))
-	     (send dc draw-line (sub1 (+ x w)) (add1 y) (sub1 (+ x w)) (+ y h))
-	     (send dc draw-line (add1 x) (sub1 (+ y h)) (+ x w) (sub1 (+ y h)))
-	     (send dc draw-polygon arrow (+ 1 lmargin x) (+ y (/ (- h (/ arrow-size 2)) 2)))
-	     (let ([l (get-items)])
-	       (unless (null? l)
-		 (send dc draw-text (car l) (+ 1 lmargin arrow-size amargin x) (add1 y)))))]
-	  [gb-get-default-class (lambda () 'choice%)])
-	(super-new))))
-  
-  
-  (define gb:choice-snip% (gb:make-choice-snip%
-			   (gb:make-item-list-snip%
-			    (gb:make-callback-snip%
-			     (gb:make-text-labelled-snip% gb:atomic-snip% 
-							  "Choice")))
-			   "gb:choice"))
-  
-  (register-class gb:choice-snip% "gb:choice")
-  
-  (provide gb:list-box-snip%
-	   gb:radio-box-snip%
-	   gb:choice-snip%))
diff --git a/collects/guibuilder/panel.rkt b/collects/guibuilder/panel.rkt
deleted file mode 100644
index ddcf2a1f48..0000000000
--- a/collects/guibuilder/panel.rkt
+++ /dev/null
@@ -1,157 +0,0 @@
-(module panel mzscheme
-  (require (prefix mred: mred)
-           mzlib/class
-           mzlib/file
-           mzlib/pretty
-           mzlib/etc
-           mzlib/list
-           "utils.rkt"
-           "base.rkt")
-
-  (define gb:make-panel-params-snip%
-    (lambda (cl)
-      (class cl
-	(inherit-field horizontal-child-alignment
-		       vertical-child-alignment
-		       with-border?)
-	(inherit set-horizontal-child-alignment
-		 set-vertical-child-alignment
-		 set-with-border
-		 gb-need-recalc-size)
-	(override*
-	 [get-frame%
-	  (lambda ()
-	    (class (super get-frame%)
-	      (inherit-field controls)
-	      (super-new)
-	      (field
-		[hca-choice
-		 (make-object mred:choice%
-			      "Horizontal Align Children:"
-			      '("Left" "Center" "Right")
-			      controls 
-			      (lambda (r e)
-				(set-horizontal-child-alignment
-				 (add1 (send r get-selection)))
-				(gb-need-recalc-size)))]
-		[vca-choice
-		 (make-object mred:choice% 
-			      "Vertical Align Children:"
-			      '("Top" "Center" "Bottom")
-			      controls 
-			      (lambda (r e)
-				(set-vertical-child-alignment
-				 (add1 (send r get-selection)))
-				(gb-need-recalc-size)))]
-		[border-check
-		 (make-object mred:check-box%
-			      "Show Border" controls
-			      (lambda (c e)
-				(set-with-border (send c get-value))
-				(gb-need-recalc-size)))])
-	      (send hca-choice stretchable-width #f)
-	      (send hca-choice set-selection (sub1 horizontal-child-alignment))
-	      (send vca-choice stretchable-width #f)
-	      (send vca-choice set-selection (sub1 vertical-child-alignment))
-	      (send border-check set-value with-border?)))])
-	(private*
-	  [symbol-append
-	   (lambda (a b) (string->symbol (string-append (symbol->string a) (symbol->string b))))])
-	(override*
-	 [gb-instantiate-arguments
-	  (lambda ()
-	    `(,@(super gb-instantiate-arguments)
-	      [alignment '(,(case horizontal-child-alignment
-			      [(1) 'left]
-			      [(2) 'center]
-			      [(3) 'right])
-			   ,(case horizontal-child-alignment
-			      [(1) 'top]
-			      [(2) 'center]
-			      [(3) 'bottom]))]))])
-	(super-new))))
-
-  (define gb:vertical-panel-snip% 
-    (class (gb:make-panel-params-snip% gb:snip%)
-      (override*
-	[get-classname (lambda () "gb:vertical-panel")]
-	[init-name (lambda () (new-name "vpanel"))])
-      (super-new)))
-  
-  (register-class gb:vertical-panel-snip% "gb:vertical-panel")
-
-  ; Used by top-level panel:
-  (define gb:panel-snip%
-    (class gb:vertical-panel-snip%
-      (override*
-	[get-classname (lambda () "gb:panel")])
-      (super-new)))
-  
-  (register-class gb:panel-snip% "gb:panel")
-  
-  (define gb:horizontal-panel-snip%
-    (class (gb:make-panel-params-snip% gb:snip%)
-      (inherit-field horizontal-child-alignment vertical-child-alignment
-		     children)
-      (inherit spacing-+)
-      (override*
-	[get-classname (lambda () "gb:horizontal-panel")]
-	[init-name (lambda () (new-name "hpanel"))]
-	
-	(gb-get-child-x-start
-	 (lambda (mw mh w h)
-	   (if (or (= horizontal-child-alignment 1)
-		   (ormap (lambda (c) (gb-x-stretch? c)) children))
-	       0
-	       (case horizontal-child-alignment
-		 [(2) (/ (- w mw) 2)]
-		 [(3) (- w mw)]))))
-	(gb-get-child-y-start
-	 (lambda (mw mh w h) 
-	   0))
-
-	(gb-combine-child-width (lambda (a b) (spacing-+ a b)))
-	(gb-combine-child-height (lambda (a b) (max a b)))
-	
-	(gb-compute-child-x-pos
-	 (lambda (dc c w)
-	   0))
-	(gb-compute-child-y-pos
-	 (lambda (dc c h)
-	   (if (gb-y-stretch? c)
-	       0
-	       (case vertical-child-alignment
-		 [(2) (let-values ([(cw ch) (send c gb-get-min-size dc)])
-			 (/ (- h ch) 2))]
-		 [(1) 0]
-		 [(3) (let-values ([(cw ch) (send c gb-get-min-size dc)])
-			 (- h ch))]))))
-	(gb-compute-child-width
-	 (lambda (dc c w xsc dw)
-	   (let-values ([(cw ch) (send c gb-get-min-size dc)])
-	     (if (gb-x-stretch? c)
-		 (+ cw (/ dw xsc))
-		 cw))))
-	(gb-compute-child-height
-	 (lambda (dc c h ysc dh)
-	   (if (gb-y-stretch? c)
-	       h
-	       (let-values ([(cw ch) (send c gb-get-min-size dc)])
-		 ch))))
-	
-	(gb-combine-child-x-offset (lambda (a b) (spacing-+ a b)))
-	(gb-combine-child-y-offset (lambda (a b) a))
-	
-	(find-position-<
-	 (lambda (fx fy cx cy)
-	   (< fx cx)))
-	
-	[gb-get-default-class (lambda () 'horizontal-panel%)])
-      (super-new)))
-
-  (register-class gb:horizontal-panel-snip% "gb:horizontal-panel")
-
-  (provide gb:make-panel-params-snip%
-	   gb:vertical-panel-snip% 
-	   gb:panel-snip%
-	   gb:horizontal-panel-snip%))
diff --git a/collects/guibuilder/radiobox.xpm b/collects/guibuilder/radiobox.xpm
deleted file mode 100644
index a1d40da9a2..0000000000
--- a/collects/guibuilder/radiobox.xpm
+++ /dev/null
@@ -1,23 +0,0 @@
-/* XPM */
-static char * radiobox_xpm[] = {
-"16 16 4 1",
-" 	c #FFFFFFFFFFFF",
-".	c #000000000000",
-"X	c #A0A0A0A0A0A0",
-"o	c #A0A0A0A0A0A0",
-"                ",
-"                ",
-"                ",
-"  ..            ",
-" .XX. ooooooooo ",
-" .XX. ooooooooo ",
-"  ..            ",
-"                ",
-"                ",
-"  ..            ",
-" .  . ooooooooo ",
-" .  . ooooooooo ",
-"  ..            ",
-"                ",
-"                ",
-"                "};
diff --git a/collects/guibuilder/readable.rkt b/collects/guibuilder/readable.rkt
deleted file mode 100644
index 166b33c0e4..0000000000
--- a/collects/guibuilder/readable.rkt
+++ /dev/null
@@ -1,54 +0,0 @@
-(module readable mzscheme
-  (require mred
-           mzlib/class
-           "top-level.rkt"
-           "toolbar.rkt")
-
-  (define gui-snip-class%
-    (class snip-class%
-      (inherit set-classname set-version)
-
-      (define/override (read f)
-	(let ([e (make-object gb:edit%)])
-	  (send e prepare-to-load)
-	  (send e read-from-file f)
-	  (send e done-loading #t)
-	  (make-object gui-code-snip% e)))
-
-      (super-new)
-      (set-classname "(lib \"readable.ss\" \"guibuilder\")")
-      (set-version 1)))
-
-  (define gui-snip-class (new gui-snip-class%))
-
-  (send (get-the-snip-class-list) add gui-snip-class)
-
-
-  (define gui-code-snip%
-    (class* editor-snip% (readable-snip<%>)
-      (inherit get-editor set-min-width set-min-height set-snipclass get-admin)
-
-      (define/public (read-special source line column position)
-	(send (get-editor) build-code #f #f))
-
-      (define/override (write f)
-	(send (get-editor) write-to-file f))
-      (define/override (copy)
-	(make-object gui-code-snip% (send (get-editor) copy-self)))
-
-      (define/override (on-event dc x y editorx editory e)
-	(if (send e button-down? 'right)
-	    (let ([tool-menu (make-object popup-menu%)])
-	      (add-tools #f tool-menu (lambda (c%)
-					(send (get-editor) insert-element c%)))
-	      (send (get-admin) popup-menu 
-		    tool-menu this 
-		    (- (send e get-x) x)
-		    (- (send e get-y) y)))
-	    (super on-event dc x y editorx editory e)))
-
-      (super-new)
-      (set-snipclass gui-snip-class)))
-
-  (provide gui-code-snip%
-           (rename gui-snip-class snip-class)))
diff --git a/collects/guibuilder/simple-control.rkt b/collects/guibuilder/simple-control.rkt
deleted file mode 100644
index cf21d4774f..0000000000
--- a/collects/guibuilder/simple-control.rkt
+++ /dev/null
@@ -1,101 +0,0 @@
-(module simple-control mzscheme
-  (require (prefix mred: mred)
-           mzlib/class
-           mzlib/file
-           mzlib/pretty
-           mzlib/etc
-           mzlib/list
-           "utils.rkt"
-           "base.rkt"
-           "feature.rkt")
-
-  (define gb:make-message-snip%
-    (lambda (cl cn)
-      (class cl
-	(inherit-field w h)
-	(inherit get-label get-label-size draw-label)
-	(override*
-	  [get-classname (lambda () cn)]
-	  [init-name (lambda () (new-name "message"))]
-	  [gb-get-min-size
-	   (lambda (dc)
-	     (get-label-size dc))]
-	  [draw
-	   (lambda (dc x y . other)
-	     (draw-label dc x y))]
-	  [gb-get-default-class (lambda () 'message%)])
-	(super-new))))
-  
-  (define gb:message-snip% (gb:make-message-snip%
-			    (gb:make-text-label-snip% gb:atomic-snip% 
-						      "Message")
-			    "gb:message"))
-  
-  (register-class gb:message-snip% "gb:message")
-  
-  (define gb:make-button-snip%
-    (lambda (cl cn)
-      (class cl
-	(inherit-field w h)
-	(inherit get-label get-label-size get-callback-names draw-label)
-	(private-field
-	  [m 5])
-	(override*
-	  [get-classname (lambda () cn)]
-	  [init-name (lambda () (new-name "button"))]
-	  [gb-get-min-size
-	   (lambda (dc)
-	     (let-values ([(x y) (get-label-size dc)])
-	       (values (+ (* 2 m) x) (+ (* 2 m) y))))]
-	  [draw
-	   (lambda (dc x y . other)
-	     (send dc draw-rounded-rectangle x y w h 3)
-	     (let-values ([(lw lh) (get-label-size dc)])
-	       (draw-label dc 
-			   (+ (+ x m) (/ (- w lw (* 2 m)) 2))
-			   (+ (+ y m) (/ (- h lh (* 2 m)) 2)))))]
-	  [gb-get-default-class (lambda () 'button%)])
-	(super-new))))
-  
-  (define gb:make-check-box-snip%
-    (lambda (cl cn)
-      (class cl
-	(inherit-field w h)
-	(inherit get-style get-label get-callback-names get-label-size draw-label)
-	(private-field
-	  [hspace 2]
-	  [boxsize 12])
-	(override*
-	  [get-classname (lambda () cn)]
-	  [init-name (lambda () (new-name "checkbox"))]
-	  [gb-get-min-size
-	   (lambda (dc)
-	     (let-values ([(x y) (get-label-size dc)])
-	       (values (+ boxsize hspace x) (max boxsize y))))]
-	  [draw
-	   (lambda (dc x y . other)
-	     (let-values ([(lx ly) (get-label-size dc)])
-	       (send dc draw-rectangle x (+ y (/ (- h boxsize) 2)) boxsize boxsize)
-	       (draw-label dc (+ x boxsize hspace) (+ y (/ (- h ly) 2)))))]
-	  [gb-get-default-class (lambda () 'check-box%)])
-	(super-new))))
-  
-  (define gb:button-snip% (gb:make-button-snip%
-			   (gb:make-callback-snip%
-			    (gb:make-text-label-snip% gb:atomic-snip% 
-						      "Button"))
-			   "gb:button"))
-  
-  (define gb:check-box-snip% (gb:make-check-box-snip%
-			      (gb:make-callback-snip%
-			       (gb:make-text-label-snip% gb:atomic-snip% 
-							 "Checkbox"))
-			      "gb:checkbox"))
-  
-  (register-class gb:button-snip% "gb:button")
-  (register-class gb:check-box-snip% "gb:checkbox")
-  
-
-  (provide gb:message-snip%
-	   gb:button-snip%
-	   gb:check-box-snip%))
diff --git a/collects/guibuilder/slider-guage.rkt b/collects/guibuilder/slider-guage.rkt
deleted file mode 100644
index c04fb0a0ff..0000000000
--- a/collects/guibuilder/slider-guage.rkt
+++ /dev/null
@@ -1,192 +0,0 @@
-(module slider-guage mzscheme
-  (require (prefix mred: mred)
-           mzlib/class
-           mzlib/file
-           mzlib/pretty
-           mzlib/etc
-           mzlib/list
-           "utils.rkt"
-           "base.rkt"
-           "feature.rkt")
-
-  (define gb:make-slider-snip%
-    (lambda (cl cn)
-      (class cl
-	(inherit-field vertical-layout?)
-	(inherit get-label get-callback-names gb-need-recalc-size)
-	(field
-	  [init-value 0]
-	  [min-value 0]
-	  [max-value 10]
-	  [arrow-size 10]
-	  [height arrow-size]
-	  [line-height 3]
-	  [min-width 50]
-	  [darrow (list (make-object mred:point% 0 0)
-			(make-object mred:point% arrow-size 0)
-			(make-object mred:point% (quotient arrow-size 2) (quotient arrow-size 2)))]
-	  [rarrow (list (make-object mred:point% 0 0)
-			(make-object mred:point% 0 arrow-size)
-			(make-object mred:point% (quotient arrow-size 2) (quotient arrow-size 2)))])
-	(public*
-	  [slider-install
-	   (lambda (mn mx in)
-	     (set! min-value mn)
-	     (set! max-value mx)
-	     (set! init-value in))])
-	(override*
-	  [get-frame%
-	   (lambda ()
-	     (class (super get-frame%)
-	       (inherit-field controls)
-	       (super-new)
-	       (private-field
-		 [min-val (make-number-control controls "Minimum:" 0 (lambda () -10000) (lambda () 10000) 
-					       (lambda (x) 
-						 (set! min-value x) 
-						 (send max-val check)
-						 (send init-val check)
-						 (gb-need-recalc-size)))]
-		 [max-val (make-number-control controls "Maximum:" 10 (lambda () (send min-val get-val)) (lambda () 10000)
-					       (lambda (x)
-						 (set! max-value x)
-						 (send init-val check)
-						 (gb-need-recalc-size)))]
-		 [init-val (make-number-control controls "Initial:" 0 (lambda () (send min-val get-val)) 
-						(lambda () (send max-val get-val))
-						(lambda (x)
-						  (set! init-value x)
-						  (gb-need-recalc-size)))])))]
-	  [get-classname (lambda () cn)]
-	  [init-name (lambda () (new-name "slider"))]
-	  [init-vertical-layout? (lambda () #f)]
-	  [get-min-body-size
-	   (lambda (dc)
-	     (if vertical-layout?
-		 (values height min-width)
-		 (values min-width height)))]
-	  [draw-body
-	   (lambda (dc x y w h)
-	     (let ([percent (/ (- init-value min-value) (- max-value min-value))])
-	       (if vertical-layout?
-		   (begin
-		     (send dc draw-rectangle 
-			   (+ x (/ arrow-size 2)) (+ y (/ arrow-size 2))
-			   line-height (- h arrow-size))
-		     (send dc draw-polygon rarrow x (+ y (* percent (- h arrow-size)))))
-		   (begin
-		     (send dc draw-rectangle 
-			   (+ x (/ arrow-size 2)) (+ y (/ arrow-size 2)) 
-			   (- w arrow-size) line-height)
-		     (send dc draw-polygon darrow (+ x (* percent (- w arrow-size))) y)))))]
-	  [gb-get-default-class (lambda () 'slider%)]
-	  [gb-instantiate-arguments
-	   (lambda ()
-	     (list*
-	      `[min-value ,min-value]
-	      `[max-value ,max-value]
-	      `[init-value ,init-value]
-	      (super gb-instantiate-arguments)))]
-	  
-	  [copy
-	   (lambda ()
-	     (let ([o (super copy)])
-	       (send o slider-install min-value max-value init-value)
-	       o))]
-	  [write
-	   (lambda (stream)
-	     (super write stream)
-	     (send stream put min-value)
-	     (send stream put max-value)
-	     (send stream put init-value))]
-	  [read
-	   (lambda (stream version)
-	     (super read stream version)
-	     (slider-install (send stream get-exact)
-			     (send stream get-exact)
-			     (send stream get-exact)))])
-	(super-new))))
-  
-  (define gb:slider-snip% (gb:make-slider-snip%
-			   (gb:make-layout-snip%
-			    (gb:make-callback-snip%
-			     (gb:make-text-labelled-snip% gb:atomic-snip% 
-							  "Slider")))
-			   "gb:slider"))
-  
-  (register-class gb:slider-snip% "gb:slider")
-  
-  (define gb:make-gauge-snip%
-    (lambda (cl cn)
-      (class cl
-	(inherit-field vertical-layout?)
-	(inherit get-label gb-need-recalc-size)
-	(field
-	  [max-value 10]
-	  [min-height 10]
-	  [min-width 50])
-	(public*
-	  [gauge-install
-	   (lambda (mx)
-	     (set! max-value mx))])
-	(override*
-	  [get-frame%
-	   (lambda ()
-	     (class (super get-frame%)
-	       (inherit-field controls)
-	       (super-new)
-	       (private-field
-		 [max-val (make-number-control controls "Maximum:" 10 (lambda () 1) (lambda () 10000) 
-					       (lambda (x) 
-						 (set! max-value x) 
-						 (gb-need-recalc-size)))])))]
-	  [get-classname (lambda () cn)]
-	  [init-name (lambda () (new-name "gauge"))]
-	  [init-vertical-layout? (lambda () #f)]
-	  [get-min-body-size
-	   (lambda (dc)
-	     (if vertical-layout?
-		 (values min-height min-width)
-		 (values min-width min-height)))]
-	  [draw-body
-	   (lambda (dc x y w h)
-	     (send dc draw-rectangle x y w h)
-	     (let ([b (send dc get-brush)])
-	       (send dc set-brush (send mred:the-brush-list find-or-create-brush "BLACK" 'solid))
-	       (send dc draw-rectangle 
-		     x (if vertical-layout? (+ y (* 0.75 h)) y)
-		     (if vertical-layout? w (* 0.25 w)) (if vertical-layout? (* 0.25 h) h))
-	       (send dc set-brush b)))]
-	  [gb-get-default-class (lambda () 'gauge%)]
-	  [gb-instantiate-arguments
-	   (lambda ()
-	     (list*
-	      `[range ,max-value]
-	      (super gb-instantiate-arguments)))]
-	  
-	  [copy
-	   (lambda ()
-	     (let ([o (super copy)])
-	       (send o gauge-install max-value)
-	       o))]
-	  [write
-	   (lambda (stream)
-	     (super write stream)
-	     (send stream put max-value))]
-	  [read
-	   (lambda (stream version)
-	     (super read stream version)
-	     (gauge-install (send stream get-exact)))])
-	(super-new))))
-  
-  (define gb:gauge-snip% (gb:make-gauge-snip%
-			  (gb:make-layout-snip%
-			   (gb:make-text-labelled-snip% gb:atomic-snip% 
-							"Gauge"))
-			  "gb:gauge"))
-  
-  (register-class gb:gauge-snip% "gb:gauge")
-
-
-  (provide gb:slider-snip%
-	   gb:gauge-snip%))
diff --git a/collects/guibuilder/slider.xpm b/collects/guibuilder/slider.xpm
deleted file mode 100644
index a8465da4c1..0000000000
--- a/collects/guibuilder/slider.xpm
+++ /dev/null
@@ -1,26 +0,0 @@
-/* XPM */
-static char *slider[] = {
-/* width height num_colors chars_per_pixel */
-"    16    16        3            1",
-/* colors */
-". c #000000",
-"# c #a0a0a0",
-"a c #ffffff",
-/* pixels */
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaa.....aaaaaa",
-"aaaaaa...aaaaaaa",
-"aaaaaaa.aaaaaaaa",
-"a##############a",
-"a..............a",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa"
-};
diff --git a/collects/guibuilder/text-field.rkt b/collects/guibuilder/text-field.rkt
deleted file mode 100644
index 3148ac857c..0000000000
--- a/collects/guibuilder/text-field.rkt
+++ /dev/null
@@ -1,135 +0,0 @@
-(module text-field mzscheme
-  (require (prefix mred: mred)
-           mzlib/class
-           mzlib/file
-           mzlib/pretty
-           mzlib/etc
-           mzlib/list
-           "utils.rkt"
-           "base.rkt"
-           "feature.rkt")
-
-  (define gb:make-text-initial-snip%
-    (lambda (cl)
-      (class cl
-	(inherit gb-need-recalc-size get-style)
-	(private-field
-	  [initial "value"])
-	(public*
-	  [get-initial (lambda () initial)]
-	  [get-initial-size
-	   (lambda (dc)
-	     (let-values ([(w h d a) (send dc get-text-extent initial
-					   (send (get-style) get-font))])
-	       (values w h)))]
-
-	  [initial-install
-	   (lambda (i)
-	     (set! initial i))])
-	(override*
-	  [get-frame%
-	   (lambda ()
-	     (class (super get-frame%)
-	       (inherit-field controls)
-	       (super-new)
-	       (private-field
-		 [initial-text
-		  (make-one-line/callback-edit controls "Initial:"
-					       (lambda (txt)
-						 (set! initial txt)
-						 (gb-need-recalc-size))
-					       initial)])))]
-
-	  [copy
-	   (lambda ()
-	     (let ([o (super copy)])
-	       (send o initial-install initial)
-	       o))]
-	  [write
-	   (lambda (stream)
-	     (super write stream)
-	     (send stream put (string->bytes/utf-8 initial)))]
-	  [read
-	   (lambda (stream version)
-	     (super read stream version)
-	     (initial-install ((get-bytes->string version) (send stream get-bytes))))])
-	(super-new))))
-
-  (define gb:make-text-hscroll-checkable-snip%
-    (lambda (cl)
-      (class (gb:make-boolean-configure-snip% cl 'hscroll "Horizontal Scroll" #f 
-					      void
-					      (lambda (f snip)
-						(send (send f find-control 'hscroll)
-						      enable
-						      (send snip get-tagged-value 'multi))))
-	(inherit get-tagged-value)
-	(override*
-	  [gb-get-style
-	   (lambda () 
-	     (append
-	      (if (get-tagged-value 'hscroll)
-		  '(hscroll)
-		  null)
-	      (super gb-get-style)))])
-	(super-new))))
-  
-  (define gb:make-text-snip%
-    (lambda (cl cn)
-      (class cl
-	(inherit-field w h)
-	(inherit get-initial-size get-initial
-		 get-callback-names get-multi
-		 get-label)
-	(private-field
-	  [margin 2])
-	(override*
-	  [get-classname (lambda () cn)]
-	  [init-name (lambda () (new-name "text"))]
-	  [init-x-stretch? (lambda () #t)]
-	  [get-label-top-margin (lambda () margin)]
-	  [get-min-body-size
-	   (lambda (dc)
-	     (let-values ([(w h) (get-initial-size dc)])
-		(values (+ w (* 2 margin))
-			(+ (* h (if (get-multi) 3 1))
-			   (* 2 margin)))))]
-	  [draw-body
-	   (lambda (dc x y w h)
-	     (send dc draw-rectangle x y w h)
-	     (send dc draw-text (get-initial) (+ x margin) (+ y margin)))]
-	  [get-callback-kinds (lambda ()
-				(list "-change-callback" "-return-callback" "-focus-callback"))]
-	  [gb-get-default-class (lambda () 'text-field%)]
-	  [gb-get-style (lambda () (append
-				    (super gb-get-style)
-				    (if (get-multi) '(multiple) '(single))))]
-	  [gb-get-unified-callback
-	   (lambda ()
-	     (let-values ([(change return focus) 
-			   (apply values (get-callback-names))])
-	       `(lambda (b e) 
-		  (let ([t (send e get-event-type)])
-		    (cond 
-		     [(eq? t 'text-field) (,change b e)]
-		     [(eq? t 'text-field-enter) (,return b e)]
-		     [else (,focus b e)])))))]
-	  [gb-instantiate-arguments
-	   (lambda ()
-	     (cons
-	      `[init-value ,(get-initial)]
-	      (super gb-instantiate-arguments)))])
-	(super-new))))
-  
-  (define gb:text-snip% (gb:make-text-snip%
-			 (gb:make-text-hscroll-checkable-snip%
-			  (gb:make-multi-checkable-snip%
-			   (gb:make-text-initial-snip%
-			    (gb:make-callback-snip%
-			     (gb:make-text-labelled-snip% gb:atomic-snip% 
-							  "Text")))))
-			 "gb:text"))
-  
-  (register-class gb:text-snip% "gb:text")
-  
-  (provide gb:text-snip%))
diff --git a/collects/guibuilder/text.xpm b/collects/guibuilder/text.xpm
deleted file mode 100644
index 89c53bcc46..0000000000
--- a/collects/guibuilder/text.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * text_xpm[] = {
-"16 16 3 1",
-" 	c #FFFFFFFFFFFF",
-".	c #000000000000",
-"X	c #A0A0A0A0A0A0",
-"                ",
-"          . .   ",
-"           .    ",
-"  XXXXXXXXX.XX  ",
-"  X        . X  ",
-"  X ...... . X  ",
-"  X . .. . . X  ",
-"  X   ..   . X  ",
-"  X   ..   . X  ",
-"  X   ..  . .X  ",
-"  X  ....    X  ",
-"  X          X  ",
-"  XXXXXXXXXXXX  ",
-"                ",
-"                ",
-"                "};
diff --git a/collects/guibuilder/tool.rkt b/collects/guibuilder/tool.rkt
deleted file mode 100644
index 7d226f641b..0000000000
--- a/collects/guibuilder/tool.rkt
+++ /dev/null
@@ -1,76 +0,0 @@
-(module tool mzscheme
-  (require drscheme/tool
-           mred
-           mzlib/unit
-           mzlib/class
-           string-constants
-           mzlib/contract
-           "top-level.rkt"
-           "toolbar.rkt"
-           "readable.rkt")
-
-  (provide tool@)
-
-  (define-syntax (name stx) (syntax-case stx () [(_ x e) #'(let ((x e)) x)]))
-
-  (define tool@
-    (unit
-      (import drscheme:tool^)
-      (export drscheme:tool-exports^) 
-      (define (phase1) (void))
-      (define (phase2) 
-	(drscheme:get/extend:extend-unit-frame 
-	 (lambda (drs:frame%)
-	   (name guibuilder-frame%
-	   (class drs:frame%
-	     (inherit get-insert-menu get-edit-target-object)
-
-	     (define toolbar #f)
-	     (define toolbar-shown? #f)
-
-	     (define/override (get-definitions/interactions-panel-parent)
-	       (let ([p (super get-definitions/interactions-panel-parent)])
-		 (set! toolbar (new toolbar% [parent p][style '(deleted)]))
-		 (add-tools toolbar #f
-			    (lambda (c%) 
-			      (let ([e (get-edit-target-object)])
-				(if (e . is-a? . gb:edit%)
-				    (send e insert-element c%)
-				    (message-box 
-				     (string-constant gui-tool-heading)
-				     (string-constant gui-tool-before-clicking-message)
-				     this
-				     '(ok stop))))))
-		 (new vertical-panel% (parent p))))
-
-	     (define/override (add-show-menu-items menu)
-	       (super add-show-menu-items menu)
-	       (make-object menu-item% 
-			    (string-constant gui-tool-show-gui-toolbar)
-			    menu
-			    (lambda (i e)
-			      (let ([p (send toolbar get-parent)])
-				(if toolbar-shown?
-				    (send p delete-child toolbar)
-				    (send p change-children (lambda (l)
-							      (cons toolbar l))))
-				(set! toolbar-shown? (not toolbar-shown?))
-				(send i set-label (if toolbar-shown?
-						      (string-constant gui-tool-hide-gui-toolbar)
-						      (string-constant gui-tool-show-gui-toolbar)))))))
-
-	     (super-new)
-
-	     (make-object menu-item% (string-constant gui-tool-insert-gui) (get-insert-menu)
-			  (lambda (b e)
-			    (let ([e (get-edit-target-object)])
-			      (when e
-				(let* ([gb (make-object gb:edit%)]
-				       [s (make-object gui-code-snip% gb)])
-				  (send e insert s)
-				  (send gb create-main-panel)
-				  (send gb set-caret-owner #f 'display))))))
-             (inherit register-capability-menu-item)
-             (register-capability-menu-item 'drscheme:special:insert-gui-tool (get-insert-menu)))))))
-      
-      (drscheme:language:register-capability 'drscheme:special:insert-gui-tool (flat-contract boolean?) #t))))
diff --git a/collects/guibuilder/toolbar.rkt b/collects/guibuilder/toolbar.rkt
deleted file mode 100644
index d1e964eefc..0000000000
--- a/collects/guibuilder/toolbar.rkt
+++ /dev/null
@@ -1,159 +0,0 @@
-(module toolbar mzscheme
-  (require (prefix mred: mred)
-           mzlib/class
-           mzlib/file
-           mzlib/pretty
-           mzlib/etc
-           mzlib/list
-           "utils.rkt")
-
-  ;; These modules implement snips for the various
-  ;;  kinds of windows and controls.
-  (require "base.rkt"
-           "panel.rkt"
-           "simple-control.rkt"
-           "text-field.rkt"
-           "multiple-choice.rkt"
-           "slider-guage.rkt"
-           "canvas.rkt")
-
-  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; Frame
-  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  
-  (define-struct tool (icon callback active?))
-
-  (define lg-pen (send mred:the-pen-list find-or-create-pen 
-		       (make-object mred:color% 200 200 200) 0 'solid))
-
-  (define dg-pen (send mred:the-pen-list find-or-create-pen 
-		       (make-object mred:color% 140 140 140) 0 'solid))
-
-  (define icons (make-hash-table))
-
-  (define toolbar%
-    (class mred:canvas%
-      (inherit min-height stretchable-height get-dc)
-      (init parent [style '()])
-      (private-field
-       [margin 2]
-       [icon-size 16]
-       [tools null]
-       [active-tool #f])
-      (private*
-       [deactivate-tool
-	(lambda ()
-	  (when active-tool
-		(set-tool-active?! active-tool #f)
-		(set! active-tool #f)
-		(on-paint)))]
-       [activate-tool
-	(lambda (mx my only)
-	  (let ([y 0]
-		[h (+ icon-size (* 2 margin))]
-		[w (+ icon-size (* 2 margin))])
-	    (let loop ([l tools][x 0])
-	      (unless (null? l)
-		 (if (and (<= x mx (+ x w)) (<= y my (+ y h))
-			  (or (not only) (eq? (car l) only)))
-		     (begin
-		       (set! active-tool (car l))
-		       (set-tool-active?! active-tool #t)
-		       (on-paint))
-		     (loop (cdr l) (+ x w)))))))])
-      (private-field
-       [can-drag #f])
-      (override*
-       [on-paint
-	(lambda ()
-	  (let ([dc (get-dc)]
-		[y 0]
-		[h (+ icon-size (* 2 margin))]
-		[w (+ icon-size (* 2 margin))])
-	    (let loop ([l tools][x 0])
-	      (unless (null? l)
-		(let ([tool (car l)])
-		  (let ([p (send dc get-pen)]
-			[on? (tool-active? tool)])
-		    (send dc set-pen (if on? dg-pen lg-pen))
-		    (send dc draw-line x y (+ x w -1) y)
-		    (send dc draw-line x y x (+ y h -1))
-		    (send dc draw-line x (add1 y) (+ x w -2) (add1 y))
-		    (send dc draw-line (add1 x) y (add1 x) (+ y h -2))
-		    (send dc set-pen (if on? lg-pen dg-pen))
-		    (send dc draw-line (+ x 1) (+ y h -1) (+ x w -1) (+ y h -1))
-		    (send dc draw-line (+ x w -1) (+ y 1) (+ x w -1) (+ y h -1))
-		    (send dc draw-line (+ x 2) (+ y h -2) (+ x w -2) (+ y h -2))
-		    (send dc draw-line (+ x w -2) (+ y 2) (+ x w -2) (+ y h -2))
-		    (send dc set-pen p))
-		  (if (tool-icon tool)
-		      (send dc draw-bitmap (tool-icon tool) (+ x margin) margin)
-		      (send dc draw-rectangle (+ x margin) margin icon-size icon-size)))
-		(loop (cdr l) (+ x w))))))]
-       [on-event
-	(lambda (e)
-	  (cond
-	   [(send e button-down?)
-	    (deactivate-tool)
-	    (activate-tool (send e get-x) (send e get-y) #f)
-	    (set! can-drag active-tool)]
-	   [(send e button-up?)
-	    (set! can-drag #f)
-	    (when active-tool
-		  (let ([cb (tool-callback active-tool)])
-		    (deactivate-tool)
-		    (cb #f #f)))]
-	   [(send e dragging?)
-	    (when can-drag
-		  (let ([old-active active-tool])
-		    (set! active-tool #f)
-		    (activate-tool (send e get-x) (send e get-y) can-drag)
-		    (when (and (not active-tool) old-active)
-			  (set-tool-active?! old-active #f)
-			  (on-paint))))]
-	   [else (set! can-drag #f) 
-		 (deactivate-tool)]))])
-      (public*
-       [append-tool
-	(lambda (icon-name cb)
-	  (let* ([name (string->symbol icon-name)]
-		 [icon
-		  (hash-table-get 
-		   icons name
-		   (lambda ()
-		     (let* ([icon (make-object mred:bitmap% 
-					       (build-path (collection-path "guibuilder") 
-							   icon-name))])
-		       (if (send icon ok?) 
-			   icon
-			   #f))))])
-	    (hash-table-put! icons name icon)
-	    (set! tools (append tools (list (make-tool icon cb #f))))))])
-      (super-new [parent parent] [style (cons 'no-focus style)])
-      (min-height (+ icon-size (* margin 2)))
-      (stretchable-height #f)))
-
-  (define (add-tools toolbar emenu insert-element)
-    (let* ([append-element-type
-	    (lambda (name icon c%)
-	      (let ([maker (lambda (i e) (insert-element c%))])
-		(when toolbar
-		  (send toolbar append-tool icon maker))
-		(when emenu
-		  (make-object mred:menu-item% name emenu maker))))])
-      (append-element-type "New Vertical Panel" "vpanel.xpm" gb:vertical-panel-snip%)
-      (append-element-type "New Horizontal Panel" "hpanel.xpm" gb:horizontal-panel-snip%)
-      (append-element-type "New Message Label" "message.xpm" gb:message-snip%)
-      (append-element-type "New Button" "button.xpm" gb:button-snip%)
-      (append-element-type "New Checkbox" "checkbox.xpm" gb:check-box-snip%)
-      (append-element-type "New Text Field" "text.xpm" gb:text-snip%)
-      (append-element-type "New List" "list.xpm" gb:list-box-snip%)
-      (append-element-type "New Radiobox" "radiobox.xpm" gb:radio-box-snip%)
-      (append-element-type "New Choice" "choice.xpm" gb:choice-snip%)
-      (append-element-type "New Slider" "slider.xpm" gb:slider-snip%)
-      (append-element-type "New Gauge" "gauge.xpm" gb:gauge-snip%)
-      (append-element-type "New Canvas" "canvas.xpm" gb:canvas-snip%)
-      (append-element-type "New Editor Canvas" "mcanvas.xpm" gb:editor-canvas-snip%)))
-
-  (provide toolbar%
-	   add-tools))
diff --git a/collects/guibuilder/top-level.rkt b/collects/guibuilder/top-level.rkt
deleted file mode 100644
index 934005301d..0000000000
--- a/collects/guibuilder/top-level.rkt
+++ /dev/null
@@ -1,633 +0,0 @@
-#lang racket/base
-
-(require racket/class
-         racket/file
-         racket/gui
-         racket/pretty
-         racket/list
-         (prefix-in mred: racket/gui)
-         (prefix-in framework: framework)
-         "utils.rkt"
-         "base.rkt"
-         "panel.rkt")
-
-;; INVARIANT: If a snip is selected, then no ancestor or
-;;  descendant of the snip can be selected. Otherwise, the
-;;  dragging rules get complicated (perhaps impossible).
-
-;; INVARIANT: a child must be ordered before its parent in the
-;;  pasteboard. Not only does this affect drawing, but it also
-;;  affects how select-all and rubber-banding work due to the
-;;  ancestor/descendant-selection-exclusion rule.
-
-(define START-FRAME-WIDTH 100)
-(define START-FRAME-HEIGHT 100)
-
-;; Keep in order of choice items:
-(define FRAME-MODE 0)
-(define DIALOG-MODE 1)
-(define PANEL-MODE 2)
-
-(define -FIRST-MODE- FRAME-MODE)
-(define -LAST-MODE- PANEL-MODE)
-
-(define top-font (send mred:the-font-list find-or-create-font 
-      		 12 'default 'normal 'normal #f))
-    
-;; for use of eval on the generated code
-(define-namespace-anchor anchor)
-
-(define gb:edit%
-  (class mred:pasteboard%
-    (inherit set-selected find-next-selected-snip insert
-             find-first-snip is-selected? add-selected remove-selected
-             get-admin find-snip begin-edit-sequence end-edit-sequence
-             get-snip-location delete erase set-modified resize
-             invalidate-bitmap-cache
-             begin-write-header-footer-to-file end-write-header-footer-to-file
-             get-keymap)
-    (private-field 
-      [dragging? #f]
-      [pasting? #f]
-      [copying? #f]
-      [cur-hilite #f]
-      [cur-hilite-pos 0]
-      [cur-id 1]
-      [last-empty-click -inf.0])
-    (public*
-      [new-id (lambda () 
-      	  (begin0 
-      	    (number->string cur-id)
-      	    (set! cur-id (add1 cur-id))))]
-      [for-each-snip
-       (lambda (f)
-         (let loop ([s (find-first-snip)])
-           (when s
-             (f s)
-             (loop (send s next)))))]
-      [for-each-selected-snip
-       (lambda (f)
-         (let loop ([s (find-next-selected-snip #f)])
-           (when s
-             (f s)
-             (loop (find-next-selected-snip s)))))]
-      [in-selected-hierarchy?
-       (lambda (s)
-         (or (is-selected? s)
-             (let ([parent (send s gb-get-parent)])
-      	 (and parent
-      	      (in-selected-hierarchy? parent)))))]
-      [find-unselected-snip
-       (lambda (x y)
-         (let ([s (find-snip x y)])
-           (if (or (not s) (and (not (in-selected-hierarchy? s))
-      			  (send s container?)))
-      	 s
-      	 (let loop ([s (find-first-snip)])
-      	   (cond
-      	     [(not s) #f]
-      	     [(and (send s container?)
-      		   (not (in-selected-hierarchy? s)))
-      	      (let ([tb (box 0)]
-      		    [lb (box 0)]
-      		    [bb (box 0)]
-      		    [rb (box 0)])
-      		(get-snip-location s lb tb #f)
-      		(get-snip-location s rb bb #t)
-      		(if (and (<= (unbox lb) x (unbox rb))
-      			 (<= (unbox tb) y (unbox bb)))
-      		    s
-      		    (loop (send s next))))]
-      	     [else (loop (send s next))])))))]
-      [find-snip-by-XXX
-       (lambda (id get)
-         (let/ec found
-           (for-each-snip
-            (lambda (s)
-      	(when (equal? id (get s))
-      	  (found s))))
-           #f))]
-      [find-snip-by-id
-       (lambda (id)
-         (find-snip-by-XXX id (gb-id)))]
-      [find-snip-by-original-id
-       (lambda (id)
-         (find-snip-by-XXX id gb-original-id))]
-      [find-snip-by-name
-       (lambda (id)
-         (find-snip-by-XXX id gb-name))]
-
-      [top-resized
-       (lambda (snip old-w old-h w h)
-         (when (eq? snip main-panel)
-      	 (unless (= top-level-type PANEL-MODE)
-      		 (invalidate-bitmap-cache 0 0
-      					  (+ (max old-w w) (* 2 margin))
-      					  (+ (max old-h h) (* 2 margin)
-      					     (or frame-label-h 0) 2)))))])
-
-    (augment*
-      [can-move-to?
-       (lambda (snip x y dragging?)
-         (or (not (eq? snip main-panel))
-             (and (= x main-panel-x)
-      	    (= y main-panel-y))))]
-      [after-move-to
-       (lambda (snip x y dragging?)
-         (when dragging?
-           (send snip gb-drag-children-along x y)))]
-      [after-resize
-       (lambda (snip w h did?)
-         (when (and (eq? snip main-panel) did?)
-      	 (unless (= top-level-type PANEL-MODE)
-      		 (invalidate-bitmap-cache 
-      		  0 0 last-frame-paint-w last-frame-paint-h))))]
-      [on-interactive-move
-       (lambda (e)
-         (set! dragging? #t)
-         (for-each-snip (lambda (s) (send s gb-set-stable-position)))
-         (inner (void) on-interactive-move e))]
-      [on-select
-       (lambda (s on?)
-         (when (and (not copying?) on?)
-           ; deselect parents:
-           (let loop ([p (send s gb-get-parent)])
-             (when p
-      	 (if (is-selected? p)
-      	     (remove-selected p)
-      	     (loop (send p gb-get-parent)))))
-           ; deselect children:
-           (for-each
-            (lambda (c)
-      	(when (is-selected? c)
-      	  (remove-selected c)))
-            (send s gb-get-children))))]
-      [after-interactive-move
-       (lambda (e)
-         (set! dragging? #f)
-         
-         ;; Adjust parent of selected snips & move selected snip's children
-         (for-each-selected-snip
-          (lambda (snip)
-            (when (not (eq? snip main-panel))
-      	(let* ([parent (send snip gb-get-parent)]
-      	       [pos (if parent
-      			(send parent gb-get-child-pos snip)
-      			-1)])
-      	  (if cur-hilite
-      	      (when (or (not (eq? cur-hilite parent))
-      			(not (= pos cur-hilite-pos)))
-      		(when parent
-      		  (send parent gb-remove-child snip))
-      		(send cur-hilite gb-add-child snip cur-hilite-pos)
-      		(set! cur-hilite-pos (add1 cur-hilite-pos)))
-      	      (when parent
-      		(send parent gb-remove-child snip)
-      		(send snip gb-install this #f))))
-      	(send snip gb-need-recalc-size))))
-         
-         (when cur-hilite
-           (send cur-hilite gb-hilite #f)
-           (set! cur-hilite #f))
-
-         (inner (void) after-interactive-move e))])
-    (override*
-      [interactive-adjust-move
-       (lambda (snip x-box y-box)
-         (super interactive-adjust-move snip x-box y-box)
-         ;; The following doesn't really work very well.
-         #;
-         (let ([parent (send snip gb-get-parent)])
-           (when parent
-             (let-values ([(x y w h) 
-      		     (send (let loop ([p parent])
-      			     (let ([parent (send p gb-get-parent)])
-      			       (if parent
-      				   (loop parent)
-      				   p)))
-      			   gb-get-position-and-size)])
-      	 (when (and (<= x (unbox x-box) (+ x w))
-      		    (<= y (unbox y-box) (+ y h)))
-      	   (set-box! x-box (send snip gb-get-stable-x))
-      	   (set-box! y-box (send snip gb-get-stable-y)))))))]
-      [interactive-adjust-resize
-       (lambda (snip wb hb)
-         (super interactive-adjust-resize snip wb hb)
-         (let-values ([(x-min y-min) (send snip gb-get-saved-min-size)])
-           (when (or (not (gb-x-stretch? snip))
-      	       (<= (unbox wb) x-min))
-             (set-box! wb x-min))
-           (when (or (not (gb-y-stretch? snip))
-      	       (<= (unbox hb) y-min))
-             (set-box! hb y-min))))])
-    (augment*
-      [after-interactive-resize
-       (lambda (snip)
-         (inner (void) after-interactive-resize snip)
-         (send snip gb-need-recalc-size))])
-    (override*
-      [on-default-event
-       (lambda (e)
-         (unless dragging?
-           (when (send e button-down?)
-             (unless (find-next-selected-snip #f)
-      	 (when ((- (send e get-time-stamp) last-empty-click) 
-      		. < . 
-      		(send (get-keymap) get-double-click-interval))
-      	   (open-dialog))
-      	 (set! last-empty-click (send e get-time-stamp)))))
-         (when dragging?
-           (let ([x (send e get-x)]
-      	   [y (send e get-y)]
-      	   [xb (box 0)]
-      	   [yb (box 0)])
-             (send (get-admin) get-dc xb yb)
-             (let ([lx (+ x (unbox xb))]
-      	     [ly (+ y (unbox yb))])
-      	 (let ([s (find-unselected-snip lx ly)])
-      	   (when s
-      	     (set! cur-hilite-pos (send s gb-find-position lx ly)))
-      	   (when (and (or cur-hilite s)
-      		      (not (eq? cur-hilite s)))
-      	     (begin-edit-sequence)
-      	     (when cur-hilite
-      	       (send cur-hilite gb-hilite #f)
-      	       (set! cur-hilite #f))
-      	     (when s
-      	       (set! cur-hilite s)
-      	       (send s gb-hilite #t))
-      	     (end-edit-sequence))))))
-         (super on-default-event e))]
-      [on-double-click
-       (lambda (snip e)
-         (send snip gb-open-dialog))])
-    (augment*
-      [after-delete
-       (lambda (snip)
-         (for-each (lambda (i) (delete i)) (send snip gb-get-children))
-         (let ([parent (send snip gb-get-parent)])
-           (when parent
-             (send parent gb-remove-child snip)))
-         (inner (void) after-delete snip))]
-      [can-insert?
-       (lambda (snip before x y)
-         (is-a? snip gb:snip%))]
-      [after-insert
-       (lambda (snip behind x y)
-         (when pasting?
-           (dynamic-wind
-            (lambda () (set! pasting? #f))
-            (lambda () (send snip gb-install this #f))
-            (lambda () (set! pasting? #t))))
-         (inner (void) after-insert snip behind x y))])
-    (private*
-      [do-generic-paste
-       (lambda (time super-call)
-         (dynamic-wind
-             (lambda () (set! pasting? #t))
-             (lambda () (super-call time))
-             (lambda () (set! pasting? #f)))
-         (let ([a-paste #f])
-           (for-each-snip
-            (lambda (s)
-      	(unless a-paste
-      	  (let ([oi (gb-original-id s)])
-      	    (when oi
-      	      (set! a-paste s))))))
-           (handle-new-arrivals)
-           (when a-paste
-             (let ([top-paste (let loop ([a-paste a-paste])
-      			  (let ([p (send a-paste gb-get-parent)])
-      			    (if p
-      				(loop p)
-      				a-paste)))])
-      	 (send main-panel gb-add-child top-paste)
-      	 (set-selected top-paste)))))])
-    (override*
-      [do-paste
-       (lambda (time)
-         (do-generic-paste time (lambda (time) (super do-paste time))))]
-      [do-paste-x-selection
-       (lambda (time)
-         (do-generic-paste time (lambda (time) (super do-paste-x-selection time))))])
-    (public*
-      [handle-new-arrivals
-       (lambda ()
-         (let loop ()
-           ((let/ec k
-      	(for-each-snip 
-      	 (lambda (s) 
-      	   (when (send s gb-reconnect-to-original-children)
-      	     (k loop))))
-      	void)))
-         (for-each-snip (lambda (s) (send s gb-forget-original-id))))])
-    (override*
-      [do-copy
-       (lambda (time delete?)
-         (dynamic-wind
-          (lambda () (set! copying? #t))
-          (lambda () 
-            (when (find-next-selected-snip #f)
-      	(letrec ([selected
-      		  (let loop ([s (find-next-selected-snip #f)])
-      		    (let ([next (find-next-selected-snip s)])
-      		      (if next
-      			  (cons s (loop next))
-      			  (list s))))]
-      		 [close-selected
-      		  (lambda (method)
-      		    (lambda (s)
-      		      (for-each
-      		       (lambda (child)
-      			 (method child)
-      			 ((close-selected method) child))
-      		       (send s gb-get-children))))])
-      	  (for-each (close-selected (lambda (x) (add-selected x))) selected)
-      	  (super do-copy time delete?)
-      	  (for-each (close-selected (lambda (x) (remove-selected x))) selected))))
-          (lambda () (set! copying? #f))))])
-    (public*
-      [get-selected-snip
-       (lambda () 
-         (let ([s (find-next-selected-snip #f)])
-           (if (or (not s)
-      	     (not (find-next-selected-snip s)))
-      	 main-panel
-      	 s)))]
-      [insert-element
-       (lambda (c%)
-         (let* ([i (make-object c%)]
-      	  [se (get-selected-snip)]
-      	  [s (if (send se container?)
-      		 se
-      		 (or (gb-parent se)
-      		     main-panel))])
-           (send s gb-add-child i)
-           (set-selected s)))])
-    (init-field
-     [auto-show? #t]
-     [top-level-type FRAME-MODE]
-     [frame-label "Frame"]
-     [top-name "top"])
-    (private-field
-     [frame-label-w #f]
-     [frame-label-h #f]
-     [last-frame-paint-w 0]
-     [last-frame-paint-h 0]
-     [main-panel-x 0]
-     [main-panel-y 0]
-     [margin 2]
-     [configure-frame #f])
-    (public*
-      [get-top-level-type
-       (lambda () top-level-type)]
-      [get-auto-show
-       (lambda () auto-show?)]
-      [get-frame-label
-       (lambda () frame-label)]
-      [open-dialog
-       (lambda ()
-         (unless configure-frame
-           (set! configure-frame (make-object 
-      			    (class mred:frame%
-      			       (augment*
-      				[on-close
-      				 (lambda ()
-      				   (set! configure-frame #f)
-      				   (inner (void) on-close))])
-      			       (super-new))
-      			    "Output"))
-           (let ([p (make-object mred:vertical-panel% configure-frame)])
-             (send p set-alignment 'left 'center)
-             (letrec ([update-frame
-      		 (lambda ()
-      		   (send main-panel gb-need-recalc-size)
-      		   (invalidate-bitmap-cache 0 0 'end 'end))]
-      		[kind-choice
-      		 (make-object mred:choice% 
-      			      "Output:" 
-      			      '("Frame" "Dialog" "Panel")
-      			      p
-      			      (lambda (c e)
-      				(let ([mode (send c get-selection)])
-      				  (set! top-level-type mode)
-      				  (send frame-stuff enable (< mode PANEL-MODE))
-      				  (update-frame))))]
-      		[frame-stuff (make-object mred:vertical-panel% p)]
-      		[name-text (make-one-line/callback-edit 
-      			    frame-stuff
-      			    "Scheme Name:"
-      			    (lambda (txt)
-      			      (set! top-name txt))
-      			    top-name)]
-      		[title-text (make-one-line/callback-edit 
-      			     frame-stuff
-      			     "Frame Title:"
-      			     (lambda (txt)
-      			       (unless (string=? frame-label txt)
-      				       (set! frame-label txt)
-      				       (let ([w frame-label-w]
-      					     [h frame-label-h])
-      					 (set! frame-label-h #f)
-      					 (update-frame))))
-      			     frame-label)]
-      		[auto-show-check (make-object mred:check-box%
-      					      "Show Automatically" frame-stuff
-      					      (lambda (c e)
-      						(set! auto-show? (send c get-value))))])
-      	 (send frame-stuff set-alignment 'left 'center)
-      	 (send frame-stuff enable (< top-level-type PANEL-MODE))
-      	 (send kind-choice stretchable-width #f)
-      	 (send kind-choice set-selection top-level-type)
-      	 (send auto-show-check set-value auto-show?))))
-         (send configure-frame show #t))]
-      [get-main-location
-       (lambda (snip dc dx dy)
-         (when (eq? snip main-panel)
-      	 (if (= top-level-type PANEL-MODE)
-      	     (begin
-      	       (set! main-panel-x 0)
-      	       (set! main-panel-y 0))
-      	     (begin
-      	       (unless frame-label-h
-      		 (let-values ([(w h d a) (send dc get-text-extent
-      					       frame-label top-font)])
-      		   (set! frame-label-w w)
-      		   (set! frame-label-h h)))
-      	       (set! main-panel-x margin)
-      	       (set! main-panel-y (+ frame-label-h 2 margin))))
-      	 (set-box! dx main-panel-x)
-      	 (set-box! dy main-panel-y)))])
-    (override*
-      [on-paint
-       (lambda (pre? dc l t r b dx dy show-caret?)
-         (unless (or (not pre?) (= top-level-type PANEL-MODE)
-      	       (not main-panel))
-            (let ([tb (box 0)]
-      	    [lb (box 0)]
-      	    [bb (box 0)]
-      	    [rb (box 0)])
-      	(get-snip-location main-panel lb tb #f)
-      	(get-snip-location main-panel rb bb #t)
-      	(let* ([w (- (unbox rb) (unbox lb))]
-      	       [h (- (unbox bb) (unbox tb))]
-      	       [th (+ (or frame-label-h 0) 2)]
-      	       [tw (+ (* 2 margin) w)]
-      	       [totalh (+ th (* 2 margin) h)])
-      	  (when (and (or (<= 0 l tw) (<= 0 r tw) (<= l 0 tw r))
-      		     (or (<= 0 t totalh) (<= 0 b totalh) (<= t 0 totalh b)))
-      	    (set! last-frame-paint-w tw)
-      	    (set! last-frame-paint-h totalh)
-      	    (send dc draw-rectangle dx dy 
-      		  tw totalh)
-      	    (send dc draw-line dx (+ dy th)
-      		  (+ dx tw -1) (+ dy th))
-      	    (with-clipping-region 
-      	     dc (add1 dx) (add1 dy) 
-      	     (+ tw -2) (- th 2)
-      	     (lambda ()
-      	       (let ([f (send dc get-font)])
-      		 (send dc set-font f)
-      		 (send dc draw-text frame-label 
-      		       (+ dx (/ (- tw (or frame-label-w 0)) 2)) 
-      		       (+ dy 1))
-      		 (send dc set-font f)))))))))]
-      [write-footers-to-file
-       (lambda (stream)
-         (super write-footers-to-file stream)
-         (let ([out (lambda (name val)
-      		(let ([info (box 0)])
-      		  (begin-write-header-footer-to-file stream name info)
-      		  (send stream put val)
-      		  (end-write-header-footer-to-file stream (unbox info))))])
-           (out "gb:mode" top-level-type)
-           (out "gb:title-utf8" (string->bytes/utf-8 frame-label))
-           (out "gb:top-name-utf8" (string->bytes/utf-8 top-name))
-           (out "gb:show" (if auto-show? 1 0))))]
-      [read-footer-from-file
-       (lambda (stream kind)
-         (cond
-           [(string=? kind "gb:mode") 
-            (set! top-level-type 
-      	    (min -LAST-MODE- 
-      		 (max -FIRST-MODE- (send stream get-exact))))]
-           [(string=? kind "gb:title") 
-            (set! frame-label (bytes->string/latin-1 (send stream get-bytes)))]
-           [(string=? kind "gb:title-utf8") 
-            (set! frame-label (bytes->string/utf-8 (send stream get-bytes)))]
-           [(string=? kind "gb:top-name-utf8") 
-            (set! top-name (bytes->string/latin-1 (send stream get-bytes)))]
-           [(string=? kind "gb:top-name") 
-            (set! top-name (bytes->string/utf-8 (send stream get-bytes)))]
-           [(string=? kind "gb:show") 
-            (set! auto-show? (positive? (send stream get-exact)))]
-           [else (super read-footer-from-file stream kind)]))]
-      [copy-self-to (lambda (e)
-      		(send e prepare-to-load)
-      		(super copy-self-to e)
-      		(send e done-loading #t))]
-      [copy-self (lambda ()
-      	     (let ([e (new gb:edit%
-      			   [auto-show? auto-show?]
-      			   [top-level-type top-level-type]
-      			   [frame-label frame-label]
-      			   [top-name top-name])])
-      	       (copy-self-to e)
-      	       e))])
-    (private-field
-      [main-panel #f])
-    (public*
-      [get-main-panel (lambda () main-panel)]
-      [create-main-panel
-       (lambda () 
-         (erase)
-         (set! main-panel (make-object gb:panel-snip%))
-         (insert main-panel 0 0)
-         (resize main-panel START-FRAME-WIDTH START-FRAME-HEIGHT)
-         (send main-panel gb-install this #f)
-         (send main-panel set-id "0")
-         (send main-panel gb-need-recalc-size)
-         (set-modified #f))])
-    (public*
-      [prepare-to-load
-       (lambda ()
-         (set! pasting? #t))]
-      [done-loading
-       (lambda (ok?)
-         (set! pasting? #f)
-         (when ok?
-           (set! main-panel (find-snip-by-original-id "0"))
-           (send main-panel set-id "0")
-           (handle-new-arrivals)
-           (set-modified #f)))])
-    (augment*
-     [on-load-file
-      (lambda (file mode)
-        (prepare-to-load))]
-     [after-load-file
-      (lambda (ok?)
-        (done-loading ok?))])
-
-    ;; Code generation:
-    (public*
-      [instantiate
-       (lambda ()
-         (let ([code (build-code #t #f)])
-           (thread
-            (lambda ()
-      	(parameterize ([mred:current-eventspace (mred:make-eventspace)]
-                       [current-namespace (namespace-anchor->namespace anchor)])
-      	   (eval code))))))]
-      [view-source
-       (lambda ()
-         (let ([port (open-output-string)])
-           (pretty-print (build-code #f #f) port)
-           (let ([f (make-object (framework:frame:text-mixin framework:frame:editor%)
-      			   "code.scm")])
-             (send (send f get-editor) insert (get-output-string port))
-             (send f show #t))))]
-      [build-code
-       (lambda (force-frame? as-class?)
-         (let* ([main (get-main-panel)]
-      	  [type (get-top-level-type)]
-      	  [frame-label (if (and (= type PANEL-MODE) force-frame?)
-      			   "Panel Tester"
-      			   (get-frame-label))]
-      	  [mode (make-output-mode as-class? force-frame?)]
-      	  [top (string->symbol top-name)])
-           `(,@(cond
-      	  [as-class? '(class object%)]
-      	  [(and (= type PANEL-MODE)
-      		(not force-frame?))
-      	   '(lambda (top))]
-      	  [else '(begin)])
-      	,@(if as-class?
-      	      (if (and (= type PANEL-MODE) (not force-frame?))
-      		  '((init top))
-      		  '())
-      	      '())
-      	,@(cond
-      	   [(or (= type FRAME-MODE) 
-      		(and (= type PANEL-MODE) force-frame?))
-      	    (if as-class?
-      		`((public* [get-top% (lambda () frame%)])
-      		  (field [,top (make-object (get-top%) ,frame-label)]))
-      		`((define ,top (make-object frame% ,frame-label))))]
-      	   [(= type PANEL-MODE) null]
-      	   [else
-      	    (if as-class?
-      		`((public* [get-top% (lambda () dialog%)])
-      		  (field [,top (make-object (get-top%) ,frame-label)]))
-      		`((define ,top (make-object dialog% ,frame-label))))])
-      	,@(send main gb-instantiate 'top mode)
-      	,@(if as-class?
-      	      '((super-new))
-      	      null)
-      	,@(if (and (not force-frame?)
-      		   (or (= type PANEL-MODE) (not (get-auto-show))))
-      	      null
-      	      `((send ,top show #t))))))])
-
-    (super-new)))
-
-(provide gb:edit%)
diff --git a/collects/guibuilder/utils.rkt b/collects/guibuilder/utils.rkt
deleted file mode 100644
index c7e2bcc69f..0000000000
--- a/collects/guibuilder/utils.rkt
+++ /dev/null
@@ -1,101 +0,0 @@
-
-(module utils mzscheme
-  (require (prefix mred: mred)
-	   mzlib/class
-	   mzlib/etc
-	   mzlib/list)
-
-  (define-syntax (private-field stx)
-    (syntax-case stx ()
-      [(_ (id val) ...)
-       (syntax/loc stx (begin (define id val) ...))]))
-
-  (define make-one-line/callback-edit
-    (opt-lambda (parent label cb [v ""])
-      (make-object mred:text-field% label parent 
-		   (lambda (t e) (cb (send t get-value))) v)))
-
-  (define make-number-control
-    (lambda (parent label value get-min get-max set-v)
-      (let* ([p (make-object mred:horizontal-panel% parent)]
-	     [l (make-object mred:message% label p)]
-	     [vl (make-object mred:message% "999999" p)]
-	     [set-value
-	      (lambda (n)
-		(set! value n)
-		(send vl set-label (number->string n))
-		(set-v n))]
-	     [b (make-object mred:button%
-			     "Set..."
-			     p
-			     (lambda (b e)
-			       (let ([v (mred:get-text-from-user 
-					 (format "~a, in [~a, ~a]:" label (get-min) (get-max))
-					 label
-					 #f
-					 (number->string value))])
-				 (when v
-				   (let ([n (string->number v)])
-				     (if (and (integer? n) (exact? n) 
-					      (>= n (get-min)) (<= n (get-max)))
-					 (set-value n)
-					 (mred:message-box "Error" "Bad value")))))))])
-	(send vl set-label (number->string value))
-	(make-object (class object% ()
-		       (public*
-			 [get-val (lambda () value)]
-			 [check (lambda () 
-				  (when (< value (get-min))
-				    (set-value (get-min)))
-				  (when (> value (get-max))
-				    (set-value (get-max))))])
-		       (super-new))))))
-  
-  (define new-name (lambda (base) (symbol->string (gensym base))))
-  
-  (define (stream-write-list stream l)
-    (send stream put (length l))
-    (for-each
-     (lambda (i)
-       (send stream put (string->bytes/utf-8 i)))
-     l))
-  
-  (define (get-bytes->string version)
-    (if (version . >= . 5)
-	bytes->string/utf-8
-	bytes->string/latin-1))
-
-  (define (stream-read-list stream version)
-    (let ([n (send stream get-exact)]
-	  [b->s (get-bytes->string version)])
-      (let loop ([n n])
-	(if (zero? n)
-	    null
-	    (cons (b->s (send stream get-bytes)) (loop (sub1 n)))))))
-
-  (define cached-region #f)
-  (define cached-region-dc #f)
-
-  (define (with-clipping-region dc x y w h thunk)
-    (let ([r (send dc get-clipping-region)]
-	  [r2 (if (eq? dc cached-region-dc)
-		  cached-region
-		  (make-object mred:region% dc))])
-      (set! cached-region-dc #f)
-      (send r2 set-rectangle x y w h)
-      (send r2 intersect r)
-      (send dc set-clipping-region r2)
-      (thunk)
-      (send dc set-clipping-region r)
-      (set! cached-region r2)
-      (set! cached-region-dc dc)))
-  
-  (provide private-field
-	   make-one-line/callback-edit
-	   make-number-control
-	   new-name
-	   get-bytes->string	   
-	   stream-write-list
-	   stream-read-list
-	   with-clipping-region))
-
diff --git a/collects/guibuilder/vpanel.xpm b/collects/guibuilder/vpanel.xpm
deleted file mode 100644
index c5fb5451be..0000000000
--- a/collects/guibuilder/vpanel.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * vpanel_xpm[] = {
-"16 16 3 1",
-" 	c #FFFFFFFFFFFF",
-".	c #000000000000",
-"X	c #A0A0A0A0A0A0",
-"                ",
-"   ..........   ",
-"   .        .   ",
-"   .        .   ",
-"   .  XXXX  .   ",
-"   .        .   ",
-"   .        .   ",
-"   .  XXXX  .   ",
-"   .  XXXX  .   ",
-"   .        .   ",
-"   .        .   ",
-"   .  XXXX  .   ",
-"   .        .   ",
-"   .        .   ",
-"   ..........   ",
-"                "};