Why not just use the pp argument that's already there? (And I think your editor is indenting improperly; some of those lines don't seem to have changed except indentation)
Robby On Thu, May 2, 2013 at 3:02 PM, J. Ian Johnson <[email protected]> wrote: > 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" <[email protected]> > To: "users" <[email protected]> > 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 > > ____________________ > Racket Users list: > http://lists.racket-lang.org/users >
____________________ Racket Users list: http://lists.racket-lang.org/users
