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

add support for tethering to a config or addon dir

Browse Source 
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:
Matthew Flatt 2016-04-12 17:14:06 -06:00
parent 91d6c69565
commit 6369e56709
17 changed files with 511 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi)
(define version "6.5.0.1")
(define version "6.5.0.2")
(define deps `("racket-lib"
["racket" #:version ,version]))

2
pkgs/racket-doc/help/info.rkt
View File

@ -1,6 +1,6 @@
#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 scribblings '(("help.scrbl")))

34
pkgs/racket-doc/help/installer.rkt
View File

@ -1,18 +1,36 @@
#lang scheme/base
(require launcher
setup/dirs)
;; Builds different kinds of executables for different platforms.
;; The `plt-help' executable is for backward compatibity.
;; The `Racket Documentation' executable is to help Windows and
;; Mac users who are completely lost and need something to click.
(provide post-installer)
(require launcher)
(provide installer)
(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)
[(macosx) '(#t #f)]
[(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)
(if mr?
(values available-mred-variants
@ -26,10 +44,12 @@
'())))
(for ([variant (remove* '(script-3m script-cgc) (variants))])
(parameterize ([current-launcher-variant variant])
(mk-launcher '("-l-" "help/help")
(mk-path (if mr? "Racket Documentation" "plt-help") #:user? user?)
(mk-launcher #:tether-mode (and tethered? (if user? 'addon 'config))
(append
'("-l-" "help/help"))
(mk-path (if mr? "Racket Documentation" "plt-help") #:user? user? #:tethered? tethered?)
`([exe-name . ,(if mr? "Racket Documentation" "plt-help")]
[relative? . ,(not user?)]
[install-mode . ,(if user? 'user 'main)]
[start-menu? . #t]
[start-menu? . ,(not user?)]
,@extras))))))

2
pkgs/racket-doc/info.rkt
View File

@ -3,7 +3,7 @@
(define collection 'multi)
(define deps '("scheme-lib"
"base"
["base" #:version "6.5.0.2"]
"net-lib"
"sandbox-lib"
["scribble-lib" #:version "1.14"]

12
pkgs/racket-doc/scribblings/raco/config.scrbl
View File

@ -18,6 +18,10 @@ to configure other directories as described below. Use the
@racketmodname[setup/dirs] library (which combines information from
the configuration files and other sources) to locate configured
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
Racket executable, and it can be changed via the
@ -166,4 +170,12 @@ directory}:
binary identifies itself as CGC, then the suffix is
@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].}
]

12
pkgs/racket-doc/scribblings/raco/exe-api.scrbl
View File

