extended initial-char-width

svn: r13221

collects/redex/gui.ss

@@ -86,7 +86,7 @@
  [dark-text-color (parameter/c (or/c string? (is-a?/c color%)))]
  [light-text-color (parameter/c (or/c string? (is-a?/c color%)))]
  [initial-font-size (parameter/c number?)]
- [initial-char-width (parameter/c number?)])
+ [initial-char-width (parameter/c (or/c number? (-> any/c number?)))])
          
 (provide reduction-steps-cutoff
          default-pretty-printer)

collects/redex/private/size-snip.ss

@@ -10,10 +10,17 @@
          size-text%
          default-pretty-printer
          initial-char-width
-         resizing-pasteboard-mixin)
+         resizing-pasteboard-mixin
+         get-user-char-width)
 
 (define initial-char-width (make-parameter 30))
 
+;; get-user-char-width : value-bound-to-'initial-char-width'-parameter sexp -> number
+(define (get-user-char-width cw/proc expr)
+  (cond
+    [(number? cw/proc) cw/proc]
+    [else (cw/proc expr)]))
+
 (define (default-pretty-printer v port w spec)
   (parameterize ([pretty-print-columns w]
                  [pretty-print-size-hook

collects/redex/private/stepper.ss

@@ -716,7 +716,7 @@ todo:
                    [node node]
                    [editor txt]
                    [expr sexp]
-                   [char-width init-cw])])
+                   [char-width (get-user-char-width init-cw sexp)])])
       (send txt set-autowrap-bitmap #f)
       #;(send txt freeze-colorer)
       (send s format-expr)

collects/redex/private/traces.ss

@@ -238,6 +238,7 @@
   (define main-eventspace (current-eventspace))
   (define saved-parameterization (current-parameterization))
   (define graph-pb (new graph-pasteboard% [layout layout] [edge-label-font edge-label-font]))
+  (define user-char-width (initial-char-width))
   (define f (instantiate red-sem-frame% ()
               (label "PLT Redex Reduction Graph")
               (style '(toolbar-button))
@@ -331,6 +332,7 @@
   (define default-colors (list (dark-pen-color) (light-pen-color) 
                                (dark-text-color) (light-text-color)
                                (dark-brush-color) (light-brush-color)))
+      
   
   ;; only changed on the reduction thread
   ;; frontier : (listof (is-a?/c graph-editor-snip%))
@@ -339,9 +341,11 @@
      (λ (x) x)
      (map (lambda (expr) (apply build-snip
                                 snip-cache #f expr pred pp #f scheme-colors?
+                                (get-user-char-width user-char-width expr)
                                 default-colors))
           exprs)))
   
+  
   ;; set-font-size : number -> void
   ;; =eventspace main thread=
   (define (set-font-size size)
@@ -408,6 +412,7 @@
                                                                      light-pen-color) 
                                                    (red->colors name)])
                                        (build-snip snip-cache snip sexp pred pp name scheme-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))))]
@@ -719,12 +724,13 @@
 ;;              sexp -> boolean
 ;;              (any port number -> void)
 ;;              (union #f string)
+;;              number
 ;;              color^6
 ;;           -> (union #f (is-a?/c graph-editor-snip%))
 ;; 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 scheme-colors?
+(define (build-snip cache parent-snip expr pred pp name scheme-colors? cw
                     light-arrow-color dark-arrow-color dark-label-color light-label-color
                     dark-brush-color light-brush-color)
   (let-values ([(snip new?)
@@ -733,7 +739,7 @@
                            cache
                            expr
                            (lambda ()
-                             (let ([new-snip (make-snip parent-snip expr pred pp scheme-colors?)])
+                             (let ([new-snip (make-snip parent-snip expr pred pp scheme-colors? cw)])
                                (hash-set! cache expr new-snip)
                                (k new-snip #t))))
                           #f))])
@@ -775,13 +781,15 @@
 ;;             sexp 
 ;;             sexp -> boolean
 ;;             (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 scheme-colors?)
+(define (make-snip parent-snip expr pred pp scheme-colors? cw)
   (let* ([text (new program-text%)]
          [es (instantiate graph-editor-snip% ()
-               (char-width (initial-char-width))
+               (char-width cw)
                (editor text)
                (my-eventspace (current-eventspace))
                (pp pp)

collects/redex/redex.scrbl

@@ -1367,11 +1367,15 @@ A parameter that controls the initial font size for the terms shown
 in the GUI window.
 }
 
-@defparam[initial-char-width width number?]{
+@defparam[initial-char-width width (or/c number? (-> any/c number?))]{
 
 A parameter that determines the initial width of the boxes
 where terms are displayed (measured in characters) for both
 the stepper and traces.
+
+If its value is a number, then the number is used as the width for 
+every term. If its value is a function, then the function is called
+with each term and the resulting number is used as the width.
 }
 
 @deftogether[[

doc/release-notes/redex/HISTORY.txt

@@ -1,3 +1,8 @@
+v4.1.4
+
+  - initial-char-width now accepts functions to give finer grained
+    control of the initial widths of the terms.
+
 v4.1.3
 
   * added redex-check, a tool for automatically generating test cases