From 23299ef25c9f1a58361792cb0f0b7f0c719a5b32 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 12 Dec 2007 13:47:02 +0000 Subject: [PATCH] revised mzlib/sandbox in scheme/sandbox svn: r7965 original commit: 622cd0554d57fc1c5f1dc03c69504703181eec18 --- collects/mred/mred-sig.ss | 3 +- collects/mred/mred.ss | 41 +++++++++++--------- collects/scheme/gui/base.ss | 4 ++ collects/scribblings/gui/dynamic.scrbl | 28 +++++++++++++ collects/scribblings/gui/gui.scrbl | 12 +++--- collects/scribblings/gui/miscwin-funcs.scrbl | 24 +++++------- 6 files changed, 73 insertions(+), 39 deletions(-) create mode 100644 collects/scheme/gui/base.ss create mode 100644 collects/scribblings/gui/dynamic.scrbl diff --git a/collects/mred/mred-sig.ss b/collects/mred/mred-sig.ss index 34a0752b..3ddd2598 100644 --- a/collects/mred/mred-sig.ss +++ b/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% diff --git a/collects/mred/mred.ss b/collects/mred/mred.ss index f10f1c52..9f9bbeeb 100644 --- a/collects/mred/mred.ss +++ b/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 diff --git a/collects/scheme/gui/base.ss b/collects/scheme/gui/base.ss new file mode 100644 index 00000000..dd18b645 --- /dev/null +++ b/collects/scheme/gui/base.ss @@ -0,0 +1,4 @@ +#lang scheme/base + +(require mred) +(provide (all-from-out mred)) diff --git a/collects/scribblings/gui/dynamic.scrbl b/collects/scribblings/gui/dynamic.scrbl new file mode 100644 index 00000000..a33df354 --- /dev/null +++ b/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].} diff --git a/collects/scribblings/gui/gui.scrbl b/collects/scribblings/gui/gui.scrbl index 39cf5404..3c48abc3 100644 --- a/collects/scribblings/gui/gui.scrbl +++ b/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"] @;------------------------------------------------------------------------ diff --git a/collects/scribblings/gui/miscwin-funcs.scrbl b/collects/scribblings/gui/miscwin-funcs.scrbl index 4b4d14ad..d94b97c1 100644 --- a/collects/scribblings/gui/miscwin-funcs.scrbl +++ b/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.}