@ -15,7 +15,8 @@
compiler/embed-unit
racket/runtime-path
launcher/launcher
compiler/find-exe))
compiler/find-exe
setup/dirs))
@title{API for Creating Executables}
@ -474,6 +475,7 @@ A unit that imports nothing and exports @racket[compiler:embed^].}
@defmodule[compiler/find-exe]
@defproc[(find-exe [#:cross? cross? any/c #f]
[#:untetherd? untethered? any/c #f]
[gracket? any/c #f]
[variant (or/c 'cgc '3m) (if cross?
(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
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.}]}

76
pkgs/racket-doc/scribblings/raco/launcher.scrbl
View File

@ -28,7 +28,8 @@ creating @tech{launchers}.
@defproc[(make-gracket-launcher [args (listof 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?]{
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.}
@item{@racket['install-mode] (Windows, Unix) --- either
@racket['user] or @racket['main], indicates that the launcher
is being installed to a user-specific place or to an
installation-wide place, which in turn determines where to
@racket['main], @racket['user], @racket['config-tethered], or
@racket['addon-tethered], indicates that the launcher
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],
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
already listed in @racket[args]. The remaining arguments (i.e.,
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?)]
@ -251,27 +266,50 @@ arguments.}
@section{Launcher Path and Platform Conventions}
@defproc[(gracket-program-launcher-path [name string?]
[#:user? user? any/c #f])
[#:user? user? any/c #f]
[#:tethered? tethered? any/c #f])
path?]{
Returns a pathname for an executable called something like @racket[name]
in the Racket installation (if @racket[user?] is @racket[#f]) or the
user's Racket executable directory (if @racket[user?] is @racket[#t]).
in
@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}
suffix is automatically appended to @racket[name]. For Unix,
@racket[name] is changed to lowercase, whitespace is changed to
@litchar{-}, and the path includes the @filepath{bin} subdirectory of
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?]
[#:user? user? any/c #f])
[#:user? user? any/c #f]
[#:tethered? tethered? any/c #f])
path?]{
Returns the same path as @racket[(gracket-program-launcher-path name #:user? user?)]
for Unix and Windows. For Mac OS X, the result is the same as for
Unix.}
Returns the same path as @racket[(gracket-program-launcher-path name #:user? user? #:tethered tethered?)].
@history[#:changed "6.5.0.2" @elem{Added the @racket[#:tethered?] argument.}]}
@defproc[(gracket-launcher-is-directory?) boolean?]{
@ -335,7 +373,7 @@ Like @racket[gracket-launcher-get-file-extension+style+filters], but for
Racket launchers.}
@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-actually-directory?) boolean?]
@defproc[(mred-launcher-add-suffix [path-string? path]) path?]
@ -346,10 +384,12 @@ Racket launchers.}
)]{
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[(
@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-actually-directory?) boolean?]
@defproc[(mzscheme-launcher-add-suffix [path-string? path]) path?]
@ -360,7 +400,9 @@ 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])

107
pkgs/racket-doc/scribblings/raco/setup.scrbl
View File

@ -708,35 +708,52 @@ Optional @filepath{info.rkt} fields trigger additional actions by
specification is compared to @racket[(system-type)]
and @racket[(system-library-subpath #f)].}
@item{@indexed-racket[install-collection] : @racket[path-string?] --- A
library module relative to the collection that provides
@racket[installer]. The @racket[installer] procedure accepts one
to three arguments. The first argument is a directory path to the
parent of the Racket installation's @filepath{collects} directory; the
second argument, if accepted, is a path to the collection's own
directory; the third argument, if accepted, is a boolean indicating
@item{@indexed-racket[install-collection] : @racket[path-string?] ---
A library module relative to the collection that provides
@racket[installer]. The @racket[installer] procedure must accept
one, two, three, or four arguments:
@itemlist[
@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])
or installation-wide (@racket[#f]). The procedure should perform collection-specific
installation work, and it should avoid unnecessary work in the case
that it is called multiple times for the same installation.}
or installation-wide (@racket[#f]).}
@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?] ---
Like @racket[install-collection], except that the corresponding
installer is called @emph{before} the normal @filepath{.zo} build,
instead of after. The provided procedure should be named
@racket[pre-installer] in this case, so it can be provided by the
same file that provides an @racket[installer].}
installer procedures are called @emph{before} the normal @filepath{.zo} build,
instead of after. The provided procedure is
@racket[pre-installer], so it can be provided by the
same file that provides an @racket[installer] procedure.}
@item{@indexed-racket[post-install-collection] : @racket[path-string?] ---
Like @racket[install-collection]. It is called right after the
@racket[install-collection] procedure is executed. The only
difference between these is that the @DFlag{no-install} flag can be
used to disable the previous two installers, but not this one. It
is therefore expected to perform operations that are always needed,
Like @racket[install-collection] for a procedure that is called right after the
@racket[install-collection] procedure is executed. The
@DFlag{no-install} flag can be provided to @exec{raco setup}
to disable @racket[install-collection] and @racket[pre-install-collection],
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
provided procedure should be named @racket[post-installer] in this
case, so it can be provided by the same file that provides the
previous two.}
provided procedure is @racket[post-installer], so it
can be provided by the same file that provides an
@racket[installer] procedure.}
@item{@indexed-racket[assume-virtual-sources] : @racket[any/c] ---
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,
@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}

2
racket/collects/compiler/embed.rkt
View File

@ -1436,7 +1436,7 @@
cmdline)) . < . 80))
(error 'create-embedding-executable "command line too long: ~e" cmdline))
(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?
(eprintf "Copying to ~s\n" dest))
(let-values ([(dest-exe orig-exe osx?)

11
racket/collects/compiler/find-exe.rkt
View File

@ -5,13 +5,20 @@
(provide find-exe)
(define (find-exe #:cross? [cross? #f]
#:untethered? [untethered? #f]
[mred? #f]
[variant (if cross?
(cross-system-type 'gc)
(system-type 'gc))])
(let* ([base (if mred?
(find-lib-dir)
(find-console-bin-dir))]
(or (and (not untethered?)
(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
(lambda ()
(error 'find-exe

96
racket/collects/launcher/launcher.rkt
View File

@ -364,6 +364,9 @@
(format "~a~a.app/Contents/MacOS/~a~a"
(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)
(eq? (cross-system-type) 'unix)
(not (script-variant? variant)))]
@ -373,6 +376,7 @@
flags))]
[post-flags (cond
[x-flags? (skip-x-flags flags)]
[alt-exe-is-gracket? flags]
[alt-exe null]
[else flags])]
[pre-flags (cond
@ -389,9 +393,12 @@
"# This script was created by make-"
(symbol->string kind)"-launcher\n")]
[use-librktdir? (if alt-exe
(let ([m (assq 'exe-is-gracket aux)])
(and m (cdr m)))
alt-exe-is-gracket?
(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
(let ([bindir (if alt-exe
(let ([m (assq 'exe-is-gracket aux)])
@ -399,8 +406,16 @@
(find-lib-dir)
(let ([p (path-only dest)])
(if (eq? 'macosx (cross-system-type))
(let* ([cdir (find-console-bin-dir)]
[gdir (find-gui-bin-dir)]
(let* ([cdir (or (and addon?
(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)])
(cond
[(relative-path? rel)
@ -729,15 +744,30 @@
[(macos) make-macos-launcher]
[(macosx) make-macosx-launcher]))
(define (make-gracket-launcher flags dest [aux null])
((get-maker) 'mred (current-launcher-variant) flags dest aux))
(define (make-mred-launcher flags dest [aux null])
((get-maker) 'mred (current-launcher-variant) (list* "-I" "scheme/gui/init" flags) dest aux))
(define (make-gracket-launcher flags dest [aux null] #:tether-mode [tether-mode 'addon])
((get-maker) 'mred (current-launcher-variant) (add-tether tether-mode flags) dest aux))
(define (make-mred-launcher flags dest [aux null] #:tether-mode [tether-mode 'addon])
(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])
((get-maker) 'mzscheme (current-launcher-variant) flags dest aux))
(define (make-mzscheme-launcher flags dest [aux null])
((get-maker) 'mzscheme (current-launcher-variant) (list* "-I" "scheme/init" flags) dest aux))
(define (make-racket-launcher flags dest [aux null] #:tether-mode [tether-mode 'addon])
((get-maker) 'mzscheme (current-launcher-variant) (add-tether tether-mode flags) dest aux))
(define (make-mzscheme-launcher flags dest [aux null] #:tether-mode [tether-mode 'addon])
(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)
(path-replace-suffix s #""))
@ -894,7 +924,7 @@
(string-append (if mred? file (unix-sfx file mred?)) ".exe")]
[else file]))
(define (program-launcher-path name mred? user?)
(define (program-launcher-path name mred? user? tethered?)
(let* ([variant (current-launcher-variant)]
[mac-script? (and (eq? (cross-system-type) 'macosx)
(script-variant? variant))])
@ -902,11 +932,19 @@
(build-path
(if (or mac-script? (not mred?))
(if user?
(find-user-console-bin-dir)
(find-console-bin-dir))
(or (and tethered?
(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?
(find-user-gui-bin-dir)
(find-gui-bin-dir)))
(or (and tethered?
(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?))
variant
mred?)])
@ -915,23 +953,27 @@
(path-replace-suffix p #".app")
p))))
(define (gracket-program-launcher-path name #:user? [user? #f])
(program-launcher-path name #t user?))
(define (mred-program-launcher-path name #:user? [user? #f])
(gracket-program-launcher-path name #:user? user?))
(define (gracket-program-launcher-path name #:user? [user? #f] #:tethered? [tethered? #f])
(program-launcher-path name #t user? tethered?))
(define (mred-program-launcher-path name #:user? [user? #f] #:tethered? [tethered? #f])
(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)
[(macosx)
(add-file-suffix (build-path (if user?
(find-user-console-bin-dir)
(find-console-bin-dir))
(or (and tethered?
(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))
(current-launcher-variant)
#f)]
[else (program-launcher-path name #f user?)]))
(define (mzscheme-program-launcher-path name #:user? [user? #f])
(racket-program-launcher-path name #:user? user?))
[else (program-launcher-path name #f user? tethered?)]))
(define (mzscheme-program-launcher-path name #:user? [user? #f] #:tethered? [tethered? #f])
(racket-program-launcher-path name #:user? user? #:tethered? tethered?))
(define (gracket-launcher-is-directory?)
#f)

2
racket/collects/racket/info.rkt
View File

@ -8,3 +8,5 @@
("Porting from v1xxx to v2xxx" "MzScheme_200.txt")))))
(define copy-man-pages '("racket.1"))
(define install-collection "private/tethered-installer.rkt")

30
racket/collects/racket/private/tethered-installer.rkt Normal file
View 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)))))))

45
racket/collects/setup/dirs.rkt
View File

@ -8,6 +8,8 @@
(provide (except-out (all-from-out "private/dirs.rkt")
config:dll-dir
config:bin-dir
config:config-tethered-console-bin-dir
config:config-tethered-gui-bin-dir
define-finder)
find-dll-dir)
@ -30,6 +32,49 @@
[(windows macosx) 'same]
[(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

6
racket/collects/setup/private/dirs.rkt
View File

@ -58,6 +58,8 @@
(define-config config:include-dir 'include-dir 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: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:links-file 'links-file to-path)
(define-config config:links-search-files 'links-search-files to-path)
@ -268,7 +270,9 @@
;; `setup/dirs`
(provide config:bin-dir)
(provide config:bin-dir
config:config-tethered-console-bin-dir
config:config-tethered-gui-bin-dir)
;; ----------------------------------------
;; DLLs

111
racket/collects/setup/setup-core.rkt
View File

@ -319,7 +319,7 @@
(setup-printf "WARNING" "~a" (exn->string exn))
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))
;; collection-cc! : listof-path .... -> cc
@ -664,10 +664,7 @@
x-specific-planet-dirs)))
null))
(define top-level-plt-collects
((if (avoid-main-installation)
(lambda (l) (filter (lambda (cc) (not (cc-main? cc))) l))
values)
(define all-top-level-plt-collects
(if no-specific-collections?
all-collections
(check-against-all
@ -690,7 +687,13 @@
(string-join sc "/")))
ccs)
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
(sort-collections
@ -700,11 +703,28 @@
(map (lambda (p) (planet-cc->sub-cc cc (list (path->bytes p))))
subs)))))
(define ccs-to-compile
(define (combine-collections top-level-plt-collects)
(append
(sort-collections (lookup-collection-closure top-level-plt-collects))
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 ;;
@ -839,7 +859,7 @@
[(pre) "pre-"]
[(general) ""]
[(post) "post-"])))
(for ([cc ccs-to-compile])
(for ([cc ccs-to-call-installers])
(let/ec k
(begin-record-error cc (case part
[(pre) "early install"]
@ -865,11 +885,18 @@
(error name-sym
"error loading installer: ~a"
(exn->string exn)))])
(define base-installer
(dynamic-require (build-path (cc-path cc) fn)
(case part
[(pre) 'pre-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"
(case part
[(pre) "pre-"]
@ -879,12 +906,15 @@
(cc-name cc))
(define dir (build-path main-collects-dir 'up))
(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)
(installer dir (cc-path cc) (not (cc-main? cc)))]
[(procedure-arity-includes? installer 2)
(installer dir (cc-path cc))]
[else
(installer dir)]))))))
(installer dir)])))))))
(define (bytecode-file-exists? p)
(parameterize ([use-compiled-file-paths (list mode-dir)])
@ -1366,7 +1396,7 @@
(error "result is not a list of strings:" l)))
(define ((or-f f) x) (when x (f x)))
(define created-launchers (make-hash))
(for ([cc ccs-to-compile])
(for ([cc ccs-to-make-launchers])
(begin-record-error cc "launcher setup"
(define info (cc-info cc))
(define (make-launcher kind
@ -1396,6 +1426,15 @@
[mzll (in-list (or mzlls (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 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
(build-path (if (cc-main? cc)
(find-lib-dir)
@ -1404,18 +1443,29 @@
(define (prep-dir p)
(define dir (path-only p))
(make-directory* dir))
(define skip-non-addon? (and (cc-main? cc)
(avoid-main-installation)))
(unless skip-non-addon?
(prep-dir p)
(prep-dir receipt-path)
(when config-p
(prep-dir config-p)))
(when addon-p
(prep-dir addon-p))
(hash-set! created-launchers
(record-launcher receipt-path mzln kind (current-launcher-variant)
(cc-collection cc) (cc-path cc))
#t)
(define (create p user? tethered?)
(define aux
(append
`((exe-name . ,mzln)
(relative? . ,(and (cc-main? cc)
(not tethered?)
(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-path (cc-path cc)
(path-replace-suffix (or mzll mzln) #""))))))
@ -1430,6 +1480,12 @@
(let ([v (current-launcher-variant)])
(if (eq? v (cross-system-type 'gc)) "" (format " [~a]" v))))
(make-launcher
#:tether-mode (if tethered?
(if user?
'addon
'config)
#f)
(append
(or mzlf
(if (cc-collection cc)
(list "-l-" (string-append
@ -1437,9 +1493,15 @@
(map (lambda (s) (format "~a/" s))
(cc-collection cc)))
mzll))
(list "-t-" (path->string (build-path (cc-path cc) mzll)))))
(list "-t-" (path->string (build-path (cc-path cc) mzll))))))
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
(define fault
(if (or (not mzlls) (= (length mzlns) (length mzlls))) 'f 'l))
@ -1485,15 +1547,11 @@
(make-tidy))
(unless (avoid-main-installation)
(tidy-launchers #f
(find-console-bin-dir)
(find-gui-bin-dir)
(find-lib-dir)
created-launchers
ccs-to-compile))
(when (make-user)
(tidy-launchers #t
(find-user-console-bin-dir)
(find-user-gui-bin-dir)
(find-user-lib-dir)
created-launchers
ccs-to-compile))))
@ -1535,7 +1593,7 @@
(write-receipt-hash receipt-path ht)))
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 ht (read-receipt-hash receipt-path))
(define ht2 (for/fold ([ht (hash)]) ([(k v) (in-hash ht)])
@ -1562,15 +1620,21 @@
(define variant (vector-ref k 1))
(define name (vector-ref k 2))
(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
racket-program-launcher-path)
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?
(if (eq? kind 'gui)
(gracket-launcher-is-actually-directory?)
(racket-launcher-is-actually-directory?)))
(define (delete exe-path)
(define rel-exe-path
((if (eq? kind 'gui)
path->relative-string/gui-bin
@ -1582,7 +1646,10 @@
(delete-file exe-path)]
[(and is-dir? (directory-exists? 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:
(when (eq? 'unix (cross-system-type))
(let ([desktop (installed-executable-path->desktop-path

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "6.5.0.1"
#define MZSCHEME_VERSION "6.5.0.2"
#define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 5
#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_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)