diff --git a/collects/redex/HISTORY b/collects/redex/HISTORY index b033b5ed63..27bde4a65f 100644 --- a/collects/redex/HISTORY +++ b/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: diff --git a/collects/redex/private/core-layout.ss b/collects/redex/private/core-layout.ss index 337a5bd34e..9f813f4f34 100644 --- a/collects/redex/private/core-layout.ss +++ b/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)) @@ -673,15 +673,42 @@ (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 diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl index 1153996238..a2af8fbefe 100644 --- a/collects/redex/redex.scrbl +++ b/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