[racket] Trimmed view in redex's traces?

Okay, here's a diff that hacks it in for my purposes and doesn't crash. I don't know what this breaks due to the new init-field in size-snip though. Will anyone familiar with this part of the codebase please comment?
Thanks,
-Ian

diff --git a/collects/redex/gui.rkt b/collects/redex/gui.rkt
index 41dce2a..ddd291b 100644
--- a/collects/redex/gui.rkt
+++ b/collects/redex/gui.rkt
@@ -43,6 +43,7 @@
                #:edge-label-font (or/c #f (is-a?/c font%))
                #:edge-labels? boolean?
                #:filter (-> any/c (or/c #f string?) any/c)
+               #:format (-> any/c any/c)
                #:graph-pasteboard-mixin (make-mixin-contract graph-pasteboard<%>))
               any)]
  [traces/ps (->* (reduction-relation?
@@ -60,6 +61,7 @@
                   #:edge-label-font (or/c #f (is-a?/c font%))
                   #:edge-labels? boolean?
                   #:filter (-> any/c (or/c #f string?) any/c)
+                  #:format (-> any/c any/c)
                   #:graph-pasteboard-mixin (make-mixin-contract graph-pasteboard<%>)
                   #:post-process (-> (is-a?/c graph-pasteboard<%>) any/c))
                  any)]
diff --git a/collects/redex/private/size-snip.rkt b/collects/redex/private/size-snip.rkt
index e505ba5..3cf8676 100644
--- a/collects/redex/private/size-snip.rkt
+++ b/collects/redex/private/size-snip.rkt
@@ -83,6 +83,7 @@
 (define size-editor-snip%
   (class* editor-snip% (reflowing-snip<%>)
     (init-field expr)
+    (init-field formatted-expr)
     (init pp)
     (init-field char-width)
     (define real-pp
@@ -172,7 +173,7 @@
           (send text thaw-colorer))
         (send text set-styles-sticky #f)
         (send text erase)
-        (real-pp expr port char-width text)
+        (real-pp formatted-expr port char-width text)
diff --git a/collects/redex/private/traces.rkt b/collects/redex/private/traces.rkt
index 1293c19..9bcb45a 100644
--- a/collects/redex/private/traces.rkt
+++ b/collects/redex/private/traces.rkt
@@ -139,6 +139,7 @@
                    #:edge-labels? [edge-labels? #t]
                    #:graph-pasteboard-mixin [extra-graph-pasteboard-mixin values]
                    #:filter [term-filter (lambda (x y) #t)]
+                   #:format [term-formatter values]
                    #:post-process [post-process void]
                    #:x-spacing [x-spacing default-x-spacing]
                    #:y-spacing [y-spacing default-x-spacing])
@@ -156,6 +157,7 @@
                         #:edge-labels? edge-labels?
                         #:graph-pasteboard-mixin extra-graph-pasteboard-mixin
                         #:filter term-filter
+                        #:format term-formatter
                         #:x-spacing x-spacing
                         #:y-spacing y-spacing)])
     (post-process graph-pb)
@@ -249,6 +251,7 @@
                 #:edge-label-font [edge-label-font #f]
                 #:edge-labels? [edge-labels? #t]
                 #:filter [term-filter (lambda (x y) #t)]
+                #:format [term-formatter values]
                 #:graph-pasteboard-mixin [extra-graph-pasteboard-mixin values]
                 #:no-show-frame? [no-show-frame? #f]
                 #:x-spacing [x-spacing default-x-spacing]
@@ -368,7 +371,7 @@
     (filter
      (λ (x) x)
      (map (lambda (expr) (apply build-snip
-                                snip-cache #f expr pred pp #f code-colors?
+                                snip-cache #f expr pred term-formatter pp #f code-colors?
                                 (get-user-char-width user-char-width expr)
                                 default-colors))
           exprs)))
@@ -429,20 +432,20 @@
            (let* ([snip (car snips)]
                   [new-snips 
                    (filter 
-                    (lambda (x) x)
+                    values
                     (map (lambda (red+sexp)
                            (let-values ([(name sexp) (apply values red+sexp)])
                              (call-on-eventspace-main-thread
                               (λ ()
-                                (and (term-filter sexp name)
-                                     (let-values ([(dark-arrow-color light-arrow-color dark-label-color light-label-color
-                                                                     dark-pen-color
-                                                                     light-pen-color) 
-                                                   (red->colors name)])
-                                       (build-snip snip-cache snip sexp pred pp name code-colors? 
-                                                   (get-user-char-width user-char-width sexp)
-                                                   light-arrow-color dark-arrow-color dark-label-color light-label-color
-                                                   dark-pen-color light-pen-color)))))))
+                                 (and (term-filter sexp name)
+                                      (let-values ([(dark-arrow-color light-arrow-color dark-label-color light-label-color
+                                                                      dark-pen-color
+                                                                      light-pen-color) 
+                                                    (red->colors name)])
+                                        (build-snip snip-cache snip sexp pred term-formatter pp name code-colors? 
+                                                    (get-user-char-width user-char-width sexp)
+                                                    light-arrow-color dark-arrow-color dark-label-color light-label-color
+                                                    dark-pen-color light-pen-color)))))))
                          (apply-reduction-relation/tag-with-names reductions (send snip get-expr))))]
                   [new-y 
                    (call-on-eventspace-main-thread
@@ -787,6 +790,7 @@
 ;;              (union #f (is-a?/c graph-snip<%>)) 
 ;;              sexp
 ;;              sexp -> boolean
+;;              sexp -> sexp
 ;;              (any port number -> void)
 ;;              (union #f string)
 ;;              number
@@ -795,7 +799,7 @@
 ;; returns #f if a snip corresponding to the expr has already been created.
 ;; also adds in the links to the parent snip
 ;; =eventspace main thread=
-(define (build-snip cache parent-snip expr pred pp name code-colors? cw
+(define (build-snip cache parent-snip expr pred formatter pp name code-colors? cw
                     light-arrow-color dark-arrow-color dark-label-color light-label-color
                     dark-brush-color light-brush-color)
   (let-values ([(snip new?)
@@ -804,7 +808,7 @@
                            cache
                            expr
                            (lambda ()
-                             (let ([new-snip (make-snip parent-snip expr pred pp code-colors? cw)])
+                             (let ([new-snip (make-snip parent-snip expr pred formatter pp code-colors? cw)])
                                (hash-set! cache expr new-snip)
@@ -824,7 +828,7 @@
                                  (make-object color% light-label-color))
                              0 0
                              name)
-      (update-badness pred parent-snip (send parent-snip get-expr)))
+      (update-badness pred parent-snip (formatter (send parent-snip get-expr))))
     
     (update-badness pred snip expr)
     
@@ -845,20 +849,22 @@
 ;; make-snip : (union #f (is-a?/c graph-snip<%>)) 
 ;;             sexp 
 ;;             sexp -> boolean
+;;             sexp -> sexp
 ;;             (any port number -> void)
 ;;             boolean
 ;;             number
 ;;          -> (is-a?/c graph-editor-snip%)
 ;; unconditionally creates a new graph-editor-snip
 ;; =eventspace main thread=
-(define (make-snip parent-snip expr pred pp code-colors? cw)
+(define (make-snip parent-snip expr pred formatter pp code-colors? cw)
   (let* ([text (new program-text%)]
          [es (instantiate graph-editor-snip% ()
                (char-width cw)
                (editor text)
                (my-eventspace (current-eventspace))
                (pp pp)
-               (expr expr))])
+               (expr expr)
+               (formatted-expr (formatter expr)))])
     (send text set-autowrap-bitmap #f)
     (send text set-max-width 'none)
     (send text freeze-colorer)

----- Original Message -----
From: "J. Ian Johnson" <ianj at ccs.neu.edu>
To: "users" <users at racket-lang.org>
Sent: Thursday, May 2, 2013 2:46:17 PM GMT -05:00 US/Canada Eastern
Subject: [racket] Trimmed view in redex's traces?

I'm trying to debug an abstract machine with some large auxiliary tables. Is there a way to make traces only show a portion of a term, but still treat the box it's in as the entire term? An additional bonus would be to drill down into a trimmed box via click or something.
I don't see this in the docs, so I'm guessing no, but an extra keyword argument for a term -> term "trimming" function shouldn't be too hard to add, right? Just not sure where to change this.
-Ian
____________________
  Racket Users list:
  http://lists.racket-lang.org/users