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

add ++aux' flag to raco exe'

Browse Source
This commit is contained in:
Matthew Flatt 2011-09-09 10:30:02 -06:00
parent 735ca7f3c3
commit ca0d7b5ef4
5 changed files with 76 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/compiler/commands/exe.rkt
View File

@ -2,6 +2,7 @@
(require scheme/cmdline
raco/command-name
compiler/private/embed
launcher/launcher
dynext/file)
(define verbose (make-parameter #f))
@ -40,6 +41,11 @@
[("--cgc") "Generate using CGC variant"
(3m #f)]
#:multi
[("++aux") aux-file "Extra executable info (based on <aux-file> suffix)"
(let ([auxes (extract-aux-from-path (path->complete-path aux-file))])
(when (null? auxes)
(printf " warning: no recognized information from ~s\n" aux-file))
(exe-aux (append auxes (exe-aux))))]
[("++lib") lib "Embed <lib> in executable"
(exe-embedded-libraries (append (exe-embedded-libraries) (list lib)))]
[("++exf") flag "Add flag to embed in executable"

1
collects/launcher/launcher-sig.rkt
View File

@ -46,6 +46,7 @@ mred-launcher-put-file-extension+style+filters
mzscheme-launcher-put-file-extension+style+filters
build-aux-from-path
extract-aux-from-path
current-launcher-variant
available-mred-variants
available-mzscheme-variants

65
collects/launcher/launcher-unit.rkt
View File

@ -503,52 +503,75 @@
(define (strip-suffix s)
(path-replace-suffix s #""))
(define (build-aux-from-path aux-root)
(let ([aux-root (if (string? aux-root) (string->path aux-root) aux-root)])
(define (try key suffix)
(let ([p (path-replace-suffix aux-root suffix)])
(if (file-exists? p) (list (cons key p)) null)))
(append
(try 'icns #".icns")
(try 'ico #".ico")
(try 'independent? #".lch")
(let ([l (try 'creator #".creator")])
(if (null? l)
(define (extract-aux-from-path path)
(define path-bytes (path->bytes (if (string? path)
(string->path path)
path)))
(define len (bytes-length path-bytes))
(define (try key suffix)
(if (and (len . > . (bytes-length suffix))
(equal? (subbytes path-bytes (- len (bytes-length suffix)))
suffix))
(list (cons key path))
null))
(append
(try 'icns #".icns")
(try 'ico #".ico")
(try 'independent? #".lch")
(let ([l (try 'creator #".creator")])
(if (null? l)
l
(with-handlers ([exn:fail:filesystem? (lambda (x) null)])
(with-input-from-file (cdar l)
(lambda ()
(let ([s (read-string 4)])
(if s (list (cons (caar l) s)) null)))))))
(let ([l (try 'file-types #".filetypes")])
(if (null? l)
(let ([l (try 'file-types #".filetypes")])
(if (null? l)
l
(with-handlers ([exn:fail:filesystem? (lambda (x) null)])
(with-input-from-file (cdar l)
(lambda ()
(let*-values ([(d) (read)]
[(local-dir base dir?) (split-path aux-root)]
[(local-dir base dir?) (split-path path)]
[(icon-files)
(append-map
(lambda (spec)
(let ([m (assoc "CFBundleTypeIconFile" spec)])
(if m
(list (build-path
(path->complete-path local-dir)
(format "~a.icns" (cadr m))))
null)))
(list (build-path
(if (eq? local-dir 'relative)
(current-directory)
(path->complete-path local-dir))
(format "~a.icns" (cadr m))))
null)))
d)])
(list (cons 'file-types d)
(cons 'resource-files
(remove-duplicates icon-files)))))))))
(let ([l (try 'file-types #".utiexports")])
(if (null? l)
(let ([l (try 'file-types #".utiexports")])
(if (null? l)
l
(with-handlers ([exn:fail:filesystem? (lambda (x) null)])
(with-input-from-file (cdar l)
(lambda ()
(let ([d (read)])
(list (cons 'uti-exports d)))))))))))
(list (cons 'uti-exports d))))))))))
(define (build-aux-from-path aux-root)
(let ([aux-root (if (string? aux-root) (string->path aux-root) aux-root)])
(define (try suffix)
(let ([p (path-replace-suffix aux-root suffix)])
(if (file-exists? p)
(extract-aux-from-path p)
null)))
(append
(try #".icns")
(try #".ico")
(try #".lch")
(try #".creator")
(try #".filetypes")
(try #".utiexports"))))
(define (make-gracket-program-launcher file collection dest)
(make-mred-launcher (list "-l-" (string-append collection "/" file))

11
collects/scribblings/raco/exe.scrbl
View File

@ -1,5 +1,8 @@
#lang scribble/doc
@(require scribble/manual "common.rkt" (for-label racket/runtime-path))
@(require scribble/manual
"common.rkt"
(for-label racket/runtime-path
launcher/launcher))
@title[#:tag "exe"]{@exec{raco exe}: Creating Stand-Alone Executables}
@ -62,6 +65,12 @@ and possibly other run-time files declared via
support libraries to create a distribution using @exec{raco
distribute}, as described in @secref["exe-dist"].
The @DFlag{ico} (Windows) or @DFlag{icns} (Mac OS X) flag sets the
icon for the generated executable. For generally, @DPFlag{aux}
attaches information to the executable based on the auxilliary file's
suffix; see @racket[extract-aux-from-path] for a list of recognized
suffixes and meanings.
@; ----------------------------------------------------------------------
@include-section["exe-api.scrbl"]

19
collects/scribblings/raco/launcher.scrbl
View File

@ -299,11 +299,22 @@ launcher.}
(listof (cons/c symbol? any/c))]{
Creates an association list suitable for use with
@racket[make-gracket-launcher] or @racket[create-embedding-executable].
It builds associations by adding to @racket[path] suffixes, such as
@filepath{.icns}, and checking whether such a file exists.
@racket[make-gracket-launcher] or
@racket[create-embedding-executable]. It builds associations by
adding to @racket[path] suffixes, such as @filepath{.icns}, checking
whether such a file exists, and calling @racket[extract-aux-from-path]
if so. The results from all recognized suffixes are appended
together.}
The recognized suffixes are as follows:
@defproc[(extract-aux-from-path [path path-string?])
(listof (cons/c symbol? any/c))]{
Creates an association list suitable for use with
@racket[make-gracket-launcher] or
@racket[create-embedding-executable]. It builds associations by
recognizing the suffix of @racket[path], where the recognized suffixes
are as follows:
@itemize[