original commit: 24955de0f7e89a4d94461fe8d30ed8186ec1500a
This commit is contained in:
Matthew Flatt 2002-10-17 21:15:16 +00:00
parent 1922e08073
commit 0c4a60ec11
2 changed files with 22 additions and 1 deletions

View File

@ -105,6 +105,7 @@
list-box% list-box%
list-control<%> list-control<%>
make-eventspace make-eventspace
make-namespace-with-mred
menu% menu%
menu-bar% menu-bar%
menu-item% menu-item%

View File

@ -6920,6 +6920,25 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)]
[mred-name ((current-module-name-resolver)
'(lib "mred.ss" "mred") #f #f)]
[ns (make-namespace (if (eq? flag 'empty) 'empty 'initial))])
(parameterize ([current-namespace ns])
(namespace-attach-module orig mred-name)
(when (eq? flag 'mred)
(namespace-require '(lib "mred.ss" "mred"))
(namespace-require '(lib "class.ss"))))
ns)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax propagate (define-syntax propagate
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()
@ -7119,7 +7138,8 @@
text-editor-load-handler text-editor-load-handler
application-about-handler application-about-handler
application-preferences-handler application-preferences-handler
current-eventspace-has-standard-menus?) current-eventspace-has-standard-menus?
make-namespace-with-mred)
) ;; end of module ) ;; end of module