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

Eli

Browse Source 
svn: r4850
This commit is contained in:
Jay McCarthy 2006-11-14 07:37:38 +00:00
parent 56a3701974
commit d86225e2df
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/web-server/private/configuration.ss
View File

@ -1,6 +1,7 @@
(module configuration mzscheme (module configuration mzscheme
(require (lib "unitsig.ss") (require (lib "unitsig.ss")
(lib "kw.ss") (lib "kw.ss")
(lib "list.ss")
(lib "contract.ss")) (lib "contract.ss"))
(require "configuration-structures.ss" (require "configuration-structures.ss"
"configuration-table-structs.ss" "configuration-table-structs.ss"
@ -56,13 +57,13 @@
;; GregP: putting mred.ss here is a bad idea because it will cause ;; GregP: putting mred.ss here is a bad idea because it will cause
;; web-server-text to have a dependency on mred ;; web-server-text to have a dependency on mred
;; JM: We get around it by only doing it if the module is already attached. ;; JM: We get around it by only doing it if the module is already attached.
; (lib "mred.ss" "mred") (lib "mred.ss" "mred")
(lib "servlet.ss" "web-server"))) (lib "servlet.ss" "web-server")))
; end stolen ; end stolen
(define/kw (make-make-servlet-namespace (define/kw (make-make-servlet-namespace
#:key #:key
[to-be-copied-module-specs default-to-be-copied-module-specs]) [to-be-copied-module-specs empty])
; JBC : added error-handler hack; the right answer is only to transfer the 'mred' ; JBC : added error-handler hack; the right answer is only to transfer the 'mred'
; module binding when asked to, e.g. by a field in the configuration file. ; module binding when asked to, e.g. by a field in the configuration file.
; GregP: put this back in if Sam's code breaks ; GregP: put this back in if Sam's code breaks
@ -79,14 +80,17 @@
(if (symbol? spec) (if (symbol? spec)
spec spec
((current-module-name-resolver) spec #f #f)))]) ((current-module-name-resolver) spec #f #f)))])
(map get-name to-be-copied-module-specs))) (map get-name
(append default-to-be-copied-module-specs
to-be-copied-module-specs))))
;end stolen ;end stolen
(lambda () (lambda ()
(define server-namespace (current-namespace)) (define server-namespace (current-namespace))
(define new-namespace (make-namespace)) (define new-namespace (make-namespace))
(parameterize ([current-namespace new-namespace]) (parameterize ([current-namespace new-namespace])
(for-each (lambda (name) (for-each (lambda (name)
(namespace-attach-module server-namespace name)) (with-handlers ([exn? void])
(namespace-attach-module server-namespace name)))
to-be-copied-module-names) to-be-copied-module-names)
new-namespace))) new-namespace)))