diff --git a/collects/stepper/view-controller.ss b/collects/stepper/view-controller.ss
new file mode 100644
index 0000000000..ff88b74eea
--- /dev/null
+++ b/collects/stepper/view-controller.ss
@@ -0,0 +1,390 @@
+#lang scheme/unit
+
+(require scheme/class
+         scheme/match
+         scheme/list
+         drscheme/tool
+         mred
+         string-constants
+         scheme/async-channel
+         (prefix-in model: "private/model.ss")
+         (prefix-in x: "private/mred-extensions.ss")
+         "private/shared.ss"
+         "private/model-settings.ss"
+         "xml-sig.ss")
+
+(import drscheme:tool^ xml^ stepper-frame^)
+(export view-controller^)
+
+(define drscheme-eventspace (current-eventspace))
+
+(define (definitions-text->settings definitions-text)
+  (send definitions-text get-next-settings))
+
+(define (settings->language-level settings)
+    (drscheme:language-configuration:language-settings-language settings))
+  
+;; the stored representation of a step
+(define-struct step (text kind posns) #:transparent)
+
+(define (go drscheme-frame program-expander selection-posn)
+  
+  ;; get the language-level name:
+  (define language-settings (definitions-text->settings (send drscheme-frame get-definitions-text)))
+  (define language-level
+    (settings->language-level language-settings))
+  
+  ;; VALUE CONVERSION CODE:
+  
+  (define simple-settings
+    (drscheme:language-configuration:language-settings-settings
+     language-settings))
+  
+  ;; render-to-string : TST -> string
+  (define (render-to-string val)
+    (let ([string-port (open-output-string)])
+      (send language-level render-value val simple-settings string-port)
+      (get-output-string string-port)))
+  
+  ;; render-to-sexp : TST -> sexp
+  (define (render-to-sexp val)
+    (send language-level stepper:render-to-sexp val simple-settings language-level))
+  
+  ;; channel for incoming views
+  (define view-channel (make-async-channel))
+  
+  ;; the semaphore associated with the view at the end of the
+  ;; view-history note that because these are fresh semaphores for every
+  ;; step, posting to a semaphore multiple times is no problem.
+  (define release-for-next-step #f)
+  
+  ;; the list of available views
+  (define view-history null)
+  
+  ;; the view in the stepper window
+  (define view #f)
+  
+  ;; whether the stepper is waiting for a new view to become available
+  ;; possible values: #f, or a predicate on steps.
+  (define stepper-is-waiting? (lambda (x) #t))
+  
+  ;; hand-off-and-block : (-> text%? boolean? void?)
+  ;; hand-off-and-block generates a new semaphore, hands off a thunk to
+  ;; drscheme's eventspace, and blocks on the new semaphore.  The thunk
+  ;; adds the text% to the waiting queue, and checks to see if the
+  ;; stepper is waiting for a new step.  If so, takes that new text% out
+  ;; of the queue and puts it on the list of available ones.  If the
+  ;; stepper is waiting for a new step, it checks to see whether this is
+  ;; of the kind that the stepper wants.  If so, display it.  otherwise,
+  ;; release the stepped program to continue execution.
+  (define (hand-off-and-block text kind posns)
+    (let ([new-semaphore (make-semaphore)])
+      (run-on-drscheme-side
+       (lambda ()
+         (async-channel-put view-channel
+                            (list (make-step text kind posns) new-semaphore))
+         (match stepper-is-waiting?
+           [#f (void)]
+           [step-pred 
+            (match (async-channel-try-get view-channel)
+             [#f (error
+                  'check-for-stepper-waiting
+                  "queue is empty, even though a step was just added")]
+             [(list new-step semaphore)
+              (add-view-step new-step semaphore)
+              (cond [(step-pred new-step)
+                     ;; got the desired step; show the user:
+                     (begin (set! stepper-is-waiting? #f)
+                            (update-view/existing (- (length view-history) 1)))]
+                    [else 
+                     ;; nope, keep running:
+                     (begin (if (eq? (step-kind new-step) 'finished-stepping)
+                                (begin (message-box "Ran out of steps"
+                                                    "Reached the end of evaluation before finding the kind of step you were looking for.")
+                                       (update-view/existing (- (length view-history) 1)))
+                                (semaphore-post semaphore)))])])])))
+      (semaphore-wait new-semaphore)))
+  
+  ;; run-on-drscheme-side : runs a thunk in the drscheme eventspace.
+  ;; Passed to 'go' so that display-break-stuff can work.  This would be
+  ;; cleaner with two-way provides.
+  (define (run-on-drscheme-side thunk)
+    (parameterize ([current-eventspace drscheme-eventspace])
+      (queue-callback thunk)))
+  
+  
+  ;; add-view-triple : set the release-semaphore to be the new one, add
+  ;; the view to the list.
+  (define (add-view-step view-step semaphore)
+    (set! release-for-next-step semaphore)
+    (set! view-history (append view-history (list view-step)))
+    (update-status-bar))
+  
+  ;; find-later-step : given a predicate on history-entries, search through
+  ;; the history for the first step that satisfies the predicate and whose 
+  ;; number is greater than n (or -1 if n is #f), return # of step on success,
+  ;; on failure return 'nomatch or 'nomatch/seen-final if we went past the final step
+  (define (find-later-step p n)
+    (let* ([n-as-num (or n -1)])
+      (let loop ([step 0] 
+                 [remaining view-history]
+                 [seen-final? #f])
+        (cond [(null? remaining) (cond [seen-final? 'nomatch/seen-final]
+                                       [else 'nomatch])]
+              [(and (> step n-as-num) (p (car remaining))) step]
+              [else (loop (+ step 1) 
+                          (cdr remaining)
+                          (or seen-final? (finished-stepping-step? (car remaining))))]))))
+  
+  ;; find-later-step/boolean : similar, but just return #f or #t.
+  (define (find-later-step/boolean p n)
+    (number? (find-later-step p n)))
+  
+  ;; find-earlier-step : like find-later-step, but searches backward from
+  ;; the given step.
+  (define (find-earlier-step p n)
+    (unless (number? n)
+      (error 'find-earlier-step "can't find earlier step when no step is displayed."))
+    (let* ([to-search (reverse (take view-history n))])
+      (let loop ([step (- n 1)]
+                 [remaining to-search])
+        (cond [(null? remaining) #f]
+              [(p (car remaining)) step]
+              [else (loop (- step 1) (cdr remaining))]))))
+  
+  
+  ;; STEP PREDICATES:
+  
+  ;; is this an application step?
+  (define (application-step? history-entry)
+    (match history-entry
+      [(struct step (text (or 'user-application 'finished-stepping) posns)) #t]
+      [else #f]))
+  
+  ;; is this the finished-stepping step?
+  (define (finished-stepping-step? history-entry)
+    (match (step-kind history-entry)
+      ['finished-stepping #t]
+      [else #f]))
+  
+  ;; is this step on the selected expression?
+  (define (selected-exp-step? history-entry)
+    (member selection-posn (step-posns history-entry)))
+  
+  
+  ;; build gui object:
+  
+
+  ;; next-of-specified-kind : starting at the current view, search forward for the
+  ;; desired step or wait for it if not found
+  (define (next-of-specified-kind right-kind?)
+    (next-of-specified-kind/helper right-kind? view))
+  
+  ;; first-of-specified-kind : similar to next-of-specified-kind, but always start at zero
+  (define (first-of-specified-kind right-kind?)
+    (next-of-specified-kind/helper right-kind? #f))
+  
+  ;; next-of-specified-kind/helper : if the desired step is already in the list, display
+  ;; it; otherwise, wait for it.
+  (define (next-of-specified-kind/helper right-kind? starting-step)
+    (set! stepper-is-waiting? #f)
+    (match (find-later-step right-kind? starting-step)
+      [(? number? n)
+       (update-view/existing n)]
+      ['nomatch
+       (begin
+            ;; each step has its own semaphore, so releasing one twice is
+            ;; no problem.
+            (semaphore-post release-for-next-step)
+            (when stepper-is-waiting?
+              (error 'try-to-get-view
+                     "try-to-get-view should not be reachable when already waiting for new step"))
+            (let ([wait-for-it (lambda ()
+                                 (set! stepper-is-waiting? right-kind?)
+                                 (en/dis-able-buttons))])
+              (match (async-channel-try-get view-channel)
+                [(list new-step semaphore)
+                 (add-view-step new-step semaphore)
+                 (if (right-kind? (list-ref view-history (+ view 1)))
+                     (update-view/existing (+ view 1))
+                     (wait-for-it))]
+                [#f (wait-for-it)])))]
+      ['nomatch/seen-final
+       (message-box "Step Not Found"
+                    "Couldn't find a step matching that criterion.")
+       (update-view/existing (- (length view-history) 1))]))
+  
+  ;; prior-of-specified-kind: if the desired step is already in the list, display
+  ;; it; otherwise, put up a dialog and jump to the first step.
+  (define (prior-of-specified-kind right-kind?)
+    (set! stepper-is-waiting? #f)
+    (let* ([found-step (find-earlier-step right-kind? view)])
+      (if found-step
+          (update-view/existing found-step)
+          (begin
+            (message-box "Step Not Found"
+                         "Couldn't find an earlier step matching that criterion.")
+            (update-view/existing 0)))))
+  
+  ;; BUTTON/CHOICE BOX PROCEDURES
+ 
+  
+  ;; respond to a click on the "next" button
+  (define (next)
+    (next-of-specified-kind (lambda (x) #t)))
+  
+  ;; respond to a click on the "next application" button
+  (define (next-application)
+    (next-of-specified-kind application-step?))
+  
+  ;; respond to a click on the "Jump To..." choice
+  (define (jump-to control event)
+    ((second (list-ref pulldown-choices (send control get-selection)))))
+  
+  ;; previous : the action of the 'previous' button
+  (define (previous)
+    (prior-of-specified-kind (lambda (x) #t)))
+  
+  ;; previous-application : the action of the 'previous-application'
+  ;; button
+  (define (previous-application)
+    (prior-of-specified-kind application-step?))
+
+  ;; jump-to-beginning : the action of the choice menu entry
+  (define (jump-to-beginning)
+    (set! stepper-is-waiting? #f)
+    (update-view/existing 0))
+  
+  ;; jump-to-end : the action of the choice menu entry
+  (define (jump-to-end)
+    (next-of-specified-kind finished-stepping-step?))
+
+  ;; jump-forward-to-selected : the action of the choice menu entry
+  (define (jump-to-selected)
+    (first-of-specified-kind selected-exp-step?))
+  
+  ;; jump-back-to-selection : the action of the choice menu entry
+  (define (jump-back-to-selection)
+    (prior-of-specified-kind selected-exp-step?))
+  
+  ;; GUI ELEMENTS:
+  (define s-frame
+    (make-object stepper-frame% drscheme-frame))
+  (define button-panel
+    (make-object horizontal-panel% (send s-frame get-area-container)))
+  (define (add-button name fun)
+    (make-object button% name button-panel (lambda (_1 _2) (fun))))
+  (define (add-choice-box name fun)
+    (new choice% [label "Jump..."]
+         [choices (map first pulldown-choices)]
+         [parent button-panel]
+         [callback fun]))
+  
+  (define pulldown-choices
+    `(("to beginning"             ,jump-to-beginning)
+      ("to end"                   ,jump-to-end)
+      ("to beginning of selected" ,jump-to-selected)))
+  
+  (define previous-application-button (add-button (string-constant stepper-previous-application) previous-application))
+  (define previous-button             (add-button (string-constant stepper-previous) previous))
+  (define next-button                 (add-button (string-constant stepper-next) next))
+  (define next-application-button     (add-button (string-constant stepper-next-application) next-application))
+  (define jump-button                 (add-choice-box (string-constant stepper-jump) jump-to))
+    
+  (define canvas
+    (make-object x:stepper-canvas% (send s-frame get-area-container)))
+  
+  ;; counting steps...
+  (define status-text
+    (new text%))
+  (define _1 (send status-text insert ""))
+  
+  (define status-canvas
+    (new editor-canvas%
+         [parent button-panel]
+         [editor status-text]
+         [style '(transparent no-border no-hscroll no-vscroll)]
+         ;; some way to get the height of a line of text?
+         [min-width 100]))
+
+  
+  ;; update-view/existing : set an existing step as the one shown in the
+  ;; frame
+  (define (update-view/existing new-view)
+    (set! view new-view)
+    (let ([e (step-text (list-ref view-history view))])
+      (send e begin-edit-sequence)
+      (send canvas set-editor e)
+      (send e reset-width canvas)
+      (send e set-position (send e last-position))
+      (update-status-bar)
+      (send e end-edit-sequence))
+    (en/dis-able-buttons))
+  
+  (define (update-status-bar)
+    (send status-text delete 0 (send status-text last-position))
+    (send status-text insert (format "~a/~a" view (length view-history))))
+  
+  ;; en/dis-able-buttons : set enable & disable the stepper buttons,
+  ;; based on view-controller state
+  (define (en/dis-able-buttons)
+    (let* ([can-go-back? (and view (> view 0))])
+      (send previous-button enable can-go-back?)
+      (send previous-application-button enable can-go-back?)
+      (send next-button
+            enable (or (find-later-step/boolean (lambda (x) #t) view)
+                       (not stepper-is-waiting?)))
+      (send next-application-button
+            enable (or (find-later-step/boolean application-step? view)
+                       (not stepper-is-waiting?)))))
+  
+  (define (print-current-view item evt)
+    (send (send canvas get-editor) print))
+  
+  ;; receive-result takes a result from the model and renders it
+  ;; on-screen. Runs on the user thread.
+  ;; : (step-result -> void)
+  (define (receive-result result)
+    (match-let*
+        ([(list step-text step-kind posns)
+          (match result
+            [(struct before-after-result (pre-exps post-exps kind pre-src post-src))
+             (list (new x:stepper-text% [left-side pre-exps] [right-side post-exps]) kind (list pre-src post-src))]
+            [(struct before-error-result (pre-exps err-msg pre-src))
+             (list (new x:stepper-text% [left-side pre-exps] [right-side err-msg]) #f (list pre-src))]
+            [(struct error-result (err-msg))
+             (list (new x:stepper-text% [left-side null] [right-side err-msg]) #f (list))]
+            [(struct finished-stepping ())
+             (list x:finished-text 'finished-stepping (list))])])
+      (hand-off-and-block step-text step-kind posns)))
+  
+  ;; need to capture the custodian as the thread starts up:
+  (define (program-expander-prime init iter)
+    (program-expander
+     (lambda args
+       (send s-frame set-custodian! (current-custodian))
+       (apply init args))
+     iter))
+  
+  ;; CONFIGURE GUI ELEMENTS
+  (send s-frame set-printing-proc print-current-view)
+  (send button-panel stretchable-width #f)
+  (send button-panel stretchable-height #f)
+  (send canvas stretchable-height #t)
+  (en/dis-able-buttons)
+  (send (send s-frame edit-menu:get-undo-item) enable #f)
+  (send (send s-frame edit-menu:get-redo-item) enable #f)
+  
+  ;; START THE MODEL
+  (model:go
+   program-expander-prime receive-result
+   (get-render-settings render-to-string render-to-sexp 
+                        (send language-level stepper:enable-let-lifting?))
+   (send language-level stepper:show-lambdas-as-lambdas?)
+   language-level
+   run-on-drscheme-side
+   #f)
+  (send s-frame show #t)
+  
+  s-frame)
+