added support for customizing the edge label font to the graph library and propogated that argument to the redex traces and traces/ps functions

svn: r13155

collects/mrlib/graph.ss

@@ -231,6 +231,8 @@
     (mixin ((class->interface pasteboard%)) (graph-pasteboard<%>)
       (inherit find-first-snip find-next-selected-snip)
       
+      (init-field [edge-label-font #f])
+      
       (define draw-arrow-heads? #t)
       (inherit refresh get-admin)
       (define/public (set-draw-arrow-heads? x)
@@ -248,6 +250,8 @@
                     (unbox wb)
                     (unbox hb))))))
       
+      
+      
       (define arrowhead-angle-width (* 1/4 pi))
       (define arrowhead-short-side 8)
       (define arrowhead-long-side 12)
@@ -484,7 +488,12 @@
       
       (define/override (on-paint before? dc left top right bottom dx dy draw-caret)
         (when before?
-          (draw-edges dc left top right bottom dx dy))
+          (let ([old-font (send dc get-font)])
+            (when edge-label-font
+              (send dc set-font edge-label-font))
+            (draw-edges dc left top right bottom dx dy)
+            (when edge-label-font
+              (send dc set-font old-font))))
         (super on-paint before? dc left top right bottom dx dy draw-caret))
       
       (define/public (draw-edges dc left top right bottom dx dy)

collects/mrlib/scribblings/graph/graph-pasteboard-mixin.scrbl

@@ -3,5 +3,13 @@
 
 @defmixin/title[graph-pasteboard-mixin (pasteboard%) (graph-pasteboard<%>)]{
 
+@defconstructor/auto-super[([edge-label-font (or/c #f (is-a?/c font%)) #f])]{
+
+If @scheme[edge-label-font] is supplied, it is used when drawing the
+labels on the edges. Otherwise, the font is not set before drawing
+the labels, defaulting to the @scheme[dc<%>] object's font.
+
+}
+
 This mixin overrides many methods to draw lines between
 @scheme[graph-snip<%>] that it contains.}

collects/redex/gui.ss

@@ -35,7 +35,8 @@
                #:pp pp-contract
                #:colors (listof (list/c string? string?))
                #:scheme-colors? boolean?
-               #:layout (-> any/c any/c))
+               #:layout (-> any/c any/c)
+               #:edge-label-font (or/c #f (is-a?/c font%)))
               any)]
  [traces/ps (->* (reduction-relation?
                   any/c
@@ -46,7 +47,8 @@
                                (any/c term-node? . -> . any))
                   #:pp pp-contract
                   #:colors (listof any/c)
-                  #:layout (-> any/c any/c))
+                  #:layout (-> any/c any/c)
+                  #:edge-label-font (or/c #f (is-a?/c font%)))
                  any)]
  
  [term-node? (-> any/c boolean?)]

collects/redex/private/traces.ss

@@ -131,7 +131,9 @@
                    #:pp [pp default-pretty-printer] 
                    #:scheme-colors? [scheme-colors? #t]
                    #:colors [colors '()]
-                   #:layout [layout void])
+                   #:layout [layout void]
+                   #:edge-label-font [edge-label-font #f]
+                   )
   (let-values ([(graph-pb canvas)
                 (traces reductions pre-exprs
                         #:no-show-frame? #t
@@ -140,7 +142,8 @@
                         #:pp pp
                         #:scheme-colors? scheme-colors?
                         #:colors colors
-                        #:layout layout)])
+                        #:layout layout
+                        #:edge-label-font edge-label-font)])
     (print-to-ps graph-pb canvas filename)))
 
 (define (print-to-ps graph-pb canvas filename)
@@ -227,11 +230,12 @@
                 #:colors [colors '()]
                 #:scheme-colors? [scheme-colors? #t]
                 #:layout [layout void]
+                #:edge-label-font [edge-label-font #f]
                 #:no-show-frame? [no-show-frame? #f])
   (define exprs (if multiple? pre-exprs (list pre-exprs)))
   (define main-eventspace (current-eventspace))
   (define saved-parameterization (current-parameterization))
-  (define graph-pb (new graph-pasteboard% [layout layout]))
+  (define graph-pb (new graph-pasteboard% [layout layout] [edge-label-font edge-label-font]))
   (define f (instantiate red-sem-frame% ()
               (label "PLT Redex Reduction Graph")
               (style '(toolbar-button))

collects/redex/redex.scrbl

@@ -1157,7 +1157,8 @@ exploring reduction sequences.
                                   (lambda (x) (member (length x) '(2 3 4 6))))))]
 
 	         [#:scheme-colors? scheme-colors? boolean?]
-                 [#:layout layout (-> (listof term-node?) void)])
+                 [#:layout layout (-> (listof term-node?) void)]
+                 [#:edge-label-font edge-label-font (or/c #f (is-a?/c font%)) #f])
          void?]{
 
 This function opens a new window and inserts each expression
@@ -1169,7 +1170,7 @@ found, or no more reductions can occur. It inserts each new
 term into the gui. Clicking the @onscreen{reduce} button reduces
 until reduction-steps-cutoff more terms are found.
 
-The pred function indicates if a term has a particular
+The @scheme[pred] function indicates if a term has a particular
 property. If it returns @scheme[#f], the term is displayed with a
 pink background. If it returns a string or a @scheme[color%] object,
 the term is displayed with a background of that color (using
@@ -1211,8 +1212,6 @@ the color that fills the arrow head.  If fewer than six colors are
 specified, the colors specified colors are used and then defaults are
 filled in for the remaining colors.
 
-
-
 The @scheme[scheme-colors?] argument, if @scheme[#t] causes
 @scheme[traces] to color the contents of each of the windows according
 to DrScheme's Scheme mode color Scheme. If it is @scheme[#f],
@@ -1224,8 +1223,10 @@ after new terms are inserted in response to the user clicking on the
 reduce button, and after the initial set of terms is inserted.
 See also @scheme[term-node-set-position!].
 
-You can save the contents of the window as a postscript file
+The @scheme[edge-label-font] argument is used as the font on the edge
-from the menus.
+labels. If nothign is suppled, the @scheme[dc<%>] object's default
+font is used.
+
 }
 
 @defproc[(traces/ps [reductions reduction-relation?] 
@@ -1241,7 +1242,8 @@ from the menus.
                                 (any output-port number (is-a?/c text%) -> void))
                           default-pretty-printer]
                     [#:colors colors (listof (list string string)) '()]
-                    [#:layout layout (-> (listof term-node?) void)])
+                    [#:layout layout (-> (listof term-node?) void)]
+                    [#:edge-label-font edge-label-font (or/c #f (is-a?/c font%)) #f])
          void?]{
 
 The arguments behave just like the function @scheme[traces], but