diff --git a/collects/framework/canvas.ss b/collects/framework/canvas.ss
index 38d3e689..d73b86c6 100644
--- a/collects/framework/canvas.ss
+++ b/collects/framework/canvas.ss
@@ -27,9 +27,8 @@
 	     (lambda (m)
 	       (super-set-editor m)
 	       (let ([tlw (get-top-level-window)])
-		 (cond
-		  [(eq? this (send tlw get-info-canvas))
-		   (send tlw update-info)])))])
+		 (when (eq? this (send tlw get-info-canvas))
+		   (send tlw update-info))))])
 	   (sequence
 	     (apply super-init parent editor args)
 	     (unless (is-a? (get-top-level-window) frame:info<%>)
diff --git a/collects/framework/frame.ss b/collects/framework/frame.ss
index 55839295..fd6a5476 100644
--- a/collects/framework/frame.ss
+++ b/collects/framework/frame.ss
@@ -171,8 +171,7 @@
 	[on-close
 	 (lambda ()
 	   (super-on-close)
-	   (send (get-editor) on-close))]
-	[get-area-container%  (lambda () panel:vertical-editor%)])
+	   (send (get-editor) on-close))])
       (private
 	[label (if file-name
 		   (let-values ([(base name dir?) (split-path file-name)])
@@ -211,8 +210,8 @@
 	     (set! label t)
 	     (do-label)))])
       (public
-	[get-canvas% (lambda () editor-canvas<%>)]
-	[get-canvas<%> (lambda () editor-canvas%)]
+	[get-canvas% (lambda () editor-canvas%)]
+	[get-canvas<%> (lambda () editor-canvas<%>)]
 	[make-canvas (lambda ()
 		       (let ([% (get-canvas%)]
 			     [<%> (get-canvas<%>)])
@@ -273,24 +272,6 @@
 			  (send (get-editor) save-file)
 			  #t)]
 	[file-menu:save-as (lambda (item control) (save-as) #t)]
-	[file-menu:between-print-and-close
-	 (lambda (file-menu)
-	   (make-object separator-menu-item% file-menu)
-	   (let ([split
-		  (lambda (panel%)
-		    (lambda (item control)
-		      (let ([win (get-edit-target-object)])
-			(when (and win
-				   (is-a? win canvas<%>))
-			  (send (get-area-container) split win panel%)))))])
-	     (make-object (get-menu-item%) "Split Horizontally" file-menu (split horizontal-panel%))
-	     (make-object (get-menu-item%) "Split Vertically" file-menu (split vertical-panel%))
-	     (make-object (get-menu-item%) "Collapse" file-menu
-		   (lambda (item control)
-		     (let ([canvas (get-edit-target-window)])
-		       (when canvas
-			 (send (get-area-container) collapse canvas))))))
-	   (make-object separator-menu-item% file-menu))]
 	[file-menu:print (lambda (item control)
 			   (send (get-editor) print
 				 #t
diff --git a/collects/framework/frameworks.ss b/collects/framework/frameworks.ss
index 65015215..7cc832e5 100644
--- a/collects/framework/frameworks.ss
+++ b/collects/framework/frameworks.ss
@@ -21,12 +21,7 @@
    single-window<%>
    single-window-mixin
    single%
-   single-pane%
-   
-   editor-mixin
-   editor<%>
-   horizontal-editor%
-   vertical-editor%))
+   single-pane%))
 
 (define-signature framework:exn^
   ((struct exn ())
@@ -48,6 +43,8 @@
    restore-defaults
 
    add-panel
+   add-font-panel
+   add-general-panel
    show-dialog
    hide-dialog))
 
@@ -202,10 +199,7 @@
    open-file))
 
 (define-signature framework:icon^
-  (get
-   get-mask
-   
-   get-paren-highlight-bitmap
+  (get-paren-highlight-bitmap
    get-autowrap-bitmap
 
    get-lock-bitmap
@@ -247,7 +241,8 @@
    setup-keymap
    text-mixin
    text<%>
-   text%))
+   text%
+   add-preferences-panel))
 
 (define-signature framework:paren^
   (balanced? 
diff --git a/collects/framework/icon.ss b/collects/framework/icon.ss
index 606cefe2..71a77f4b 100644
--- a/collects/framework/icon.ss
+++ b/collects/framework/icon.ss
@@ -47,8 +47,8 @@
 	      (set! icon (make-object bitmap% p type))
 	      icon)))))
   
