From 213430f728b33486fcc8334058a833f9d8c9de78 Mon Sep 17 00:00:00 2001
From: David Van Horn <dvanhorn@ccs.neu.edu>
Date: Fri, 22 Feb 2013 19:01:42 -0500
Subject: [PATCH] Add #:lang and input-program inputs to make-base-eval and
 friends.

This commit extends make-base-eval, make-base-eval-factory, and
make-eval-factory with an #:eval and input-program inputs so that
these functions are more like racket/sandbox make-evaluator.
---
 collects/scribble/eval.rkt               | 14 ++++++++------
 collects/scribblings/scribble/eval.scrbl | 24 ++++++++++++++++++++----
 doc/release-notes/racket/HISTORY.txt     |  2 ++
 3 files changed, 30 insertions(+), 10 deletions(-)

diff --git a/collects/scribble/eval.rkt b/collects/scribble/eval.rkt
index 9af9db7597..6ec781b5c2 100644
--- a/collects/scribble/eval.rkt
+++ b/collects/scribble/eval.rkt
@@ -342,13 +342,13 @@
       (namespace-attach-module ns 'racket/pretty)
       (current-print (dynamic-require 'racket/pretty 'pretty-print-handler)))))
 
-(define (make-base-eval #:pretty-print? [pretty-print? #t])
+(define (make-base-eval #:lang [lang '(begin)] #:pretty-print? [pretty-print? #t] . ips)
   (call-with-trusted-sandbox-configuration
    (lambda ()
      (parameterize ([sandbox-output 'string]
                     [sandbox-error-output 'string]
                     [sandbox-propagate-breaks #f])
-       (let ([e (make-evaluator '(begin))])
+       (let ([e (apply make-evaluator lang ips)])
          (let ([ns (namespace-anchor->namespace anchor)])
            (call-in-sandbox-context
             e
@@ -357,7 +357,8 @@
          e)))))
 
 (define (make-base-eval-factory mod-paths
-                                #:pretty-print? [pretty-print? #t])
+                                #:lang [lang '(begin)]
+                                #:pretty-print? [pretty-print? #t] . ips)
   (let ([ns (delay (let ([ns 
                           ;; This namespace-creation choice needs to be consistent
                           ;; with the sandbox (i.e., with `make-base-eval')
@@ -370,7 +371,7 @@
                        (when pretty-print? (dynamic-require 'racket/pretty #f)))
                      ns))])
     (lambda ()
-      (let ([ev (make-base-eval #:pretty-print? #f)]
+      (let ([ev (apply make-base-eval #:lang lang #:pretty-print? #f ips)]
             [ns (force ns)])
         (when pretty-print? (install-pretty-printer! ev ns))
         (call-in-sandbox-context
@@ -381,8 +382,9 @@
         ev))))
 
 (define (make-eval-factory mod-paths
-                           #:pretty-print? [pretty-print? #t])
-  (let ([base-factory (make-base-eval-factory mod-paths #:pretty-print? pretty-print?)])
+                           #:lang [lang '(begin)]
+                           #:pretty-print? [pretty-print? #t] . ips)
+  (let ([base-factory (apply make-base-eval-factory mod-paths #:lang lang #:pretty-print? pretty-print? ips)])
     (lambda ()
       (let ([ev (base-factory)])
         (call-in-sandbox-context
diff --git a/collects/scribblings/scribble/eval.scrbl b/collects/scribblings/scribble/eval.scrbl
index 418706261f..0411aea211 100644
--- a/collects/scribblings/scribble/eval.scrbl
+++ b/collects/scribblings/scribble/eval.scrbl
@@ -155,10 +155,16 @@ Like @racket[examples], but each definition using @racket[define] or
 prompt, and with line of space after it.}
 
 
-@defproc[(make-base-eval [#:pretty-print? pretty-print? any/c #t])
+@defproc[(make-base-eval [#:pretty-print? pretty-print? any/c #t]
+                         [#:lang lang
+                          (or/c module-path?
+                                (list/c 'special symbol?)
+                                (cons/c 'begin list?))
+                          '(begin)]
+                         [input-program any/c] ...)
          (any/c . -> . any)]{
 
-Creates an evaluator using @racket[(make-evaluator 'racket/base)],
+Creates an evaluator using @racket[(make-evaluator 'racket/base #:lang lang input-program ...)],
 setting sandbox parameters to disable limits, setting the outputs to
 @racket['string], and not adding extra security guards.
 
@@ -167,7 +173,12 @@ If @racket[pretty-print?] is true, the sandbox's printer is set to
 
 
 @defproc[(make-base-eval-factory [mod-paths (listof module-path?)]
-                                 [#:pretty-print? pretty-print? any/c #t])
+                                 [#:pretty-print? pretty-print? any/c #t]
+                                 [#:lang lang
+                                  (or/c module-path?
+                                        (list/c 'special symbol?)
+                                        (cons/c 'begin list?))
+                                  '(begin)])
          (-> (any/c . -> . any))]{
 
 Produces a function that is like @racket[make-base-eval], except that
@@ -178,7 +189,12 @@ time) and then attached to each evaluator that is created.}
 
 
 @defproc[(make-eval-factory [mod-paths (listof module-path?)]
-                            [#:pretty-print? pretty-print? any/c #t])
+                            [#:pretty-print? pretty-print? any/c #t]
+                            [#:lang lang
+                             (or/c module-path?
+                                   (list/c 'special symbol?)
+                                   (cons/c 'begin list?))
+                             '(begin)])
          (-> (any/c . -> . any))]{
 
 Like @racket[make-base-eval-factory], but each module in @racket[mod-paths] is
diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt
index 6fa918524d..4a0b84eb55 100644
--- a/doc/release-notes/racket/HISTORY.txt
+++ b/doc/release-notes/racket/HISTORY.txt
@@ -4,6 +4,8 @@ racket/udp: added multicast support: udp-multicast-join-group!,
  udp-multicast-set-interface!, udp-multicast-set-loopback!,
  udp-multicast-loopback?, udp-multicast-set-ttl!,
  udp-multicast-ttl
+scribble/eval: extended make-base-eval to be more like
+ make-evaluator
 
 Version 5.3.3.8
 slideshow/pict: added color% objects to text-style/c