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

wrap dynamic requires with original code inspector

Browse Source 
svn: r1596
This commit is contained in:
Matthew Flatt 2005-12-12 19:01:52 +00:00
parent 4436cec431
commit ad629c682b
1 changed files with 16 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/slideshow/tool.ss
View File

@ -38,7 +38,7 @@ pict snip :
get-snp/poss
build-lib-pict-stx)
(define orig-inspector (current-inspector))
(define orig-inspector (current-code-inspector))
(define-syntax syntax/cert
(syntax-rules ()
@ -653,21 +653,25 @@ pict snip :
(define system-eventspace (current-eventspace))
(define (ss-dynamic-require lib id)
(parameterize ([current-code-inspector orig-inspector])
(dynamic-require lib id)))
;; send-over : any syntax -> void
;; thread: (any) user's thread
(define (send-over v stx)
(let ([rep (drscheme:rep:current-rep)])
(when rep
(let ([pict? (dynamic-require '(lib "mrpict.ss" "texpict") 'pict?)])
(let ([pict? (ss-dynamic-require '(lib "mrpict.ss" "texpict") 'pict?)])
(when (pict? v)
(let* ([make-pict-drawer (dynamic-require '(lib "mrpict.ss" "texpict") 'make-pict-drawer)]
[width ((dynamic-require '(lib "mrpict.ss" "texpict") 'pict-width) v)]
[height ((dynamic-require '(lib "mrpict.ss" "texpict") 'pict-height) v)]
[pict-drawer (make-pict-drawer v)])
(parameterize ([current-eventspace system-eventspace])
(queue-callback
(lambda ()
(add-pict-drawer stx v pict-drawer width height))))))))))
(let* ([make-pict-drawer (ss-dynamic-require '(lib "mrpict.ss" "texpict") 'make-pict-drawer)]
[width ((ss-dynamic-require '(lib "mrpict.ss" "texpict") 'pict-width) v)]
[height ((ss-dynamic-require '(lib "mrpict.ss" "texpict") 'pict-height) v)]
[pict-drawer (make-pict-drawer v)])
(parameterize ([current-eventspace system-eventspace])
(queue-callback
(lambda ()
(add-pict-drawer stx v pict-drawer width height))))))))))
;; add-pict-drawer : syntax pict-drawer number number -> void
;; thread: system eventspace
@ -885,8 +889,8 @@ pict snip :
(drscheme:language:add-snip-value
(lambda (x) ((dynamic-require '(lib "mrpict.ss" "texpict") 'pict?) x))
(lambda (pict) (new (dynamic-require '(lib "pict-value-snip.ss" "texpict") 'pict-value-snip%) (pict pict))))
(lambda (x) ((ss-dynamic-require '(lib "mrpict.ss" "texpict") 'pict?) x))
(lambda (pict) (new (ss-dynamic-require '(lib "pict-value-snip.ss" "texpict") 'pict-value-snip%) (pict pict))))
(define lib-pict-snipclass (make-object lib-pict-snipclass%))