-  (define get (make-get/mask "plt16x16.bmp" 'bmp))
-  (define get-mask (make-get/mask "dot16x16.xbm" 'xbm))
+  ;(define get (make-get/mask "plt16x16.bmp" 'bmp))
+  ;(define get-mask (make-get/mask "dot16x16.xbm" 'xbm))
   
   (define gc-on-bitmap #f)
 
diff --git a/collects/framework/main.ss b/collects/framework/main.ss
index 28b0686b..1f397d85 100644
--- a/collects/framework/main.ss
+++ b/collects/framework/main.ss
@@ -2,8 +2,7 @@
   (import mred-interfaces^
 	  [preferences : framework:preferences^]
 	  [exit : framework:exit^]
-	  [group : framework:group^]
-	  [mzlib:function : mzlib:function^])
+	  [group : framework:group^])
   
   ;; preferences
 
@@ -83,83 +82,6 @@
      (or (eq? x 'common)
 	 (eq? x 'std))))
   
-  (preferences:add-panel
-   "Indenting"
-   (lambda (p)
-     (let*-values
-	 ([(get-keywords)
-	   (lambda (hash-table)
-	     (letrec ([all-keywords (hash-table-map hash-table list)]
-		      [pick-out (lambda (wanted in out)
-				  (cond
-				    [(null? in) (mzlib:function:quicksort out string<=?)]
-				    [else (if (eq? wanted (cadr (car in))) 
-					      (pick-out wanted (cdr in) (cons (symbol->string (car (car in))) out))
-					      (pick-out wanted (cdr in) out))]))])
-	       (values  (pick-out 'begin all-keywords null)
-			(pick-out 'define all-keywords null)
-			(pick-out 'lambda all-keywords null))))]
-	  [(begin-keywords define-keywords lambda-keywords)
-	   (get-keywords (preferences:get 'framework:tabify))])
-       (let* ([add-callback
-	       (lambda (keyword-type keyword-symbol list-box)
-		 (lambda (button command)
-		   (let ([new-one (get-text-from-user
-				   (string-append "Enter new " keyword-type "-like keyword:")
-				   (string-append keyword-type " Keyword"))])
-		     (when new-one
-		       (let ([parsed (with-handlers ((exn:read? (lambda (x) #f)))
-				       (read (open-input-string new-one)))])
-			 (cond
-			   [(and (symbol? parsed)
-				 (hash-table-get (preferences:get 'framework:tabify)
-						 parsed
-						 (lambda () #f)))
-			    (message-box "Error"
-					 (format "\"~a\" is already a specially indented keyword" parsed))]
-			   [(symbol? parsed)
-			    (hash-table-put! (preferences:get 'framework:tabify)
-					     parsed keyword-symbol)
-			    (send list-box append (symbol->string parsed))]
-			   [else (message-box "Error" (format "expected a symbol, found: ~a" new-one))]))))))]
-	      [delete-callback
-	       (lambda (list-box)
-		 (lambda (button command)
-		   (let* ([selections (send list-box get-selections)]
-			  [symbols (map (lambda (x) (string->symbol (send list-box get-string x))) selections)])
-		     (for-each (lambda (x) (send list-box delete x)) (reverse selections))
-		     (let ([ht (preferences:get 'framework:tabify)])
-		       (for-each (lambda (x) (hash-table-remove! ht x)) symbols)))))]
-	      [main-panel (make-object horizontal-panel% p)]
-	      [make-column
-	       (lambda (string symbol keywords)
-		 (let* ([vert (make-object vertical-panel% main-panel)]
-			[_ (make-object message% (string-append string "-like Keywords") vert)]
-			[box (make-object list-box% #f keywords vert void '(multiple))]
-			[button-panel (make-object horizontal-panel% vert)]
-			[add-button (make-object button% "Add" button-panel (add-callback string symbol box))]
-			[delete-button (make-object button% "Remove" button-panel (delete-callback box))])
-		   (send* button-panel 
-		     (set-alignment 'center 'center)
-		     (stretchable-height #f))
-		   (send add-button min-width (send delete-button get-width))
-		   box))]
-	      [begin-list-box (make-column "Begin" 'begin begin-keywords)]
-	      [define-list-box (make-column "Define" 'define define-keywords)]
-	      [lambda-list-box (make-column "Lambda" 'lambda lambda-keywords)]
-	      [update-list-boxes
-	       (lambda (hash-table)
-		 (let-values ([(begin-keywords define-keywords lambda-keywords) (get-keywords hash-table)]
-			      [(reset) (lambda (list-box keywords)
-					 (send list-box clear)
-					 (for-each (lambda (x) (send list-box append x)) keywords))])
-		   (reset begin-list-box begin-keywords)
-		   (reset define-list-box define-keywords)
-		   (reset lambda-list-box lambda-keywords)
-		   #t))])
-	 (preferences:add-callback 'framework:tabify (lambda (p v) (update-list-boxes v)))
-	 main-panel))))
-  
   ;; groups
   
   (preferences:set-default 'framework:exit-when-no-frames #t boolean?)
diff --git a/collects/framework/panel.ss b/collects/framework/panel.ss
index e42f6008..0dac6bd6 100644
--- a/collects/framework/panel.ss
+++ b/collects/framework/panel.ss
@@ -79,88 +79,4 @@
 	(apply super-init args))))
 
   (define single% (single-window-mixin (single-mixin panel%)))
-  (define single-pane% (single-mixin pane%))
-  
-  (define -editor<%>
-    (interface ()
-      get-canvas%
-      collapse
-      split))
-  
-  (define editor-mixin
-    (mixin (panel<%>) (-editor<%>) args
-      (rename [super-change-children change-children])
-      (inherit get-parent change-children get-children)
-      (public [get-canvas% (lambda () editor-canvas%)])
-      (private
-	[split-edits null])
-      (public
-	[collapse
-	 (lambda (canvas)
-	   (let ([media (send canvas get-media)])
-	     (if (memq media split-edits)
-		 (letrec ([helper
-			   (lambda (canvas/panel)
-			     (if (eq? canvas/panel this)
-				 (let ([children (get-children)])
-				   (cond
-				     [(and (= (length children) 1)
-					   (eq? canvas (car children)))
-				      (void)]
-				     [(member canvas children)
-				      (change-children (lambda (l) (list canvas)))]
-				     [else
-				      (change-children
-				       (lambda (l)
-					 (let ([c (make-object (object-class canvas) this)])
-					   (send c set-media media)
-					   (list c))))])
-					(bell))
-				 (let* ([parent (send canvas/panel get-parent)]
-					[parents-children (send parent get-children)]
-					[num-children (length parents-children)])
-				   (if (<= num-children 1)
-				       (helper parent)
-				       (begin (send parent delete-child canvas/panel)
-					      (send (car (send parent get-children)) focus))))))])
-		   (send media remove-canvas canvas)
-		   (helper canvas))
-		 (bell))))]
-	[split
-	 (opt-lambda (canvas [panel% horizontal-panel%])
-	   (let* ([frame (ivar canvas frame)]
-		  [media (send canvas get-media)]
-		  [canvas% (object-class canvas)]
-		  [parent (send canvas get-parent)]
-		  [new-panel #f]
-		  [left-split #f]
-		  [right-split #f]
-		  [before #t])
-	     (set! split-edits (cons media split-edits))
-	     (dynamic-wind
-	      (lambda () 
-		(set! before (send frame delay-updates))
-		(send frame delay-updates #t))
-	      (lambda () 
-		(set! new-panel (make-object panel% parent))
-		(set! left-split (make-object canvas% new-panel))
-		(set! right-split (make-object canvas% new-panel))
-		(send parent change-children
-		      (lambda (l)
-			(let ([before (mzlib:function:remq new-panel l)])
-			  (map (lambda (x) (if (eq? x canvas)
-					       new-panel
-					       x))
-			       before)))))
-	      (lambda () (send frame delay-updates before)))
-	     (send* media (remove-canvas canvas)
-	       (add-canvas left-split)
-	       (add-canvas right-split))
-	     (send* left-split (set-media media) (focus))
-	     (send* right-split (set-media media))))])
-      (sequence (apply super-init args))))
-  
-  (define horizontal-editor%
-    (editor-mixin horizontal-panel%))    
-  (define vertical-editor%
-    (editor-mixin vertical-panel%)))
\ No newline at end of file
+  (define single-pane% (single-mixin pane%)))
\ No newline at end of file
diff --git a/collects/framework/prefs.ss b/collects/framework/prefs.ss
index 6877aa49..03fb4321 100644
--- a/collects/framework/prefs.ss
+++ b/collects/framework/prefs.ss
@@ -254,291 +254,271 @@
 		    [else (err input "expected a pair")])))))))))
   
   (define-struct ppanel (title container panel))
-
-  (define font-families-name/const
-    (list (list "Default" 'default)
-	  (list "Decorative" 'decorative)
-	  (list "Roman" 'roman)
-	  (list "Decorative" 'script)
-	  (list "Swiss" 'swiss)
-	  (list "Modern" 'modern)))
-
-  (define font-families (map car font-families-name/const))
   
-  (define font-size-entry "defaultFontSize")
-  (define font-default-string "Default Value")
-  (define font-default-size 12)
-  (define font-section "mred")
-  (define build-font-entry (lambda (x) (string-append "Screen" x "__")))
-  (define font-file (find-graphical-system-path 'setup-file))
-  (define (build-font-preference-symbol family)
-    (string->symbol (string-append "framework:" family)))
-  
-  (let ([set-default
-	 (lambda (build-font-entry default pred)
-	   (lambda (family)
-	     (let ([name (build-font-preference-symbol family)]
-		   [font-entry (build-font-entry family)])
-	       (set-default name
-			    default
-			    (cond
-			      [(string? default) string?]
-			      [(number? default) number?]
-			      [else (error 'internal-error.set-default "unrecognized default: ~a~n" default)]))
-	       (add-callback 
-		name 
-		(lambda (p new-value)
-		  (write-resource 
-		   font-section
-		   font-entry
-		   (if (and (string? new-value)
-			    (string=? font-default-string new-value))
-		       ""
-		       new-value)
-		   font-file))))))])
-    (for-each (set-default build-font-entry font-default-string string?)
-	      font-families)
-    ((set-default (lambda (x) x)
-		  font-default-size
-		  number?)
-     font-size-entry))
-  
-  (define ppanels 
-    (list 
-     (make-ppanel
-      "General"
-      (lambda (parent)
-	(let* ([main (make-object vertical-panel% parent)]
-	       [make-check
-		(lambda (pref title bool->pref pref->bool)
-		  (let*  ([callback
-			   (lambda (check-box _)
-			     (set pref (bool->pref (send check-box get-value))))]
-			  [pref-value (get pref)]
-			  [initial-value (pref->bool pref-value)]
-			  [c (make-object check-box% title main callback)])
-		    (send c set-value initial-value)
-		    (add-callback pref
-				  (lambda (p v)
-				    (send c set-value (pref->bool v))))))]
-	       [id (lambda (x) x)])
-	  (send main set-alignment 'left 'center)
-	  (make-check 'framework:highlight-parens "Highlight between matching parens" id id)
-	  (make-check 'framework:fixup-parens "Correct parens" id id)
-	  (make-check 'framework:paren-match "Flash paren match" id id)
-	  (make-check 'framework:autosaving-on? "Auto-save files" id id)
-	  (make-check 'framework:delete-forward? "Map delete to backspace" not not)
-	  (make-check 'framework:file-dialogs "Use platform-specific file dialogs"
-		      (lambda (x) (if x 'std 'common))
-		      (lambda (x) (eq? x 'std)))
-	  
-	  (make-check 'framework:verify-exit "Verify exit" id id)
-	  (make-check 'framework:verify-change-format "Ask before changing save format" id id)
-	  (make-check 'framework:auto-set-wrap? "Wordwrap editor buffers" id id)
-	  
-	  (make-check 'framework:show-status-line "Show status-line" id id)
-	  (make-check 'framework:line-offsets "Count line and column numbers from one" id id)
-	  (make-check 'framework:menu-bindings "Enable keybindings in menus" id id)
-	  (unless (eq? (system-type) 'unix) 
-	    (make-check 'framework:print-output-mode "Automatically print to postscript file"
-			(lambda (b) 
-			  (if b 'postscript 'standard))
-			(lambda (n) (eq? 'postscript n))))
+  (define ppanels null)
 
-	  
-	  (make-check 'framework:display-line-numbers "Display line numbers in buffer; not character offsets" id id)
-	  '(when (eq? (system-type) 'windows)
+  (define (add-general-panel)
+    (add-panel
+     "General"
+     (lambda (parent)
+       (let* ([main (make-object vertical-panel% parent)]
+	      [make-check
+	       (lambda (pref title bool->pref pref->bool)
+		 (let*  ([callback
+			  (lambda (check-box _)
+			    (set pref (bool->pref (send check-box get-value))))]
+			 [pref-value (get pref)]
+			 [initial-value (pref->bool pref-value)]
+			 [c (make-object check-box% title main callback)])
+		   (send c set-value initial-value)
+		   (add-callback pref
+				 (lambda (p v)
+				   (send c set-value (pref->bool v))))))]
+	      [id (lambda (x) x)])
+	 (send main set-alignment 'left 'center)
+	 (make-check 'framework:highlight-parens "Highlight between matching parens" id id)
+	 (make-check 'framework:fixup-parens "Correct parens" id id)
+	 (make-check 'framework:paren-match "Flash paren match" id id)
+	 (make-check 'framework:autosaving-on? "Auto-save files" id id)
+	 (make-check 'framework:delete-forward? "Map delete to backspace" not not)
+	 (make-check 'framework:file-dialogs "Use platform-specific file dialogs"
+		     (lambda (x) (if x 'std 'common))
+		     (lambda (x) (eq? x 'std)))
+	 
+	 (make-check 'framework:verify-exit "Verify exit" id id)
+	 (make-check 'framework:verify-change-format "Ask before changing save format" id id)
+	 (make-check 'framework:auto-set-wrap? "Wordwrap editor buffers" id id)
+	 
+	 (make-check 'framework:show-status-line "Show status-line" id id)
+	 (make-check 'framework:line-offsets "Count line and column numbers from one" id id)
+	 (make-check 'framework:menu-bindings "Enable keybindings in menus" id id)
+	 (unless (eq? (system-type) 'unix) 
+	   (make-check 'framework:print-output-mode "Automatically print to postscript file"
+		       (lambda (b) 
+			 (if b 'postscript 'standard))
+		       (lambda (n) (eq? 'postscript n))))
+
+	 
+	 (make-check 'framework:display-line-numbers "Display line numbers in buffer; not character offsets" id id)
+	 '(when (eq? (system-type) 'windows)
 	    (make-check 'framework:windows-mdi "Use MDI Windows" id id))
 
-	  main))
-      #f)
-     (make-ppanel
-      "Default Fonts"
-      (lambda (parent)
-	(letrec ([font-size-pref-sym (build-font-preference-symbol font-size-entry)]
-		 [ex-string "The quick brown fox jumped over the lazy dogs."]
-		 [main (make-object vertical-panel% parent)]
-		 [fonts (cons font-default-string (get-face-list))]
-		 [make-family-panel
-		  (lambda (name)
-		    (let* ([pref-sym (build-font-preference-symbol name)]
-			   [family-const-pair (assoc name font-families-name/const)]
-			   
-			   [edit (make-object text%)]
-			   [_ (send edit insert ex-string)]
-			   [set-edit-font
-			    (lambda (size)
-			      (let ([delta (make-object style-delta% 'change-size size)]
-				    [face (get pref-sym)])
-				(if (and (string=? face font-default-string)
-					 family-const-pair)
-				    (send delta set-family (cadr family-const-pair))
-				    (send delta set-delta-face (get pref-sym)))
-				
-				(send edit change-style delta 0 (send edit last-position))))]
-			   
-			   [horiz (make-object horizontal-panel% main '(border))]
-			   [label (make-object message% name horiz)]
-			   
-			   [message (make-object message%
-				      (let ([b (box "")])
-					(if (and (get-resource 
-						  font-section 
-						  (build-font-entry name)
-						  b)
-						 (not (string=? (unbox b) 
-								"")))
-					    (unbox b)
-					    font-default-string)) 
-				      horiz)]
-			   [button 
-			    (make-object button%
-			      "Change" 
-			      horiz
-			      (lambda (button evt)
-				(let ([new-value
-				       (get-choices-from-user
-					"Fonts"
-					(format "Please choose a new ~a font"
-						name)
-					fonts)])
-				  (when new-value
-				    (set pref-sym (list-ref fonts (car new-value))) 
-				    (set-edit-font (get font-size-pref-sym))))))]
-			   [canvas (make-object editor-canvas% horiz
-						edit
-						(list 'hide-hscroll
-						      'hide-vscroll))])
-		      (set-edit-font (get font-size-pref-sym))
-		      (add-callback
-		       pref-sym
-		       (lambda (p new-value)
-			 (send horiz change-children
-			       (lambda (l)
-				 (let ([new-message (make-object message%
-						      new-value
-						      horiz)])
-				   (set! message new-message)
-				   (update-message-sizes font-message-get-widths 
-							 font-message-user-min-sizes)
-				   (list label 
-					 new-message
-					 button
-					 canvas))))))
-		      (send canvas set-line-count 1)
-		      (vector set-edit-font
-			      (lambda () (send message get-width))
-			      (lambda (width) (send message min-width width))
-			      (lambda () (send label get-width))
-			      (lambda (width) (send label min-width width)))))]
-		 [set-edit-fonts/messages (map make-family-panel font-families)]
-		 [collect (lambda (n) (map (lambda (x) (vector-ref x n))
-					   set-edit-fonts/messages))]
-		 [set-edit-fonts (collect 0)]
-		 [font-message-get-widths (collect 1)]
-		 [font-message-user-min-sizes (collect 2)]
-		 [category-message-get-widths (collect 3)]
-		 [category-message-user-min-sizes (collect 4)]
-		 [update-message-sizes
-		  (lambda (gets sets)
-		    (let ([width (mzlib:function:foldl (lambda (x l) (max l (x))) 0 gets)])
-		      (for-each (lambda (set) (set width)) sets)))]
-		 [size-panel (make-object horizontal-panel% main '(border))]
-		 [initial-font-size
-		  (let ([b (box 0)])
-		    (if (get-resource font-section 
-				      font-size-entry
-				      b)
-			(unbox b)
-			font-default-size))]
-		 [size-slider
-		  (make-object slider%
-		    "Size"
-		    1 127
-		    size-panel
-		    (lambda (slider evt)
-		      (set font-size-pref-sym (send slider get-value)))
-		    initial-font-size)])
-	  (update-message-sizes font-message-get-widths font-message-user-min-sizes)
-	  (update-message-sizes category-message-get-widths category-message-user-min-sizes)
-	  (add-callback
-	   font-size-pref-sym
-	   (lambda (p value)
-	     (for-each (lambda (f) (f value)) set-edit-fonts)
-	     (unless (= value (send size-slider get-value))
-	       (send size-slider set-value value))
-	     #t))
-	  (for-each (lambda (f) (f initial-font-size)) set-edit-fonts)
-	  (make-object message% "Restart to see font changes" main)
-	  main))
-      #f)))
-  
-  (define make-run-once
-    (lambda ()
-      (let ([semaphore (make-semaphore 1)])
-	(lambda (t)
-	  (dynamic-wind (lambda () (semaphore-wait semaphore))
-			t
-			(lambda () (semaphore-post semaphore)))))))
-  
-  (define run-once (make-run-once))
+	 main))))
+
+  (define (add-font-panel)
+    (let* ([font-families-name/const
+	    (list (list "Default" 'default)
+		  (list "Decorative" 'decorative)
+		  (list "Modern" 'modern)
+		  (list "Roman" 'roman)
+		  (list "Swiss" 'swiss))]
+	   
+	   [font-families (map car font-families-name/const)]
+	   
+	   [font-size-entry "defaultFontSize"]
+	   [font-default-string "Default Value"]
+	   [font-default-size 12]
+	   [font-section "mred"]
+	   [build-font-entry (lambda (x) (string-append "Screen" x "__"))]
+	   [font-file (find-graphical-system-path 'setup-file)]
+	   [build-font-preference-symbol
+	    (lambda (family)
+	      (string->symbol (string-append "framework:" family)))]
+	   
+	   [set-default
+	    (lambda (build-font-entry default pred)
+	      (lambda (family)
+		(let ([name (build-font-preference-symbol family)]
+		      [font-entry (build-font-entry family)])
+		  (set-default name
+			       default
+			       (cond
+				[(string? default) string?]
+				[(number? default) number?]
+				[else (error 'internal-error.set-default "unrecognized default: ~a~n" default)]))
+		  (add-callback 
+		   name 
+		   (lambda (p new-value)
+		     (write-resource 
+		      font-section
+		      font-entry
+		      (if (and (string? new-value)
+			       (string=? font-default-string new-value))
+			  ""
+			  new-value)
+		      font-file))))))])
+
+      (for-each (set-default build-font-entry font-default-string string?)
+		font-families)
+      ((set-default (lambda (x) x)
+		    font-default-size
+		    number?)
+       font-size-entry)
+      (add-panel
+       "Default Fonts"
+       (lambda (parent)
+	 (letrec ([font-size-pref-sym (build-font-preference-symbol font-size-entry)]
+		  [ex-string "The quick brown fox jumped over the lazy dogs."]
+		  [main (make-object vertical-panel% parent)]
+		  [fonts (cons font-default-string (get-face-list))]
+		  [make-family-panel
+		   (lambda (name)
+		     (let* ([pref-sym (build-font-preference-symbol name)]
+			    [family-const-pair (assoc name font-families-name/const)]
+			    
+			    [edit (make-object text%)]
+			    [_ (send edit insert ex-string)]
+			    [set-edit-font
+			     (lambda (size)
+			       (let ([delta (make-object style-delta% 'change-size size)]
+				     [face (get pref-sym)])
+				 (if (and (string=? face font-default-string)
+					  family-const-pair)
+				     (send delta set-family (cadr family-const-pair))
+				     (send delta set-delta-face (get pref-sym)))
+				 
+				 (send edit change-style delta 0 (send edit last-position))))]
+			    
+			    [horiz (make-object horizontal-panel% main '(border))]
+			    [label (make-object message% name horiz)]
+			    
+			    [message (make-object message%
+				       (let ([b (box "")])
+					 (if (and (get-resource 
+						   font-section 
+						   (build-font-entry name)
+						   b)
+						  (not (string=? (unbox b) 
+								 "")))
+					     (unbox b)
+					     font-default-string)) 
+				       horiz)]
+			    [button 
+			     (make-object button%
+			       "Change" 
+			       horiz
+			       (lambda (button evt)
+				 (let ([new-value
+					(get-choices-from-user
+					 "Fonts"
+					 (format "Please choose a new ~a font"
+						 name)
+					 fonts)])
+				   (when new-value
+				     (set pref-sym (list-ref fonts (car new-value))) 
+				     (set-edit-font (get font-size-pref-sym))))))]
+			    [canvas (make-object editor-canvas% horiz
+						 edit
+						 (list 'hide-hscroll
+						       'hide-vscroll))])
+		       (set-edit-font (get font-size-pref-sym))
+		       (add-callback
+			pref-sym
+			(lambda (p new-value)
+			  (send horiz change-children
+				(lambda (l)
+				  (let ([new-message (make-object message%
+						       new-value
+						       horiz)])
+				    (set! message new-message)
+				    (update-message-sizes font-message-get-widths 
+							  font-message-user-min-sizes)
+				    (list label 
+					  new-message
+					  button
+					  canvas))))))
+		       (send canvas set-line-count 1)
+		       (vector set-edit-font
+			       (lambda () (send message get-width))
+			       (lambda (width) (send message min-width width))
+			       (lambda () (send label get-width))
+			       (lambda (width) (send label min-width width)))))]
+		  [set-edit-fonts/messages (map make-family-panel font-families)]
+		  [collect (lambda (n) (map (lambda (x) (vector-ref x n))
+					    set-edit-fonts/messages))]
+		  [set-edit-fonts (collect 0)]
+		  [font-message-get-widths (collect 1)]
+		  [font-message-user-min-sizes (collect 2)]
+		  [category-message-get-widths (collect 3)]
+		  [category-message-user-min-sizes (collect 4)]
+		  [update-message-sizes
+		   (lambda (gets sets)
+		     (let ([width (mzlib:function:foldl (lambda (x l) (max l (x))) 0 gets)])
+		       (for-each (lambda (set) (set width)) sets)))]
+		  [size-panel (make-object horizontal-panel% main '(border))]
+		  [initial-font-size
+		   (let ([b (box 0)])
+		     (if (get-resource font-section 
+				       font-size-entry
+				       b)
+			 (unbox b)
+			 font-default-size))]
+		  [size-slider
+		   (make-object slider%
+		     "Size"
+		     1 127
+		     size-panel
+		     (lambda (slider evt)
+		       (set font-size-pref-sym (send slider get-value)))
+		     initial-font-size)])
+	   (update-message-sizes font-message-get-widths font-message-user-min-sizes)
+	   (update-message-sizes category-message-get-widths category-message-user-min-sizes)
+	   (add-callback
+	    font-size-pref-sym
+	    (lambda (p value)
+	      (for-each (lambda (f) (f value)) set-edit-fonts)
+	      (unless (= value (send size-slider get-value))
+		(send size-slider set-value value))
+	      #t))
+	   (for-each (lambda (f) (f initial-font-size)) set-edit-fonts)
+	   (make-object message% "Restart to see font changes" main)
+	   main)))))
   
   (define preferences-dialog #f)
   
   (define add-panel
     (lambda (title container)
-      (run-once
-       (lambda ()
-	 (let ([new-ppanel (make-ppanel title container #f)])
-	   (set! ppanels 
-		 (let loop ([ppanels ppanels])
-		   (cond
-		     [(null? ppanels) (list new-ppanel)]
-		     [(string=? (ppanel-title (car ppanels))
-				title)
-		      (loop (cdr ppanels))]
-		     [else (cons (car ppanels)
-				 (loop (cdr ppanels)))])))
-	   (when preferences-dialog
-	     (send preferences-dialog added-pane)))))))
+      (set! ppanels
+	    (append ppanels (list (make-ppanel title container #f))))
+      (when preferences-dialog
+	(send preferences-dialog added-pane))))
   
   (define hide-dialog
     (lambda ()
-      (run-once
-       (lambda ()
-	 (when preferences-dialog
-	   (send preferences-dialog show #f))))))
+      (when preferences-dialog
+	(send preferences-dialog show #f))))
   
   (define show-dialog
     (lambda ()
-      (run-once
-       (lambda () 
-	 (save)
-	 (if preferences-dialog
-	     (send preferences-dialog show #t)
-	     (set! preferences-dialog
-		   (make-preferences-dialog)))))))
+      (save)
+      (if preferences-dialog
+	  (send preferences-dialog show #t)
+	  (set! preferences-dialog
+		(make-preferences-dialog)))))
   
   (define make-preferences-dialog
     (lambda ()
       (letrec ([frame 
 		(make-object (class-asi frame%
-			       (public [added-pane
-					(lambda () 
-					  (ensure-constructed)
-					  (refresh-menu)
-					  (send popup-menu set-selection (sub1 (length ppanels)))
-					  (send single-panel active-child 
-						(ppanel-panel
-						 (car
-						  (list-tail ppanels
-							     (sub1 (length ppanels)))))))]))
+			       (public
+				 [added-pane
+				  (lambda () 
+				    (ensure-constructed)
+				    (refresh-menu)
+				    (unless (null? ppanels)
+				      (send popup-menu set-selection (sub1 (length ppanels)))
+				      (send single-panel active-child 
+					    (ppanel-panel
+					     (car
+					      (list-tail ppanels
+							 (sub1 (length ppanels))))))))]))
 		  "Preferences")]
 	       [panel (make-object vertical-panel% frame)]
 	       [popup-callback
 		(lambda (choice command-event)
-		  (send single-panel active-child
-			(ppanel-panel (list-ref ppanels (send choice get-selection)))))]
+		  (unless (null? ppanels)
+		    (send single-panel active-child
+			  (ppanel-panel (list-ref ppanels (send choice get-selection))))))]
 	       [make-popup-menu 
 		(lambda ()
 		  (let ([menu (make-object choice% "Category"
@@ -563,11 +543,14 @@
 				  (set-ppanel-panel! ppanel panel))))
 			    ppanels)
 		  (send single-panel change-children (lambda (l) (map ppanel-panel ppanels)))
-		  (send single-panel active-child (ppanel-panel (car ppanels))))]
+		  (unless (null? ppanels)
+		    (send single-panel active-child (ppanel-panel (car ppanels)))))]
 	       [refresh-menu
 		(lambda ()
-		  (let ([new-popup (make-popup-menu)])
-		    (send new-popup set-selection (send popup-menu get-selection))
+		  (let ([new-popup (make-popup-menu)]
+			[old-selection (send popup-menu get-selection)])
+		    (when old-selection
+		      (send new-popup set-selection old-selection))
 		    (set! popup-menu new-popup)
 		    (send panel change-children
 			  (lambda (l) (list new-popup
@@ -587,6 +570,7 @@
 	  (stretchable-height #f)
 	  (set-alignment 'right 'center))
 	(ensure-constructed)
-	(send popup-menu set-selection 0)
+	(unless (null? ppanels)
+	  (send popup-menu set-selection 0))
 	(send frame show #t)
 	frame))))
diff --git a/collects/framework/scheme.ss b/collects/framework/scheme.ss
index 20805d81..44232263 100644
--- a/collects/framework/scheme.ss
+++ b/collects/framework/scheme.ss
@@ -13,7 +13,8 @@
 	  [keymap : framework:keymap^]
 	  [text : framework:text^]
 	  [frame : framework:frame^]
-	  [mzlib:thread : mzlib:thread^])
+	  [mzlib:thread : mzlib:thread^]
+	  [mzlib:function : mzlib:function^])
   
   (rename [-text% text%]
 	  [-text<%> text<%>])
@@ -894,4 +895,84 @@
 
   (define keymap (make-object keymap%))
   (setup-keymap keymap)
-  (define (get-keymap) keymap))
+  (define (get-keymap) keymap)
+
+  (define (add-preferences-panel)
+    (preferences:add-panel
+     "Indenting"
+     (lambda (p)
+       (let*-values
+	   ([(get-keywords)
+	     (lambda (hash-table)
+	       (letrec ([all-keywords (hash-table-map hash-table list)]
+			[pick-out (lambda (wanted in out)
+				    (cond
+				     [(null? in) (mzlib:function:quicksort out string<=?)]
+				     [else (if (eq? wanted (cadr (car in))) 
+					       (pick-out wanted (cdr in) (cons (symbol->string (car (car in))) out))
+					       (pick-out wanted (cdr in) out))]))])
+		 (values  (pick-out 'begin all-keywords null)
+			  (pick-out 'define all-keywords null)
+			  (pick-out 'lambda all-keywords null))))]
+	    [(begin-keywords define-keywords lambda-keywords)
+	     (get-keywords (preferences:get 'framework:tabify))])
+	 (let* ([add-callback
+		 (lambda (keyword-type keyword-symbol list-box)
+		   (lambda (button command)
+		     (let ([new-one (get-text-from-user
+				     (string-append "Enter new " keyword-type "-like keyword:")
+				     (string-append keyword-type " Keyword"))])
+		       (when new-one
+			 (let ([parsed (with-handlers ((exn:read? (lambda (x) #f)))
+					 (read (open-input-string new-one)))])
+			   (cond
+			    [(and (symbol? parsed)
+				  (hash-table-get (preferences:get 'framework:tabify)
+						  parsed
+						  (lambda () #f)))
+			     (message-box "Error"
+					  (format "\"~a\" is already a specially indented keyword" parsed))]
+			    [(symbol? parsed)
+			     (hash-table-put! (preferences:get 'framework:tabify)
+					      parsed keyword-symbol)
+			     (send list-box append (symbol->string parsed))]
+			    [else (message-box "Error" (format "expected a symbol, found: ~a" new-one))]))))))]
+		[delete-callback
+		 (lambda (list-box)
+		   (lambda (button command)
+		     (let* ([selections (send list-box get-selections)]
+			    [symbols (map (lambda (x) (string->symbol (send list-box get-string x))) selections)])
+		       (for-each (lambda (x) (send list-box delete x)) (reverse selections))
+		       (let ([ht (preferences:get 'framework:tabify)])
+			 (for-each (lambda (x) (hash-table-remove! ht x)) symbols)))))]
+		[main-panel (make-object horizontal-panel% p)]
+		[make-column
+		 (lambda (string symbol keywords)
+		   (let* ([vert (make-object vertical-panel% main-panel)]
+			  [_ (make-object message% (string-append string "-like Keywords") vert)]
+			  [box (make-object list-box% #f keywords vert void '(multiple))]
+			  [button-panel (make-object horizontal-panel% vert)]
+			  [add-button (make-object button% "Add" button-panel (add-callback string symbol box))]
+			  [delete-button (make-object button% "Remove" button-panel (delete-callback box))])
+		     (send* button-panel 
+			    (set-alignment 'center 'center)
+			    (stretchable-height #f))
+		     (send add-button min-width (send delete-button get-width))
+		     box))]
+		[begin-list-box (make-column "Begin" 'begin begin-keywords)]
+		[define-list-box (make-column "Define" 'define define-keywords)]
+		[lambda-list-box (make-column "Lambda" 'lambda lambda-keywords)]
+		[update-list-boxes
+		 (lambda (hash-table)
+		   (let-values ([(begin-keywords define-keywords lambda-keywords) (get-keywords hash-table)]
+				[(reset) (lambda (list-box keywords)
+					   (send list-box clear)
+					   (for-each (lambda (x) (send list-box append x)) keywords))])
+		     (reset begin-list-box begin-keywords)
+		     (reset define-list-box define-keywords)
+		     (reset lambda-list-box lambda-keywords)
+		     #t))])
+	   (preferences:add-callback 'framework:tabify (lambda (p v) (update-list-boxes v)))
+	   main-panel)))))
+
+  )
diff --git a/collects/framework/text.ss b/collects/framework/text.ss
index 31e35ee2..0ca2a663 100644
--- a/collects/framework/text.ss
+++ b/collects/framework/text.ss
@@ -79,7 +79,6 @@
                                [height (- bottom top)])
                            (when (and (> width 0)
                                       (> height 0))
-			     (printf "invalidating ~a ~a ~a ~a~n" left top width height)
                              (invalidate-bitmap-cache left top width height))))]
                       [else (let* ([r (car rectangles)]
                                    
diff --git a/collects/tests/framework/framework-test-engine.ss b/collects/tests/framework/framework-test-engine.ss
index 9f03b9aa..83fdd80f 100644
--- a/collects/tests/framework/framework-test-engine.ss
+++ b/collects/tests/framework/framework-test-engine.ss
@@ -1,4 +1,4 @@
-(require-library "errortrace.ss" "errortrace") (error-print-width 80)
+(require-library "errortrace.ss" "errortrace") (error-print-width 80) (error-context-display-depth 3)
 
 (let* ([errs null]
        [sema (make-semaphore 1)]
diff --git a/collects/tests/framework/main.ss b/collects/tests/framework/main.ss
index 451dc435..dc311d29 100644
--- a/collects/tests/framework/main.ss
+++ b/collects/tests/framework/main.ss
@@ -235,7 +235,8 @@
 
   (define (wait-for-frame name)
     (wait-for `(let ([win (get-top-level-focus-window)])
-		 (and win (string=? (send win get-label) ,name)))))))
+		 (and win
+		      (string=? (send win get-label) ,name)))))))
 
 (define Engine
   (unit/sig Engine^