diff --git a/collects/redex/pict.ss b/collects/redex/pict.ss index c511e1f375..0d636a934f 100644 --- a/collects/redex/pict.ss +++ b/collects/redex/pict.ss @@ -59,6 +59,7 @@ [default-style (parameter/c text-style/c)] [non-terminal-style (parameter/c text-style/c)] [non-terminal-subscript-style (parameter/c text-style/c)] + [non-terminal-superscript-style (parameter/c text-style/c)] [linebreaks (parameter/c (or/c false/c (listof boolean?)))] [curly-quotes-for-strings (parameter/c boolean?)] [white-bracket-sizing (parameter/c diff --git a/collects/redex/private/bitmap-test.ss b/collects/redex/private/bitmap-test.ss index 8a8aefe9c7..e5f73397d9 100644 --- a/collects/redex/private/bitmap-test.ss +++ b/collects/redex/private/bitmap-test.ss @@ -159,5 +159,9 @@ ;; make sure two metafunctions simultaneously rewritten line up properly (test (render-metafunctions S T TL) "metafunctions-multiple.png") +;; Non-terminal superscripts +(test (render-lw lang (to-lw (x_^abcdef x_q^abcdef))) + "superscripts.png") + (printf "bitmap-test.ss: ") (done) diff --git a/collects/redex/private/bmps-macosx/superscripts.png b/collects/redex/private/bmps-macosx/superscripts.png new file mode 100644 index 0000000000..69484218f2 Binary files /dev/null and b/collects/redex/private/bmps-macosx/superscripts.png differ diff --git a/collects/redex/private/core-layout.ss b/collects/redex/private/core-layout.ss index c2e8fad505..138b15ba67 100644 --- a/collects/redex/private/core-layout.ss +++ b/collects/redex/private/core-layout.ss @@ -6,7 +6,8 @@ texpict/utils texpict/mrpict - + + scheme/match scheme/gui/base scheme/class) @@ -21,6 +22,7 @@ label-style non-terminal-style non-terminal-subscript-style + non-terminal-superscript-style label-font-size default-font-size metafunction-font-size @@ -688,18 +690,15 @@ 'modern (default-font-size)))))] [(and (symbol? atom) - (regexp-match #rx"^([^_]*)_(.*)$" (symbol->string atom))) + (regexp-match #rx"^([^_^]*)_([^^]*)\\^?(.*)$" (symbol->string atom))) => - (λ (m) - (let* ([first-part (cadr m)] - [second-part (caddr m)] - [first-span (- span (string-length first-part))]) - (list - (non-terminal->token col first-span first-part) - (make-string-token (+ col first-span) - (- span first-span) - second-part - (non-terminal-subscript-style)))))] + (match-lambda + [(list _ nt sub sup) + (let* ([sub-pict (basic-text sub (non-terminal-subscript-style))] + [sup-pict (basic-text sup (non-terminal-superscript-style))] + [sub+sup (lbl-superimpose sub-pict sup-pict)]) + (list (non-terminal->token col span nt) + (make-pict-token (+ col span) 0 sub+sup)))])] [(or (memq atom all-nts) (memq atom '(number variable variable-except variable-not-otherwise-mentioned))) (list (non-terminal->token col span (format "~s" atom)))] @@ -747,6 +746,7 @@ (define (unksc str) (pink-background ((current-text) str 'modern (default-font-size)))) (define non-terminal-style (make-parameter '(italic . roman))) (define non-terminal-subscript-style (make-parameter `(subscript . ,(non-terminal-style)))) + (define non-terminal-superscript-style (make-parameter `(superscript . ,(non-terminal-style)))) (define default-style (make-parameter 'roman)) (define metafunction-style (make-parameter 'swiss)) (define (metafunction-text str) ((current-text) str (metafunction-style) (metafunction-font-size))) diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl index fb34a26e47..a66ca1287a 100644 --- a/collects/redex/redex.scrbl +++ b/collects/redex/redex.scrbl @@ -1865,6 +1865,7 @@ cases appear. If it is a list of numbers, then only the selected cases appear (c @defparam[metafunction-style style text-style/c]{} @defparam[non-terminal-style style text-style/c]{} @defparam[non-terminal-subscript-style style text-style/c]{} +@defparam[non-terminal-superscript-style style text-style/c]{} @defparam[default-style style text-style/c]{}]]{ These parameters determine the font used for various text in @@ -1875,15 +1876,27 @@ useful things it can be is one of the symbols @scheme['roman], monospaced font, respectively. (It can also encode style information, too.) -The label-style is used for the reduction rule label -names. The literal-style is used for names that aren't +The @scheme[label-style] is used for the reduction rule label +names. The @scheme[literal-style] is used for names that aren't non-terminals that appear in patterns. The -metafunction-style is used for the names of -metafunctions. The non-terminal-style is for non-terminals -and non-terminal-subscript-style is used for the portion +@scheme[metafunction-style] is used for the names of +metafunctions. + +The @scheme[non-terminal-style] is used for the names of non-terminals. +Two parameters style the text in the (optional) "underscore" component +of a non-terminal reference. The first, @scheme[non-terminal-subscript-style], +applies to the segment between the underscore and the first caret (@scheme[^]) +to follow it; the second, @scheme[non-terminal-superscript-style], applies +to the segment following that caret. For example, in the non-terminal +reference @scheme[x_y_z], @scheme[x] has style @scheme[non-terminal-style], +@scheme[y] has style @scheme[non-terminal-subscript-style], and @scheme[z] +has style @scheme[non-terminal-superscript-style]. + +The +@scheme[non-terminal-subscript-style] is used for the portion after the underscore in non-terminal references. -The default-style is used for parenthesis, the dot in dotted +The @scheme[default-style] is used for parenthesis, the dot in dotted lists, spaces, the separator words in the grammar, the "where" and "fresh" in side-conditions, and other places where the other parameters aren't used.