From 9ce9194139d28f40137a8ca29b7ae23f1362c62c Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Thu, 14 Dec 2006 21:25:21 +0000
Subject: [PATCH] Merged changes to macro-debugger from /branches/ryanc/md5
 4899:5119   updated to change in expansion of lexical variables   many UI
 updates and tweaks   improved syntax properties panel   added expand-only and
 expand/hide   added rudimentary textual stepper   fixed PR 8395 by adding
 snipclass for hrule-snip   fixed PR 8431: reductions and block splicing  
 fixed PR 8433: handling unquote and macro hiding w/ errors in hidden terms

svn: r5120

original commit: 056683743d998145deb4b2e82fa8fc73507ed7e3
---
 collects/macro-debugger/expand.ss             |  33 +++-
 collects/macro-debugger/model/deriv-parser.ss |  22 ++-
 collects/macro-debugger/model/reductions.ss   |  39 +++--
 collects/macro-debugger/model/stx-util.ss     |   9 --
 collects/macro-debugger/stepper-text.ss       | 139 +++++++++++++++++
 collects/macro-debugger/stepper.ss            |   9 ++
 .../syntax-browser/hrule-snip.ss              |  25 ++-
 .../macro-debugger/syntax-browser/keymap.ss   | 144 ++++++++++-------
 .../syntax-browser/partition.ss               |  16 +-
 .../syntax-browser/pretty-helper.ss           |  51 ++++--
 .../syntax-browser/pretty-printer.ss          |   4 +-
 .../syntax-browser/properties.ss              | 147 ++++++++++++------
 .../syntax-browser/syntax-snip.ss             |  19 ++-
 .../macro-debugger/syntax-browser/util.ss     |   2 +-
 .../macro-debugger/syntax-browser/widget.ss   |  91 +++++------
 collects/macro-debugger/view/hiding-panel.ss  |  83 +++++-----
 collects/macro-debugger/view/interfaces.ss    |  19 ++-
 collects/macro-debugger/view/prefs.ss         |   9 ++
 18 files changed, 599 insertions(+), 262 deletions(-)
 create mode 100644 collects/macro-debugger/stepper-text.ss
 create mode 100644 collects/macro-debugger/stepper.ss

diff --git a/collects/macro-debugger/expand.ss b/collects/macro-debugger/expand.ss
index 1d52b22..46acecb 100644
--- a/collects/macro-debugger/expand.ss
+++ b/collects/macro-debugger/expand.ss
@@ -1,9 +1,32 @@
 
 (module expand mzscheme
-  (require (lib "unitsig.ss"))
-  (require "view/view.ss")
+  (require "model/trace.ss"
+           "model/hide.ss")
+  (provide expand-only
+           expand/hide)
+  
   (provide expand/step)
-
-  (define (expand/step stx)
-    (go stx))
+  (define (expand/step . args)
+    (apply (dynamic-require '(lib "stepper.ss" "macro-debugger") 'expand/step)
+           args))
+  
+  (define (expand-only stx show-list)
+    (define (show? id)
+      (ormap (lambda (x) (module-identifier=? id x))
+             show-list))
+    (expand/hiding stx show?))
+  
+  (define (expand/hide stx hide-list)
+    (define (show? id)
+      (andmap (lambda (x) (not (module-identifier=? id x)))
+              hide-list))
+    (expand/hiding stx show?))
+  
+  (define (expand/hiding stx show?)
+    (let-values ([(result deriv) (trace/result stx)])
+      (when (exn? result)
+        (raise result))
+      (let-values ([(_d estx) (hide/policy deriv show?)])
+        estx)))
+  
   )
diff --git a/collects/macro-debugger/model/deriv-parser.ss b/collects/macro-debugger/model/deriv-parser.ss
index 4cf815a..7b528d1 100644
--- a/collects/macro-debugger/model/deriv-parser.ss
+++ b/collects/macro-debugger/model/deriv-parser.ss
@@ -60,6 +60,8 @@
         $2]
        [(visit (? TaggedPrimStep 'prim) return)
         ($2 $1)]
+       [(visit VariableStep return)
+        ($2 $1 $3)]
        [((? EE/Macro))
         $1])
       (EE/Macro
@@ -127,9 +129,10 @@
       ;; MacroStep Answer = Transformation (I,E)
       (MacroStep 
        [(Resolves enter-macro 
+         (! 'bad-transformer)
          macro-pre-transform (? LocalActions 'locals) (! 'transform) macro-post-transform 
          exit-macro)
-        (make-transformation $2 $7 $1 $3 $6 $4)])
+        (make-transformation $2 $8 $1 $4 $7 $5)])
 
       ;; Local actions taken by macro
       ;; LocalAction Answer = (list-of LocalAction)
@@ -163,10 +166,14 @@
       (PrimStep
        (#:no-wrap)
        [(Resolves NoError enter-prim (? Prim) exit-prim)
-        ($4 $3 $5 $1)]
-       [(Resolves variable)
-        (make-p:variable (car $2) (cdr $2) $1)])
+        ($4 $3 $5 $1)])
 
