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 (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
;; thread: (any) user's thread
(define (send-over v stx)
(let ([rep (drscheme:rep:current-rep)])
(when rep
(let ([pict? (ss-dynamic-require '(lib "mrpict.ss" "texpict") 'pict?)])
(when (pict? v)
(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))))))))))
(when (pict? v)
(let ([pict-drawer (make-pict-drawer v)]
[width (pict-width v)]
[height (pict-height 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
@ -891,11 +884,16 @@ pict snip :
(drscheme:language-configuration:add-language
(new slideshow-language%)))
(define orig-namespace (current-namespace))
(drscheme:language:add-snip-value
(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))))
;; Convert to print?
(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%))
(send lib-pict-snipclass set-version 2)