suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: f708a5f520ca9567ba4dbc160fa166eda0c7c88a
This commit is contained in:
Matthew Flatt 2004-06-01 13:33:41 +00:00
parent d945d6322f
commit 0753399f96
1 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/mred/mred.ss
View File

@ -7705,6 +7705,11 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define mred-module-name ((current-module-name-resolver)
'(lib "mred.ss" "mred") #f #f))
(define class-module-name ((current-module-name-resolver)
'(lib "class.ss") #f #f))
(define make-namespace-with-mred
(opt-lambda ([flag 'mred])
(unless (memq flag '(initial mred empty))
@ -7712,14 +7717,12 @@
"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)
(namespace-attach-module orig mred-module-name)
(when (eq? flag 'mred)
(namespace-require '(lib "mred.ss" "mred"))
(namespace-require '(lib "class.ss"))))
(namespace-require mred-module-name)
(namespace-require class-module-name)))
ns)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;