add support for tethering to a config or addon dir
Add a hook to `raco setup` to make copies of installed executables, where the copies start with the configuration or addon directory of creation time, instead of the default installation or user-specific path. Although the same effect can be achived by setting environment variables such as PLTADDONDIR, tethered executables can be easier to work with and compose better with other programs. See also #1206 for some discussion, although this change does not exactly address the original idea there.
This commit is contained in:
parent
91d6c69565
commit
6369e56709
|
@ -12,7 +12,7 @@
|
||||||
|
|
||||||
(define collection 'multi)
|
(define collection 'multi)
|
||||||
|
|
||||||
(define version "6.5.0.1")
|
(define version "6.5.0.2")
|
||||||
|
|
||||||
(define deps `("racket-lib"
|
(define deps `("racket-lib"
|
||||||
["racket" #:version ,version]))
|
["racket" #:version ,version]))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang info
|
#lang info
|
||||||
|
|
||||||
(define post-install-collection "installer.rkt")
|
(define install-collection "installer.rkt")
|
||||||
(define raco-commands '(("docs" help/help "search and view documentation" 110)))
|
(define raco-commands '(("docs" help/help "search and view documentation" 110)))
|
||||||
|
|
||||||
(define scribblings '(("help.scrbl")))
|
(define scribblings '(("help.scrbl")))
|
||||||
|
|
|
@ -1,18 +1,36 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
(require launcher
|
||||||
|
setup/dirs)
|
||||||
|
|
||||||
;; Builds different kinds of executables for different platforms.
|
;; Builds different kinds of executables for different platforms.
|
||||||
;; The `plt-help' executable is for backward compatibity.
|
;; The `plt-help' executable is for backward compatibity.
|
||||||
;; The `Racket Documentation' executable is to help Windows and
|
;; The `Racket Documentation' executable is to help Windows and
|
||||||
;; Mac users who are completely lost and need something to click.
|
;; Mac users who are completely lost and need something to click.
|
||||||
|
|
||||||
(provide post-installer)
|
(provide installer)
|
||||||
(require launcher)
|
|
||||||
|
|
||||||
(define (post-installer path collection user?)
|
(define (installer path coll user? no-main?)
|
||||||
|
(unless no-main?
|
||||||
|
(do-installer path coll user? #f)
|
||||||
|
(when (and (not user?)
|
||||||
|
(find-config-tethered-console-bin-dir))
|
||||||
|
(do-installer path coll #f #t)))
|
||||||
|
(when (find-addon-tethered-console-bin-dir)
|
||||||
|
(do-installer path coll #t #t)))
|
||||||
|
|
||||||
|
(define (do-installer path collection user? tethered?)
|
||||||
(for ([mr? (case (system-type)
|
(for ([mr? (case (system-type)
|
||||||
[(macosx) '(#t #f)]
|
[(macosx) '(#t #f)]
|
||||||
[(windows) '(#t)]
|
[(windows) '(#t)]
|
||||||
[else '(#f)])])
|
[else '(#f)])]
|
||||||
|
#:when (or (not tethered?)
|
||||||
|
(if mr?
|
||||||
|
(if user?
|
||||||
|
(find-addon-tethered-gui-bin-dir)
|
||||||
|
(find-config-tethered-gui-bin-dir))
|
||||||
|
(if user?
|
||||||
|
(find-addon-tethered-console-bin-dir)
|
||||||
|
(find-config-tethered-console-bin-dir)))))
|
||||||
(define-values (variants mk-launcher mk-path extras)
|
(define-values (variants mk-launcher mk-path extras)
|
||||||
(if mr?
|
(if mr?
|
||||||
(values available-mred-variants
|
(values available-mred-variants
|
||||||
|
@ -26,10 +44,12 @@
|
||||||
'())))
|
'())))
|
||||||
(for ([variant (remove* '(script-3m script-cgc) (variants))])
|
(for ([variant (remove* '(script-3m script-cgc) (variants))])
|
||||||
(parameterize ([current-launcher-variant variant])
|
(parameterize ([current-launcher-variant variant])
|
||||||
(mk-launcher '("-l-" "help/help")
|
(mk-launcher #:tether-mode (and tethered? (if user? 'addon 'config))
|
||||||
(mk-path (if mr? "Racket Documentation" "plt-help") #:user? user?)
|
(append
|
||||||
|
'("-l-" "help/help"))
|
||||||
|
(mk-path (if mr? "Racket Documentation" "plt-help") #:user? user? #:tethered? tethered?)
|
||||||
`([exe-name . ,(if mr? "Racket Documentation" "plt-help")]
|
`([exe-name . ,(if mr? "Racket Documentation" "plt-help")]
|
||||||
[relative? . ,(not user?)]
|
[relative? . ,(not user?)]
|
||||||
[install-mode . ,(if user? 'user 'main)]
|
[install-mode . ,(if user? 'user 'main)]
|
||||||
[start-menu? . #t]
|
[start-menu? . ,(not user?)]
|
||||||
,@extras))))))
|
,@extras))))))
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
(define collection 'multi)
|
(define collection 'multi)
|
||||||
|
|
||||||
(define deps '("scheme-lib"
|
(define deps '("scheme-lib"
|
||||||
"base"
|
["base" #:version "6.5.0.2"]
|
||||||
"net-lib"
|
"net-lib"
|
||||||
"sandbox-lib"
|
"sandbox-lib"
|
||||||
["scribble-lib" #:version "1.14"]
|
["scribble-lib" #:version "1.14"]
|
||||||
|
|
|
@ -18,6 +18,10 @@ to configure other directories as described below. Use the
|
||||||
@racketmodname[setup/dirs] library (which combines information from
|
@racketmodname[setup/dirs] library (which combines information from
|
||||||
the configuration files and other sources) to locate configured
|
the configuration files and other sources) to locate configured
|
||||||
directories, instead of reading @filepath{config.rktd} directly.
|
directories, instead of reading @filepath{config.rktd} directly.
|
||||||
|
A @filepath{config.rktd} file can also appear in the directory
|
||||||
|
@racket[(build-path (find-system-path 'addon-dir) "etc")], but it
|
||||||
|
controls only the results of @racket[find-addon-tethered-console-bin-dir] and
|
||||||
|
@racket[find-addon-tethered-gui-bin-dir].
|
||||||
|
|
||||||
The path of the @deftech{main collection directory} is built into the
|
The path of the @deftech{main collection directory} is built into the
|
||||||
Racket executable, and it can be changed via the
|
Racket executable, and it can be changed via the
|
||||||
|
@ -166,4 +170,12 @@ directory}:
|
||||||
binary identifies itself as CGC, then the suffix is
|
binary identifies itself as CGC, then the suffix is
|
||||||
@racket["3m"], otherwise it is @racket[""].}
|
@racket["3m"], otherwise it is @racket[""].}
|
||||||
|
|
||||||
|
@item{@indexed-racket['config-tethered-console-bin-dir] and
|
||||||
|
@indexed-racket['config-tethered-gui-bin-dir] --- a path for a
|
||||||
|
directory to hold extra copies of executables that are tied to the
|
||||||
|
configuration directory (as reported by @racket[find-config-dir])
|
||||||
|
that is active at the time the executables are created. See also
|
||||||
|
@racket[find-config-tethered-console-bin-dir] and
|
||||||
|
@racket[find-config-tethered-gui-bin-dir].}
|
||||||
|
|
||||||
]
|
]
|
||||||
|
|
|
@ -15,7 +15,8 @@
|
||||||
compiler/embed-unit
|
compiler/embed-unit
|
||||||
racket/runtime-path
|
racket/runtime-path
|
||||||
launcher/launcher
|
launcher/launcher
|
||||||
compiler/find-exe))
|
compiler/find-exe
|
||||||
|
setup/dirs))
|
||||||
|
|
||||||
@title{API for Creating Executables}
|
@title{API for Creating Executables}
|
||||||
|
|
||||||
|
@ -474,6 +475,7 @@ A unit that imports nothing and exports @racket[compiler:embed^].}
|
||||||
@defmodule[compiler/find-exe]
|
@defmodule[compiler/find-exe]
|
||||||
|
|
||||||
@defproc[(find-exe [#:cross? cross? any/c #f]
|
@defproc[(find-exe [#:cross? cross? any/c #f]
|
||||||
|
[#:untetherd? untethered? any/c #f]
|
||||||
[gracket? any/c #f]
|
[gracket? any/c #f]
|
||||||
[variant (or/c 'cgc '3m) (if cross?
|
[variant (or/c 'cgc '3m) (if cross?
|
||||||
(cross-system-type 'gc)
|
(cross-system-type 'gc)
|
||||||
|
@ -486,4 +488,10 @@ A unit that imports nothing and exports @racket[compiler:embed^].}
|
||||||
If @racket[cross?] is true, the executable is found for the target
|
If @racket[cross?] is true, the executable is found for the target
|
||||||
platform in @seclink["cross-system"]{cross-installation mode}.
|
platform in @seclink["cross-system"]{cross-installation mode}.
|
||||||
|
|
||||||
@history[#:changed "6.3" @elem{Added the @racket[#:cross?] argument.}]}
|
If @racket[untethered?] is true, then the original executable is
|
||||||
|
found, instead of an executable that is tethered to a configuration
|
||||||
|
or addon directory via @racket[(find-addon-tethered-console-bin-dir)]
|
||||||
|
and related functions.
|
||||||
|
|
||||||
|
@history[#:changed "6.3" @elem{Added the @racket[#:cross?] argument.}
|
||||||
|
#:changed "6.2.0.5" @elem{Added the @racket[#:untethered?] argument.}]}
|
||||||
|
|
|
@ -28,7 +28,8 @@ creating @tech{launchers}.
|
||||||
|
|
||||||
@defproc[(make-gracket-launcher [args (listof string?)]
|
@defproc[(make-gracket-launcher [args (listof string?)]
|
||||||
[dest path-string?]
|
[dest path-string?]
|
||||||
[aux (listof (cons/c symbol? any/c)) null])
|
[aux (listof (cons/c symbol? any/c)) null]
|
||||||
|
[#:tether-mode tether-mode (or/c 'addon 'config #f) 'addon])
|
||||||
void?]{
|
void?]{
|
||||||
|
|
||||||
Creates the launcher @racket[dest], which starts GRacket with the
|
Creates the launcher @racket[dest], which starts GRacket with the
|
||||||
|
@ -69,9 +70,13 @@ the following additional associations apply to launchers:
|
||||||
base GRacket executable through a relative path.}
|
base GRacket executable through a relative path.}
|
||||||
|
|
||||||
@item{@racket['install-mode] (Windows, Unix) --- either
|
@item{@racket['install-mode] (Windows, Unix) --- either
|
||||||
@racket['user] or @racket['main], indicates that the launcher
|
@racket['main], @racket['user], @racket['config-tethered], or
|
||||||
is being installed to a user-specific place or to an
|
@racket['addon-tethered], indicates that the launcher
|
||||||
installation-wide place, which in turn determines where to
|
is being installed to an
|
||||||
|
installation-wide place, a user-specific place, an installation-wide
|
||||||
|
place that embeds the configuration path, or a specific place that
|
||||||
|
embeds an addon-directory path;
|
||||||
|
the install mode, in turn, determines whether and where to
|
||||||
record @racket['start-menu], @racket['extension-registry],
|
record @racket['start-menu], @racket['extension-registry],
|
||||||
and/or @racket['desktop] information.}
|
and/or @racket['desktop] information.}
|
||||||
|
|
||||||
|
@ -146,7 +151,17 @@ arguments to the script. Instead of appending these arguments to the
|
||||||
end of @racket[args], they are spliced in after any X Windows flags
|
end of @racket[args], they are spliced in after any X Windows flags
|
||||||
already listed in @racket[args]. The remaining arguments (i.e.,
|
already listed in @racket[args]. The remaining arguments (i.e.,
|
||||||
all script flags and arguments after the last X Windows flag or
|
all script flags and arguments after the last X Windows flag or
|
||||||
argument) are then appended after the spliced @racket[args].}
|
argument) are then appended after the spliced @racket[args].
|
||||||
|
|
||||||
|
The @racket[tether-mode] argument indicates how much to preserve the
|
||||||
|
current installation's tethering to a configuration directory and/or
|
||||||
|
addon directory based on @racket[(find-addon-tether-console-bin-dir)]
|
||||||
|
and @racket[(find-config-tether-console-bin-dir)]. The @racket['addon]
|
||||||
|
mode allows full tethering, the @racket['config] mode allows only
|
||||||
|
configuration-directory tethering, and the @racket[#f] mode disables
|
||||||
|
tethering.
|
||||||
|
|
||||||
|
@history[#:changed "6.5.0.2" @elem{Added the @racket[#:tether-mode] argument.}]}
|
||||||
|
|
||||||
|
|
||||||
@defproc[(make-racket-launcher [args (listof string?)]
|
@defproc[(make-racket-launcher [args (listof string?)]
|
||||||
|
@ -251,27 +266,50 @@ arguments.}
|
||||||
@section{Launcher Path and Platform Conventions}
|
@section{Launcher Path and Platform Conventions}
|
||||||
|
|
||||||
@defproc[(gracket-program-launcher-path [name string?]
|
@defproc[(gracket-program-launcher-path [name string?]
|
||||||
[#:user? user? any/c #f])
|
[#:user? user? any/c #f]
|
||||||
|
[#:tethered? tethered? any/c #f])
|
||||||
path?]{
|
path?]{
|
||||||
|
|
||||||
Returns a pathname for an executable called something like @racket[name]
|
Returns a pathname for an executable called something like @racket[name]
|
||||||
in the Racket installation (if @racket[user?] is @racket[#f]) or the
|
in
|
||||||
user's Racket executable directory (if @racket[user?] is @racket[#t]).
|
|
||||||
|
@itemlist[
|
||||||
|
|
||||||
|
@item{the Racket installation --- when @racket[user?] is @racket[#f]
|
||||||
|
and @racket[tethered?] is @racket[#f];}
|
||||||
|
|
||||||
|
@item{the user's Racket executable directory --- when @racket[user?]
|
||||||
|
is @racket[#t] and @racket[tethered?] is @racket[#f];}
|
||||||
|
|
||||||
|
@item{an additional executable directory for executables tethered to a
|
||||||
|
particular configuration directory --- when @racket[user?] is
|
||||||
|
@racket[#f] and @racket[tethered?] is @racket[#t]; or}
|
||||||
|
|
||||||
|
@item{an additional executable directory for executables tethered to
|
||||||
|
a particular addon and configuration directory --- when
|
||||||
|
@racket[user?] is @racket[#t] and @racket[tethered?] is
|
||||||
|
@racket[#t].}
|
||||||
|
|
||||||
|
]
|
||||||
|
|
||||||
For Windows, the @filepath{.exe}
|
For Windows, the @filepath{.exe}
|
||||||
suffix is automatically appended to @racket[name]. For Unix,
|
suffix is automatically appended to @racket[name]. For Unix,
|
||||||
@racket[name] is changed to lowercase, whitespace is changed to
|
@racket[name] is changed to lowercase, whitespace is changed to
|
||||||
@litchar{-}, and the path includes the @filepath{bin} subdirectory of
|
@litchar{-}, and the path includes the @filepath{bin} subdirectory of
|
||||||
the Racket installation. For Mac OS X, the @filepath{.app} suffix
|
the Racket installation. For Mac OS X, the @filepath{.app} suffix
|
||||||
is appended to @racket[name].}
|
is appended to @racket[name].
|
||||||
|
|
||||||
|
@history[#:changed "6.5.0.2" @elem{Added the @racket[#:tethered?] argument.}]}
|
||||||
|
|
||||||
|
|
||||||
@defproc[(racket-program-launcher-path [name string?]
|
@defproc[(racket-program-launcher-path [name string?]
|
||||||
[#:user? user? any/c #f])
|
[#:user? user? any/c #f]
|
||||||
|
[#:tethered? tethered? any/c #f])
|
||||||
path?]{
|
path?]{
|
||||||
|
|
||||||
Returns the same path as @racket[(gracket-program-launcher-path name #:user? user?)]
|
Returns the same path as @racket[(gracket-program-launcher-path name #:user? user? #:tethered tethered?)].
|
||||||
for Unix and Windows. For Mac OS X, the result is the same as for
|
|
||||||
Unix.}
|
@history[#:changed "6.5.0.2" @elem{Added the @racket[#:tethered?] argument.}]}
|
||||||
|
|
||||||
|
|
||||||
@defproc[(gracket-launcher-is-directory?) boolean?]{
|
@defproc[(gracket-launcher-is-directory?) boolean?]{
|
||||||
|
@ -335,7 +373,7 @@ Like @racket[gracket-launcher-get-file-extension+style+filters], but for
|
||||||
Racket launchers.}
|
Racket launchers.}
|
||||||
|
|
||||||
@deftogether[(
|
@deftogether[(
|
||||||
@defproc[(mred-program-launcher-path [name string?] [#:user? user? any/c #f]) path?]
|
@defproc[(mred-program-launcher-path [name string?] [#:user? user? any/c #f] [#:tethered? tethered? any/c #f]) path?]
|
||||||
@defproc[(mred-launcher-is-directory?) boolean?]
|
@defproc[(mred-launcher-is-directory?) boolean?]
|
||||||
@defproc[(mred-launcher-is-actually-directory?) boolean?]
|
@defproc[(mred-launcher-is-actually-directory?) boolean?]
|
||||||
@defproc[(mred-launcher-add-suffix [path-string? path]) path?]
|
@defproc[(mred-launcher-add-suffix [path-string? path]) path?]
|
||||||
|
@ -346,10 +384,12 @@ Racket launchers.}
|
||||||
)]{
|
)]{
|
||||||
|
|
||||||
Backward-compatible aliases for
|
Backward-compatible aliases for
|
||||||
@racket[gracket-program-launcher-path], etc.}
|
@racket[gracket-program-launcher-path], etc.
|
||||||
|
|
||||||
|
@history[#:changed "6.5.0.2" @elem{Added the @racket[#:tethered?] argument.}]}
|
||||||
|
|
||||||
@deftogether[(
|
@deftogether[(
|
||||||
@defproc[(mzscheme-program-launcher-path [name string?] [#:user? user? any/c #f]) path?]
|
@defproc[(mzscheme-program-launcher-path [name string?] [#:user? user? any/c #f] [#:tethered? tethered? any/c #f]) path?]
|
||||||
@defproc[(mzscheme-launcher-is-directory?) boolean?]
|
@defproc[(mzscheme-launcher-is-directory?) boolean?]
|
||||||
@defproc[(mzscheme-launcher-is-actually-directory?) boolean?]
|
@defproc[(mzscheme-launcher-is-actually-directory?) boolean?]
|
||||||
@defproc[(mzscheme-launcher-add-suffix [path-string? path]) path?]
|
@defproc[(mzscheme-launcher-add-suffix [path-string? path]) path?]
|
||||||
|
@ -360,7 +400,9 @@ Backward-compatible aliases for
|
||||||
)]{
|
)]{
|
||||||
|
|
||||||
Backward-compatible aliases for
|
Backward-compatible aliases for
|
||||||
@racket[racket-program-launcher-path], etc.}
|
@racket[racket-program-launcher-path], etc.
|
||||||
|
|
||||||
|
@history[#:changed "6.5.0.2" @elem{Added the @racket[#:tethered?] argument.}]}
|
||||||
|
|
||||||
|
|
||||||
@defproc[(installed-executable-path->desktop-path [exec-path path-string?] [user? any/c])
|
@defproc[(installed-executable-path->desktop-path [exec-path path-string?] [user? any/c])
|
||||||
|
|
|
@ -708,35 +708,52 @@ Optional @filepath{info.rkt} fields trigger additional actions by
|
||||||
specification is compared to @racket[(system-type)]
|
specification is compared to @racket[(system-type)]
|
||||||
and @racket[(system-library-subpath #f)].}
|
and @racket[(system-library-subpath #f)].}
|
||||||
|
|
||||||
@item{@indexed-racket[install-collection] : @racket[path-string?] --- A
|
@item{@indexed-racket[install-collection] : @racket[path-string?] ---
|
||||||
library module relative to the collection that provides
|
A library module relative to the collection that provides
|
||||||
@racket[installer]. The @racket[installer] procedure accepts one
|
@racket[installer]. The @racket[installer] procedure must accept
|
||||||
to three arguments. The first argument is a directory path to the
|
one, two, three, or four arguments:
|
||||||
parent of the Racket installation's @filepath{collects} directory; the
|
|
||||||
second argument, if accepted, is a path to the collection's own
|
@itemlist[
|
||||||
directory; the third argument, if accepted, is a boolean indicating
|
|
||||||
|
@item{The first argument is a directory path to the parent of the
|
||||||
|
Racket installation's @filepath{collects} directory.}
|
||||||
|
|
||||||
|
@item{The second argument, if accepted, is a path to the
|
||||||
|
collection's own directory.}
|
||||||
|
|
||||||
|
@item{The third argument, if accepted, is a boolean indicating
|
||||||
whether the collection is installed as user-specific (@racket[#t])
|
whether the collection is installed as user-specific (@racket[#t])
|
||||||
or installation-wide (@racket[#f]). The procedure should perform collection-specific
|
or installation-wide (@racket[#f]).}
|
||||||
installation work, and it should avoid unnecessary work in the case
|
|
||||||
that it is called multiple times for the same installation.}
|
@item{The fourth argument, if accepted, is a boolean indicating
|
||||||
|
whether the collection is installed as installation-wide and should
|
||||||
|
nevertheless avoid modifying the installation; an
|
||||||
|
@racket[installer] procedure that does not accept this argument is
|
||||||
|
never called when the argument would be @racket[#t]. An installer
|
||||||
|
that does accept this argument is called with @racket[#t] to that
|
||||||
|
it can perform user-specific work, even though the collection is
|
||||||
|
installed installation-wide.}
|
||||||
|
|
||||||
|
]}
|
||||||
|
|
||||||
@item{@indexed-racket[pre-install-collection] : @racket[path-string?] ---
|
@item{@indexed-racket[pre-install-collection] : @racket[path-string?] ---
|
||||||
Like @racket[install-collection], except that the corresponding
|
Like @racket[install-collection], except that the corresponding
|
||||||
installer is called @emph{before} the normal @filepath{.zo} build,
|
installer procedures are called @emph{before} the normal @filepath{.zo} build,
|
||||||
instead of after. The provided procedure should be named
|
instead of after. The provided procedure is
|
||||||
@racket[pre-installer] in this case, so it can be provided by the
|
@racket[pre-installer], so it can be provided by the
|
||||||
same file that provides an @racket[installer].}
|
same file that provides an @racket[installer] procedure.}
|
||||||
|
|
||||||
@item{@indexed-racket[post-install-collection] : @racket[path-string?] ---
|
@item{@indexed-racket[post-install-collection] : @racket[path-string?] ---
|
||||||
Like @racket[install-collection]. It is called right after the
|
Like @racket[install-collection] for a procedure that is called right after the
|
||||||
@racket[install-collection] procedure is executed. The only
|
@racket[install-collection] procedure is executed. The
|
||||||
difference between these is that the @DFlag{no-install} flag can be
|
@DFlag{no-install} flag can be provided to @exec{raco setup}
|
||||||
used to disable the previous two installers, but not this one. It
|
to disable @racket[install-collection] and @racket[pre-install-collection],
|
||||||
is therefore expected to perform operations that are always needed,
|
but not @racket[post-install-collection]. The @racket[post-install-collection]
|
||||||
|
function is therefore expected to perform operations that are always needed,
|
||||||
even after an installation that contains pre-compiled files. The
|
even after an installation that contains pre-compiled files. The
|
||||||
provided procedure should be named @racket[post-installer] in this
|
provided procedure is @racket[post-installer], so it
|
||||||
case, so it can be provided by the same file that provides the
|
can be provided by the same file that provides an
|
||||||
previous two.}
|
@racket[installer] procedure.}
|
||||||
|
|
||||||
@item{@indexed-racket[assume-virtual-sources] : @racket[any/c] ---
|
@item{@indexed-racket[assume-virtual-sources] : @racket[any/c] ---
|
||||||
A true value indicates that bytecode files without a corresponding
|
A true value indicates that bytecode files without a corresponding
|
||||||
|
@ -1412,6 +1429,52 @@ function for installing a single @filepath{.plt} file.
|
||||||
absolute path names for executable and library references,
|
absolute path names for executable and library references,
|
||||||
@racket[#f] otherwise.}
|
@racket[#f] otherwise.}
|
||||||
|
|
||||||
|
@deftogether[(
|
||||||
|
@defproc[(find-addon-tethered-console-bin-dir) (or/c #f path?)]
|
||||||
|
@defproc[(find-addon-tethered-gui-bin-dir) (or/c #f path?)]
|
||||||
|
)]{
|
||||||
|
Returns a path to a user-specific directory to hold an extra copy of
|
||||||
|
each installed executable, where the extra copy is created by
|
||||||
|
@exec{raco setup} and tethered to a particular result for
|
||||||
|
@racket[(find-system-path 'addon-dir)] and
|
||||||
|
@racket[(find-config-dir)].
|
||||||
|
|
||||||
|
Unlike other directories, which are configured via
|
||||||
|
@filepath{config.rktd} in the @racket[(find-config-dir)] directory
|
||||||
|
(see @secref["config-file"]), these paths are configured via
|
||||||
|
@racket['addon-tethered-console-bin-dir] and
|
||||||
|
@racket['addon-tethered-gui-bin-dir] entries in
|
||||||
|
@filepath{config.rktd} in @racket[(build-path (find-system-path
|
||||||
|
'addon-dir) "etc")]. If no configuration is present, the result from
|
||||||
|
the corresponding function,
|
||||||
|
@racket[find-addon-tethered-console-bin-dir] or
|
||||||
|
@racket[find-addon-tethered-gui-bin-dir], is @racket[#f] instead of
|
||||||
|
a path.
|
||||||
|
|
||||||
|
The intent of this protocol is to support a kind of sandbox: an
|
||||||
|
installation that is more specific than user-specific, and where
|
||||||
|
copies of executables such as @exec{racket} serve as entry points
|
||||||
|
into the sandbox. Assuming that the addon directory is set to a
|
||||||
|
directory other than the user's default addon directory when
|
||||||
|
@exec{raco setup} creates the executable copies, then further
|
||||||
|
package build and setup operations through the entry points will be
|
||||||
|
confined to the sandbox and not affect a user's default environment.
|
||||||
|
|
||||||
|
@history[#:added "6.5.0.2"]}
|
||||||
|
|
||||||
|
|
||||||
|
@deftogether[(
|
||||||
|
@defproc[(find-config-tethered-console-bin-dir) (or/c #f path?)]
|
||||||
|
@defproc[(find-config-tethered-gui-bin-dir) (or/c #f path?)]
|
||||||
|
)]{
|
||||||
|
Similar to @racket[find-addon-tethered-console-bin-dir] and
|
||||||
|
@racket[find-addon-tethered-gui-bin-dir], but configured via
|
||||||
|
@filepath{config.rktd} in the @racket[(find-config-dir)] directory
|
||||||
|
(see @secref["config-file"]) and triggers executables that are
|
||||||
|
tethered only to a particular value of @racket[(find-config-dir)].
|
||||||
|
|
||||||
|
@history[#:added "6.5.0.2"]}
|
||||||
|
|
||||||
@; ------------------------------------------------------------------------
|
@; ------------------------------------------------------------------------
|
||||||
|
|
||||||
@section[#:tag "getinfo"]{API for Reading @filepath{info.rkt} Files}
|
@section[#:tag "getinfo"]{API for Reading @filepath{info.rkt} Files}
|
||||||
|
|
|
@ -1436,7 +1436,7 @@
|
||||||
cmdline)) . < . 80))
|
cmdline)) . < . 80))
|
||||||
(error 'create-embedding-executable "command line too long: ~e" cmdline))
|
(error 'create-embedding-executable "command line too long: ~e" cmdline))
|
||||||
(check-collects-path 'create-embedding-executable collects-path collects-path-bytes)
|
(check-collects-path 'create-embedding-executable collects-path collects-path-bytes)
|
||||||
(let ([exe (find-exe #:cross? #t mred? variant)])
|
(let ([exe (find-exe #:cross? #t #:untethered? #t mred? variant)])
|
||||||
(when verbose?
|
(when verbose?
|
||||||
(eprintf "Copying to ~s\n" dest))
|
(eprintf "Copying to ~s\n" dest))
|
||||||
(let-values ([(dest-exe orig-exe osx?)
|
(let-values ([(dest-exe orig-exe osx?)
|
||||||
|
|
|
@ -5,13 +5,20 @@
|
||||||
(provide find-exe)
|
(provide find-exe)
|
||||||
|
|
||||||
(define (find-exe #:cross? [cross? #f]
|
(define (find-exe #:cross? [cross? #f]
|
||||||
|
#:untethered? [untethered? #f]
|
||||||
[mred? #f]
|
[mred? #f]
|
||||||
[variant (if cross?
|
[variant (if cross?
|
||||||
(cross-system-type 'gc)
|
(cross-system-type 'gc)
|
||||||
(system-type 'gc))])
|
(system-type 'gc))])
|
||||||
(let* ([base (if mred?
|
(let* ([base (if mred?
|
||||||
(find-lib-dir)
|
(or (and (not untethered?)
|
||||||
(find-console-bin-dir))]
|
(find-addon-tethered-gui-bin-dir)
|
||||||
|
(find-config-tethered-gui-bin-dir))
|
||||||
|
(find-lib-dir))
|
||||||
|
(or (and (not untethered?)
|
||||||
|
(find-addon-tethered-console-bin-dir)
|
||||||
|
(find-config-tethered-console-bin-dir))
|
||||||
|
(find-console-bin-dir)))]
|
||||||
[fail
|
[fail
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(error 'find-exe
|
(error 'find-exe
|
||||||
|
|
|
@ -364,6 +364,9 @@
|
||||||
(format "~a~a.app/Contents/MacOS/~a~a"
|
(format "~a~a.app/Contents/MacOS/~a~a"
|
||||||
(cdr m) (variant-suffix variant #t)
|
(cdr m) (variant-suffix variant #t)
|
||||||
(cdr m) (variant-suffix variant #t))))]
|
(cdr m) (variant-suffix variant #t))))]
|
||||||
|
[alt-exe-is-gracket? (and alt-exe
|
||||||
|
(let ([m (assq 'exe-is-gracket aux)])
|
||||||
|
(and m (cdr m))))]
|
||||||
[x-flags? (and (eq? kind 'mred)
|
[x-flags? (and (eq? kind 'mred)
|
||||||
(eq? (cross-system-type) 'unix)
|
(eq? (cross-system-type) 'unix)
|
||||||
(not (script-variant? variant)))]
|
(not (script-variant? variant)))]
|
||||||
|
@ -373,6 +376,7 @@
|
||||||
flags))]
|
flags))]
|
||||||
[post-flags (cond
|
[post-flags (cond
|
||||||
[x-flags? (skip-x-flags flags)]
|
[x-flags? (skip-x-flags flags)]
|
||||||
|
[alt-exe-is-gracket? flags]
|
||||||
[alt-exe null]
|
[alt-exe null]
|
||||||
[else flags])]
|
[else flags])]
|
||||||
[pre-flags (cond
|
[pre-flags (cond
|
||||||
|
@ -389,9 +393,12 @@
|
||||||
"# This script was created by make-"
|
"# This script was created by make-"
|
||||||
(symbol->string kind)"-launcher\n")]
|
(symbol->string kind)"-launcher\n")]
|
||||||
[use-librktdir? (if alt-exe
|
[use-librktdir? (if alt-exe
|
||||||
(let ([m (assq 'exe-is-gracket aux)])
|
alt-exe-is-gracket?
|
||||||
(and m (cdr m)))
|
|
||||||
(eq? kind 'mred))]
|
(eq? kind 'mred))]
|
||||||
|
[addon? (let ([im (assoc 'install-mode aux)])
|
||||||
|
(and im (eq? (cdr im) 'addon-tethered)))]
|
||||||
|
[config? (let ([im (assoc 'install-mode aux)])
|
||||||
|
(and im (eq? (cdr im) 'config-tethered)))]
|
||||||
[dir-finder
|
[dir-finder
|
||||||
(let ([bindir (if alt-exe
|
(let ([bindir (if alt-exe
|
||||||
(let ([m (assq 'exe-is-gracket aux)])
|
(let ([m (assq 'exe-is-gracket aux)])
|
||||||
|
@ -399,8 +406,16 @@
|
||||||
(find-lib-dir)
|
(find-lib-dir)
|
||||||
(let ([p (path-only dest)])
|
(let ([p (path-only dest)])
|
||||||
(if (eq? 'macosx (cross-system-type))
|
(if (eq? 'macosx (cross-system-type))
|
||||||
(let* ([cdir (find-console-bin-dir)]
|
(let* ([cdir (or (and addon?
|
||||||
[gdir (find-gui-bin-dir)]
|
(find-addon-tethered-console-bin-dir))
|
||||||
|
(and config?
|
||||||
|
(find-config-tethered-console-bin-dir))
|
||||||
|
(find-console-bin-dir))]
|
||||||
|
[gdir (or (and addon?
|
||||||
|
(find-addon-tethered-gui-bin-dir))
|
||||||
|
(and config?
|
||||||
|
(find-config-tethered-gui-bin-dir))
|
||||||
|
(find-gui-bin-dir))]
|
||||||
[rel (find-relative-path cdir gdir)])
|
[rel (find-relative-path cdir gdir)])
|
||||||
(cond
|
(cond
|
||||||
[(relative-path? rel)
|
[(relative-path? rel)
|
||||||
|
@ -729,15 +744,30 @@
|
||||||
[(macos) make-macos-launcher]
|
[(macos) make-macos-launcher]
|
||||||
[(macosx) make-macosx-launcher]))
|
[(macosx) make-macosx-launcher]))
|
||||||
|
|
||||||
(define (make-gracket-launcher flags dest [aux null])
|
(define (make-gracket-launcher flags dest [aux null] #:tether-mode [tether-mode 'addon])
|
||||||
((get-maker) 'mred (current-launcher-variant) flags dest aux))
|
((get-maker) 'mred (current-launcher-variant) (add-tether tether-mode flags) dest aux))
|
||||||
(define (make-mred-launcher flags dest [aux null])
|
(define (make-mred-launcher flags dest [aux null] #:tether-mode [tether-mode 'addon])
|
||||||
((get-maker) 'mred (current-launcher-variant) (list* "-I" "scheme/gui/init" flags) dest aux))
|
(let ([flags (list* "-I" "scheme/gui/init" (add-tether tether-mode flags))])
|
||||||
|
((get-maker) 'mred (current-launcher-variant) flags dest aux)))
|
||||||
|
|
||||||
(define (make-racket-launcher flags dest [aux null])
|
(define (make-racket-launcher flags dest [aux null] #:tether-mode [tether-mode 'addon])
|
||||||
((get-maker) 'mzscheme (current-launcher-variant) flags dest aux))
|
((get-maker) 'mzscheme (current-launcher-variant) (add-tether tether-mode flags) dest aux))
|
||||||
(define (make-mzscheme-launcher flags dest [aux null])
|
(define (make-mzscheme-launcher flags dest [aux null] #:tether-mode [tether-mode 'addon])
|
||||||
((get-maker) 'mzscheme (current-launcher-variant) (list* "-I" "scheme/init" flags) dest aux))
|
(let ([flags (list* "-I" "scheme/init" (add-tether tether-mode flags))])
|
||||||
|
((get-maker) 'mzscheme (current-launcher-variant) flags dest aux)))
|
||||||
|
|
||||||
|
(define (add-tether tether-mode flags)
|
||||||
|
(cond
|
||||||
|
[(not tether-mode) flags]
|
||||||
|
[(and (not (eq? tether-mode 'config))
|
||||||
|
(find-addon-tethered-console-bin-dir))
|
||||||
|
(list* "-G" (path->string (find-config-dir))
|
||||||
|
"-A" (path->string (find-system-path 'addon-dir))
|
||||||
|
flags)]
|
||||||
|
[(find-config-tethered-console-bin-dir)
|
||||||
|
(list* "-G" (path->string (find-config-dir))
|
||||||
|
flags)]
|
||||||
|
[else flags]))
|
||||||
|
|
||||||
(define (strip-suffix s)
|
(define (strip-suffix s)
|
||||||
(path-replace-suffix s #""))
|
(path-replace-suffix s #""))
|
||||||
|
@ -894,7 +924,7 @@
|
||||||
(string-append (if mred? file (unix-sfx file mred?)) ".exe")]
|
(string-append (if mred? file (unix-sfx file mred?)) ".exe")]
|
||||||
[else file]))
|
[else file]))
|
||||||
|
|
||||||
(define (program-launcher-path name mred? user?)
|
(define (program-launcher-path name mred? user? tethered?)
|
||||||
(let* ([variant (current-launcher-variant)]
|
(let* ([variant (current-launcher-variant)]
|
||||||
[mac-script? (and (eq? (cross-system-type) 'macosx)
|
[mac-script? (and (eq? (cross-system-type) 'macosx)
|
||||||
(script-variant? variant))])
|
(script-variant? variant))])
|
||||||
|
@ -902,11 +932,19 @@
|
||||||
(build-path
|
(build-path
|
||||||
(if (or mac-script? (not mred?))
|
(if (or mac-script? (not mred?))
|
||||||
(if user?
|
(if user?
|
||||||
(find-user-console-bin-dir)
|
(or (and tethered?
|
||||||
(find-console-bin-dir))
|
(find-addon-tethered-console-bin-dir))
|
||||||
|
(find-user-console-bin-dir))
|
||||||
|
(or (and tethered?
|
||||||
|
(find-config-tethered-console-bin-dir))
|
||||||
|
(find-console-bin-dir)))
|
||||||
(if user?
|
(if user?
|
||||||
(find-user-gui-bin-dir)
|
(or (and tethered?
|
||||||
(find-gui-bin-dir)))
|
(find-addon-tethered-gui-bin-dir))
|
||||||
|
(find-user-gui-bin-dir))
|
||||||
|
(or (and tethered?
|
||||||
|
(find-config-tethered-gui-bin-dir))
|
||||||
|
(find-gui-bin-dir))))
|
||||||
((if mac-script? unix-sfx sfx) name mred?))
|
((if mac-script? unix-sfx sfx) name mred?))
|
||||||
variant
|
variant
|
||||||
mred?)])
|
mred?)])
|
||||||
|
@ -915,23 +953,27 @@
|
||||||
(path-replace-suffix p #".app")
|
(path-replace-suffix p #".app")
|
||||||
p))))
|
p))))
|
||||||
|
|
||||||
(define (gracket-program-launcher-path name #:user? [user? #f])
|
(define (gracket-program-launcher-path name #:user? [user? #f] #:tethered? [tethered? #f])
|
||||||
(program-launcher-path name #t user?))
|
(program-launcher-path name #t user? tethered?))
|
||||||
(define (mred-program-launcher-path name #:user? [user? #f])
|
(define (mred-program-launcher-path name #:user? [user? #f] #:tethered? [tethered? #f])
|
||||||
(gracket-program-launcher-path name #:user? user?))
|
(gracket-program-launcher-path name #:user? user? #:tethered? tethered?))
|
||||||
|
|
||||||
(define (racket-program-launcher-path name #:user? [user? #f])
|
(define (racket-program-launcher-path name #:user? [user? #f] #:tethered? [tethered? #f])
|
||||||
(case (cross-system-type)
|
(case (cross-system-type)
|
||||||
[(macosx)
|
[(macosx)
|
||||||
(add-file-suffix (build-path (if user?
|
(add-file-suffix (build-path (if user?
|
||||||
(find-user-console-bin-dir)
|
(or (and tethered?
|
||||||
(find-console-bin-dir))
|
(find-addon-tethered-console-bin-dir))
|
||||||
|
(find-user-console-bin-dir))
|
||||||
|
(or (and tethered?
|
||||||
|
(find-config-tethered-console-bin-dir))
|
||||||
|
(find-console-bin-dir)))
|
||||||
(unix-sfx name #f))
|
(unix-sfx name #f))
|
||||||
(current-launcher-variant)
|
(current-launcher-variant)
|
||||||
#f)]
|
#f)]
|
||||||
[else (program-launcher-path name #f user?)]))
|
[else (program-launcher-path name #f user? tethered?)]))
|
||||||
(define (mzscheme-program-launcher-path name #:user? [user? #f])
|
(define (mzscheme-program-launcher-path name #:user? [user? #f] #:tethered? [tethered? #f])
|
||||||
(racket-program-launcher-path name #:user? user?))
|
(racket-program-launcher-path name #:user? user? #:tethered? tethered?))
|
||||||
|
|
||||||
(define (gracket-launcher-is-directory?)
|
(define (gracket-launcher-is-directory?)
|
||||||
#f)
|
#f)
|
||||||
|
|
|
@ -8,3 +8,5 @@
|
||||||
("Porting from v1xxx to v2xxx" "MzScheme_200.txt")))))
|
("Porting from v1xxx to v2xxx" "MzScheme_200.txt")))))
|
||||||
|
|
||||||
(define copy-man-pages '("racket.1"))
|
(define copy-man-pages '("racket.1"))
|
||||||
|
|
||||||
|
(define install-collection "private/tethered-installer.rkt")
|
||||||
|
|
30
racket/collects/racket/private/tethered-installer.rkt
Normal file
30
racket/collects/racket/private/tethered-installer.rkt
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
#lang racket/base
|
||||||
|
(require setup/dirs
|
||||||
|
racket/file
|
||||||
|
compiler/embed
|
||||||
|
launcher)
|
||||||
|
|
||||||
|
(provide installer)
|
||||||
|
|
||||||
|
(define (installer path coll user? no-main?)
|
||||||
|
(unless (or user? no-main?)
|
||||||
|
(do-installer #f (find-config-tethered-console-bin-dir)))
|
||||||
|
(do-installer #t (find-addon-tethered-console-bin-dir)))
|
||||||
|
|
||||||
|
(define (do-installer user? dir)
|
||||||
|
(when dir
|
||||||
|
(make-directory* dir)
|
||||||
|
(define variants (available-racket-variants))
|
||||||
|
(for ([v (in-list variants)])
|
||||||
|
(parameterize ([current-launcher-variant v])
|
||||||
|
(create-embedding-executable
|
||||||
|
(racket-program-launcher-path "Racket" #:user? user? #:tethered? #t)
|
||||||
|
#:variant v
|
||||||
|
#:cmdline (append
|
||||||
|
(list "-X" (path->string (find-collects-dir))
|
||||||
|
"-G" (path->string (find-config-dir)))
|
||||||
|
(if user?
|
||||||
|
(list "-A" (path->string (find-system-path 'addon-dir)))
|
||||||
|
null))
|
||||||
|
#:launcher? #t
|
||||||
|
#:aux `((relative? . #f)))))))
|
|
@ -8,6 +8,8 @@
|
||||||
(provide (except-out (all-from-out "private/dirs.rkt")
|
(provide (except-out (all-from-out "private/dirs.rkt")
|
||||||
config:dll-dir
|
config:dll-dir
|
||||||
config:bin-dir
|
config:bin-dir
|
||||||
|
config:config-tethered-console-bin-dir
|
||||||
|
config:config-tethered-gui-bin-dir
|
||||||
define-finder)
|
define-finder)
|
||||||
find-dll-dir)
|
find-dll-dir)
|
||||||
|
|
||||||
|
@ -30,6 +32,49 @@
|
||||||
[(windows macosx) 'same]
|
[(windows macosx) 'same]
|
||||||
[(unix) "bin"]))
|
[(unix) "bin"]))
|
||||||
|
|
||||||
|
(provide find-config-tethered-console-bin-dir
|
||||||
|
find-config-tethered-gui-bin-dir)
|
||||||
|
|
||||||
|
(define (find-config-tethered-console-bin-dir)
|
||||||
|
(force config:config-tethered-console-bin-dir))
|
||||||
|
|
||||||
|
(define (find-config-tethered-gui-bin-dir)
|
||||||
|
(force config:config-tethered-gui-bin-dir))
|
||||||
|
|
||||||
|
(provide find-addon-tethered-console-bin-dir
|
||||||
|
find-addon-tethered-gui-bin-dir)
|
||||||
|
|
||||||
|
(define addon-bin-table
|
||||||
|
(delay/sync
|
||||||
|
(let ()
|
||||||
|
(define f (build-path (find-system-path 'addon-dir)
|
||||||
|
"etc"
|
||||||
|
"config.rktd"))
|
||||||
|
(and (file-exists? f)
|
||||||
|
(call-with-input-file*
|
||||||
|
f
|
||||||
|
(lambda (in)
|
||||||
|
(call-with-default-reading-parameterization
|
||||||
|
(lambda ()
|
||||||
|
(read in)))))))))
|
||||||
|
|
||||||
|
(define (find-addon-bin-dir key)
|
||||||
|
(define t (force addon-bin-table))
|
||||||
|
(and (hash? t)
|
||||||
|
(let ([v (hash-ref t key #f)])
|
||||||
|
(and (path-string? v)
|
||||||
|
(simplify-path
|
||||||
|
(path->complete-path
|
||||||
|
v
|
||||||
|
(build-path (find-system-path 'addon-dir)
|
||||||
|
"etc")))))))
|
||||||
|
|
||||||
|
(define (find-addon-tethered-console-bin-dir)
|
||||||
|
(find-addon-bin-dir 'addon-tethered-console-bin-dir))
|
||||||
|
|
||||||
|
(define (find-addon-tethered-gui-bin-dir)
|
||||||
|
(find-addon-bin-dir 'addon-tethered-gui-bin-dir))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
;; DLLs
|
;; DLLs
|
||||||
|
|
||||||
|
|
|
@ -58,6 +58,8 @@
|
||||||
(define-config config:include-dir 'include-dir to-path)
|
(define-config config:include-dir 'include-dir to-path)
|
||||||
(define-config config:include-search-dirs 'include-search-dirs to-path)
|
(define-config config:include-search-dirs 'include-search-dirs to-path)
|
||||||
(define-config config:bin-dir 'bin-dir to-path)
|
(define-config config:bin-dir 'bin-dir to-path)
|
||||||
|
(define-config config:config-tethered-console-bin-dir 'config-tethered-console-bin-dir to-path)
|
||||||
|
(define-config config:config-tethered-gui-bin-dir 'config-tethered-gui-bin-dir to-path)
|
||||||
(define-config config:man-dir 'man-dir to-path)
|
(define-config config:man-dir 'man-dir to-path)
|
||||||
(define-config config:links-file 'links-file to-path)
|
(define-config config:links-file 'links-file to-path)
|
||||||
(define-config config:links-search-files 'links-search-files to-path)
|
(define-config config:links-search-files 'links-search-files to-path)
|
||||||
|
@ -268,7 +270,9 @@
|
||||||
|
|
||||||
;; `setup/dirs`
|
;; `setup/dirs`
|
||||||
|
|
||||||
(provide config:bin-dir)
|
(provide config:bin-dir
|
||||||
|
config:config-tethered-console-bin-dir
|
||||||
|
config:config-tethered-gui-bin-dir)
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
;; DLLs
|
;; DLLs
|
||||||
|
|
|
@ -319,7 +319,7 @@
|
||||||
(setup-printf "WARNING" "~a" (exn->string exn))
|
(setup-printf "WARNING" "~a" (exn->string exn))
|
||||||
v)
|
v)
|
||||||
|
|
||||||
;; Maps a colletion name to a list of `cc's:
|
;; Maps a collection name to a list of `cc's:
|
||||||
(define collection-ccs-table (make-hash))
|
(define collection-ccs-table (make-hash))
|
||||||
|
|
||||||
;; collection-cc! : listof-path .... -> cc
|
;; collection-cc! : listof-path .... -> cc
|
||||||
|
@ -664,10 +664,7 @@
|
||||||
x-specific-planet-dirs)))
|
x-specific-planet-dirs)))
|
||||||
null))
|
null))
|
||||||
|
|
||||||
(define top-level-plt-collects
|
(define all-top-level-plt-collects
|
||||||
((if (avoid-main-installation)
|
|
||||||
(lambda (l) (filter (lambda (cc) (not (cc-main? cc))) l))
|
|
||||||
values)
|
|
||||||
(if no-specific-collections?
|
(if no-specific-collections?
|
||||||
all-collections
|
all-collections
|
||||||
(check-against-all
|
(check-against-all
|
||||||
|
@ -690,7 +687,13 @@
|
||||||
(string-join sc "/")))
|
(string-join sc "/")))
|
||||||
ccs)
|
ccs)
|
||||||
x-specific-collections)
|
x-specific-collections)
|
||||||
(null? planet-collects)))))
|
(null? planet-collects))))
|
||||||
|
|
||||||
|
(define top-level-plt-collects
|
||||||
|
(if (avoid-main-installation)
|
||||||
|
(filter (lambda (cc) (not (cc-main? cc)))
|
||||||
|
all-top-level-plt-collects)
|
||||||
|
all-top-level-plt-collects))
|
||||||
|
|
||||||
(define planet-dirs-to-compile
|
(define planet-dirs-to-compile
|
||||||
(sort-collections
|
(sort-collections
|
||||||
|
@ -700,11 +703,28 @@
|
||||||
(map (lambda (p) (planet-cc->sub-cc cc (list (path->bytes p))))
|
(map (lambda (p) (planet-cc->sub-cc cc (list (path->bytes p))))
|
||||||
subs)))))
|
subs)))))
|
||||||
|
|
||||||
(define ccs-to-compile
|
(define (combine-collections top-level-plt-collects)
|
||||||
(append
|
(append
|
||||||
(sort-collections (lookup-collection-closure top-level-plt-collects))
|
(sort-collections (lookup-collection-closure top-level-plt-collects))
|
||||||
planet-dirs-to-compile))
|
planet-dirs-to-compile))
|
||||||
|
|
||||||
|
(define ccs-to-compile
|
||||||
|
(combine-collections top-level-plt-collects))
|
||||||
|
|
||||||
|
(define ccs-to-call-installers
|
||||||
|
(if (avoid-main-installation)
|
||||||
|
;; Although we mostly avoid the main installation, we'll
|
||||||
|
;; need to call main-installaiton launchers in case they
|
||||||
|
;; support being called to perform only user-specific
|
||||||
|
;; actions.
|
||||||
|
(combine-collections all-top-level-plt-collects)
|
||||||
|
ccs-to-compile))
|
||||||
|
|
||||||
|
(define ccs-to-make-launchers
|
||||||
|
(if (or (find-addon-tethered-console-bin-dir)
|
||||||
|
(find-addon-tethered-gui-bin-dir))
|
||||||
|
ccs-to-call-installers
|
||||||
|
ccs-to-compile))
|
||||||
|
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Clean ;;
|
;; Clean ;;
|
||||||
|
@ -839,7 +859,7 @@
|
||||||
[(pre) "pre-"]
|
[(pre) "pre-"]
|
||||||
[(general) ""]
|
[(general) ""]
|
||||||
[(post) "post-"])))
|
[(post) "post-"])))
|
||||||
(for ([cc ccs-to-compile])
|
(for ([cc ccs-to-call-installers])
|
||||||
(let/ec k
|
(let/ec k
|
||||||
(begin-record-error cc (case part
|
(begin-record-error cc (case part
|
||||||
[(pre) "early install"]
|
[(pre) "early install"]
|
||||||
|
@ -865,11 +885,18 @@
|
||||||
(error name-sym
|
(error name-sym
|
||||||
"error loading installer: ~a"
|
"error loading installer: ~a"
|
||||||
(exn->string exn)))])
|
(exn->string exn)))])
|
||||||
|
(define base-installer
|
||||||
(dynamic-require (build-path (cc-path cc) fn)
|
(dynamic-require (build-path (cc-path cc) fn)
|
||||||
(case part
|
(case part
|
||||||
[(pre) 'pre-installer]
|
[(pre) 'pre-installer]
|
||||||
[(general) 'installer]
|
[(general) 'installer]
|
||||||
[(post) 'post-installer]))))
|
[(post) 'post-installer])))
|
||||||
|
(if (and (cc-main? cc)
|
||||||
|
(avoid-main-installation)
|
||||||
|
(not (procedure-arity-includes? base-installer 4)))
|
||||||
|
#f
|
||||||
|
base-installer)))
|
||||||
|
(when installer
|
||||||
(setup-printf (format "~ainstalling"
|
(setup-printf (format "~ainstalling"
|
||||||
(case part
|
(case part
|
||||||
[(pre) "pre-"]
|
[(pre) "pre-"]
|
||||||
|
@ -879,12 +906,15 @@
|
||||||
(cc-name cc))
|
(cc-name cc))
|
||||||
(define dir (build-path main-collects-dir 'up))
|
(define dir (build-path main-collects-dir 'up))
|
||||||
(cond
|
(cond
|
||||||
|
[(procedure-arity-includes? installer 4)
|
||||||
|
(installer dir (cc-path cc) (not (cc-main? cc)) (and (cc-main? cc)
|
||||||
|
(avoid-main-installation)))]
|
||||||
[(procedure-arity-includes? installer 3)
|
[(procedure-arity-includes? installer 3)
|
||||||
(installer dir (cc-path cc) (not (cc-main? cc)))]
|
(installer dir (cc-path cc) (not (cc-main? cc)))]
|
||||||
[(procedure-arity-includes? installer 2)
|
[(procedure-arity-includes? installer 2)
|
||||||
(installer dir (cc-path cc))]
|
(installer dir (cc-path cc))]
|
||||||
[else
|
[else
|
||||||
(installer dir)]))))))
|
(installer dir)])))))))
|
||||||
|
|
||||||
(define (bytecode-file-exists? p)
|
(define (bytecode-file-exists? p)
|
||||||
(parameterize ([use-compiled-file-paths (list mode-dir)])
|
(parameterize ([use-compiled-file-paths (list mode-dir)])
|
||||||
|
@ -1366,7 +1396,7 @@
|
||||||
(error "result is not a list of strings:" l)))
|
(error "result is not a list of strings:" l)))
|
||||||
(define ((or-f f) x) (when x (f x)))
|
(define ((or-f f) x) (when x (f x)))
|
||||||
(define created-launchers (make-hash))
|
(define created-launchers (make-hash))
|
||||||
(for ([cc ccs-to-compile])
|
(for ([cc ccs-to-make-launchers])
|
||||||
(begin-record-error cc "launcher setup"
|
(begin-record-error cc "launcher setup"
|
||||||
(define info (cc-info cc))
|
(define info (cc-info cc))
|
||||||
(define (make-launcher kind
|
(define (make-launcher kind
|
||||||
|
@ -1396,6 +1426,15 @@
|
||||||
[mzll (in-list (or mzlls (map (lambda (_) #f) mzlns)))]
|
[mzll (in-list (or mzlls (map (lambda (_) #f) mzlns)))]
|
||||||
[mzlf (in-list (or mzlfs (map (lambda (_) #f) mzlns)))])
|
[mzlf (in-list (or mzlfs (map (lambda (_) #f) mzlns)))])
|
||||||
(define p (program-launcher-path mzln #:user? (not (cc-main? cc))))
|
(define p (program-launcher-path mzln #:user? (not (cc-main? cc))))
|
||||||
|
(define addon-p (and (if (eq? kind 'gui)
|
||||||
|
(find-addon-tethered-gui-bin-dir)
|
||||||
|
(find-addon-tethered-console-bin-dir))
|
||||||
|
(program-launcher-path mzln #:user? #t #:tethered? #t)))
|
||||||
|
(define config-p (and (cc-main? cc)
|
||||||
|
(if (eq? kind 'gui)
|
||||||
|
(find-config-tethered-gui-bin-dir)
|
||||||
|
(find-config-tethered-console-bin-dir))
|
||||||
|
(program-launcher-path mzln #:user? #f #:tethered? #t)))
|
||||||
(define receipt-path
|
(define receipt-path
|
||||||
(build-path (if (cc-main? cc)
|
(build-path (if (cc-main? cc)
|
||||||
(find-lib-dir)
|
(find-lib-dir)
|
||||||
|
@ -1404,18 +1443,29 @@
|
||||||
(define (prep-dir p)
|
(define (prep-dir p)
|
||||||
(define dir (path-only p))
|
(define dir (path-only p))
|
||||||
(make-directory* dir))
|
(make-directory* dir))
|
||||||
|
(define skip-non-addon? (and (cc-main? cc)
|
||||||
|
(avoid-main-installation)))
|
||||||
|
(unless skip-non-addon?
|
||||||
(prep-dir p)
|
(prep-dir p)
|
||||||
(prep-dir receipt-path)
|
(prep-dir receipt-path)
|
||||||
|
(when config-p
|
||||||
|
(prep-dir config-p)))
|
||||||
|
(when addon-p
|
||||||
|
(prep-dir addon-p))
|
||||||
(hash-set! created-launchers
|
(hash-set! created-launchers
|
||||||
(record-launcher receipt-path mzln kind (current-launcher-variant)
|
(record-launcher receipt-path mzln kind (current-launcher-variant)
|
||||||
(cc-collection cc) (cc-path cc))
|
(cc-collection cc) (cc-path cc))
|
||||||
#t)
|
#t)
|
||||||
|
(define (create p user? tethered?)
|
||||||
(define aux
|
(define aux
|
||||||
(append
|
(append
|
||||||
`((exe-name . ,mzln)
|
`((exe-name . ,mzln)
|
||||||
(relative? . ,(and (cc-main? cc)
|
(relative? . ,(and (cc-main? cc)
|
||||||
|
(not tethered?)
|
||||||
(not (get-absolute-installation?))))
|
(not (get-absolute-installation?))))
|
||||||
(install-mode . ,(if (cc-main? cc) 'main 'user))
|
(install-mode . ,(if tethered?
|
||||||
|
(if user? 'addon-tethered 'config-tethered)
|
||||||
|
(if (cc-main? cc) 'main 'user)))
|
||||||
,@(build-aux-from-path
|
,@(build-aux-from-path
|
||||||
(build-path (cc-path cc)
|
(build-path (cc-path cc)
|
||||||
(path-replace-suffix (or mzll mzln) #""))))))
|
(path-replace-suffix (or mzll mzln) #""))))))
|
||||||
|
@ -1430,6 +1480,12 @@
|
||||||
(let ([v (current-launcher-variant)])
|
(let ([v (current-launcher-variant)])
|
||||||
(if (eq? v (cross-system-type 'gc)) "" (format " [~a]" v))))
|
(if (eq? v (cross-system-type 'gc)) "" (format " [~a]" v))))
|
||||||
(make-launcher
|
(make-launcher
|
||||||
|
#:tether-mode (if tethered?
|
||||||
|
(if user?
|
||||||
|
'addon
|
||||||
|
'config)
|
||||||
|
#f)
|
||||||
|
(append
|
||||||
(or mzlf
|
(or mzlf
|
||||||
(if (cc-collection cc)
|
(if (cc-collection cc)
|
||||||
(list "-l-" (string-append
|
(list "-l-" (string-append
|
||||||
|
@ -1437,9 +1493,15 @@
|
||||||
(map (lambda (s) (format "~a/" s))
|
(map (lambda (s) (format "~a/" s))
|
||||||
(cc-collection cc)))
|
(cc-collection cc)))
|
||||||
mzll))
|
mzll))
|
||||||
(list "-t-" (path->string (build-path (cc-path cc) mzll)))))
|
(list "-t-" (path->string (build-path (cc-path cc) mzll))))))
|
||||||
p
|
p
|
||||||
aux)))]
|
aux)))
|
||||||
|
(unless skip-non-addon?
|
||||||
|
(create p (not (cc-main? cc)) #f)
|
||||||
|
(when config-p
|
||||||
|
(create config-p #f #t)))
|
||||||
|
(when addon-p
|
||||||
|
(create addon-p #t #t)))]
|
||||||
[else
|
[else
|
||||||
(define fault
|
(define fault
|
||||||
(if (or (not mzlls) (= (length mzlns) (length mzlls))) 'f 'l))
|
(if (or (not mzlls) (= (length mzlns) (length mzlls))) 'f 'l))
|
||||||
|
@ -1485,15 +1547,11 @@
|
||||||
(make-tidy))
|
(make-tidy))
|
||||||
(unless (avoid-main-installation)
|
(unless (avoid-main-installation)
|
||||||
(tidy-launchers #f
|
(tidy-launchers #f
|
||||||
(find-console-bin-dir)
|
|
||||||
(find-gui-bin-dir)
|
|
||||||
(find-lib-dir)
|
(find-lib-dir)
|
||||||
created-launchers
|
created-launchers
|
||||||
ccs-to-compile))
|
ccs-to-compile))
|
||||||
(when (make-user)
|
(when (make-user)
|
||||||
(tidy-launchers #t
|
(tidy-launchers #t
|
||||||
(find-user-console-bin-dir)
|
|
||||||
(find-user-gui-bin-dir)
|
|
||||||
(find-user-lib-dir)
|
(find-user-lib-dir)
|
||||||
created-launchers
|
created-launchers
|
||||||
ccs-to-compile))))
|
ccs-to-compile))))
|
||||||
|
@ -1535,7 +1593,7 @@
|
||||||
(write-receipt-hash receipt-path ht)))
|
(write-receipt-hash receipt-path ht)))
|
||||||
exe-key))
|
exe-key))
|
||||||
|
|
||||||
(define (tidy-launchers user? bin-dir gui-bin-dir lib-dir created ccs-to-compile)
|
(define (tidy-launchers user? lib-dir created ccs-to-compile)
|
||||||
(define receipt-path (build-path lib-dir "launchers.rktd"))
|
(define receipt-path (build-path lib-dir "launchers.rktd"))
|
||||||
(define ht (read-receipt-hash receipt-path))
|
(define ht (read-receipt-hash receipt-path))
|
||||||
(define ht2 (for/fold ([ht (hash)]) ([(k v) (in-hash ht)])
|
(define ht2 (for/fold ([ht (hash)]) ([(k v) (in-hash ht)])
|
||||||
|
@ -1562,15 +1620,21 @@
|
||||||
(define variant (vector-ref k 1))
|
(define variant (vector-ref k 1))
|
||||||
(define name (vector-ref k 2))
|
(define name (vector-ref k 2))
|
||||||
(parameterize ([current-launcher-variant variant])
|
(parameterize ([current-launcher-variant variant])
|
||||||
(define exe-path ((if (eq? kind 'gui)
|
(define (get-path user? tethered?)
|
||||||
|
((if (eq? kind 'gui)
|
||||||
gracket-program-launcher-path
|
gracket-program-launcher-path
|
||||||
racket-program-launcher-path)
|
racket-program-launcher-path)
|
||||||
name
|
name
|
||||||
#:user? user?))
|
#:user? user?
|
||||||
|
#:tethered? tethered?))
|
||||||
|
(define exe-path (get-path user? #f))
|
||||||
|
(define config-exe-path (and (not user?) (get-path #f #t)))
|
||||||
|
(define addon-exe-path (get-path #t #t))
|
||||||
(define is-dir?
|
(define is-dir?
|
||||||
(if (eq? kind 'gui)
|
(if (eq? kind 'gui)
|
||||||
(gracket-launcher-is-actually-directory?)
|
(gracket-launcher-is-actually-directory?)
|
||||||
(racket-launcher-is-actually-directory?)))
|
(racket-launcher-is-actually-directory?)))
|
||||||
|
(define (delete exe-path)
|
||||||
(define rel-exe-path
|
(define rel-exe-path
|
||||||
((if (eq? kind 'gui)
|
((if (eq? kind 'gui)
|
||||||
path->relative-string/gui-bin
|
path->relative-string/gui-bin
|
||||||
|
@ -1582,7 +1646,10 @@
|
||||||
(delete-file exe-path)]
|
(delete-file exe-path)]
|
||||||
[(and is-dir? (directory-exists? exe-path))
|
[(and is-dir? (directory-exists? exe-path))
|
||||||
(setup-printf "deleting" "launcher ~a" rel-exe-path)
|
(setup-printf "deleting" "launcher ~a" rel-exe-path)
|
||||||
(delete-directory/files exe-path)])
|
(delete-directory/files exe-path)]))
|
||||||
|
(delete exe-path)
|
||||||
|
(when config-exe-path (delete config-exe-path))
|
||||||
|
(when addon-exe-path (delete addon-exe-path))
|
||||||
;; Clean up any associated .desktop file and icon file:
|
;; Clean up any associated .desktop file and icon file:
|
||||||
(when (eq? 'unix (cross-system-type))
|
(when (eq? 'unix (cross-system-type))
|
||||||
(let ([desktop (installed-executable-path->desktop-path
|
(let ([desktop (installed-executable-path->desktop-path
|
||||||
|
|
|
@ -13,12 +13,12 @@
|
||||||
consistently.)
|
consistently.)
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#define MZSCHEME_VERSION "6.5.0.1"
|
#define MZSCHEME_VERSION "6.5.0.2"
|
||||||
|
|
||||||
#define MZSCHEME_VERSION_X 6
|
#define MZSCHEME_VERSION_X 6
|
||||||
#define MZSCHEME_VERSION_Y 5
|
#define MZSCHEME_VERSION_Y 5
|
||||||
#define MZSCHEME_VERSION_Z 0
|
#define MZSCHEME_VERSION_Z 0
|
||||||
#define MZSCHEME_VERSION_W 1
|
#define MZSCHEME_VERSION_W 2
|
||||||
|
|
||||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user