diff --git a/pkgs/redex-pkgs/redex-doc/redex/scribblings/ref.scrbl b/pkgs/redex-pkgs/redex-doc/redex/scribblings/ref.scrbl
index 8d8f4afbe5..cfd5957584 100644
--- a/pkgs/redex-pkgs/redex-doc/redex/scribblings/ref.scrbl
+++ b/pkgs/redex-pkgs/redex-doc/redex/scribblings/ref.scrbl
@@ -3041,7 +3041,8 @@ This function sets @racket[dc-for-text-size]. See also
 
 @defparam[extend-language-show-union show? boolean?]{
 
-If this is @racket[#t], then a language constructed with
+A parameter that controls the rendering of extended languages.
+If the parameter value is @racket[#t], then a language constructed with
 extend-language is shown as if the language had been
 constructed directly with @racket[language]. If it is @racket[#f], then only
 the last extension to the language is shown (with
@@ -3054,6 +3055,18 @@ Note that the @racket[#t] variant can look a little bit strange if
 multi-line right-hand sides.
 }
 
+@defparam[extend-language-show-extended-order ext-order? boolean?]{
+
+A parameter that controls the rendering of extended languages when
+@racket[extend-language-show-union] has a true value.  If this
+parameter's value is @racket[#t], then productions are shown as
+ordered in the language extension instead of the order of the
+original, unextended language.
+
+Defaults to @racket[#f].
+
+@history[#:added "1.2"]}
+
 @defparam[render-reduction-relation-rules 
           rules 
           (or/c false/c 
diff --git a/pkgs/redex-pkgs/redex-lib/info.rkt b/pkgs/redex-pkgs/redex-lib/info.rkt
index 9dd2f4231a..d256bbd763 100644
--- a/pkgs/redex-pkgs/redex-lib/info.rkt
+++ b/pkgs/redex-pkgs/redex-lib/info.rkt
@@ -18,4 +18,4 @@
 
 (define pkg-authors '(robby bfetscher))
 
-(define version "1.1")
+(define version "1.2")
diff --git a/pkgs/redex-pkgs/redex-pict-lib/redex/pict.rkt b/pkgs/redex-pkgs/redex-pict-lib/redex/pict.rkt
index 5ec8cbd113..7148ed7565 100644
--- a/pkgs/redex-pkgs/redex-pict-lib/redex/pict.rkt
+++ b/pkgs/redex-pkgs/redex-pict-lib/redex/pict.rkt
@@ -61,6 +61,7 @@
 (provide/contract
  [render-language-nts (parameter/c (or/c false/c (listof (or/c string? symbol?))))]
  [extend-language-show-union (parameter/c boolean?)]
+ [extend-language-show-extended-order (parameter/c boolean?)]
  [current-text (parameter/c (-> string? text-style/c number? pict?))])
 
 (provide/contract
diff --git a/pkgs/redex-pkgs/redex-pict-lib/redex/private/pict.rkt b/pkgs/redex-pkgs/redex-pict-lib/redex/private/pict.rkt
index c446516e71..da931fc935 100644
--- a/pkgs/redex-pkgs/redex-pict-lib/redex/private/pict.rkt
+++ b/pkgs/redex-pkgs/redex-pict-lib/redex/private/pict.rkt
@@ -80,6 +80,7 @@
          judgment-form-cases
          compact-vertical-min-width
          extend-language-show-union
+         extend-language-show-extended-order
          set-arrow-pict!
          arrow->pict
          horizontal-bar-spacing
@@ -573,7 +574,7 @@
 ;; raw-info : language-pict-info
 ;; nts : (listof symbol) -- the nts that the user expects to see
 (define (make-grammar-pict raw-info nts all-nts)
-  (let* ([info (remove-unwanted-nts nts (flatten-grammar-info raw-info all-nts))]
+  (let* ([info (remove-unwanted-nts nts (flatten-grammar-info raw-info all-nts nts))]
          [term-space 
           (launder
            (ghost
@@ -604,6 +605,7 @@
 
 
 (define extend-language-show-union (make-parameter #f))
+(define extend-language-show-extended-order (make-parameter #f))
 
 ;; remove-unwanted-nts : (listof symbol) flattened-language-pict-info -> flattened-language-pict-info
 (define (remove-unwanted-nts nts info)
@@ -615,32 +617,53 @@
 
 
 ;; flatten-grammar-info : language-pict-info (listof symbol) -> flattened-language-pict-info
-(define (flatten-grammar-info info all-nts)
-  (let ([union? (extend-language-show-union)])
+(define (flatten-grammar-info info all-nts wanted-nts)
+  (define (merge-line nt extension orig-line)
+    (cond
+     [(and extension orig-line)
+      (let ([rhss (cdr extension)])
+        (cons nt
+              (map (λ (x)
+                     (if (and (lw? x) (eq? '.... (lw-e x)))
+                         (struct-copy lw
+                                      x
+                                      [e
+                                       (lw->pict all-nts
+                                                 (find-enclosing-loc-wrapper
+                                                  (add-bars (cdr orig-line))))])
+                         x))
+                   (cdr extension))))]
+     [extension extension]
+     [else orig-line]))
+  (let ([union? (extend-language-show-union)]
+        [ext-order? (extend-language-show-extended-order)])
     (let loop ([info info])
       (cond
         [(vector? info) 
          (let ([orig (loop (vector-ref info 0))]
                [extensions (vector-ref info 1)])
            (if union?
-               (map (λ (orig-line)
-                      (let* ([nt (car orig-line)]
-                             [extension (assoc nt extensions)])
-                        (if extension
-                            (let ([rhss (cdr extension)])
-                              (cons nt
-                                    (map (λ (x) 
-                                           (if (and (lw? x) (eq? '.... (lw-e x)))
-                                               (struct-copy lw
-                                                            x
-                                                            [e
-                                                             (lw->pict all-nts
-                                                                       (find-enclosing-loc-wrapper
-                                                                        (add-bars (cdr orig-line))))])
-                                               x))
-                                         (cdr extension))))
-                            orig-line)))
-                    orig)
+               (cond
+                [(not ext-order?)
+                 ;; Use original order, adding extra extensions after:
+                 (define orig-nts (list->set (map car orig)))
+                 (append
+                  (map (λ (orig-line)
+                         (define nt (car orig-line))
+                         (merge-line nt (assoc nt extensions) orig-line))
+                       orig)
+                  (filter (lambda (extension) (not (set-member? orig-nts (car extension))))
+                          extensions))]
+                [else
+                 ;; Use extension order, adding any extra originals after:
+                 (define ext-nts (list->set (map car extensions)))
+                 (append
+                  (map (λ (extension)
+                         (define nt (car extension))
+                         (merge-line nt extension (assoc nt orig)))
+                       extensions)
+                  (filter (lambda (orig-line) (not (set-member? ext-nts (car orig-line))))
+                          orig))])
                extensions))]
         [else info]))))