diff --git a/collects/macro-debugger/analysis/check-requires.rkt b/collects/macro-debugger/analysis/check-requires.rkt
new file mode 100644
index 0000000..632f85f
--- /dev/null
+++ b/collects/macro-debugger/analysis/check-requires.rkt
@@ -0,0 +1,340 @@
+#lang racket/base
+(require racket/contract
+         racket/match
+         racket/dict
+         unstable/struct
+         syntax/modresolve
+         syntax/stx
+         syntax/id-table
+         macro-debugger/model/deriv
+         "private/reftable.rkt"
+         "private/nom-use-alg.rkt"
+         "private/util.rkt")
+(provide/contract
+ [check-requires (-> module-path? list?)]
+ [add-disappeared-uses? (parameter/c boolean?)]
+ [mpi->key (-> module-path-index? any/c)])
+
+#|
+
+The purpose of this script is to estimate a module's useless requires.
+
+Usage:
+
+  (check-requires <module-name>)
+
+Examples:
+
+  (check-requires 'typed-scheme)
+  (check-requires 'unstable/markparam)
+  (check-requires 'macro-debugger/syntax-browser/widget)
+
+The procedure prints one line per (non-label) require in the following
+format:
+
+  KEEP <module> at <phase> <optional-comment>
+    - The require must be kept because bindings defined within it are used.
+    - The optional comment indicates if the require must be kept
+      - only because its bindings are re-exported
+      - only because the whitelist DB says so
+
+  BYPASS <module> at <phase>
+    - The require is used, but only for bindings that could be more directly
+      obtained via another module. For example, 'racket' can be bypassed in favor
+      of some subset of 'racket/base', 'racket/contract', etc.
+
+  DROP <module> at <phase>
+    - The require appears to be unused. Unless it must be kept for side
+      effects or for bindings of a very unusual macro, it can be dropped
+      entirely.
+
+Notes:
+
+  BYPASS recommendations should often be disregarded, because the
+  required module is expressly intended as an aggregation module and the
+  only way to bypass it would be to require private modules
+  directly. See TODO for plans to improve BYPASS recommendations.
+
+  Ignore recommendations to DROP or BYPASS modules with side
+  effects. Read the section below (How it works) and also see the docs
+  for 'module-db' for whitelisting side-effectful modules.
+
+  The script is not intelligent about the language, which causes
+  certain spurious recommendations to appear frequently. For example,
+
+    DROP scheme/mzscheme at 1
+
+  means that the module's language is mzscheme, which automatically
+  inserts (require-for-syntax scheme/mzscheme). It's infeasible to
+  remove it except by rewriting the module in scheme/base or
+  racket/base.
+
+========
+
+How it works
+
+Determining whether a require is actually useless is impossible: a
+module may be required for compile-time side effect only, and there's
+no way to monitor that.
+
+Here are some approximations that are feasible to calculate:
+
+NOM-USES = A require R is "used" by a module M if, during the
+compilation of M, a reference is resolved to a binding exported by R.
+
+DEF-USES = A require R is "used" by a module M if, during the
+compilation of M, a reference is resolved to a binding defined in R.
+
+The limitations:
+ - misses side-effects
+ - misses identifiers recognized via 'free-identifier=?'
+   (But those should be recorded as 'disappeared-use anyway.)
+
+|#
+
+;; ========
+
+(define add-disappeared-uses? (make-parameter #t))
+
+;; ========
+
+;; phase : (parameterof nat)
+(define phase (make-parameter 0))
+
+;; ========
+
+;; analyze : *Deriv* RefTable -> void
+;; *Deriv* = Deriv | LDeriv | BRule | ModRule | ... (anything from deriv.rkt)
+(define (analyze deriv refs)
+  (define (recur . args)
+    (let check ([arg args])
+      (cond [(syntax? arg) (error 'whoops "arg = ~s" arg)]
+            [(list? arg) (for-each check arg)]
+            [else (void)]))
+    (for ([arg (in-list args)])
+      (if (list? arg)
+          (apply recur arg)
+          (analyze arg refs))))
+  (define (add! ids)
+    (reftable-add-all! refs (phase) ids))
+
+  ;; (printf "analyze ~.s\n" deriv)
+
+  ;; Handle common base (ie, resolves) part of derivs, if applicable
+  (match deriv
+    [(base z1 z2 resolves ?1)
+     (add! resolves)
+     (when (and (syntax? z2) (add-disappeared-uses?))
+       (let ([uses (syntax-property z2 'disappeared-use)])
+         (add! (let loop ([x uses] [onto null])
+                 (cond [(identifier? x) (cons x onto)]
+                       [(pair? x) (loop (car x) (loop (cdr x) onto))]
+                       [else onto])))))]
+    [_
+     (void)])
+  ;; Handle individual variants
+  (match deriv
+    [(lift-deriv z1 z2 first lift-stx second)
+     (recur first second)]
+    [(tagrule z1 z2 tagged-stx next)
+     (recur next)]
+    [(lift/let-deriv z1 z2 first lift-stx second)
+     (recur first second)]
+
+    [(mrule z1 z2 rs ?1 me1 locals me2 ?2 etx next)
+     (recur locals next)]
+    [(local-exn exn)
+     (void)]
+    [(local-expansion z1 z2 for-stx? me1 inner lifted me2 opaque)
+     (parameterize ((phase (+ (phase) (if for-stx? 1 0))))
+       (recur inner))]
+    [(local-lift expr ids)
+     (void)]
+    [(local-lift-end decl)
+     (void)]
+    [(local-lift-require req expr mexpr)
+     (void)]
+    [(local-lift-provide prov)
+     (void)]
+    [(local-bind names ?1 renames bindrhs)
+     (recur bindrhs)]
+    [(local-value name ?1 resolves bound?)
+     (when (and bound? resolves)
+       (add! (cons name resolves)))]
+    [(track-origin before after)
+     (void)]
+    [(local-remark contents)
+     (void)]
+
+    [(p:variable z1 z2 rs ?1)
+     (void)]
+    [(p:module z1 z2 rs ?1 locals tag rename check tag2 ?3 body shift)
+     (recur locals check body)]
+    [(p:#%module-begin z1 z2 rs ?1 me pass1 pass2 ?2)
+     (recur pass1 pass2)]
+    [(p:define-syntaxes z1 z2 rs ?1 rhs locals)
+     (parameterize ((phase (+ (phase) 1)))
+       (recur rhs locals))]
+    [(p:define-values z1 z2 rs ?1 rhs)
+     (recur rhs)]
+
+    [(p:#%expression z1 z2 rs ?1 inner untag)
+     (recur inner)]
+    [(p:if z1 z2 rs ?1 test then else)
+     (recur test then else)]
+    [(p:wcm z1 z2 rs ?1 key mark body)
+     (recur key mark body)]
+    [(p:set! _ _ _ _ id-resolves ?2 rhs)
+     (add! id-resolves)
+     (recur rhs)]
+    [(p:set!-macro _ _ _ _ deriv)
+     (recur deriv)]
+    [(p:#%app _ _ _ _ lderiv)
+     (recur lderiv)]
+    [(p:begin _ _ _ _ lderiv)
+     (recur lderiv)]
+    [(p:begin0 _ _ _ _ first lderiv)
+     (recur first lderiv)]
+
+    [(p:lambda _ _ _ _ renames body)
+     (recur body)]
+    [(p:case-lambda _ _ _ _ renames+bodies)
+     (recur renames+bodies)]
+    [(p:let-values _ _ _ _ renames rhss body)
+     (recur rhss body)]
+    [(p:letrec-values _ _ _ _ renames rhss body)
+     (recur rhss body)]
+    [(p:letrec-syntaxes+values _ _ _ _ srenames sbindrhss vrenames vrhss body tag)
+     (recur sbindrhss vrhss body)]
+
+    [(p:provide _ _ _ _ inners ?2)
+     (recur inners)]
+
+    [(p:require _ _ _ _ locals)
+     (recur locals)]
+
+    [(p:#%stratified-body _ _ _ _ bderiv)
+     (recur bderiv)]
+
+    [(p:stop _ _ _ _) (void)]
+    [(p:unknown _ _ _ _) (void)]
+    [(p:#%top _ _ _ _)
+     (void)]
+    [(p:#%datum _ _ _ _) (void)]
+    [(p:quote _ _ _ _) (void)]
+    [(p:quote-syntax z1 z2 _ _)
+     (when z2 (analyze/quote-syntax z2 refs))]
+    [(p:#%variable-reference _ _ _ _)
+     ;; FIXME
+     (void)]
+
+    [(lderiv _ _ ?1 derivs)
+     (recur derivs)]
+
+    [(bderiv _ _ pass1 trans pass2)
+     (recur pass1 pass2)]
+
+    [(b:error ?1)
+     (void)]
+    [(b:expr _ head)
+     (recur head)]
+    [(b:splice _ head ?1 tail ?2)
+     (recur head)]
+    [(b:defvals _ head ?1 rename ?2)
+     (recur head)]
+    [(b:defstx _ head ?1 rename ?2 bindrhs)
+     (recur head bindrhs)]
+
+    [(bind-syntaxes rhs locals)
+     (parameterize ((phase (+ 1 (phase))))
+       (recur rhs locals))]
+
+    [(clc ?1 renames body)
+     (recur body)]
+
+    [(mod:prim head rename prim)
+     (recur head prim)]
+    [(mod:splice head rename ?1 tail)
+     (recur head)]
+    [(mod:lift head renames tail)
+     (recur head)]
+    [(mod:lift-end tail)
+     (void)]
+    [(mod:cons head)
+     (recur head)]
+    [(mod:skip)
+     (void)]
+
+    [(ecte _ _ locals first second locals2)
+     (recur locals first second locals2)]
+
+    [#f
+     (void)]))
+
+;; analyze/quote-syntax : stx RefTable -> void
+;; Current approach: estimate that an identifier in a syntax template
+;; may be used at (sub1 (phase)) or (phase).
+;; FIXME: Allow for more conservative choices, too.
+;; FIXME: #%top, #%app, #%datum, etc?
+;; FIXME: Track tentative (in quote-syntax) references separately?
+(define (analyze/quote-syntax qs-stx refs)
+  (let ([phases (list (phase) (sub1 (phase)))]
+        [stx (syntax-case qs-stx ()
+               [(_quote-syntax x) #'x])])
+    (define (add! id)
+      (for ([phase (in-list phases)])
+        (reftable-add! refs phase id)))
+    (let loop ([stx stx])
+      (let ([d (if (syntax? stx) (syntax-e stx) stx)])
+        (cond [(identifier? stx) (add! stx)]
+              [(pair? d)
+               (loop (car d))
+               (loop (cdr d))]
+              [(vector? d)
+               (map loop (vector->list d))]
+              [(prefab-struct-key d)
+               (map loop (struct->list d))]
+              [(box? d)
+               (loop (unbox d))]
+              [else
+               (void)])))))
+
+;; ========
+
+#|
+A recommendation is one of
+  (list 'keep   module-path-index phase string/#f)
+  (list 'bypass module-path-index phase)
+  (list 'drop   module-path-index phase)
+|#
+
+;; check-requires : module-path -> (listof recommendation)
+(define (check-requires mod-path)
+  (let-values ([(compiled deriv) (get-module-code/trace mod-path)])
+    (let ([refs (new-reftable)])
+      (analyze deriv refs)
+      (nom-use-alg refs compiled))))
+
+#|
+TODO
+====
+
+Elaborate on BYPASS recommendations by finding the necessary modules
+further up the require chain to require directly.
+  - don't recommend private modules, though... heuristic
+
+Let user provide database of modules that should never be dropped, eg
+because they have side effects.
+  - wouldn't it be awesome if this db could be a datalog program?
+  - start simpler, though
+
+Verbose mode should show identifiers used by a module (for KEEP).
+For example, if only one used, good candidate to split out, if possible.
+
+Ambitious mode could analyze module and recommend ways to split module
+into independent submodules.
+
+More options for quote-syntax handling & explain current heuristic better.
+
+Handle for-label.
+|#
diff --git a/collects/macro-debugger/analysis/private/moduledb.rkt b/collects/macro-debugger/analysis/private/moduledb.rkt
new file mode 100644
index 0000000..6ce302e
--- /dev/null
+++ b/collects/macro-debugger/analysis/private/moduledb.rkt
@@ -0,0 +1,27 @@
+#lang racket/base
+(require syntax/modresolve)
+(provide module-db)
+
+;; A ModuleDB = hash[path/symbol => (U 'no-drop 'no-bypass)]
+;;   'no-drop = must not be dropped or bypassed because of, eg, side effects
+;;   'no-bypass = don't bypass in favor of private component modules
+;;                but if the module is unused, can drop it
+;;                (FIXME: replace with component module calculation and checking)
+
+(define (make-module-db mod+config-list)
+  (for/hash ([mod+config (in-list mod+config-list)])
+    (values (resolve-module-path (car mod+config) #f) (cadr mod+config))))
+
+;; module-db : ModuleDB
+(define module-db
+  (make-module-db
+   '([racket/base                            no-bypass]
+     [racket/contract/base                   no-bypass]
+     [racket/gui                             no-bypass]
+     [racket/match                           no-bypass]
+     ['#%builtin                             no-drop]
+
+     [typed-scheme/private/base-env          no-drop]
+     [typed-scheme/private/base-special-env  no-drop]
+     [typed-scheme/private/base-env-numeric  no-drop]
+     [typed-scheme/private/base-env-indexing no-drop])))
diff --git a/collects/macro-debugger/analysis/private/nom-use-alg.rkt b/collects/macro-debugger/analysis/private/nom-use-alg.rkt
new file mode 100644
index 0000000..f7abaed
--- /dev/null
+++ b/collects/macro-debugger/analysis/private/nom-use-alg.rkt
@@ -0,0 +1,109 @@
+#lang racket/base
+(require racket/dict
+         racket/match
+         "reftable.rkt"
+         "moduledb.rkt"
+         "util.rkt")
+(provide nom-use-alg)
+
+;; sMPI = S-expr form of mpi (see mpi->key)
+;; Using MPIs doesn't work. I conjecture that the final module shift means that
+;; all during-expansion MPIs are different from all compiled-expr MPIs.
+
+;; A UsedTable = hash[(list int sMPI) => list]
+
+;; calculate-used-approximations : RefTable -> (values UsedTable UsedTable)
+(define (calculate-used-approximations refs)
+  (let ([NOM-USES (make-hash)]
+        [DEF-USES (make-hash)])
+    (for* ([(use-phase id-table) (in-hash refs)]
+           [id (in-dict-keys id-table)])
+      ;; Only look at identifiers written in module being examined.
+      ;; (Otherwise, nom-mod & nom-phase aren't enough info (???)
+      (when (here-mpi? (syntax-source-module id)) ;; REDUNDANT
+        (let ([b (identifier-binding id use-phase)])
+          (match b
+            [(list def-mod def-sym nom-mod nom-sym
+                   def-phase nom-imp-phase nom-exp-phase)
+             ;; use-phase = def-phase + required-phase
+             ;; thus required-phase = use-phase - def-phase
+             (let* ([required-phase (- use-phase def-phase)]
+                    [key (list required-phase (mpi->key def-mod))])
+               (hash-set! DEF-USES key
+                          (cons id (hash-ref DEF-USES key null))))
+             ;; use-phase = nom-imp-phase + nom-exp-phase ?????
+             ;; We just care about nom-imp-phase, since importing into *here*
+             #|
+             ;; FIXME: This check goes wrong on defined-for-syntax ids
+             (unless (equal? use-phase (+ nom-imp-phase nom-exp-phase))
+               (error 'calculate
+                      "internal error: phases wrong in ~s @ ~s, binding = ~s"
+                      id use-phase b))
+             |#
+             (let ([key (list nom-imp-phase (mpi->key nom-mod))])
+               (hash-set! NOM-USES key
+                          (cons id (hash-ref NOM-USES key null))))]
+            [_
+             (void)]))))
+    (values NOM-USES DEF-USES)))
+
+;; ========
+
+;; get-requires : compiled-module-expr -> (listof (list int MPI))
+(define (get-requires compiled)
+  (let ([phase+mods-list (module-compiled-imports compiled)])
+    (for*/list ([phase+mods (in-list phase+mods-list)]
+                #:when (car phase+mods) ;; Skip for-label requires
+                [mod (cdr phase+mods)])
+      (list (car phase+mods) mod))))
+
+;; add-provides! : compiled-module-expr UsedTable UsedTable -> void
+(define (add-provides! compiled NOM-USES DEF-USES)
+  (define (add! mpi phase)
+    (let ([key (list phase (mpi->key mpi))])
+      (hash-set! NOM-USES key (cons 'export (hash-ref NOM-USES key null)))
+      (hash-set! DEF-USES key (cons 'export (hash-ref DEF-USES key null)))))
+  (let-values ([(vprov sprov) (module-compiled-exports compiled)])
+    (for* ([phase+exps (in-list (append vprov sprov))]
+           #:when (car phase+exps) ;; Skip for-label provides
+           [name+srcs (in-list (cdr phase+exps))]
+           [src (in-list (cadr name+srcs))])
+      (let ([name (car name+srcs)])
+        (match src
+          [(? module-path-index?)
+           (add! src 0)]
+          [(list imp-mod imp-phase-shift imp-name imp-phase-???)
+           (add! imp-mod imp-phase-shift)])))))
+
+;; ========
+
+;; report : UseTable UseTable (listof (list int mpi)) -> (listof recommendation)
+(define (report NOM-USES DEF-USES phase+mod-list)
+  (for/list ([phase+mod (in-list phase+mod-list)])
+    (let* ([key (list (car phase+mod) (mpi->key (cadr phase+mod)))]
+           [db-config
+            (hash-ref module-db
+                      (resolved-module-path-name
+                       (module-path-index-resolve (cadr phase+mod)))
+                      #f)]
+           [nom-ids (hash-ref NOM-USES key null)]
+           [def-ids (hash-ref DEF-USES key null)]
+           [phase (car phase+mod)]
+           [mod (cadr phase+mod)]
+           [name (format "~s at ~s" (mpi->key mod) phase)])
+      (cond [(and (pair? nom-ids) (pair? def-ids))
+             (list 'keep mod phase (if (ormap identifier? nom-ids) #f "for exports"))]
+            [(pair? nom-ids)
+             (if (memq db-config '(no-bypass no-drop))
+                 (list 'keep mod phase "db says no-bypass")
+                 (list 'bypass mod phase))]
+            [else
+             (if (memq db-config '(no-drop))
+                 (list 'keep mod phase "db says no-drop")
+                 (list 'drop mod phase))]))))
+
+;; nom-use-alg : RefTable compiled -> (listof recommendation)
+(define (nom-use-alg refs compiled)
+  (let-values ([(NOM-USES DEF-USES) (calculate-used-approximations refs)])
+    (add-provides! compiled NOM-USES DEF-USES)
+    (report NOM-USES DEF-USES (get-requires compiled))))
diff --git a/collects/macro-debugger/analysis/private/refine-alg.rkt b/collects/macro-debugger/analysis/private/refine-alg.rkt
new file mode 100644
index 0000000..1aff991
--- /dev/null
+++ b/collects/macro-debugger/analysis/private/refine-alg.rkt
@@ -0,0 +1,59 @@
+#lang racket/base
+
+;; intern Def, Use?
+
+;; A Def is (def sym resolved-module-path int)
+(struct def (sym mod phase) #:prefab)
+
+;; A Use is (use Def int)
+;; the offset is (ref-phase - def-phase)
+(struct use (def offset) #:prefab)
+
+;; A resolved is path or symbol.
+
+;; An import is (import resolved int)
+(struct import (resolved offset))
+
+;; ========
+
+;; uses : hash[Use => #t]
+;; reqs : hash[import => mpi]
+;; keeps : hash[import => mpi]
+
+#|
+
+(define (refine uses reqs keeps)
+  (unless (= (hash-count uses) 0)
+    (direct-def-uses uses reqs keeps)
+    (recur-on-imports uses reqs keeps)))
+
+|#
+
+(define (hash-choose h)
+  (let ([i (hash-iterate-first h)])
+    (and i (hash-iterate-value h i))))
+
+#|
+Algorithm for refining bypass modules
+
+loop: set of references (id, phase), set of requires (mod, phase)
+  for every reference DEFINED* in a require R
+    mark that require R NEEDED and remove from set
+    eliminate every reference provided by R
+      (including re-provides)
+  now every reference left is re-provided by some remaining require
+  recur on imports of requires
+
+DEFINED* : really, defined in this module OR imported from a "private" module.
+|#
+
+
+;; ====================
+
+#|
+Another algorithm
+
+Put all requires in priority queue, with max-depth-to-kernel
+priority...
+
+|#
diff --git a/collects/macro-debugger/analysis/private/util.rkt b/collects/macro-debugger/analysis/private/util.rkt
new file mode 100644
index 0000000..a452bf3
--- /dev/null
+++ b/collects/macro-debugger/analysis/private/util.rkt
@@ -0,0 +1,73 @@
+#lang racket/base
+(require syntax/modcode
+         syntax/modresolve
+         macro-debugger/model/trace)
+
+(provide get-module-code/trace
+         here-mpi?
+         mpi->key
+         mpi->list)
+
+;; get-module-derivation : module-path -> (values compiled Deriv)
+(define (get-module-code/trace path)
+  (get-module-code (resolve-module-path path #f)
+                   #:choose (lambda _ 'src)
+                   #:compile (lambda (stx)
+                               (let-values ([(stx deriv) (trace/result stx expand)])
+                                 (values (compile stx) deriv)))))
+
+;; here-mpi? : any -> boolean
+(define (here-mpi? x)
+  (and (module-path-index? x)
+       (let-values ([(rel base) (module-path-index-split x)])
+         (and (eq? rel #f) (eq? base #f)))))
+
+(define (mpi->key x)
+  (let ([l (mpi->list x)])
+    (if (and (pair? l) (null? (cdr l)))
+        (car l)
+        l)))
+
+(define (mpi->list x)
+  (cond [(module-path-index? x)
+         (let-values ([(rel base) (module-path-index-split x)])
+           (if rel
+               (cons rel (mpi->list base))
+               null))]
+        [(eq? x #f)
+         null]
+        [else
+         (list x)]))
+
+;; --------
+
+(provide get-module-imports
+         get-module-exports
+         get-module-var-exports
+         get-module-stx-exports)
+
+(struct modinfo (imports var-exports stx-exports) #:prefab)
+
+;; cache : hash[path/symbol => modinfo]
+(define cache (make-hash))
+
+(define (get-module-info/no-cache resolved)
+  (let ([compiled (get-module-code resolved)])
+    (let-values ([(imports) (module-compiled-imports compiled)]
+                 [(var-exports stx-exports) (module-compiled-exports compiled)])
+      (modinfo imports var-exports stx-exports))))
+
+(define (get-module-info path)
+  (let ([resolved (resolve-module-path path #f)])
+    (hash-ref! cache resolved (lambda () (get-module-info/no-cache resolved)))))
+
+(define (get-module-imports path)
+  (modinfo-imports (get-module-info path)))
+(define (get-module-var-exports path)
+  (modinfo-var-exports (get-module-info path)))
+(define (get-module-stx-exports path)
+  (modinfo-stx-exports (get-module-info path)))
+(define (get-module-exports path)
+  (let ([info (get-module-info path)])
+    (values (modinfo-var-exports info) (modinfo-stx-exports info))))
+
diff --git a/collects/macro-debugger/macro-debugger.scrbl b/collects/macro-debugger/macro-debugger.scrbl
index 3192ab3..d8dc6a9 100644
--- a/collects/macro-debugger/macro-debugger.scrbl
+++ b/collects/macro-debugger/macro-debugger.scrbl
@@ -28,29 +28,24 @@ syntax browser uses colors and a properties panel to show the term's
 syntax properties, such as lexical binding information and source
 location.
 
+
 @section{Macro stepper}
 
 @defmodule[macro-debugger/stepper]
 
 @defproc[(expand/step [stx any/c])
-         (is-a/c macro-stepper<%>)]{
+         void?]{
 
-  Expands the syntax (or S-expression) and opens a macro stepper frame
-  for stepping through the expansion. 
+Expands the syntax (or S-expression) and opens a macro stepper frame
+for stepping through the expansion. 
 }
 
-@definterface[macro-stepper<%> ()]{
+@defproc[(expand-module/step [mod module-path?])
+         void?]{
 
-@defmethod[(at-start?) boolean?]
-@defmethod[(at-end?) boolean?]
-@defmethod[(navigate-to-start) void?]
-@defmethod[(navigate-to-end) void?]
-@defmethod[(navigate-previous) void?]
-@defmethod[(navigate-next) void?]
-@defmethod[(at-top?) boolean?]
-@defmethod[(at-bottom?) boolean?]
-@defmethod[(navigate-up) void?]
-@defmethod[(navigate-down) void?]
+Expands the source file named by @racket[mod], which must contains a
+single module declaration, and opens a macro stepper frame for
+stepping through the expansion.
 }
 
 @section{Macro expansion tools}
@@ -139,7 +134,6 @@ transformer returns. Unmarking is suppressed if @scheme[unmark?] is
 ]
 
 (Run the fragment above in the macro stepper.)
-
 }
 
 @defproc[(emit-local-step [before syntax?] [after syntax?]
@@ -151,9 +145,9 @@ Emits an event that simulates a local expansion step from
 
 The @scheme[id] argument acts as the step's ``macro'' for the purposes
 of macro hiding.
-
 }
 
+
 @section{Macro stepper text interface}
 
 @defmodule[macro-debugger/stepper-text]
@@ -188,6 +182,7 @@ of macro hiding.
   @scheme['all] to print out all remaining steps.
 }
 
+
 @section{Syntax browser}
 
 @defmodule[macro-debugger/syntax-browser]
@@ -208,14 +203,6 @@ of macro hiding.
   objects.
 }
 
-@;{
-@defproc[(syntax-snip [stx syntax?])
-         (is-a/c snip%)]{
-
-  Like @scheme[browse-syntax], but creates a snip that can be
-  displayed in an editor.
-}
-}
 
 @section{Using the macro stepper}
 
diff --git a/collects/macro-debugger/model/deriv-c.rkt b/collects/macro-debugger/model/deriv-c.rkt
index c155e64..89308a5 100644
--- a/collects/macro-debugger/model/deriv-c.rkt
+++ b/collects/macro-debugger/model/deriv-c.rkt
@@ -39,6 +39,8 @@
 (define-struct local-lift-require (req expr mexpr) #:transparent)
 (define-struct local-lift-provide (prov) #:transparent)
 (define-struct local-bind (names ?1 renames bindrhs) #:transparent)
+(define-struct local-value (name ?1 resolves bound?) #:transparent)
+(define-struct track-origin (before after) #:transparent)
 (define-struct local-remark (contents) #:transparent)
   ;; contents : (listof (U string syntax))
 
diff --git a/collects/macro-debugger/model/deriv-parser.rkt b/collects/macro-debugger/model/deriv-parser.rkt
index a140435..ec95d05 100644
--- a/collects/macro-debugger/model/deriv-parser.rkt
+++ b/collects/macro-debugger/model/deriv-parser.rkt
@@ -43,6 +43,7 @@
     enter-check exit-check
     local-post exit-local exit-local/expr
     local-bind enter-bind exit-bind
+    local-value-result
     phase-up module-body
     renames-lambda
     renames-case-lambda
@@ -201,6 +202,10 @@
       (make local-bind $1 $2 $3 #f)]
      [(local-bind rename-list (? BindSyntaxes))
       (make local-bind $1 #f $2 $3)]
+     [(track-origin)
+      (make track-origin (car $1) (cdr $1))]
+     [(local-value ! Resolves local-value-result)
+      (make local-value $1 $2 $3 $4)]
      [(local-remark)
       (make local-remark $1)]
      [(local-artificial-step)
diff --git a/collects/macro-debugger/model/deriv-tokens.rkt b/collects/macro-debugger/model/deriv-tokens.rkt
index 3c5cb9d..7e717e7 100644
--- a/collects/macro-debugger/model/deriv-tokens.rkt
+++ b/collects/macro-debugger/model/deriv-tokens.rkt
@@ -61,6 +61,10 @@
 
    local-remark         ; (listof (U string syntax))
    local-artificial-step ; (list syntax syntax syntax syntax)
+
+   track-origin         ; (cons stx stx)
+   local-value          ; identifier
+   local-value-result   ; boolean
    ))
 
 (define-tokens renames-tokens
@@ -175,8 +179,10 @@
     (149 prim-varref)
     (150 lift-require            ,token-lift-require)
     (151 lift-provide            ,token-lift-provide)
-    (155 prim-#%stratified-body)
-    ))
+    (152 track-origin            ,token-track-origin)
+    (153 local-value             ,token-local-value)
+    (154 local-value-result      ,token-local-value-result)
+    (155 prim-#%stratified-body)))
 
 (define (signal->symbol sig)
   (if (symbol? sig)
diff --git a/collects/macro-debugger/model/deriv-util.rkt b/collects/macro-debugger/model/deriv-util.rkt
index 8987afb..d68afcc 100644
--- a/collects/macro-debugger/model/deriv-util.rkt
+++ b/collects/macro-debugger/model/deriv-util.rkt
@@ -1,7 +1,5 @@
 #lang racket/base
 (require (for-syntax racket/base)
-         (for-syntax racket/private/struct-info)
-         racket/list
          racket/match
          unstable/struct
          "deriv.rkt")
diff --git a/collects/macro-debugger/model/deriv.rkt b/collects/macro-debugger/model/deriv.rkt
index 420d6ca..9f397d3 100644
--- a/collects/macro-debugger/model/deriv.rkt
+++ b/collects/macro-debugger/model/deriv.rkt
@@ -1,5 +1,3 @@
 #lang racket/base
-(require racket/contract
-         syntax/stx
-         "deriv-c.rkt")
+(require "deriv-c.rkt")
 (provide (all-from-out "deriv-c.rkt"))
diff --git a/collects/macro-debugger/model/hiding-policies.rkt b/collects/macro-debugger/model/hiding-policies.rkt
index f7476b8..3f0f01b 100644
--- a/collects/macro-debugger/model/hiding-policies.rkt
+++ b/collects/macro-debugger/model/hiding-policies.rkt
@@ -1,6 +1,5 @@
 #lang racket/base
-(require (for-syntax racket/base)
-         racket/match
+(require racket/match
          "reductions-config.rkt"
          "../util/mpi.rkt")
 (provide policy->predicate)
diff --git a/collects/macro-debugger/model/reductions-config.rkt b/collects/macro-debugger/model/reductions-config.rkt
index cb3cfcb..661e95c 100644
--- a/collects/macro-debugger/model/reductions-config.rkt
+++ b/collects/macro-debugger/model/reductions-config.rkt
@@ -1,9 +1,8 @@
 #lang racket/base
 (require (for-syntax racket/base)
-         racket/list
          racket/contract
          racket/match
-         "deriv.rkt"
+         "../util/eomap.rkt"
          "deriv-util.rkt"
          "stx-util.rkt"
          "context.rkt"
@@ -35,8 +34,8 @@
  [big-context (parameter/c big-context/c)]
  [marking-table (parameter/c (or/c hash? false/c))]
  [current-binders (parameter/c (listof identifier?))]
- [current-definites (parameter/c (listof identifier?))]
- [current-binders (parameter/c (listof identifier?))]
+ [current-definites (parameter/c eomap?)] ;; eomap[identifier => phase-level]
+ [current-binders (parameter/c hash?)] ;; hash[identifier => phase-level]
  [current-frontier (parameter/c (listof syntax?))]
  [sequence-number (parameter/c (or/c false/c exact-nonnegative-integer?))]
  [phase (parameter/c exact-nonnegative-integer?)]
@@ -82,11 +81,11 @@
 ;; marking-table
 (define marking-table (make-parameter #f))
 
-;; current-binders : parameterof (listof identifier)
-(define current-binders (make-parameter null))
+;; current-binders : parameter of hash[identifier => phase-level]
+(define current-binders (make-parameter #f))
 
-;; current-definites : parameter of (list-of identifier)
-(define current-definites (make-parameter null))
+;; current-definites : parameter of eomap[identifier => phase-level]
+(define current-definites (make-parameter #f))
 
 ;; current-frontier : parameter of (list-of syntax)
 (define current-frontier (make-parameter null))
@@ -151,11 +150,12 @@
 
 (define (learn-definites ids)
   (current-definites
-   (append ids (current-definites))))
+   (eomap-set* (current-definites) ids (phase))))
 
 (define (learn-binders ids)
   (current-binders
-   (append ids (current-binders))))
+   (for/fold ([binders (current-binders)]) ([id (in-list ids)])
+     (hash-set binders id (phase)))))
 
 (define (get-frontier) (or (current-frontier) null))
 
@@ -249,9 +249,9 @@
   (lambda (stx #:allow-nonstx? [allow-nonstx? #f] #:default [default #f])
     (let ([replacement (hash-ref table stx #f)])
       (if replacement
-          (begin #;(printf "  replacing ~s with ~s~n" stx replacement)
+          (begin #;(printf "  replacing ~s with ~s\n" stx replacement)
                  replacement)
-          (begin #;(printf "  not replacing ~s~n" stx)
+          (begin #;(printf "  not replacing ~s\n" stx)
                  default)))))
 
 (define (make-renames-table from0 to0)
@@ -286,11 +286,11 @@
            ;; Only bad effect should be missed subterms (usually at phase1).
            (STRICT-CHECKS
             (fprintf (current-error-port)
-                     "from:\n~e\n\nto:\n~e\n\n"
+                     "from:\n~.s\n\nto:\n~.s\n\n"
                      (stx->datum from)
                      (stx->datum to))
             (fprintf (current-error-port)
-                     "original from:\n~e\n\noriginal to:\n~e\n\n"
+                     "original from:\n~.s\n\noriginal to:\n~.s\n\n"
                      (stx->datum from0)
                      (stx->datum to0))
             (error 'add-to-renames-table))
diff --git a/collects/macro-debugger/model/reductions-engine.rkt b/collects/macro-debugger/model/reductions-engine.rkt
index f02f088..125b1db 100644
--- a/collects/macro-debugger/model/reductions-engine.rkt
+++ b/collects/macro-debugger/model/reductions-engine.rkt
@@ -1,9 +1,8 @@
 #lang racket/base
 (require (for-syntax racket/base
-                     syntax/parse)
-         racket/list
+                     syntax/parse
+                     syntax/parse/experimental/contract)
          racket/contract
-         "deriv.rkt"
          "deriv-util.rkt"
          "stx-util.rkt"
          "context.rkt"
@@ -149,7 +148,7 @@
                       (current-state-with v (with-syntax1 ([p f]) fs)))]
              [type-var type])
          (DEBUG
-          (printf "visibility = ~s\n" (visibility))
+          (printf "visibility = ~s\n" (if (visibility) 'VISIBLE 'HIDDEN))
           (printf "step: s1 = ~s\n" s)
           (printf "step: s2 = ~s\n\n" s2))
          (let ([ws2
@@ -289,9 +288,9 @@
 
     [(R** f v p s ws [#:print-state msg] . more)
      #'(begin (printf "** ~s\n" msg)
-              (printf "f = ~e\n" (stx->datum f))
-              (printf "v = ~e\n" (stx->datum v))
-              (printf "s = ~e\n" (stx->datum s))
+              (printf "f = ~.s\n" (stx->datum f))
+              (printf "v = ~.s\n" (stx->datum v))
+              (printf "s = ~.s\n" (stx->datum s))
               (R** f v p s ws . more))]
 
     ;; ** Multi-pass reductions **
@@ -323,7 +322,7 @@
          (visibility-off (not previous-pass-hides?)
                          v
                          (lambda ()
-                           (print-viable-subterms v)
+                           (when #f (print-viable-subterms v))
                            (R** f v p s ws clause ... => k))
                          #t))]
 
@@ -365,10 +364,10 @@
               [fills fills-e])
          (DEBUG
            (printf "Run (multi, vis=~s)\n" (visibility))
-           (printf " f: ~e\n" (stx->datum f))
-           (printf " v: ~e\n" (stx->datum v))
-           (printf " p: ~e\n" 'p)
-           (printf " hole: ~e\n" '(hole :::))
+           (printf " f: ~.s\n" (stx->datum f))
+           (printf " v: ~.s\n" (stx->datum v))
+           (printf " p: ~.s\n" 'p)
+           (printf " hole: ~.s\n" '(hole :::))
            (print-viable-subterms v))
          (if (visibility)
              (let ([vctx (CC (hole :::) v p)]
@@ -381,10 +380,10 @@
               [fctx (CC hole f p)])
          (DEBUG
            (printf "Run (single, vis=~s)\n" (visibility))
-           (printf " f: ~e\n" (stx->datum f))
-           (printf " v: ~e\n" (stx->datum v))
-           (printf " p: ~e\n" 'p)
-           (printf " hole: ~e\n" 'hole)
+           (printf " f: ~.s\n" (stx->datum f))
+           (printf " v: ~.s\n" (stx->datum v))
+           (printf " p: ~.s\n" 'p)
+           (printf " hole: ~.s\n" 'hole)
            (print-viable-subterms v))
          (if (visibility)
              (let ([vctx (CC hole v p)]
@@ -396,8 +395,8 @@
 (define (run-one reducer init-e fctx vsub vctx fill s ws k)
   (DEBUG
     (printf "run-one\n")
-    (printf "  fctx: ~e\n" (stx->datum (fctx #'HOLE)))
-    (printf "  vctx: ~e\n" (stx->datum (vctx #'HOLE))))
+    (printf "  fctx: ~.s\n" (stx->datum (fctx #'HOLE)))
+    (printf "  vctx: ~.s\n" (stx->datum (vctx #'HOLE))))
   (RSbind (with-context vctx
             ((reducer fill) init-e vsub s ws))
           (lambda (f2 v2 s2 ws2) (k (fctx f2) (vctx v2) s2 ws2))))
@@ -406,12 +405,12 @@
 (define (run-multiple/visible reducer init-e1s fctx vsubs vctx fills s ws k)
   (DEBUG
     (printf "run-multiple/visible\n")
-    (printf "  fctx: ~e\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE))))
-    (printf "  vctx: ~e\n" (stx->datum (vctx (for/list ([dummy init-e1s]) #'HOLE))))
+    (printf "  fctx: ~.s\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE))))
+    (printf "  vctx: ~.s\n" (stx->datum (vctx (for/list ([dummy init-e1s]) #'HOLE))))
     (unless (= (length fills) (length init-e1s))
-      (printf "  fills(~s): ~e\n" (length fills) fills)
-      (printf "  init-e1s: ~s\n" (stx->datum init-e1s))
-      (printf "  vsubs: ~s\n" (stx->datum vsubs))))
+      (printf "  fills(~s): ~.s\n" (length fills) fills)
+      (printf "  init-e1s: ~.s\n" (stx->datum init-e1s))
+      (printf "  vsubs: ~.s\n" (stx->datum vsubs))))
   (let loop ([fills fills] [prefix null] [vprefix null] [suffix init-e1s] [vsuffix vsubs] [s s] [ws ws])
     (cond
      [(pair? fills)
@@ -432,10 +431,10 @@
 (define (run-multiple/nonvisible reducer init-e1s fctx v fills s ws k)
   (DEBUG
     (printf "run-multiple/nonvisible\n")
-    (printf "  fctx: ~e\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE)))))
+    (printf "  fctx: ~.s\n" (stx->datum (fctx (for/list ([dummy init-e1s]) #'HOLE)))))
   (let loop ([fills fills] [prefix null] [suffix init-e1s] [v v] [s s] [ws ws])
     (DEBUG
-      (printf "  v: ~e\n" (stx->datum (datum->syntax #f v))))
+      (printf "  v: ~.s\n" (stx->datum (datum->syntax #f v))))
     (cond
      [(pair? fills)
       (RSbind ((reducer (car fills)) (car suffix) v s ws)
@@ -468,7 +467,7 @@
   (cond [(and (not new-visible?) (or (visibility) reset-subterms?))
          (begin
            (DEBUG
-            (printf "hide => seek: ~e\n" (stx->datum stx)))
+            (printf "hide => seek: ~.s\n" (stx->datum stx)))
            (current-pass-hides? #t)
            (let* ([subterms (gather-proper-subterms stx)]
                   [marking (marking-table)]
@@ -494,26 +493,29 @@
 (define (seek-point stx vstx k)
   (if (visibility)
       (k vstx)
-      (let ([paths (table-get (subterms-table) stx)])
-        (cond [(null? paths)
-               (DEBUG (printf "seek-point: failed on ~e\n" (stx->datum stx)))
-               (k vstx)]
-              [(null? (cdr paths))
-               (let ([path (car paths)])
-                 (DEBUG (printf "seek => hide: ~e\n" (stx->datum stx)))
-                 (let ([ctx (lambda (x) (path-replace vstx path x))])
-                   (RScase (parameterize ((visibility #t)
-                                          (subterms-table #f)
-                                          (marking-table #f))
-                             ;; Found stx within vstx
-                             (with-context ctx (k stx)))
-                           (lambda (ws2 stx2 vstx2 s2)
-                             (let ([vstx2 (ctx vstx2)])
-                               (RSunit ws2 stx2 vstx2 s2)))
-                           (lambda (ws exn)
-                             (RSfail ws exn)))))]
-              [else
-               (raise (make nonlinearity stx paths))]))))
+      (begin
+        (DEBUG (printf "Seek point\n")
+               (print-viable-subterms stx))
+        (let ([paths (table-get (subterms-table) stx)])
+          (cond [(null? paths)
+                 (DEBUG (printf "seek-point: failed on ~.s\n" (stx->datum stx)))
+                 (k vstx)]
+                [(null? (cdr paths))
+                 (let ([path (car paths)])
+                   (DEBUG (printf "seek => hide: ~.s\n" (stx->datum stx)))
+                   (let ([ctx (lambda (x) (path-replace vstx path x))])
+                     (RScase (parameterize ((visibility #t)
+                                            (subterms-table #f)
+                                            (marking-table #f))
+                               ;; Found stx within vstx
+                               (with-context ctx (k stx)))
+                             (lambda (ws2 stx2 vstx2 s2)
+                               (let ([vstx2 (ctx vstx2)])
+                                 (RSunit ws2 stx2 vstx2 s2)))
+                             (lambda (ws exn)
+                               (RSfail ws exn)))))]
+                [else
+                 (raise (make nonlinearity stx paths))])))))
 
 (provide print-viable-subterms)
 (define (print-viable-subterms stx)
@@ -538,16 +540,16 @@
            [same-form? (equal? actual-datum expected-datum)])
       (if same-form?
           (fprintf (current-error-port)
-                   "same form but wrong wrappings:\n~e\nwrongness:\n~e\n"
+                   "same form but wrong wrappings:\n~.s\nwrongness:\n~.s\n"
                    actual-datum
                    (wrongness actual expected))
           (fprintf (current-error-port)
-                   "got:\n~s\n\nexpected:\n~e\n"
+                   "got:\n~.s\n\nexpected:\n~.s\n"
                    actual-datum
                    expected-datum))
       (for ([d derivs])
         (fprintf (current-error-port)
-                 "\n~e\n" d))
+                 "\n~.s\n" d))
       (error function
              (if same-form?
                  "wrong starting point (wraps)!"
diff --git a/collects/macro-debugger/model/reductions.rkt b/collects/macro-debugger/model/reductions.rkt
index 3f04bf1..925d3f2 100644
--- a/collects/macro-debugger/model/reductions.rkt
+++ b/collects/macro-debugger/model/reductions.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require racket/match
+         "../util/eomap.rkt"
          "stx-util.rkt"
          "deriv-util.rkt"
          "deriv.rkt"
@@ -15,10 +16,13 @@
   (let-values ([(steps binders definites estx exn) (reductions+ d)])
     steps))
 
-;; reductions+ : WDeriv -> (list-of step) (list-of identifier) ?stx ?exn
+;; Binders = hasheq[identifier => phase-level]
+;; Definites = eomap[identifier => phase-level]
+
+;; reductions+ : WDeriv -> (list-of step) Binders Definites ?stx ?exn
 (define (reductions+ d)
-  (parameterize ((current-definites null)
-                 (current-binders null)
+  (parameterize ((current-definites (empty-eomap))
+                 (current-binders #hasheq())
                  (current-frontier null)
                  (hides-flags (list (box #f)))
                  (sequence-number 0))
@@ -454,6 +458,19 @@
         ;; FIXME: use renames
         [#:binders names]
         [#:when bindrhs => (BindSyntaxes bindrhs)]]]
+    [(struct track-origin (before after))
+     (R)
+     #|
+     ;; Do nothing for now... need to account for marks also.
+     [R [#:set-syntax before]
+        [#:pattern ?form]
+        [#:rename ?form after 'track-origin]]
+     |#]
+    [(struct local-value (name ?1 resolves bound?))
+     [R [! ?1]
+        ;; [#:learn (list name)]
+        ;; Add remark step?
+        ]]
     [(struct local-remark (contents))
      (R [#:reductions (list (walk/talk 'remark contents))])]))
 
diff --git a/collects/macro-debugger/model/steps.rkt b/collects/macro-debugger/model/steps.rkt
index bb4feed..716277f 100644
--- a/collects/macro-debugger/model/steps.rkt
+++ b/collects/macro-debugger/model/steps.rkt
@@ -1,6 +1,4 @@
 #lang racket/base
-(require "deriv.rkt"
-         "deriv-util.rkt")
 (provide (struct-out protostep)
          (struct-out step)
          (struct-out misstep)
@@ -92,6 +90,7 @@
     (splice-module-lifts . "Splice lifted module declarations")
 
     (remark           . "Macro made a remark")
+    (track-origin     . "Macro called syntax-track-origin")
 
     (error            . "Error")))
 
@@ -111,7 +110,8 @@
           rename-case-lambda
           rename-let-values
           rename-letrec-values
-          rename-lsv)))
+          rename-lsv
+          track-origin)))
 
 (define (rewrite-step? x)
   (and (step? x) (not (rename-step? x))))
diff --git a/collects/macro-debugger/model/stx-util.rkt b/collects/macro-debugger/model/stx-util.rkt
index def760a..5114379 100644
--- a/collects/macro-debugger/model/stx-util.rkt
+++ b/collects/macro-debugger/model/stx-util.rkt
@@ -36,10 +36,10 @@
              [old-parts (stx->list old-expr)])
          ;; FIXME 
          (unless (= (length new-parts) (length old-parts))
-           (printf "** syntax/restamp~n~s~n" (quote-syntax #,stx))
-           (printf "pattern : ~s~n" (syntax->datum #'(pa (... ...))))
-           (printf "old parts: ~s~n" (map syntax->datum old-parts))
-           (printf "new parts: ~s~n" (map syntax->datum new-parts)))
+           (printf "** syntax/restamp\n~s\n" (quote-syntax #,stx))
+           (printf "pattern : ~s\n" (syntax->datum #'(pa (... ...))))
+           (printf "old parts: ~s\n" (map syntax->datum old-parts))
+           (printf "new parts: ~s\n" (map syntax->datum new-parts)))
          (d->so
           old-expr
           (map (lambda (new old) (syntax/restamp pa new old))
@@ -49,10 +49,10 @@
      ;; FIXME 
      #'(begin
          (unless (and (stx-pair? new-expr) (stx-pair? old-expr))
-           (printf "** syntax/restamp~n~s~n" (quote-syntax #,stx))
-           (printf "pattern : ~s~n" (syntax->datum (quote-syntax (pa . pb))))
-           (printf "old parts: ~s~n" old-expr)
-           (printf "new parts: ~s~n" new-expr))
+           (printf "** syntax/restamp\n~s\n" (quote-syntax #,stx))
+           (printf "pattern : ~s\n" (syntax->datum (quote-syntax (pa . pb))))
+           (printf "old parts: ~s\n" old-expr)
+           (printf "new parts: ~s\n" new-expr))
          (let ([na (stx-car new-expr)]
                [nb (stx-cdr new-expr)]
                [oa (stx-car old-expr)]
diff --git a/collects/macro-debugger/model/trace-raw.rkt b/collects/macro-debugger/model/trace-raw.rkt
index 40615d6..5a171f7 100644
--- a/collects/macro-debugger/model/trace-raw.rkt
+++ b/collects/macro-debugger/model/trace-raw.rkt
@@ -2,7 +2,6 @@
 (require racket/class
          parser-tools/lex
          "deriv-tokens.rkt"
-         "deriv-parser.rkt"
          "../syntax-browser.rkt")
 (provide (all-defined-out))
 
@@ -18,7 +17,7 @@
     (define val (cdr sig+val))
     (define t (tokenize sig val pos))
     (send browser add-text
-          (format "Signal: ~s: ~s~n"
+          (format "Signal: ~s: ~s\n"
                   pos
                   (token-name (position-token-token t))))
     (when val
diff --git a/collects/macro-debugger/model/trace.rkt b/collects/macro-debugger/model/trace.rkt
index 5f509e5..527494b 100644
--- a/collects/macro-debugger/model/trace.rkt
+++ b/collects/macro-debugger/model/trace.rkt
@@ -1,12 +1,15 @@
 #lang racket/base
 (require racket/promise
+         syntax/modcode
+         syntax/modresolve
          parser-tools/lex
-         "deriv.rkt"
          "deriv-parser.rkt"
          "deriv-tokens.rkt")
 
 (provide trace
          trace*
+         trace-module
+         trace*-module
          trace/result
          trace-verbose?
          events->token-generator
@@ -26,6 +29,11 @@
   (let-values ([(result events derivp) (trace* stx expander)])
     (force derivp)))
 
+;; trace-module : module-path -> Deriv
+(define (trace-module module-path)
+  (let-values ([(result events derivp) (trace*-module module-path)])
+    (force derivp)))
+
 ;; trace/result : stx -> stx/exn Deriv
 (define (trace/result stx [expander expand/compile-time-evals])
   (let-values ([(result events derivp) (trace* stx expander)])
@@ -40,6 +48,13 @@
             (delay (parse-derivation
                     (events->token-generator events))))))
 
+;; trace*-module : module-path -> stx/exn (listof event) (promiseof Deriv)
+(define (trace*-module module-path)
+  (get-module-code (resolve-module-path module-path #f)
+                   #:choose (lambda _ 'src)
+                   #:compile (lambda (stx)
+                               (trace* stx expand))))
+
 ;; events->token-generator : (list-of event) -> (-> token)
 (define (events->token-generator events)
   (let ([pos 1])
@@ -50,7 +65,7 @@
              [val (cdr sig+val)]
              [t (tokenize sig val pos)])
         (when (trace-verbose?)
-          (printf "~s: ~s~n" pos
+          (printf "~s: ~s\n" pos
                   (token-name (position-token-token t))))
         (set! pos (add1 pos))
         t))))
diff --git a/collects/macro-debugger/stepper-text.rkt b/collects/macro-debugger/stepper-text.rkt
index 15df8ef..5004438 100644
--- a/collects/macro-debugger/stepper-text.rkt
+++ b/collects/macro-debugger/stepper-text.rkt
@@ -1,6 +1,5 @@
 #lang racket/base
-(require racket/list
-         racket/pretty
+(require racket/pretty
          "model/trace.rkt"
          "model/reductions.rkt"
          "model/reductions-config.rkt"
diff --git a/collects/macro-debugger/stepper.rkt b/collects/macro-debugger/stepper.rkt
index 07e782b..48982a6 100644
--- a/collects/macro-debugger/stepper.rkt
+++ b/collects/macro-debugger/stepper.rkt
@@ -1,6 +1,25 @@
 #lang racket/base
-(require "view/view.rkt")
-(provide expand/step)
+(require racket/class
+         racket/contract
+         unstable/class-iop
+         "model/trace.rkt"
+         "view/interfaces.rkt"
+         "view/view.rkt")
+
+(define (create-stepper deriv)
+  (define director (new macro-stepper-director%))
+  (define stepper (send/i director director<%> new-stepper))
+  (send/i director director<%> add-deriv deriv)
+  (void))
 
 (define (expand/step stx)
-  (go stx))
+  (create-stepper (trace stx)))
+
+(define (expand-module/step module-path)
+  (create-stepper (trace-module module-path)))
+
+(provide/contract
+ [expand/step
+  (-> syntax? void?)]
+ [expand-module/step
+  (-> module-path? void?)])
diff --git a/collects/macro-debugger/syntax-browser/display.rkt b/collects/macro-debugger/syntax-browser/display.rkt
index bc3b1ff..3549da3 100644
--- a/collects/macro-debugger/syntax-browser/display.rkt
+++ b/collects/macro-debugger/syntax-browser/display.rkt
@@ -1,8 +1,10 @@
 #lang racket/base
 (require racket/class
-         racket/gui
+         racket/gui/base
          racket/list
-         racket/block
+         racket/pretty
+         racket/promise
+         data/interval-map
          framework
          unstable/class-iop
          "pretty-printer.rkt"
@@ -12,46 +14,52 @@
 (provide print-syntax-to-editor
          code-style)
 
-(define TIME-PRINTING? #f)
+(define-syntax-rule (uninterruptible e ...)
+  ;; (coarsely) prevent breaks within editor operations
+  (parameterize-break #f (begin e ...))
+  #|
+  (parameterize-break #f
+    (let ([ta (now)])
+      (begin0 (begin e ...)
+        (let ([tb (now)])
+          (eprintf "****\n")
+          (pretty-write '(begin e ...) (current-error-port))
+          (eprintf "  -- ~s ms\n\n" (- tb ta))))))
+  |#)
 
-(define-syntax-rule (now)
-  (if TIME-PRINTING?
-      (current-inexact-milliseconds)
-      0))
+(define (now) (current-inexact-milliseconds))
 
 ;; FIXME: assumes text never moves
 
 ;; print-syntax-to-editor : syntax text controller<%> config number number
 ;;                       -> display<%>
+;; Note: must call display<%>::refresh to finish styling.
 (define (print-syntax-to-editor stx text controller config columns
                                 [insertion-point (send text last-position)])
-  (block
-   (define output-port (open-output-string/count-lines))
-   (define range
-     (pretty-print-syntax stx output-port 
-                          (send/i controller controller<%> get-primary-partition)
-                          (length (send/i config config<%> get-colors))
-                          (send/i config config<%> get-suffix-option)
-                          (send config get-pretty-styles)
-                          columns))
-   (define output-string (get-output-string output-port))
-   (define output-length (sub1 (string-length output-string))) ;; skip final newline
-   (fixup-parentheses output-string range)
-   (send text begin-edit-sequence #f)
-   (send text insert output-length output-string insertion-point)
-   (define display
-     (new display%
-          (text text)
-          (controller controller)
-          (config config)
-          (range range)
-          (start-position insertion-point)
-          (end-position (+ insertion-point output-length))))
-   (send display initialize)
-   (send text end-edit-sequence)
-   display))
+  (define output-port (open-output-string/count-lines))
+  (define range
+    (pretty-print-syntax stx output-port 
+                         (send/i controller controller<%> get-primary-partition)
+                         (length (send/i config config<%> get-colors))
+                         (send/i config config<%> get-suffix-option)
+                         (send config get-pretty-styles)
+                         columns))
+  (define output-string (get-output-string output-port))
+  (define output-length (sub1 (string-length output-string))) ;; skip final newline
+  (fixup-parentheses output-string range)
+  (with-unlock text
+    (uninterruptible
+     (send text insert output-length output-string insertion-point))
+    (new display%
+         (text text)
+         (controller controller)
+         (config config)
+         (range range)
+         (start-position insertion-point)
+         (end-position (+ insertion-point output-length)))))
 
 ;; display%
+;; Note: must call refresh method to finish styling.
 (define display%
   (class* object% (display<%>)
     (init-field/i [controller controller<%>]
@@ -64,57 +72,69 @@
     (define base-style
       (code-style text (send/i config config<%> get-syntax-font-size)))
 
+    ;; on-next-refresh : (listof (cons stx style-delta))
+    ;; Styles to be applied on next refresh only. (eg, underline)
+    (define on-next-refresh null)
+
+    ;; extra-styles : hash[stx => (listof style-delta)]
+    ;; Styles to be re-applied on every refresh.
     (define extra-styles (make-hasheq))
 
+    ;; to-undo-styles : (listof (cons nat nat))
+    ;; Ranges to unbold or unhighlight when selection changes.
+    ;; FIXME: ought to be managed by text:region-data (to auto-update ranges)
+    ;;   until then, positions are relative
+    (define to-undo-styles null)
+
     ;; initialize : -> void
-    (define/public (initialize)
-      (send text change-style base-style start-position end-position #f)
-      (apply-primary-partition-styles)
-      (add-clickbacks)
-      (refresh))
+    (define/private (initialize)
+      (uninterruptible
+       (send text change-style base-style start-position end-position #f))
+      (uninterruptible (apply-primary-partition-styles))
+      (uninterruptible (add-clickbacks)))
 
     ;; add-clickbacks : -> void
     (define/private (add-clickbacks)
-      (define (the-clickback editor start end)
+      (define mapping (send text get-region-mapping 'syntax))
+      (define lazy-interval-map-init
+        (delay
+          (uninterruptible
+           (for ([range (send/i range range<%> all-ranges)])
+             (let ([stx (range-obj range)]
+                   [start (range-start range)]
+                   [end (range-end range)])
+               (interval-map-set! mapping (+ start-position start) (+ start-position end) stx))))))
+      (define (the-callback position)
+        (force lazy-interval-map-init)
         (send/i controller selection-manager<%> set-selected-syntax
-               (clickback->stx
-                (- start start-position) (- end start-position))))
-      (for ([range (send/i range range<%> all-ranges)])
-        (let ([stx (range-obj range)]
-              [start (range-start range)]
-              [end (range-end range)])
-          (send text set-clickback (+ start-position start) (+ start-position end)
-                the-clickback))))
-
-    ;; clickback->stx : num num -> syntax
-    ;; FIXME: use vectors for treerange-subs and do binary search to narrow?
-    (define/private (clickback->stx start end)
-      (let ([treeranges (send/i range range<%> get-treeranges)])
-        (let loop* ([treeranges treeranges])
-          (for/or ([tr treeranges])
-            (cond [(and (= (treerange-start tr) start)
-                        (= (treerange-end tr) end))
-                   (treerange-obj tr)]
-                  [(and (<= (treerange-start tr) start)
-                        (<= end (treerange-end tr)))
-                   (loop* (treerange-subs tr))]
-                  [else #f])))))
+                (interval-map-ref mapping position #f)))
+      (send text set-clickregion start-position end-position the-callback))
 
     ;; refresh : -> void
     ;; Clears all highlighting and reapplies all non-foreground styles.
     (define/public (refresh)
       (with-unlock text
-        (send* text 
-          (begin-edit-sequence #f)
-          (change-style (unhighlight-d) start-position end-position))
-        (apply-extra-styles)
+        (uninterruptible
+         (let ([undo-select/highlight-d (get-undo-select/highlight-d)])
+           (for ([r (in-list to-undo-styles)])
+             (send text change-style undo-select/highlight-d
+                   (relative->text-position (car r))
+                   (relative->text-position (cdr r)))))
+         (set! to-undo-styles null))
+        (uninterruptible
+         (for ([stx+delta (in-list on-next-refresh)])
+           (for ([r (in-list (send/i range range<%> get-ranges (car stx+delta)))])
+             (restyle-range r (cdr stx+delta) #f)))
+         (set! on-next-refresh null))
+        (uninterruptible
+         (apply-extra-styles))
         (let ([selected-syntax
                (send/i controller selection-manager<%>
-                      get-selected-syntax)])
-          (apply-secondary-relation-styles selected-syntax)
-          (apply-selection-styles selected-syntax))
-        (send* text
-          (end-edit-sequence))))
+                       get-selected-syntax)])
+          (uninterruptible
+           (apply-secondary-relation-styles selected-syntax))
+          (uninterruptible
+           (apply-selection-styles selected-syntax)))))
 
     ;; get-range : -> range<%>
     (define/public (get-range) range)
@@ -127,22 +147,16 @@
 
     ;; highlight-syntaxes : (list-of syntax) string -> void
     (define/public (highlight-syntaxes stxs hi-color)
-      (let ([style-delta (highlight-style-delta hi-color #f)])
-        (for ([stx stxs])
-          (add-extra-styles stx (list style-delta))))
-      (refresh))
+      (let ([delta (highlight-style-delta hi-color)])
+        (for ([stx (in-list stxs)])
+          (hash-set! extra-styles stx
+                     (cons delta (hash-ref extra-styles stx null))))))
 
     ;; underline-syntaxes : (listof syntax) -> void
     (define/public (underline-syntaxes stxs)
-      (for ([stx stxs])
-        (add-extra-styles stx (list underline-style-delta)))
-      (refresh))
-
-    ;; add-extra-styles : syntax (listof style) -> void
-    (define/public (add-extra-styles stx styles)
-      (hash-set! extra-styles stx
-                 (append (hash-ref extra-styles stx null)
-                         styles)))
+      (for ([stx (in-list stxs)])
+        (set! on-next-refresh
+              (cons (cons stx underline-d) on-next-refresh))))
 
     ;; Primary styles
     ;; (Done once on initialization, never repeated)
@@ -194,10 +208,16 @@
     ;; apply-extra-styles : -> void
     ;; Applies externally-added styles (such as highlighting)
     (define/private (apply-extra-styles)
-      (for ([(stx style-deltas) extra-styles])
-        (for ([r (send/i range range<%> get-ranges stx)])
-          (for ([style-delta style-deltas])
-            (restyle-range r style-delta)))))
+      (for ([(stx deltas) (in-hash extra-styles)])
+        (for ([r (in-list (send/i range range<%> get-ranges stx))])
+          (for ([delta (in-list deltas)])
+            (restyle-range r delta #t)))))
+
+    ;; apply-selection-styles : syntax -> void
+    ;; Styles subterms eq to the selected syntax
+    (define/private (apply-selection-styles selected-syntax)
+      (for ([r (in-list (send/i range range<%> get-ranges selected-syntax))])
+        (restyle-range r select-d #t)))
 
     ;; apply-secondary-relation-styles : selected-syntax -> void
     ;; If the selected syntax is an identifier, then styles all identifiers
@@ -207,25 +227,17 @@
         (let* ([name+relation
                 (send/i controller secondary-relation<%>
                         get-identifier=?)]
-               [relation (and name+relation (cdr name+relation))])
+               [relation (and name+relation (cdr name+relation))]
+               [secondary-highlight-d (get-secondary-highlight-d)])
           (when relation
-            (for ([id (send/i range range<%> get-identifier-list)])
+            (for ([id (in-list (send/i range range<%> get-identifier-list))])
               (when (relation selected-syntax id)
-                (draw-secondary-connection id)))))))
+                (for ([r (in-list (send/i range range<%> get-ranges id))])
+                  (restyle-range r secondary-highlight-d #t))))))))
 
-    ;; apply-selection-styles : syntax -> void
-    ;; Styles subterms eq to the selected syntax
-    (define/private (apply-selection-styles selected-syntax)
-      (for ([r (send/i range range<%> get-ranges selected-syntax)])
-        (restyle-range r (select-highlight-d))))
-
-    ;; draw-secondary-connection : syntax -> void
-    (define/private (draw-secondary-connection stx2)
-      (for ([r (send/i range range<%> get-ranges stx2)])
-        (restyle-range r (select-sub-highlight-d))))
-
-    ;; restyle-range : (cons num num) style-delta% -> void
-    (define/private (restyle-range r style)
+    ;; restyle-range : (cons num num) style-delta% boolean -> void
+    (define/private (restyle-range r style need-undo?)
+      (when need-undo? (set! to-undo-styles (cons r to-undo-styles)))
       (send text change-style style
             (relative->text-position (car r))
             (relative->text-position (cdr r))))
@@ -236,7 +248,8 @@
 
     ;; Initialize
     (super-new)
-    (send/i controller controller<%> add-syntax-display this)))
+    (send/i controller controller<%> add-syntax-display this)
+    (initialize)))
 
 ;; fixup-parentheses : string range -> void
 (define (fixup-parentheses string range)
@@ -358,34 +371,38 @@
 
 ;; Styles
 
-(define (highlight-style-delta raw-color em?
-                               #:translate-color? [translate-color? #t])
-  (let* ([sd (new style-delta%)])
-    (unless em?
-      (send sd set-delta-background
-            (if translate-color? (translate-color raw-color) raw-color)))
-    (when em? (send sd set-weight-on 'bold))
-    (unless em?
-      ;; (send sd set-underlined-off #t)
-      (send sd set-weight-off 'bold))
+(define select-d
+  (make-object style-delta% 'change-weight 'bold))
+
+(define underline-d
+  (make-object style-delta% 'change-underline #t))
+
+(define (highlight-style-delta raw-color #:translate-color? [translate-color? #t])
+  (let ([sd (new style-delta%)]
+        [color (if translate-color? (translate-color raw-color) raw-color)])
+    (send sd set-delta-background color)
     sd))
 
-(define underline-style-delta
-  (let ([sd (new style-delta%)])
-    (send sd set-underlined-on #t)
-    sd))
-
-(define (mk-2-constant-style bow-color em? [wob-color (translate-color bow-color)])
-  (let ([wob-version (highlight-style-delta wob-color em? #:translate-color? #f)]
-        [bow-version (highlight-style-delta bow-color em? #:translate-color? #f)])
+(define (mk-2-constant-style bow-color [wob-color (translate-color bow-color)])
+  (let ([wob-version (highlight-style-delta wob-color #:translate-color? #f)]
+        [bow-version (highlight-style-delta bow-color #:translate-color? #f)])
     (λ ()
       (if (pref:invert-colors?)
           wob-version
           bow-version))))
 
-(define select-highlight-d
-  (mk-2-constant-style "yellow" #t "darkgoldenrod"))
-(define select-sub-highlight-d
-  (mk-2-constant-style "yellow" #f "darkgoldenrod"))
+(define get-secondary-highlight-d
+  (mk-2-constant-style "yellow" "darkgoldenrod"))
 
-(define unhighlight-d (mk-2-constant-style "white" #f #|"black"|#))
+#|
+(define undo-select-d
+  (make-object style-delta% 'change-weight 'normal))
+(define get-undo-highlight-d
+  (mk-2-constant-style "white" "black"))
+|#
+
+(define (get-undo-select/highlight-d)
+  (let ([sd (make-object style-delta% 'change-weight 'normal)]
+        [bg (if (pref:invert-colors?) "black" "white")])
+    (send sd set-delta-background bg)
+    sd))
diff --git a/collects/macro-debugger/syntax-browser/frame.rkt b/collects/macro-debugger/syntax-browser/frame.rkt
index d59f2eb..2286124 100644
--- a/collects/macro-debugger/syntax-browser/frame.rkt
+++ b/collects/macro-debugger/syntax-browser/frame.rkt
@@ -1,8 +1,7 @@
 #lang racket/base
 (require racket/class
-         racket/gui
+         racket/gui/base
          racket/list
-         framework
          unstable/class-iop
          "interfaces.rkt"
          "partition.rkt"
diff --git a/collects/macro-debugger/syntax-browser/hrule-snip.rkt b/collects/macro-debugger/syntax-browser/hrule-snip.rkt
index c7bb859..a48d135 100644
--- a/collects/macro-debugger/syntax-browser/hrule-snip.rkt
+++ b/collects/macro-debugger/syntax-browser/hrule-snip.rkt
@@ -1,6 +1,6 @@
 #lang racket/base
 (require racket/class
-         racket/gui)
+         racket/gui/base)
 (provide hrule-snip%)
 
 ;; hrule-snip%
diff --git a/collects/macro-debugger/syntax-browser/image.rkt b/collects/macro-debugger/syntax-browser/image.rkt
index 23fa15c..2a6e4e1 100644
--- a/collects/macro-debugger/syntax-browser/image.rkt
+++ b/collects/macro-debugger/syntax-browser/image.rkt
@@ -1,11 +1,12 @@
 #lang racket/base
 (require racket/contract
          racket/class
-         racket/gui
+         racket/gui/base
          framework
          "prefs.rkt"
          "controller.rkt"
-         "display.rkt")
+         "display.rkt"
+         "text.rkt")
 
 #|
 
@@ -36,12 +37,10 @@ TODO: tacked arrows
 ;; print-syntax-columns : (parameter-of (U number 'infinity))
 (define print-syntax-columns (make-parameter 40))
 
-(define standard-text% (text:foreground-color-mixin (editor:standard-style-list-mixin text:basic%)))
-
 ;; print-syntax-to-png : syntax path -> void
 (define (print-syntax-to-png stx file
                              #:columns [columns (print-syntax-columns)])
-  (let ([bmp (print-syntax-to-bitmap stx columns)])
+  (let ([bmp (print-syntax-to-bitmap stx #:columns columns)])
     (send bmp save-file file 'png))
   (void))
 
@@ -49,8 +48,8 @@ TODO: tacked arrows
 (define (print-syntax-to-bitmap stx
                                 #:columns [columns (print-syntax-columns)])
   (define t (prepare-editor stx columns))
-  (define f (new frame% [label "dummy"]))
-  (define ec (new editor-canvas% (editor t) (parent f)))
+  (define admin (new dummy-admin%))
+  (send t set-admin admin)
   (define dc (new bitmap-dc% (bitmap (make-object bitmap% 1 1))))
   (define char-width
     (let* ([sl (send t get-style-list)]
@@ -87,10 +86,20 @@ TODO: tacked arrows
     (send t print #f #f 'postscript #f #f #t)))
 
 (define (prepare-editor stx columns)
-  (define t (new standard-text%))
+  (define t (new browser-text%))
   (define sl (send t get-style-list))
   (send t change-style (send sl find-named-style (editor:get-default-color-style-name)))
   (print-syntax-to-editor stx t 
                           (new controller%) (new syntax-prefs/readonly%)
                           columns (send t last-position))
   t)
+
+;; dummy editor-admin
+(define dummy-admin%
+  (class editor-admin%
+    (define the-dc (new bitmap-dc% (bitmap (make-object bitmap% 1 1))))
+    (define/override (get-dc [x #f] [y #f])
+      (when x (set-box! x 0.0))
+      (when y (set-box! y 0.0))
+      the-dc)
+    (super-new)))
diff --git a/collects/macro-debugger/syntax-browser/keymap.rkt b/collects/macro-debugger/syntax-browser/keymap.rkt
index afc3fc2..4949134 100644
--- a/collects/macro-debugger/syntax-browser/keymap.rkt
+++ b/collects/macro-debugger/syntax-browser/keymap.rkt
@@ -1,10 +1,9 @@
 #lang racket/base
 (require racket/class
-         racket/gui
+         racket/gui/base
          racket/pretty
          unstable/gui/notify
-         "interfaces.rkt"
-         "partition.rkt")
+         "interfaces.rkt")
 (provide syntax-keymap%)
 
 (define keymap/popup%
@@ -119,7 +118,7 @@
                (demand-callback
                 (lambda (i)
                   (let ([stx (selected-syntax)])
-                    (when stx
+                    (when (identifier? stx)
                       (send i set-label
                             (format "Format ~s ~a" (syntax-e stx) (cadr sym+desc)))))))
                (callback
diff --git a/collects/macro-debugger/syntax-browser/partition.rkt b/collects/macro-debugger/syntax-browser/partition.rkt
index 35f662d..b2a7367 100644
--- a/collects/macro-debugger/syntax-browser/partition.rkt
+++ b/collects/macro-debugger/syntax-browser/partition.rkt
@@ -1,6 +1,5 @@
 #lang racket/base
 (require racket/class
-         syntax/stx
          "interfaces.rkt"
          "../util/stxobj.rkt")
 (provide new-bound-partition
diff --git a/collects/macro-debugger/syntax-browser/prefs.rkt b/collects/macro-debugger/syntax-browser/prefs.rkt
index ec9c0ad..fb4dce2 100644
--- a/collects/macro-debugger/syntax-browser/prefs.rkt
+++ b/collects/macro-debugger/syntax-browser/prefs.rkt
@@ -15,11 +15,13 @@
 (preferences:set-default 'SyntaxBrowser:Height 600 number?)
 (preferences:set-default 'SyntaxBrowser:PropertiesPanelPercentage 1/3 number?)
 (preferences:set-default 'SyntaxBrowser:PropertiesPanelShown #t boolean?)
+(preferences:set-default 'SyntaxBrowser:DrawArrows? #t boolean?)
 
 (define pref:width (pref:get/set 'SyntaxBrowser:Width))
 (define pref:height (pref:get/set 'SyntaxBrowser:Height))
 (define pref:props-percentage (pref:get/set 'SyntaxBrowser:PropertiesPanelPercentage))
 (define pref:props-shown? (pref:get/set 'SyntaxBrowser:PropertiesPanelShown))
+(define pref:draw-arrows? (pref:get/set 'SyntaxBrowser:DrawArrows?))
 
 (define pref:invert-colors? (pref:get/set 'framework:white-on-black?))
 
@@ -68,7 +70,8 @@
       (width pref:width)
       (height pref:height)
       (props-percentage pref:props-percentage)
-      (props-shown? pref:props-shown?))
+      (props-shown? pref:props-shown?)
+      (draw-arrows? pref:draw-arrows?))
 
     (super-new)))
 
diff --git a/collects/macro-debugger/syntax-browser/pretty-helper.rkt b/collects/macro-debugger/syntax-browser/pretty-helper.rkt
index 1f58acf..a67ebc2 100644
--- a/collects/macro-debugger/syntax-browser/pretty-helper.rkt
+++ b/collects/macro-debugger/syntax-browser/pretty-helper.rkt
@@ -1,6 +1,5 @@
 #lang racket/base
-(require racket/class
-         racket/pretty
+(require racket/pretty
          unstable/class-iop
          syntax/stx
          unstable/struct
diff --git a/collects/macro-debugger/syntax-browser/pretty-printer.rkt b/collects/macro-debugger/syntax-browser/pretty-printer.rkt
index 442115c..ae5a835 100644
--- a/collects/macro-debugger/syntax-browser/pretty-printer.rkt
+++ b/collects/macro-debugger/syntax-browser/pretty-printer.rkt
@@ -2,7 +2,8 @@
 (require racket/list
          racket/class
          racket/pretty
-         racket/gui
+         racket/gui/base
+         racket/promise
          "pretty-helper.rkt"
          "interfaces.rkt")
 (provide pretty-print-syntax)
@@ -86,7 +87,9 @@
    (map cdr basic-styles)))
 (define basic-styles
   '((define-values          . define)
-    (define-syntaxes        . define-syntax))
+    (define-syntaxes        . define-syntax)
+    (define-for-syntax      . define)
+    (define-values-for-syntax . define))
   #|
   ;; Messes up formatting too much :(
   (let* ([pref (pref:tabify)]
diff --git a/collects/macro-debugger/syntax-browser/properties.rkt b/collects/macro-debugger/syntax-browser/properties.rkt
index 2d0a482..2bf64f1 100644
--- a/collects/macro-debugger/syntax-browser/properties.rkt
+++ b/collects/macro-debugger/syntax-browser/properties.rkt
@@ -1,6 +1,6 @@
 #lang racket/base
 (require racket/class
-         racket/gui
+         racket/gui/base
          framework
          unstable/class-iop
          "interfaces.rkt"
@@ -59,17 +59,12 @@
 
     ;; refresh : -> void
     (define/public (refresh)
-      (send* text
-        (lock #f)
-        (begin-edit-sequence #f)
-        (erase))
-      (if (syntax? selected-syntax)
-          (refresh/mode mode)
-          (refresh/mode #f))
-      (send* text
-        (end-edit-sequence)
-        (lock #t)
-        (scroll-to-position 0)))
+      (with-unlock text
+        (send text erase)
+        (if (syntax? selected-syntax)
+            (refresh/mode mode)
+            (refresh/mode #f)))
+      (send text scroll-to-position 0))
 
     ;; refresh/mode : symbol -> void
     (define/public (refresh/mode mode)
@@ -255,19 +250,19 @@
 
     ;; display-kv : any any -> void
     (define/private (display-kv key value)
-      (display (format "~a~n" key) key-sd)
-      (display (format "~s~n~n" value) #f))
+      (display (format "~a\n" key) key-sd)
+      (display (format "~s\n\n" value) #f))
 
     ;; display-subkv : any any -> void
     (define/public (display-subkv k v)
       (display (format "~a: " k) sub-key-sd)
-      (display (format "~a~n" v) #f))
+      (display (format "~a\n" v) #f))
 
     (define/public (display-subkv/value k v)
       (display-subkv k v)
       #;
       (begin
-        (display (format "~a:~n" k) sub-key-sd)
+        (display (format "~a:\n" k) sub-key-sd)
         (let* ([value-text (new text:standard-style-list% (auto-wrap #t))]
                [value-snip (new editor-snip% (editor value-text))]
                [value-port (make-text-port value-text)])
diff --git a/collects/macro-debugger/syntax-browser/snip-decorated.rkt b/collects/macro-debugger/syntax-browser/snip-decorated.rkt
index c408255..442a09a 100644
--- a/collects/macro-debugger/syntax-browser/snip-decorated.rkt
+++ b/collects/macro-debugger/syntax-browser/snip-decorated.rkt
@@ -1,12 +1,13 @@
 #lang racket/base
 (require racket/class
-         racket/gui
+         racket/gui/base
          (only-in mzlib/string read-from-string)
          unstable/class-iop
          "interfaces.rkt"
          "controller.rkt"
          "properties.rkt"
          "prefs.rkt"
+         "util.rkt"
          (except-in "snip.rkt"
                     snip-class))
 
@@ -47,26 +48,21 @@
     (define open? #f)
 
     (define/public (refresh-contents)
-      (send* -outer
-        (begin-edit-sequence)
-        (lock #f)
-        (erase))
-      (do-style (if open? open-style closed-style))
-      (outer:insert (if open? (hide-icon) (show-icon))
-                    style:hyper
-                    (if open?
-                        (lambda _
-                          (set! open? #f)
-                          (refresh-contents))
-                        (lambda _
-                          (set! open? #t)
-                          (refresh-contents))))
-      (for-each (lambda (s) (outer:insert s))
-                (if open? (open-contents) (closed-contents)))
-      (send* -outer
-        (change-style top-aligned 0 (send -outer last-position))
-        (lock #t)
-        (end-edit-sequence)))
+      (with-unlock -outer
+        (send -outer erase)
+        (do-style (if open? open-style closed-style))
+        (outer:insert (if open? (hide-icon) (show-icon))
+                      style:hyper
+                      (if open?
+                          (lambda _
+                            (set! open? #f)
+                            (refresh-contents))
+                          (lambda _
+                            (set! open? #t)
+                            (refresh-contents))))
+        (for-each (lambda (s) (outer:insert s))
+                  (if open? (open-contents) (closed-contents)))
+        (send -outer change-style top-aligned 0 (send -outer last-position))))
 
     (define/private (do-style style)
       (show-border (memq 'border style))
diff --git a/collects/macro-debugger/syntax-browser/snip.rkt b/collects/macro-debugger/syntax-browser/snip.rkt
index 545b213..82a1f28 100644
--- a/collects/macro-debugger/syntax-browser/snip.rkt
+++ b/collects/macro-debugger/syntax-browser/snip.rkt
@@ -1,13 +1,13 @@
 #lang racket/base
 (require racket/class
-         racket/gui
+         racket/gui/base
          racket/match
          (only-in mzlib/string read-from-string)
          framework
-         "interfaces.rkt"
          "display.rkt"
          "controller.rkt"
          "keymap.rkt"
+         "util.rkt"
          "prefs.rkt")
 
 (provide syntax-snip%
@@ -35,12 +35,10 @@
     ;;(set-margin 2 2 2 2)
     (set-inset 0 0 0 0)
 
-    (send text begin-edit-sequence)
-    (send text change-style (make-object style-delta% 'change-alignment 'top))
     (define display
-      (print-syntax-to-editor stx text controller config columns))
-    (send text lock #t)
-    (send text end-edit-sequence)
+      (with-unlock text
+        (send text change-style (make-object style-delta% 'change-alignment 'top))
+        (print-syntax-to-editor stx text controller config columns)))
     (send text hide-caret #t)
 
     (setup-keymap text)
diff --git a/collects/macro-debugger/syntax-browser/text.rkt b/collects/macro-debugger/syntax-browser/text.rkt
index 839123c..c1eaeba 100644
--- a/collects/macro-debugger/syntax-browser/text.rkt
+++ b/collects/macro-debugger/syntax-browser/text.rkt
@@ -1,11 +1,11 @@
 #lang racket/base
 (require racket/list
          racket/class
-         racket/gui
+         racket/gui/base
+         data/interval-map
          drracket/arrow
          framework/framework
-         unstable/interval-map
-         unstable/gui/notify
+         data/interval-map
          "interfaces.rkt")
 
 (provide text:hover<%>
@@ -15,7 +15,12 @@
          text:hover-mixin
          text:hover-drawings-mixin
          text:tacking-mixin
-         text:arrows-mixin)
+         text:arrows-mixin
+         text:region-data-mixin
+         text:clickregion-mixin
+         browser-text%)
+
+(define arrow-cursor (make-object cursor% 'arrow))
 
 (define arrow-brush
   (send the-brush-list find-or-create-brush "white" 'solid))
@@ -27,14 +32,15 @@
 
 (define white (send the-color-database find-color "white"))
 
-;; A Drawing is (make-drawing number number (??? -> void) (box boolean))
-(define-struct drawing (start end draw tacked?))
+;; A Drawing is (make-drawing (??? -> void) (box boolean))
+(define-struct drawing (draw tacked?))
 
 (define-struct idloc (start end id))
 
 (define (mean x y)
   (/ (+ x y) 2))
 
+;; save+restore pen, brush, also smoothing
 (define-syntax with-saved-pen&brush
   (syntax-rules ()
     [(with-saved-pen&brush dc . body)
@@ -42,10 +48,13 @@
 
 (define (save-pen&brush dc thunk)
   (let ([old-pen (send dc get-pen)]
-        [old-brush (send dc get-brush)])
+        [old-brush (send dc get-brush)]
+        [old-smoothing (send dc get-smoothing)])
     (begin0 (thunk)
-      (send dc set-pen old-pen)
-      (send dc set-brush old-brush))))
+      (send* dc
+        (set-pen old-pen)
+        (set-brush old-brush)
+        (set-smoothing old-smoothing)))))
 
 (define-syntax with-saved-text-config
   (syntax-rules ()
@@ -58,10 +67,17 @@
         [old-background (send dc get-text-background)]
         [old-mode (send dc get-text-mode)])
     (begin0 (thunk)
-            (send dc set-font old-font)
-            (send dc set-text-foreground old-color)
-            (send dc set-text-background old-background)
-            (send dc set-text-mode old-mode))))
+      (send* dc
+        (set-font old-font)
+        (set-text-foreground old-color)
+        (set-text-background old-background)
+        (set-text-mode old-mode)))))
+
+;; Interfaces
+
+(define text:region-data<%>
+  (interface (text:basic<%>)
+    get-region-mapping))
 
 (define text:hover<%>
   (interface (text:basic<%>)
@@ -70,29 +86,51 @@
 (define text:hover-drawings<%>
   (interface (text:basic<%>)
     add-hover-drawing
-    get-position-drawings
-    delete-all-drawings))
+    get-position-drawings))
 
 (define text:arrows<%>
   (interface (text:hover-drawings<%>)
     add-arrow
-    add-question-arrow
     add-billboard))
 
+;; Mixins
+
+(define text:region-data-mixin
+  (mixin (text:basic<%>) (text:region-data<%>)
+
+    (define table (make-hasheq))
+
+    (define/public (get-region-mapping key)
+      (hash-ref! table key (lambda () (make-interval-map))))
+
+    (define/augment (after-delete start len)
+      (for ([im (in-hash-values table)])
+        (interval-map-contract! im start (+ start len)))
+      (inner (void) after-delete start len))
+
+    (define/augment (after-insert start len)
+      (for ([im (in-hash-values table)])
+        (interval-map-expand! im start (+ start len)))
+      (inner (void) after-insert start len))
+
+    (super-new)))
+
 (define text:hover-mixin
   (mixin (text:basic<%>) (text:hover<%>)
     (inherit dc-location-to-editor-location
              find-position)
 
     (define/override (on-default-event ev)
-      (define gx (send ev get-x))
-      (define gy (send ev get-y))
-      (define-values (x y) (dc-location-to-editor-location gx gy))
-      (define pos (find-position x y))
       (super on-default-event ev)
       (case (send ev get-event-type)
         ((enter motion leave)
-         (update-hover-position pos))))
+         (define-values (x y)
+           (let ([gx (send ev get-x)]
+                 [gy (send ev get-y)])
+             (dc-location-to-editor-location gx gy)))
+         (define on-it? (box #f))
+         (define pos (find-position x y #f on-it?))
+         (update-hover-position (and (unbox on-it?) pos)))))
 
     (define/public (update-hover-position pos)
       (void))
@@ -100,13 +138,15 @@
     (super-new)))
 
 (define text:hover-drawings-mixin
-  (mixin (text:hover<%>) (text:hover-drawings<%>)
+  (mixin (text:hover<%> text:region-data<%>) (text:hover-drawings<%>)
     (inherit dc-location-to-editor-location
              find-position
-             invalidate-bitmap-cache)
+             invalidate-bitmap-cache
+             get-region-mapping)
+    (super-new)
 
     ;; interval-map of Drawings
-    (define drawings-list (make-numeric-interval-map))
+    (define drawings-list (get-region-mapping 'hover-drawings))
 
     (field [hover-position #f])
 
@@ -118,15 +158,12 @@
         (invalidate-bitmap-cache 0.0 0.0 +inf.0 +inf.0)))
 
     (define/public (add-hover-drawing start end draw [tack-box (box #f)])
-      (let ([drawing (make-drawing start end draw tack-box)])
+      (let ([drawing (make-drawing draw tack-box)])
         (interval-map-cons*! drawings-list
                              start (add1 end)
                              drawing
                              null)))
 
-    (define/public (delete-all-drawings)
-      (interval-map-remove! drawings-list -inf.0 +inf.0))
-
     (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?
@@ -139,9 +176,7 @@
     (define/private (same-drawings? old-pos pos)
       ;; relies on order drawings added & list-of-eq?-struct equality
       (equal? (get-position-drawings old-pos)
-              (get-position-drawings pos)))
-
-    (super-new)))
+              (get-position-drawings pos)))))
 
 (define text:tacking-mixin
   (mixin (text:basic<%> text:hover-drawings<%>) ()
@@ -153,17 +188,26 @@
 
     (define tacked-table (make-hasheq))
 
-    (define/override (on-event ev)
+    (define/override (on-local-event ev)
       (case (send ev get-event-type)
         ((right-down)
          (if (pair? (get-position-drawings hover-position))
              (send (get-canvas) popup-menu
-                   (make-tack/untack-menu)
+                   (make-tack/untack-menu (get-position-drawings hover-position))
                    (send ev get-x)
                    (send ev get-y))
-             (super on-event ev)))
+             (super on-local-event ev)))
         (else
-         (super on-event ev))))
+         (super on-local-event ev))))
+
+    ;; Clear tacked-table on any modification.
+    ;; FIXME: possible to be more precise? (but not needed for macro stepper)
+    (define/augment (after-delete start len)
+      (set! tacked-table (make-hasheq))
+      (inner (void) after-delete start len))
+    (define/augment (after-insert start len)
+      (set! tacked-table (make-hasheq))
+      (inner (void) after-insert start len))
 
     (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)
@@ -171,26 +215,32 @@
         (for ([draw (in-hash-keys tacked-table)])
           (draw this dc left top right bottom dx dy))))
 
-    (define/private (make-tack/untack-menu)
+    (define/private (make-tack/untack-menu drawings)
       (define menu (new popup-menu%))
       (define keymap (get-keymap))
-      (new menu-item% (label "Tack")
-           (parent menu)
-           (callback (lambda _ (tack))))
-      (new menu-item% (label "Untack")
-           (parent menu)
-           (callback (lambda _ (untack))))
+      (define tack-item
+        (new menu-item% (label "Tack")
+             (parent menu)
+             (callback (lambda _ (tack drawings)))))
+      (define untack-item
+        (new menu-item% (label "Untack")
+             (parent menu)
+             (callback (lambda _ (untack drawings)))))
+      (send tack-item enable
+            (for/or ([d (in-list drawings)]) (not (unbox (drawing-tacked? d)))))
+      (send untack-item enable
+            (for/or ([d (in-list drawings)]) (unbox (drawing-tacked? d))))
       (when (is-a? keymap keymap/popup<%>)
         (new separator-menu-item% (parent menu))
         (send keymap add-context-menu-items menu))
       menu)
 
-    (define/private (tack)
-      (for ([d (get-position-drawings hover-position)])
+    (define/private (tack drawings)
+      (for ([d (in-list drawings)])
         (hash-set! tacked-table (drawing-draw d) #t)
         (set-box! (drawing-tacked? d) #t)))
-    (define/private (untack)
-      (for ([d (get-position-drawings hover-position)])
+    (define/private (untack drawings)
+      (for ([d (in-list drawings)])
         (hash-remove! tacked-table (drawing-draw d))
         (set-box! (drawing-tacked? d) #f)))))
 
@@ -200,12 +250,6 @@
              add-hover-drawing
              find-wordbreak)
 
-    (define/public (add-arrow from1 from2 to1 to2 color)
-      (internal-add-arrow from1 from2 to1 to2 color #f))
-
-    (define/public (add-question-arrow from1 from2 to1 to2 color)
-      (internal-add-arrow from1 from2 to1 to2 color #t))
-
     (define/public (add-billboard pos1 pos2 str color-name)
       (define color (send the-color-database find-color color-name))
       (let ([draw 
@@ -224,6 +268,7 @@
                                   [(adj-y) fh]
                                   [(mini) _d])
                        (send* dc
+                         (set-smoothing 'smoothed)
                          (draw-rounded-rectangle
                           (+ x dx)
                           (+ y dy adj-y)
@@ -232,7 +277,7 @@
                          (draw-text str (+ x dx mini) (+ y dy mini adj-y))))))))])
         (add-hover-drawing pos1 pos2 draw)))
 
-    (define/private (internal-add-arrow from1 from2 to1 to2 color-name question?)
+    (define/public (add-arrow from1 from2 to1 to2 color-name label where)
       (define color (send the-color-database find-color color-name))
       (define tack-box (box #f))
       (unless (and (= from1 to1) (= from2 to2))
@@ -240,7 +285,8 @@
                (lambda (text dc left top right bottom dx dy)
                  (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")])
+                              [(fw fh _d _v) (send dc get-text-extent "x")]
+                              [(lw lh ld _V) (send dc get-text-extent (or label "x"))])
                    (with-saved-pen&brush dc
                      (with-saved-text-config dc
                        (send dc set-pen color 1 'solid)
@@ -253,13 +299,17 @@
                                    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)))))))])
+                       (when label
+                         (let* ([lx (+ endx dx fw)]
+                                [ly (- (+ endy dy) fh)])
+                           (send* dc
+                             (set-brush billboard-brush)
+                             (set-font (billboard-font dc))
+                             (set-text-foreground color)
+                             (set-smoothing 'smoothed)
+                             (draw-rounded-rectangle (- lx ld) (- ly ld)
+                                                     (+ lw ld ld) (+ lh ld ld))
+                             (draw-text label lx ly))))))))])
           (add-hover-drawing from1 from2 draw tack-box)
           (add-hover-drawing to1 to2 draw tack-box))))
 
@@ -286,15 +336,65 @@
 
     (super-new)))
 
-(define text:hover-drawings%
-  (text:hover-drawings-mixin
-   (text:hover-mixin
-    text:standard-style-list%)))
+#|
+text:clickregion-mixin
 
-(define text:arrows%
-  (text:arrows-mixin
-   (text:tacking-mixin
-    text:hover-drawings%)))
+Like clickbacks, but:
+  - use interval-map to avoid linear search
+    (major problem w/ macro stepper and large expansions!)
+  - callback takes position of click, not (start, end)
+  - different rules for removal
+  - TODO: extend to double-click
+|#
+(define text:clickregion-mixin
+  (mixin (text:region-data<%>) ()
+    (inherit get-admin
+             get-region-mapping
+             dc-location-to-editor-location
+             find-position)
+
+    (super-new)
+    (define clickbacks (get-region-mapping 'clickregion))
+    (define tracking #f)
+
+    (define/public (set-clickregion start end callback)
+      (if callback
+          (interval-map-set! clickbacks start end callback)
+          (interval-map-remove! clickbacks start end)))
+
+    (define/private (get-event-position ev)
+      (define-values (x y)
+        (let ([gx (send ev get-x)]
+              [gy (send ev get-y)])
+          (dc-location-to-editor-location gx gy)))
+      (define on-it? (box #f))
+      (define pos (find-position x y #f on-it?))
+      (and (unbox on-it?) pos))
+
+    (define/override (on-default-event ev)
+      (define admin (get-admin))
+      (when admin
+        (define pos (get-event-position ev))
+        (case (send ev get-event-type)
+          ((left-down)
+           (set! tracking (and pos (interval-map-ref clickbacks pos #f)))
+           (send admin update-cursor))
+          ((left-up)
+           (when tracking
+             (let ([cb (and pos (interval-map-ref clickbacks pos #f))]
+                   [tracking* tracking])
+               (set! tracking #f)
+               (when (eq? tracking* cb)
+                 (cb pos)))
+             (send admin update-cursor)))))
+      (super on-default-event ev))
+
+    (define/override (adjust-cursor ev)
+      (define pos (get-event-position ev))
+      (define cb (and pos (interval-map-ref clickbacks pos #f)))
+      (if cb
+          arrow-cursor
+          (super adjust-cursor ev)))))
 
 
 #|
@@ -327,3 +427,25 @@
               [else (search (cdr idlocs))])))
     (super-new)))
 |#
+
+
+(define browser-text%
+  (let ([browser-text-default-style-name "widget.rkt::browser-text% basic"])
+    (class (text:clickregion-mixin
+            (text:arrows-mixin
+             (text:tacking-mixin
+              (text:hover-drawings-mixin
+               (text:hover-mixin
+                (text:region-data-mixin
+                 (text:hide-caret/selection-mixin
+                  (text:foreground-color-mixin
+                   (editor:standard-style-list-mixin text:basic%)))))))))
+      (inherit set-autowrap-bitmap get-style-list)
+      (define/override (default-style-name) browser-text-default-style-name)
+      (super-new (auto-wrap #t))
+      (let* ([sl (get-style-list)]
+             [standard (send sl find-named-style (editor:get-default-color-style-name))]
+             [browser-basic (send sl find-or-create-style standard
+                                  (make-object style-delta% 'change-family 'default))])
+        (send sl new-named-style browser-text-default-style-name browser-basic))
+      (set-autowrap-bitmap #f))))
diff --git a/collects/macro-debugger/syntax-browser/util.rkt b/collects/macro-debugger/syntax-browser/util.rkt
index 1c3ad52..2efd494 100644
--- a/collects/macro-debugger/syntax-browser/util.rkt
+++ b/collects/macro-debugger/syntax-browser/util.rkt
@@ -10,13 +10,16 @@
     [(with-unlock text . body)
      (let* ([t text]
             [locked? (send t is-locked?)])
-       (send* t
-         (lock #f)
-         (begin-edit-sequence #f))
-       (begin0 (let () . body)
-         (send* t
-           (end-edit-sequence)
-           (lock locked?))))]))
+       (dynamic-wind
+         (lambda ()
+           (send* t
+             (begin-edit-sequence #f)
+             (lock #f)))
+         (lambda () . body)
+         (lambda ()
+           (send* t
+             (lock locked?)
+             (end-edit-sequence)))))]))
 
 ;; make-text-port : text (-> number) -> port
 ;; builds a port from a text object.  
diff --git a/collects/macro-debugger/syntax-browser/widget.rkt b/collects/macro-debugger/syntax-browser/widget.rkt
index 5aaccbc..fbae429 100644
--- a/collects/macro-debugger/syntax-browser/widget.rkt
+++ b/collects/macro-debugger/syntax-browser/widget.rkt
@@ -1,6 +1,6 @@
 #lang racket/base
 (require racket/class
-         racket/gui
+         racket/gui/base
          racket/list
          racket/match
          framework
@@ -14,6 +14,7 @@
          "properties.rkt"
          "text.rkt"
          "util.rkt"
+         "../util/eomap.rkt"
          "../util/mpi.rkt")
 (provide widget%)
 
@@ -106,87 +107,101 @@
             (send -text change-style clickback-style a b)))))
 
     (define/public (add-syntax stx
-                               #:binders [binders null]
+                               #:binders [binders #f]
                                #:shift-table [shift-table #f]
-                               #:definites [definites null]
+                               #:definites [definites #f]
                                #:hi-colors [hi-colors null]
                                #:hi-stxss [hi-stxss null]
                                #:substitutions [substitutions null])
-      (let ([display (internal-add-syntax stx)]
-            [definite-table (make-hasheq)])
-        (let ([range (send/i display display<%> get-range)]
-              [offset (send/i display display<%> get-start-position)])
-          (for ([subst substitutions])
-            (for ([r (send/i range range<%> get-ranges (car subst))])
-              (with-unlock -text
-                (send -text insert (cdr subst)
-                      (+ offset (car r))
-                      (+ offset (cdr r))
-                      #f)
-                (send -text change-style
-                      (code-style -text (send/i config config<%> get-syntax-font-size))
-                      (+ offset (car r))
-                      (+ offset (cdr r)))))))
-        (for ([hi-stxs hi-stxss] [hi-color hi-colors])
+      (define (get-shifted id) (hash-ref shift-table id null))
+
+      (with-unlock -text
+        (define display
+          (print-syntax-to-editor stx -text controller config
+                                  (calculate-columns)
+                                  (send -text last-position)))
+        (send -text insert "\n")
+        (define range (send/i display display<%> get-range))
+        (define offset (send/i display display<%> get-start-position))
+        (for ([subst (in-list substitutions)])
+          (for ([r (in-list (send/i range range<%> get-ranges (car subst)))])
+            (send -text insert (cdr subst)
+                  (+ offset (car r))
+                  (+ offset (cdr r))
+                  #f)
+            (send -text change-style
+                  (code-style -text (send/i config config<%> get-syntax-font-size))
+                  (+ offset (car r))
+                  (+ offset (cdr r))
+                  #f)))
+        ;; Apply highlighting
+        (for ([hi-stxs (in-list hi-stxss)] [hi-color (in-list hi-colors)])
           (send/i display display<%> highlight-syntaxes hi-stxs hi-color))
-        (for ([definite definites])
-          (hash-set! definite-table definite #t)
-          (when shift-table
-            (for ([shifted-definite (hash-ref shift-table definite null)])
-              (hash-set! definite-table shifted-definite #t))))
-        (let ([binder-table (make-free-id-table)])
-          (define range (send/i display display<%> get-range))
-          (define start (send/i display display<%> get-start-position))
-          (define (get-binders id)
-            (let ([binder (free-id-table-ref binder-table id #f)])
-              (cond [(not binder) null]
-                    [shift-table (cons binder (get-shifted binder))]
-                    [else (list binder)])))
-          (define (get-shifted id)
-            (hash-ref shift-table id null))
-          ;; Populate table
-          (for ([binder binders])
-            (free-id-table-set! binder-table binder binder))
-          ;; Underline binders (and shifted binders)
-          (send/i display display<%> underline-syntaxes
-                 (append (apply append (map get-shifted binders))
-                         binders))
-          ;; Make arrows (& billboards, when enabled)
-          (for ([id (send/i range range<%> get-identifier-list)])
-            (define definite? (hash-ref definite-table id #f))
+        ;; Underline binders (and shifted binders)
+        (send/i display display<%> underline-syntaxes
+                (let ([binder-list (hash-map binders (lambda (k v) k))])
+                  (append (apply append (map get-shifted binder-list))
+                          binder-list)))
+        (send display refresh)
+
+        ;; Make arrows (& billboards, when enabled)
+        (when (send config get-draw-arrows?)
+          (define (definite-phase id)
+            (and definites
+                 (or (eomap-ref definites id #f)
+                     (for/or ([shifted (in-list (hash-ref shift-table id null))])
+                       (eomap-ref definites shifted #f)))))
+
+          (define phase-binder-table (make-hash))
+          (define (get-binder-table phase)
+            (hash-ref! phase-binder-table phase (lambda () (make-free-id-table #:phase phase))))
+          (for ([(binder phase) (in-hash binders)])
+            (free-id-table-set! (get-binder-table phase) binder binder))
+
+          (define (get-binders id phase)
+            (define (for-one-table table id)
+              (let ([binder (free-id-table-ref table id #f)])
+                (cond [(not binder) null]
+                      [shift-table (cons binder (get-shifted binder))]
+                      [else (list binder)])))
+            (cond [phase (for-one-table (get-binder-table phase) id)]
+                  [else
+                   (apply append
+                          (for/list ([table (in-hash-values phase-binder-table)])
+                            (for-one-table table id)))]))
+
+          (for ([id (in-list (send/i range range<%> get-identifier-list))])
+            (define phase (definite-phase id))
             (when #f ;; DISABLED
-              (add-binding-billboard start range id definite?))
-            (for ([binder (get-binders id)])
-              (for ([binder-r (send/i range range<%> get-ranges binder)])
-                (for ([id-r (send/i range range<%> get-ranges id)])
-                  (add-binding-arrow start binder-r id-r definite?))))))
+              (add-binding-billboard offset range id phase))
+            (for ([binder (in-list (get-binders id phase))])
+              (for ([binder-r (in-list (send/i range range<%> get-ranges binder))])
+                (for ([id-r (in-list (send/i range range<%> get-ranges id))])
+                  (add-binding-arrow offset binder-r id-r phase))))))
         (void)))
 
-    (define/private (add-binding-arrow start binder-r id-r definite?)
-      (if definite?
-          (send -text add-arrow
-                (+ start (car binder-r))
-                (+ start (cdr binder-r))
-                (+ start (car id-r))
-                (+ start (cdr id-r))
-                "blue")
-          (send -text add-question-arrow
-                (+ start (car binder-r))
-                (+ start (cdr binder-r))
-                (+ start (car id-r))
-                (+ start (cdr id-r))
-                "purple")))
+    (define/private (add-binding-arrow start binder-r id-r phase)
+      ;; phase = #f means not definite binding (ie, "?" arrow)
+      (send -text add-arrow
+            (+ start (car binder-r))
+            (+ start (cdr binder-r))
+            (+ start (car id-r))
+            (+ start (cdr id-r))
+            (if phase "blue" "purple")
+            (cond [(equal? phase 0) #f]
+                  [phase (format "phase ~s" phase)]
+                  [else "?"])
+            (if phase 'end 'start)))
 
     (define/private (add-binding-billboard start range id definite?)
       (match (identifier-binding id)
         [(list-rest src-mod src-name nom-mod nom-name _)
-         (for-each (lambda (id-r)
-                     (send -text add-billboard
-                           (+ start (car id-r))
-                           (+ start (cdr id-r))
-                           (string-append "from " (mpi->string src-mod))
-                           (if definite? "blue" "purple")))
-                   (send/i range range<%> get-ranges id))]
+         (for ([id-r (in-list (send/i range range<%> get-ranges id))])
+           (send -text add-billboard
+                 (+ start (car id-r))
+                 (+ start (cdr id-r))
+                 (string-append "from " (mpi->string src-mod))
+                 (if definite? "blue" "purple")))]
         [_ (void)]))
 
     (define/public (add-separator)
@@ -197,25 +212,11 @@
 
     (define/public (erase-all)
       (with-unlock -text
-        (send -text erase)
-        (send -text delete-all-drawings))
+        (send -text erase))
       (send/i controller displays-manager<%> remove-all-syntax-displays))
 
     (define/public (get-text) -text)
 
-    ;; internal-add-syntax : syntax -> display
-    (define/private (internal-add-syntax stx)
-      (with-unlock -text
-        (let ([display
-               (print-syntax-to-editor stx -text controller config
-                                       (calculate-columns)
-                                       (send -text last-position))])
-          (send* -text
-            (insert "\n")
-            ;;(scroll-to-position current-position)
-            )
-          display)))
-
     (define/private (calculate-columns)
       (define style (code-style -text (send/i config config<%> get-syntax-font-size)))
       (define char-width (send style get-text-width (send -ecanvas get-dc)))
@@ -246,24 +247,3 @@
     (send sd set-delta 'change-italic)
     (send sd set-delta-foreground "red")
     sd))
-
-;; Specialized classes for widget
-
-(define browser-text%
-  (let ([browser-text-default-style-name "widget.rkt::browser-text% basic"])
-    (class (text:arrows-mixin
-            (text:tacking-mixin
-             (text:hover-drawings-mixin
-              (text:hover-mixin
-               (text:hide-caret/selection-mixin
-                (text:foreground-color-mixin
-                 (editor:standard-style-list-mixin text:basic%)))))))
-      (inherit set-autowrap-bitmap get-style-list)
-      (define/override (default-style-name) browser-text-default-style-name)
-      (super-new (auto-wrap #t))
-      (let* ([sl (get-style-list)]
-             [standard (send sl find-named-style (editor:get-default-color-style-name))]
-             [browser-basic (send sl find-or-create-style standard
-                                  (make-object style-delta% 'change-family 'default))])
-        (send sl new-named-style browser-text-default-style-name browser-basic))
-      (set-autowrap-bitmap #f))))
diff --git a/collects/macro-debugger/util/eomap.rkt b/collects/macro-debugger/util/eomap.rkt
new file mode 100644
index 0000000..1421385
--- /dev/null
+++ b/collects/macro-debugger/util/eomap.rkt
@@ -0,0 +1,140 @@
+#lang racket/base
+(require racket/contract
+         racket/dict
+         racket/match)
+
+#|
+eomap = "extend-only" mapping
+
+Used to represent persistent mappings that are typically extended only once,
+where both lookup and extend must be fast, but no other operations are needed.
+
+Like association list (sharing, fast extend), but lookup is fast too.
+Like immutable hash (fast lookup), but extend (hopefully) involves less allocation.
+
+----
+
+An eomap[K,V] is (eomap store[K,V] timestamp (box timestamp)).
+A store[K,V] is mutable-dict[K, (listof (cons timestamp V))].
+
+A timestamp is either
+  - nat
+  - (cons nat (cons symbol timestamp))
+
+Timestamps are arranged into Branches. The main Branch goes 1, 2, 3 ....
+A box stores the latest timestamp in a Branch.
+If another eomap is branched off of 2, that Branch is tagged (g0 . 2) and
+its successor for 2 is (1 g0 . 2).
+
+Timestamps and branches are compared using eqv?.
+
+Comparison:
+  t1 < nat2 if 
+    - t1 = nat1 < nat2
+  t1 < (nat2 sym2 . bt2) if
+    - t1 = (nat1 sym2 . bt2)    ;; same branch
+      and nat1 < nat2
+    - t1 < bt2, or              ;; less than branch point
+
+====
+
+The data structure works best, of course, when a mapping is extended only once,
+so we can stick to simple numbered timestamps.
+
+An alternative is to make eomaps enforce the extend-once property; so
+instead of branching a second extension just errors.
+
+TODO: check if macro stepper strictly follows extend-once discipline.
+
+|#
+
+(struct eomap (store ts latest))
+
+(define (empty-eomap [store (make-hasheq)])
+  (eomap store 1 (box 1)))
+
+(define (eomap-bump eom)
+  (match eom
+    [(eomap store ts latest)
+     (let-values ([(ts* latest*) (successor ts latest)])
+       (eomap store ts* latest*))]))
+
+(define (eomap-add eom to-add)
+  (let ([eom* (eomap-bump eom)])
+    (match eom*
+      [(eomap store ts latest)
+       (for ([(key value) (in-dict to-add)])
+         (dict-set! store key
+                    (cons (cons ts value) (dict-ref store key null))))])
+    eom*))
+
+(define (eomap-set* eom keys value)
+  (let ([eom* (eomap-bump eom)])
+    (match eom*
+      [(eomap store ts latest)
+       (for ([key (in-list keys)])
+         (dict-set! store key
+                    (cons (cons ts value) (dict-ref store key null))))])
+    eom*))
+
+(define (eomap-ref eom key [default not-given])
+  (match eom
+    [(eomap store ts _latest)
+     (let loop ([ts+value-list (dict-ref store key null)])
+       (cond [(pair? ts+value-list)
+              (let ([entry-ts (car (car ts+value-list))]
+                    [entry-value (cdr (car ts+value-list))])
+                (cond [(t<=? entry-ts ts)
+                       entry-value]
+                      [else (loop (cdr ts+value-list))]))]
+             [else
+              (cond [(eq? default not-given)
+                     (error 'eomap-ref "key not found: ~e" key)]
+                    [(procedure? default) (default)]
+                    [else default])]))]))
+
+(define not-given (gensym 'not-given))
+
+;; Timestamps
+
+(define (successor ts latest)
+  (define (tadd1 ts)
+    (cond [(pair? ts) (cons (add1 (car ts)) (cdr ts))]
+          [else (add1 ts)]))
+  (cond [(eqv? ts (unbox latest))
+         (let ([ts+1 (tadd1 ts)])
+           (set-box! latest ts+1)
+           (values ts+1 latest))]
+        [else
+         (let* ([tag (cons (gensym) ts)]
+                [next (cons 1 tag)])
+           (values next (box next)))]))
+
+(define (t<=? x y)
+  (or (eqv? x y) (t<? x y)))
+
+(define (t<? x y)
+  (match y
+    [(cons yn ytag)
+     (match x
+       [(cons xn (? (lambda (v) (eqv? v ytag))))
+        (< xn yn)]
+       [x
+        (t<? x (cdr ytag))])]
+    [yn
+     (and (number? x)
+          (< x yn))]))
+
+;; ----
+
+(provide/contract
+ [eomap?
+  (-> any/c boolean?)]
+ [empty-eomap
+  (->* () (dict?) eomap?)]
+ [eomap-add
+  (-> eomap? dict? eomap?)]
+ [eomap-set*
+  (-> eomap? list? any/c eomap?)]
+ [eomap-ref
+  (->* (eomap? any/c) (any/c) any)])
diff --git a/collects/macro-debugger/view/debug.rkt b/collects/macro-debugger/view/debug.rkt
index 8ebc9da..6ab15a8 100644
--- a/collects/macro-debugger/view/debug.rkt
+++ b/collects/macro-debugger/view/debug.rkt
@@ -4,7 +4,6 @@
          unstable/class-iop
          "interfaces.rkt"
          "debug-format.rkt"
-         "prefs.rkt"
          "view.rkt")
 (provide debug-file)
 
diff --git a/collects/macro-debugger/view/extensions.rkt b/collects/macro-debugger/view/extensions.rkt
index 61425dc..9c6f240 100644
--- a/collects/macro-debugger/view/extensions.rkt
+++ b/collects/macro-debugger/view/extensions.rkt
@@ -3,21 +3,11 @@
          racket/unit
          racket/list
          racket/match
-         racket/gui
-         framework
+         racket/gui/base
          unstable/class-iop
          "interfaces.rkt"
-         "prefs.rkt"
-         "hiding-panel.rkt"
          (prefix-in s: "../syntax-browser/widget.rkt")
-         (prefix-in s: "../syntax-browser/keymap.rkt")
-         (prefix-in s: "../syntax-browser/interfaces.rkt")
-         "../model/deriv.rkt"
-         "../model/deriv-util.rkt"
-         "../model/trace.rkt"
-         "../model/steps.rkt"
-         "cursor.rkt"
-         unstable/gui/notify)
+         (prefix-in s: "../syntax-browser/keymap.rkt"))
 (provide stepper-keymap%
          stepper-syntax-widget%)
 
@@ -29,6 +19,7 @@
     (inherit-field config
                    controller)
     (inherit add-function
+             map-function
              call-function)
 
     (define show-macro #f)
@@ -39,6 +30,9 @@
     (define/public (get-hiding-panel)
       (send/i macro-stepper widget<%> get-macro-hiding-prefs))
 
+    (map-function ":s" "hiding:show-macro")
+    (map-function ":h" "hiding:hide-macro")
+
     (add-function "hiding:show-macro"
                   (lambda (i e)
                     (send*/i (get-hiding-panel) hiding-prefs<%>
diff --git a/collects/macro-debugger/view/frame.rkt b/collects/macro-debugger/view/frame.rkt
index 3d02a47..180dad6 100644
--- a/collects/macro-debugger/view/frame.rkt
+++ b/collects/macro-debugger/view/frame.rkt
@@ -3,21 +3,15 @@
          racket/unit
          racket/list
          racket/file
+         racket/path
          racket/match
-         racket/gui
+         racket/gui/base
          framework
          unstable/class-iop
          "interfaces.rkt"
          "stepper.rkt"
-         "prefs.rkt"
-         "hiding-panel.rkt"
          (prefix-in sb: "../syntax-browser/embed.rkt")
 	 (prefix-in sb: "../syntax-browser/interfaces.rkt")
-         "../model/deriv.rkt"
-         "../model/deriv-util.rkt"
-         "../model/trace.rkt"
-         "../model/steps.rkt"
-         "cursor.rkt"
          unstable/gui/notify)
 (provide macro-stepper-frame-mixin)
 
@@ -64,7 +58,8 @@
       (send/i config config<%> set-width w)
       (send/i config config<%> set-height h)
       (unless (and (= w0 w) (= h0 h))
-        (send/i widget widget<%> update/preserve-view))
+        (when (send/i config config<%> get-refresh-on-resize?)
+          (send/i widget widget<%> update/preserve-view)))
       (set!-values (w0 h0) (values w h)))
 
     (define warning-panel
@@ -198,26 +193,26 @@
       (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
+                              "Refresh on resize"
+                              (get-field refresh-on-resize? config))
+      (menu-option/notify-box extras-menu
+                              "Draw binding arrows"
+                              (get-field draw-arrows? config))
       (menu-option/notify-box extras-menu
                               "Extra navigation"
-                              (get-field extra-navigation? config))
-      #|
-      (menu-option/notify-box extras-menu
-                              "Suppress warnings"
-                              (get-field suppress-warnings? config))
-      (menu-option/notify-box extras-menu
-                              "(Debug) Catch internal errors?"
-                              (get-field debug-catch-errors? config))
-      |#)
+                              (get-field extra-navigation? config)))
 
     ;; fixup-menu : menu -> void
     ;; Delete separators at beginning/end and duplicates in middle
diff --git a/collects/macro-debugger/view/gui-util.rkt b/collects/macro-debugger/view/gui-util.rkt
new file mode 100644
index 0000000..0967194
--- /dev/null
+++ b/collects/macro-debugger/view/gui-util.rkt
@@ -0,0 +1,105 @@
+#lang racket/base
+(require racket/class
+         racket/gui/base)
+(provide status-area%)
+
+(define FADE-DELAY 1000)
+(define NAP-TIME 0.01)
+
+(define status-area%
+  (class* object% (#| status-area<%> |#)
+    (init parent
+          stop-callback)
+
+    (define lock (make-semaphore 1))
+
+    (define-syntax-rule (with-lock . body)
+      (dynamic-wind (lambda () (yield lock))
+                    (lambda () . body)
+                    (lambda () (semaphore-post lock))))
+
+    (define timer (new timer% (notify-callback (lambda () (fade-out)))))
+
+    (define pane
+      (new horizontal-pane%
+           (parent parent)
+           (stretchable-height #f)))
+    (define message
+      (new message%
+           (parent pane)
+           (label "")
+           (auto-resize #t)
+           (stretchable-width #t)
+           (style '(deleted))))
+    (define stop-button
+      (new button%
+           (parent pane)
+           (label "Stop")
+           (enabled #f)
+           (callback stop-callback)
+           (style '(deleted))))
+
+    (define visible? #t)
+
+    (define/public (set-visible new-visible?)
+      (with-lock
+       (set! visible? new-visible?)
+       (show (memq state '(shown fade)))))
+
+    #|
+    Three states:
+      - 'none    = no message displayed
+      - 'shown   = message displayed
+      - 'fade    = message displayed, waiting to erase
+
+    Timer is only started during 'fade state.
+    |#
+    (define state 'none)
+
+    (define/private (show ?)
+      (send pane change-children
+            (lambda _
+              (if (and ? visible?)
+                  (list message stop-button)
+                  null))))
+
+    (define/public (set-status msg)
+      (with-lock
+       (cond [msg
+              (case state
+                ((none)
+                 (send message set-label msg)
+                 (send message enable #t)
+                 (show #t)
+                 (set! state 'shown))
+                ((shown)
+                 (send message set-label msg))
+                ((fade)
+                 (send timer stop) ;; but (update) may already be waiting
+                 (send message set-label msg)
+                 (send message enable #t)
+                 (set! state 'shown)))]
+             [(not msg)
+              (case state
+                ((shown)
+                 (send timer start FADE-DELAY #t)
+                 (send message enable #f)
+                 (set! state 'fade)))])))
+
+    (define/private (fade-out)
+      (with-lock (fade-out*)))
+
+    (define/private (fade-out*)
+      (case state
+        ((fade)
+         (show #f)
+         (send message set-label "")
+         (set! state 'none))
+        (else
+         ;; timer not stopped in time; do nothing
+         (void))))
+
+    (define/public (enable-stop ?)
+      (send stop-button enable ?))
+
+    (super-new)))
diff --git a/collects/macro-debugger/view/hiding-panel.rkt b/collects/macro-debugger/view/hiding-panel.rkt
index 61d7f42..5442459 100644
--- a/collects/macro-debugger/view/hiding-panel.rkt
+++ b/collects/macro-debugger/view/hiding-panel.rkt
@@ -1,7 +1,8 @@
 #lang racket/base
 (require racket/class
-         racket/gui
+         racket/gui/base
          racket/list
+         racket/match
          unstable/class-iop
          "interfaces.rkt"
          "../model/hiding-policies.rkt"
diff --git a/collects/macro-debugger/view/interfaces.rkt b/collects/macro-debugger/view/interfaces.rkt
index e038725..efd20cb 100644
--- a/collects/macro-debugger/view/interfaces.rkt
+++ b/collects/macro-debugger/view/interfaces.rkt
@@ -4,7 +4,9 @@
 (provide (all-defined-out))
 
 (define-interface config<%> (sb:config<%>)
-  ((sb:methods:notify macro-hiding-mode
+  ((sb:methods:notify draw-arrows?
+                      refresh-on-resize?
+                      macro-hiding-mode
                       show-hiding-panel?
                       identifier=?
                       highlight-foci?
diff --git a/collects/macro-debugger/view/prefs.rkt b/collects/macro-debugger/view/prefs.rkt
index 237d86a..baf5710 100644
--- a/collects/macro-debugger/view/prefs.rkt
+++ b/collects/macro-debugger/view/prefs.rkt
@@ -14,6 +14,8 @@
 (preferences:set-default 'MacroStepper:Frame:Height 600 number?)
 (preferences:set-default 'MacroStepper:PropertiesShown? #f boolean?)
 (preferences:set-default 'MacroStepper:PropertiesPanelPercentage 1/3 number?)
+(preferences:set-default 'MacroStepper:DrawArrows? #t boolean?)
+
 (preferences:set-default 'MacroStepper:MacroHidingMode "Standard" string?)
 (preferences:set-default 'MacroStepper:ShowHidingPanel? #t boolean?)
 (preferences:set-default 'MacroStepper:IdentifierComparison "bound-identifier=?" string?)
@@ -27,11 +29,14 @@
 (preferences:set-default 'MacroStepper:SplitContext? #f boolean?)
 (preferences:set-default 'MacroStepper:MacroStepLimit 40000
                          (lambda (x) (or (eq? x #f) (exact-positive-integer? x))))
+(preferences:set-default 'MacroStepper:RefreshOnResize? #t boolean?)
 
 (define pref:width (pref:get/set 'MacroStepper:Frame:Width))
 (define pref:height (pref:get/set 'MacroStepper:Frame:Height))
 (define pref:props-shown? (pref:get/set 'MacroStepper:PropertiesShown?))
 (define pref:props-percentage (pref:get/set 'MacroStepper:PropertiesPanelPercentage))
+(define pref:draw-arrows? (pref:get/set 'MacroStepper:DrawArrows?))
+
 (define pref:macro-hiding-mode (pref:get/set 'MacroStepper:MacroHidingMode))
 (define pref:show-hiding-panel? (pref:get/set 'MacroStepper:ShowHidingPanel?))
 (define pref:identifier=? (pref:get/set 'MacroStepper:IdentifierComparison))
@@ -44,7 +49,7 @@
 (define pref:debug-catch-errors? (pref:get/set 'MacroStepper:DebugCatchErrors?))
 (define pref:split-context? (pref:get/set 'MacroStepper:SplitContext?))
 (define pref:macro-step-limit (pref:get/set 'MacroStepper:MacroStepLimit))
-
+(define pref:refresh-on-resize? (pref:get/set 'MacroStepper:RefreshOnResize?))
 
 (define macro-stepper-config-base%
   (class* prefs-base% (config<%>)
@@ -58,6 +63,7 @@
       (height pref:height)
       (props-percentage pref:props-percentage)
       (props-shown? pref:props-shown?)
+      (draw-arrows? pref:draw-arrows?)
       (macro-hiding-mode pref:macro-hiding-mode)
       (show-hiding-panel? pref:show-hiding-panel?)
       (identifier=? pref:identifier=?)
@@ -68,7 +74,8 @@
       (one-by-one? pref:one-by-one?)
       (extra-navigation? pref:extra-navigation?)
       (debug-catch-errors? pref:debug-catch-errors?)
-      (split-context? pref:split-context?))
+      (split-context? pref:split-context?)
+      (refresh-on-resize? pref:refresh-on-resize?))
     (super-new)))
 
 (define macro-stepper-config/prefs%
diff --git a/collects/macro-debugger/view/step-display.rkt b/collects/macro-debugger/view/step-display.rkt
index 0e01ccf..51259a6 100644
--- a/collects/macro-debugger/view/step-display.rkt
+++ b/collects/macro-debugger/view/step-display.rkt
@@ -3,23 +3,11 @@
          racket/unit
          racket/list
          racket/match
-         racket/gui
-         framework
+         racket/gui/base
          unstable/class-iop
          "interfaces.rkt"
-         "prefs.rkt"
-         "extensions.rkt"
-         "hiding-panel.rkt"
-         "../model/deriv.rkt"
-         "../model/deriv-util.rkt"
-         "../model/deriv-parser.rkt"
-         "../model/trace.rkt"
-         "../model/reductions-config.rkt"
-         "../model/reductions.rkt"
          "../model/steps.rkt"
-         unstable/gui/notify
 	 (prefix-in sb: "../syntax-browser/interfaces.rkt")
-         "cursor.rkt"
          "debug-format.rkt")
 
 #;
@@ -43,9 +31,13 @@
 
     (define/public (add-internal-error part exn stx events)
       (send/i sbview sb:syntax-browser<%> add-text
-              (if part
-                  (format "Macro stepper error (~a)" part)
-                  "Macro stepper error"))
+              (string-append
+               (if (exn:break? exn)
+                   "Macro stepper was interrupted"
+                   "Macro stepper error")
+               (if part
+                   (format " (~a)" part)
+                   "")))
       (when (exn? exn)
         (send/i sbview sb:syntax-browser<%> add-text " ")
         (send/i sbview sb:syntax-browser<%> add-clickback "[details]"
@@ -56,7 +48,9 @@
       (when stx (send/i sbview sb:syntax-browser<%> add-syntax stx)))
 
     (define/private (show-internal-error-details exn events)
-      (case (message-box/custom "Macro stepper internal error"
+      (case (message-box/custom (if (exn:break? exn)
+                                    "Macro stepper was interrupted"
+                                    "Macro stepper internal error")
                                 (format "Internal error:\n~a" (exn-message exn))
                                 "Show error"
                                 "Dump debugging file"
@@ -90,8 +84,8 @@
              (show-poststep step shift-table)]))
 
     (define/public (add-syntax stx
-                               #:binders [binders null]
-                               #:definites [definites null]
+                               #:binders [binders #f]
+                               #:definites [definites #f]
                                #:shift-table [shift-table #f])
       (send/i sbview sb:syntax-browser<%> add-syntax stx
               #:binders binders
@@ -221,8 +215,8 @@
       (when (exn:fail:syntax? (misstep-exn step))
         (for ([e (exn:fail:syntax-exprs (misstep-exn step))])
           (send/i sbview sb:syntax-browser<%> add-syntax e
-                  #:binders (or (state-binders state) null)
-                  #:definites (or (state-uses state) null)
+                  #:binders (state-binders state)
+                  #:definites (state-uses state)
                   #:shift-table shift-table)))
       (show-lctx step shift-table))
 
@@ -236,8 +230,8 @@
               [(syntax? content)
                (send*/i sbview sb:syntax-browser<%>
                  (add-syntax content
-                             #:binders (or (state-binders state) null)
-                             #:definites (or (state-uses state) null)
+                             #:binders (state-binders state)
+                             #:definites (state-uses state)
                              #:shift-table shift-table)
                  (add-text "\n"))]))
       (show-lctx step shift-table))
@@ -248,7 +242,7 @@
       (define highlight-foci? (send/i config config<%> get-highlight-foci?))
       (define highlight-frontier? (send/i config config<%> get-highlight-frontier?))
       (send/i sbview sb:syntax-browser<%> add-syntax stx
-              #:definites (or definites null)
+              #:definites definites
               #:binders binders
               #:shift-table shift-table
               #:hi-colors (list hi-color
diff --git a/collects/macro-debugger/view/stepper.rkt b/collects/macro-debugger/view/stepper.rkt
index bba35c7..b028065 100644
--- a/collects/macro-debugger/view/stepper.rkt
+++ b/collects/macro-debugger/view/stepper.rkt
@@ -3,11 +3,10 @@
          racket/unit
          racket/list
          racket/match
-         racket/gui
-         framework
+         racket/gui/base
+         racket/pretty
          unstable/class-iop
          "interfaces.rkt"
-         "prefs.rkt"
          "extensions.rkt"
          "hiding-panel.rkt"
          "term-record.rkt"
@@ -15,10 +14,9 @@
 	 (prefix-in sb: "../syntax-browser/interfaces.rkt")
          "../model/deriv.rkt"
          "../model/deriv-util.rkt"
-         "../model/trace.rkt"
-         "../model/reductions.rkt"
-         "../model/steps.rkt"
          "cursor.rkt"
+         "gui-util.rkt"
+         "../syntax-browser/util.rkt"
          unstable/gui/notify
          (only-in mzscheme [#%top-interaction mz-top-interaction]))
 (provide macro-stepper-widget%
@@ -33,6 +31,13 @@
     (init-field config)
     (init-field/i (director director<%>))
 
+    (define frame (send parent get-top-level-window))
+    (define eventspace (send frame get-eventspace))
+
+    (define-syntax-rule (with-eventspace . body)
+      (parameterize ((current-eventspace eventspace))
+        (queue-callback (lambda () . body))))
+
     ;; Terms
 
     ;; all-terms : (list-of TermRecord)
@@ -61,16 +66,17 @@
         (add trec)))
 
     ;; add : TermRecord -> void
-    (define/public (add trec)
-      (set! all-terms (cons trec all-terms))
-      (let ([display-new-term? (cursor:at-end? terms)]
-            [invisible? (send/i trec term-record<%> get-deriv-hidden?)])
-        (unless invisible?
-          (cursor:add-to-end! terms (list trec))
-          (trim-navigator)
-          (if display-new-term?
-              (refresh)
-              (update)))))
+    (define/private (add trec)
+      (with-eventspace
+       (set! all-terms (cons trec all-terms))
+       (let ([display-new-term? (cursor:at-end? terms)]
+             [invisible? (send/i trec term-record<%> get-deriv-hidden?)])
+         (unless invisible?
+           (cursor:add-to-end! terms (list trec))
+           (trim-navigator)
+           (if display-new-term?
+               (refresh)
+               (update))))))
 
     ;; remove-current-term : -> void
     (define/public (remove-current-term)
@@ -103,7 +109,11 @@
       (send/i sbc sb:controller<%> reset-primary-partition)
       (update/preserve-view))
 
-    (define area (new vertical-panel% (parent parent)))
+    (define superarea (new vertical-pane% (parent parent)))
+    (define area
+      (new vertical-panel%
+           (parent superarea)
+           (enabled #f)))
     (define supernavigator
       (new horizontal-panel%
            (parent area)
@@ -135,12 +145,18 @@
       (send/i sbview sb:syntax-browser<%> get-controller))
     (define control-pane
       (new vertical-panel% (parent area) (stretchable-height #f)))
+
     (define/i macro-hiding-prefs hiding-prefs<%>
       (new macro-hiding-prefs-widget%
            (parent control-pane)
            (stepper this)
            (config config)))
 
+    (define status-area
+      (new status-area%
+           (parent superarea)
+           (stop-callback (lambda _ (stop-processing)))))
+
     (send/i sbc sb:controller<%>
            listen-selected-syntax
            (lambda (stx) (send/i macro-hiding-prefs hiding-prefs<%> set-syntax stx)))
@@ -243,28 +259,25 @@
                   (list navigator extra-navigator)
                   (list navigator)))))
 
+    (define/public (change-status msg)
+      (send status-area set-status msg))
+
     ;; Navigation
-#|
-    (define/public-final (at-start?)
-      (send/i (focused-term) term-record<%> at-start?))
-    (define/public-final (at-end?)
-      (send/i (focused-term) term-record<%> at-end?))
-|#
     (define/public-final (navigate-to-start)
       (send/i (focused-term) term-record<%> navigate-to-start)
-      (update/save-position))
+      (update/preserve-lines-view))
     (define/public-final (navigate-to-end)
       (send/i (focused-term) term-record<%> navigate-to-end)
-      (update/save-position))
+      (update/preserve-lines-view))
     (define/public-final (navigate-previous)
       (send/i (focused-term) term-record<%> navigate-previous)
-      (update/save-position))
+      (update/preserve-lines-view))
     (define/public-final (navigate-next)
       (send/i (focused-term) term-record<%> navigate-next)
-      (update/save-position))
+      (update/preserve-lines-view))
     (define/public-final (navigate-to n)
       (send/i (focused-term) term-record<%> navigate-to n)
-      (update/save-position))
+      (update/preserve-lines-view))
 
     (define/public-final (navigate-up)
       (when (focused-term)
@@ -277,108 +290,159 @@
       (cursor:move-next terms)
       (refresh/move))
 
-    ;; Update
+    ;; enable/disable-buttons : -> void
+    (define/private (enable/disable-buttons [? #t])
+      (define term (and ? (focused-term)))
+      ;; (message-box "alert" (format "enable/disable: ~s" ?))
+      (send area enable ?)
+      (send (send frame get-menu-bar) enable ?)
+      (send nav:start enable (and ? term (send/i term term-record<%> has-prev?)))
+      (send nav:previous enable (and ? term (send/i term term-record<%> has-prev?)))
+      (send nav:next enable (and ? term (send/i term term-record<%> has-next?)))
+      (send nav:end enable (and ? term (send/i term term-record<%> has-next?)))
+      (send nav:text enable (and ? term #t))
+      (send nav:up enable (and ? (cursor:has-prev? terms)))
+      (send nav:down enable (and ? (cursor:has-next? terms)))
+      (send status-area enable-stop (not ?)))
 
-    ;; update/save-position : -> void
-    (define/private (update/save-position)
-      (update/preserve-lines-view))
+    ;; Async update & refresh
+
+    (define update-thread #f)
+
+    (define ASYNC-DELAY 500) ;; milliseconds
+
+    (define/private (call-with-update-thread thunk)
+      (send status-area set-visible #f)
+      (let* ([lock (make-semaphore 1)] ;; mutex for status variable
+             [status #f] ;; mutable: one of #f, 'done, 'async
+             [thd
+              (parameterize-break #f
+                (thread (lambda ()
+                          (with-handlers ([exn:break?
+                                           (lambda (e)
+                                             (change-status "Interrupted")
+                                             (void))])
+                            (parameterize-break #t
+                              (thunk)
+                              (change-status #f)))
+                          (semaphore-wait lock)
+                          (case status
+                            ((async)
+                             (set! update-thread #f)
+                             (with-eventspace
+                              (enable/disable-buttons #t)))
+                            (else
+                             (set! status 'done)))
+                          (semaphore-post lock))))])
+        (sync thd (alarm-evt (+ (current-inexact-milliseconds) ASYNC-DELAY)))
+        (semaphore-wait lock)
+        (case status
+          ((done)
+           ;; Thread finished; enable/disable skipped, so do it now to update.
+           (enable/disable-buttons #t))
+          (else
+           (set! update-thread thd)
+           (send status-area set-visible #t)
+           (enable/disable-buttons #f)
+           (set! status 'async)))
+        (semaphore-post lock)))
+
+    (define-syntax-rule (with-update-thread . body)
+      (call-with-update-thread (lambda () . body)))
+
+    (define/private (stop-processing)
+      (let ([t update-thread])
+        (when t (break-thread t))))
+
+    ;; Update
 
     ;; update/preserve-lines-view : -> void
     (define/public (update/preserve-lines-view)
-      (define text (send/i sbview sb:syntax-browser<%> get-text))
-      (define start-box (box 0))
-      (define end-box (box 0))
-      (send text get-visible-line-range start-box end-box)
-      (update)
-      (send text scroll-to-position
-            (send text line-start-position (unbox start-box))
-            #f
-            (send text line-start-position (unbox end-box))
-            'start))
+      (with-update-thread
+       (define text (send/i sbview sb:syntax-browser<%> get-text))
+       (define start-box (box 0))
+       (define end-box (box 0))
+       (send text get-visible-line-range start-box end-box)
+       (update*)
+       (send text scroll-to-position
+             (send text line-start-position (unbox start-box))
+             #f
+             (send text line-start-position (unbox end-box))
+             'start)))
 
     ;; update/preserve-view : -> void
     (define/public (update/preserve-view)
-      (define text (send/i sbview sb:syntax-browser<%> 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) 'start))
+      (with-update-thread
+       (define text (send/i sbview sb:syntax-browser<%> 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) 'start)))
 
     ;; update : -> void
     ;; Updates the terms in the syntax browser to the current step
     (define/private (update)
+      (with-update-thread
+       (update*)))
+
+    (define/private (update*)
+      ;; update:show-prefix : -> void
+      (define (update:show-prefix)
+        ;; Show the final terms from the cached synth'd derivs
+        (for ([trec (in-list (cursor:prefix->list terms))])
+          (send/i trec term-record<%> display-final-term)))
+      ;; update:show-current-step : -> void
+      (define (update:show-current-step)
+        (when (focused-term)
+          (send/i (focused-term) term-record<%> display-step)))
+      ;; update:show-suffix : -> void
+      (define (update:show-suffix)
+        (let ([suffix0 (cursor:suffix->list terms)])
+          (when (pair? suffix0)
+            (for ([trec (in-list (cdr suffix0))])
+              (send/i trec term-record<%> display-initial-term)))))
+      ;; update-nav-index : -> void
+      (define (update-nav-index)
+        (define term (focused-term))
+        (set-current-step-index
+         (and term (send/i term term-record<%> get-step-index))))
+
       (define text (send/i sbview sb:syntax-browser<%> get-text))
       (define position-of-interest 0)
       (define multiple-terms? (> (length (cursor->list terms)) 1))
-      (send text begin-edit-sequence #f)
-      (send/i sbview sb:syntax-browser<%> erase-all)
 
-      (update:show-prefix)
-      (when multiple-terms? (send/i sbview sb:syntax-browser<%> add-separator))
-      (set! position-of-interest (send text last-position))
-      (update:show-current-step)
-      (when multiple-terms? (send/i sbview sb:syntax-browser<%> add-separator))
-      (update:show-suffix)
-      (send text end-edit-sequence)
+      (with-unlock text
+        (send/i sbview sb:syntax-browser<%> erase-all)
+        (update:show-prefix)
+        (when multiple-terms? (send/i sbview sb:syntax-browser<%> add-separator))
+        (set! position-of-interest (send text last-position))
+        (update:show-current-step)
+        (when multiple-terms? (send/i sbview sb:syntax-browser<%> add-separator))
+        (update:show-suffix))
+
       (send text scroll-to-position
             position-of-interest
             #f
             (send text last-position)
             'start)
       (update-nav-index)
-      (enable/disable-buttons))
-
-    ;; update:show-prefix : -> void
-    (define/private (update:show-prefix)
-      ;; Show the final terms from the cached synth'd derivs
-      (for-each (lambda (trec) (send/i trec term-record<%> display-final-term))
-                (cursor:prefix->list terms)))
-
-    ;; update:show-current-step : -> void
-    (define/private (update:show-current-step)
-      (when (focused-term)
-        (send/i (focused-term) term-record<%> display-step)))
-
-    ;; update:show-suffix : -> void
-    (define/private (update:show-suffix)
-      (let ([suffix0 (cursor:suffix->list terms)])
-        (when (pair? suffix0)
-          (for-each (lambda (trec)
-                      (send/i trec term-record<%> display-initial-term))
-                    (cdr suffix0)))))
-
-    ;; update-nav-index : -> void
-    (define/private (update-nav-index)
-      (define term (focused-term))
-      (set-current-step-index
-       (and term (send/i term term-record<%> get-step-index))))
-
-    ;; enable/disable-buttons : -> void
-    (define/private (enable/disable-buttons)
-      (define term (focused-term))
-      (send nav:start enable (and term (send/i term term-record<%> has-prev?)))
-      (send nav:previous enable (and term (send/i term term-record<%> has-prev?)))
-      (send nav:next enable (and term (send/i term term-record<%> has-next?)))
-      (send nav:end enable (and term (send/i term term-record<%> has-next?)))
-      (send nav:text enable (and term #t))
-      (send nav:up enable (cursor:has-prev? terms))
-      (send nav:down enable (cursor:has-next? terms)))
+      (change-status #f))
 
     ;; --
 
     ;; refresh/resynth : -> void
     ;; Macro hiding policy has changed; invalidate cached parts of trec
     (define/public (refresh/resynth)
-      (for-each (lambda (trec) (send/i trec term-record<%> invalidate-synth!))
-                (cursor->list terms))
+      (for ([trec (in-list (cursor->list terms))])
+        (send/i trec term-record<%> invalidate-synth!))
       (refresh))
 
     ;; refresh/re-reduce : -> void
     ;; Reduction config has changed; invalidate cached parts of trec
     (define/private (refresh/re-reduce)
-      (for-each (lambda (trec) (send/i trec term-record<%> invalidate-steps!))
-                (cursor->list terms))
+      (for ([trec (in-list (cursor->list terms))])
+        (send/i trec term-record<%> invalidate-steps!))
       (refresh))
 
     ;; refresh/move : -> void
@@ -388,18 +452,17 @@
 
     ;; refresh : -> void
     (define/public (refresh)
-      (when (focused-term)
-        (send/i (focused-term) term-record<%> on-get-focus))
-      (send nav:step-count set-label "")
-      (let ([term (focused-term)])
-        (when term
-          (let ([step-count (send/i term term-record<%> get-step-count)])
-            (when step-count
-              ;; +1 for end of expansion "step"
-              (send nav:step-count set-label (format "of ~s" (add1 step-count)))))))
-      (update))
-
-    (define/private (foci x) (if (list? x) x (list x)))
+      (with-update-thread
+       (when (focused-term)
+         (send/i (focused-term) term-record<%> on-get-focus))
+       (send nav:step-count set-label "")
+       (let ([term (focused-term)])
+         (when term
+           (let ([step-count (send/i term term-record<%> get-step-count)])
+             (when step-count
+               ;; +1 for end of expansion "step"
+               (send nav:step-count set-label (format "of ~s" (add1 step-count)))))))
+       (update*)))
 
     ;; Hiding policy
     
@@ -415,7 +478,6 @@
     (super-new)
     (show-macro-hiding-panel (send/i config config<%> get-show-hiding-panel?))
     (show-extra-navigation (send/i config config<%> get-extra-navigation?))
-    (refresh/move)
     ))
 
 (define (macro-stepper-widget/process-mixin %)
diff --git a/collects/macro-debugger/view/term-record.rkt b/collects/macro-debugger/view/term-record.rkt
index 44d7a9c..969c49a 100644
--- a/collects/macro-debugger/view/term-record.rkt
+++ b/collects/macro-debugger/view/term-record.rkt
@@ -3,15 +3,11 @@
          racket/unit
          racket/list
          racket/match
-         racket/gui
-         framework
+         racket/gui/base
          syntax/stx
          unstable/find
          unstable/class-iop
          "interfaces.rkt"
-         "prefs.rkt"
-         "extensions.rkt"
-         "hiding-panel.rkt"
          "step-display.rkt"
          "../model/deriv.rkt"
          "../model/deriv-util.rkt"
@@ -20,9 +16,7 @@
          "../model/reductions-config.rkt"
          "../model/reductions.rkt"
          "../model/steps.rkt"
-         unstable/gui/notify
-         "cursor.rkt"
-         "debug-format.rkt")
+         "cursor.rkt")
 
 (provide term-record%)
 
@@ -38,7 +32,7 @@
       (send/i stepper widget<%> get-step-displayer))
 
     ;; Data
-    
+
     (init-field [events #f])
 
     (init-field [raw-deriv #f])
@@ -58,9 +52,15 @@
     (define steps #f)
 
     ;; --
-    
+
     (define steps-position #f)
 
+    (define/private (status msg)
+      (send stepper change-status msg))
+    (define-syntax-rule (with-status msg . body)
+      (begin (send stepper change-status msg)
+             (begin0 (let () . body))))
+
     (super-new)
 
     (define-syntax define-guarded-getters
@@ -120,22 +120,24 @@
         (with-handlers ([(lambda (e) #t)
                          (lambda (e)
                            (set! raw-deriv-oops e))])
-          (set! raw-deriv
-                (parse-derivation
-                 (events->token-generator events))))))
+          (with-status "Parsing expansion derivation"
+            (set! raw-deriv
+                  (parse-derivation
+                   (events->token-generator events)))))))
 
     ;; recache-deriv! : -> void
     (define/private (recache-deriv!)
       (unless (or deriv deriv-hidden?)
         (recache-raw-deriv!)
         (when raw-deriv
-          (let ([process (send/i stepper widget<%> get-preprocess-deriv)])
-            (let ([d (process raw-deriv)])
-              (when (not d)
-                (set! deriv-hidden? #t))
-              (when d
-                (set! deriv d)
-                (set! shift-table (compute-shift-table d))))))))
+          (with-status "Processing expansion derivation"
+            (let ([process (send/i stepper widget<%> get-preprocess-deriv)])
+              (let ([d (process raw-deriv)])
+                (when (not d)
+                  (set! deriv-hidden? #t))
+                (when d
+                  (set! deriv d)
+                  (set! shift-table (compute-shift-table d)))))))))
 
     ;; recache-synth! : -> void
     (define/private (recache-synth!)
@@ -146,38 +148,40 @@
       (unless (or raw-steps raw-steps-oops)
         (recache-synth!)
         (when deriv
-          (let ([show-macro? (or (send/i stepper widget<%> get-show-macro?)
-                                 (lambda (id) #t))])
-            (with-handlers ([(lambda (e) #t)
-                             (lambda (e)
-                               (set! raw-steps-oops e))])
-              (let-values ([(raw-steps* binders* definites* estx* error*)
-                            (parameterize ((macro-policy show-macro?))
-                              (reductions+ deriv))])
-                (set! raw-steps raw-steps*)
-                (set! raw-steps-estx estx*)
-                (set! raw-steps-exn error*)
-                (set! raw-steps-binders binders*)
-                (set! raw-steps-definites definites*)))))))
+          (with-status "Computing reduction steps"
+            (let ([show-macro? (or (send/i stepper widget<%> get-show-macro?)
+                                   (lambda (id) #t))])
+              (with-handlers ([(lambda (e) #t)
+                               (lambda (e)
+                                 (set! raw-steps-oops e))])
+                (let-values ([(raw-steps* binders* definites* estx* error*)
+                              (parameterize ((macro-policy show-macro?))
+                                (reductions+ deriv))])
+                  (set! raw-steps raw-steps*)
+                  (set! raw-steps-estx estx*)
+                  (set! raw-steps-exn error*)
+                  (set! raw-steps-binders binders*)
+                  (set! raw-steps-definites definites*))))))))
 
     ;; recache-steps! : -> void
     (define/private (recache-steps!)
       (unless (or steps)
         (recache-raw-steps!)
         (when raw-steps
-          (set! steps
-                (and raw-steps
-                     (let* ([filtered-steps 
-                             (if (send/i config config<%> get-show-rename-steps?)
-                                 raw-steps
-                                 (filter (lambda (x) (not (rename-step? x)))
-                                         raw-steps))]
-                            [processed-steps
-                             (if (send/i config config<%> get-one-by-one?)
-                                 (reduce:one-by-one filtered-steps)
-                                 filtered-steps)])
-                       (cursor:new processed-steps))))
-          (restore-position))))
+          (with-status "Processing reduction steps"
+            (set! steps
+                  (and raw-steps
+                       (let* ([filtered-steps 
+                               (if (send/i config config<%> get-show-rename-steps?)
+                                   raw-steps
+                                   (filter (lambda (x) (not (rename-step? x)))
+                                           raw-steps))]
+                              [processed-steps
+                               (if (send/i config config<%> get-one-by-one?)
+                                   (reduce:one-by-one filtered-steps)
+                                   filtered-steps)])
+                         (cursor:new processed-steps))))
+            (restore-position)))))
 
     ;; reduce:one-by-one : (list-of step) -> (list-of step)
     (define/private (reduce:one-by-one rs)
@@ -274,37 +278,40 @@
 
     ;; display-initial-term : -> void
     (define/public (display-initial-term)
-      (cond [raw-deriv-oops
-             (send/i displayer step-display<%> add-internal-error
-                     "derivation" raw-deriv-oops #f events)]
-            [else
-             (send/i displayer step-display<%> add-syntax (wderiv-e1 deriv))]))
+      (with-status "Rendering term"
+        (cond [raw-deriv-oops
+               (send/i displayer step-display<%> add-internal-error
+                       "derivation" raw-deriv-oops #f events)]
+              [else
+               (send/i displayer step-display<%> add-syntax (wderiv-e1 deriv))])))
 
     ;; display-final-term : -> void
     (define/public (display-final-term)
       (recache-steps!)
-      (cond [(syntax? raw-steps-estx)
-             (send/i displayer step-display<%> add-syntax raw-steps-estx
-                     #:binders raw-steps-binders
-                     #:shift-table shift-table
-                     #:definites raw-steps-definites)]
-            [(exn? raw-steps-exn)
-             (send/i displayer step-display<%> add-error raw-steps-exn)]
-            [else (display-oops #f)]))
+      (with-status "Rendering term"
+        (cond [(syntax? raw-steps-estx)
+               (send/i displayer step-display<%> add-syntax raw-steps-estx
+                       #:binders raw-steps-binders
+                       #:shift-table shift-table
+                       #:definites raw-steps-definites)]
+              [(exn? raw-steps-exn)
+               (send/i displayer step-display<%> add-error raw-steps-exn)]
+              [else (display-oops #f)])))
 
     ;; display-step : -> void
     (define/public (display-step)
       (recache-steps!)
-      (cond [steps
-             (let ([step (cursor:next steps)])
-               (if step
-                   (send/i displayer step-display<%> add-step step
-                           #:shift-table shift-table)
-                   (send/i displayer step-display<%> add-final raw-steps-estx raw-steps-exn
-                           #:binders raw-steps-binders
-                           #:shift-table shift-table
-                           #:definites raw-steps-definites)))]
-            [else (display-oops #t)]))
+      (with-status "Rendering step"
+        (cond [steps
+               (let ([step (cursor:next steps)])
+                 (if step
+                     (send/i displayer step-display<%> add-step step
+                             #:shift-table shift-table)
+                     (send/i displayer step-display<%> add-final raw-steps-estx raw-steps-exn
+                             #:binders raw-steps-binders
+                             #:shift-table shift-table
+                             #:definites raw-steps-definites)))]
+              [else (display-oops #t)])))
 
     ;; display-oops : boolean -> void
     (define/private (display-oops show-syntax?)
diff --git a/collects/macro-debugger/view/view.rkt b/collects/macro-debugger/view/view.rkt
index 4552b48..5fec952 100644
--- a/collects/macro-debugger/view/view.rkt
+++ b/collects/macro-debugger/view/view.rkt
@@ -1,7 +1,7 @@
 #lang racket/base
 (require racket/class
          racket/pretty
-         racket/gui
+         racket/gui/base
          framework
          unstable/class-iop
          "interfaces.rkt"
@@ -9,8 +9,7 @@
          "prefs.rkt"
          "../model/trace.rkt")
 (provide macro-stepper-director%
-         macro-stepper-frame%
-         go)
+         macro-stepper-frame%)
 
 (define macro-stepper-director%
   (class* object% (director<%>)
@@ -24,24 +23,26 @@
       (hash-remove! stepper-frames s))
 
     (define/public (add-obsoleted-warning)
-      (hash-for-each stepper-frames
-                     (lambda (stepper-frame flags)
-                       (unless (memq 'no-obsolete flags)
-                         (send/i stepper-frame stepper-frame<%> add-obsoleted-warning)))))
+      (for ([(stepper-frame flags) (in-hash stepper-frames)])
+        (unless (memq 'no-obsolete flags)
+          (send/i stepper-frame stepper-frame<%> add-obsoleted-warning))))
     (define/public (add-trace events)
-      (hash-for-each stepper-frames
-                     (lambda (stepper-frame flags)
-                       (unless (memq 'no-new-traces flags)
-                         (send/i (send/i stepper-frame stepper-frame<%> get-widget) widget<%>
-                                add-trace events)))))
+      (for ([(stepper-frame flags) (in-hash stepper-frames)])
+        (unless (memq 'no-new-traces flags)
+          (send/i (send/i stepper-frame stepper-frame<%> get-widget) widget<%>
+                  add-trace events))))
     (define/public (add-deriv deriv)
-      (hash-for-each stepper-frames
-                     (lambda (stepper-frame flags)
-                       (unless (memq 'no-new-traces flags)
-                         (send/i (send/i stepper-frame stepper-frame<%> get-widget) widget<%>
-                                add-deriv deriv)))))
+      (for ([(stepper-frame flags) (in-hash stepper-frames)])
+        (unless (memq 'no-new-traces flags)
+          (send/i (send/i stepper-frame stepper-frame<%> get-widget) widget<%>
+                  add-deriv deriv))))
 
+    ;; PRE: current thread = current eventspace's handler thread
     (define/public (new-stepper [flags '()])
+      (unless (eq? (current-thread)
+                   (eventspace-handler-thread (current-eventspace)))
+        (error 'macro-stepper-director
+               "new-stepper method called from wrong thread"))
       (define stepper-frame (new-stepper-frame))
       (define stepper (send/i stepper-frame stepper-frame<%> get-widget))
       (send stepper-frame show #t)
@@ -59,11 +60,3 @@
   (macro-stepper-frame-mixin
    (frame:standard-menus-mixin
     (frame:basic-mixin frame%))))
-
-;; Main entry points
-
-(define (go stx)
-  (define director (new macro-stepper-director%))
-  (define stepper (send/i director director<%> new-stepper))
-  (send/i director director<%> add-deriv (trace stx))
-  (void))