suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix scribble make-base-eval racket/pretty namespace error

Browse Source 
closes pr 14066

original commit: b7360c76d7bdda4d6973bc09f0266b4dc0c9dc84
This commit is contained in:
Stephen Chang 2014-03-04 16:25:54 -05:00
parent 3d40e770ef
commit b11717253d
1 changed files with 19 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
pkgs/scribble-pkgs/scribble-lib/scribble/eval.rkt
View File

@ -337,30 +337,29 @@
[(eq? stx 'code:blank) (void)] [(eq? stx 'code:blank) (void)]
[else stx])) [else stx]))
(define (install-pretty-printer! e ns)
(call-in-sandbox-context e
(lambda ()
(namespace-attach-module ns 'racket/pretty)
(current-print (dynamic-require 'racket/pretty 'pretty-print-handler)))))
(define (make-base-eval #:lang [lang '(begin)] #:pretty-print? [pretty-print? #t] . ips) (define (make-base-eval #:lang [lang '(begin)] #:pretty-print? [pretty-print? #t] . ips)
(call-with-trusted-sandbox-configuration (call-with-trusted-sandbox-configuration
(lambda () (lambda ()
(parameterize ([sandbox-output 'string] (parameterize ([sandbox-output 'string]
[sandbox-error-output 'string] [sandbox-error-output 'string]
[sandbox-propagate-breaks #f]) [sandbox-propagate-breaks #f]
[sandbox-namespace-specs
(append (sandbox-namespace-specs)
(if pretty-print?
'(racket/pretty file/convertible)
'(file/convertible)))])
(let ([e (apply make-evaluator lang ips)]) (let ([e (apply make-evaluator lang ips)])
(let ([ns (namespace-anchor->namespace anchor)]) (when pretty-print?
(call-in-sandbox-context (call-in-sandbox-context e
e (lambda ()
(lambda () (namespace-attach-module ns 'file/convertible))) (current-print (dynamic-require 'racket/pretty 'pretty-print-handler)))))
(when pretty-print? (install-pretty-printer! e ns)))
e))))) e)))))
(define (make-base-eval-factory mod-paths (define (make-base-eval-factory mod-paths
#:lang [lang '(begin)] #:lang [lang '(begin)]
#:pretty-print? [pretty-print? #t] . ips) #:pretty-print? [pretty-print? #t] . ips)
(let ([ns (delay (let ([ns (parameterize ([sandbox-namespace-specs
(cons (λ () (let ([ns
;; This namespace-creation choice needs to be consistent ;; This namespace-creation choice needs to be consistent
;; with the sandbox (i.e., with `make-base-eval') ;; with the sandbox (i.e., with `make-base-eval')
(if gui? (if gui?
@ -370,16 +369,14 @@
(for ([mod-path (in-list mod-paths)]) (for ([mod-path (in-list mod-paths)])
(dynamic-require mod-path #f)) (dynamic-require mod-path #f))
(when pretty-print? (dynamic-require 'racket/pretty #f))) (when pretty-print? (dynamic-require 'racket/pretty #f)))
ns))]) ns))
(append mod-paths (if pretty-print? '(racket/pretty) '())))])
(lambda () (lambda ()
(let ([ev (apply make-base-eval #:lang lang #:pretty-print? #f ips)] (let ([ev (apply make-base-eval #:lang lang #:pretty-print? #f ips)])
[ns (force ns)]) (when pretty-print?
(when pretty-print? (install-pretty-printer! ev ns)) (call-in-sandbox-context ev
(call-in-sandbox-context (lambda ()
ev (current-print (dynamic-require 'racket/pretty 'pretty-print-handler)))))
(lambda ()
(for ([mod-path (in-list mod-paths)])
(namespace-attach-module ns mod-path))))
ev)))) ev))))
(define (make-eval-factory mod-paths (define (make-eval-factory mod-paths