redex: add where-make-prefix-pict' and where-combine' for typesetting

collects/redex/pict.rkt

@@ -77,7 +77,9 @@
  [white-bracket-sizing (parameter/c
                         (-> string? number? (values number? number? number? number?)))]
  [horizontal-bar-spacing (parameter/c exact-nonnegative-integer?)]
- [relation-clauses-combine (parameter/c (-> (listof pict?) pict?))])
+ [relation-clauses-combine (parameter/c (-> (listof pict?) pict?))]
+ [where-make-prefix-pict (parameter/c (-> pict?))]
+ [where-combine (parameter/c (-> pict? pict? pict?))])
 
 (provide/contract
  [rule-pict-style 

collects/redex/private/pict.rkt

@@ -64,6 +64,9 @@
          metafunction-font-size
          reduction-relation-rule-separation
 
+         where-make-prefix-pict
+         where-combine
+         
          just-before
          just-after         
          
@@ -352,7 +355,7 @@
                 frsh))])
     (if (null? lst)
         (blank)
-        (let ([where (basic-text " where " (default-style))])
+        (let ([where ((where-make-prefix-pict))])
           (let ([max-w (- max-w (pict-width where))])
             (htl-append where
                         (let loop ([p (car lst)][lst (cdr lst)])
@@ -366,8 +369,16 @@
                                         (loop (car lst) (cdr lst)))]
                             [else (loop (htl-append p (car lst)) (cdr lst))]))))))))
 
+(define where-make-prefix-pict
+  (make-parameter (lambda ()
+                    (basic-text " where " (default-style)))))
+
 (define (where-pict lhs rhs)
-  (htl-append lhs (make-=) rhs))
+  ((where-combine) lhs rhs))
+
+(define where-combine
+  (make-parameter (lambda (lhs rhs)
+                    (htl-append lhs (make-=) rhs))))
 
 (define (rp->side-condition-pict rp max-w)
   (side-condition-pict (rule-pict-fresh-vars rp)

collects/redex/scribblings/ref.scrbl

@@ -11,7 +11,7 @@
                      mrlib/graph
                      (except-in 2htdp/image make-pen text)
                      (only-in pict pict? text dc-for-text-size text-style/c
-                              vc-append)
+                              vc-append hbl-append)
                      redex))
 
 @(define-syntax (defpattech stx)
@@ -3045,11 +3045,24 @@ single reduction relation.
 }
 @defparam[relation-clauses-combine combine 
                                    (parameter/c (-> (listof pict?) pict?))]{
-  @racket[combine] is called with the list of picts that are obtained by rendering
+  The @racket[combine] function is called with the list of picts that are obtained by rendering
   a relation; it should put them together into a single pict. It defaults to
   @racket[(λ (l) (apply vc-append 20 l))]
 }
 
+@defparam[where-make-prefix-pict make-prefix (parameter/c (-> pict?))]{
+  The @racket[make-prefix] function is called with no arguments to generate a pict
+  that prefixes @tech{@racket[where] clauses}. It defaults to a function that
+  produces a pict for ``where'' surrounded by spaces using the default style.
+}
+
+@defparam[where-combine combine (parameter/c (-> pict? pict? pict?))]{
+  The @racket[combine] function is called with picts for the left and right
+  side of a where clause, and it should put them together into a single pict. It defaults to
+  @racket[(λ (l r) (hbl-append l _=-pict r))], where @racket[_=-pict] is an equal
+  sign surrounded by spaces using the default style.
+}
+
 @subsection[#:tag "pink"]{Removing the Pink Background}
 
 @declare-exporting[redex/pict redex]

doc/release-notes/redex/HISTORY.txt

@@ -1,3 +1,8 @@
+v5.3.4.11
+
+  * added where-make-prefix-pict and where-combine parameters.
+
+
 v5.3.4
 
   * adjusted define-union-language to allow the unioned languages to