improve runtime-path support for building stand-alone gui exes
This commit is contained in:
Matthew Flatt
parent
bcbe42f4ff
commit
75a6bfe119
|
|
@ -162,24 +162,14 @@
|
|||
(memq 'gracket3m types))
|
||||
(map copy-dll
|
||||
(list
|
||||
(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")))))]
|
||||
(versionize "libracket3m~a.dll")))))]
|
||||
[(macosx)
|
||||
(when (memq 'racketcgc types)
|
||||
(when (or (memq 'racketcgc types)
|
||||
(memq 'gracketcgc types))
|
||||
(copy-framework "Racket" #f lib-dir))
|
||||
(when (memq 'racket3m types)
|
||||
(copy-framework "Racket" #t lib-dir))
|
||||
(when (memq 'gracketcgc types)
|
||||
(copy-framework "GRacket" #f lib-dir))
|
||||
(when (memq 'gracket3m types)
|
||||
(copy-framework "GRacket" #t lib-dir))]
|
||||
(when (or (memq 'racket3m types)
|
||||
(memq 'gracket3m types))
|
||||
(copy-framework "Racket" #t lib-dir))]
|
||||
[(unix)
|
||||
(let ([lib-plt-dir (build-path lib-dir "plt")])
|
||||
(unless (directory-exists? lib-plt-dir)
|
||||
|
|
@ -205,11 +195,7 @@
|
|||
(copy-shared-lib "mzgc" lib-dir))
|
||||
(when (or (memq 'racket3m types)
|
||||
(memq 'gracket3m types))
|
||||
(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))))]))
|
||||
(copy-shared-lib "racket3m" lib-dir))))]))
|
||||
|
||||
(define (search-dll dll-dir dll)
|
||||
(if dll-dir
|
||||
|
|
@ -393,35 +379,40 @@
|
|||
;; Copy over the extensions for this binary, generating a separate path
|
||||
;; for each executable
|
||||
(let loop ([exts exts][counter counter])
|
||||
(if (null? exts)
|
||||
(values null counter)
|
||||
(let* ([src (extract-src (car exts) (car orig-binaries))]
|
||||
[dest (construct-dest src)]
|
||||
[sub (format "e~a" counter)])
|
||||
(when (and src copy?)
|
||||
; Make dest and copy
|
||||
(make-directory* (build-path exts-dir sub (or (path-only dest) 'same)))
|
||||
(let ([f (build-path exts-dir sub dest)])
|
||||
(when (or (file-exists? f)
|
||||
(directory-exists? f)
|
||||
(link-exists? f))
|
||||
(delete-directory/files f))
|
||||
(copy-directory/files src f)))
|
||||
;; Generate the new extension entry for the table, and combine with
|
||||
;; recur result for the rest:
|
||||
(let-values ([(rest-exts counter)
|
||||
(loop (cdr exts) (inc-counter counter))])
|
||||
(values (if src
|
||||
(cons (transform-entry
|
||||
(path->bytes
|
||||
(relative->binary-relative (car sub-dirs)
|
||||
(car types)
|
||||
(build-path relative-exts-dir sub dest)))
|
||||
(car exts))
|
||||
rest-exts)
|
||||
(cons (car exts)
|
||||
rest-exts))
|
||||
counter)))))])
|
||||
(cond
|
||||
[(null? exts) (values null counter)]
|
||||
[(eq? 'module (cadar (car exts)))
|
||||
(let-values ([(rest-exts counter)
|
||||
(loop (cdr exts) counter)])
|
||||
(values (cons (car exts) rest-exts) counter))]
|
||||
[else
|
||||
(let* ([src (extract-src (car exts) (car orig-binaries))]
|
||||
[dest (construct-dest src)]
|
||||
[sub (format "e~a" counter)])
|
||||
(when (and src copy?)
|
||||
; Make dest and copy
|
||||
(make-directory* (build-path exts-dir sub (or (path-only dest) 'same)))
|
||||
(let ([f (build-path exts-dir sub dest)])
|
||||
(when (or (file-exists? f)
|
||||
(directory-exists? f)
|
||||
(link-exists? f))
|
||||
(delete-directory/files f))
|
||||
(copy-directory/files src f)))
|
||||
;; Generate the new extension entry for the table, and combine with
|
||||
;; recur result for the rest:
|
||||
(let-values ([(rest-exts counter)
|
||||
(loop (cdr exts) (inc-counter counter))])
|
||||
(values (if src
|
||||
(cons (transform-entry
|
||||
(path->bytes
|
||||
(relative->binary-relative (car sub-dirs)
|
||||
(car types)
|
||||
(build-path relative-exts-dir sub dest)))
|
||||
(car exts))
|
||||
rest-exts)
|
||||
(cons (car exts)
|
||||
rest-exts))
|
||||
counter)))]))])
|
||||
(when copy?
|
||||
;; Update the binary with the new paths
|
||||
(let* ([str (string->bytes/utf-8 (format "~s" new-exts))]
|
||||
|
|
@ -477,6 +468,7 @@
|
|||
;; extract-src:
|
||||
(lambda (rt orig-binary)
|
||||
(and (cadr rt)
|
||||
(bytes? (cadr rt))
|
||||
(bytes->path (cadr rt))))
|
||||
;; construct-dest:
|
||||
(lambda (src)
|
||||
|
|
|
|||
|
|
@ -300,10 +300,12 @@
|
|||
;; Represent modules with lists starting with the filename, so we
|
||||
;; can use assoc:
|
||||
(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)
|
||||
(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))
|
||||
|
||||
(define (mod-file m) (car m))
|
||||
|
|
@ -314,7 +316,8 @@
|
|||
(define (mod-full-name m) (list-ref m 5))
|
||||
(define (mod-mappings m) (list-ref m 6))
|
||||
(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)
|
||||
(format "#%embedded:~a:" (gensym)))
|
||||
|
|
@ -428,7 +431,7 @@
|
|||
(cons (make-mod filename module-path code
|
||||
name prefix (string->symbol
|
||||
(format "~a~a" prefix name))
|
||||
null null
|
||||
null null null
|
||||
actual-filename)
|
||||
(unbox codes)))]
|
||||
[code
|
||||
|
|
@ -440,44 +443,54 @@
|
|||
(apply append (map cdr importss)))]
|
||||
[extra-paths
|
||||
(map symbol-to-lib-form (get-extra-imports actual-filename code))])
|
||||
(let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename)))
|
||||
all-file-imports)]
|
||||
[sub-paths (map (lambda (i) (collapse-module-path-index i module-path))
|
||||
all-file-imports)]
|
||||
[normalized-extra-paths (map (lambda (i) (collapse-module-path i module-path))
|
||||
extra-paths)]
|
||||
[extra-files (map (lambda (i) (normalize (resolve-module-path-index (module-path-index-join i #f)
|
||||
filename)))
|
||||
extra-paths)])
|
||||
;; Get code for imports:
|
||||
(for-each (lambda (sub-filename sub-path)
|
||||
(get-code sub-filename
|
||||
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))
|
||||
(let ([runtime-paths
|
||||
(parameterize ([current-namespace expand-namespace])
|
||||
(eval code)
|
||||
(let ([module-path
|
||||
(if (path? module-path)
|
||||
(path->complete-path module-path)
|
||||
module-path)])
|
||||
(syntax-case (expand `(,#'module m mzscheme
|
||||
(require (only ,module-path)
|
||||
mzlib/runtime-path)
|
||||
(runtime-paths ,module-path))) (quote)
|
||||
[(_ m mz (#%mb rfs req (quote (spec ...))))
|
||||
(syntax->datum #'(spec ...))]
|
||||
[_else (error 'create-empbedding-executable
|
||||
"expansion mismatch when getting external paths")])))])
|
||||
(let* ([runtime-paths
|
||||
(parameterize ([current-namespace expand-namespace])
|
||||
(eval code)
|
||||
(let ([module-path
|
||||
(if (path? module-path)
|
||||
(path->complete-path module-path)
|
||||
module-path)])
|
||||
(syntax-case (expand `(,#'module m mzscheme
|
||||
(require (only ,module-path)
|
||||
mzlib/runtime-path)
|
||||
(runtime-paths ,module-path))) (quote)
|
||||
[(_ m mz (#%mb rfs req (quote (spec ...))))
|
||||
(syntax->datum #'(spec ...))]
|
||||
[_else (error 'create-empbedding-executable
|
||||
"expansion mismatch when getting external paths")])))]
|
||||
|
||||
[extra-runtime-paths (filter
|
||||
values
|
||||
(map (lambda (p)
|
||||
(and (pair? p)
|
||||
(eq? (car p) 'module)
|
||||
(cadr p)))
|
||||
runtime-paths))])
|
||||
(let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename)))
|
||||
all-file-imports)]
|
||||
[sub-paths (map (lambda (i) (collapse-module-path-index i module-path))
|
||||
all-file-imports)]
|
||||
[normalized-extra-paths (map (lambda (i) (collapse-module-path i module-path))
|
||||
(append extra-runtime-paths extra-paths))]
|
||||
[extra-files (map (lambda (i) (normalize (resolve-module-path-index (module-path-index-join i #f)
|
||||
filename)))
|
||||
;; getting runtime-module-path symbols below
|
||||
;; relies on extra-runtime-paths being first:
|
||||
(append extra-runtime-paths extra-paths))])
|
||||
;; Get code for imports:
|
||||
(for-each (lambda (sub-filename sub-path)
|
||||
(get-code sub-filename
|
||||
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?
|
||||
(unless (null? runtime-paths)
|
||||
(fprintf (current-error-port) "Runtime paths for ~s: ~s\n"
|
||||
|
|
@ -494,7 +507,8 @@
|
|||
;; Record module as copied
|
||||
(set-box! codes
|
||||
(cons (make-mod filename module-path #f
|
||||
#f #f #f #f null
|
||||
#f #f #f #f
|
||||
null null
|
||||
actual-filename)
|
||||
(unbox codes))))
|
||||
;; Build up relative module resolutions, relative to this one,
|
||||
|
|
@ -521,6 +535,17 @@
|
|||
(and p (cdr p)))
|
||||
mappings)
|
||||
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)
|
||||
(unbox codes)))))))))]
|
||||
[else
|
||||
|
|
@ -906,23 +931,31 @@
|
|||
(let-values ([(rUnTiMe-paths) ; this is a magic name for exe->distribution process
|
||||
',(apply append
|
||||
(map (lambda (nc)
|
||||
(map (lambda (p)
|
||||
(map (lambda (p sym)
|
||||
(list
|
||||
(cons (mod-full-name nc)
|
||||
(if (path? p)
|
||||
(path->bytes p)
|
||||
p))
|
||||
(if (and (pair? p)
|
||||
(eq? 'module (car p)))
|
||||
(list 'module (cadr p))
|
||||
p)))
|
||||
(let ([p (cond
|
||||
[(bytes? p) (bytes->path p)]
|
||||
[(and (list? p) (= 2 (length p))
|
||||
(eq? 'so (car p)))
|
||||
(let ([f (path-replace-suffix (cadr p)
|
||||
(system-type 'so-suffix))])
|
||||
(ormap (lambda (p)
|
||||
(let ([p (build-path p f)])
|
||||
(and (file-exists? p)
|
||||
p)))
|
||||
(get-lib-search-dirs)))]
|
||||
(let ([fs (list
|
||||
(cadr p)
|
||||
(path-replace-suffix (cadr p)
|
||||
(system-type 'so-suffix)))])
|
||||
(ormap (lambda (f)
|
||||
(ormap (lambda (p)
|
||||
(let ([p (build-path p f)])
|
||||
(and (or (file-exists? p)
|
||||
(directory-exists? p))
|
||||
p)))
|
||||
(get-lib-search-dirs)))
|
||||
fs))]
|
||||
[(and (list? p)
|
||||
(eq? 'lib (car p)))
|
||||
(let ([p (if (null? (cddr p))
|
||||
|
|
@ -940,16 +973,22 @@
|
|||
(if (null? (cddr p))
|
||||
(list "mzlib")
|
||||
(cddr p)))))]
|
||||
[(and (list? p)
|
||||
(eq? 'module (car p)))
|
||||
sym]
|
||||
[else p])])
|
||||
(and p
|
||||
(path->bytes
|
||||
(if (absolute-path? p)
|
||||
p
|
||||
(build-path (path-only (mod-file nc)) p)))))
|
||||
(if (symbol? p)
|
||||
p
|
||||
(path->bytes
|
||||
(if (absolute-path? p)
|
||||
p
|
||||
(build-path (path-only (mod-file nc)) p))))))
|
||||
;; As for the extension table, a placeholder to save
|
||||
;; room likely needed by the distribution-mangler
|
||||
(bytes-append #"................." (path->bytes program-name))))
|
||||
(mod-runtime-paths nc)))
|
||||
(mod-runtime-paths nc)
|
||||
(mod-runtime-module-syms nc)))
|
||||
runtimes))])
|
||||
rUnTiMe-paths))))
|
||||
outp))
|
||||
|
|
|
|||
|
|
@ -1,21 +1,24 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
scheme/foreign
|
||||
ffi/objc
|
||||
"../../syntax.rkt"
|
||||
"types.rkt"
|
||||
"utils.rkt"
|
||||
"window.rkt"
|
||||
"panel.rkt"
|
||||
"../common/event.rkt"
|
||||
"../common/procs.rkt")
|
||||
(unsafe!)
|
||||
(objc-unsafe!)
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
ffi/unsafe
|
||||
ffi/unsafe/objc
|
||||
racket/runtime-path
|
||||
"../../syntax.rkt"
|
||||
"types.rkt"
|
||||
"utils.rkt"
|
||||
"window.rkt"
|
||||
"panel.rkt"
|
||||
"../common/event.rkt"
|
||||
"../common/procs.rkt"
|
||||
(for-syntax racket/base))
|
||||
|
||||
(provide tab-panel%)
|
||||
|
||||
(define-runtime-path psm-tab-bar-dir
|
||||
'(so "PSMTabBarControl.framework"))
|
||||
|
||||
;; Load PSMTabBarControl:
|
||||
(void (ffi-lib "PSMTabBarControl.framework/PSMTabBarControl"))
|
||||
(void (ffi-lib (build-path psm-tab-bar-dir "PSMTabBarControl")))
|
||||
(define NSNoTabsNoBorder 6)
|
||||
|
||||
(import-class NSView NSTabView NSTabViewItem PSMTabBarControl)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
(require scheme/runtime-path (for-syntax scheme/base))
|
||||
(provide (all-defined-out))
|
||||
|
||||
(define-runtime-path platform-lib
|
||||
(define-runtime-module-path platform-lib
|
||||
(let ([gtk-lib
|
||||
'(lib "mred/private/wx/gtk/platform.rkt")])
|
||||
(case (system-type)
|
||||
|
|
|
|||
|
|
@ -11,24 +11,23 @@
|
|||
(provide define-runtime-path
|
||||
define-runtime-paths
|
||||
define-runtime-path-list
|
||||
define-runtime-module-path
|
||||
runtime-paths)
|
||||
|
||||
(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
|
||||
;; 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
|
||||
table
|
||||
(cons (cond
|
||||
[(module-path-index? mpi)
|
||||
(resolved-module-path-name (module-path-index-resolve mpi))]
|
||||
[(symbol? mpi) mpi]
|
||||
[else #f])
|
||||
(cons (resolved-module-path-name modname)
|
||||
(if (path? p)
|
||||
(path->bytes p)
|
||||
p))
|
||||
(if (and (pair? p) (eq? 'module (car p)))
|
||||
(list 'module (cadr p))
|
||||
p)))
|
||||
#f)])
|
||||
(and p
|
||||
(car p)
|
||||
|
|
@ -36,11 +35,13 @@
|
|||
[p (if (bytes? p)
|
||||
(bytes->path p)
|
||||
p)])
|
||||
(if (absolute-path? p)
|
||||
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)))))))))
|
||||
(if (symbol? p)
|
||||
(module-path-index-join (list 'quote p) #f) ; make it a module path index
|
||||
(if (absolute-path? p)
|
||||
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)
|
||||
(let ([base #f])
|
||||
|
|
@ -85,18 +86,24 @@
|
|||
(null? (cdr strs)))
|
||||
(list "mzlib")
|
||||
(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)])))
|
||||
paths)))
|
||||
|
||||
(define-for-syntax (register-ext-files tag-stx paths)
|
||||
(let ([mpi (syntax-source-module tag-stx)])
|
||||
(let ([modname (cond
|
||||
[(module-path-index? mpi) (module-path-index-resolve mpi)]
|
||||
[(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-for-syntax (register-ext-files var-ref paths)
|
||||
(let ([modname (variable-reference->resolved-module-path var-ref)])
|
||||
(let ([files (hash-ref ext-file-table modname null)])
|
||||
(hash-set! ext-file-table modname (append paths files)))))
|
||||
|
||||
(define-syntax (-define-runtime-path stx)
|
||||
(syntax-case stx ()
|
||||
|
|
@ -111,23 +118,22 @@
|
|||
#'orig-stx
|
||||
id)))
|
||||
ids)
|
||||
(let ([tag (datum->syntax #'orig-stx 'tag #'orig-stx)])
|
||||
#`(begin
|
||||
(define-values (id ...)
|
||||
(let-values ([(id ...) expr])
|
||||
(let ([get-dir (lambda ()
|
||||
#,(datum->syntax
|
||||
tag
|
||||
`(,#'this-expression-source-directory)
|
||||
tag))])
|
||||
(apply to-values (resolve-paths (quote-syntax #,tag)
|
||||
get-dir
|
||||
(to-list id ...))))))
|
||||
(begin-for-syntax
|
||||
(register-ext-files
|
||||
(quote-syntax #,tag)
|
||||
(let-values ([(id ...) expr])
|
||||
(to-list id ...)))))))]))
|
||||
#`(begin
|
||||
(define-values (id ...)
|
||||
(let-values ([(id ...) expr])
|
||||
(let ([get-dir (lambda ()
|
||||
#,(datum->syntax
|
||||
#'orig-stx
|
||||
`(,#'this-expression-source-directory)
|
||||
#'orig-stx))])
|
||||
(apply to-values (resolve-paths (#%variable-reference)
|
||||
get-dir
|
||||
(to-list id ...))))))
|
||||
(begin-for-syntax
|
||||
(register-ext-files
|
||||
(#%variable-reference)
|
||||
(let-values ([(id ...) expr])
|
||||
(to-list id ...))))))]))
|
||||
|
||||
(define-syntax (define-runtime-path stx)
|
||||
(syntax-case stx ()
|
||||
|
|
@ -141,6 +147,10 @@
|
|||
(syntax-case stx ()
|
||||
[(_ 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)
|
||||
(syntax-case stx ()
|
||||
[(_ mp)
|
||||
|
|
|
|||
|
|
@ -3,19 +3,22 @@
|
|||
ffi/unsafe/define
|
||||
ffi/unsafe/alloc
|
||||
setup/dirs
|
||||
"libs.rkt"
|
||||
"utils.rkt")
|
||||
|
||||
(define cairo-lib
|
||||
(case (system-type)
|
||||
[(macosx) (ffi-lib "libcairo.2")]
|
||||
[(unix) (ffi-lib "libcairo" '("2"))]
|
||||
[(windows)
|
||||
(ffi-lib "zlib1")
|
||||
(ffi-lib "libpng14-14")
|
||||
(ffi-lib "libexpat-1")
|
||||
(ffi-lib "freetype6")
|
||||
(ffi-lib "libfontconfig-1")
|
||||
(ffi-lib "libcairo-2")]))
|
||||
(define-runtime-lib cairo-lib
|
||||
[(unix) (ffi-lib "libcairo" '("2"))]
|
||||
[(macosx)
|
||||
(ffi-lib "libpixman-1.0.dylib")
|
||||
(ffi-lib "libpng14.14.dylib")
|
||||
(ffi-lib "libcairo.2.dylib")]
|
||||
[(windows)
|
||||
(ffi-lib "zlib1")
|
||||
(ffi-lib "libpng14-14")
|
||||
(ffi-lib "libexpat-1")
|
||||
(ffi-lib "freetype6")
|
||||
(ffi-lib "libfontconfig-1")
|
||||
(ffi-lib "libcairo-2")])
|
||||
|
||||
(define-ffi-definer define-cairo cairo-lib
|
||||
#:provide provide-protected)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang scheme
|
||||
#lang racket/base
|
||||
(require "lzw.rkt")
|
||||
|
||||
;; FIXME: still need to handle transparency
|
||||
|
|
|
|||
|
|
@ -5,13 +5,13 @@
|
|||
ffi/unsafe/atomic
|
||||
setup/dirs
|
||||
"bstr.rkt"
|
||||
"utils.rkt")
|
||||
"utils.rkt"
|
||||
"libs.rkt")
|
||||
|
||||
(define jpeg-lib
|
||||
(case (system-type)
|
||||
[(macosx) (ffi-lib "libjpeg.62")]
|
||||
[(unix) (ffi-lib "libjpeg" '("62" ""))]
|
||||
[(windows) (ffi-lib "libjpeg-7.dll")]))
|
||||
(define-runtime-lib jpeg-lib
|
||||
[(unix) (ffi-lib "libjpeg" '("62" ""))]
|
||||
[(macosx) (ffi-lib "libjpeg.62.dylib")]
|
||||
[(windows) (ffi-lib "libjpeg-7.dll")])
|
||||
|
||||
(define JPEG_LIB_VERSION
|
||||
(case (system-type)
|
||||
|
|
|
|||
27
collects/racket/draw/libs.rkt
Normal file
27
collects/racket/draw/libs.rkt
Normal 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)))))]))
|
||||
|
||||
|
||||
|
|
@ -5,43 +5,45 @@
|
|||
ffi/unsafe/atomic
|
||||
setup/dirs
|
||||
"cairo.rkt"
|
||||
"utils.rkt")
|
||||
"utils.rkt"
|
||||
"libs.rkt")
|
||||
|
||||
(define pango-lib
|
||||
(case (system-type)
|
||||
[(macosx)
|
||||
(ffi-lib "libpango-1.0.0")]
|
||||
[(unix) (ffi-lib "libpango-1.0" '("0"))]
|
||||
[(windows)
|
||||
(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-runtime-lib pango-lib
|
||||
[(unix) (ffi-lib "libpango-1.0" '("0"))]
|
||||
[(macosx)
|
||||
(ffi-lib "libglib-2.0.0.dylib")
|
||||
(ffi-lib "libgmodule-2.0.0.dylib")
|
||||
(ffi-lib "libgobject-2.0.0.dylib")
|
||||
(ffi-lib "libintl.8.dylib")
|
||||
(ffi-lib "libpango-1.0.0.dylib")]
|
||||
[(windows)
|
||||
(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
|
||||
(case (system-type)
|
||||
[(windows)
|
||||
(ffi-lib "libpangowin32-1.0-0")]
|
||||
[else #f]))
|
||||
(define-runtime-lib pangowin32-lib
|
||||
[(unix) #f]
|
||||
[(macosx)]
|
||||
[(windows)
|
||||
(ffi-lib "libpangowin32-1.0-0")])
|
||||
|
||||
(define pangocairo-lib
|
||||
(case (system-type)
|
||||
[(macosx)
|
||||
(ffi-lib "libpangocairo-1.0.0")]
|
||||
[(unix) (ffi-lib "libpangocairo-1.0" '("0"))]
|
||||
[(windows)
|
||||
(ffi-lib "libpangowin32-1.0-0")
|
||||
(ffi-lib "libexpat-1")
|
||||
(ffi-lib "freetype6")
|
||||
(ffi-lib "libfontconfig-1")
|
||||
(ffi-lib "libpangoft2-1.0-0")
|
||||
(ffi-lib "libpangocairo-1.0-0")]))
|
||||
(define-runtime-lib pangocairo-lib
|
||||
[(unix) (ffi-lib "libpangocairo-1.0" '("0"))]
|
||||
[(macosx)
|
||||
(ffi-lib "libpangocairo-1.0.0.dylib")]
|
||||
[(windows)
|
||||
(ffi-lib "libpangowin32-1.0-0")
|
||||
(ffi-lib "libexpat-1")
|
||||
(ffi-lib "freetype6")
|
||||
(ffi-lib "libfontconfig-1")
|
||||
(ffi-lib "libpangoft2-1.0-0")
|
||||
(ffi-lib "libpangocairo-1.0-0")])
|
||||
|
||||
(define glib-lib
|
||||
(case (system-type)
|
||||
[(macosx) (ffi-lib "libgobject-2.0.0")]
|
||||
[(unix) (ffi-lib "libgobject-2.0" '("0"))]
|
||||
[else #f]))
|
||||
(define-runtime-lib glib-lib
|
||||
[(unix) (ffi-lib "libgobject-2.0" '("0"))]
|
||||
[(macosx) (ffi-lib "libgobject-2.0.0")]
|
||||
[(windows) (ffi-lib "libgobject-2.0-0")])
|
||||
|
||||
(define-ffi-definer define-pango pango-lib
|
||||
#:provide provide)
|
||||
|
|
|
|||
|
|
@ -5,19 +5,19 @@
|
|||
ffi/unsafe/atomic
|
||||
setup/dirs
|
||||
"bstr.rkt"
|
||||
"utils.rkt")
|
||||
"utils.rkt"
|
||||
"libs.rkt")
|
||||
|
||||
(define png-lib
|
||||
(case (system-type)
|
||||
[(macosx) (ffi-lib "libpng14" '("14" #f))]
|
||||
[(unix)
|
||||
(case (string->symbol (path->string (system-library-subpath #f)))
|
||||
[(i386-freebsd) (ffi-lib "libpng")]
|
||||
[else
|
||||
(ffi-lib "libpng12" '("0" ""))])]
|
||||
[(windows)
|
||||
(ffi-lib "zlib1.dll")
|
||||
(ffi-lib "libpng14-14.dll")]))
|
||||
(define-runtime-lib png-lib
|
||||
[(unix)
|
||||
(case (string->symbol (path->string (system-library-subpath #f)))
|
||||
[(i386-freebsd) (ffi-lib "libpng")]
|
||||
[else
|
||||
(ffi-lib "libpng12" '("0" ""))])]
|
||||
[(macosx) (ffi-lib "libpng14.14.dylib")]
|
||||
[(windows)
|
||||
(ffi-lib "zlib1.dll")
|
||||
(ffi-lib "libpng14-14.dll")])
|
||||
|
||||
(define-ffi-definer define-png png-lib
|
||||
#:provide provide)
|
||||
|
|
|
|||
|
|
@ -3,32 +3,4 @@
|
|||
|
||||
(require mzlib/runtime-path)
|
||||
(provide (all-from-out mzlib/runtime-path)
|
||||
(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))))
|
||||
(for-syntax #%datum))
|
||||
|
|
|
|||
|
|
@ -447,6 +447,15 @@ Racket-specific shared-object library directories (as determined by
|
|||
libraries that are installed specifically for Racket get carried
|
||||
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
|
||||
creator---but not the result when the containing module is
|
||||
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)]{
|
||||
|
||||
Similar to @racket[define-runtime-path], but @racket[id] is bound to a
|
||||
@tech{resolved module path}. The @tech{resolved module path} for
|
||||
@racket[id] corresponds to @racket[module-path] (with the same syntax
|
||||
as a module path for @racket[require]), which can be relative to the
|
||||
enclosing module.
|
||||
@tech{module path index} that encapsulates @racket[module-path]
|
||||
relative to the enclosing module.
|
||||
|
||||
Use @racket[define-runtime-module-path] to bind a module path that is
|
||||
passed to a reflective function like @racket[dynamic-require] while
|
||||
also creating a module dependency for building and distributing
|
||||
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).}
|
||||
executables.}
|
||||
|
||||
|
||||
@defform[(runtime-paths module-path)]{
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user