revised mzlib/sandbox in scheme/sandbox

svn: r7965

original commit: 622cd0554d57fc1c5f1dc03c69504703181eec18

collects/mred/mred-sig.ss

@@ -118,7 +118,8 @@ labelled-menu-item<%>
 list-box%
 list-control<%>
 make-eventspace
-make-namespace-with-mred
+make-gui-empty-namespace
+make-gui-namespace
 map-command-as-meta-key
 menu%
 menu-bar%

collects/mred/mred.ss

@@ -1,5 +1,10 @@
 (module mred mzscheme
-  (require (lib "etc.ss")
+  (require (only scheme/base
+                 define-namespace-anchor
+                 namespace-anchor->empty-namespace
+                 make-base-empty-namespace)
+           scheme/class
+           (lib "etc.ss")
 	   (prefix wx: "private/kernel.ss")
 	   "private/wxtop.ss"
 	   "private/app.ss"
@@ -37,23 +42,22 @@
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-  (define mred-module-name '(lib "mred/mred.ss"))
-  (define class-module-name '(lib "scheme/class.ss"))
+  (define-namespace-anchor anchor)
 
-  (define make-namespace-with-mred
-    (opt-lambda ([flag 'mred])
-      (unless (memq flag '(initial mred empty))
-	(raise-type-error 'make-namespace-with-mred
-			  "flag symbol, one of 'mred, 'initial, or 'empty"
-			  flag))
-      (let ([orig (current-namespace)]
-	    [ns (make-namespace (if (eq? flag 'empty) 'empty 'initial))])
-	(parameterize ([current-namespace ns])
-	  (namespace-attach-module orig mred-module-name)
-	  (when (eq? flag 'mred)
-	    (namespace-require mred-module-name)
-	    (namespace-require class-module-name)))
-	ns)))
+  (define (make-gui-empty-namespace)
+    (let ([ns (make-base-empty-namespace)])
+      (namespace-attach-module (namespace-anchor->empty-namespace anchor)
+                               'mred/mred
+                               ns)
+      ns))
+
+  (define (make-gui-namespace)
+    (let ([ns (make-gui-empty-namespace)])
+      (parameterize ([current-namespace ns])
+        (namespace-require 'scheme/base)
+        (namespace-require 'mred/mred)
+        (namespace-require 'scheme/class))
+      ns))
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -287,7 +291,8 @@
 	   current-eventspace-has-standard-menus?
 	   current-eventspace-has-menu-root?
 	   eventspace-handler-thread
-	   make-namespace-with-mred
+	   make-gui-namespace
+	   make-gui-empty-namespace
 	   file-creator-and-type
 	   current-ps-afm-file-paths
 	   current-ps-cmap-file-paths

collects/scheme/gui/base.ss

@@ -0,0 +1,4 @@
+#lang scheme/base
+
+(require mred)
+(provide (all-from-out mred))

collects/scribblings/gui/dynamic.scrbl

@@ -0,0 +1,28 @@
+#lang scribble/doc
+@require["common.ss"
+         (for-label scheme/gui/dynamic)]
+
+@title{Dynamic Loading}
+
+@defmodule[scheme/gui/dynamic]{The @schememodname[scheme/gui/dynamic]
+library provides functiosn for dynamically accessing the PLT Scheme
+GUI toolbox, instead of directly requiring @scheme[scheme/gui] or
+@scheme[scheme/gui/base].}
+
+@defproc[(gui-available?) boolean?]{
+
+Returns @scheme[#t] if dynamic access to the GUI bindings are
+available---that is, that the program is being run as a
+@exec{mred}-based application, as opposed to a pure
+@exec{mzscheme}-based application, and that GUI modules are attached
+to the namespace in which @scheme[scheme/gui/dynamic] was
+instantiated.
+
+This predicate can be used in code that optionally uses GUI elements
+when they are available.}
+
+
+@defproc[(gui-dynamic-require [sym symbol?]) any]{
+
+Like @scheme[dynamic-require], but specifically to access exports of
+@scheme[scheme/gui/base].}

collects/scribblings/gui/gui.scrbl

@@ -4,20 +4,21 @@
 @title[#:tag-prefix '(lib "scribblings/gui/gui.scrbl") 
        #:tag "top"]{PLT Scheme GUI: MrEd}
 
-@declare-exporting[mred scheme/gui]
+@declare-exporting[scheme/gui/base scheme/gui]
 
 This reference manual describes the MrEd GUI toolbox that is part of
  PLT Scheme. See @secref[#:doc '(lib "scribblings/guide/guide.scrbl")
  "mred"] in @italic{@link["../guide/index.html"]{A Guide to PLT
  Scheme}} for an introduction to MrEd.
 
-@defmodule*/no-declare[(mred)]{The @schememodname[mred] module provides
-all of the class, interface, and procedure bindings defined in this
-manual.}
+@defmodule*/no-declare[(scheme/gui/base)]{The
+@schememodname[scheme/gui/base] module provides all of the class,
+interface, and procedure bindings defined in this manual.}
 
 @defmodulelang*/no-declare[(scheme/gui)]{The
 @schememodname[scheme/gui] language combines all bindings of the
-@schememodname[scheme] language and the @schememodname[mred] module.}
+@schememodname[scheme] language and the
+@schememodname[scheme/gui/base] modules.}
 
 
 @table-of-contents[]
@@ -27,6 +28,7 @@ manual.}
 @include-section["guide.scrbl"]
 @include-section["reference.scrbl"]
 @include-section["config.scrbl"]
+@include-section["dynamic.scrbl"]
 
 @;------------------------------------------------------------------------
 

collects/scribblings/gui/miscwin-funcs.scrbl

@@ -424,22 +424,16 @@ If the AppleEvent reply contains a value that cannot be
 
 }
 
-@defproc[(make-namespace-with-mred [flag (one-of/c 'mred 'initial 'empty) 'mred])
+@defproc[(make-gui-empty-namespace)
          namespace?]{
 
-Like @scheme[make-namespace], but the @scheme[(lib "mred.ss"
- "mred")] module of the current namespace is attached. In addition, by
- default, the namespace is initialized by importing the @filepath{mred.ss}
- module and MzLib's @indexed-file{class.ss} module into the
- namespace's top-level environment.
+Like @scheme[make-base-empty-namespace], but with
+@scheme[scheme/class] and @schememodname[scheme/gui/base] also
+attached to the result namespace.}
 
+@defproc[(make-gui-namespace)
+         namespace?]{
 
-The @scheme['initial] and @scheme['empty] flags control the namespace
- creation in the same way as for @scheme[make-namespace], except that
- the @filepath{mred.ss} module is attached to the created namespace (along
- with the transitive closure of its imports). The @scheme['mred] flag
- is like @scheme['initial], but also imports the @filepath{mred.ss} module
- and MzLib's @indexed-file{class.ss} module into the namespace's
- top-level environment.
-
-}
+Like @scheme[make-base-namespace], but with @scheme[scheme/class] and
+@schememodname[scheme/gui/base] also required into the top-level
+environment of the result namespace.}