racket/gui/dynamic: make gui-dynamic-require' pull from racket/gui/base'

It was pulling from `scheme/gui/base', instead. The one from `scheme/gui/base'
is now different and still pulls from `scheme/gui/base'.

This could break some programs that accidentally depended on `scheme/gui/base'
exports from `gui-dynamic-require', but it's more likely to fix problems.
This commit is contained in:
Matthew Flatt 2012-11-19 08:13:48 -07:00
parent d90fbaeff4
commit 702df4b07a
5 changed files with 40 additions and 10 deletions

View File

@ -23,10 +23,9 @@
(eq? (dynamic-require 'mred/private/dynamic 'kernel-initialized)
'done))))
(define-namespace-anchor anchor)
(define (gui-dynamic-require sym)
(parameterize ([current-namespace (namespace-anchor->empty-namespace anchor)])
(parameterize ([current-namespace (variable-reference->empty-namespace
(#%variable-reference))])
(if (gui-available?)
(dynamic-require 'mred sym)
(dynamic-require 'racket/gui/base sym)
(error "racket/gui/base is not available"))))

View File

@ -1,2 +1,13 @@
#lang scheme/private/provider
racket/gui/dynamic
#lang racket/base
(require (only-in racket/gui/dynamic
gui-available?))
(provide gui-available?
gui-dynamic-require)
(define (gui-dynamic-require sym)
(parameterize ([current-namespace (variable-reference->empty-namespace
(#%variable-reference))])
(if (gui-available?)
(dynamic-require 'mred sym)
(error "scheme/gui/base is not available"))))

View File

@ -8,6 +8,7 @@
(only-in racket/base struct hash hasheq hasheqv in-directory local-require)
(only-in racket/unit struct/ctc)
(only-in scheme/gui/base make-gui-namespace make-gui-empty-namespace)
(only-in scheme/gui/dynamic gui-dynamic-require)
(only-in mzlib/unit struct~s struct~s/ctc)
scheme/gui/base
scheme/sandbox))
@ -20,12 +21,14 @@
make-evaluator-id
make-module-evaluator-id
pretty-print-id
printable<%>-id)
printable<%>-id
gui-dynamic-require-id)
(begin
(require (for-label (only-in scheme struct struct/ctc)
(only-in racket/base make-base-namespace
make-base-empty-namespace)
(only-in racket/pretty pretty-print)
(only-in racket/gui/dynamic gui-dynamic-require)
racket/sandbox))
(define unit-struct (racket struct))
(define unit-struct/ctc (racket struct/ctc))
@ -35,7 +38,8 @@
(define make-evaluator-id (racket make-evaluator))
(define make-module-evaluator-id (racket make-module-evaluator))
(define pretty-print-id (racket pretty-print))
(define printable<%>-id (racket printable<%>))))
(define printable<%>-id (racket printable<%>))
(define gui-dynamic-require-id (racket gui-dynamic-require))))
@(def-extras unit-struct
unit-struct/ctc
make-base-namespace-id
@ -44,7 +48,8 @@
make-evaluator-id
make-module-evaluator-id
pretty-print-id
printable<%>-id)
printable<%>-id
gui-dynamic-require-id)
@(define-syntax-rule (compat-except sid rid . rest)
(begin
@ -158,6 +163,8 @@ must occur after all the @racket[provide*] forms to which it refers.}
@compat-except[scheme/gui racket/gui]{, except that it builds on
@racketmodname[scheme/gui/base] instead of @racketmodname[racket/gui/base]}
@; ----------------------------------------------------------------------
@compat-except[scheme/gui/base racket/gui/base]{, except that it builds on
@racketmodname[scheme] instead of @racketmodname[racket]}
@ -175,7 +182,16 @@ environment of the result namespace.}
@; ----------------------------------------------------------------------
@compat[scheme/gui/dynamic racket/gui/dynamic]
@compat-except[scheme/gui/dynamic racket/gui/dynamic]{, except
that @racket[gui-dynamic-require] extracts bindings from @racket[mred]
instead of @racket[scheme/gui/base]}
@defproc[(gui-dynamic-require [sym symbol?]) any]{
Like @|gui-dynamic-require-id| from @racket[racket/gui/base], but
to access exports of @racketmodname[scheme/gui/base].}
@; ----------------------------------------------------------------------
@compat[scheme/help racket/help]
@compat[scheme/include racket/include]
@; ----------------------------------------------------------------------

View File

@ -6,4 +6,6 @@
(let ([ns ((gui-dynamic-require 'make-gui-namespace))]
[orig-ns (current-namespace)])
(unless (namespace-variable-value 'hash #t (lambda () #f) ns)
(error "expected a binding for `hash'"))
(namespace-attach-module orig-ns 'racket/base ns))

View File

@ -6,4 +6,6 @@
(let ([ns ((gui-dynamic-require 'make-gui-namespace))]
[orig-ns (current-namespace)])
(when (namespace-variable-value 'hash #t (lambda () #f) ns)
(error "did not expect a binding for `hash'"))
(namespace-attach-module orig-ns 'scheme/base ns))