+      (VariableStep
+       (#:no-wrap)
+       (#:args e1 e2)
+       [(Resolves variable)
+        (make-p:variable e1 e2 $1)])
+      
       ;; Tagged Primitive syntax
       ;; TaggedPrimStep Answer = syntax -> PRule
       (TaggedPrimStep
@@ -174,6 +181,8 @@
        (#:args orig-stx)
        [(Resolves ! IMPOSSIBLE)
         (make-p:unknown orig-stx #f $1)]
+       [(Resolves NoError enter-prim ! IMPOSSIBLE)
+        (make-p:unknown orig-stx #f $1)]
        [(Resolves NoError enter-prim (? TaggedPrim) exit-prim)
         ($4 orig-stx $5 $1 $3)])
 
@@ -234,7 +243,10 @@
 
       (Prim#%ModuleBegin
        (#:args e1 e2 rs)
-       [(prim-#%module-begin ! (? ModulePass1 'pass1) next-group (? ModulePass2 'pass2))
+       [(prim-#%module-begin (! 'malformed)
+                             (? ModulePass1 'pass1) next-group 
+                             (? ModulePass2 'pass2)
+                             (! 'provides))
         (make-p:#%module-begin e1 e2 rs $3 $5)])
 
       (ModulePass1
diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.ss
index 69e51a3..4f550d1 100644
--- a/collects/macro-debugger/model/reductions.ss
+++ b/collects/macro-debugger/model/reductions.ss
@@ -29,7 +29,9 @@
 
       ;; Primitives
       [(struct p:variable (e1 e2 rs))
-       null]
+       (if (bound-identifier=? e1 e2)
+           null
+           (list (walk e1 e2 "Resolve variable (remove extra marks)")))]
       [(IntQ p:module (e1 e2 rs #f body))
        (with-syntax ([(?module name language . BODY) e1])
          (let ([ctx (lambda (x) (d->so e1 `(,#'?module ,#'name ,#'language ,x)))]
@@ -42,21 +44,19 @@
          (let ([ctx (lambda (x) (d->so e1 `(,#'?module ,#'name ,#'language ,x)))])
            (with-context ctx
              (reductions body))))]
-      [(IntQ p:#%module-begin (e1 e2 rs pass1 pass2))
-       #;(R e1 (?module-begin . MBODY)
-            [! exni 'blah]
-            [ModulePass1 MBODY pass1]
-            => (lambda (e1prime)
-                 (R e1prime (?module-begin2 . MBODY2)
-                    [ModulePass2 MBODY2 pass2])))
+      [(AnyQ p:#%module-begin (e1 e2 rs pass1 pass2))
        (with-syntax ([(?#%module-begin form ...) e1])
-         (let-values ([(reductions1 final-stxs1)
-                       (with-context (lambda (x) (d->so e1 (cons #'?#%module-begin x)))
-                         (mbrules-reductions pass1 (syntax->list #'(form ...)) #t))])
-           (let-values ([(reductions2 final-stxs2)
-                         (with-context (lambda (x) (d->so e1 (cons #'?#%module-begin x)))
-                           (mbrules-reductions pass2 final-stxs1 #f))])
-             (append reductions1 reductions2))))]
+         (let ([frame (lambda (x) (d->so e1 (cons #'?#%module-begin x)))])
+           (let-values ([(reductions1 final-stxs1)
+                         (with-context frame
+                           (mbrules-reductions pass1 (syntax->list #'(form ...)) #t))])
+             (let-values ([(reductions2 final-stxs2)
+                           (with-context frame
+                             (mbrules-reductions pass2 final-stxs1 #f))])
+               (if (error-wrap? d)
+                   (append reductions1 reductions2 
+                           (list (stumble (frame final-stxs2) (error-wrap-exn d))))
+                   (append reductions1 reductions2))))))]
       [(AnyQ p:define-syntaxes (e1 e2 rs rhs) exni)
        (R e1 _
           [! exni]
@@ -269,7 +269,8 @@
       
       [#f null]
       
-      #;[else (error 'reductions "unmatched case: ~s" d)]))
+      #;
+      [else (error 'reductions "unmatched case: ~s" d)]))
 
   ;; reductions-transformation : Transformation -> ReductionSequence
   (define (reductions-transformation tx)
@@ -279,6 +280,8 @@
                (list (walk e1 e2 "Macro transformation")))]
       [(IntW transformation (e1 e2 rs me1 me2 locals) 'locals)
        (reductions-locals e1 locals)]
+      [(ErrW transformation (e1 e2 rs me1 me2 locals) 'bad-transformer exn)
+       (list (stumble e1 exn))]
       [(ErrW transformation (e1 e2 rs me1 me2 locals) 'transform exn)
        (append (reductions-locals e1 locals)
                (list (stumble e1 exn)))]))
@@ -374,7 +377,9 @@
         [(cons (struct b:splice (renames head tail)) next)
          (loop next tail prefix
                (cons (list (walk/foci (deriv-e2 head)
-                                      (take-until tail (stx-cdr suffix))
+                                      (stx-take tail
+                                                (- (stx-improper-length tail)
+                                                   (stx-improper-length (stx-cdr suffix))))
                                       (E (revappend prefix 
                                                     (cons (deriv-e2 head) (stx-cdr suffix))))
                                       (E (revappend prefix tail))
diff --git a/collects/macro-debugger/model/stx-util.ss b/collects/macro-debugger/model/stx-util.ss
index 56339f4..1c34aaf 100644
--- a/collects/macro-debugger/model/stx-util.ss
+++ b/collects/macro-debugger/model/stx-util.ss
@@ -80,15 +80,6 @@
     (cond [(zero? n) null]
           [else (cons (stx-car items) (stx-take (stx-cdr items) (sub1 n)))]))
 
-  (define *args* #f)
-  
-  (define (take-until stxs tail)
-    (set! *args* (list stxs tail))
-    (let loop ([stxs stxs])
-      (if (eq? stxs tail)
-          null
-          (cons (stx-car stxs) (loop (stx-cdr stxs))))))
-  
   (define (stx-improper-length stx)
     (if (stx-pair? stx)
         (add1 (stx-improper-length (stx-cdr stx)))
diff --git a/collects/macro-debugger/stepper-text.ss b/collects/macro-debugger/stepper-text.ss
new file mode 100644
index 0000000..acef02d
--- /dev/null
+++ b/collects/macro-debugger/stepper-text.ss
@@ -0,0 +1,139 @@
+
+(module stepper-text mzscheme 
+  (require (lib "list.ss")
+           (lib "pretty.ss")
+           "model/trace.ss"
+           "model/steps.ss"
+           "model/hide.ss"
+           "model/hiding-policies.ss"
+           "syntax-browser/partition.ss"
+           "syntax-browser/pretty-helper.ss")
+  (provide expand/step-text
+           stepper-text)
+
+  (define expand/step-text
+    (case-lambda 
+     [(stx) (expand/step-text stx #f)]
+     [(stx show)
+      (define s (stepper-text stx (->show-function show)))
+      (s 'all)]))
+  
+  (define stepper-text
+    (case-lambda
+     [(stx) (internal-stepper stx #f)]
+     [(stx show) (internal-stepper stx (->show-function show))]))
+  
+  ;; internal procedures
+
+  (define (internal-stepper stx show?)
+    (define steps (get-steps stx show?))
+    (define used-steps null)
+    (define partition (new-bound-partition))
+    (define dispatch
+      (case-lambda
+       [() (dispatch 'next)]
+       [(sym)
+        (case sym
+          ((next)
+           (if (pair? steps)
+               (begin (show-step (car steps) partition)
+                      (set! used-steps (cons (car steps) used-steps))
+                      (set! steps (cdr steps)))
+               #f))
+          ((prev)
+           (if (pair? used-steps)
+               (begin (show-step (car used-steps) partition)
+                      (set! steps (cons (car used-steps) steps))
+                      (set! used-steps (cdr used-steps)))
+               #f))
+          ((all)
+           (when (pair? steps)
+             (dispatch 'next)
+             (dispatch 'all))))]))
+    dispatch)
+  
+  (define (get-steps stx show?)
+    (define deriv (trace stx))
+    (define hderiv
+      (if show? (hide/policy deriv show?) deriv))
+    (define (ok? x)
+      (or (rewrite-step? x) (misstep? x)))
+    (filter ok? (reductions hderiv)))
+  
+  (define (show-step step partition)
+    (cond [(step? step)
+           (display (step-note step))
+           (newline)
+           (show-term (step-e1 step) partition)
+           (display "  ==>")
+           (newline)
+           (show-term (step-e2 step) partition)
+           (newline)]
+          [(misstep? step)
+           (display (exn-message (misstep-exn step)))
+           (newline)
+           (show-term (misstep-e1 step) partition)]))
+
+  (define (show-term stx partition)
+    (define-values (datum flat=>stx stx=>flat)
+      (table stx partition 0 'always))
+    (define identifier-list 
+      (filter identifier? (hash-table-map stx=>flat (lambda (k v) k))))
+    (define (pp-size-hook obj display-like? port)
+      (cond [(syntax-dummy? obj)
+             (let ((ostring (open-output-string)))
+               ((if display-like? display write)
+                (syntax-dummy-val obj)
+                ostring)
+               (string-length (get-output-string ostring)))]
+            [else #f]))
+    (define (pp-print-hook obj display-like? port)
+      (cond [(syntax-dummy? obj)
+             ((if display-like? display write) (syntax-dummy-val obj) port)]
+            [else 
+             (error 'pretty-print-hook "unexpected special value: ~e" obj)]))
+    (define (pp-extend-style-table)
+      (let* ([ids identifier-list]
+             [syms (map (lambda (x) (hash-table-get stx=>flat x)) ids)]
+             [like-syms (map syntax-e ids)])
+        (pretty-print-extend-style-table (pp-better-style-table)
+                                         syms
+                                         like-syms)))
+    (define (pp-better-style-table)
+      (pretty-print-extend-style-table (pretty-print-current-style-table)
+                                       (map car extended-style-list)
+                                       (map cdr extended-style-list)))
+    (parameterize 
+     ([pretty-print-size-hook pp-size-hook]
+      [pretty-print-print-hook pp-print-hook]
+      [pretty-print-current-style-table (pp-extend-style-table)]
+      ;; Printing parameters (mzscheme manual 7.9.1.4)
+      [print-unreadable #t]
+      [print-graph #f]
+      [print-struct #f]
+      [print-box #t]
+      [print-vector-length #t]
+      [print-hash-table #f]
+      [print-honu #f])
+     (pretty-print datum)))
+     
+  (define (->show-function show)
+    (cond [(procedure? show)
+           show]
+          [(list? show)
+           (lambda (id)
+             (ormap (lambda (x) (module-identifier=? x id))
+                    show))]
+          [(hiding-policy? show)
+           (lambda (x) (policy-show-macro? show x))]
+          [(eq? show #f)
+           #f]
+          [else
+           (error 'expand/trace-text
+                  "expected procedure or list of identifiers for macros to show; got: ~e"
+                  show)]))
+
+  (define extended-style-list
+    '((define-values          . define)
+      (define-syntaxes        . define-syntax)))
+  )
\ No newline at end of file
diff --git a/collects/macro-debugger/stepper.ss b/collects/macro-debugger/stepper.ss
new file mode 100644
index 0000000..cc3d64d
--- /dev/null
+++ b/collects/macro-debugger/stepper.ss
@@ -0,0 +1,9 @@
+
+(module stepper mzscheme
+  (require "view/view.ss")
+  (provide expand/step)
+  
+  (define (expand/step stx)
+    (go stx))
+  
+  )
diff --git a/collects/macro-debugger/syntax-browser/hrule-snip.ss b/collects/macro-debugger/syntax-browser/hrule-snip.ss
index 9d3ce56..fb45593 100644
--- a/collects/macro-debugger/syntax-browser/hrule-snip.ss
+++ b/collects/macro-debugger/syntax-browser/hrule-snip.ss
@@ -16,7 +16,7 @@
                 [ad-y (box 0)])
             (send (get-admin) get-view-size ad-x ad-y)
             #;(set-box?! bw fw)
-            (set-box?! bw (unbox ad-x))
+            (set-box?! bw (max 0 (- (unbox ad-x) (get-xheight dc))))
             (set-box?! bh h))))
       (define/override (draw dc x y left top right bottom dx dy draw-caret)
         (let* [(xh (get-xheight dc))
@@ -30,5 +30,28 @@
               (set! cached-xheight h)
               h)))
       (define cached-xheight #f)
+
+      ;; Snip methods
+      (define/override (copy)
+        (new hrule-snip%))
+      (define/override (write stream)
+        (void))
+      (inherit set-snipclass)
+      (super-new)
+
+      (set-snipclass snip-class)))
+
+
+  (define hrule-snipclass%
+    (class snip-class%
+      (define/override (read stream)
+        (let ([str (send stream get-bytes)])
+          (new hrule-snip%)))
       (super-new)))
+  
+  (define snip-class (new hrule-snipclass%))
+  (send snip-class set-version 1)
+  (send snip-class set-classname
+        (format "~s" '(lib "hrule-snip.ss" "macro-debugger" "syntax-browser")))
+  (send (get-the-snip-class-list) add snip-class)
   )
diff --git a/collects/macro-debugger/syntax-browser/keymap.ss b/collects/macro-debugger/syntax-browser/keymap.ss
index 503c056..79e8480 100644
--- a/collects/macro-debugger/syntax-browser/keymap.ss
+++ b/collects/macro-debugger/syntax-browser/keymap.ss
@@ -8,72 +8,30 @@
   (provide keymap@
            context-menu@)
   
-  (define keymap@
-    (unit/sig keymap^
-      (import)
-      
-      (define syntax-keymap%
-        (class keymap%
-          (init editor)
-          (init-field context-menu)
-          
-          (inherit add-function
-                   map-function
-                   chain-to-keymap)
-          (super-new)
-          
-          ;; Initialization
-          (map-function "rightbutton" "popup-context-window")
-          (add-function "popup-context-window"
-                        (lambda (editor event)
-                          (do-popup-context-window editor event)))
-          
-          ;; Attach to editor
-          (chain-to-keymap (send editor get-keymap) #t)
-          (send editor set-keymap this)
-          
-          (define/private (do-popup-context-window editor event)
-            (define-values (x y)
-              (send editor dc-location-to-editor-location
-                    (send event get-x)
-                    (send event get-y)))
-            (define admin (send editor get-admin))
-            (send admin popup-menu context-menu x y))))))
-  
   (define context-menu@
     (unit/sig context-menu^
-      (import snip^)
+      (import)
 
       (define context-menu%
         (class popup-menu%
+          (init-field keymap)
           (init-field controller)
           (super-new)
-
-          (define copy-menu #f)
-          (define copy-syntax-menu #f)
-          (define clear-menu #f)
+          
+          (field [copy-menu #f]
+                 [copy-syntax-menu #f]
+                 [clear-menu #f]
+                 [props-menu #f])
           
           (define/public (add-edit-items)
             (set! copy-menu
                   (new menu-item% (label "Copy") (parent this)
                        (callback (lambda (i e)
-                                   (define stx (send controller get-selected-syntax))
-                                   (send the-clipboard set-clipboard-string
-                                         (if stx 
-                                             (format "~s" (syntax-object->datum stx))
-                                             "")
-                                         (send e get-time-stamp))))))
+                                   (send keymap call-function "copy-text" i e)))))
             (set! copy-syntax-menu
                   (new menu-item% (label "Copy syntax") (parent this)
                        (callback (lambda (i e)
-                                   (define stx (send controller get-selected-syntax))
-                                   (define t (new text%))
-                                   (send t insert
-                                         (new syntax-snip%
-                                              (syntax stx)
-                                              #;(controller controller)))
-                                   (send t select-all)
-                                   (send t copy)))))
+                                   (send keymap call-function "copy-syntax" i e)))))
             (void))
 
           (define/public (after-edit-items)
@@ -84,7 +42,16 @@
                   (new menu-item%
                        (label "Clear selection")
                        (parent this)
-                       (callback (lambda _ (send controller select-syntax #f)))))
+                       (callback 
+                        (lambda (i e)
+                          (send keymap call-function "clear-syntax-selection" i e)))))
+            (set! props-menu
+                  (new menu-item%
+                       (label "Show syntax properties")
+                       (parent this)
+                       (callback 
+                        (lambda (i e) 
+                          (send keymap call-function "show-syntax-properties" i e)))))
             (void))
           
           (define/public (after-selection-items)
@@ -113,7 +80,7 @@
 
           (define/public (add-separator)
             (new separator-menu-item% (parent this)))
-
+          
           (define/override (on-demand)
             (define stx (send controller get-selected-syntax))
             (send copy-menu enable (and stx #t))
@@ -134,4 +101,75 @@
           (after-partition-items)
 
           ))))
+  
+  (define keymap@
+    (unit/sig keymap^
+      (import context-menu^ snip^)
+      
+      (define syntax-keymap%
+        (class keymap%
+          (init editor)
+          (init-field controller)
+          
+          (inherit add-function
+                   map-function
+                   chain-to-keymap)
+          (super-new)
+          
+          (define context-menu (make-context-menu))
+          
+          (define/public (make-context-menu)
+            (new context-menu% (controller controller) (keymap this)))
+          
+          ;; Key mappings
+
+          (map-function "rightbutton" "popup-context-window")
+          
+          ;; Functionality
+          
+          (add-function "popup-context-window"
+                        (lambda (editor event)
+                          (do-popup-context-window editor event)))
+          
+          (add-function "copy-text"
+                        (lambda (_ event)
+                          (define stx (send controller get-selected-syntax))
+                          (send the-clipboard set-clipboard-string
+                                (if stx 
+                                    (format "~s" (syntax-object->datum stx))
+                                    "")
+                                (send event get-time-stamp))))
+          
+          (add-function "copy-syntax"
+                        (lambda (_ event)
+                          (define stx (send controller get-selected-syntax))
+                          (define t (new text%))
+                          (send t insert
+                                (new syntax-snip%
+                                     (syntax stx)))
+                          (send t select-all)
+                          (send t copy)))
+          
+          (add-function "clear-syntax-selection"
+                        (lambda (i e)
+                          (send controller select-syntax #f)))
+          
+          (add-function "show-syntax-properties"
+                        (lambda (i e)
+                          (error 'show-syntax-properties "not provided by this keymap")))
+          
+          ;; Attach to editor
+
+          (chain-to-keymap (send editor get-keymap) #t)
+          (send editor set-keymap this)
+          
+          (define/public (get-controller) controller)
+          
+          (define/private (do-popup-context-window editor event)
+            (define-values (x y)
+              (send editor dc-location-to-editor-location
+                    (send event get-x)
+                    (send event get-y)))
+            (define admin (send editor get-admin))
+            (send admin popup-menu context-menu x y))))))
   )
diff --git a/collects/macro-debugger/syntax-browser/partition.ss b/collects/macro-debugger/syntax-browser/partition.ss
index 8a25624..3adc7e4 100644
--- a/collects/macro-debugger/syntax-browser/partition.ss
+++ b/collects/macro-debugger/syntax-browser/partition.ss
@@ -9,10 +9,7 @@
            identifier=-choices)
   
   (define (new-bound-partition)
-    #;(define p (new partition% (relation id:same-marks?)))
-    (define p (new bound-partition%))
-    (send p get-partition (datum->syntax-object #f 'no-marks))
-    p)
+    (new bound-partition%))
   
   ;; representative-symbol : symbol
   ;; Must be fresh---otherwise, using it could detect rename wraps 
@@ -74,7 +71,8 @@
          rep=>num
          (lambda (k v)
            (printf "~s => ~s~n" k v))))
-      
+
+      (get-partition unmarked-syntax)
       (super-new)
       ))
   
@@ -90,8 +88,9 @@
                [n (bound-identifier-mapping-get numbers r (lambda _ #f))])
           (or n
               (begin0 next-number
-                      (bound-identifier-mapping-put! numbers r next-number)
-                      (set! next-number (add1 next-number))))))
+                (bound-identifier-mapping-put! numbers r next-number)
+                #;(printf "primary partition new stx:~n~s~n~s~n" stx (syntax-object->datum stx))
+                (set! next-number (add1 next-number))))))
       
       (define/public (same-partition? a b)
         (= (get-partition a) (get-partition b)))
@@ -101,7 +100,8 @@
       
       (define/private (representative stx)
         (datum->syntax-object stx representative-symbol))
-      
+
+      (get-partition unmarked-syntax)
       (super-new)))
   
   ;; Different identifier relations for highlighting.
diff --git a/collects/macro-debugger/syntax-browser/pretty-helper.ss b/collects/macro-debugger/syntax-browser/pretty-helper.ss
index e9cc88d..12766e0 100644
--- a/collects/macro-debugger/syntax-browser/pretty-helper.ss
+++ b/collects/macro-debugger/syntax-browser/pretty-helper.ss
@@ -19,11 +19,16 @@
   
   (define-struct syntax-dummy (val))
   
-  ;; syntax->datum/tables : stx [partition% num boolean]
+  ;; A SuffixOption is one of
+  ;; - 'never             -- never
+  ;; - 'always            -- suffix > 0
+  ;; - 'over-limit        -- suffix > limit
+  ;; - 'all-if-over-limit -- suffix > 0 if any over limit
+  
+  ;; syntax->datum/tables : stx [partition% num SuffixOption]
   ;;                        -> (values s-expr hashtable hashtable)
   ;; When partition is not false, tracks the partititions that subterms belong to
   ;; When limit is a number, restarts processing with numbering? set to true
-  ;; When numbering? is true, suffixes identifiers with partition numbers.
   ;; 
   ;; Returns three values:
   ;;   - an S-expression
@@ -32,18 +37,23 @@
   ;; Syntax objects which are eq? will map to same flat values
   (define syntax->datum/tables
     (case-lambda
-      [(stx) (table stx #f #f #f)]
-      [(stx partition limit numbering?) (table stx partition limit numbering?)]))
+      [(stx) (table stx #f #f 'never)]
+      [(stx partition limit suffixopt) (table stx partition limit suffixopt)]))
   
-  ;; table : syntax partition%-or-#f num-or-#f -> (values s-expr hashtable hashtable)
-  (define (table stx partition limit numbering?)
+  ;; table : syntax maybe-partition% maybe-num SuffixOption -> (values s-expr hashtable hashtable)
+  (define (table stx partition limit suffixopt)
     (define (make-identifier-proxy id)
-      (let ([n (send partition get-partition id)])
-        (cond [(or (zero? n) (not numbering?))
-               (string->uninterned-symbol (symbol->string (syntax-e id)))]
-              [else
-               (string->uninterned-symbol
-                (format "~a:~a" (syntax-e id) n))])))
+      (case suffixopt
+        ((never) (unintern (syntax-e id)))
+        ((always)
+         (let ([n (send partition get-partition id)])
+           (if (zero? n) (unintern (syntax-e id)) (suffix (syntax-e id) n))))
+        ((over-limit)
+         (let ([n (send partition get-partition id)])
+           (if (<= n limit)
+               (unintern (syntax-e id))
+               (suffix (syntax-e id) n))))))
+    
     (let/ec escape
       (let ([flat=>stx (make-hash-table)]
             [stx=>flat (make-hash-table)])
@@ -51,10 +61,11 @@
           (cond [(hash-table-get stx=>flat obj (lambda _ #f))
                  => (lambda (datum) datum)]
                 [(and partition (identifier? obj))
+                 (when (and (eq? suffixopt 'all-if-over-limit)
+                            (> (send partition count) limit))
+                   (call-with-values (lambda () (table stx partition #f 'always))
+                                     escape))
                  (let ([lp-datum (make-identifier-proxy obj)])
-                   (when (and limit (> (send partition count) limit))
-                     (call-with-values (lambda () (table stx partition #f #t))
-                       escape))
                    (hash-table-put! flat=>stx lp-datum obj)
                    (hash-table-put! stx=>flat obj lp-datum)
                    lp-datum)]
@@ -69,8 +80,7 @@
                 [(vector? obj) 
                  (list->vector (map loop (vector->list obj)))]
                 [(symbol? obj)
-                 ;(make-syntax-dummy obj)
-                 (string->uninterned-symbol (symbol->string obj))]
+                 (unintern obj)]
                 [(number? obj)
                  (make-syntax-dummy obj)]
                 [(box? obj)
@@ -90,4 +100,11 @@
         (values (loop stx)
                 flat=>stx
                 stx=>flat))))
+
+  (define (unintern sym)
+    (string->uninterned-symbol (symbol->string sym)))
+  
+  (define (suffix sym n)
+    (string->uninterned-symbol (format "~a:~a" sym n)))
+
   )
diff --git a/collects/macro-debugger/syntax-browser/pretty-printer.ss b/collects/macro-debugger/syntax-browser/pretty-printer.ss
index 1cd5d36..1260952 100644
--- a/collects/macro-debugger/syntax-browser/pretty-printer.ss
+++ b/collects/macro-debugger/syntax-browser/pretty-printer.ss
@@ -97,7 +97,9 @@
       ;; recompute-tables : -> void
       (define/private (recompute-tables)
         (set!-values (datum ht:flat=>stx ht:stx=>flat)
-                     (syntax->datum/tables main-stx primary-partition 12 #f))
+                     (syntax->datum/tables main-stx primary-partition
+                                           (length (current-colors))
+                                           (current-suffix-option)))
         (set! identifier-list 
               (filter identifier? (hash-table-map ht:stx=>flat (lambda (k v) k)))))
 
diff --git a/collects/macro-debugger/syntax-browser/properties.ss b/collects/macro-debugger/syntax-browser/properties.ss
index 00965ea..24ea7e3 100644
--- a/collects/macro-debugger/syntax-browser/properties.ss
+++ b/collects/macro-debugger/syntax-browser/properties.ss
@@ -12,10 +12,12 @@
       (init parent)
       (define selected-syntax #f)
       
+      (define tab-choices (get-tab-choices))
       (define tab-panel (new tab-panel% 
-                             (choices (list "Binding" "Source" "Properties"))
+                             (choices (map car tab-choices))
                              (parent parent)
                              (callback (lambda _ (refresh)))))
+      
       (define text (new text%))
       (send text set-styles-sticky #f)
       (define ecanvas (new editor-canvas% (editor text) (parent tab-panel)))
@@ -24,63 +26,106 @@
         (set! selected-syntax stx)
         (refresh))
       
+      ;; get-tab-choices : (listof (cons string thunk))
+      ;; Override to add or remove panels
+      (define/public (get-tab-choices)
+        (list (cons "Term" (lambda () (display-meaning-info)))
+              (cons "Syntax Object" (lambda () (display-stxobj-info)))))
+      
       (define/private (refresh)
         (send* text
           (lock #f)
           (begin-edit-sequence)
           (erase))
         (when (syntax? selected-syntax)
-          (let ([s (send tab-panel get-item-label (send tab-panel get-selection))])
-            (cond [(equal? s "Binding")
-                   (display-binding-info)]
-                  [(equal? s "Source")
-                   (display-source-info)]
-                  [(equal? s "Properties")
-                   (display-properties)])))
+          (let ([tab (send tab-panel get-item-label (send tab-panel get-selection))])
+            (cond [(assoc tab tab-choices) => (lambda (p) ((cdr p)))]
+                  [else (error 'properties-view%:refresh "internal error: no such tab: ~s" tab)])))
         (send* text
           (end-edit-sequence)
           (lock #t)
           (scroll-to-position 0)))
 
+      (define/pubment (display-meaning-info)
+        (when (and (identifier? selected-syntax)
+                   (uninterned? (syntax-e selected-syntax)))
+          (display "Uninterned symbol!\n\n" key-sd))
+        (display-binding-info)
+        (inner (void) display-meaning-info))
+      
+      
       (define/private (display-binding-info)
-        (for-each (lambda (p) (display-binding-kv (car p) ((cdr p) selected-syntax)))
-                  binding-properties))
-
-      (define/private (display-binding-kv k v)
-        (display (format "~a~n" k) key-sd)
-        (cond [(eq? v 'lexical)
-               (display "lexical\n" #f)]
-              [(eq? v #f)
-               (display "#f (top-level or unbound)\n" #f)]
+        (display "Apparent identifier binding\n" key-sd)
+        (unless (identifier? selected-syntax)
+          (display "Not applicable\n\n" n/a-sd))
+        (when (identifier? selected-syntax)
+          (if (eq? (identifier-binding selected-syntax) 'lexical)
+              (display "lexical (all phases)\n" #f)
+              (for-each (lambda (p) (display-binding-kvs (car p) ((cdr p) selected-syntax)))
+                        binding-properties))
+          (display "\n" #f)))
+      
+      (define/private (display-binding-kvs k v)
+        (display k sub-key-sd)
+        (display "\n" #f)
+        (cond [(eq? v #f)
+               (display "  top-level or unbound\n" #f)]
               [(list? v)
-               (display-subkv "source module" (mpi->string (list-ref v 0)))
-               (display-subkv "source id" (list-ref v 1))
-               (display-subkv "nom. module" (mpi->string (list-ref v 2)))
-               (display-subkv "nom. id" (list-ref v 3))
+               (display-subkv "  defined in" (mpi->string (list-ref v 0)))
+               (display-subkv "  as" (list-ref v 1))
+               (display-subkv "  imported from" (mpi->string (list-ref v 2)))
+               (display-subkv "  as" (list-ref v 3))
                (if (list-ref v 4)
-                   (display-subkv "phase" "via define-for-syntax"))]
-              [(void? v)
-               (display "Not applicable\n" n/a-sd)])
-        (display "\n" #f))
+                   (display "  via define-for-syntax" sub-key-sd))]))
+        
+      (define/pubment (display-stxobj-info)
+        (display-source-info)
+        (display-extra-source-info)
+        (inner (void) display-stxobj-info)
+        (display-symbol-property-info))
 
-      (define/private (display-subkv k v)
-        (display (format "~a: " k) sub-key-sd)
-        (display (format "~a~n" v) #f))
-      
       (define/private (display-source-info)
-        (for-each (lambda (p) (display-subkv (car p) ((cdr p) selected-syntax)))
-                  source-properties))
+        (define s-source (syntax-source selected-syntax))
+        (define s-line (syntax-line selected-syntax))
+        (define s-column (syntax-column selected-syntax))
+        (define s-position (syntax-position selected-syntax))
+        (define s-span0 (syntax-span selected-syntax))
+        (define s-span (if (zero? s-span0) #f s-span0))
+        (display "Source location\n" key-sd)
+        (if (or s-source s-line s-column s-position s-span)
+            (begin
+              (display-subkv "source" (prettify-source s-source))
+              (display-subkv "line" s-line)
+              (display-subkv "column" s-column)
+              (display-subkv "position" s-position)
+              (display-subkv "span" s-span0))
+            (display "No source location available\n" n/a-sd))
+        (display "\n" #f))
       
-      (define/private (display-properties)
+      (define/private (display-extra-source-info)
+        (display "Built-in properties\n" key-sd)
+        (display-subkv "source module"
+                       (let ([mod (syntax-source-module selected-syntax)])
+                         (and mod (mpi->string mod))))
+        (display-subkv "original?" (syntax-original? selected-syntax))
+        (display "\n" #f))
+      
+      (define/private (display-symbol-property-info)
         (let ([keys (syntax-property-symbol-keys selected-syntax)])
-          (if (null? keys)
-              (display "No properties available" n/a-sd)
-              (for-each (lambda (k) (display-kv k (syntax-property selected-syntax k)))
-                        keys))))
-
+          (display "Additional properties\n" key-sd)
+          (when (null? keys)
+            (display "No additional properties available.\n" n/a-sd))
+          (when (pair? keys)
+            (for-each (lambda (k) (display-subkv k (syntax-property selected-syntax k)))
+                      keys))))
+      
       (define/private (display-kv key value)
         (display (format "~a~n" key) key-sd)
         (display (format "~s~n~n" value) #f))
+
+      (define/public (display-subkv k v)
+        (display (format "~a: " k) sub-key-sd)
+        (display (format "~a~n" v) #f))
       
       (define/private (display item sd)
         (let ([p0 (send text last-position)])
@@ -97,23 +142,23 @@
 
   ;; binding-properties : (listof (cons string (syntax -> any)))
   (define binding-properties
-    (list (cons "identifier-binding"
+    (list (cons "in the standard phase"
                 (lift/id identifier-binding))
-          (cons "identifier-transformer-binding"
+          (cons "in the transformer phase (\"for-syntax\")"
                 (lift/id identifier-transformer-binding))
-          (cons "identifier-template-binding"
+          (cons "in the template phase (\"for-template\")"
                 (lift/id identifier-template-binding))))
+  
+  (define (uninterned? s)
+    (not (eq? s (string->symbol (symbol->string s)))))
 
-  ;; source-properties : (listof (cons string (syntax -> any)))
-  (define source-properties
-    (list (cons "syntax-source" syntax-source)
-          (cons "syntax-source-module"
-                (lambda (stx) (mpi->string (syntax-source-module stx))))
-          (cons "syntax-line" syntax-line)
-          (cons "syntax-position" syntax-position)
-          (cons "syntax-span" syntax-span)
-          (cons "syntax-original?" syntax-original?)))
-
+  (define (prettify-source s)
+    (cond [(is-a? s editor<%>)
+           'editor]
+          [else s]))
+  
+  ;; Styles
+    
   (define key-sd
     (let ([sd (new style-delta%)])
       (send sd set-delta-foreground "blue")
@@ -130,4 +175,4 @@
       (send sd set-delta-foreground "gray")
       sd))
   
-  )
\ No newline at end of file
+  )
diff --git a/collects/macro-debugger/syntax-browser/syntax-snip.ss b/collects/macro-debugger/syntax-browser/syntax-snip.ss
index 2ca4373..440e02b 100644
--- a/collects/macro-debugger/syntax-browser/syntax-snip.ss
+++ b/collects/macro-debugger/syntax-browser/syntax-snip.ss
@@ -9,7 +9,7 @@
            "properties.ss"
            "typesetter.ss")
   (provide snip@
-           snip-context-menu-extension@)
+           snip-keymap-extension@)
   
   (define snip@
     (unit/sig snip^
@@ -48,7 +48,7 @@
           (send -outer change-style (make-object style-delta% 'change-alignment 'top))
           (new syntax-keymap%
                (editor -outer)
-               (context-menu (new context-menu% (snip this))))
+               (snip this))
           (refresh)
           
           (define/public (get-controller) controller)
@@ -200,6 +200,21 @@
           (super-new)))
       ))
 
+  (define snip-keymap-extension@
+    (unit/sig keymap^
+      (import (pre : keymap^))
+      
+      (define syntax-keymap%
+        (class pre:syntax-keymap%
+          (init-field snip)
+          (inherit add-function)
+          (super-new (controller (send snip get-controller)))
+          
+          (add-function "show-syntax-properties"
+                        (lambda (i e)
+                          (send snip show-props)))))))
+  
+  #;
   (define snip-context-menu-extension@
     (unit/sig context-menu^
       (import (pre : context-menu^))
diff --git a/collects/macro-debugger/syntax-browser/util.ss b/collects/macro-debugger/syntax-browser/util.ss
index e527f94..9f679ad 100644
--- a/collects/macro-debugger/syntax-browser/util.ss
+++ b/collects/macro-debugger/syntax-browser/util.ss
@@ -25,7 +25,7 @@
                  (format "~s" (car mps))]
                 [(null? mps) "self"]))
         (format "~s" mpi)))
-
+  
   (define (mpi->list mpi)
     (if mpi
         (let-values ([(path rel) (module-path-index-split mpi)])
diff --git a/collects/macro-debugger/syntax-browser/widget.ss b/collects/macro-debugger/syntax-browser/widget.ss
index 2cd8978..91c541f 100644
--- a/collects/macro-debugger/syntax-browser/widget.ss
+++ b/collects/macro-debugger/syntax-browser/widget.ss
@@ -13,12 +13,12 @@
            "properties.ss"
            "util.ss")
   (provide widget@
+           widget-keymap-extension@
            widget-context-menu-extension@)
 
   (define widget@
     (unit/sig widget^
-      (import keymap^
-              context-menu^)
+      (import keymap^)
       
       ;; syntax-widget%
       ;; A syntax-widget creates its own syntax-controller.
@@ -39,12 +39,11 @@
             (new syntax-controller%
                  (properties-controller this)))
           
-          (define/public (make-context-menu)
-            (new context-menu% (widget this)))
-          
-          (new syntax-keymap% 
-               (editor -text)
-               (context-menu (make-context-menu)))
+          (define/public (make-keymap text)
+            (new syntax-keymap% 
+                 (editor text)
+                 (widget this)))
+          (make-keymap -text)
           
           (send -text lock #t)
           (send -split-panel set-percentages 
@@ -56,32 +55,27 @@
           (define/public (set-syntax stx)
             (send props set-syntax stx))
           
-          (define/public (show ?)
-            (if ? (show-props) (hide-props)))
-          
           (define/public (props-shown?)
             (send -props-panel is-shown?))
           
           (define/public (toggle-props)
-            (if (send -props-panel is-shown?)
-                (hide-props)
-                (show-props)))
-          
-          (define/public (hide-props)
-            (when (send -props-panel is-shown?)
-              (set! props-percentage (cadr (send -split-panel get-percentages)))
-              (send -split-panel delete-child -props-panel)
-              (send -props-panel show #f)))
-          
-          (define/public (show-props)
-            (unless (send -props-panel is-shown?)
-              (send -split-panel add-child -props-panel)
-              (send -split-panel set-percentages
-                    (list (- 1 props-percentage) props-percentage))
-              (send -props-panel show #t)))
+            (show-props (not (send -props-panel is-shown?))))
           
+          (define/public (show-props show?)
+            (if show?
+                (unless (send -props-panel is-shown?)
+                  (send -split-panel add-child -props-panel)
+                  (send -split-panel set-percentages
+                        (list (- 1 props-percentage) props-percentage))
+                  (send -props-panel show #t))
+                (when (send -props-panel is-shown?)
+                  (set! props-percentage
+                        (cadr (send -split-panel get-percentages)))
+                  (send -split-panel delete-child -props-panel)
+                  (send -props-panel show #f))))
+
           ;;
-          
+
           (define/public (get-controller) controller)
           
           ;;
@@ -145,32 +139,41 @@
       
       ))
 
+  (define widget-keymap-extension@
+    (unit/sig keymap^
+      (import (pre : keymap^))
+      
+      (define syntax-keymap%
+        (class pre:syntax-keymap%
+          (init-field widget)
+          (super-new (controller (send widget get-controller)))
+          (inherit add-function)
+          
+          (add-function "show-syntax-properties"
+                        (lambda (i e)
+                          (send widget toggle-props)))
+          
+          (define/public (get-widget) widget)
+          ))))
+  
   (define widget-context-menu-extension@
     (unit/sig context-menu^
       (import (pre : context-menu^))
       
       (define context-menu%
         (class pre:context-menu%
-          (init-field widget)
-          
-          (define props-menu #f)
-
-          (define/override (after-selection-items)
-            (super after-selection-items)
-            (set! props-menu
-                  (new menu-item% (label "Show/hide syntax properties")
-                       (parent this)
-                       (callback (lambda _ (send widget toggle-props)))))
-            (void))
+          (inherit-field keymap)
+          (inherit-field props-menu)
           
           (define/override (on-demand)
             (send props-menu set-label
-                  (if (send widget props-shown?)
+                  (if (send (send keymap get-widget) props-shown?)
                       "Hide syntax properties"
                       "Show syntax properties"))
             (super on-demand))
-          
-          (super-new (controller (send widget get-controller)))))))
-
-  (define browser-text% (editor:standard-style-list-mixin text:basic%))
+          (super-new)))))
+  
+  (define browser-text%
+    (text:hide-caret/selection-mixin
+     (editor:standard-style-list-mixin text:basic%)))
   )
diff --git a/collects/macro-debugger/view/hiding-panel.ss b/collects/macro-debugger/view/hiding-panel.ss
index 1d22e75..146154a 100644
--- a/collects/macro-debugger/view/hiding-panel.ss
+++ b/collects/macro-debugger/view/hiding-panel.ss
@@ -4,6 +4,7 @@
            (lib "mred.ss" "mred")
            (lib "list.ss")
            (lib "boundmap.ss" "syntax")
+           "util.ss"
            "../model/hiding-policies.ss"
            "../syntax-browser/util.ss")
   (provide macro-hiding-prefs-widget%)
@@ -13,13 +14,24 @@
     (class object%
       (init parent)
       (init-field stepper)
-      (init-field policy)
-      (init-field (enabled? #f))
-      
+      (init-field config)
+
+      (define policy (new-hiding-policy))
+      (set-hiding-policy-opaque-kernel! policy (send config get-hide-primitives?))
+      (set-hiding-policy-opaque-libs! policy (send config get-hide-libs?))
+      (send config listen-hide-primitives?
+            (lambda (value)
+              (set-hiding-policy-opaque-kernel! policy value)
+              (refresh)))
+      (send config listen-hide-libs?
+            (lambda (value)
+              (set-hiding-policy-opaque-libs! policy value)
+              (refresh)))
+
       (define stx #f)
       (define stx-name #f)
       (define stx-module #f)
-      
+
       (define super-pane
         (new horizontal-pane%
              (parent parent)
@@ -32,38 +44,24 @@
       (define right-pane
         (new vertical-pane%
              (parent super-pane)))
-      
+
       (define enable-ctl
-        (new check-box% 
-             (label "Enable macro hiding?")
-             (parent left-pane)
-             (value enabled?) 
-             (callback
-              (lambda _
-                (set! enabled? (send enable-ctl get-value))
-                (force-refresh)))))
-      
+        (check-box/notify-box left-pane
+                              "Enable macro hiding?"
+                              (get-field macro-hiding? config)))
+      (send config listen-macro-hiding?
+            (lambda (value) (force-refresh)))
+
       (define kernel-ctl
-        (new check-box%
-             (label "Hide mzscheme syntax")
-             (parent left-pane)
-             (value (hiding-policy-opaque-kernel policy))
-             (callback (lambda _
-                         (if (send kernel-ctl get-value)
-                             (policy-hide-kernel policy)
-                             (policy-unhide-kernel policy))
-                         (refresh)))))
+        (check-box/notify-box left-pane
+                              "Hide mzscheme syntax"
+                              (get-field hide-primitives? config)))
+
       (define libs-ctl
-        (new check-box%
-             (label "Hide library syntax")
-             (parent left-pane)
-             (value (hiding-policy-opaque-libs policy))
-             (callback (lambda _
-                         (if (send libs-ctl get-value)
-                             (policy-hide-libs policy)
-                             (policy-unhide-libs policy))
-                         (refresh)))))
-      
+        (check-box/notify-box left-pane
+                              "Hide library syntax"
+                              (get-field hide-libs? config)))
+
       (define look-pane
         (new horizontal-pane% (parent right-pane) (stretchable-height #f)))
       (define look-ctl
@@ -97,23 +95,14 @@
       
       ;; Methods
       
-      ;; enable-hiding : boolean -> void
-      ;; Called only by stepper, which does it's own refresh
-      (define/public (enable-hiding ok?)
-        (send enable-ctl set-value ok?)
-        (set! enabled? ok?))
-      
-      ;; get-enabled?
-      (define/public (get-enabled?) enabled?)
-      
-      ;; get-policy
-      (define/public (get-policy) policy)
+      (define/public (get-show-macro?)
+        (lambda (id) (policy-show-macro? policy id)))
       
       ;; refresh
       (define/public (refresh)
-        (when enabled?
+        (when (send config get-macro-hiding?)
           (send stepper refresh/resynth)))
-      
+
       ;; force-refresh
       (define/private (force-refresh)
         (send stepper refresh/resynth))
@@ -221,4 +210,4 @@
       
       (super-new)))
   
-  )
\ No newline at end of file
+  )
diff --git a/collects/macro-debugger/view/interfaces.ss b/collects/macro-debugger/view/interfaces.ss
index d68591b..5159411 100644
--- a/collects/macro-debugger/view/interfaces.ss
+++ b/collects/macro-debugger/view/interfaces.ss
@@ -20,9 +20,26 @@
      pref:height
      pref:props-percentage
      pref:macro-hiding?
+     pref:show-syntax-properties?
      pref:show-hiding-panel?
      pref:hide-primitives?
      pref:hide-libs?
-     pref:identifier=?))
+     pref:identifier=?
+     pref:show-rename-steps?
+     pref:highlight-foci?
+     pref:suppress-warnings?
+     ))
+
+  ;; macro-stepper-config%
+  ;;   all fields are notify-box% objects
+  ;;     width
+  ;;     height
+  ;;     macro-hiding?
+  ;;     hide-primitives?
+  ;;     hide-libs?
+  ;;     show-syntax-properties?
+  ;;     show-hiding-panel?
+  ;;     show-rename-steps?
+  ;;     highlight-foci?
 
   )
diff --git a/collects/macro-debugger/view/prefs.ss b/collects/macro-debugger/view/prefs.ss
index 5f95742..4d0e2dd 100644
--- a/collects/macro-debugger/view/prefs.ss
+++ b/collects/macro-debugger/view/prefs.ss
@@ -21,18 +21,27 @@
       (preferences:set-default 'MacroStepper:Frame:Height 600 number?)
       (preferences:set-default 'MacroStepper:PropertiesPanelPercentage 1/3 number?)
       (preferences:set-default 'MacroStepper:MacroHiding? #t boolean?)
+      (preferences:set-default 'MacroStepper:ShowSyntaxProperties? #f boolean?)
       (preferences:set-default 'MacroStepper:ShowHidingPanel? #t boolean?)
       (preferences:set-default 'MacroStepper:HidePrimitives? #t boolean?)
       (preferences:set-default 'MacroStepper:HideLibs? #t boolean?)
       (preferences:set-default 'MacroStepper:IdentifierComparison "bound-identifier=?" string?)
+      (preferences:set-default 'MacroStepper:HighlightFoci? #t boolean?)
+      (preferences:set-default 'MacroStepper:ShowRenameSteps? #f boolean?)
+      (preferences:set-default 'MacroStepper:SuppressWarnings? #f boolean?)
       
       (pref:get/set pref:width MacroStepper:Frame:Width)
       (pref:get/set pref:height MacroStepper:Frame:Height)
       (pref:get/set pref:props-percentage MacroStepper:PropertiesPanelPercentage)
       (pref:get/set pref:macro-hiding? MacroStepper:MacroHiding?)
+      (pref:get/set pref:show-syntax-properties? MacroStepper:ShowSyntaxProperties?)
       (pref:get/set pref:show-hiding-panel? MacroStepper:ShowHidingPanel?)
       (pref:get/set pref:hide-primitives? MacroStepper:HidePrimitives?)
       (pref:get/set pref:hide-libs? MacroStepper:HideLibs?)
       (pref:get/set pref:identifier=? MacroStepper:IdentifierComparison)
+      (pref:get/set pref:highlight-foci? MacroStepper:HighlightFoci?)
+      (pref:get/set pref:show-rename-steps? MacroStepper:ShowRenameSteps?)
+      (pref:get/set pref:suppress-warnings? MacroStepper:SuppressWarnings?)
+      
       ))
   )