added white-bracket-sizing

svn: r11243

collects/redex/HISTORY

@@ -1,4 +1,10 @@
-PLT v4.1
+v4.2
+
+  - added white-bracket-sizing to control how the brackets
+    are typeset when rendering a metafunction.
+
+v4.1 (this is the first version that was included in the PLT
+      distribution. Before this, Redex was in PLaneT).
 
   EXTENSIONS:
 

collects/redex/private/core-layout.ss

@@ -345,10 +345,10 @@
                           (- next-lw-column init-column))])
                  (list* (build-lw to-wrap1 line 0 new-lw-col 0)
                         (build-lw (blank)
-                                           line
-                                           (- next-lw-line line)
-                                           new-lw-col 
-                                           new-lw-col-span)
+                                  line
+                                  (- next-lw-line line)
+                                  new-lw-col 
+                                  new-lw-col-span)
                         (build-lw to-wrap2 next-lw-line 0 (+ new-lw-col new-lw-col-span) 0)
                         (if after-next-lw
                             (cons next-lw (loop after-next-lw next-line next-column))
@@ -674,14 +674,41 @@
   (define (open-white-square-bracket) (white-bracket "["))
   (define (close-white-square-bracket) (white-bracket "]"))
 
+  #;"\u301a\u301b" ;; white square brackets
+  
+  ;; white-bracket : string -> pict
+  ;; puts two of `str' next to each other to make 
+  ;; a `white' version of the bracket.
   (define (white-bracket str)
-    (let ([inset-amt
-           (case (default-font-size)
-             [(9 10 11 12) -2]
-             [else
-              (- (floor (max 2 (* 2 (/ (default-font-size) 10)))))])])
-      (hbl-append (basic-text str (default-style))
-                  (inset (basic-text str (default-style)) inset-amt 0 0 0))))
+    (let-values ([(left-inset-amt right-inset-amt left-space right-space)
+                  ((white-bracket-sizing) str 
+                                          (default-font-size))])
+      (let ([main-bracket (basic-text str (default-style))])
+        (inset (refocus (cbl-superimpose main-bracket
+                                         (hbl-append (blank left-inset-amt)
+                                                     (basic-text str (default-style))
+                                                     (blank right-inset-amt)))
+                        main-bracket)
+               left-space
+               0
+               right-space
+               0))))
+  
+  (define white-bracket-sizing 
+    (make-parameter
+     (λ (str size)
+       (let ([inset-amt (floor (max 4 (* size 2/5)))])
+         (cond
+           [(equal? str "[")
+            (values inset-amt
+                    0
+                    0
+                    2)]
+           [else
+            (values 0
+                    inset-amt
+                    2
+                    0)])))))
   
   (define (pink-background p)
     (refocus

collects/redex/redex.scrbl

@@ -1368,6 +1368,38 @@ it. The thunk may be invoked multiple times when rendering a
 single reduction relation.
 }
 
+@defparam[white-bracket-sizing proc (-> string? number? (values number? number? number? number?))]{
+
+  This parameter is used when typesetting metafunctions to
+  determine how to create the @"\u301a\u301b"
+  characters. Rather than using those characters directory
+  (since glyphs tend not to be available in PostScript
+  fonts), they are created by combining two ‘[’ characters
+  or two ‘]’ characters together.
+  
+  The procedure accepts a string that is either @scheme["["]
+  or @scheme["]"], and returns four numbers. The first two
+  numbers determine the offset (from the left and from the
+  right respectively) for the second square bracket, and the
+  second two two numbers determine the extra space added (to
+  the left and to the right respectively).
+
+  The default value of the parameter is: @schemeblock[
+     (λ (str size)
+       (let ([inset-amt (floor (max 4 (* size 2/5)))])
+         (cond
+           [(equal? str "[")
+            (values inset-amt
+                    0
+                    0
+                    2)]
+           [else
+            (values 0
+                    inset-amt
+                    2
+                    0)])))]
+}
+
 @deftech{Removing the pink background from PLT Redex rendered picts and ps files}
 
 When reduction rules, a metafunction, or a grammar contains