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

improve runtime-path support for building stand-alone gui exes

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-22 19:01:27 -06:00
parent bcbe42f4ff
commit 75a6bfe119
13 changed files with 313 additions and 266 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
collects/compiler/distribute.rkt
View File

@ -162,24 +162,14 @@
(memq 'gracket3m types)) (memq 'gracket3m types))
(map copy-dll (map copy-dll
(list (list
(versionize "libracket3m~a.dll")))) (versionize "libracket3m~a.dll")))))]
(when (memq 'gracketcgc types)
(map copy-dll
(list
(versionize "libgracket~a.dll"))))
(when (memq 'gracket3m types)
(map copy-dll
(list
(versionize "libgracket3m~a.dll")))))]
[(macosx) [(macosx)
(when (memq 'racketcgc types) (when (or (memq 'racketcgc types)
(memq 'gracketcgc types))
(copy-framework "Racket" #f lib-dir)) (copy-framework "Racket" #f lib-dir))
(when (memq 'racket3m types) (when (or (memq 'racket3m types)
(copy-framework "Racket" #t lib-dir)) (memq 'gracket3m types))
(when (memq 'gracketcgc types) (copy-framework "Racket" #t lib-dir))]
(copy-framework "GRacket" #f lib-dir))
(when (memq 'gracket3m types)
(copy-framework "GRacket" #t lib-dir))]
[(unix) [(unix)
(let ([lib-plt-dir (build-path lib-dir "plt")]) (let ([lib-plt-dir (build-path lib-dir "plt")])
(unless (directory-exists? lib-plt-dir) (unless (directory-exists? lib-plt-dir)
@ -205,11 +195,7 @@
(copy-shared-lib "mzgc" lib-dir)) (copy-shared-lib "mzgc" lib-dir))
(when (or (memq 'racket3m types) (when (or (memq 'racket3m types)
(memq 'gracket3m types)) (memq 'gracket3m types))
(copy-shared-lib "racket3m" lib-dir)) (copy-shared-lib "racket3m" lib-dir))))]))
(when (memq 'gracketcgc types)
(copy-shared-lib "gracket" lib-dir))
(when (memq 'gracket3m types)
(copy-shared-lib "gracket3m" lib-dir))))]))
(define (search-dll dll-dir dll) (define (search-dll dll-dir dll)
(if dll-dir (if dll-dir
@ -393,35 +379,40 @@
;; Copy over the extensions for this binary, generating a separate path ;; Copy over the extensions for this binary, generating a separate path
;; for each executable ;; for each executable
(let loop ([exts exts][counter counter]) (let loop ([exts exts][counter counter])
(if (null? exts) (cond
(values null counter) [(null? exts) (values null counter)]
(let* ([src (extract-src (car exts) (car orig-binaries))] [(eq? 'module (cadar (car exts)))
[dest (construct-dest src)] (let-values ([(rest-exts counter)
[sub (format "e~a" counter)]) (loop (cdr exts) counter)])
(when (and src copy?) (values (cons (car exts) rest-exts) counter))]
; Make dest and copy [else
(make-directory* (build-path exts-dir sub (or (path-only dest) 'same))) (let* ([src (extract-src (car exts) (car orig-binaries))]
(let ([f (build-path exts-dir sub dest)]) [dest (construct-dest src)]
(when (or (file-exists? f) [sub (format "e~a" counter)])
(directory-exists? f) (when (and src copy?)
(link-exists? f)) ; Make dest and copy
(delete-directory/files f)) (make-directory* (build-path exts-dir sub (or (path-only dest) 'same)))
(copy-directory/files src f))) (let ([f (build-path exts-dir sub dest)])
;; Generate the new extension entry for the table, and combine with (when (or (file-exists? f)
;; recur result for the rest: (directory-exists? f)
(let-values ([(rest-exts counter) (link-exists? f))
(loop (cdr exts) (inc-counter counter))]) (delete-directory/files f))
(values (if src (copy-directory/files src f)))
(cons (transform-entry ;; Generate the new extension entry for the table, and combine with
(path->bytes ;; recur result for the rest:
(relative->binary-relative (car sub-dirs) (let-values ([(rest-exts counter)
(car types) (loop (cdr exts) (inc-counter counter))])
(build-path relative-exts-dir sub dest))) (values (if src
(car exts)) (cons (transform-entry
rest-exts) (path->bytes
(cons (car exts) (relative->binary-relative (car sub-dirs)
rest-exts)) (car types)
counter)))))]) (build-path relative-exts-dir sub dest)))
(car exts))
rest-exts)
(cons (car exts)
rest-exts))
counter)))]))])
(when copy? (when copy?
;; Update the binary with the new paths ;; Update the binary with the new paths
(let* ([str (string->bytes/utf-8 (format "~s" new-exts))] (let* ([str (string->bytes/utf-8 (format "~s" new-exts))]
@ -477,6 +468,7 @@
;; extract-src: ;; extract-src:
(lambda (rt orig-binary) (lambda (rt orig-binary)
(and (cadr rt) (and (cadr rt)
(bytes? (cadr rt))
(bytes->path (cadr rt)))) (bytes->path (cadr rt))))
;; construct-dest: ;; construct-dest:
(lambda (src) (lambda (src)

153
collects/compiler/embed-unit.rkt
View File

@ -300,10 +300,12 @@
;; Represent modules with lists starting with the filename, so we ;; Represent modules with lists starting with the filename, so we
;; can use assoc: ;; can use assoc:
(define (make-mod normal-file-path normal-module-path (define (make-mod normal-file-path normal-module-path
code name prefix full-name relative-mappings runtime-paths code name prefix full-name relative-mappings
runtime-paths runtime-module-syms
actual-file-path) actual-file-path)
(list normal-file-path normal-module-path code (list normal-file-path normal-module-path code
name prefix full-name relative-mappings runtime-paths name prefix full-name relative-mappings
runtime-paths runtime-module-syms
actual-file-path)) actual-file-path))
(define (mod-file m) (car m)) (define (mod-file m) (car m))
@ -314,7 +316,8 @@
(define (mod-full-name m) (list-ref m 5)) (define (mod-full-name m) (list-ref m 5))
(define (mod-mappings m) (list-ref m 6)) (define (mod-mappings m) (list-ref m 6))
(define (mod-runtime-paths m) (list-ref m 7)) (define (mod-runtime-paths m) (list-ref m 7))
(define (mod-actual-file m) (list-ref m 8)) (define (mod-runtime-module-syms m) (list-ref m 8))
(define (mod-actual-file m) (list-ref m 9))
(define (generate-prefix) (define (generate-prefix)
(format "#%embedded:~a:" (gensym))) (format "#%embedded:~a:" (gensym)))
@ -428,7 +431,7 @@
(cons (make-mod filename module-path code (cons (make-mod filename module-path code
name prefix (string->symbol name prefix (string->symbol
(format "~a~a" prefix name)) (format "~a~a" prefix name))
null null null null null
actual-filename) actual-filename)
(unbox codes)))] (unbox codes)))]
[code [code
@ -440,44 +443,54 @@
(apply append (map cdr importss)))] (apply append (map cdr importss)))]
[extra-paths [extra-paths
(map symbol-to-lib-form (get-extra-imports actual-filename code))]) (map symbol-to-lib-form (get-extra-imports actual-filename code))])
(let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename))) (let* ([runtime-paths
all-file-imports)] (parameterize ([current-namespace expand-namespace])
[sub-paths (map (lambda (i) (collapse-module-path-index i module-path)) (eval code)
all-file-imports)] (let ([module-path
[normalized-extra-paths (map (lambda (i) (collapse-module-path i module-path)) (if (path? module-path)
extra-paths)] (path->complete-path module-path)
[extra-files (map (lambda (i) (normalize (resolve-module-path-index (module-path-index-join i #f) module-path)])
filename))) (syntax-case (expand `(,#'module m mzscheme
extra-paths)]) (require (only ,module-path)
;; Get code for imports: mzlib/runtime-path)
(for-each (lambda (sub-filename sub-path) (runtime-paths ,module-path))) (quote)
(get-code sub-filename [(_ m mz (#%mb rfs req (quote (spec ...))))
sub-path (syntax->datum #'(spec ...))]
codes [_else (error 'create-empbedding-executable
prefixes "expansion mismatch when getting external paths")])))]
verbose?
collects-dest [extra-runtime-paths (filter
on-extension values
compiler (map (lambda (p)
expand-namespace (and (pair? p)
get-extra-imports)) (eq? (car p) 'module)
(append sub-files extra-files) (cadr p)))
(append sub-paths normalized-extra-paths)) runtime-paths))])
(let ([runtime-paths (let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename)))
(parameterize ([current-namespace expand-namespace]) all-file-imports)]
(eval code) [sub-paths (map (lambda (i) (collapse-module-path-index i module-path))
(let ([module-path all-file-imports)]
(if (path? module-path) [normalized-extra-paths (map (lambda (i) (collapse-module-path i module-path))
(path->complete-path module-path) (append extra-runtime-paths extra-paths))]
module-path)]) [extra-files (map (lambda (i) (normalize (resolve-module-path-index (module-path-index-join i #f)
(syntax-case (expand `(,#'module m mzscheme filename)))
(require (only ,module-path) ;; getting runtime-module-path symbols below
mzlib/runtime-path) ;; relies on extra-runtime-paths being first:
(runtime-paths ,module-path))) (quote) (append extra-runtime-paths extra-paths))])
[(_ m mz (#%mb rfs req (quote (spec ...)))) ;; Get code for imports:
(syntax->datum #'(spec ...))] (for-each (lambda (sub-filename sub-path)
[_else (error 'create-empbedding-executable (get-code sub-filename
"expansion mismatch when getting external paths")])))]) sub-path
codes
prefixes
verbose?
collects-dest
on-extension
compiler
expand-namespace
get-extra-imports))
(append sub-files extra-files)
(append sub-paths normalized-extra-paths))
(when verbose? (when verbose?
(unless (null? runtime-paths) (unless (null? runtime-paths)
(fprintf (current-error-port) "Runtime paths for ~s: ~s\n" (fprintf (current-error-port) "Runtime paths for ~s: ~s\n"
@ -494,7 +507,8 @@
;; Record module as copied ;; Record module as copied
(set-box! codes (set-box! codes
(cons (make-mod filename module-path #f (cons (make-mod filename module-path #f
#f #f #f #f null #f #f #f #f
null null
actual-filename) actual-filename)
(unbox codes)))) (unbox codes))))
;; Build up relative module resolutions, relative to this one, ;; Build up relative module resolutions, relative to this one,
@ -521,6 +535,17 @@
(and p (cdr p))) (and p (cdr p)))
mappings) mappings)
runtime-paths runtime-paths
;; extract runtime-path module symbols:
(let loop ([runtime-paths runtime-paths]
[extra-files extra-files])
(cond
[(null? runtime-paths) null]
[(let ([p (car runtime-paths)])
(and (pair? p) (eq? (car p) 'module)))
(cons (mod-full-name (assoc (car extra-files) (unbox codes)))
(loop (cdr runtime-paths) (cdr extra-files)))]
[else
(cons #f (loop (cdr runtime-paths) extra-files))]))
actual-filename) actual-filename)
(unbox codes)))))))))] (unbox codes)))))))))]
[else [else
@ -906,23 +931,31 @@
(let-values ([(rUnTiMe-paths) ; this is a magic name for exe->distribution process (let-values ([(rUnTiMe-paths) ; this is a magic name for exe->distribution process
',(apply append ',(apply append
(map (lambda (nc) (map (lambda (nc)
(map (lambda (p) (map (lambda (p sym)
(list (list
(cons (mod-full-name nc) (cons (mod-full-name nc)
(if (path? p) (if (path? p)
(path->bytes p) (path->bytes p)
p)) (if (and (pair? p)
(eq? 'module (car p)))
(list 'module (cadr p))
p)))
(let ([p (cond (let ([p (cond
[(bytes? p) (bytes->path p)] [(bytes? p) (bytes->path p)]
[(and (list? p) (= 2 (length p)) [(and (list? p) (= 2 (length p))
(eq? 'so (car p))) (eq? 'so (car p)))
(let ([f (path-replace-suffix (cadr p) (let ([fs (list
(system-type 'so-suffix))]) (cadr p)
(ormap (lambda (p) (path-replace-suffix (cadr p)
(let ([p (build-path p f)]) (system-type 'so-suffix)))])
(and (file-exists? p) (ormap (lambda (f)
p))) (ormap (lambda (p)
(get-lib-search-dirs)))] (let ([p (build-path p f)])
(and (or (file-exists? p)
(directory-exists? p))
p)))
(get-lib-search-dirs)))
fs))]
[(and (list? p) [(and (list? p)
(eq? 'lib (car p))) (eq? 'lib (car p)))
(let ([p (if (null? (cddr p)) (let ([p (if (null? (cddr p))
@ -940,16 +973,22 @@
(if (null? (cddr p)) (if (null? (cddr p))
(list "mzlib") (list "mzlib")
(cddr p)))))] (cddr p)))))]
[(and (list? p)
(eq? 'module (car p)))
sym]
[else p])]) [else p])])
(and p (and p
(path->bytes (if (symbol? p)
(if (absolute-path? p) p
p (path->bytes
(build-path (path-only (mod-file nc)) p))))) (if (absolute-path? p)
p
(build-path (path-only (mod-file nc)) p))))))
;; As for the extension table, a placeholder to save ;; As for the extension table, a placeholder to save
;; room likely needed by the distribution-mangler ;; room likely needed by the distribution-mangler
(bytes-append #"................." (path->bytes program-name)))) (bytes-append #"................." (path->bytes program-name))))
(mod-runtime-paths nc))) (mod-runtime-paths nc)
(mod-runtime-module-syms nc)))
runtimes))]) runtimes))])
rUnTiMe-paths)))) rUnTiMe-paths))))
outp)) outp))

31
collects/mred/private/wx/cocoa/tab-panel.rkt
View File

@ -1,21 +1,24 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
ffi/objc ffi/unsafe/objc
"../../syntax.rkt" racket/runtime-path
"types.rkt" "../../syntax.rkt"
"utils.rkt" "types.rkt"
"window.rkt" "utils.rkt"
"panel.rkt" "window.rkt"
"../common/event.rkt" "panel.rkt"
"../common/procs.rkt") "../common/event.rkt"
(unsafe!) "../common/procs.rkt"
(objc-unsafe!) (for-syntax racket/base))
(provide tab-panel%) (provide tab-panel%)
(define-runtime-path psm-tab-bar-dir
'(so "PSMTabBarControl.framework"))
;; Load PSMTabBarControl: ;; Load PSMTabBarControl:
(void (ffi-lib "PSMTabBarControl.framework/PSMTabBarControl")) (void (ffi-lib (build-path psm-tab-bar-dir "PSMTabBarControl")))
(define NSNoTabsNoBorder 6) (define NSNoTabsNoBorder 6)
(import-class NSView NSTabView NSTabViewItem PSMTabBarControl) (import-class NSView NSTabView NSTabViewItem PSMTabBarControl)

2
collects/mred/private/wx/platform.rkt
View File

@ -2,7 +2,7 @@
(require scheme/runtime-path (for-syntax scheme/base)) (require scheme/runtime-path (for-syntax scheme/base))
(provide (all-defined-out)) (provide (all-defined-out))
(define-runtime-path platform-lib (define-runtime-module-path platform-lib
(let ([gtk-lib (let ([gtk-lib
'(lib "mred/private/wx/gtk/platform.rkt")]) '(lib "mred/private/wx/gtk/platform.rkt")])
(case (system-type) (case (system-type)

88
collects/mzlib/runtime-path.rkt
View File

@ -11,24 +11,23 @@
(provide define-runtime-path (provide define-runtime-path
define-runtime-paths define-runtime-paths
define-runtime-path-list define-runtime-path-list
define-runtime-module-path
runtime-paths) runtime-paths)
(define-for-syntax ext-file-table (make-hasheq)) (define-for-syntax ext-file-table (make-hasheq))
(define (lookup-in-table tag-stx p) (define (lookup-in-table var-ref p)
;; This function is designed to cooperate with a table embedded ;; This function is designed to cooperate with a table embedded
;; in an executable by create-embedding-executable. ;; in an executable by create-embedding-executable.
(let ([mpi (syntax-source-module tag-stx)]) (let ([modname (variable-reference->resolved-module-path var-ref)])
(let ([p (hash-ref (let ([p (hash-ref
table table
(cons (cond (cons (resolved-module-path-name modname)
[(module-path-index? mpi)
(resolved-module-path-name (module-path-index-resolve mpi))]
[(symbol? mpi) mpi]
[else #f])
(if (path? p) (if (path? p)
(path->bytes p) (path->bytes p)
p)) (if (and (pair? p) (eq? 'module (car p)))
(list 'module (cadr p))
p)))
#f)]) #f)])
(and p (and p
(car p) (car p)
@ -36,11 +35,13 @@
[p (if (bytes? p) [p (if (bytes? p)
(bytes->path p) (bytes->path p)
p)]) p)])
(if (absolute-path? p) (if (symbol? p)
p (module-path-index-join (list 'quote p) #f) ; make it a module path index
(parameterize ([current-directory (find-system-path 'orig-dir)]) (if (absolute-path? p)
(or (find-executable-path (find-system-path 'exec-file) p #t) p
(build-path (current-directory) p))))))))) (parameterize ([current-directory (find-system-path 'orig-dir)])
(or (find-executable-path (find-system-path 'exec-file) p #t)
(build-path (current-directory) p))))))))))
(define (resolve-paths tag-stx get-base paths) (define (resolve-paths tag-stx get-base paths)
(let ([base #f]) (let ([base #f])
@ -85,18 +86,24 @@
(null? (cdr strs))) (null? (cdr strs)))
(list "mzlib") (list "mzlib")
(append (cddr p) (drop-right strs 1)))))] (append (cddr p) (drop-right strs 1)))))]
[(and (list? p)
((length p) . = . 3)
(eq? 'module (car p))
(or (not (caddr p))
(variable-reference? (caddr p))))
(let ([p (cadr p)]
[vr (caddr p)])
(unless (module-path? p)
(error 'runtime-path "not a module path: ~.s" p))
(module-path-index-join p (and vr
(variable-reference->resolved-module-path vr))))]
[else (error 'runtime-path "unknown form: ~.s" p)]))) [else (error 'runtime-path "unknown form: ~.s" p)])))
paths))) paths)))
(define-for-syntax (register-ext-files tag-stx paths) (define-for-syntax (register-ext-files var-ref paths)
(let ([mpi (syntax-source-module tag-stx)]) (let ([modname (variable-reference->resolved-module-path var-ref)])
(let ([modname (cond (let ([files (hash-ref ext-file-table modname null)])
[(module-path-index? mpi) (module-path-index-resolve mpi)] (hash-set! ext-file-table modname (append paths files)))))
[(symbol? mpi) mpi]
[else (error 'register-ext-files
"cannot determine source")])])
(let ([files (hash-ref ext-file-table modname null)])
(hash-set! ext-file-table modname (append paths files))))))
(define-syntax (-define-runtime-path stx) (define-syntax (-define-runtime-path stx)
(syntax-case stx () (syntax-case stx ()
@ -111,23 +118,22 @@
#'orig-stx #'orig-stx
id))) id)))
ids) ids)
(let ([tag (datum->syntax #'orig-stx 'tag #'orig-stx)]) #`(begin
#`(begin (define-values (id ...)
(define-values (id ...) (let-values ([(id ...) expr])
(let-values ([(id ...) expr]) (let ([get-dir (lambda ()
(let ([get-dir (lambda () #,(datum->syntax
#,(datum->syntax #'orig-stx
tag `(,#'this-expression-source-directory)
`(,#'this-expression-source-directory) #'orig-stx))])
tag))]) (apply to-values (resolve-paths (#%variable-reference)
(apply to-values (resolve-paths (quote-syntax #,tag) get-dir
get-dir (to-list id ...))))))
(to-list id ...)))))) (begin-for-syntax
(begin-for-syntax (register-ext-files
(register-ext-files (#%variable-reference)
(quote-syntax #,tag) (let-values ([(id ...) expr])
(let-values ([(id ...) expr]) (to-list id ...))))))]))
(to-list id ...)))))))]))
(define-syntax (define-runtime-path stx) (define-syntax (define-runtime-path stx)
(syntax-case stx () (syntax-case stx ()
@ -141,6 +147,10 @@
(syntax-case stx () (syntax-case stx ()
[(_ id expr) #`(-define-runtime-path #,stx (id) expr values list)])) [(_ id expr) #`(-define-runtime-path #,stx (id) expr values list)]))
(define-syntax (define-runtime-module-path stx)
(syntax-case stx ()
[(_ id expr) #`(-define-runtime-path #,stx (id) `(module ,expr ,(#%variable-reference)) list values)]))
(define-syntax (runtime-paths stx) (define-syntax (runtime-paths stx)
(syntax-case stx () (syntax-case stx ()
[(_ mp) [(_ mp)

25
collects/racket/draw/cairo.rkt
View File

@ -3,19 +3,22 @@
ffi/unsafe/define ffi/unsafe/define
ffi/unsafe/alloc ffi/unsafe/alloc
setup/dirs setup/dirs
"libs.rkt"
"utils.rkt") "utils.rkt")
(define cairo-lib (define-runtime-lib cairo-lib
(case (system-type) [(unix) (ffi-lib "libcairo" '("2"))]
[(macosx) (ffi-lib "libcairo.2")] [(macosx)
[(unix) (ffi-lib "libcairo" '("2"))] (ffi-lib "libpixman-1.0.dylib")
[(windows) (ffi-lib "libpng14.14.dylib")
(ffi-lib "zlib1") (ffi-lib "libcairo.2.dylib")]
(ffi-lib "libpng14-14") [(windows)
(ffi-lib "libexpat-1") (ffi-lib "zlib1")
(ffi-lib "freetype6") (ffi-lib "libpng14-14")
(ffi-lib "libfontconfig-1") (ffi-lib "libexpat-1")
(ffi-lib "libcairo-2")])) (ffi-lib "freetype6")
(ffi-lib "libfontconfig-1")
(ffi-lib "libcairo-2")])
(define-ffi-definer define-cairo cairo-lib (define-ffi-definer define-cairo cairo-lib
#:provide provide-protected) #:provide provide-protected)

2
collects/racket/draw/gif.rkt
View File

@ -1,4 +1,4 @@
#lang scheme #lang racket/base
(require "lzw.rkt") (require "lzw.rkt")
;; FIXME: still need to handle transparency ;; FIXME: still need to handle transparency

12
collects/racket/draw/jpeg.rkt
View File

@ -5,13 +5,13 @@
ffi/unsafe/atomic ffi/unsafe/atomic
setup/dirs setup/dirs
"bstr.rkt" "bstr.rkt"
"utils.rkt") "utils.rkt"
"libs.rkt")
(define jpeg-lib (define-runtime-lib jpeg-lib
(case (system-type) [(unix) (ffi-lib "libjpeg" '("62" ""))]
[(macosx) (ffi-lib "libjpeg.62")] [(macosx) (ffi-lib "libjpeg.62.dylib")]
[(unix) (ffi-lib "libjpeg" '("62" ""))] [(windows) (ffi-lib "libjpeg-7.dll")])
[(windows) (ffi-lib "libjpeg-7.dll")]))
(define JPEG_LIB_VERSION (define JPEG_LIB_VERSION
(case (system-type) (case (system-type)

27
collects/racket/draw/libs.rkt Normal file
View File

@ -0,0 +1,27 @@
#lang scheme/base
(require ffi/unsafe
racket/runtime-path
(for-syntax racket/base))
(provide define-runtime-lib)
(define-syntax define-runtime-lib
(syntax-rules (macosx unix windows ffi-lib)
[(_ lib-id
[(unix) unix-lib]
[(macosx) (ffi-lib mac-lib) ...]
[(windows) (ffi-lib windows-lib) ...])
(begin
(define-runtime-path-list libs
(case (system-type)
[(macosx) '((so mac-lib) ...)]
[(unix) null]
[(windows) `((so windows-lib) ...)]))
(define lib-id
(if (null? libs)
unix-lib
(for/fold ([v #f]) ([lib (in-list libs)])
(ffi-lib lib)))))]))

68
collects/racket/draw/pango.rkt
View File

@ -5,43 +5,45 @@
ffi/unsafe/atomic ffi/unsafe/atomic
setup/dirs setup/dirs
"cairo.rkt" "cairo.rkt"
"utils.rkt") "utils.rkt"
"libs.rkt")
(define pango-lib (define-runtime-lib pango-lib
(case (system-type) [(unix) (ffi-lib "libpango-1.0" '("0"))]
[(macosx) [(macosx)
(ffi-lib "libpango-1.0.0")] (ffi-lib "libglib-2.0.0.dylib")
[(unix) (ffi-lib "libpango-1.0" '("0"))] (ffi-lib "libgmodule-2.0.0.dylib")
[(windows) (ffi-lib "libgobject-2.0.0.dylib")
(ffi-lib "libglib-2.0-0") (ffi-lib "libintl.8.dylib")
(ffi-lib "libgmodule-2.0-0") (ffi-lib "libpango-1.0.0.dylib")]
(ffi-lib "libgobject-2.0-0") [(windows)
(ffi-lib "libpango-1.0-0")])) (ffi-lib "libglib-2.0-0")
(ffi-lib "libgmodule-2.0-0")
(ffi-lib "libgobject-2.0-0")
(ffi-lib "libpango-1.0-0")])
(define pangowin32-lib (define-runtime-lib pangowin32-lib
(case (system-type) [(unix) #f]
[(windows) [(macosx)]
(ffi-lib "libpangowin32-1.0-0")] [(windows)
[else #f])) (ffi-lib "libpangowin32-1.0-0")])
(define pangocairo-lib (define-runtime-lib pangocairo-lib
(case (system-type) [(unix) (ffi-lib "libpangocairo-1.0" '("0"))]
[(macosx) [(macosx)
(ffi-lib "libpangocairo-1.0.0")] (ffi-lib "libpangocairo-1.0.0.dylib")]
[(unix) (ffi-lib "libpangocairo-1.0" '("0"))] [(windows)
[(windows) (ffi-lib "libpangowin32-1.0-0")
(ffi-lib "libpangowin32-1.0-0") (ffi-lib "libexpat-1")
(ffi-lib "libexpat-1") (ffi-lib "freetype6")
(ffi-lib "freetype6") (ffi-lib "libfontconfig-1")
(ffi-lib "libfontconfig-1") (ffi-lib "libpangoft2-1.0-0")
(ffi-lib "libpangoft2-1.0-0") (ffi-lib "libpangocairo-1.0-0")])
(ffi-lib "libpangocairo-1.0-0")]))
(define glib-lib (define-runtime-lib glib-lib
(case (system-type) [(unix) (ffi-lib "libgobject-2.0" '("0"))]
[(macosx) (ffi-lib "libgobject-2.0.0")] [(macosx) (ffi-lib "libgobject-2.0.0")]
[(unix) (ffi-lib "libgobject-2.0" '("0"))] [(windows) (ffi-lib "libgobject-2.0-0")])
[else #f]))
(define-ffi-definer define-pango pango-lib (define-ffi-definer define-pango pango-lib
#:provide provide) #:provide provide)

24
collects/racket/draw/png.rkt
View File

@ -5,19 +5,19 @@
ffi/unsafe/atomic ffi/unsafe/atomic
setup/dirs setup/dirs
"bstr.rkt" "bstr.rkt"
"utils.rkt") "utils.rkt"
"libs.rkt")
(define png-lib (define-runtime-lib png-lib
(case (system-type) [(unix)
[(macosx) (ffi-lib "libpng14" '("14" #f))] (case (string->symbol (path->string (system-library-subpath #f)))
[(unix) [(i386-freebsd) (ffi-lib "libpng")]
(case (string->symbol (path->string (system-library-subpath #f))) [else
[(i386-freebsd) (ffi-lib "libpng")] (ffi-lib "libpng12" '("0" ""))])]
[else [(macosx) (ffi-lib "libpng14.14.dylib")]
(ffi-lib "libpng12" '("0" ""))])] [(windows)
[(windows) (ffi-lib "zlib1.dll")
(ffi-lib "zlib1.dll") (ffi-lib "libpng14-14.dll")])
(ffi-lib "libpng14-14.dll")]))
(define-ffi-definer define-png png-lib (define-ffi-definer define-png png-lib
#:provide provide) #:provide provide)

30
collects/racket/runtime-path.rkt
View File

@ -3,32 +3,4 @@
(require mzlib/runtime-path) (require mzlib/runtime-path)
(provide (all-from-out mzlib/runtime-path) (provide (all-from-out mzlib/runtime-path)
(for-syntax #%datum) (for-syntax #%datum))
define-runtime-module-path)
(define-syntax (define-runtime-module-path stx)
(syntax-case stx ()
[(_ id mod-path)
(begin
(unless (memq (syntax-local-context) '(top-level module module-begin))
(raise-syntax-error #f
"allowed only in a module top-level or top-level context"
stx))
(unless (identifier? #'id)
(raise-syntax-error #f
"expected an identifier to bind"
stx
#'id))
(unless (module-path? (syntax->datum #'mod-path))
(raise-syntax-error #f
"expected a literal module path"
stx
#'mod-path))
#`(begin
(require (only-in (for-label mod-path)))
(define id (combine-module-path (#%variable-reference) 'mod-path))))]))
(define (combine-module-path vr mod-path)
(module-path-index-resolve (module-path-index-join
mod-path
(variable-reference->resolved-module-path vr))))

25
collects/scribblings/reference/filesystem.scrbl
View File

@ -447,6 +447,15 @@ Racket-specific shared-object library directories (as determined by
libraries that are installed specifically for Racket get carried libraries that are installed specifically for Racket get carried
along in distributions. along in distributions.
If @racket[expr] produces a list of the form @racket[(list 'module
_module-path _var-ref)], the value bound to @racket[id] is a
@tech{module path index}, where @racket[_module-path] is treated as
relative (if it is relative) to the module that is the home of the
@tech{variable reference} @racket[_var-ref], where @racket[_var-ref]
can be @racket[#f] if @racket[_module-path] is absolute. In an
executable, the corresponding module is carried along, including all
of its dependencies.
For compile-time, the @racket[expr] result is used by an executable For compile-time, the @racket[expr] result is used by an executable
creator---but not the result when the containing module is creator---but not the result when the containing module is
compiled. Instead, @racket[expr] is preserved in the module as a compiled. Instead, @racket[expr] is preserved in the module as a
@ -544,23 +553,13 @@ list of paths.}
@defform[(define-runtime-module-path id module-path)]{ @defform[(define-runtime-module-path id module-path)]{
Similar to @racket[define-runtime-path], but @racket[id] is bound to a Similar to @racket[define-runtime-path], but @racket[id] is bound to a
@tech{resolved module path}. The @tech{resolved module path} for @tech{module path index} that encapsulates @racket[module-path]
@racket[id] corresponds to @racket[module-path] (with the same syntax relative to the enclosing module.
as a module path for @racket[require]), which can be relative to the
enclosing module.
Use @racket[define-runtime-module-path] to bind a module path that is Use @racket[define-runtime-module-path] to bind a module path that is
passed to a reflective function like @racket[dynamic-require] while passed to a reflective function like @racket[dynamic-require] while
also creating a module dependency for building and distributing also creating a module dependency for building and distributing
executables. executables.}
The @racket[define-runtime-module-path] form creates a
@racket[for-label] dependency from an enclosing module to
@racket[module-path]. Since the dependency is merely
@racket[for-label], @racket[module-path] is not @tech{instantiate}d or
@tech{visit}ed when the enclosing module is @tech{instantiate}d or
@tech{visit}ed (unless such a dependency is created by other
@racket[require]s).}
@defform[(runtime-paths module-path)]{ @defform[(runtime-paths module-path)]{