From 273e6e7d258f78e07cac3dead3eb3bcd15fc5d3e Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 24 Sep 2010 08:11:45 -0500
Subject: [PATCH] added paren-style added missing provide for grammar-style
 removed some dead code

---
 collects/redex/pict.rkt                |  2 ++
 collects/redex/private/core-layout.rkt | 25 +++++++++++--------------
 collects/redex/private/pict.rkt        |  1 +
 collects/redex/redex.scrbl             |  8 +++++++-
 doc/release-notes/redex/HISTORY.txt    |  3 +++
 5 files changed, 24 insertions(+), 15 deletions(-)

diff --git a/collects/redex/pict.rkt b/collects/redex/pict.rkt
index 4d8c67965d..190c2dfaf1 100644
--- a/collects/redex/pict.rkt
+++ b/collects/redex/pict.rkt
@@ -59,6 +59,8 @@
 (provide/contract
  [label-style (parameter/c text-style/c)]
  [literal-style (parameter/c text-style/c)]
+ [grammar-style (parameter/c text-style/c)]
+ [paren-style (parameter/c text-style/c)]
  [metafunction-style (parameter/c text-style/c)]
  [default-style (parameter/c text-style/c)]
  [non-terminal-style (parameter/c text-style/c)]
diff --git a/collects/redex/private/core-layout.rkt b/collects/redex/private/core-layout.rkt
index fd080c8e8b..4c4767d5cf 100644
--- a/collects/redex/private/core-layout.rkt
+++ b/collects/redex/private/core-layout.rkt
@@ -19,6 +19,7 @@
          basic-text
          metafunction-text
          grammar-style
+         paren-style
          default-style
          label-style
          non-terminal-style
@@ -79,14 +80,19 @@
                      (if (and (lw? thing-in-hole)
                               (equal? (lw-e thing-in-hole) 'hole))
                          (list (blank) context (blank))
-                         (list (blank) context "" "[" thing-in-hole "]")))))
+                         (list (blank) 
+                               context 
+                               "" 
+                               (basic-text "[" (default-style))
+                               thing-in-hole
+                               (basic-text "]" (default-style)))))))
        (hide-hole ,(λ (args)
                      (list (blank)
                            (list-ref args 2)
                            (blank))))
        (hole ,(λ (args)
                 (let ([name (lw-e (list-ref args 2))])
-                  (list "[]" 
+                  (list (basic-text "[]" (default-style)) 
                         (basic-text (format "~a" name) (non-terminal-subscript-style))))))
        (name ,(λ (args)
                 (let ([open-paren (list-ref args 0)]
@@ -374,18 +380,6 @@
             (values fst snd))
           (values fst (blank)))))
   
-  (define (combine-into-loc-wrapper to-wrap)
-    (cond
-      [(null? to-wrap) (blank)]
-      [(null? (cdr to-wrap)) (car to-wrap)]
-      [else 
-       (apply hbl-append (map make-single-pict to-wrap))]))
-  
-  (define (make-single-pict x)
-    (cond
-      [(pict? x) x]
-      [(string? x) (basic-text x (default-style))]))
-  
   (define (drop-to-lw-and1 lst)
     (let loop ([lst lst])
       (cond
@@ -713,6 +707,8 @@
       [(symbol? atom)
        (list (or (rewrite-atomic col span atom literal-style)
                  (make-string-token col span (symbol->string atom) (literal-style))))]
+      [(member atom '("(" ")" "[" "]" "{" "}"))
+       (list (make-string-token col span atom (paren-style)))]
       [(string? atom)
        (list (make-string-token col span atom (default-style)))]
       [else (error 'atom->tokens "unk ~s" atom)]))
@@ -757,6 +753,7 @@
   (define non-terminal-superscript-style (make-parameter `(superscript . ,(non-terminal-style))))
   (define default-style (make-parameter 'roman))
   (define grammar-style (make-parameter 'roman))
+  (define paren-style (make-parameter 'roman))
   (define metafunction-style (make-parameter 'swiss))
   (define (metafunction-text str) ((current-text) str (metafunction-style) (metafunction-font-size)))
   (define literal-style (make-parameter 'swiss))
diff --git a/collects/redex/private/pict.rkt b/collects/redex/private/pict.rkt
index 18fac2db14..4b0faaaeff 100644
--- a/collects/redex/private/pict.rkt
+++ b/collects/redex/private/pict.rkt
@@ -34,6 +34,7 @@
          
          default-style
          grammar-style
+         paren-style
          label-style
          literal-style
          metafunction-style
diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl
index 23390a502f..a2d8891527 100644
--- a/collects/redex/redex.scrbl
+++ b/collects/redex/redex.scrbl
@@ -2058,6 +2058,7 @@ cases appear. If it is a list of numbers, then only the selected cases appear (c
 @deftogether[[
 @defparam[label-style style text-style/c]{}
 @defparam[grammar-style style text-style/c]{}
+@defparam[paren-style style text-style/c]{}
 @defparam[literal-style style text-style/c]{}
 @defparam[metafunction-style style text-style/c]{}
 @defparam[non-terminal-style style text-style/c]{}
@@ -2077,7 +2078,12 @@ The @racket[label-style] is used for the reduction rule label
 names. The @racket[literal-style] is used for names that aren't
 non-terminals that appear in patterns. The
 @racket[metafunction-style] is used for the names of
-metafunctions. The @racket[grammar-style] is used for the ``::='' and ``|''
+metafunctions. 
+The @racket[paren-style] is used for the parentheses 
+(including ``['', ``]'', ``@"{"'', and ``@"}"'',
+as well as ``('' and ``)''), but not for the square brackets used for
+in-hole decompositions, which use the @racket[default-style].
+The @racket[grammar-style] is used for the ``::='' and ``|''
 in grammars.
 
 The @racket[non-terminal-style] is used for the names of non-terminals.
diff --git a/doc/release-notes/redex/HISTORY.txt b/doc/release-notes/redex/HISTORY.txt
index d339c71d4b..d99354cf7c 100644
--- a/doc/release-notes/redex/HISTORY.txt
+++ b/doc/release-notes/redex/HISTORY.txt
@@ -1,3 +1,6 @@
+  * added grammar-style and paren-style that give finer-grained control
+    over the typesetting styles
+
 v5.0.1
 
   * changed the matching of `where' clauses in a