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

attach mrpict.ss instead of loading it in the user's space

Browse Source 
svn: r3926
This commit is contained in:
Matthew Flatt 2006-08-02 12:55:20 +00:00
parent 13e27951a6
commit 386b9c06a9
1 changed files with 16 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
collects/slideshow/tool.ss
View File

@ -655,27 +655,20 @@ pict snip :
;; ;;
(define system-eventspace (current-eventspace)) (define system-eventspace (current-eventspace))
(define (ss-dynamic-require lib id)
(parameterize ([current-code-inspector orig-inspector]
[current-library-collection-paths orig-lcp])
(dynamic-require lib id)))
;; send-over : any syntax -> void ;; send-over : any syntax -> void
;; thread: (any) user's thread ;; thread: (any) user's thread
(define (send-over v stx) (define (send-over v stx)
(let ([rep (drscheme:rep:current-rep)]) (let ([rep (drscheme:rep:current-rep)])
(when rep (when rep
(let ([pict? (ss-dynamic-require '(lib "mrpict.ss" "texpict") 'pict?)]) (when (pict? v)
(when (pict? v) (let ([pict-drawer (make-pict-drawer v)]
(let* ([make-pict-drawer (ss-dynamic-require '(lib "mrpict.ss" "texpict") 'make-pict-drawer)] [width (pict-width v)]
[width ((ss-dynamic-require '(lib "mrpict.ss" "texpict") 'pict-width) v)] [height (pict-height v)])
[height ((ss-dynamic-require '(lib "mrpict.ss" "texpict") 'pict-height) v)] (parameterize ([current-eventspace system-eventspace])
[pict-drawer (make-pict-drawer v)]) (queue-callback
(parameterize ([current-eventspace system-eventspace]) (lambda ()
(queue-callback (add-pict-drawer stx v pict-drawer width height)))))))))
(lambda ()
(add-pict-drawer stx v pict-drawer width height))))))))))
;; add-pict-drawer : syntax pict-drawer number number -> void ;; add-pict-drawer : syntax pict-drawer number number -> void
;; thread: system eventspace ;; thread: system eventspace
@ -891,11 +884,16 @@ pict snip :
(drscheme:language-configuration:add-language (drscheme:language-configuration:add-language
(new slideshow-language%))) (new slideshow-language%)))
(define orig-namespace (current-namespace))
(drscheme:language:add-snip-value (drscheme:language:add-snip-value
(lambda (x) ((ss-dynamic-require '(lib "mrpict.ss" "texpict") 'pict?) x)) ;; Convert to print?
(lambda (pict) (new (ss-dynamic-require '(lib "pict-value-snip.ss" "texpict") 'pict-value-snip%) (pict pict)))) (lambda (x) (pict? x))
;; Converter:
(lambda (pict) (new pict-value-snip% (pict pict)))
;; Namespace setup:
(lambda ()
(namespace-attach-module orig-namespace '(lib "mrpict.ss" "texpict"))))
(define lib-pict-snipclass (make-object lib-pict-snipclass%)) (define lib-pict-snipclass (make-object lib-pict-snipclass%))
(send lib-pict-snipclass set-version 2) (send lib-pict-snipclass set-version 2)