diff --git a/collects/macro-debugger/expand.ss b/collects/macro-debugger/expand.ss
index 46acecb..4cacf3e 100644
--- a/collects/macro-debugger/expand.ss
+++ b/collects/macro-debugger/expand.ss
@@ -5,11 +5,6 @@
   (provide expand-only
            expand/hide)
   
-  (provide expand/step)
-  (define (expand/step . args)
-    (apply (dynamic-require '(lib "stepper.ss" "macro-debugger") 'expand/step)
-           args))
-  
   (define (expand-only stx show-list)
     (define (show? id)
       (ormap (lambda (x) (module-identifier=? id x))
diff --git a/collects/macro-debugger/model/reductions-engine.ss b/collects/macro-debugger/model/reductions-engine.ss
index c71d9cc..9542b03 100644
--- a/collects/macro-debugger/model/reductions-engine.ss
+++ b/collects/macro-debugger/model/reductions-engine.ss
@@ -23,6 +23,7 @@
            revappend)
   (provide walk
            walk/foci
+           walk/mono
            stumble
            stumble/E)
 
@@ -213,15 +214,21 @@
     (current-frontier
      (apply append (map (make-rename-mapping from to) (current-frontier)))))
 
-  (define (make-rename-mapping from to)
+  (define (make-rename-mapping from0 to0)
     (define table (make-hash-table))
-    (let loop ([from from] [to to])
+    (let loop ([from from0] [to to0])
       (cond [(syntax? from)
              (hash-table-put! table from (flatten-syntaxes to))
              (loop (syntax-e from) to)]
             [(syntax? to)
              (loop from (syntax-e to))]
             [(pair? from)
+             #;(unless (pair? to)
+               (fprintf (current-error-port)
+                        "from:\n~s\n\n" (syntax-object->datum from0))
+               (fprintf (current-error-port)
+                        "to:\n~s\n\n" (syntax-object->datum to0))
+               (error 'frontier-renaming))
              (loop (car from) (car to))
              (loop (cdr from) (cdr to))]
             [(vector? from)
@@ -264,6 +271,12 @@
                (current-definites) (current-frontier)
                (foci foci1) (foci foci2) Ee1 Ee2))
 
+  ;; walk/mono : syntax StepType -> Reduction
+  (define (walk/mono e1 type)
+    (make-mono (current-derivation) (big-context) type (context)
+               (current-definites) (current-frontier)
+               (foci e1) e1))
+  
   ;; stumble : syntax exception -> Reduction
   (define (stumble stx exn)
     (make-misstep (current-derivation) (big-context) 'error (context)
diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.ss
index e896afc..0efbe4a 100644
--- a/collects/macro-debugger/model/reductions.ss
+++ b/collects/macro-debugger/model/reductions.ss
@@ -400,7 +400,7 @@
       [(struct local-lift (expr id))
        (list (walk expr id 'local-lift))]
       [(struct local-lift-end (decl))
-       (list (walk decl decl 'module-lift))]
+       (list (walk/mono decl 'module-lift))]
       [(struct local-bind (deriv))
        (reductions* deriv)]))
 
diff --git a/collects/macro-debugger/model/steps.ss b/collects/macro-debugger/model/steps.ss
index 1de25cc..4ad8e07 100644
--- a/collects/macro-debugger/model/steps.ss
+++ b/collects/macro-debugger/model/steps.ss
@@ -2,6 +2,7 @@
 (module steps mzscheme
   (require "deriv.ss"
            "deriv-util.ss")
+  (provide (all-defined))
 
   ;; A ReductionSequence is a (list-of Reduction)
 
@@ -22,11 +23,13 @@
 
   ;; A Reduction is one of 
   ;;   - (make-step ... Syntaxes Syntaxes Syntax Syntax)
+  ;;   - (make-mono ... Syntaxes Syntax)
   ;;   - (make-misstep ... Syntax Syntax Exception)
 
   (define-struct protostep (deriv lctx type ctx definites frontier) #f)
 
   (define-struct (step protostep) (foci1 foci2 e1 e2) #f)
+  (define-struct (mono protostep) (foci1 e1) #f)
   (define-struct (misstep protostep) (foci1 e1 exn) #f)
 
   ;; context-fill : Context Syntax -> Syntax
@@ -56,6 +59,9 @@
   (define (step-term2 s)
     (context-fill (protostep-ctx s) (step-e2 s)))
 
+  (define (mono-term1 s)
+    (context-fill (protostep-ctx s) (mono-e1 s)))
+
   (define (misstep-term1 s)
     (context-fill (protostep-ctx s) (misstep-e1 s)))
 
@@ -106,40 +112,4 @@
 
   (define (rewrite-step? x)
     (and (step? x) (not (rename-step? x))))
-
-  (provide (all-defined))
-
-  #;(begin
-  (require (lib "contract.ss"))
-  (provide rewrite-step?
-           rename-step?)
-  (provide/contract
-   [step-type->string (any/c . -> . string?)]
-   [step-term1        (step? . -> . syntax?)]
-   [step-term2        (step? . -> . syntax?)]
-   [misstep-term1     (misstep? . -> . syntax?)]
-   [context-fill      ((listof procedure?) syntax? . -> . syntax?)]
-   (struct protostep 
-           ([deriv deriv?]
-            [lctx list?]
-            [type (or/c symbol? boolean?)]
-            [ctx (listof procedure?)]))
-   (struct (step protostep)
-           ([deriv deriv?]
-            [lctx list?]
-            [type (or/c symbol? boolean?)]
-            [ctx (listof procedure?)]
-            [foci1 (listof syntax?)]
-            [foci2 (listof syntax?)]
-            [e1 syntax?]
-            [e2 syntax?]))
-   (struct (misstep protostep)
-           ([deriv deriv?]
-            [lctx list?]
-            [type (or/c symbol? boolean?)]
-            [ctx (listof procedure?)]
-            [foci1 (listof syntax?)]
-            [e1 syntax?]
-            [exn exn?])))
-  )
 )
diff --git a/collects/macro-debugger/stepper.ss b/collects/macro-debugger/stepper.ss
index cc3d64d..624b955 100644
--- a/collects/macro-debugger/stepper.ss
+++ b/collects/macro-debugger/stepper.ss
@@ -5,5 +5,4 @@
   
   (define (expand/step stx)
     (go stx))
-  
   )
diff --git a/collects/macro-debugger/syntax-browser.ss b/collects/macro-debugger/syntax-browser.ss
index ccc0cde..deda135 100644
--- a/collects/macro-debugger/syntax-browser.ss
+++ b/collects/macro-debugger/syntax-browser.ss
@@ -1,8 +1,7 @@
 
 (module syntax-browser mzscheme
-  (require "syntax-browser/browser.ss")
+  (require "syntax-browser/frame.ss")
   (provide browse-syntax
            browse-syntaxes
-           make-syntax-browser
-           syntax-snip)
+           make-syntax-browser)
   )
diff --git a/collects/macro-debugger/syntax-browser/controller.ss b/collects/macro-debugger/syntax-browser/controller.ss
index 9df5c55..3231c9a 100644
--- a/collects/macro-debugger/syntax-browser/controller.ss
+++ b/collects/macro-debugger/syntax-browser/controller.ss
@@ -2,73 +2,75 @@
 (module controller mzscheme
   (require (lib "class.ss")
            "interfaces.ss"
-           "partition.ss")
-  
-  (provide syntax-controller%)
-  
-  ;; syntax-controller%
-  (define syntax-controller%
-    (class* object% (syntax-controller<%>
-                     syntax-pp-snip-controller<%>
-                     color-controller<%>)
-      (init-field (primary-partition (new-bound-partition)))
-      (init-field (properties-controller #f))
+           "partition.ss"
+           "../util/notify.ss")
+  (provide controller%)
 
-      (define colorers null)
-      (define selection-listeners null)
-      (define selected-syntax #f)
-      (define identifier=?-listeners null)
+  ;; displays-manager-mixin
+  (define displays-manager-mixin
+    (mixin () (displays-manager<%>)
+      ;; displays : (list-of display<%>)
+      (field [displays null])
 
-      ;; syntax-controller<%> Methods
+      ;; add-syntax-display : display<%> -> void
+      (define/public (add-syntax-display c)
+        (set! displays (cons c displays)))
 
-      (define/public (select-syntax stx)
-        (set! selected-syntax stx)
-        (send properties-controller set-syntax stx)
-        (for-each (lambda (c) (send c select-syntax stx)) colorers)
-        (for-each (lambda (p) (p stx)) selection-listeners))
+      ;; remove-all-syntax-displays : -> void
+      (define/public (remove-all-syntax-displays)
+        (set! displays null))
 
-      (define/public (get-selected-syntax) selected-syntax)
+      (super-new)))
 
-      (define/public (get-properties-controller) properties-controller)
-      (define/public (set-properties-controller pc)
-        (set! properties-controller pc))
+  ;; selection-manager-mixin
+  (define selection-manager-mixin
+    (mixin (displays-manager<%>) (selection-manager<%>)
+      (inherit-field displays)
+      (field/notify selected-syntax (new notify-box% (value #f)))
 
-      (define/public (add-view-colorer c)
-        (set! colorers (cons c colorers))
-        (send c select-syntax selected-syntax))
-
-      (define/public (get-view-colorers) colorers)
-
-      (define/public (add-selection-listener p)
-        (set! selection-listeners (cons p selection-listeners)))
-      
-      (define/public (on-update-identifier=? name id=?)
-        (set! secondary-partition 
-              (and id=? (new partition% (relation id=?))))
-        (for-each (lambda (c) (send c refresh)) colorers)
-        (for-each (lambda (f) (f name id=?)) identifier=?-listeners))
-      
-      (define/public (add-identifier=?-listener f)
-        (set! identifier=?-listeners
-              (cons f identifier=?-listeners)))
-
-      (define/public (erase)
-        (set! colorers null))
-
-      ;; syntax-pp-snip-controller<%> Methods
-
-      (define/public (on-select-syntax stx)
-        (select-syntax stx))
-
-      ;; color-controller<%> Methods
-
-      (define secondary-partition #f)
-
-      (define/public (get-primary-partition) primary-partition)
-      (define/public (get-secondary-partition) secondary-partition)
-
-      ;; Initialization
       (super-new)
-      ))
-  
+      (listen-selected-syntax
+       (lambda (new-value)
+         (for-each (lambda (display) (send display refresh))
+                   displays)))))
+
+  ;; mark-manager-mixin
+  (define mark-manager-mixin
+    (mixin () (mark-manager<%>)
+      (init-field [primary-partition (new-bound-partition)])
+      (super-new)
+
+      ;; get-primary-partition : -> partition
+      (define/public-final (get-primary-partition)
+        primary-partition)
+
+      ;; reset-primary-partition : -> void
+      (define/public-final (reset-primary-partition)
+        (set! primary-partition (new-bound-partition)))))
+
+  ;; secondary-partition-mixin
+  (define secondary-partition-mixin
+    (mixin (displays-manager<%>) (secondary-partition<%>)
+      (inherit-field displays)
+      (field/notify identifier=? (new notify-box% (value #f)))
+      (field/notify secondary-partition (new notify-box% (value #f)))
+
+      (listen-identifier=?
+       (lambda (name+proc)
+         (set-secondary-partition
+          (and name+proc
+               (new partition% (relation (cdr name+proc)))))))
+      (listen-secondary-partition
+       (lambda (p)
+         (for-each (lambda (d) (send d refresh))
+                   displays)))
+      (super-new)))
+
+  (define controller%
+    (class (secondary-partition-mixin
+            (selection-manager-mixin
+             (mark-manager-mixin
+              (displays-manager-mixin
+               object%))))
+      (super-new)))
   )
diff --git a/collects/macro-debugger/syntax-browser/display.ss b/collects/macro-debugger/syntax-browser/display.ss
new file mode 100644
index 0000000..dd0fbef
--- /dev/null
+++ b/collects/macro-debugger/syntax-browser/display.ss
@@ -0,0 +1,251 @@
+
+(module display mzscheme
+  (require (lib "class.ss")
+           (lib "mred.ss" "mred")
+           (lib "plt-match.ss")
+           "params.ss"
+           "pretty-printer.ss"
+           "interfaces.ss"
+           "util.ss")
+  (provide print-syntax-to-editor
+           code-style)
+
+  ;; print-syntax-to-editor : syntax text controller<%> -> display<%>
+  (define (print-syntax-to-editor stx text controller)
+    (new display% (syntax stx) (text text) (controller controller)))
+
+  ;; FIXME: assumes text never moves
+
+  ;; display%
+  (define display%
+    (class* object% (display<%>)
+      (init ((stx syntax)))
+      (init-field text)
+      (init-field controller)
+
+      (define start-anchor (new anchor-snip%))
+      (define end-anchor (new anchor-snip%))
+      (define range #f)
+      (define extra-styles (make-hash-table))
+
+      ;; render-syntax : syntax -> void
+      (define/public (render-syntax stx)
+        (with-unlock text
+          (send text delete (get-start-position) (get-end-position))
+          (set! range
+                (print-syntax stx text controller
+                              (lambda () (get-start-position))
+                              (lambda () (get-end-position))))
+          (apply-primary-partition-styles))
+        (refresh))
+
+      ;; refresh : -> void
+      ;; Clears all highlighting and reapplies all non-foreground styles.
+      (define/public (refresh)
+        (with-unlock text
+          (send* text 
+            (begin-edit-sequence)
+            (change-style unhighlight-d (get-start-position) (get-end-position)))
+          (apply-extra-styles)
+          (let ([selected-syntax (send controller get-selected-syntax)])
+            (apply-secondary-partition-styles selected-syntax)
+            (apply-selection-styles selected-syntax))
+          (send* text
+            (end-edit-sequence))))
+
+      ;; cached-start-position : number
+      (define cached-start-position #f)
+
+      ;; get-start-position : -> number
+      (define/public-final (get-start-position)
+        (unless cached-start-position
+          (set! cached-start-position (send text get-snip-position start-anchor)))
+        cached-start-position)
+
+      ;; get-end-position : -> number
+      (define/public-final (get-end-position)
+        (send text get-snip-position end-anchor))
+
+      ;; relative->text-position : number -> number
+      ;; FIXME: might be slow to find start every time!
+      (define/public-final (relative->text-position pos)
+        (+ pos (get-start-position)))
+
+      ;; Styling
+
+      ;; get-range : -> range<%>
+      (define/public (get-range) range)
+      
+      ;; highlight-syntaxes : (list-of syntax) string -> void
+      (define/public (highlight-syntaxes stxs hi-color)
+        (let ([style-delta (highlight-style-delta hi-color #f)])
+          (for-each (lambda (stx) (hash-table-put! extra-styles stx style-delta))
+                    stxs))
+        (refresh))
+
+      ;; apply-extra-styles : -> void
+      ;; Applies externally-added styles (such as highlighting)
+      (define/private (apply-extra-styles)
+        (hash-table-for-each
+         extra-styles
+         (lambda (hi-stx style-delta)
+           (let ([rs (send range get-ranges hi-stx)])
+             (for-each (lambda (r) (restyle-range r style-delta)) rs)))))
+
+      ;; apply-secondary-partition-styles : selected-syntax -> void
+      ;; If the selected syntax is an identifier, then styles all identifiers
+      ;; in the same partition in blue.
+      (define/private (apply-secondary-partition-styles selected-syntax)
+        (when (identifier? selected-syntax)
+          (let ([partition (send controller get-secondary-partition)])
+            (when partition
+              (for-each (lambda (id)
+                          (when (send partition same-partition? selected-syntax id)
+                            (draw-secondary-connection id)))
+                        (send range get-identifier-list))))))
+
+      ;; apply-selection-styles : syntax -> void
+      ;; Styles subterms eq to the selected syntax
+      (define/private (apply-selection-styles selected-syntax)
+        (let ([rs (send range get-ranges selected-syntax)])
+          (for-each (lambda (r) (restyle-range r select-highlight-d)) rs)))
+
+      ;; draw-secondary-connection : syntax -> void
+      (define/private (draw-secondary-connection stx2)
+        (let ([rs (send range get-ranges stx2)])
+          (for-each (lambda (r) (restyle-range r select-sub-highlight-d)) rs)))
+
+      ;; restyle-range : (cons num num) style-delta% -> void
+      (define/private (restyle-range r style)
+        (send text change-style style
+              (relative->text-position (car r))
+              (relative->text-position (cdr r))))
+
+      ;; Primary styles
+
+      ;; apply-primary-partition-styles : -> void
+      ;; Changes the foreground color according to the primary partition.
+      ;; Only called once, when the syntax is first drawn.
+      (define/private (apply-primary-partition-styles)
+        (define (color-style color)
+          (let ([delta (new style-delta%)])
+            (send delta set-delta-foreground color)
+            delta))
+        (define color-styles (list->vector (map color-style (current-colors))))
+        (define overflow-style (color-style "darkgray"))
+        (define color-partition (send controller get-primary-partition))
+        (define offset (get-start-position))
+        (for-each
+         (lambda (range)
+           (let ([stx (range-obj range)]
+                 [start (range-start range)]
+                 [end (range-end range)])
+             (send text change-style
+                   (primary-style stx color-partition color-styles overflow-style)
+                   (+ offset start)
+                   (+ offset end))))
+         (send range all-ranges)))
+
+      ;; primary-style : syntax partition (vector-of style-delta%) style-delta%
+      ;;               -> style-delta%
+      (define/private (primary-style stx partition color-vector overflow)
+        (let ([n (send partition get-partition stx)])
+          (cond [(< n (vector-length color-vector))
+                 (vector-ref color-vector n)]
+                [else
+                 overflow])))
+
+      ;; Initialize
+      (super-new)
+      (send text insert start-anchor)
+      (send text insert end-anchor)
+      (render-syntax stx)
+      (send controller add-syntax-display this)))
+
+  ;; print-syntax : syntax controller (-> number) (-> number)
+  ;;                -> range%
+  (define (print-syntax stx text controller
+                        get-start-position get-end-position)
+    (define primary-partition (send controller get-primary-partition))
+    (define real-output-port (make-text-port text get-end-position))
+    (define output-port (open-output-string))
+
+    (port-count-lines! output-port)
+    (let ([range (pretty-print-syntax stx output-port primary-partition)])
+      (write-string (get-output-string output-port) real-output-port)
+      (let ([end (get-end-position)])
+        ;; Pretty printer always inserts final newline; we remove it here.
+        (send text delete (sub1 end) end))
+      ;; Set font to standard
+      (send text change-style
+            (code-style text)
+            (get-start-position)
+            (get-end-position))
+      (let ([offset (get-start-position)])
+        (fixup-parentheses text range offset)
+        (for-each
+         (lambda (range)
+           (let* ([stx (range-obj range)]
+                  [start (range-start range)]
+                  [end (range-end range)])
+             (send text set-clickback (+ offset start) (+ offset end)
+                   (lambda (_1 _2 _3)
+                     (send controller set-selected-syntax stx)))))
+         (send range all-ranges))
+        range)))
+
+  ;; fixup-parentheses : text range -> void
+  (define (fixup-parentheses text range offset)
+    (define (fixup r)
+      (let ([stx (range-obj r)]
+            [start (+ offset (range-start r))]
+            [end (+ offset (range-end r))])
+        (when (and (syntax? stx) (pair? (syntax-e stx)))
+          (case (syntax-property stx 'paren-shape)
+            ((#\[)
+             (replace start #\[)
+             (replace (sub1 end) #\]))
+            ((#\{) 
+             (replace start #\{)
+             (replace (sub1 end) #\}))))))
+    (define (replace pos char)
+      (send text insert char pos (add1 pos)))
+    (for-each fixup (send range all-ranges)))
+
+  ;; code-style : text<%> -> style<%>
+  (define (code-style text)
+    (let* ([style-list (send text get-style-list)]
+           [style (send style-list find-named-style "Standard")]
+           [font-size (current-syntax-font-size)])
+      (if font-size
+          (send style-list find-or-create-style
+                style
+                (make-object style-delta% 'change-size font-size))
+          style)))
+
+  ;; anchor-snip%
+  (define anchor-snip%
+    (class snip%
+      (define/override (copy)
+        (make-object string-snip% ""))
+      (super-instantiate ())))
+
+  ;; Styles
+
+  (define (highlight-style-delta color em?)
+    (let ([sd (new style-delta%)])
+      (unless em? (send sd set-delta-background color))
+      (when em? (send sd set-weight-on 'bold))
+      (unless em? (send sd set-underlined-off #t)
+        (send sd set-weight-off 'bold))
+      sd))
+
+  (define selection-color "yellow")
+  (define subselection-color "yellow")
+
+  (define select-highlight-d (highlight-style-delta selection-color #t))
+  (define select-sub-highlight-d (highlight-style-delta subselection-color #f))
+
+  (define unhighlight-d (highlight-style-delta "white" #f))
+
+  )
diff --git a/collects/macro-debugger/syntax-browser/embed.ss b/collects/macro-debugger/syntax-browser/embed.ss
index 1a77f20..69ad4e0 100644
--- a/collects/macro-debugger/syntax-browser/embed.ss
+++ b/collects/macro-debugger/syntax-browser/embed.ss
@@ -3,13 +3,11 @@
   (require "interfaces.ss"
            "widget.ss"
            "keymap.ss"
-           "implementation.ss"
            "params.ss"
            "partition.ss")
   
   (provide (all-from "interfaces.ss")
            (all-from "widget.ss")
            (all-from "keymap.ss")
-           (all-from "implementation.ss")
            (all-from "params.ss")
            identifier=-choices))
diff --git a/collects/macro-debugger/syntax-browser/frame.ss b/collects/macro-debugger/syntax-browser/frame.ss
index eb478d1..a94f5c7 100644
--- a/collects/macro-debugger/syntax-browser/frame.ss
+++ b/collects/macro-debugger/syntax-browser/frame.ss
@@ -1,97 +1,96 @@
 
 (module frame mzscheme
   (require (lib "class.ss")
-           (lib "unit.ss")
            (lib "mred.ss" "mred")
            (lib "framework.ss" "framework")
            (lib "list.ss")
-           "interfaces.ss"
-           "partition.ss")
-  (provide frame@)
-  
-  (define frame@
-    (unit
-      (import prefs^
-              widget^)
-      (export browser^)
+           "partition.ss"
+           "prefs.ss"
+           "widget.ss")
+  (provide browse-syntax
+           browse-syntaxes
+           make-syntax-browser
+           syntax-browser-frame%
+           syntax-widget/controls%)
 
-      ;; browse-syntax : syntax -> void
-      (define (browse-syntax stx)
-        (browse-syntaxes (list stx)))
-      
-      ;; browse-syntaxes : (list-of syntax) -> void
-      (define (browse-syntaxes stxs)
-        (let ((w (make-syntax-browser)))
-          (for-each (lambda (stx)
-                      (send w add-syntax stx)
-                      (send w add-separator))
-                    stxs)))
-      
-      ;; make-syntax-browser : -> syntax-browser<%>
-      (define (make-syntax-browser)
-        (let* ([view (new syntax-browser-frame%)])
-          (send view show #t)
-          (send view get-widget)))
-      
-      ;; syntax-browser-frame%
-      (define syntax-browser-frame%
-        (class* frame% ()
-          (super-new (label "Syntax Browser")
-                     (width (pref:width))
-                     (height (pref:height)))
-          (define widget
-            (new syntax-widget/controls%
-                 (parent this)
-                 (pref:props-percentage pref:props-percentage)))
-          (define/public (get-widget) widget)
-          (define/augment (on-close)
-            (pref:width (send this get-width))
-            (pref:height (send this get-height))
-            (send widget save-prefs)
-            (inner (void) on-close))
-          ))
-      
-      ;; syntax-widget/controls%
-      (define syntax-widget/controls%
-        (class* syntax-widget% ()
-          (inherit get-main-panel
-                   get-controller
-                   toggle-props)
-          (super-new)
-          
-          (define -control-panel 
-            (new horizontal-pane% (parent (get-main-panel)) (stretchable-height #f)))
-          
-          ;; Put the control panel up front
-          (send (get-main-panel) change-children
-                (lambda (children)
-                  (cons -control-panel (remq -control-panel children))))
-          
-          (define -identifier=-choices (identifier=-choices))
-          (define -choice
-            (new choice% (label "identifer=?") (parent -control-panel)
-                 (choices (map car -identifier=-choices))
-                 (callback (lambda _ (on-update-identifier=?-choice)))))
-          (new button% 
-               (label "Clear")
-               (parent -control-panel)
-               (callback (lambda _ (send (get-controller) select-syntax #f))))
-          (new button%
-               (label "Properties")
-               (parent -control-panel)
-               (callback (lambda _ (toggle-props))))
-          
-          (define/private (on-update-identifier=?-choice)
-            (cond [(assoc (send -choice get-string-selection)
-                          -identifier=-choices)
-                   => (lambda (p)
-                        (send (get-controller)
-                              on-update-identifier=? (car p) (cdr p)))]
-                  [else #f]))
-          (send (get-controller) add-identifier=?-listener
-                (lambda (name func)
-                  (send -choice set-selection
-                        (or (send -choice find-string name) 0))))))
-      
+  ;; browse-syntax : syntax -> void
+  (define (browse-syntax stx)
+    (browse-syntaxes (list stx)))
+
+  ;; browse-syntaxes : (list-of syntax) -> void
+  (define (browse-syntaxes stxs)
+    (let ((w (make-syntax-browser)))
+      (for-each (lambda (stx)
+                  (send w add-syntax stx)
+                  (send w add-separator))
+                stxs)))
+
+  ;; make-syntax-browser : -> syntax-browser<%>
+  (define (make-syntax-browser)
+    (let* ([view (new syntax-browser-frame%)])
+      (send view show #t)
+      (send view get-widget)))
+
+  ;; syntax-browser-frame%
+  (define syntax-browser-frame%
+    (class* frame% ()
+      (init-field [config (new syntax-prefs%)])
+      (super-new (label "Syntax Browser")
+                 (width (send config pref:width))
+                 (height (send config pref:height)))
+      (define widget
+        (new syntax-widget/controls%
+             (parent this)
+             (config config)))
+      (define/public (get-widget) widget)
+      (define/augment (on-close)
+        (send config pref:width (send this get-width))
+        (send config pref:height (send this get-height))
+        (send widget shutdown)
+        (inner (void) on-close))
       ))
+
+  ;; syntax-widget/controls%
+  (define syntax-widget/controls%
+    (class* widget% ()
+      (inherit get-main-panel
+               get-controller
+               toggle-props)
+      (super-new)
+      (inherit-field config)
+
+      (define -control-panel 
+        (new horizontal-pane%
+             (parent (get-main-panel))
+             (stretchable-height #f)))
+
+      ;; Put the control panel up front
+      (send (get-main-panel) change-children
+            (lambda (children)
+              (cons -control-panel (remq -control-panel children))))
+
+      (define -identifier=-choices (identifier=-choices))
+      (define -choice
+        (new choice% (label "identifer=?") (parent -control-panel)
+             (choices (map car -identifier=-choices))
+             (callback 
+              (lambda (c e)
+                (send (get-controller) set-identifier=?
+                      (assoc (send c get-string-selection)
+                             -identifier=-choices))))))
+      (new button% 
+           (label "Clear")
+           (parent -control-panel)
+           (callback (lambda _ (send (get-controller) select-syntax #f))))
+      (new button%
+           (label "Properties")
+           (parent -control-panel)
+           (callback (lambda _ (toggle-props))))
+
+      (send (get-controller) listen-identifier=?
+            (lambda (name+func)
+              (send -choice set-selection
+                    (or (send -choice find-string (car name+func)) 0))))
+      ))
+
   )
diff --git a/collects/macro-debugger/syntax-browser/interfaces.ss b/collects/macro-debugger/syntax-browser/interfaces.ss
index 32af451..240ddb8 100644
--- a/collects/macro-debugger/syntax-browser/interfaces.ss
+++ b/collects/macro-debugger/syntax-browser/interfaces.ss
@@ -1,130 +1,150 @@
 
 (module interfaces mzscheme
-  (require (lib "class.ss")
-           (lib "unit.ss"))
+  (require (lib "class.ss"))
   (provide (all-defined))
 
-  ;; Signatures
-  
-  (define-signature browser^
-    (;; browse-syntax : syntax -> void
-     browse-syntax
-     
-     ;; browse-syntaxes : (list-of syntax) -> void
-     browse-syntaxes
-     
-     ;; make-syntax-browser : -> syntax-browser<%>
-     make-syntax-browser
-     
-     ;; syntax-widget/controls%
-     syntax-widget/controls%
-     
-     ;; syntax-browser-frame%
-     syntax-browser-frame%))
-
-  (define-signature prefs^
-    (;; pref:width : pref of number
-     pref:width
-     
-     ;; pref:height : pref of number
-     pref:height
-     
-     ;; pref:props-percentage : pref of number in (0,1)
-     pref:props-percentage))
-
-  (define-signature keymap^
-    (;; syntax-keymap% implements syntax-keymap<%>
-     syntax-keymap%))
-  
-  (define-signature context-menu^
-    (;; context-menu%
-     context-menu%))
-
-  (define-signature snip^
-    (;; syntax-snip : syntax -> snip
-     syntax-snip
-     
-     ;; syntax-snip%
-     syntax-snip%))
-
-  (define-signature snipclass^
-    (;; snip-class
-     snip-class))
-  
-  (define-signature widget^
-    (;; syntax-widget%
-     syntax-widget%))
-
-  ;; Class Interfaces
-
-  ;; syntax-controller<%>
-  ;; A syntax-controller coordinates state shared by many different syntax views.
-  ;; Syntax views can share:
-  ;;   - selection
-  ;;   - partitioning configuration
-  ;;   - property display
-  (define syntax-controller<%>
+  ;; displays-manager<%>
+  (define displays-manager<%>
     (interface ()
-      ;; select-syntax : syntax -> void
-      select-syntax
-      
-      ;; get-selected-syntax : -> syntax/#f
+      ;; add-syntax-display : display<%> -> void
+      add-syntax-display
+
+      ;; remove-all-syntax-displays : -> void
+      remove-all-syntax-displays))
+
+  ;; selection-manager<%>
+  (define selection-manager<%>
+    (interface ()
+      ;; set-selected-syntax : syntax -> void
+      set-selected-syntax
+
+      ;; get-selected-syntax : -> syntax
       get-selected-syntax
-      
-      ;; get-properties-controller : -> syntax-properties-controller<%>
-      get-properties-controller
-      
-      ;; add-view-colorer : syntax-colorer<%> -> void
-      add-view-colorer
-      
-      ;; get-view-colorers : -> (list-of syntax-colorer<%>)
-      get-view-colorers
-      
-      ;; add-selection-listener : syntax -> void
-      add-selection-listener
-      ))
 
-  ;; syntax-properties-controller<%>
-  (define syntax-properties-controller<%>
-    (interface ()
-      ;; set-syntax : syntax -> void
-      set-syntax
-      
-      ;; show : boolean -> void
-      #;show
-      
-      ;; props-shown? : -> boolean
-      props-shown?))
+      ;; listen-selected-syntax : (syntax -> void) -> void
+      listen-selected-syntax))
 
-  ;; syntax-configuration<%>
-  (define syntax-configuration<%>
+  ;; mark-manager<%>
+  ;; Manages marks, mappings from marks to colors
+  (define mark-manager<%>
     (interface ()
-      ;; get-primary-partition : -> partition<%>
-      get-primary-partition
-      
+      ;; get-primary-partition : -> partition
+      get-primary-partition))
+
+  ;; secondary-partition<%>
+  (define secondary-partition<%>
+    (interface (displays-manager<%>)
       ;; get-secondary-partition : -> partition<%>
       get-secondary-partition
-      
-      ;; update-identifier=? : ... -> void
-      update-identifier=?))
 
-  
-  ;; syntax-colorer<%>
-  (define syntax-colorer<%>
-    (interface ()
-      select-syntax
-      apply-styles))
+      ;; set-secondary-partition : partition<%> -> void
+      set-secondary-partition
 
-  ;; syntax-sharing-context<%>
-  ;; A syntax-sharing-context<%> 
-  ;; Syntax snips search their enclosing editors for instances of sharing contexts
-  (define syntax-sharing-context<%>
+      ;; listen-secondary-partition : (partition<%> -> void) -> void
+      listen-secondary-partition
+
+      ;; get-identifier=? : -> (cons string procedure)
+      get-identifier=?
+
+      ;; set-identifier=? : (cons string procedure) -> void
+      set-identifier=?
+
+      ;; listen-identifier=? : ((cons string procedure) -> void) -> void
+      listen-identifier=?))
+
+  ;; controller<%>
+  (define controller<%>
+    (interface (displays-manager<%>
+                selection-manager<%>
+                mark-manager<%> 
+                secondary-partition<%>)))
+
+  ;; host<%>
+  (define host<%>
     (interface ()
-      ;; get-shared-partition
-      get-shared-partition))
+      ;; get-controller : -> controller<%>
+      get-controller
+
+      ;; add-keymap : text snip
+      add-keymap
+      ))
+
+
+  ;; display<%>
+  (define display<%>
+    (interface ()
+      ;; refresh : -> void
+      refresh
+
+      ;; highlight-syntaxes : (list-of syntax) color -> void
+      highlight-syntaxes
+
+      ;; get-start-position : -> number
+      get-start-position
+
+      ;; get-end-position : -> number
+      get-end-position
+
+      ;; get-range : -> range<%>
+      get-range))
+
+  ;; range<%>
+  (define range<%>
+    (interface ()
+      ;; get-ranges : datum -> (list-of (cons number number))
+      get-ranges
+
+      ;; all-ranges : (list-of Range)
+      ;; Sorted outermost-first
+      all-ranges
+
+      ;; get-identifier-list : (list-of identifier)
+      get-identifier-list))
+
+  ;; A Range is (make-range datum number number)
+  (define-struct range (obj start end))
+
+
+  ;; syntax-prefs<%>
+  (define syntax-prefs<%>
+    (interface ()
+      pref:width
+      pref:height
+      pref:props-percentage
+      pref:props-shown?))
+
+  ;; widget-hooks<%>
+  (define widget-hooks<%>
+    (interface ()
+      ;; setup-keymap : -> void
+      setup-keymap
+
+      ;; shutdown : -> void
+      shutdown
+      ))
+
+  ;; keymap-hooks<%>
+  (define keymap-hooks<%>
+    (interface ()
+      ;; make-context-menu : -> context-menu<%>
+      make-context-menu
+
+      ;; get-context-menu% : -> class
+      get-context-menu%))
+
+  ;; context-menu-hooks<%>
+  (define context-menu-hooks<%>
+    (interface ()
+      add-edit-items
+      after-edit-items
+      add-selection-items
+      after-selection-items
+      add-partition-items
+      after-partition-items))
+
 
   ;;----------
-  
+
   ;; Convenience widget, specialized for displaying stx and not much else
   (define syntax-browser<%>
     (interface ()
@@ -135,51 +155,16 @@
       select-syntax
       get-text
       ))
-  
+
   (define partition<%>
     (interface ()
       ;; get-partition : any -> number
       get-partition
-      
+
       ;; same-partition? : any any -> number
       same-partition?
-      
+
       ;; count : -> number
       count))
-      
-  ;; Internal interfaces
-  
-  (define syntax-pp-snip-controller<%>
-    (interface ()
-      on-select-syntax
-      ))
-
-  (define color-controller<%>
-    (interface ()
-      get-primary-partition
-      get-secondary-partition
-      ))
-
-  (define syntax-pp<%>
-    (interface ()
-      pretty-print-syntax
-
-      get-range
-      get-identifier-list
-      flat=>stx
-      stx=>flat))
-
-  (define typesetter<%>
-    (interface ()
-      get-output-port
-      get-current-position))
-
-  (define range<%>
-    (interface ()
-      get-start
-      set-start
-      get-ranges
-      add-range
-      all-ranges))
 
   )
diff --git a/collects/macro-debugger/syntax-browser/keymap.ss b/collects/macro-debugger/syntax-browser/keymap.ss
index 4ca331f..b32ad3f 100644
--- a/collects/macro-debugger/syntax-browser/keymap.ss
+++ b/collects/macro-debugger/syntax-browser/keymap.ss
@@ -1,177 +1,152 @@
 
 (module keymap mzscheme
   (require (lib "class.ss")
-           (lib "unit.ss")
            (lib "mred.ss" "mred")
            "interfaces.ss"
            "partition.ss")
-  (provide keymap@
-           context-menu@)
-  
-  (define context-menu@
-    (unit
-      (import)
-      (export context-menu^)
+  (provide syntax-keymap%
+           context-menu%)
 
-      (define context-menu%
-        (class popup-menu%
-          (init-field keymap)
-          (init-field controller)
-          (super-new)
-          
-          (field [copy-menu #f]
-                 [copy-syntax-menu #f]
-                 [clear-menu #f]
-                 [props-menu #f])
-          
-          (define/public (add-edit-items)
-            (set! copy-menu
-                  (new menu-item% (label "Copy") (parent this)
-                       (callback (lambda (i e)
-                                   (send keymap call-function "copy-text" i e)))))
-            (set! copy-syntax-menu
-                  (new menu-item% (label "Copy syntax") (parent this)
-                       (callback (lambda (i e)
-                                   (send keymap call-function "copy-syntax" i e)))))
-            (void))
+  (define syntax-keymap%
+    (class keymap%
+      (init editor)
+      (init-field controller)
 
-          (define/public (after-edit-items)
-            (void))
+      (inherit add-function
+               map-function
+               chain-to-keymap)
+      (super-new)
 
-          (define/public (add-selection-items)
-            (set! clear-menu
-                  (new menu-item%
-                       (label "Clear selection")
-                       (parent this)
-                       (callback 
-                        (lambda (i e)
-                          (send keymap call-function "clear-syntax-selection" i e)))))
-            (set! props-menu
-                  (new menu-item%
-                       (label "Show syntax properties")
-                       (parent this)
-                       (callback 
-                        (lambda (i e) 
-                          (send keymap call-function "show-syntax-properties" i e)))))
-            (void))
-          
-          (define/public (after-selection-items)
-            (void))
+      (define/public (get-context-menu%)
+        context-menu%)
 
-          (define/public (add-partition-items)
-            (let ([secondary (new menu% (label "identifier=?") (parent this))])
-              (for-each
-               (lambda (name func)
-                 (let ([this-choice
-                        (new checkable-menu-item%
-                             (label name)
-                             (parent secondary)
-                             (callback 
-                              (lambda (i e)
-                                (send controller on-update-identifier=? name func))))])
-                   (send controller add-identifier=?-listener
-                         (lambda (new-name new-id=?) 
-                           (send this-choice check (eq? name new-name))))))
-               (map car (identifier=-choices))
-               (map cdr (identifier=-choices))))
-            (void))
-          
-          (define/public (after-partition-items)
-            (void))
+      (define/public (make-context-menu)
+        (new (get-context-menu%) (controller controller) (keymap this)))
 
-          (define/public (add-separator)
-            (new separator-menu-item% (parent this)))
-          
-          (define/override (on-demand)
-            (define stx (send controller get-selected-syntax))
-            (send copy-menu enable (and stx #t))
-            (send copy-syntax-menu enable (and stx #t))
-            (send clear-menu enable (and stx #t))
-            (super on-demand))
+      ;; Key mappings
 
-          ;; Initialization
-          (add-edit-items)
-          (after-edit-items)
+      (map-function "rightbutton" "popup-context-window")
 
-          (add-separator)
-          (add-selection-items)
-          (after-selection-items)
+      ;; Functionality
 
-          (add-separator)
-          (add-partition-items)
-          (after-partition-items)
+      (add-function "popup-context-window"
+                    (lambda (editor event)
+                      (do-popup-context-window editor event)))
 
-          ))))
-  
-  (define keymap@
-    (unit
-      (import context-menu^ snip^)
-      (export keymap^)
-      
-      (define syntax-keymap%
-        (class keymap%
-          (init editor)
-          (init-field controller)
-          
-          (inherit add-function
-                   map-function
-                   chain-to-keymap)
-          (super-new)
-          
-          (define context-menu (make-context-menu))
-          
-          (define/public (make-context-menu)
-            (new context-menu% (controller controller) (keymap this)))
-          
-          ;; Key mappings
+      (add-function "copy-text"
+                    (lambda (_ event)
+                      (define stx (send controller get-selected-syntax))
+                      (send the-clipboard set-clipboard-string
+                            (if stx 
+                                (format "~s" (syntax-object->datum stx))
+                                "")
+                            (send event get-time-stamp))))
 
-          (map-function "rightbutton" "popup-context-window")
-          
-          ;; Functionality
-          
-          (add-function "popup-context-window"
-                        (lambda (editor event)
-                          (do-popup-context-window editor event)))
-          
-          (add-function "copy-text"
-                        (lambda (_ event)
-                          (define stx (send controller get-selected-syntax))
-                          (send the-clipboard set-clipboard-string
-                                (if stx 
-                                    (format "~s" (syntax-object->datum stx))
-                                    "")
-                                (send event get-time-stamp))))
-          
-          (add-function "copy-syntax"
-                        (lambda (_ event)
-                          (define stx (send controller get-selected-syntax))
-                          (define t (new text%))
-                          (send t insert
-                                (new syntax-snip%
-                                     (syntax stx)))
-                          (send t select-all)
-                          (send t copy)))
-          
-          (add-function "clear-syntax-selection"
-                        (lambda (i e)
-                          (send controller select-syntax #f)))
-          
-          (add-function "show-syntax-properties"
-                        (lambda (i e)
-                          (error 'show-syntax-properties "not provided by this keymap")))
-          
-          ;; Attach to editor
+      (add-function "clear-syntax-selection"
+                    (lambda (i e)
+                      (send controller set-selected-syntax #f)))
+
+      (add-function "show-syntax-properties"
+                    (lambda (i e)
+                      (error 'show-syntax-properties "not provided by this keymap")))
+
+      ;; Attach to editor
+
+      (chain-to-keymap (send editor get-keymap) #t)
+      (send editor set-keymap this)
+
+      (define/public (get-controller) controller)
+
+      (define/private (do-popup-context-window editor event)
+        (define-values (x y)
+          (send editor dc-location-to-editor-location
+                (send event get-x)
+                (send event get-y)))
+        (define admin (send editor get-admin))
+        (send admin popup-menu (make-context-menu) x y))))
+
+  (define context-menu%
+    (class popup-menu%
+      (init-field keymap)
+      (init-field controller)
+      (super-new)
+
+      (field [copy-menu #f]
+             [clear-menu #f]
+             [props-menu #f])
+
+      (define/public (add-edit-items)
+        (set! copy-menu
+              (new menu-item% (label "Copy") (parent this)
+                   (callback (lambda (i e)
+                               (send keymap call-function "copy-text" i e)))))
+        (void))
+
+      (define/public (after-edit-items)
+        (void))
+
+      (define/public (add-selection-items)
+        (set! clear-menu
+              (new menu-item%
+                   (label "Clear selection")
+                   (parent this)
+                   (callback 
+                    (lambda (i e)
+                      (send keymap call-function "clear-syntax-selection" i e)))))
+        (set! props-menu
+              (new menu-item%
+                   (label "Show syntax properties")
+                   (parent this)
+                   (callback 
+                    (lambda (i e) 
+                      (send keymap call-function "show-syntax-properties" i e)))))
+        (void))
+
+      (define/public (after-selection-items)
+        (void))
+
+      (define/public (add-partition-items)
+        (let ([secondary (new menu% (label "identifier=?") (parent this))])
+          (for-each
+           (lambda (name func)
+             (let ([this-choice
+                    (new checkable-menu-item%
+                         (label name)
+                         (parent secondary)
+                         (callback 
+                          (lambda (i e)
+                            (send controller set-identifier=? 
+                                  (cons name func)))))])
+               (send controller listen-identifier=?
+                     (lambda (name+proc)
+                       (send this-choice check (eq? name (car name+proc)))))))
+           (map car (identifier=-choices))
+           (map cdr (identifier=-choices))))
+        (void))
+
+      (define/public (after-partition-items)
+        (void))
+
+      (define/public (add-separator)
+        (new separator-menu-item% (parent this)))
+
+      (define/override (on-demand)
+        (define stx (send controller get-selected-syntax))
+        (send copy-menu enable (and stx #t))
+        (send clear-menu enable (and stx #t))
+        (super on-demand))
+
+      ;; Initialization
+      (add-edit-items)
+      (after-edit-items)
+
+      (add-separator)
+      (add-selection-items)
+      (after-selection-items)
+
+      (add-separator)
+      (add-partition-items)
+      (after-partition-items)
+      ))
 
-          (chain-to-keymap (send editor get-keymap) #t)
-          (send editor set-keymap this)
-          
-          (define/public (get-controller) controller)
-          
-          (define/private (do-popup-context-window editor event)
-            (define-values (x y)
-              (send editor dc-location-to-editor-location
-                    (send event get-x)
-                    (send event get-y)))
-            (define admin (send editor get-admin))
-            (send admin popup-menu context-menu x y))))))
   )
diff --git a/collects/macro-debugger/syntax-browser/prefs.ss b/collects/macro-debugger/syntax-browser/prefs.ss
index 233b356..7366a9e 100644
--- a/collects/macro-debugger/syntax-browser/prefs.ss
+++ b/collects/macro-debugger/syntax-browser/prefs.ss
@@ -1,31 +1,32 @@
 
 (module prefs mzscheme
-  (require (lib "unit.ss")
+  (require (lib "class.ss")
            (lib "framework.ss" "framework")
-           "interfaces.ss")
-  (provide prefs@)
-  
-  (define-syntax pref:get/set
-    (syntax-rules ()
-      [(_ get/set prop)
-       (define get/set
-         (case-lambda
-           [() (preferences:get 'prop)]
-           [(newval) (preferences:set 'prop newval)]))]))
+           "interfaces.ss"
+           "../util/misc.ss")
+  (provide syntax-prefs%
+           syntax-prefs-mixin
 
-  (define prefs@
-    (unit
-      (import)
-      (export prefs^)
-      
-      (preferences:set-default 'SyntaxBrowser:Width 700 number?)
-      (preferences:set-default 'SyntaxBrowser:Height 600 number?)
-      (preferences:set-default 'SyntaxBrowser:PropertiesPanelPercentage 1/3 number?)
-      (preferences:set-default 'SyntaxBrowser:PropertiesPanelShown #t boolean?)
-      
-      (pref:get/set pref:width SyntaxBrowser:Width)
-      (pref:get/set pref:height SyntaxBrowser:Height)
-      (pref:get/set pref:props-percentage SyntaxBrowser:PropertiesPanelPercentage)
-      (pref:get/set pref:props-shown? SyntaxBrowser:PropertiesPanelShown)))
-  
+           pref:tabify)
+
+  (preferences:set-default 'SyntaxBrowser:Width 700 number?)
+  (preferences:set-default 'SyntaxBrowser:Height 600 number?)
+  (preferences:set-default 'SyntaxBrowser:PropertiesPanelPercentage 1/3 number?)
+  (preferences:set-default 'SyntaxBrowser:PropertiesPanelShown #t boolean?)
+
+  (pref:get/set pref:width SyntaxBrowser:Width)
+  (pref:get/set pref:height SyntaxBrowser:Height)
+  (pref:get/set pref:props-percentage SyntaxBrowser:PropertiesPanelPercentage)
+  (pref:get/set pref:props-shown? SyntaxBrowser:PropertiesPanelShown)
+
+  (pref:get/set pref:tabify framework:tabify)
+
+  (define syntax-prefs-mixin
+    (closure-mixin (syntax-prefs<%>)
+      (pref:width pref:width)
+      (pref:height pref:height)
+      (pref:props-percentage pref:props-percentage)
+      (pref:props-shown? pref:props-shown?)))
+
+  (define syntax-prefs% (syntax-prefs-mixin object%))
   )
diff --git a/collects/macro-debugger/syntax-browser/pretty-helper.ss b/collects/macro-debugger/syntax-browser/pretty-helper.ss
index b214466..1353a0b 100644
--- a/collects/macro-debugger/syntax-browser/pretty-helper.ss
+++ b/collects/macro-debugger/syntax-browser/pretty-helper.ss
@@ -1,3 +1,4 @@
+
 (module pretty-helper mzscheme
   (require (lib "class.ss")
            (lib "stx.ss" "syntax")
diff --git a/collects/macro-debugger/syntax-browser/pretty-printer.ss b/collects/macro-debugger/syntax-browser/pretty-printer.ss
index f845fa6..730c4d5 100644
--- a/collects/macro-debugger/syntax-browser/pretty-printer.ss
+++ b/collects/macro-debugger/syntax-browser/pretty-printer.ss
@@ -6,108 +6,156 @@
            (lib "class.ss")
            (lib "pretty.ss")
            (lib "mred.ss" "mred")
-           "pretty-range.ss"
            "pretty-helper.ss"
            "interfaces.ss"
-           "params.ss")
-  (provide syntax-pp%
-           (struct range (obj start end)))
+           "params.ss"
+           "prefs.ss")
 
-  ;; syntax-pp%
-  ;; Pretty printer for syntax objects.
-  (define syntax-pp%
-    (class* object% (syntax-pp<%>)
-      (init-field main-stx)
-      (init-field typesetter)
-      (init-field (primary-partition #f))
-      (init-field (columns (current-default-columns)))
+  (provide pretty-print-syntax)
 
-      (unless (syntax? main-stx)
-        (error 'syntax-pretty-printer "got non-syntax object: ~s" main-stx))
+  ;; pretty-print-syntax : syntax port partition -> range%
+  (define (pretty-print-syntax stx port primary-partition)
+    (define range-builder (new range-builder%))
+    (define-values (datum ht:flat=>stx ht:stx=>flat)
+      (syntax->datum/tables stx primary-partition
+                            (length (current-colors))
+                            (current-suffix-option)))
+    (define identifier-list
+      (filter identifier? (hash-table-map ht:stx=>flat (lambda (k v) k))))
+    (define (flat=>stx obj)
+      (hash-table-get ht:flat=>stx obj))
+    (define (stx=>flat stx)
+      (hash-table-get ht:stx=>flat stx))
+    (define (current-position)
+      (let-values ([(line column position) (port-next-location port)])
+        (sub1 position)))
+    (define (pp-pre-hook obj port)
+      (send range-builder set-start obj (current-position)))
+    (define (pp-post-hook obj port)
+      (let ([start (send range-builder get-start obj)]
+            [end (current-position)]
+            [stx (flat=>stx obj)])
+        (when (and start stx)
+          (send range-builder add-range stx (cons start end)))))
+    (define (pp-extend-style-table identifier-list)
+      (let* ([syms (map (lambda (x) (stx=>flat x)) identifier-list)]
+             [like-syms (map syntax-e identifier-list)])
+        (pretty-print-extend-style-table (pp-better-style-table)
+                                         syms
+                                         like-syms)))
 
-      (define datum #f)
-      (define ht:flat=>stx #f)
-      (define ht:stx=>flat #f)
-      (define identifier-list null)
-      (define -range #f)
-      
-      (define/public (get-range) -range)
-      (define/public (get-identifier-list) identifier-list)
-      (define/public (flat=>stx obj)
-        (hash-table-get ht:flat=>stx obj))
-      (define/public (stx=>flat obj)
-        (hash-table-get ht:stx=>flat obj))
-      
-      (define/public (pretty-print-syntax)
-        (define range (new ranges%))
-        (define (pp-pre-hook obj port)
-          (send range set-start obj (send typesetter get-current-position)))
-        (define (pp-post-hook obj port)
-          (let ([start (send range get-start obj)]
-                [end (send typesetter get-current-position)])
-            (when start
-              (send range add-range
-                    (flat=>stx obj)
-                    (cons start end)))))
-        (define (pp-size-hook obj display-like? port)
-          (cond [(is-a? obj editor-snip%)
-                 columns]
-                [(syntax-dummy? obj)
-                 (let ((ostring (open-output-string)))
-                   ((if display-like? display write) (syntax-dummy-val obj) ostring)
-                   (string-length (get-output-string ostring)))]
-                [else #f]))
-        (define (pp-print-hook obj display-like? port)
-          (cond [(syntax-dummy? obj)
-                 ((if display-like? display write) (syntax-dummy-val obj) port)]
-                [(is-a? obj editor-snip%)
-                 (write-special obj port)]
-                [else 
-                 (error 'pretty-print-hook "unexpected special value: ~e" obj)]))
-        (define (pp-extend-style-table)
-          (let* ([ids identifier-list]
-                 [syms (map (lambda (x) (stx=>flat x)) ids)]
-                 [like-syms (map syntax-e ids)])
-            (pretty-print-extend-style-table (pp-better-style-table)
-                                             syms
-                                             like-syms)))
-        (define (pp-better-style-table)
-          (pretty-print-extend-style-table (pretty-print-current-style-table)
-                                           (map car extended-style-list)
-                                           (map cdr extended-style-list)))
-        
-        (parameterize 
-            ([pretty-print-pre-print-hook pp-pre-hook]
-             [pretty-print-post-print-hook pp-post-hook]
-             [pretty-print-size-hook pp-size-hook]
-             [pretty-print-print-hook pp-print-hook]
-             [pretty-print-columns columns]
-             [pretty-print-current-style-table (pp-extend-style-table)]
-             ;; Printing parameters (mzscheme manual 7.9.1.4)
-             [print-unreadable #t]
-             [print-graph #f]
-             [print-struct #f]
-             [print-box #t]
-             [print-vector-length #t]
-             [print-hash-table #f]
-             [print-honu #f])
-          (pretty-print datum (send typesetter get-output-port))
-          (set! -range range)))
 
-      ;; recompute-tables : -> void
-      (define/private (recompute-tables)
-        (set!-values (datum ht:flat=>stx ht:stx=>flat)
-                     (syntax->datum/tables main-stx primary-partition
-                                           (length (current-colors))
-                                           (current-suffix-option)))
-        (set! identifier-list 
-              (filter identifier? (hash-table-map ht:stx=>flat (lambda (k v) k)))))
+    (unless (syntax? stx)
+      (raise-type-error 'pretty-print-syntax "syntax" stx))
+    (parameterize 
+     ([pretty-print-pre-print-hook pp-pre-hook]
+      [pretty-print-post-print-hook pp-post-hook]
+      [pretty-print-size-hook pp-size-hook]
+      [pretty-print-print-hook pp-print-hook]
+      [pretty-print-current-style-table (pp-extend-style-table identifier-list)]
+      [pretty-print-columns (current-default-columns)]
+      ;; Printing parameters (mzscheme manual 7.9.1.4)
+      [print-unreadable #t]
+      [print-graph #f]
+      [print-struct #f]
+      [print-box #t]
+      [print-vector-length #t]
+      [print-hash-table #f]
+      [print-honu #f])
+     (pretty-print datum port)
+     (new range%
+          (range-builder range-builder)
+          (identifier-list identifier-list))))
 
-      ;; Initialization
-      (recompute-tables)
-      (super-new)))
+  (define (pp-print-hook obj display-like? port)
+    (cond [(syntax-dummy? obj)
+           ((if display-like? display write) (syntax-dummy-val obj) port)]
+          [(is-a? obj editor-snip%)
+           (write-special obj port)]
+          [else 
+           (error 'pretty-print-hook "unexpected special value: ~e" obj)]))
 
-  (define extended-style-list
+  (define (pp-size-hook obj display-like? port)
+    (cond [(is-a? obj editor-snip%)
+           (pretty-print-columns)]
+          [(syntax-dummy? obj)
+           (let ((ostring (open-output-string)))
+             ((if display-like? display write) (syntax-dummy-val obj) ostring)
+             (string-length (get-output-string ostring)))]
+          [else #f]))
+
+  (define (pp-better-style-table)
+    (let* ([pref (pref:tabify)]
+           [table (car pref)]
+           [begin-rx (cadr pref)]
+           [define-rx (caddr pref)]
+           [lambda-rx (cadddr pref)])
+      (let ([style-list (hash-table-map table cons)])
+        (pretty-print-extend-style-table
+         (basic-style-list)
+         (map car style-list)
+         (map cdr style-list)))))
+
+  (define (basic-style-list)
+    (pretty-print-extend-style-table
+     (pretty-print-current-style-table)
+     (map car basic-styles)
+     (map cdr basic-styles)))
+  (define basic-styles
     '((define-values          . define)
       (define-syntaxes        . define-syntax)))
+
+  (define-local-member-name range:get-ranges)
+
+  ;; range-builder%
+  (define range-builder%
+    (class object%
+      (define starts (make-hash-table))
+      (define ranges (make-hash-table))
+
+      (define/public (set-start obj n)
+        (hash-table-put! starts obj n))
+
+      (define/public (get-start obj)
+        (hash-table-get starts obj (lambda _ #f)))
+
+      (define/public (add-range obj range)
+        (hash-table-put! ranges obj (cons range (get-ranges obj))))
+
+      (define (get-ranges obj)
+        (hash-table-get ranges obj (lambda () null)))
+
+      (define/public (range:get-ranges) ranges)
+
+      (super-new)))
+
+  ;; range%
+  (define range%
+    (class* object% (range<%>)
+      (init range-builder)
+      (init-field identifier-list)
+      (super-new)
+
+      (define ranges (hash-table-copy (send range-builder range:get-ranges)))
+
+      (define/public (get-ranges obj)
+        (hash-table-get ranges obj (lambda _ null)))
+
+      (define/public (all-ranges)
+        sorted-ranges)
+
+      (define/public (get-identifier-list)
+        identifier-list)
+
+      (define sorted-ranges
+        (sort 
+         (apply append 
+                (hash-table-map
+                 ranges
+                 (lambda (k vs)
+                   (map (lambda (v) (make-range k (car v) (cdr v))) vs))))
+         (lambda (x y)
+           (>= (- (range-end x) (range-start x))
+               (- (range-end y) (range-start y))))))))
+
   )
diff --git a/collects/macro-debugger/syntax-browser/properties.ss b/collects/macro-debugger/syntax-browser/properties.ss
index e248b1d..8969fd7 100644
--- a/collects/macro-debugger/syntax-browser/properties.ss
+++ b/collects/macro-debugger/syntax-browser/properties.ss
@@ -4,27 +4,33 @@
            "util.ss"
            (lib "class.ss")
            (lib "mred.ss" "mred")
-           (lib "framework.ss" "framework")
-           (lib "interactive-value-port.ss" "mrlib"))
+           #;(lib "framework.ss" "framework")
+           #;(lib "interactive-value-port.ss" "mrlib"))
   (provide properties-view%
            properties-snip%)
 
   ;; properties-view-base-mixin
   (define properties-view-base-mixin
     (mixin () ()
-      (init)
+      ;; controller : controller<%>
+      (init-field controller)
 
       ;; selected-syntax : syntax
       (field (selected-syntax #f))
 
-      ;; set-syntax : syntax -> void
-      (define/public (set-syntax stx)
-        (set! selected-syntax stx)
-        (refresh))
-
       ;; mode : maybe symbol in '(term stxobj)
       (define mode 'term)
 
+      ;; text : text%
+      (field (text (new text%)))
+      (field (pdisplayer (new properties-displayer% (text text))))
+
+      (send controller listen-selected-syntax
+            (lambda (stx)
+              (set! selected-syntax stx)
+              (refresh)))
+      (super-new)
+
       ;; get-mode : -> symbol
       (define/public (get-mode) mode)
 
@@ -53,17 +59,13 @@
           ((term) (send pdisplayer display-meaning-info selected-syntax))
           ((stxobj) (send pdisplayer display-stxobj-info selected-syntax))
           ((#f) (send pdisplayer display-null-info))
-          (else (error 'properties-view%:refresh "internal error: no such mode: ~s" mode))))
-
-      ;; text : text%
-      (field (text (new text%))) ;; text:wide-snip%)))
-      (field (pdisplayer (new properties-displayer% (text text))))
+          (else (error 'properties-view-base:refresh
+                       "internal error: no such mode: ~s" mode))))
 
       (send text set-styles-sticky #f)
       #;(send text hide-caret #t)
       (send text lock #t)
-      (refresh)
-      (super-new)))
+      (refresh)))
 
 
   ;; properties-snip%
@@ -113,14 +115,13 @@
 
       (super-new)
       (define tab-choices (get-tab-choices))
-      (define tab-panel (new tab-panel% 
-                             (choices (map car tab-choices))
-                             (parent parent)
-                             (callback
-                              (lambda (tp e)
-                                (set-mode
-                                 (cdr (list-ref tab-choices (send tp get-selection))))))))
-      ;; canvas:wide-?%
+      (define tab-panel
+        (new tab-panel% 
+             (choices (map car tab-choices))
+             (parent parent)
+             (callback
+              (lambda (tp e)
+                (set-mode (cdr (list-ref tab-choices (send tp get-selection))))))))
       (define ecanvas (new editor-canvas% (editor text) (parent tab-panel)))))
 
   ;; properties-displayer%
@@ -267,20 +268,6 @@
            'editor]
           [else s]))
   
-  ;; make-text-port : text -> port
-  ;; builds a port from a text object.  
-  (define (make-text-port text)
-    (make-output-port #f
-                      always-evt
-                      (lambda (s start end flush? enable-break?)
-                        (send text insert
-                              (bytes->string/utf-8 s #f start end))
-                        (- end start))
-                      void
-                      (lambda (special buffer? enable-break?)
-                        (send text insert special)
-                        #t)))
-
   ;; Styles
     
   (define key-sd
diff --git a/collects/macro-debugger/syntax-browser/syntax-snip.ss b/collects/macro-debugger/syntax-browser/syntax-snip.ss
index 2916230..69e700d 100644
--- a/collects/macro-debugger/syntax-browser/syntax-snip.ss
+++ b/collects/macro-debugger/syntax-browser/syntax-snip.ss
@@ -1,238 +1,202 @@
 
 (module syntax-snip mzscheme
   (require (lib "class.ss")
-           (lib "unit.ss")
            (lib "mred.ss" "mred")
            (lib "framework.ss" "framework")
+           (lib "match.ss")
+           (lib "list.ss")
+           (lib "string.ss")
            "interfaces.ss"
+           "display.ss"
            "controller.ss"
            "properties.ss"
-           "typesetter.ss"
            "partition.ss")
-  (provide snip@
-           snip-keymap-extension@)
 
-  ;; Every snip has its own controller and properties-controller
-  ;; (because every snip now displays its own properties)
+  (provide syntax-value-snip%)
 
-  (define snip@
-    (unit
-      (import prefs^
-              keymap^
-              context-menu^
-              snipclass^)
-      (export snip^)
+  ;; syntax-value-snip%
+  (define syntax-value-snip%
+    (class* editor-snip% (readable-snip<%>)
+      (init-field ((stx syntax)))
+      (init-field host)
+      (inherit set-margin
+               set-inset)
 
-      ;; syntax-snip : syntax -> snip
-      (define (syntax-snip stx)
-        (new syntax-snip% (syntax stx)))
-      
-      ;; syntax-value-snip%
-      (define syntax-value-snip%
-        (class* editor-snip% (readable-snip<%>)
-          (init-field ((stx syntax)))
-          (init-field controller)
-          (inherit set-margin
-                   set-inset)
+      (define text (new text:standard-style-list%))
+      (super-new (editor text) (with-border? #f))
+      (set-margin 0 0 0 0)
+      (set-inset 2 2 2 2)
+      (send text begin-edit-sequence)
+      (send text change-style (make-object style-delta% 'change-alignment 'top))
+      (define display
+        (print-syntax-to-editor stx text (send host get-controller)))
+      (send text lock #t)
+      (send text end-edit-sequence)
+      (send text hide-caret #t)
 
-          (define -outer (new text:standard-style-list%))
-          (super-new (editor -outer) (with-border? #f))
-          (set-margin 0 0 0 0)
-          (set-inset 2 2 2 2)
-          (send -outer change-style (make-object style-delta% 'change-alignment 'top))
-          (new syntax-keymap%
-               (editor -outer)
-               (snip this))
-          (refresh)
-          
-          (define/public (get-controller) controller)
+      (send host add-keymap text this)
 
-          (define/private (refresh)
-            (send -outer begin-edit-sequence)
-            (send -outer erase)
-            (new typesetter-for-text%
-                 (syntax stx)
-                 (controller controller)
-                 (text -outer))
-            (send -outer lock #t)
-            (send -outer end-edit-sequence)
-            (send -outer hide-caret #t))
-          
-          (define/public (show-props)
-            (send (send controller get-properties-controller)
-                  show #t))
-          
-          (define/private outer:insert
-            (case-lambda
-              [(obj)
-               (outer:insert obj style:normal)]
-              [(text style)
-               (outer:insert text style #f)]
-              [(text style clickback)
-               (let ([start (send -outer last-position)])
-                 (send -outer insert text)
-                 (let ([end (send -outer last-position)])
-                   (send -outer change-style style start end #f)
-                   (when clickback
-                     (send -outer set-clickback start end clickback))))]))
-          
-          ;; snip% Methods
-          (define/override (copy)
-            (new syntax-value-snip% (controller controller) (syntax stx)))
-          
-          ;; read-special : any number/#f number/#f number/#f -> syntax
-          ;; Produces 3D syntax to preserve eq-ness of syntax
-          ;; #'#'stx would be lose identity when wrapped
-          (define/public (read-special src line col pos)
-            (with-syntax ([p (lambda () stx)])
-              #'(p)))
-          ))
+      ;; snip% Methods
+      (define/override (copy)
+        (new syntax-value-snip% (host host) (syntax stx)))
 
-
-      ;; syntax-snip%
-      (define syntax-snip%
-        (class* editor-snip% (readable-snip<%>)
-          (init-field ((stx syntax)))
-          (inherit set-margin
-                   set-inset
-                   set-snipclass
-                   set-tight-text-fit
-                   show-border
-                   get-admin)
-
-          (define controller
-            (new syntax-controller% (primary-partition (find-primary-partition))))
-          (define properties-snip (new properties-snip%))
-          (send controller set-properties-controller this)
-
-          (define -outer (new text%))
-          (super-new (editor -outer) (with-border? #f))
-          (set-margin 0 0 0 0)
-          (set-inset 0 0 0 0)
-          (set-snipclass snip-class)
-          (send -outer select-all)
-
-          (define the-syntax-snip
-            (new syntax-value-snip% (syntax stx) (controller controller)))
-          (define the-summary
-            (let ([line (syntax-line stx)]
-                  [col (syntax-column stx)])
-              (if (and line col)
-                  (format "#<syntax:~s:~s>" line col)
-                  "#<syntax>")))
-          
-          (define shown? #f)
-          (define/public (refresh)
-            (if shown?
-                (refresh/shown)
-                (refresh/hidden)))
-
-          (define/private (refresh/hidden)
-            (send* -outer
-              (begin-edit-sequence)
-              (lock #f)
-              (erase))
-            (set-tight-text-fit #t)
-            (show-border #f)
-            (outer:insert (show-icon) style:hyper 
-                          (lambda _ (set! shown? #t) (refresh)))
-            (outer:insert the-summary)
-            (send* -outer 
-              (lock #t)
-              (end-edit-sequence)))
-
-          (define/private (refresh/shown)
-            (send* -outer
-              (begin-edit-sequence)
-              (lock #f)
-              (erase))
-            (set-tight-text-fit #f)
-            (show-border #t)
-            (outer:insert (hide-icon) style:hyper
-                          (lambda _ (set! shown? #f) (refresh)))
-            (outer:insert " ")
-            (outer:insert the-syntax-snip)
-            (outer:insert " ")
-            (if (props-shown?)
-                (begin (outer:insert "<" style:green (lambda _ (show #f)))
-                       (outer:insert properties-snip))
-                (begin (outer:insert ">" style:green (lambda _ (show #t)))))
-            (send* -outer
-              (change-style (make-object style-delta% 'change-alignment 'top)
-                            0
-                            (send -outer last-position))
-              (lock #t)
-              (end-edit-sequence)))
-
-          (define/private outer:insert
-            (case-lambda
-              [(obj)
-               (outer:insert obj style:normal)]
-              [(text style)
-               (outer:insert text style #f)]
-              [(text style clickback)
-               (let ([start (send -outer last-position)])
-                 (send -outer insert text)
-                 (let ([end (send -outer last-position)])
-                   (send -outer change-style style start end #f)
-                   (when clickback
-                     (send -outer set-clickback start end clickback))))]))
-          
-          ;; Snip methods
-          (define/override (copy)
-            (new syntax-snip% (syntax stx)))
-          (define/override (write stream)
-            (send stream put (string->bytes/utf-8 (format "~s" (marshall-syntax stx)))))
-          (define/public (read-special src line col pos)
-            (send the-syntax-snip read-special src line col pos))
-
-          (define/private (find-primary-partition)
-            #;(define editor (send (get-admin) get-editor))
-            (new-bound-partition))
-
-
-          ;; syntax-properties-controller methods
-          (define properties-shown? #f)
-          (define/public (props-shown?)
-            properties-shown?)
-          (define/public (show ?)
-            (set! properties-shown? ?)
-            (refresh))
-          (define/public (set-syntax stx)
-            (send properties-snip set-syntax stx))
-
-          (refresh)
-          (send -outer hide-caret #t)
-          (send -outer lock #t)
-          ))
-      
-      ;; independent-properties-controller%
-      #;
-      (define independent-properties-controller%
-        (class* object% (syntax-properties-controller<%>)
-          (init-field controller)
-          (init-field ((stx syntax) #f))
-          
-          ;; Properties display
-          (define parent
-            (new frame% (label "Properties") (height (pref:height))
-                 (width (floor (* (pref:props-percentage) (pref:width))))))
-          (define pv (new properties-view% (parent parent)))
-          
-          (define/private (show-properties)
-            (unless (send parent is-shown?)
-              (send parent show #t)))
-          
-          (define/public (set-syntax stx)
-            (send pv set-syntax stx))
-          (define/public (show ?)
-            (send parent show ?))
-          (define/public (props-shown?)
-            (send parent is-shown?))
-
-          (super-new)))
+      ;; read-special : any number/#f number/#f number/#f -> syntax
+      ;; Produces 3D syntax to preserve eq-ness of syntax
+      ;; #'#'stx would be lose identity when wrapped
+      (define/public (read-special src line col pos)
+        (with-syntax ([p (lambda () stx)])
+          #'(p)))
       ))
 
+  ;; syntax-snip%
+  #;
+  (define syntax-snip%
+    (class* editor-snip% (readable-snip<%>)
+      (init-field ((stx syntax)))
+      (init-field primary-partition)
+      (inherit set-margin
+               set-inset
+               set-snipclass
+               set-tight-text-fit
+               show-border
+               get-admin)
+
+      (define properties-snip (new properties-snip%))
+
+      (define -outer (new text%))
+      (super-new (editor -outer) (with-border? #f))
+      (set-margin 0 0 0 0)
+      (set-inset 0 0 0 0)
+      (set-snipclass snip-class)
+      (send -outer select-all)
+
+      (define the-syntax-snip
+        (new syntax-value-snip%
+             (syntax stx)
+             (controller controller)
+             ;; FIXME
+             #;(syntax-keymap% syntax-keymap%)
+             ))
+      (define the-summary
+        (let ([line (syntax-line stx)]
+              [col (syntax-column stx)])
+          (if (and line col)
+              (format "#<syntax:~s:~s>" line col)
+              "#<syntax>")))
+
+      (define shown? #f)
+      (define/public (refresh)
+        (if shown?
+            (refresh/shown)
+            (refresh/hidden)))
+
+      (define/private (refresh/hidden)
+        (send* -outer
+          (begin-edit-sequence)
+          (lock #f)
+          (erase))
+        (set-tight-text-fit #t)
+        (show-border #f)
+        (outer:insert (show-icon) style:hyper 
+                      (lambda _ (set! shown? #t) (refresh)))
+        (outer:insert the-summary)
+        (send* -outer 
+          (lock #t)
+          (end-edit-sequence)))
+
+      (define/private (refresh/shown)
+        (send* -outer
+          (begin-edit-sequence)
+          (lock #f)
+          (erase))
+        (set-tight-text-fit #f)
+        (show-border #t)
+        (outer:insert (hide-icon) style:hyper
+                      (lambda _ (set! shown? #f) (refresh)))
+        (outer:insert " ")
+        (outer:insert the-syntax-snip)
+        (outer:insert " ")
+        (if (props-shown?)
+            (begin (outer:insert "<" style:green (lambda _ (show #f)))
+                   (outer:insert properties-snip))
+            (begin (outer:insert ">" style:green (lambda _ (show #t)))))
+        (send* -outer
+          (change-style (make-object style-delta% 'change-alignment 'top)
+                        0
+                        (send -outer last-position))
+          (lock #t)
+          (end-edit-sequence)))
+
+      (define/private outer:insert
+        (case-lambda
+         [(obj)
+          (outer:insert obj style:normal)]
+         [(text style)
+          (outer:insert text style #f)]
+         [(text style clickback)
+          (let ([start (send -outer last-position)])
+            (send -outer insert text)
+            (let ([end (send -outer last-position)])
+              (send -outer change-style style start end #f)
+              (when clickback
+                    (send -outer set-clickback start end clickback))))]))
+
+      ;; Snip methods
+      (define/override (copy)
+        (new syntax-snip% (syntax stx)))
+      (define/override (write stream)
+        (send stream put (string->bytes/utf-8 (format "~s" (marshall-syntax stx)))))
+      (define/public (read-special src line col pos)
+        (send the-syntax-snip read-special src line col pos))
+
+      (define/private (find-primary-partition)
+        #;(define editor (send (get-admin) get-editor))
+        (new-bound-partition))
+
+
+      ;; syntax-properties-controller methods
+      (define properties-shown? #f)
+      (define/public (props-shown?)
+        properties-shown?)
+      (define/public (show ?)
+        (set! properties-shown? ?)
+        (refresh))
+      (define/public (set-syntax stx)
+        (send properties-snip set-syntax stx))
+
+      (refresh)
+      (send -outer hide-caret #t)
+      (send -outer lock #t)
+      ))
+
+  ;; independent-properties-controller%
+  #;
+  (define independent-properties-controller%
+    (class* object% (syntax-properties-controller<%>)
+      (init-field controller)
+      (init-field ((stx syntax) #f))
+
+      ;; Properties display
+      (define parent
+        (new frame% (label "Properties") (height (pref:height))
+             (width (floor (* (pref:props-percentage) (pref:width))))))
+      (define pv (new properties-view% (parent parent)))
+
+      (define/private (show-properties)
+        (unless (send parent is-shown?)
+          (send parent show #t)))
+
+      (define/public (set-syntax stx)
+        (send pv set-syntax stx))
+      (define/public (show ?)
+        (send parent show ?))
+      (define/public (props-shown?)
+        (send parent is-shown?))
+
+      (super-new)))
+
+
+  #;
   (define snip-keymap-extension@
     (unit
       (import (prefix pre: keymap^))
@@ -243,13 +207,13 @@
           (init-field snip)
           (inherit add-function)
           (super-new (controller (send snip get-controller)))
-          
+
           (add-function "show-syntax-properties"
                         (lambda (i e)
                           (send snip show-props)))))))
-  
-  
-  
+
+
+
   (define style:normal (make-object style-delta% 'change-normal))
   (define style:hyper
     (let ([s (make-object style-delta% 'change-normal)])
@@ -264,14 +228,14 @@
     (let ([s (make-object style-delta% 'change-normal)])
       (send s set-delta 'change-bold)
       s))
-  
+
   (define (show-icon)
     (make-object image-snip%
       (build-path (collection-path "icons") "turn-up.png")))
   (define (hide-icon)
     (make-object image-snip%
       (build-path (collection-path "icons") "turn-down.png")))
-  
+
   (define (show-properties-icon)
     (make-object image-snip%
       (build-path (collection-path "icons") "syncheck.png")))
@@ -293,7 +257,7 @@
               (syntax-property-symbol-keys stx)))
       (contents
        ,(marshall-object (syntax-e stx)))))
-  
+
   ;; marshall-object : any -> printable
   ;; really only intended for use with marshall-syntax
   (define (marshall-object obj)
@@ -310,4 +274,74 @@
            (null? obj))
        `(other ,obj)]
       [else (string->symbol (format "unknown-object: ~s" obj))]))
+
+  ;; COPIED AND MODIFIED from mrlib/syntax-browser.ss
+  #;
+  (define syntax-snipclass%
+    (class snip-class%
+      (define/override (read stream)
+        (make-object syntax-snip%
+          (unmarshall-syntax (read-from-string (send stream get-bytes)))))
+      (super-instantiate ())))
+
+  #;(define snip-class (make-object syntax-snipclass%))
+  #;(send snip-class set-version 2)
+  #;(send snip-class set-classname
+        (format "~s" '(lib "implementation.ss" "macro-debugger" "syntax-browser")))
+  #;(send (get-the-snip-class-list) add snip-class)
+  
+  (define (unmarshall-syntax stx)
+    (match stx
+      [`(syntax
+         (source ,src)
+         (source-module ,source-module) ;; marshalling
+         (position ,pos)
+         (line ,line)
+         (column ,col)
+         (span ,span)
+         (original? ,original?)
+         (properties ,@(properties ...))
+         (contents ,contents))
+        (foldl
+         add-properties
+         (datum->syntax-object
+          #'here ;; ack
+          (unmarshall-object contents)
+          (list (unmarshall-object src)
+                line
+                col
+                pos
+                span))
+         properties)]
+      [else #'unknown-syntax-object]))
+  
+  ;; add-properties : syntax any -> syntax
+  (define (add-properties prop-spec stx)
+    (match prop-spec
+      [`(,(and sym (? symbol?))
+          ,prop)
+        (syntax-property stx sym (unmarshall-object prop))]
+      [else stx]))
+  
+  (define (unmarshall-object obj)
+    (let ([unknown (lambda () (string->symbol (format "unknown: ~s" obj)))])
+      (if (and (pair? obj)
+               (symbol? (car obj)))
+          (case (car obj)
+            [(pair) 
+             (if (pair? (cdr obj))
+                 (let ([raw-obj (cadr obj)])
+                   (if (pair? raw-obj)
+                       (cons (unmarshall-object (car raw-obj))
+                             (unmarshall-object (cdr raw-obj)))
+                       (unknown)))
+                 (unknown))]
+            [(other) 
+             (if (pair? (cdr obj))
+                 (cadr obj)
+                 (unknown))]
+            [(syntax) (unmarshall-syntax obj)]
+            [else (unknown)])
+          (unknown))))
+
   )
diff --git a/collects/macro-debugger/syntax-browser/text.ss b/collects/macro-debugger/syntax-browser/text.ss
index 826fa04..0407472 100644
--- a/collects/macro-debugger/syntax-browser/text.ss
+++ b/collects/macro-debugger/syntax-browser/text.ss
@@ -6,14 +6,26 @@
            (lib "arrow.ss" "drscheme")
            (lib "framework.ss" "framework"))
 
-  (provide text:drawings<%>
-           text:mouse-drawings<%>
+  (provide text:mouse-drawings<%>
            text:arrows<%>
 
-           text:drawings-mixin
            text:mouse-drawings-mixin
+           text:tacking-mixin
            text:arrows-mixin)
 
+  (define arrow-brush
+    (send the-brush-list find-or-create-brush "white" 'solid))
+  (define (tacked-arrow-brush color)
+    (send the-brush-list find-or-create-brush color 'solid))
+
+  (define billboard-brush
+    (send the-brush-list find-or-create-brush "white" 'solid))
+
+  (define white (send the-color-database find-color "white"))
+
+  ;; A Drawing is (make-drawing number number (??? -> void) boolean boolean)
+  (define-struct drawing (start end draw visible? tacked?) #f)
+
   (define (mean x y)
     (/ (+ x y) 2))
 
@@ -45,76 +57,49 @@
               (send dc set-text-background old-background)
               (send dc set-text-mode old-mode))))
 
-  (define text:drawings<%>
-    (interface (text:basic<%>)
-      add-drawings
-      delete-drawings
-      delete-all-drawings))
-
   (define text:mouse-drawings<%>
-    (interface (text:drawings<%>)
+    (interface (text:basic<%>)
       add-mouse-drawing
-      delete-mouse-drawings))
+      for-each-drawing
+      delete-all-drawings))
 
   (define text:arrows<%>
     (interface (text:mouse-drawings<%>)
       add-arrow
-      add-question-arrow))
+      add-question-arrow
+      add-billboard))
 
-  (define text:drawings-mixin
-    (mixin (text:basic<%>) (text:drawings<%>)
-      (define draw-table (make-hash-table))
+  (define text:mouse-drawings-mixin
+    (mixin (text:basic<%>) (text:mouse-drawings<%>)
+      (inherit dc-location-to-editor-location
+               find-position
+               invalidate-bitmap-cache)
 
-      (define/public (add-drawings key draws)
-        (hash-table-put! draw-table
-                         key
-                         (append draws (hash-table-get draw-table key (lambda () null)))))
+      ;; list of Drawings
+      (field [drawings-list null])
 
-      (define/public (delete-drawings key)
-        (hash-table-remove! draw-table key))
+      (define/public add-mouse-drawing
+        (case-lambda
+          [(start end draw)
+           (add-mouse-drawing start end draw (box #f))]
+          [(start end draw tack-box)
+           (set! drawings-list 
+                 (cons (make-drawing start end draw #f tack-box)
+                       drawings-list))]))
 
       (define/public (delete-all-drawings)
-        (for-each (lambda (key) (hash-table-remove! draw-table key))
-                  (hash-table-map draw-table (lambda (k v) k))))
+        (set! drawings-list null))
+
+      (define/public-final (for-each-drawing f)
+        (for-each f drawings-list))
 
       (define/override (on-paint before? dc left top right bottom dx dy draw-caret)
         (super on-paint before? dc left top right bottom dx dy draw-caret)
         (unless before?
-          (hash-table-for-each
-           draw-table
-           (lambda (k v)
-             (for-each (lambda (d) (d this dc left top right bottom dx dy))
-                       v)))))
-
-      (super-new)))
-
-  ;; A Drawing is (make-drawing number number (??? -> void))
-  (define-struct drawing (start end draw) #f)
-
-  (define text:mouse-drawings-mixin
-    (mixin (text:drawings<%>) (text:mouse-drawings<%>)
-      (inherit dc-location-to-editor-location
-               find-position
-               invalidate-bitmap-cache
-               add-drawings
-               delete-drawings)
-
-      ;; lists of Drawings
-      (field [inactive-list null]
-             [active-list null])
-      
-      (define/public (add-mouse-drawing start end draw)
-        (set! inactive-list 
-              (cons (make-drawing start end draw)
-                    inactive-list)))
-      
-      (define/public (delete-mouse-drawings)
-        (set! inactive-list null))
-
-      (define/override (delete-all-drawings)
-        (super delete-all-drawings)
-        (set! inactive-list null)
-        (set! active-list null))
+          (for-each-drawing
+           (lambda (d)
+             (when (or (drawing-visible? d) (unbox (drawing-tacked? d)))
+               ((drawing-draw d) this dc left top right bottom dx dy))))))
 
       (define/override (on-default-event ev)
         (define gx (send ev get-x))
@@ -123,35 +108,69 @@
         (define pos (find-position x y))
         (super on-default-event ev)
         (case (send ev get-event-type)
-          ((enter motion)
-           (let ([new-active-annotations
-                  (filter (lambda (rec)
-                            (<= (drawing-start rec) pos (drawing-end rec)))
-                          inactive-list)])
-             (unless (equal? active-list new-active-annotations)
-               (set! active-list new-active-annotations)
-               (delete-drawings 'mouse-over)
-               (add-drawings 'mouse-over (map drawing-draw active-list))
-               (invalidate-bitmap-cache))))
-          ((leave)
-           (unless (null? active-list)
-             (set! active-list null)
-             (delete-drawings 'mouse-over)
-             (invalidate-bitmap-cache)))))
+          ((enter motion leave)
+           (let ([changed? (update-visible-drawings pos)])
+             (when changed? (invalidate-bitmap-cache 0.0 0.0 +inf.0 +inf.0))))))
+
+      (define/private (update-visible-drawings pos)
+        (let ([changed? #f])
+          (for-each-drawing
+           (lambda (d)
+             (let ([vis? (<= (drawing-start d) pos (drawing-end d))])
+               (unless (eqv? vis? (drawing-visible? d))
+                 (set-drawing-visible?! d vis?)
+                 (set! changed? #t)))))
+          changed?))
 
       (super-new)))
-  
-  (define arrow-brush (send the-brush-list find-or-create-brush "white" 'solid))
+
+  (define text:tacking-mixin
+    (mixin (text:basic<%> text:mouse-drawings<%>) ()
+      (inherit get-canvas
+               for-each-drawing)
+      (inherit-field drawings-list)
+      (super-new)
+
+      (define/override (on-event ev)
+        (case (send ev get-event-type)
+          ((right-down)
+           (if (ormap (lambda (d) (drawing-visible? d)) drawings-list)
+               (send (get-canvas) popup-menu
+                     (make-tack/untack-menu)
+                     (send ev get-x)
+                     (send ev get-y))
+               (super on-event ev)))
+          (else
+           (super on-event ev))))
+
+      (define/private (make-tack/untack-menu)
+        (define menu (new popup-menu%))
+        (new menu-item% (label "Tack")
+             (parent menu)
+             (callback
+              (lambda _ (tack))))
+        (new menu-item% (label "Untack")
+             (parent menu)
+             (callback
+              (lambda _ (untack))))
+        menu)
+
+      (define/private (tack)
+        (for-each-drawing
+         (lambda (d)
+           (when (drawing-visible? d)
+             (set-box! (drawing-tacked? d) #t)))))
+      (define/private (untack)
+        (for-each-drawing
+         (lambda (d)
+           (when (drawing-visible? d)
+             (set-box! (drawing-tacked? d) #f)))))))
 
   (define text:arrows-mixin
     (mixin (text:mouse-drawings<%>) (text:arrows<%>)
       (inherit position-location
                add-mouse-drawing
-               find-wordbreak
-               add-drawings
-               delete-drawings
-               get-canvas)
-      (inherit-field active-list inactive-list)
+               find-wordbreak)
 
       (define/public (add-arrow from1 from2 to1 to2 color)
         (internal-add-arrow from1 from2 to1 to2 color #f))
@@ -159,36 +178,62 @@
       (define/public (add-question-arrow from1 from2 to1 to2 color)
         (internal-add-arrow from1 from2 to1 to2 color #t))
 
-      (define/private (internal-add-arrow from1 from2 to1 to2 color question?)
+      (define/public (add-billboard pos1 pos2 str color-name)
+        (define color (send the-color-database find-color color-name))
+        (let ([draw 
+               (lambda (text dc left top right bottom dx dy)
+                 (let-values ([(x y) (range->mean-loc pos1 pos1)]
+                              [(fw fh _d _v) (send dc get-text-extent "y")])
+                   (with-saved-pen&brush dc
+                     (with-saved-text-config dc
+                       (send* dc
+                         (set-pen color 1 'solid)
+                         (set-brush billboard-brush)
+                         (set-text-mode 'solid)
+                         (set-font (billboard-font dc))
+                         (set-text-foreground color))
+                       (let-values ([(w h d v) (send dc get-text-extent str)]
+                                    [(adj-y) fh]
+                                    [(mini) _d])
+                         (send* dc
+                           (draw-rounded-rectangle
+                            (+ x dx)
+                            (+ y dy adj-y)
+                            (+ w mini mini)
+                            (+ h mini mini))
+                           (draw-text str (+ x dx mini) (+ y dy mini adj-y))))))))])
+          (add-mouse-drawing pos1 pos2 draw)))
+
+      (define/private (internal-add-arrow from1 from2 to1 to2 color-name question?)
+        (define color (send the-color-database find-color color-name))
+        (define tack-box (box #f))
         (unless (and (= from1 to1) (= from2 to2))
           (let ([draw 
                  (lambda (text dc left top right bottom dx dy)
-                   (let*-values ([(start1x start1y) (position->location from1)]
-                                 [(start2x start2y) (position->location from2)]
-                                 [(end1x end1y) (position->location to1)]
-                                 [(end2x end2y) (position->location to2)]
-                                 [(startx) (mean start1x start2x)]
-                                 [(starty) (mean start1y start2y)]
-                                 [(endx) (mean end1x end2x)]
-                                 [(endy) (mean end1y end2y)]
-                                 [(fw fh _d _v) (send dc get-text-extent "")])
-                     (let ([starty (+ starty (/ fh 2))]
-                           [endy (+ endy (/ fh 2))])
-                       (with-saved-pen&brush dc
-                         (with-saved-text-config dc
-                           (send dc set-pen color 1 'solid)
-                           (send dc set-brush arrow-brush)
-                           (draw-arrow dc startx starty endx endy dx dy)
-                           #;(send dc set-text-mode 'solid)
-                           (when question?
-                             (send dc set-font (?-font dc))
-                             (send dc set-text-foreground 
-                                   (send the-color-database find-color color))
-                             (send dc draw-text "?" 
-                                   (+ (+ startx dx) fw)
-                                   (- (+ starty dy) fh))))))))])
-            (add-mouse-drawing from1 from2 draw)
-            (add-mouse-drawing to1 to2 draw))))
+                   (let-values ([(startx starty) (range->mean-loc from1 from2)]
+                                [(endx endy) (range->mean-loc to1 to2)]
+                                [(fw fh _d _v) (send dc get-text-extent "x")])
+                     (with-saved-pen&brush dc
+                       (with-saved-text-config dc
+                         (send dc set-pen color 1 'solid)
+                         (send dc set-brush
+                               (if (unbox tack-box)
+                                   (tacked-arrow-brush color)
+                                   arrow-brush))
+                         (draw-arrow dc startx
+                                     (+ starty (/ fh 2))
+                                     endx
+                                     (+ endy (/ fh 2))
+                                     dx dy)
+                         (send dc set-text-mode 'transparent)
+                         (when question?
+                           (send dc set-font (?-font dc))
+                           (send dc set-text-foreground color)
+                           (send dc draw-text "?" 
+                                 (+ endx dx fw)
+                                 (- endy dy fh)))))))])
+            (add-mouse-drawing from1 from2 draw tack-box)
+            (add-mouse-drawing to1 to2 draw tack-box))))
 
       (define/private (position->location p)
         (define xbox (box 0.0))
@@ -196,62 +241,29 @@
         (position-location p xbox ybox)
         (values (unbox xbox) (unbox ybox)))
 
-      (define/override (on-event ev)
-        (case (send ev get-event-type)
-          ((right-down)
-           (let ([arrows active-list])
-             (if (pair? arrows)
-                 (send (get-canvas) popup-menu
-                       (make-tack/untack-menu)
-                       (send ev get-x)
-                       (send ev get-y))
-                 (super on-event ev))))
-          (else
-           (super on-event ev))))
-
-      (define/private (make-tack/untack-menu)
-        (define menu (new popup-menu%))
-        (new menu-item% (label "Tack arrows")
-             (parent menu)
-             (callback
-              (lambda _ (tack-arrows))))
-        (new menu-item% (label "Untack arrows")
-             (parent menu)
-             (callback
-              (lambda _ (untack-arrows))))
-        menu)
-
-      (define/private (tack-arrows)
-        (for-each (lambda (arrow) 
-                    (add-drawings (drawing-draw arrow) (list (drawing-draw arrow))))
-                  active-list))
-      (define/private (untack-arrows)
-        (for-each (lambda (arrow) (delete-drawings (drawing-draw arrow)))
-                  active-list))
-
       (define/private (?-font dc)
         (let ([size (send (send dc get-font) get-point-size)])
           (send the-font-list find-or-create-font size 'default 'normal 'bold)))
 
+      (define/private (billboard-font dc)
+        (let ([size (send (send dc get-font) get-point-size)])
+          (send the-font-list find-or-create-font size 'default 'normal)))
+
+      (define/private (range->mean-loc pos1 pos2)
+        (let*-values ([(loc1x loc1y) (position->location pos1)]
+                      [(loc2x loc2y) (position->location pos2)]
+                      [(locx) (mean loc1x loc2x)]
+                      [(locy) (mean loc1y loc2y)])
+          (values locx locy)))
+
       (super-new)))
 
   (define text:mouse-drawings%
     (text:mouse-drawings-mixin
-     (text:drawings-mixin text:standard-style-list%)))
+     text:standard-style-list%))
 
   (define text:arrows%
-    (text:arrows-mixin text:mouse-drawings%))
-
-  #;
-  (begin
-    (define f (new frame% (label "testing") (width 100) (height 100)))
-    (define t (new text:crazy% (auto-wrap #t)))
-    (define ec (new editor-canvas% (parent f) (editor t)))
-    (send f show #t)
-    (send t insert "this is the time to remember, because it will not last forever\n")
-    (send t insert "these are the days to hold on to, but we won't although we'll want to\n")
-    
-    (send t add-dot 5)
-    (send t add-arrow 25 8 "blue"))
-  
+    (text:arrows-mixin
+     (text:tacking-mixin
+      text:mouse-drawings%)))
   )
diff --git a/collects/macro-debugger/syntax-browser/util.ss b/collects/macro-debugger/syntax-browser/util.ss
index 3a46a6a..1217a2e 100644
--- a/collects/macro-debugger/syntax-browser/util.ss
+++ b/collects/macro-debugger/syntax-browser/util.ss
@@ -2,9 +2,12 @@
 (module util mzscheme
   (require (lib "class.ss"))
   (provide with-unlock
+           make-text-port
            mpi->string
            mpi->list)
-  
+
+  ;; with-unlock SYNTAX (expression)
+  ;; (with-unlock text-expression . body)
   (define-syntax with-unlock
     (syntax-rules ()
       [(with-unlock text . body)
@@ -14,6 +17,22 @@
          (begin0 (let () . body)
                  (send t lock locked?)))]))
 
+  ;; make-text-port : text (-> number) -> port
+  ;; builds a port from a text object.  
+  (define (make-text-port text end-position)
+    (make-output-port #f
+                      always-evt
+                      (lambda (s start end flush? enable-break?)
+                        (send text insert
+                              (bytes->string/utf-8 s #f start end)
+                              (end-position))
+                        (- end start))
+                      void
+                      (lambda (special buffer? enable-break?)
+                        (send text insert special (end-position))
+                        #t)))
+
+  ;; mpi->string : module-path-index -> string
   (define (mpi->string mpi)
     (if (module-path-index? mpi)
         (let ([mps (mpi->list mpi)])
@@ -25,7 +44,8 @@
                  (format "~s" (car mps))]
                 [(null? mps) "this module"]))
         (format "~s" mpi)))
-  
+
+  ;; mpi->list : module-path-index -> (list-of module-spec)
   (define (mpi->list mpi)
     (if mpi
         (let-values ([(path rel) (module-path-index-split mpi)])
@@ -36,4 +56,4 @@
                 [else '()]))
         '()))
 
-  )
\ No newline at end of file
+  )
diff --git a/collects/macro-debugger/syntax-browser/widget.ss b/collects/macro-debugger/syntax-browser/widget.ss
index f80df0b..e180453 100644
--- a/collects/macro-debugger/syntax-browser/widget.ss
+++ b/collects/macro-debugger/syntax-browser/widget.ss
@@ -1,218 +1,232 @@
 
 (module widget mzscheme
   (require (lib "class.ss")
-           (lib "unit.ss")
            (lib "mred.ss" "mred")
            (lib "framework.ss" "framework")
            (lib "list.ss")
+           (lib "plt-match.ss")
            (lib "kw.ss")
            (lib "boundmap.ss" "syntax")
            "interfaces.ss"
            "params.ss"
            "controller.ss"
-           "typesetter.ss"
+           "display.ss"
+           "keymap.ss"
            "hrule-snip.ss"
            "properties.ss"
            "text.ss"
            "util.ss")
-  (provide widget@
-           widget-keymap-extension@
-           widget-context-menu-extension@)
+  (provide widget%
+           widget-keymap%
+           widget-context-menu%)
 
-  (define widget@
-    (unit
-      (import keymap^)
-      (export widget^)
+  ;; widget%
+  ;; A syntax widget creates its own syntax-controller.
+  (define widget%
+    (class* object% (widget-hooks<%>)
+      (init parent)
+      (init-field config)
 
-      ;; syntax-widget%
-      ;; A syntax-widget creates its own syntax-controller.
-      (define syntax-widget%
-        (class* object% (syntax-browser<%> syntax-properties-controller<%>)
-          (init parent)
-          (init-field pref:props-percentage)
-          
-          (define -main-panel (new vertical-panel% (parent parent)))
-          (define -split-panel (new panel:horizontal-dragable% (parent -main-panel)))
-          (define -text (new browser-text%))
-          (define -ecanvas (new editor-canvas% (parent -split-panel) (editor -text)))
-          (define -props-panel (new horizontal-panel% (parent -split-panel)))
-          (define props (new properties-view% (parent -props-panel)))
-          (define props-percentage (pref:props-percentage))
-          
-          (define controller
-            (new syntax-controller%
-                 (properties-controller this)))
-          
-          (define/public (make-keymap text)
-            (new syntax-keymap% 
-                 (editor text)
-                 (widget this)))
-          (make-keymap -text)
-          
-          (send -text lock #t)
-          (send -split-panel set-percentages 
-                (list (- 1 props-percentage) props-percentage))
+      (define controller (new controller%))
 
-          ;; syntax-properties-controller<%> methods
+      (define -main-panel
+        (new vertical-panel% (parent parent)))
+      (define -split-panel
+        (new panel:horizontal-dragable% (parent -main-panel)))
+      (define -text (new browser-text%))
+      (define -ecanvas
+        (new editor-canvas% (parent -split-panel) (editor -text)))
+      (define -props-panel (new horizontal-panel% (parent -split-panel)))
+      (define props
+        (new properties-view%
+             (parent -props-panel)
+             (controller controller)))
+      (define props-percentage (send config pref:props-percentage))
 
-          (define/public (set-syntax stx)
-            (send props set-syntax stx))
-          
-          (define/public (props-shown?)
-            (send -props-panel is-shown?))
-          
-          (define/public (toggle-props)
-            (show-props (not (send -props-panel is-shown?))))
-          
-          (define/public (show-props show?)
-            (if show?
-                (unless (send -props-panel is-shown?)
-                  (send -split-panel add-child -props-panel)
-                  (send -split-panel set-percentages
-                        (list (- 1 props-percentage) props-percentage))
-                  (send -props-panel show #t))
-                (when (send -props-panel is-shown?)
-                  (set! props-percentage
-                        (cadr (send -split-panel get-percentages)))
-                  (send -split-panel delete-child -props-panel)
-                  (send -props-panel show #f))))
+      (define/public (setup-keymap)
+        (new widget-keymap% 
+             (editor -text)
+             (widget this)))
 
-          ;;
+      (send -text lock #t)
+      (send -split-panel set-percentages 
+            (list (- 1 props-percentage) props-percentage))
 
-          (define/public (get-controller) controller)
-          
-          ;;
-          
-          (define/public (get-main-panel) -main-panel)
-          
-          (define/public (save-prefs)
-            (unless (= props-percentage (pref:props-percentage))
-              (pref:props-percentage props-percentage)))
-          
-          ;; syntax-browser<%> Methods
-          
-          (define/public (add-text text)
-            (with-unlock -text
-              (send -text insert text)))
-          
-          (define/public add-syntax
-            (lambda/kw (stx #:key [hi-stxs null] hi-color alpha-table [definites null]
-                            hi2-color [hi2-stxs null])
-              (when (and (pair? hi-stxs) (not hi-color))
-                (error 'syntax-widget%::add-syntax "no highlight color specified"))
-              (let ([colorer (internal-add-syntax stx)]
-                    [definite-table (make-hash-table)])
-                (when (and hi2-color (pair? hi2-stxs))
-                  (send colorer highlight-syntaxes hi2-stxs hi2-color))
-                (when (and hi-color (pair? hi-stxs))
-                  (send colorer highlight-syntaxes hi-stxs hi-color))
-                (for-each (lambda (x) (hash-table-put! definite-table x #t)) definites)
-                (when alpha-table
-                  (let ([range (send colorer get-range)])
-                    (for-each (lambda (id)
-                                (let ([binder
-                                       (module-identifier-mapping-get alpha-table
-                                                                      id
-                                                                      (lambda () #f))])
-                                  (when binder
-                                    (for-each
-                                     (lambda (binder-r)
-                                       (for-each (lambda (id-r)
-                                                   (if (hash-table-get definite-table id #f)
-                                                       (send -text add-arrow
-                                                             (car id-r) (cdr id-r)
-                                                             (car binder-r) (cdr binder-r)
-                                                             "blue")
-                                                       (send -text add-question-arrow
-                                                             (car id-r) (cdr id-r)
-                                                             (car binder-r) (cdr binder-r)
-                                                             "purple")))
-                                                 (send range get-ranges id)))
-                                     (send range get-ranges binder)))))
-                              (send colorer get-identifier-list))))
-                colorer)))
-          
-          (define/public (add-separator)
-            (with-unlock -text
-              (send* -text
-                (insert (new hrule-snip%))
-                (insert "\n"))))
-          
-          (define/public (erase-all)
-            (with-unlock -text
-              (send -text erase)
-              (send -text delete-all-drawings))
-            (send controller erase))
-          
-          (define/public (select-syntax stx)
-            (send controller select-syntax stx))
-          
-          (define/public (get-text) -text)
-          
-          (define/private (internal-add-syntax stx)
-            (with-unlock -text
-              (parameterize ((current-default-columns (calculate-columns)))
-                (let ([current-position (send -text last-position)])
-                  (let* ([new-ts (new typesetter-for-text%
-                                      (controller controller)
-                                      (syntax stx)
-                                      (text -text))]
-                         [new-colorer (send new-ts get-colorer)])
-                    (send* -text
-                      (insert "\n")
-                      (scroll-to-position current-position))
-                    new-colorer)))))
+      ;; syntax-properties-controller<%> methods
 
-          (define/private (calculate-columns)
-            (define style (code-style -text))
-            (define char-width (send style get-text-width (send -ecanvas get-dc)))
-            (define-values (canvas-w canvas-h) (send -ecanvas get-client-size))
-            (sub1 (inexact->exact (floor (/ canvas-w char-width)))))
+      (define/public (set-syntax stx)
+        (send props set-syntax stx))
 
-          (super-new)))
+      (define/public (props-shown?)
+        (send -props-panel is-shown?))
+
+      (define/public (toggle-props)
+        (show-props (not (send -props-panel is-shown?))))
+
+      (define/public (show-props show?)
+        (if show?
+            (unless (send -props-panel is-shown?)
+              (send -split-panel add-child -props-panel)
+              (send -split-panel set-percentages
+                    (list (- 1 props-percentage) props-percentage))
+              (send -props-panel show #t))
+            (when (send -props-panel is-shown?)
+              (set! props-percentage
+                    (cadr (send -split-panel get-percentages)))
+              (send -split-panel delete-child -props-panel)
+              (send -props-panel show #f))))
+
+      ;;
+
+      (define/public (get-controller) controller)
+
+      ;;
+
+      (define/public (get-main-panel) -main-panel)
+
+      (define/public (shutdown)
+        (unless (= props-percentage (send config pref:props-percentage))
+          (send config pref:props-percentage props-percentage)))
+
+      ;; syntax-browser<%> Methods
+
+      (define/public (add-text text)
+        (with-unlock -text
+          (send -text insert text)))
+
+      (define/public add-syntax
+        (lambda/kw (stx #:key [hi-stxs null] hi-color alpha-table [definites null]
+                        hi2-color [hi2-stxs null])
+          (define (get-binder id)
+            (module-identifier-mapping-get alpha-table id (lambda () #f)))
+          (when (and (pair? hi-stxs) (not hi-color))
+            (error 'syntax-widget%::add-syntax "no highlight color specified"))
+          (let ([display (internal-add-syntax stx)]
+                [definite-table (make-hash-table)])
+            (when (and hi2-color (pair? hi2-stxs))
+              (send display highlight-syntaxes hi2-stxs hi2-color))
+            (when (and hi-color (pair? hi-stxs))
+              (send display highlight-syntaxes hi-stxs hi-color))
+            (for-each (lambda (x) (hash-table-put! definite-table x #t)) definites)
+            (when alpha-table
+              (let ([range (send display get-range)]
+                    [start (send display get-start-position)])
+                (define (adjust n) (+ start n))
+                (for-each
+                 (lambda (id)
+                   #; ;; DISABLED
+                   (match (identifier-binding id)
+                     [(list src-mod src-name nom-mod nom-name _)
+                      (for-each (lambda (id-r)
+                                  (send -text add-billboard
+                                        (adjust (car id-r))
+                                        (adjust (cdr id-r))
+                                        (string-append "from "
+                                                       (mpi->string src-mod))
+                                        (if (hash-table-get definite-table id #f)
+                                            "blue"
+                                            "purple")))
+                                (send range get-ranges id))]
+                     [_ (void)])
+                   (let ([binder (get-binder id)])
+                     (when binder
+                       (for-each
+                        (lambda (binder-r)
+                          (for-each (lambda (id-r)
+                                      (if (hash-table-get definite-table id #f)
+                                          (send -text add-arrow
+                                                (adjust (car binder-r))
+                                                (adjust (cdr binder-r))
+                                                (adjust (car id-r))
+                                                (adjust (cdr id-r))
+                                                "blue")
+                                          (send -text add-question-arrow
+                                                (adjust (car binder-r))
+                                                (adjust (cdr binder-r))
+                                                (adjust (car id-r))
+                                                (adjust (cdr id-r))
+                                                "purple")))
+                                    (send range get-ranges id)))
+                        (send range get-ranges binder)))))
+                 (send range get-identifier-list))))
+            display)))
       
-      ))
+      (define/public (add-separator)
+        (with-unlock -text
+          (send* -text
+            (insert (new hrule-snip%))
+            (insert "\n"))))
 
-  (define widget-keymap-extension@
-    (unit
-      (import (prefix pre: keymap^))
-      (export keymap^)
+      (define/public (erase-all)
+        (with-unlock -text
+          (send -text erase)
+          (send -text delete-all-drawings))
+        (send controller remove-all-syntax-displays))
 
-      (define syntax-keymap%
-        (class pre:syntax-keymap%
-          (init-field widget)
-          (super-new (controller (send widget get-controller)))
-          (inherit add-function)
-          
-          (add-function "show-syntax-properties"
-                        (lambda (i e)
-                          (send widget toggle-props)))
-          
-          (define/public (get-widget) widget)
-          ))))
-  
-  (define widget-context-menu-extension@
-    (unit
-      (import (prefix pre: context-menu^))
-      (export context-menu^)
+      (define/public (select-syntax stx)
+        (send controller select-syntax stx))
 
-      (define context-menu%
-        (class pre:context-menu%
-          (inherit-field keymap)
-          (inherit-field props-menu)
+      (define/public (get-text) -text)
+
+      ;; internal-add-syntax : syntax -> display
+      (define/private (internal-add-syntax stx)
+        (with-unlock -text
+          (parameterize ((current-default-columns (calculate-columns)))
+            (let ([display (print-syntax-to-editor stx -text controller)])
+              (send* -text
+                (insert "\n")
+                ;(scroll-to-position current-position)
+                )
+              display))))
+
+      (define/private (calculate-columns)
+        (define style (code-style -text))
+        (define char-width (send style get-text-width (send -ecanvas get-dc)))
+        (define-values (canvas-w canvas-h) (send -ecanvas get-client-size))
+        (sub1 (inexact->exact (floor (/ canvas-w char-width)))))
+
+      ;; Initialize
+      (super-new)
+      (setup-keymap)))
+
+
+  ;; Specialized classes for widget
+
+  (define widget-keymap%
+    (class syntax-keymap%
+      (init-field widget)
+      (super-new (controller (send widget get-controller)))
+      (inherit add-function)
+      (inherit-field controller)
+
+      (define/override (get-context-menu%)
+        widget-context-menu%)
+
+      (add-function "show-syntax-properties"
+                    (lambda (i e)
+                      (send widget toggle-props)))
+
+      (define/public (get-widget) widget)))
+
+  (define widget-context-menu%
+    (class context-menu%
+      (inherit-field keymap)
+      (inherit-field props-menu)
+
+      (define/override (on-demand)
+        (send props-menu set-label
+              (if (send (send keymap get-widget) props-shown?)
+                  "Hide syntax properties"
+                  "Show syntax properties"))
+        (super on-demand))
+      (super-new)))
 
-          (define/override (on-demand)
-            (send props-menu set-label
-                  (if (send (send keymap get-widget) props-shown?)
-                      "Hide syntax properties"
-                      "Show syntax properties"))
-            (super on-demand))
-          (super-new)))))
-  
   (define browser-text%
-    (text:arrows-mixin
-     (text:mouse-drawings-mixin
-      (text:drawings-mixin
-       (text:hide-caret/selection-mixin
-        (editor:standard-style-list-mixin text:basic%))))))
+    (class (text:arrows-mixin
+            (text:tacking-mixin
+             (text:mouse-drawings-mixin
+              (text:hide-caret/selection-mixin
+               (editor:standard-style-list-mixin text:basic%)))))
+      (define/override (default-style-name) "Basic")
+      (super-new)))
   )
diff --git a/collects/macro-debugger/view/cursor.ss b/collects/macro-debugger/view/cursor.ss
index 78d0069..36b982b 100644
--- a/collects/macro-debugger/view/cursor.ss
+++ b/collects/macro-debugger/view/cursor.ss
@@ -3,6 +3,7 @@
   (provide cursor?
            cursor:new
            cursor:add-to-end!
+           cursor:remove-current!
 
            cursor:next
            cursor:prev
@@ -64,6 +65,10 @@
     (let ([suffix (cursor-suffixp c)])
       (set-cursor-suffixp! c (stream-append suffix items))))
 
+  (define (cursor:remove-current! c)
+    (when (cursor:has-next? c)
+      (set-cursor-suffixp! c (stream-cdr (cursor-suffixp c)))))
+
   (define (cursor:next c)
     (let ([suffix (cursor-suffixp c)])
       (if (stream-null? suffix)
diff --git a/collects/macro-debugger/view/extensions.ss b/collects/macro-debugger/view/extensions.ss
new file mode 100644
index 0000000..774893f
--- /dev/null
+++ b/collects/macro-debugger/view/extensions.ss
@@ -0,0 +1,112 @@
+
+(module extensions mzscheme
+  (require (lib "class.ss")
+           (lib "unit.ss")
+           (lib "list.ss")
+           (lib "plt-match.ss")
+           (lib "mred.ss" "mred")
+           (lib "framework.ss" "framework")
+           (lib "boundmap.ss" "syntax")
+           "interfaces.ss"
+           "prefs.ss"
+           "warning.ss"
+           "hiding-panel.ss"
+           (prefix s: "../syntax-browser/widget.ss")
+           "../model/deriv.ss"
+           "../model/deriv-util.ss"
+           "../model/trace.ss"
+           "../model/hide.ss"
+           "../model/steps.ss"
+           "cursor.ss"
+           "util.ss")
+  (provide stepper-keymap%
+           stepper-context-menu%
+           stepper-syntax-widget%)
+
+  ;; Extensions
+
+  (define stepper-keymap%
+    (class s:widget-keymap%
+      (init-field macro-stepper)
+      (inherit-field controller)
+      (inherit add-function)
+
+      (super-new)
+
+      (define/override (get-context-menu%)
+        stepper-context-menu%)
+
+      (define/public (get-hiding-panel)
+        (send macro-stepper get-macro-hiding-prefs))
+
+      (add-function "hiding:show-macro"
+                    (lambda (i e)
+                      (send* (get-hiding-panel)
+                        (add-show-identifier)
+                        (refresh))))
+      
+      (add-function "hiding:hide-macro"
+                    (lambda (i e)
+                      (send* (get-hiding-panel)
+                        (add-hide-identifier)
+                        (refresh))))))
+
+  (define stepper-context-menu%
+    (class s:widget-context-menu%
+      (inherit-field keymap)
+      (inherit add-separator)
+      
+      (field [show-macro #f]
+             [hide-macro #f])
+      
+      (define/override (after-selection-items)
+        (super after-selection-items)
+        (add-separator)
+        (set! show-macro
+              (new menu-item% (label "Show this macro") (parent this)
+                   (callback (lambda (i e)
+                               (send keymap call-function "hiding:show-macro" i e)))))
+        (set! hide-macro
+              (new menu-item% (label "Hide this macro") (parent this)
+                   (callback (lambda (i e)
+                               (send keymap call-function "hiding:hide-macro" i e)))))
+        (void))
+      
+      (define/override (on-demand)
+        (define hiding-panel (send keymap get-hiding-panel))
+        (define controller (send keymap get-controller))
+        (define stx (send controller get-selected-syntax))
+        (define id? (identifier? stx))
+        (send show-macro enable id?)
+        (send hide-macro enable id?)
+        (super on-demand))
+
+      (super-new)))
+  
+  (define stepper-syntax-widget%
+    (class s:widget%
+      (init-field macro-stepper)
+      (inherit get-text)
+
+      (define/override (setup-keymap)
+        (new stepper-keymap%
+             (editor (get-text))
+             (widget this)
+             (macro-stepper macro-stepper)))
+
+      (define/override (show-props show?)
+        (super show-props show?)
+        (send macro-stepper update/preserve-view))
+
+      (super-new
+       (config (new config-adapter%
+                    (config (send macro-stepper get-config)))))))
+  
+  (define config-adapter%
+    (class object%
+      (init-field config)
+      (define/public pref:props-percentage
+        (case-lambda [() (send config get-props-percentage)]
+                     [(v) (send config set-props-percentage v)]))
+      (super-new)))
+  )
diff --git a/collects/macro-debugger/view/frame.ss b/collects/macro-debugger/view/frame.ss
new file mode 100644
index 0000000..d8a7644
--- /dev/null
+++ b/collects/macro-debugger/view/frame.ss
@@ -0,0 +1,239 @@
+
+(module frame mzscheme
+  (require (lib "class.ss")
+           (lib "unit.ss")
+           (lib "list.ss")
+           (lib "file.ss")
+           (lib "plt-match.ss")
+           (lib "mred.ss" "mred")
+           (lib "framework.ss" "framework")
+           (lib "boundmap.ss" "syntax")
+           "interfaces.ss"
+           "stepper.ss"
+           "prefs.ss"
+           "warning.ss"
+           "hiding-panel.ss"
+           (prefix sb: "../syntax-browser/embed.ss")
+           (prefix sb: "../syntax-browser/params.ss")
+           "../model/deriv.ss"
+           "../model/deriv-util.ss"
+           "../model/trace.ss"
+           "../model/hide.ss"
+           "../model/steps.ss"
+           "cursor.ss"
+           "util.ss")
+  (provide macro-stepper-frame-mixin)
+
+  (define (macro-stepper-frame-mixin base-frame%)
+    (class base-frame%
+      (init-field config)
+      (init-field (filename #f))
+
+      (define obsoleted? #f)
+
+      (inherit get-area-container
+               set-label
+               get-menu%
+               get-menu-item%
+               get-menu-bar
+               get-file-menu
+               get-edit-menu
+               get-help-menu)
+
+      (super-new (label (make-label))
+                 (width (send config get-width))
+                 (height (send config get-height)))
+
+      (define/private (make-label)
+        (if filename
+            (string-append (path->string
+                            (file-name-from-path filename))
+                           (if obsoleted? " (old)" "")
+                           " - Macro stepper")
+            "Macro stepper"))
+
+      (define/override (on-size w h)
+        (send config set-width w)
+        (send config set-height h)
+        (send widget update/preserve-view))
+
+      (define/augment (on-close)
+        (send widget shutdown)
+        (inner (void) on-close))
+
+      (override/return-false file-menu:create-new?
+                             file-menu:create-open?
+                             file-menu:create-open-recent?
+                             file-menu:create-revert?
+                             file-menu:create-save?
+                             file-menu:create-save-as?
+                             ;file-menu:create-print?
+                             edit-menu:create-undo?
+                             edit-menu:create-redo?
+                             ;edit-menu:create-cut?
+                             ;edit-menu:create-paste?
+                             edit-menu:create-clear?
+                             ;edit-menu:create-find?
+                             ;edit-menu:create-find-again?
+                             edit-menu:create-replace-and-find-again?)
+
+      (define file-menu (get-file-menu))
+      (define edit-menu (get-edit-menu))
+      (define stepper-menu
+        (new (get-menu%) (parent (get-menu-bar)) (label "Stepper")))
+      (define help-menu (get-help-menu))
+
+      (define warning-panel
+        (new horizontal-panel%
+             (parent (get-area-container))
+             (stretchable-height #f)
+             (style '(deleted))))
+
+      (define widget
+        (new macro-stepper-widget%
+             (parent (get-area-container))
+             (config config)))
+
+      (define/public (get-widget) widget)
+
+      (define/public (add-obsoleted-warning)
+        (unless obsoleted?
+          (set! obsoleted? #t)
+          (new warning-canvas%
+               (warning
+                (string-append
+                 "Warning: This macro stepper session is obsolete. "
+                 "The program may have changed."))
+               (parent warning-panel))
+          (set-label (make-label))
+          (send (get-area-container) change-children
+                (lambda (children)
+                  (cons warning-panel
+                        (remq warning-panel children))))))
+
+      ;; Set up menus
+
+      (menu-option/notify-box stepper-menu
+                              "Show syntax properties"
+                              (get-field show-syntax-properties? config))
+
+      ;; FIXME: rewrite with notify-box
+      (let ([id-menu
+             (new (get-menu%)
+                  (label "Identifier=?")
+                  (parent stepper-menu))])
+        (for-each (lambda (p)
+                    (let ([this-choice
+                           (new checkable-menu-item%
+                                (label (car p)) 
+                                (parent id-menu)
+                                (callback
+                                 (lambda _ 
+                                   (send (send widget get-controller)
+                                         on-update-identifier=?
+                                         (car p)
+                                         (cdr p)))))])
+                      (send (send widget get-controller)
+                            listen-identifier=?
+                            (lambda (name+func)
+                              (send this-choice check
+                                    (eq? (car name+func) (car p)))))))
+                  (sb:identifier=-choices)))
+      (let ([identifier=? (send config get-identifier=?)])
+        (when identifier=?
+          (let ([p (assoc identifier=? (sb:identifier=-choices))])
+            (send (send widget get-controller) set-identifier=? p))))
+
+      (new (get-menu-item%)
+           (label "Clear selection")
+           (parent stepper-menu)
+           (callback
+            (lambda _ (send (send widget get-controller) select-syntax #f))))
+      (new separator-menu-item% (parent stepper-menu))
+
+      (menu-option/notify-box stepper-menu
+                              "Show macro hiding panel"
+                              (get-field show-hiding-panel? config))
+      #;
+      (new (get-menu-item%)
+           (label "Show in new frame")
+           (parent stepper-menu)
+           (callback (lambda _ (send widget show-in-new-frame))))
+      (new (get-menu-item%)
+           (label "Remove selected term")
+           (parent stepper-menu)
+           (callback (lambda _ (send widget remove-current-term))))
+      (new (get-menu-item%)
+           (label "Reset mark numbering")
+           (parent stepper-menu)
+           (callback (lambda _ (send widget reset-primary-partition))))
+      (let ([extras-menu
+             (new (get-menu%)
+                  (label "Extra options")
+                  (parent stepper-menu))])
+        (new checkable-menu-item%
+             (label "Always suffix marked identifiers")
+             (parent extras-menu)
+             (callback
+              (lambda (i e)
+                (sb:current-suffix-option
+                 (if (send i is-checked?)
+                     'always
+                     'over-limit))
+                (send widget update/preserve-view))))
+        (menu-option/notify-box extras-menu
+                                "Highlight redex/contractum"
+                                (get-field highlight-foci? config))
+        (menu-option/notify-box extras-menu
+                                "Highlight frontier"
+                                (get-field highlight-frontier? config))
+        (menu-option/notify-box extras-menu
+                                "Include renaming steps"
+                                (get-field show-rename-steps? config))
+        (menu-option/notify-box extras-menu
+                                "One term at a time"
+                                (get-field one-by-one? config))
+        (menu-option/notify-box extras-menu
+                                "Suppress warnings"
+                                (get-field suppress-warnings? config))
+        (menu-option/notify-box extras-menu
+                                "Extra navigation"
+                                (get-field extra-navigation? config))
+        (menu-option/notify-box extras-menu
+                                "Force block->letrec transformation"
+                                (get-field force-letrec-transformation? config))
+        (menu-option/notify-box extras-menu
+                                "(Debug) Catch internal errors?"
+                                (get-field debug-catch-errors? config)))
+
+      (frame:reorder-menus this)))
+
+  ;; Stolen from stepper
+
+  (define warning-color "yellow")
+  (define warning-font normal-control-font)
+
+  (define warning-canvas%
+    (class canvas%
+      (init-field warning)
+      (inherit get-dc get-client-size)
+      (define/override (on-paint)
+        (let ([dc (get-dc)])
+          (send dc set-font warning-font) 
+          (let-values ([(cw ch) (get-client-size)]
+                       [(tw th dont-care dont-care2) (send dc get-text-extent warning)])
+            (send dc set-pen (send the-pen-list find-or-create-pen warning-color 1 'solid))
+            (send dc set-brush (send the-brush-list find-or-create-brush warning-color 'solid))
+            (send dc draw-rectangle 0 0 cw ch)
+            (send dc draw-text 
+                  warning
+                  (- (/ cw 2) (/ tw 2))
+                  (- (/ ch 2) (/ th 2))))))
+      (super-new)
+      (inherit min-width min-height stretchable-height)
+      (let-values ([(tw th dc dc2) (send (get-dc) get-text-extent warning warning-font)])
+        (min-width (+ 2 (inexact->exact (ceiling tw))))
+        (min-height (+ 2 (inexact->exact (ceiling th)))))
+      (stretchable-height #f)))
+
+  )
diff --git a/collects/macro-debugger/view/hiding-panel.ss b/collects/macro-debugger/view/hiding-panel.ss
index cd47c4d..98fb4a3 100644
--- a/collects/macro-debugger/view/hiding-panel.ss
+++ b/collects/macro-debugger/view/hiding-panel.ss
@@ -5,10 +5,54 @@
            (lib "list.ss")
            (lib "boundmap.ss" "syntax")
            "util.ss"
-           "../model/hiding-policies.ss"
+           "../model/synth-engine.ss"
            "../syntax-browser/util.ss")
   (provide macro-hiding-prefs-widget%)
-  
+
+  (define mode:disable "Disable")
+  (define mode:standard "Standard")
+  (define mode:custom "Custom ...")
+
+  (define (make-policy hide-mzscheme?
+                       hide-libs?
+                       hide-contracts?
+                       hide-transformers?
+                       specialized-policies)
+    (lambda (id)
+      (define now (phase))
+      (define binding
+        (cond [(= now 0) (identifier-binding id)]
+              [(= now 1) (identifier-transformer-binding id)]
+              [else #f]))
+      (define-values (def-mod def-name nom-mod nom-name)
+        (if (pair? binding)
+            (values (car binding)
+                    (cadr binding)
+                    (caddr binding)
+                    (cadddr binding))
+            (values #f #f #f #f)))
+      (let/ec return
+        (let loop ([policies specialized-policies])
+          (when (pair? policies)
+            ((car policies) id binding return)
+            (loop (cdr policies))))
+        (cond [(and hide-mzscheme? (symbol? def-mod)
+                    (regexp-match #rx"^#%" (symbol->string def-mod)))
+               #f]
+              [(and hide-libs? def-mod
+                    (lib-module? def-mod))
+               #f]
+              [(and hide-contracts? def-name
+                    (regexp-match #rx"^provide/contract-id-"
+                                  (symbol->string def-name)))
+               #f]
+              [(and hide-transformers? (positive? now))
+               #f]
+              [else #t]))))
+
+  (define standard-policy
+    (make-policy #t #t #t #t null))
+
   ;; macro-hiding-prefs-widget%
   (define macro-hiding-prefs-widget%
     (class object%
@@ -16,200 +60,269 @@
       (init-field stepper)
       (init-field config)
 
-      (define policy (new-hiding-policy))
-      (set-hiding-policy-opaque-kernel! policy (send config get-hide-primitives?))
-      (set-hiding-policy-opaque-libs! policy (send config get-hide-libs?))
-      (send config listen-hide-primitives?
-            (lambda (value)
-              (set-hiding-policy-opaque-kernel! policy value)
-              (refresh)))
-      (send config listen-hide-libs?
-            (lambda (value)
-              (set-hiding-policy-opaque-libs! policy value)
-              (refresh)))
+      (define/public (get-policy)
+        (let ([mode (get-mode)])
+          (cond [(not (macro-hiding-enabled?)) #f]
+                [(equal? mode mode:standard) standard-policy]
+                [(equal? mode mode:custom) (get-custom-policy)])))
 
-      (define stx #f)
-      (define stx-name #f)
-      (define stx-module #f)
+      (define/private (get-custom-policy)
+        (let ([hide-mzscheme? (send box:hide-mzscheme get-value)]
+              [hide-libs? (send box:hide-libs get-value)]
+              [hide-contracts? (send box:hide-contracts get-value)]
+              [hide-transformers? (send box:hide-phase1 get-value)]
+              [specialized-policies (get-specialized-policies)])
+          (make-policy hide-mzscheme?
+                       hide-libs?
+                       hide-contracts?
+                       hide-transformers?
+                       specialized-policies)))
 
-      (define super-pane
-        (new horizontal-pane%
+      (define super-panel
+        (new vertical-panel%
              (parent parent)
              (stretchable-height #f)))
+      (define top-line-panel
+        (new horizontal-panel%
+             (parent super-panel)
+             (alignment '(left center))
+             (stretchable-height #f)))
+      (define customize-panel
+        (new horizontal-panel%
+             (parent super-panel)
+             (stretchable-height #f)
+             (alignment '(left top))
+             (style '(deleted))))
       (define left-pane
         (new vertical-pane%
-             (parent super-pane)
+             (parent customize-panel)
              (stretchable-width #f)
              (alignment '(left top))))
       (define right-pane
         (new vertical-pane%
-             (parent super-pane)))
+             (parent customize-panel)))
 
-      (define enable-ctl
-        (check-box/notify-box left-pane
-                              "Enable macro hiding?"
-                              (get-field macro-hiding? config)))
-      (send config listen-macro-hiding?
-            (lambda (value) (force-refresh)))
+      (define mode-selector
+        (choice/notify-box
+         top-line-panel
+         "Macro hiding: "
+         (list mode:disable mode:standard mode:custom)
+         (get-field macro-hiding-mode config)))
+      (define top-line-inner-panel
+        (new horizontal-panel%
+             (parent top-line-panel)
+             (alignment '(right center))
+             (style '(deleted))))
 
-      (define kernel-ctl
-        (check-box/notify-box left-pane
-                              "Hide mzscheme syntax"
-                              (get-field hide-primitives? config)))
+      (define/private (get-mode)
+        (send config get-macro-hiding-mode))
 
-      (define libs-ctl
-        (check-box/notify-box left-pane
-                              "Hide library syntax"
-                              (get-field hide-libs? config)))
+      (define/private (macro-hiding-enabled?)
+        (let ([mode (get-mode)])
+          (or (equal? mode mode:standard)
+              (and (equal? mode mode:custom)
+                   (send box:hiding get-value)))))
+
+      (define/private (ensure-custom-mode)
+        (unless (equal? (get-mode) mode:custom)
+          (send config set-macro-hiding-mode mode:custom)))
+
+      (define/private (update-visibility)
+        (let ([customizing (equal? (get-mode) mode:custom)])
+          (send top-line-panel change-children
+                (lambda (children)
+                  (append (remq top-line-inner-panel children)
+                          (if customizing (list top-line-inner-panel) null))))
+          (send super-panel change-children
+                (lambda (children)
+                  (append (remq customize-panel children)
+                          (if (and customizing (send box:edit get-value))
+                              (list customize-panel)
+                              null))))))
+
+      (send config listen-macro-hiding-mode
+            (lambda (value)
+              (update-visibility)
+              (force-refresh)))
+
+      (define box:hiding
+        (new check-box%
+             (label "Enable macro hiding")
+             (value #t)
+             (parent top-line-inner-panel)
+             (callback (lambda (c e) (force-refresh)))))
+      (define box:edit
+        (new check-box%
+             (label "Show policy editor")
+             (parent top-line-inner-panel)
+             (value #t)
+             (callback (lambda (c e) (update-visibility)))))
+
+      (define box:hide-mzscheme
+        (new check-box%
+             (label "Hide mzscheme syntax")
+             (parent left-pane)
+             (value #t)
+             (callback (lambda (c e) (refresh)))))
+      (define box:hide-libs
+        (new check-box%
+             (label "Hide library syntax")
+             (parent left-pane)
+             (value #t)
+             (callback (lambda (c e) (refresh)))))
+      (define box:hide-contracts
+        (new check-box%
+             (label "Hide contracts (heuristic)")
+             (parent left-pane)
+             (value #t)
+             (callback (lambda (c e) (refresh)))))
+      (define box:hide-phase1
+        (new check-box%
+             (label "Hide phase>0")
+             (parent left-pane)
+             (value #t)
+             (callback (lambda (c e) (refresh)))))
 
-      (define look-pane
-        (new horizontal-pane% (parent right-pane) (stretchable-height #f)))
       (define look-ctl
-        (new list-box% (parent look-pane) (label "") (choices null)))
-      (define delete-ctl
-        (new button% (parent look-pane) (label "Delete")
+        (new list-box% (parent right-pane) (label "")
+             (choices null) (style '(extended))
              (callback
-              (lambda _
-                (delete-selected)
-                (refresh)))))
-      
-      (define add-pane
-        (new horizontal-pane% (parent right-pane) (stretchable-height #f)))
-      (define add-text
-        (new text-field%
-             (label "")
-             (parent add-pane)
-             (stretchable-width #t)))
-      (define add-editor (send add-text get-editor))
-      (define add-hide-module-button
-        (new button% (parent add-pane) (label "Hide module") (enabled #f)
-             (callback (lambda _ (add-hide-module) (refresh)))))
+              (lambda (c e)
+                (send delete-ctl enable (pair? (send c get-selections)))))))
+
+      (define look-button-pane
+        (new horizontal-pane% (parent right-pane) (stretchable-width #f)))
+
+      (define delete-ctl
+        (new button% (parent look-button-pane) (label "Delete rule") (enabled #f)
+             (callback (lambda _ (delete-selected) (refresh)))))
       (define add-hide-id-button
-        (new button% (parent add-pane) (label "Hide macro") (enabled #f)
+        (new button% (parent look-button-pane) (label "Hide macro") (enabled #f)
              (callback (lambda _ (add-hide-identifier) (refresh)))))
       (define add-show-id-button
-        (new button% (parent add-pane) (label "Show macro") (enabled #f)
+        (new button% (parent look-button-pane) (label "Show macro") (enabled #f)
              (callback (lambda _ (add-show-identifier) (refresh)))))
-
-      (new grow-box-spacer-pane% (parent add-pane))
-
-      (send add-editor lock #t)
+      #;(new grow-box-spacer-pane% (parent right-pane))
 
       ;; Methods
-      
-      (define/public (get-show-macro?)
-        (lambda (id) (policy-show-macro? policy id)))
-      
-      ;; refresh
+
+      (define stx #f)
+      (define stx-name #f)
+
+      ;; refresh : -> void
       (define/public (refresh)
-        (when (send config get-macro-hiding?)
+        (when (macro-hiding-enabled?)
           (send stepper refresh/resynth)))
 
-      ;; force-refresh
+      ;; force-refresh : -> void
       (define/private (force-refresh)
         (send stepper refresh/resynth))
 
       ;; set-syntax : syntax/#f -> void
       (define/public (set-syntax lstx)
-        (set! stx lstx)
-        (send add-editor lock #f)
-        (send add-editor erase)
-        (unless (identifier? stx)
-          (send add-hide-module-button enable #f))
+        (set! stx (and (identifier? lstx) lstx))
         (when (identifier? stx)
           (let ([binding (identifier-binding stx)])
-            (send add-hide-module-button enable (pair? binding))
             (if (pair? binding)
-                (begin
-                  (set! stx-name (cadr binding))
-                  (set! stx-module (car binding)))
-                (begin
-                  (set! stx-name (syntax-e stx))
-                  (set! stx-module #f)))
-            (update-add-text)))
-        (send add-editor lock #t)
+                (set! stx-name (cadr binding))
+                (set! stx-name (syntax-e stx)))))
         (send add-show-id-button enable (identifier? lstx))
         (send add-hide-id-button enable (identifier? lstx)))
-      
-      (define/private (update-add-text)
-        (send add-editor lock #f)
-        (when (identifier? stx)
-          (send add-editor insert (identifier-text "" stx)))
-        (send add-editor lock #t))
-      
-      (define/public (add-hide-module)
-        (when stx-module
-          (policy-hide-module policy stx-module)
-          (update-list-view)))
-      
+
+      (define identifier-policies null)
+
+      (define/private (get-specialized-policies)
+        (map (lambda (policy)
+               (define key (car policy))
+               (define show? (cdr policy))
+               (cond [(pair? key)
+                      (lambda (id binding return)
+                        (when (and (pair? binding)
+                                   (equal? key (get-id-key/binding id binding)))
+                          (return show?)))]
+                     [else
+                      (lambda (id binding return)
+                        (when (module-identifier=? id key)
+                          (return show?)))]))
+             identifier-policies))
+
       (define/public (add-hide-identifier)
-        (when (identifier? stx)
-          (policy-hide-id policy stx)
-          (update-list-view)))
-      
+        (add-identifier-policy #f)
+        (ensure-custom-mode))
+
       (define/public (add-show-identifier)
+        (add-identifier-policy #t)
+        (ensure-custom-mode))
+
+      (define/private (add-identifier-policy show?)
         (when (identifier? stx)
-          (policy-show-id policy stx)
-          (update-list-view)))
-      
+          (let ([key (get-id-key stx)])
+            (let loop ([i 0] [policies identifier-policies])
+              (cond [(null? policies)
+                     (set! identifier-policies
+                           (cons (cons key show?) identifier-policies))
+                     (send look-ctl append "")
+                     (update-list-view i key show?)]
+                    [(key=? key (car (car policies)))
+                     (set-cdr! (car policies) show?)
+                     (update-list-view i key show?)]
+                    [else (loop (add1 i) (cdr policies))])))))
+
+      (define/private (update-list-view index key show?)
+        (send look-ctl set-data index key)
+        (send look-ctl set-string
+              index
+              (string-append (if show? "show " "hide ")
+                             (key->text key))))
+
       (define/private (delete-selected)
-        (for-each (lambda (n)
-                    (let ([d (send look-ctl get-data n)])
-                      (case (car d)
-                        ((identifier) (policy-unhide-id policy (cdr d)))
-                        ((show-identifier) (policy-unshow-id policy (cdr d)))
-                        ((module) (policy-unhide-module policy (cdr d))))))
-                  (send look-ctl get-selections))
-        (update-list-view))
-      
-      (define/private (identifier-text prefix id)
-        (let ([b (identifier-binding id)])
-          (cond [(pair? b)
-                 (let ([name (cadr b)]
-                       [mod (car b)])
-                   (format "~a'~s' from ~a"
-                           prefix
-                           name
-                           (mpi->string mod)))]
-                [(eq? b 'lexical)
-                 (format "~alexically bound '~s'"
-                         prefix
-                         (syntax-e id))]
-                [(not b)
-                 (format "~aglobal or unbound '~s'" prefix (syntax-e id))])))
-      
-      (define/private (update-list-view)
-        (let ([opaque-modules
-               (hash-table-map (hiding-policy-opaque-modules policy)
-                               (lambda (k v) k))]
-              [opaque-ids
-               (filter values
-                       (module-identifier-mapping-map
-                        (hiding-policy-opaque-ids policy)
-                        (lambda (k v) (and v k))))]
-              [transparent-ids
-               (filter values
-                       (module-identifier-mapping-map
-                        (hiding-policy-transparent-ids policy)
-                        (lambda (k v) (and v k))))])
-          (define (om s)
-            (cons (format "hide from module ~a" (mpi->string s))
-                  (cons 'module s)))
-          (define (*i prefix tag id)
-            (cons (identifier-text prefix id)
-                  (cons tag id)))
-          (define (oid id) (*i "hide " 'identifier id))
-          (define (tid id) (*i "show " 'show-identifier id))
-          (let ([choices
-                 (sort (append (map om opaque-modules)
-                               (map oid opaque-ids)
-                               (map tid transparent-ids))
-                       (lambda (a b)
-                         (string<=? (car a) (car b))))])
-            (send look-ctl clear)
-            (for-each (lambda (c) (send look-ctl append (car c) (cdr c)))
-                      choices))))
-      
-      (super-new)))
-  
+        (define to-delete (sort (send look-ctl get-selections) <))
+        (set! identifier-policies
+              (let loop ([i 0] [policies identifier-policies] [to-delete to-delete])
+                (cond [(null? to-delete) policies]
+                      [(= i (car to-delete))
+                       (loop (add1 i) (cdr policies) (cdr to-delete))]
+                      [else
+                       (cons (car policies)
+                             (loop (add1 i) (cdr policies) to-delete))])))
+        (for-each (lambda (n) (send look-ctl delete n)) (reverse to-delete)))
+
+      (super-new)
+      (update-visibility)))
+
+  (define (lib-module? mpi)
+    (and (module-path-index? mpi)
+         (let-values ([(path rel) (module-path-index-split mpi)])
+           (cond [(pair? path) (memq (car path) '(lib planet))]
+                 [(string? path) (lib-module? rel)]
+                 [else #f]))))
+
+  (define (get-id-key id)
+    (let ([binding
+           (or (identifier-binding id)
+               (identifier-transformer-binding id))])
+      (get-id-key/binding id binding)))
+
+  (define (get-id-key/binding id binding)
+      (cond [(pair? binding)
+             binding]
+            [else id]))
+
+  (define (key=? key1 key2)
+    (cond [(and (identifier? key1) (identifier? key2))
+           (module-identifier=? key1 key2)]
+          [(and (pair? key1) (pair? key2))
+           (and (equal? (car key1) (car key2))
+                (equal? (cadr key1) (cadr key2)))]
+          [else #f]))
+
+  (define (key->text key)
+    (cond [(pair? key)
+           (let ([name (cadddr key)]
+                 [mod (caddr key)])
+             (format "'~s' from ~a"
+                     name
+                     (mpi->string mod)))]
+          [else (symbol->string (syntax-e key))]))
+
   )
diff --git a/collects/macro-debugger/view/interfaces.ss b/collects/macro-debugger/view/interfaces.ss
index b8ad2a5..855dd1d 100644
--- a/collects/macro-debugger/view/interfaces.ss
+++ b/collects/macro-debugger/view/interfaces.ss
@@ -19,11 +19,9 @@
     (pref:width
      pref:height
      pref:props-percentage
-     pref:macro-hiding?
+     pref:macro-hiding-mode
      pref:show-syntax-properties?
      pref:show-hiding-panel?
-     pref:hide-primitives?
-     pref:hide-libs?
      pref:identifier=?
      pref:show-rename-steps?
      pref:highlight-foci?
diff --git a/collects/macro-debugger/view/prefs.ss b/collects/macro-debugger/view/prefs.ss
index 1c642db..f7bbcb8 100644
--- a/collects/macro-debugger/view/prefs.ss
+++ b/collects/macro-debugger/view/prefs.ss
@@ -1,26 +1,19 @@
 
 (module prefs mzscheme
-  (require (lib "unit.ss")
+  (require (lib "class.ss")
            (lib "framework.ss" "framework")
-           "interfaces.ss")
-  (provide prefs@)
-  
-  (define-syntax pref:get/set
-    (syntax-rules ()
-      [(_ get/set prop)
-       (define get/set
-         (case-lambda
-           [() (preferences:get 'prop)]
-           [(newval) (preferences:set 'prop newval)]))]))
+           "../util/notify.ss"
+           "../util/misc.ss")
+  (provide macro-stepper-config-base%
+           macro-stepper-config/prefs%
+           macro-stepper-config/prefs/readonly%)
 
   (preferences:set-default 'MacroStepper:Frame:Width 700 number?)
   (preferences:set-default 'MacroStepper:Frame:Height 600 number?)
   (preferences:set-default 'MacroStepper:PropertiesPanelPercentage 1/3 number?)
-  (preferences:set-default 'MacroStepper:MacroHiding? #t boolean?)
+  (preferences:set-default 'MacroStepper:MacroHidingMode "Standard" string?)
   (preferences:set-default 'MacroStepper:ShowSyntaxProperties? #f boolean?)
   (preferences:set-default 'MacroStepper:ShowHidingPanel? #t boolean?)
-  (preferences:set-default 'MacroStepper:HidePrimitives? #t boolean?)
-  (preferences:set-default 'MacroStepper:HideLibs? #t boolean?)
   (preferences:set-default 'MacroStepper:IdentifierComparison "bound-identifier=?" string?)
   (preferences:set-default 'MacroStepper:HighlightFoci? #t boolean?)
   (preferences:set-default 'MacroStepper:HighlightFrontier? #t boolean?)
@@ -31,28 +24,77 @@
   (preferences:set-default 'MacroStepper:DebugCatchErrors? #t boolean?)
   (preferences:set-default 'MacroStepper:ForceLetrecTransformation? #f boolean?)
 
-  (define prefs@
-    (unit
-      (import)
-      (export prefs^)
-      
-      (pref:get/set pref:width MacroStepper:Frame:Width)
-      (pref:get/set pref:height MacroStepper:Frame:Height)
-      (pref:get/set pref:props-percentage MacroStepper:PropertiesPanelPercentage)
-      (pref:get/set pref:macro-hiding? MacroStepper:MacroHiding?)
-      (pref:get/set pref:show-syntax-properties? MacroStepper:ShowSyntaxProperties?)
-      (pref:get/set pref:show-hiding-panel? MacroStepper:ShowHidingPanel?)
-      (pref:get/set pref:hide-primitives? MacroStepper:HidePrimitives?)
-      (pref:get/set pref:hide-libs? MacroStepper:HideLibs?)
-      (pref:get/set pref:identifier=? MacroStepper:IdentifierComparison)
-      (pref:get/set pref:highlight-foci? MacroStepper:HighlightFoci?)
-      (pref:get/set pref:highlight-frontier? MacroStepper:HighlightFrontier?)
-      (pref:get/set pref:show-rename-steps? MacroStepper:ShowRenameSteps?)
-      (pref:get/set pref:suppress-warnings? MacroStepper:SuppressWarnings?)
-      (pref:get/set pref:one-by-one? MacroStepper:OneByOne?)
-      (pref:get/set pref:extra-navigation? MacroStepper:ExtraNavigation?)
-      (pref:get/set pref:debug-catch-errors? MacroStepper:DebugCatchErrors?)
-      (pref:get/set pref:force-letrec-transformation? MacroStepper:ForceLetrecTransformation?)
-      
-      ))
+  (pref:get/set pref:width MacroStepper:Frame:Width)
+  (pref:get/set pref:height MacroStepper:Frame:Height)
+  (pref:get/set pref:props-percentage MacroStepper:PropertiesPanelPercentage)
+  (pref:get/set pref:macro-hiding-mode MacroStepper:MacroHidingMode)
+  (pref:get/set pref:show-syntax-properties? MacroStepper:ShowSyntaxProperties?)
+  (pref:get/set pref:show-hiding-panel? MacroStepper:ShowHidingPanel?)
+  (pref:get/set pref:identifier=? MacroStepper:IdentifierComparison)
+  (pref:get/set pref:highlight-foci? MacroStepper:HighlightFoci?)
+  (pref:get/set pref:highlight-frontier? MacroStepper:HighlightFrontier?)
+  (pref:get/set pref:show-rename-steps? MacroStepper:ShowRenameSteps?)
+  (pref:get/set pref:suppress-warnings? MacroStepper:SuppressWarnings?)
+  (pref:get/set pref:one-by-one? MacroStepper:OneByOne?)
+  (pref:get/set pref:extra-navigation? MacroStepper:ExtraNavigation?)
+  (pref:get/set pref:debug-catch-errors? MacroStepper:DebugCatchErrors?)
+  (pref:get/set pref:force-letrec-transformation? MacroStepper:ForceLetrecTransformation?)
+
+  (define macro-stepper-config-base%
+    (class object%
+      (notify-methods width)
+      (notify-methods height)
+      (notify-methods macro-hiding-mode)
+      (notify-methods props-percentage)
+      (notify-methods show-syntax-properties?)
+      (notify-methods show-hiding-panel?)
+      (notify-methods identifier=?)
+      (notify-methods highlight-foci?)
+      (notify-methods highlight-frontier?)
+      (notify-methods show-rename-steps?)
+      (notify-methods suppress-warnings?)
+      (notify-methods one-by-one?)
+      (notify-methods extra-navigation?)
+      (notify-methods debug-catch-errors?)
+      (notify-methods force-letrec-transformation?)
+      (super-new)))
+
+  (define macro-stepper-config/prefs%
+    (class macro-stepper-config-base%
+      (connect-to-pref width pref:width)
+      (connect-to-pref height pref:height)
+      (connect-to-pref macro-hiding-mode pref:macro-hiding-mode)
+      (connect-to-pref props-percentage pref:props-percentage)
+      (connect-to-pref show-syntax-properties? pref:show-syntax-properties?)
+      (connect-to-pref show-hiding-panel? pref:show-hiding-panel?)
+      (connect-to-pref identifier=? pref:identifier=?)
+      (connect-to-pref highlight-foci? pref:highlight-foci?)
+      (connect-to-pref highlight-frontier? pref:highlight-frontier?)
+      (connect-to-pref show-rename-steps? pref:show-rename-steps?)
+      (connect-to-pref suppress-warnings? pref:suppress-warnings?)
+      (connect-to-pref one-by-one? pref:one-by-one?)
+      (connect-to-pref extra-navigation? pref:extra-navigation?)
+      (connect-to-pref debug-catch-errors? pref:debug-catch-errors?)
+      (connect-to-pref force-letrec-transformation? pref:force-letrec-transformation?)
+      (super-new)))
+
+  (define macro-stepper-config/prefs/readonly%
+    (class macro-stepper-config-base%
+      (connect-to-pref/readonly width pref:width)
+      (connect-to-pref/readonly height pref:height)
+      (connect-to-pref/readonly macro-hiding-mode pref:macro-hiding-mode)
+      (connect-to-pref/readonly props-percentage pref:props-percentage)
+      (connect-to-pref/readonly show-syntax-properties? pref:show-syntax-properties?)
+      (connect-to-pref/readonly show-hiding-panel? pref:show-hiding-panel?)
+      (connect-to-pref/readonly identifier=? pref:identifier=?)
+      (connect-to-pref/readonly highlight-foci? pref:highlight-foci?)
+      (connect-to-pref/readonly highlight-frontier? pref:highlight-frontier?)
+      (connect-to-pref/readonly show-rename-steps? pref:show-rename-steps?)
+      (connect-to-pref/readonly suppress-warnings? pref:suppress-warnings?)
+      (connect-to-pref/readonly one-by-one? pref:one-by-one?)
+      (connect-to-pref/readonly extra-navigation? pref:extra-navigation?)
+      (connect-to-pref/readonly debug-catch-errors? pref:debug-catch-errors?)
+      (connect-to-pref/readonly force-letrec-transformation? pref:force-letrec-transformation?)
+      (super-new)))
+
   )
diff --git a/collects/macro-debugger/view/stepper.ss b/collects/macro-debugger/view/stepper.ss
new file mode 100644
index 0000000..44fc278
--- /dev/null
+++ b/collects/macro-debugger/view/stepper.ss
@@ -0,0 +1,669 @@
+
+(module stepper mzscheme
+  (require (lib "class.ss")
+           (lib "unit.ss")
+           (lib "list.ss")
+           (lib "plt-match.ss")
+           (lib "mred.ss" "mred")
+           (lib "framework.ss" "framework")
+           (lib "boundmap.ss" "syntax")
+           "interfaces.ss"
+           "prefs.ss"
+           "extensions.ss"
+           "warning.ss"
+           "hiding-panel.ss"
+           (prefix s: "../syntax-browser/widget.ss")
+           (prefix s: "../syntax-browser/params.ss")
+           "../model/deriv.ss"
+           "../model/deriv-util.ss"
+           "../model/trace.ss"
+           "../model/hide.ss"
+           "../model/steps.ss"
+           "cursor.ss"
+           "util.ss")
+  (provide macro-stepper-widget%)
+
+  ;; Struct for one-by-one stepping
+
+  (define-struct (prestep protostep) (foci1 e1))
+  (define-struct (poststep protostep) (foci2 e2))
+
+  (define (prestep-term1 s) (context-fill (protostep-ctx s) (prestep-e1 s)))
+  (define (poststep-term2 s) (context-fill (protostep-ctx s) (poststep-e2 s)))
+
+  ;; TermRecords
+
+  (define-struct trec (deriv synth-deriv estx raw-steps steps definites) #f)
+
+  (define (new-trec deriv)
+    (make-trec deriv #f #f #f #f #f))
+
+  ;; trec:invalidate-synth! : TermRecord -> void
+  ;; Invalidates cached parts that depend on macro-hiding policy
+  (define (trec:invalidate-synth! trec)
+    (set-trec-synth-deriv! trec #f)
+    (set-trec-estx! trec #f)
+    (set-trec-raw-steps! trec #f)
+    (set-trec-definites! trec #f)
+    (trec:invalidate-steps! trec))
+
+  ;; trec:invalidate-steps! : TermRecord -> void
+  ;; Invalidates cached parts that depend on reductions config
+  (define (trec:invalidate-steps! trec)
+    (set-trec-steps! trec #f))
+
+
+  ;; Macro Stepper
+
+  ;; macro-stepper-widget%
+  (define macro-stepper-widget%
+    (class* object% ()
+      (init-field parent)
+      (init-field config)
+
+      ;; Terms
+
+      ;; terms : (Cursor-of TermRecord)
+      (define terms (cursor:new null))
+
+      ;; focused-term : -> TermRecord or #f
+      (define (focused-term)
+        (let ([term (cursor:next terms)])
+          (when term (recache term))
+          term))
+
+      ;; focused-steps : -> (Cursor-of Step) or #f
+      (define/private (focused-steps)
+        (let ([term (focused-term)])
+          (and term 
+               (cursor? (trec-steps term))
+               (trec-steps term))))
+
+      ;; alpha-table : module-identifier-mapping[identifier => identifier]
+      (define alpha-table (make-module-identifier-mapping))
+
+      ;; saved-position : number/#f
+      (define saved-position #f)
+
+      ;; add-deriv : Derivation -> void
+      (define/public (add-deriv d)
+        (let ([needs-display? (cursor:at-end? terms)])
+          (for-each (lambda (id) (module-identifier-mapping-put! alpha-table id id))
+                    (extract-all-fresh-names d))
+          (cursor:add-to-end! terms (list (new-trec d)))
+          (trim-navigator)
+          (if needs-display?
+              (refresh/move)
+              (update))))
+
+      ;; remove-current-term : -> void
+      (define/public (remove-current-term)
+        (cursor:remove-current! terms)
+        (trim-navigator)
+        (refresh/move))
+
+      (define/public (get-config) config)
+      (define/public (get-controller) sbc)
+      (define/public (get-view) sbview)
+      (define/public (get-macro-hiding-prefs) macro-hiding-prefs)
+
+      (define/public (reset-primary-partition)
+        (send sbc reset-primary-partition)
+        (update/preserve-view))
+
+      (define area (new vertical-panel% (parent parent)))
+      (define supernavigator
+        (new horizontal-panel%
+             (parent area)
+             (stretchable-height #f)
+             (alignment '(center center))))
+      (define navigator
+        (new horizontal-panel%
+             (parent supernavigator)
+             (stretchable-width #f)
+             (stretchable-height #f)
+             (alignment '(left center))))
+      (define extra-navigator
+        (new horizontal-panel%
+             (parent supernavigator)
+             (stretchable-width #f)
+             (stretchable-height #f)
+             (alignment '(left center))
+             (style '(deleted))))
+
+      (define sbview (new stepper-syntax-widget% 
+                          (parent area)
+                          (macro-stepper this)))
+      (define sbc (send sbview get-controller))
+      (define control-pane
+        (new vertical-panel% (parent area) (stretchable-height #f)))
+      (define macro-hiding-prefs
+        (new macro-hiding-prefs-widget%
+             (parent control-pane)
+             (stepper this)
+             (config config)))
+
+      (define warnings-frame #f)
+
+      (send config listen-show-syntax-properties?
+            (lambda (show?) (send sbview show-props show?)))
+      (send config listen-show-hiding-panel?
+            (lambda (show?) (show-macro-hiding-prefs show?)))
+      (send sbc listen-selected-syntax
+            (lambda (stx) (send macro-hiding-prefs set-syntax stx)))
+      (send config listen-highlight-foci?
+            (lambda (_) (update/preserve-view)))
+      (send config listen-highlight-frontier?
+            (lambda (_) (update/preserve-view)))
+      (send config listen-show-rename-steps?
+            (lambda (_) (refresh/re-reduce)))
+      (send config listen-one-by-one?
+            (lambda (_) (refresh/re-reduce)))
+      (send config listen-force-letrec-transformation?
+            (lambda (_) (refresh/resynth)))
+      (send config listen-extra-navigation?
+            (lambda (show?) (show-extra-navigation show?)))
+
+      (define nav:up
+        (new button% (label "Previous term") (parent navigator)
+             (callback (lambda (b e) (navigate-up)))))
+      (define nav:start
+        (new button% (label "<-- Start") (parent navigator)
+             (callback (lambda (b e) (navigate-to-start)))))
+      (define nav:previous
+        (new button% (label "<- Step") (parent navigator)
+             (callback (lambda (b e) (navigate-previous)))))
+      (define nav:next
+        (new button% (label "Step ->") (parent navigator)
+             (callback (lambda (b e) (navigate-next)))))
+      (define nav:end
+        (new button% (label "End -->") (parent navigator)
+             (callback (lambda (b e) (navigate-to-end)))))
+      (define nav:down
+        (new button% (label "Next term") (parent navigator)
+             (callback (lambda (b e) (navigate-down)))))
+
+      (define/private (trim-navigator)
+        (if (> (length (cursor->list terms)) 1)
+            (send navigator change-children
+                  (lambda _
+                    (list nav:up
+                          nav:start
+                          nav:previous
+                          nav:next
+                          nav:end
+                          nav:down)))
+            (send navigator change-children
+                  (lambda _
+                    (list nav:start
+                          nav:previous
+                          nav:next
+                          nav:end)))))
+
+      (define/public (show-macro-hiding-prefs show?)
+        (send area change-children
+              (lambda (children)
+                (if show?
+                    (append (remq control-pane children) (list control-pane))
+                    (remq control-pane children)))))
+
+      (define/private (show-extra-navigation show?)
+        (send supernavigator change-children
+              (lambda (children)
+                (if show?
+                    (list navigator extra-navigator)
+                    (list navigator)))))
+
+      ;; Navigate
+
+      (define/private (navigate-to-start)
+        (cursor:move-to-start (focused-steps))
+        (update/save-position))
+      (define/private (navigate-to-end)
+        (cursor:move-to-end (focused-steps))
+        (update/save-position))
+      (define/private (navigate-previous)
+        (cursor:move-prev (focused-steps))
+        (update/save-position))
+      (define/private (navigate-next)
+        (cursor:move-next (focused-steps))
+        (update/save-position))
+
+      (define/private (navigate-up)
+        (cursor:move-prev terms)
+        (refresh/move))
+      (define/private (navigate-down)
+        (cursor:move-next terms)
+        (refresh/move))
+
+      ;; insert-step-separator : string -> void
+      (define/private (insert-step-separator text)
+        (send sbview add-text "\n    ")
+        (send sbview add-text
+              (make-object image-snip% 
+                           (build-path (collection-path "icons")
+                                       "red-arrow.bmp")))
+        (send sbview add-text "  ")
+        (send sbview add-text text)
+        (send sbview add-text "\n\n"))
+
+      ;; insert-as-separator : string -> void
+      (define/private (insert-as-separator text)
+        (send sbview add-text "\n    ")
+        (send sbview add-text text)
+        (send sbview add-text "\n\n"))
+
+      ;; insert-step-separator/small : string -> void
+      (define/private (insert-step-separator/small text)
+        (send sbview add-text "    ")
+        (send sbview add-text
+              (make-object image-snip% 
+                           (build-path (collection-path "icons")
+                                       "red-arrow.bmp")))
+        (send sbview add-text "  ")
+        (send sbview add-text text)
+        (send sbview add-text "\n\n"))
+
+      ;; update/preserve-view : -> void
+      (define/public (update/preserve-view)
+        (define text (send sbview get-text))
+        (define start-box (box 0))
+        (define end-box (box 0))
+        (send text get-visible-position-range start-box end-box)
+        (update)
+        (send text scroll-to-position (unbox start-box) #f (unbox end-box)))
+      
+      ;; update:show-prefix : -> void
+      (define/private (update:show-prefix)
+        ;; Show the final terms from the cached synth'd derivs
+        (for-each (lambda (trec)
+                    (recache trec)
+                    (let ([e2 (trec-estx trec)]
+                          [definites
+                            (if (pair? (trec-definites trec))
+                                (trec-definites trec)
+                                null)])
+                      (if e2
+                          (send sbview add-syntax e2
+                                #:alpha-table alpha-table
+                                #:definites definites)
+                          (send sbview add-text "Error\n"))))
+                  (cursor:prefix->list terms)))
+
+      ;; update:show-current-step : -> void
+      (define/private (update:show-current-step)
+        (define steps (focused-steps))
+        (when (focused-term)
+          (when steps
+            (let ([step (cursor:next steps)])
+              (cond [(step? step)
+                     (update:show-step step)]
+                    [(mono? step)
+                     (update:show-mono step)]
+                    [(misstep? step)
+                     (update:show-misstep step)]
+                    [(prestep? step)
+                     (update:show-prestep step)]
+                    [(poststep? step)
+                     (update:show-poststep step)]
+                    [(not step)
+                     (update:show-final (focused-term))])))
+          (unless steps
+            (send sbview add-text
+                  "Internal error computing reductions. Original term:\n")
+            (send sbview add-syntax
+                  (lift/deriv-e1 (trec-deriv (focused-term)))))))
+
+      ;; update:show-lctx : Step -> void
+      (define/private (update:show-lctx step)
+        (define lctx (protostep-lctx step))
+        (when (pair? lctx)
+          (send sbview add-text "\n")
+          (for-each (lambda (bf)
+                      (send sbview add-text 
+                            "while executing macro transformer in:\n")
+                      (insert-syntax/redex (bigframe-term bf)
+                                           (bigframe-foci bf)
+                                           (protostep-definites step)
+                                           (protostep-frontier step)))
+                    (reverse lctx))))
+
+      ;; update:separator : Step -> void
+      (define/private (update:separator step)
+        (if (not (mono? step))
+            (insert-step-separator (step-type->string (protostep-type step)))
+            (insert-as-separator (step-type->string (protostep-type step)))))
+
+      ;; update:separator/small : Step -> void
+      (define/private (update:separator/small step)
+        (insert-step-separator/small
+         (step-type->string (protostep-type step))))
+      
+      ;; update:show-step : Step -> void
+      (define/private (update:show-step step)
+        (insert-syntax/redex (step-term1 step)
+                             (step-foci1 step)
+                             (protostep-definites step)
+                             (protostep-frontier step))
+        (update:separator step)
+        (insert-syntax/contractum (step-term2 step)
+                                  (step-foci2 step)
+                                  (protostep-definites step)
+                                  (protostep-frontier step))
+        (update:show-lctx step))
+
+      ;; update:show-mono : Step -> void
+      (define/private (update:show-mono step)
+        (update:separator step)
+        (insert-syntax/redex (mono-term1 step)
+                             null
+                             (protostep-definites step)
+                             (protostep-frontier step))
+        (update:show-lctx step))
+
+      ;; update:show-prestep : Step -> void
+      (define/private (update:show-prestep step)
+        (update:separator/small step)
+        (insert-syntax/redex (prestep-term1 step)
+                             (prestep-foci1 step)
+                             (protostep-definites step)
+                             (protostep-frontier step))
+        (update:show-lctx step))
+
+      ;; update:show-poststep : Step -> void
+      (define/private (update:show-poststep step)
+        (update:separator/small step)
+        (insert-syntax/contractum (poststep-term2 step)
+                                  (poststep-foci2 step)
+                                  (protostep-definites step)
+                                  (protostep-frontier step))
+        (update:show-lctx step))
+
+      ;; update:show-misstep : Step -> void
+      (define/private (update:show-misstep step)
+        (insert-syntax/redex (misstep-term1 step)
+                             (misstep-foci1 step)
+                             (protostep-definites step)
+                             (protostep-frontier step))
+        (update:separator step)
+        (send sbview add-text (exn-message (misstep-exn step)))
+        (send sbview add-text "\n")
+        (when (exn:fail:syntax? (misstep-exn step))
+          (for-each (lambda (e) (send sbview add-syntax e
+                                      #:alpha-table alpha-table
+                                      #:definites (protostep-definites step)))
+                    (exn:fail:syntax-exprs (misstep-exn step))))
+        (update:show-lctx step))
+
+      ;; update:show-final : TermRecord -> void
+      (define/private (update:show-final trec)
+        (define result (trec-estx trec))
+        (when result
+          (send sbview add-text "Expansion finished\n")
+          (send sbview add-syntax result
+                #:alpha-table alpha-table
+                #:definites (let ([definites (trec-definites trec)])
+                              (if (pair? definites) definites null))))
+        (unless result
+          (send sbview add-text "Error\n")))
+
+      ;; update:show-suffix : -> void
+      (define/private (update:show-suffix)
+        (let ([suffix0 (cursor:suffix->list terms)])
+          (when (pair? suffix0)
+            (for-each (lambda (trec)
+                        (send sbview add-syntax
+                              (lift/deriv-e1 (trec-deriv trec))
+                              #:alpha-table alpha-table))
+                      (cdr suffix0)))))
+
+      ;; update/save-position : -> void
+      (define/private (update/save-position)
+        (save-position)
+        (update))
+
+      ;; update : -> void
+      ;; Updates the terms in the syntax browser to the current step
+      (define/private (update)
+        (define text (send sbview get-text))
+        (define position-of-interest 0)
+        (define multiple-terms? (> (length (cursor->list terms)) 1))
+        (send text begin-edit-sequence)
+        (send sbview erase-all)
+
+        (update:show-prefix)
+        (when multiple-terms? (send sbview add-separator))
+        (set! position-of-interest (send text last-position))
+        (update:show-current-step)
+        (when multiple-terms? (send sbview add-separator))
+        (update:show-suffix)
+        (send text end-edit-sequence)
+        (send text scroll-to-position
+              position-of-interest
+              #f
+              (send text last-position)
+              'start)
+        (enable/disable-buttons))
+
+      ;; insert-syntax/color : syntax syntaxes identifiers syntaxes string -> void
+      (define/private (insert-syntax/color stx foci definites frontier hi-color)
+        (send sbview add-syntax stx
+              #:definites definites
+              #:alpha-table alpha-table
+              #:hi-color hi-color
+              #:hi-stxs (if (send config get-highlight-foci?) foci null)
+              #:hi2-color "WhiteSmoke"
+              #:hi2-stxs (if (send config get-highlight-frontier?) frontier null)))
+
+      ;; insert-syntax/redex : syntax syntaxes identifiers syntaxes -> void
+      (define/private (insert-syntax/redex stx foci definites frontier)
+        (insert-syntax/color stx foci definites frontier "MistyRose"))
+
+      ;; insert-syntax/contractum : syntax syntaxes identifiers syntaxes -> void
+      (define/private (insert-syntax/contractum stx foci definites frontier)
+        (insert-syntax/color stx foci definites frontier "LightCyan"))
+
+      ;; enable/disable-buttons : -> void
+      (define/private (enable/disable-buttons)
+        (define steps (focused-steps))
+        (send nav:start enable (and steps (cursor:has-prev? steps)))
+        (send nav:previous enable (and steps (cursor:has-prev? steps)))
+        (send nav:next enable (and steps (cursor:has-next? steps)))
+        (send nav:end enable (and steps (cursor:has-next? steps)))
+        (send nav:up enable (cursor:has-prev? terms))
+        (send nav:down enable (cursor:has-next? terms)))
+
+      ;; --
+
+      ;; refresh/resynth : -> void
+      ;; Macro hiding policy has changed; invalidate cached parts of trec
+      (define/public (refresh/resynth)
+        (for-each trec:invalidate-synth! (cursor->list terms))
+        (refresh))
+
+      ;; refresh/re-reduce : -> void
+      ;; Reduction config has changed; invalidate cached parts of trec
+      (define/private (refresh/re-reduce)
+        (for-each trec:invalidate-steps! (cursor->list terms))
+        (refresh))
+
+      ;; refresh/move : -> void
+      ;; Moving between terms; clear the saved position
+      (define/private (refresh/move)
+        (clear-saved-position)
+        (refresh))
+
+      ;; refresh : -> void
+      (define/public (refresh)
+        (restore-position)
+        (update))
+
+      ;; recache : TermRecord -> void
+      (define/private (recache trec)
+        (unless (trec-synth-deriv trec)
+          (with-handlers ([(lambda (e) #t)
+                           (lambda (e)
+                             (handle-recache-error e 'macro-hiding)
+                             (set-trec-synth-deriv! trec 'error)
+                             (set-trec-estx! trec (lift/deriv-e2 (trec-deriv trec))))])
+            (let-values ([(synth-deriv estx) (synthesize (trec-deriv trec))])
+              (set-trec-synth-deriv! trec synth-deriv)
+              (set-trec-estx! trec estx))))
+        (unless (trec-raw-steps trec)
+          (with-handlers ([(lambda (e) #t)
+                           (lambda (e)
+                             (handle-recache-error e 'reductions)
+                             (set-trec-raw-steps! trec 'error)
+                             (set-trec-definites! trec 'error))])
+            (let-values ([(steps definites)
+                          (reductions+definites
+                           (or (trec-synth-deriv trec) (trec-deriv trec)))])
+              (set-trec-raw-steps! trec steps)
+              (set-trec-definites! trec definites))))
+        (unless (trec-steps trec)
+          (with-handlers ([(lambda (e) #t)
+                           (lambda (e)
+                             (handle-recache-error e 'special-reductions)
+                             (set-trec-steps! trec 'error))])
+            (set-trec-steps!
+             trec
+             (let ([raw-steps (trec-raw-steps trec)])
+               (if (eq? raw-steps 'error)
+                   'error
+                   (let ([filtered-steps 
+                          (if (send config get-show-rename-steps?)
+                              raw-steps
+                              (filter (lambda (x) (not (rename-step? x))) raw-steps))])
+                     (cursor:new
+                      (if (send config get-one-by-one?)
+                          (reduce:one-by-one filtered-steps)
+                          filtered-steps)))))))))
+
+      ;; delayed-recache-errors : (list-of (cons exn string))
+      (define delayed-recache-errors null)
+
+      ;; handle-recache-error : exception string -> void
+      (define/private (handle-recache-error exn part)
+        (if (send config get-debug-catch-errors?)
+            (begin
+              (set! delayed-recache-errors 
+                    (cons (cons exn part) delayed-recache-errors))
+              (queue-callback
+               (lambda ()
+                 (when (pair? delayed-recache-errors)
+                   (message-box
+                    "Error"
+                    (string-append 
+                     "Internal errors in macro stepper:\n"
+                     (if (memq 'macro-hiding (map cdr delayed-recache-errors))
+                         (string-append 
+                          "Macro hiding failed on one or more terms. "
+                          "The macro stepper is showing the terms "
+                          "with macro hiding disabled.\n")
+                         "")
+                     (if (memq 'reductions (map cdr delayed-recache-errors))
+                         (string-append
+                          "The macro stepper failed to compute the reduction sequence "
+                          "for one or more terms.\n")
+                         "")))
+                   (set! delayed-recache-errors null)))))
+            (raise exn)))
+
+      ;; update-saved-position : num -> void
+      (define/private (update-saved-position pos)
+        (when pos (set! saved-position pos)))
+
+      ;; clear-saved-position : -> void
+      (define/private (clear-saved-position)
+        (set! saved-position #f))
+
+      ;; save-position : -> void
+      (define/private (save-position)
+        (when (cursor? (focused-steps))
+          (let ([step (cursor:next (focused-steps))])
+            (cond [(not step)
+                   ;; At end; go to the end when restored
+                   (update-saved-position +inf.0)]
+                  [(protostep? step)
+                   (update-saved-position
+                    (extract-protostep-seq step))]))))
+
+      ;; restore-position : number -> void
+      (define/private (restore-position)
+        (define steps (focused-steps))
+        (define (advance)
+          (let ([step (cursor:next steps)])
+            (cond [(not step)
+                   ;; At end; stop
+                   (void)]
+                  [(protostep? step)
+                   (let ([step-pos (extract-protostep-seq step)])
+                     (cond [(not step-pos)
+                            (cursor:move-next steps)
+                            (advance)]
+                           [(< step-pos saved-position)
+                            (cursor:move-next steps)
+                            (advance)]
+                           [else (void)]))])))
+        (when saved-position
+          (when steps
+            (advance))))
+
+      (define/private (extract-protostep-seq step)
+        (match (protostep-deriv step)
+          [(AnyQ mrule (_ _ (AnyQ transformation (_ _ _ _ _ _ seq)) _))
+           seq]
+          [else #f]))
+
+      ;; synthesize : Derivation -> Derivation Syntax
+      (define/private (synthesize deriv)
+        (let ([show-macro? (get-show-macro?)])
+          (if show-macro?
+              (parameterize ((current-hiding-warning-handler
+                              (lambda (tag message)
+                                (unless (send config get-suppress-warnings?)
+                                  (unless warnings-frame
+                                    (set! warnings-frame (new warnings-frame%)))
+                                  (send warnings-frame add-warning tag message)
+                                  (send warnings-frame show #t))))
+                             (force-letrec-transformation
+                              (send config get-force-letrec-transformation?)))
+                (hide/policy deriv show-macro?))
+              (values deriv (lift/deriv-e2 deriv)))))
+
+      (define/private (reduce:one-by-one rs)
+        (let loop ([rs rs])
+          (match rs
+            [(cons (struct step (d l t c df fr redex contractum e1 e2)) rs)
+             (list* (make-prestep d l "Find redex" c df fr redex e1)
+                    (make-poststep d l t c df fr contractum e2)
+                    (loop rs))]
+            [(cons (struct misstep (d l t c df fr redex e1 exn)) rs)
+             (list* (make-prestep d l "Find redex" c df fr redex e1)
+                    (make-misstep d l t c df fr redex e1 exn)
+                    (loop rs))]
+            ['()
+             null])))
+
+      (define/private (foci x) (if (list? x) x (list x)))
+
+      ;; Hiding policy
+
+      (define/private (get-show-macro?)
+        (send macro-hiding-prefs get-policy))
+
+      ;; --
+
+      (define/public (shutdown)
+        (when warnings-frame (send warnings-frame show #f)))
+
+      ;; Initialization
+      
+      (super-new)
+      (send sbview show-props (send config get-show-syntax-properties?))
+      (show-macro-hiding-prefs (send config get-show-hiding-panel?))
+      (show-extra-navigation (send config get-extra-navigation?))
+      (refresh/move)
+      ))
+
+  )
diff --git a/collects/macro-debugger/view/view.ss b/collects/macro-debugger/view/view.ss
index e45a4c8..d0ea4f2 100644
--- a/collects/macro-debugger/view/view.ss
+++ b/collects/macro-debugger/view/view.ss
@@ -1,26 +1,35 @@
 
 (module view mzscheme
-  (require (lib "unit.ss")
+  (require (lib "class.ss")
            (lib "mred.ss" "mred")
            (lib "framework.ss" "framework")
            "interfaces.ss"
-           "gui.ss")
+           "frame.ss"
+           "prefs.ss"
+           "../model/trace.ss")
   (provide (all-defined))
 
-  (define view-base@
-    (unit
-      (import)
-      (export view-base^)
+  (define macro-stepper-frame%
+    (macro-stepper-frame-mixin
+     (frame:standard-menus-mixin
+      (frame:basic-mixin frame%))))
+  
+  ;; Main entry points
+  
+  (define (make-macro-stepper)
+    (let ([f (new macro-stepper-frame%
+                  (config (new macro-stepper-config/prefs%)))])
+      (send f show #t)
+      (send f get-widget)))
 
-      (define base-frame%
-        (frame:standard-menus-mixin (frame:basic-mixin frame%)))))
-
-  (define-values/invoke-unit
-    (compound-unit
-      (import)
-      (link [((BASE : view-base^)) view-base@]
-            [((STEPPER : view^)) pre-stepper@ BASE])
-      (export STEPPER))
-    (import)
-    (export view^))
+  (define (go stx)
+    (let ([stepper (make-macro-stepper)])
+      (send stepper add-deriv (trace stx))))
+  
+  (define (go/deriv deriv)
+    (let* ([f (new macro-stepper-frame%)]
+           [w (send f get-widget)])
+      (send w add-deriv deriv)
+      (send f show #t)
+      w))
   )