user paths depend on name (not always version); no `shared' pkg scope
An installation has a name (via the configuration file "config.rktd") that defaults to the version string. The name, instead of the Racket version, is used for forming the path to the user "collects" directory, user packages, and so on. The `user' package scope is thus user- and installation-name-specific (instead of user- and version-specific). Remove `shared' package and link scope, since the notion of installation names generalizes the concept (a set of installations can be given the same name) and fits it into `user' scope.
This commit is contained in:
Matthew Flatt
parent
e0bab441a8
commit
afe8c37a2a
|
|
@ -20,7 +20,6 @@
|
|||
[else
|
||||
(case a
|
||||
[(installation) #t]
|
||||
[(user) (eq? b 'shared)]
|
||||
[else #f])]))
|
||||
|
||||
(define (ipkg<? a b)
|
||||
|
|
|
|||
|
|
@ -38,7 +38,6 @@
|
|||
(define sc-install-pkg-scope-label (string-constant install-pkg-scope-label))
|
||||
(define sc-install-pkg-installation (string-constant install-pkg-installation))
|
||||
(define sc-install-pkg-user (string-constant install-pkg-user))
|
||||
(define sc-install-pkg-shared (string-constant install-pkg-shared))
|
||||
(define sc-install-pkg-set-as-default (string-constant install-pkg-set-as-default))
|
||||
(define sc-install-pkg-scope-is (string-constant install-pkg-scope-is))
|
||||
|
||||
|
|
@ -184,13 +183,11 @@
|
|||
[callback (λ (x y) (adjust-all))]
|
||||
[choices (list sc-install-pkg-default
|
||||
sc-install-pkg-installation
|
||||
sc-install-pkg-user
|
||||
sc-install-pkg-shared)]))
|
||||
sc-install-pkg-user)]))
|
||||
(define/private (selected-scope) (case (send scope-choice get-selection)
|
||||
[(0) (default-pkg-scope)]
|
||||
[(1) 'installation]
|
||||
[(2) 'user]
|
||||
[(3) 'shared]))
|
||||
[(2) 'user]))
|
||||
(define scope-default-button (new button%
|
||||
[label sc-install-pkg-set-as-default]
|
||||
[font small-control-font]
|
||||
|
|
@ -331,14 +328,12 @@
|
|||
(send scope-msg set-label (format sc-install-pkg-scope-is
|
||||
(case (selected-scope)
|
||||
[(installation) sc-install-pkg-installation]
|
||||
[(user) sc-install-pkg-user]
|
||||
[(shared) sc-install-pkg-shared])))
|
||||
[(user) sc-install-pkg-user])))
|
||||
(define is-default? (let ([v (send scope-choice get-selection)])
|
||||
(or (zero? v)
|
||||
(= v (case (default-pkg-scope)
|
||||
[(installation) 1]
|
||||
[(user) 2]
|
||||
[(shared) 3])))))
|
||||
[(user) 2])))))
|
||||
(define deleted? (not (member scope-default-button (send scope-panel get-children))))
|
||||
(unless (equal? is-default? deleted?)
|
||||
(if is-default?
|
||||
|
|
|
|||
|
|
@ -40,4 +40,4 @@
|
|||
(if (equal? d main)
|
||||
'installation
|
||||
d))))
|
||||
'(user shared)))
|
||||
'(user)))
|
||||
|
|
|
|||
|
|
@ -32,13 +32,14 @@ that are documented to require the lock. Other functions from
|
|||
@racketmodname[pkg/lib] take the lock as needed.}
|
||||
|
||||
@deftogether[(
|
||||
@defparam[current-pkg-scope scope (or/c 'installation 'user 'shared
|
||||
@defparam[current-pkg-scope scope (or/c 'installation 'user
|
||||
(and/c path? complete-path?))]
|
||||
@defparam[current-pkg-scope-version s string?]
|
||||
)]{
|
||||
|
||||
Parameters that together determine @tech{package scope} for management
|
||||
operations and the version for version-specific scope.}
|
||||
Parameters that determine @tech{package scope} for management
|
||||
operations and, in the case of @racket['user] scope, the relevant
|
||||
installation name/version.}
|
||||
|
||||
|
||||
@defparam[current-pkg-error err procedure?]{
|
||||
|
|
@ -75,13 +76,13 @@ Returns the directory that holds the installation of the installed
|
|||
is installed.}
|
||||
|
||||
|
||||
@defproc[(default-pkg-scope) (or/c 'installation 'user 'shared
|
||||
@defproc[(default-pkg-scope) (or/c 'installation 'user
|
||||
(and/c path? complete-path?))]{
|
||||
|
||||
Returns the user's configured default @tech{package scope}.}
|
||||
|
||||
|
||||
@defproc[(installed-pkg-names [#:scope scope (or/c #f 'installation 'user 'shared
|
||||
@defproc[(installed-pkg-names [#:scope scope (or/c #f 'installation 'user
|
||||
(and/c path? complete-path?))])
|
||||
(listof string?)]{
|
||||
|
||||
|
|
@ -90,7 +91,7 @@ scope}, where @racket[#f] indicates the user's default @tech{package
|
|||
scope}.}
|
||||
|
||||
|
||||
@defproc[(installed-pkg-table [#:scope scope (or/c #f 'installation 'user 'shared
|
||||
@defproc[(installed-pkg-table [#:scope scope (or/c #f 'installation 'user
|
||||
(and/c path? complete-path?))])
|
||||
(hash/c string? pkg-info?)]{
|
||||
|
||||
|
|
|
|||
|
|
@ -243,17 +243,15 @@ the version is part of the source. A @tech{single-collection package}
|
|||
can be a @tech{package update} of a @tech{multi-collection package}
|
||||
and vice versa.
|
||||
|
||||
A @deftech{package scope} determines the effect of package installations,
|
||||
updates, @|etc|, with respect to different users, Racket versions, and
|
||||
Racket installations. The default @tech{package scope} can be configured, but it is
|
||||
normally @exec{user}, which is user-specific and version-specific;
|
||||
that is, package installation makes the package visible only for the
|
||||
installing user and with the installing version of Racket. The
|
||||
@exec{installation} scope means that package installation makes the
|
||||
package visible to all users of the specific Racket installation that
|
||||
is used to install the package. The @exec{shared} scope means
|
||||
user-specific, but for all versions and installations of Racket.
|
||||
Finally, a directory path can be used as a package scope, in which case
|
||||
A @deftech{package scope} determines the effect of package
|
||||
installations, updates, @|etc|, with respect to different users and
|
||||
Racket installations. The default @tech{package scope} can be
|
||||
configured, but it is normally @exec{user}, which makes actions
|
||||
specific to both the current user and the installation's name/version
|
||||
(in the sense of @racket[get-installation-name]). The
|
||||
@exec{installation} scope means that package operations affect
|
||||
all users of the Racket installation.
|
||||
Finally, a directory path can be used as a @tech{package scope}, in which case
|
||||
package operations affect the set of packages installations in the
|
||||
directory (and an installation can be configured to include the
|
||||
directory in its search path for installed packages).
|
||||
|
|
@ -325,14 +323,12 @@ sub-sub-commands:
|
|||
@item{@DFlag{scope} @nonterm{scope} --- Selects the @tech{package scope} for installation, where @nonterm{scope} is one of
|
||||
@itemlist[
|
||||
@item{@exec{installation} --- Install packages for all users of a Racket installation, rather than user-specific.}
|
||||
@item{@exec{user} --- Install packages as user-specific and Racket version-specific.}
|
||||
@item{@exec{shared} --- Install packages as user-specific, but for all Racket versions.}
|
||||
@item{@exec{user} --- Install packages for the current user and current installation's name/version.}
|
||||
]
|
||||
The default package scope is normally @exec{user}, but it can be configured with
|
||||
@command-ref{config}@exec{ --set default-scope @nonterm{scope}}.}
|
||||
@item{@Flag{i} or @DFlag{installation} --- Shorthand for @exec{--scope installation}.}
|
||||
@item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.}
|
||||
@item{@Flag{s} or @DFlag{shared} --- Shorthand for @exec{--scope shared}.}
|
||||
@item{@DFlag{scope-dir} @nonterm{dir} --- Select @nonterm{dir} as the @tech{package scope}.}
|
||||
|
||||
@item{@DFlag{catalog} @nonterm{catalog} --- Use @nonterm{catalog} instead of of the currently configured
|
||||
|
|
@ -363,7 +359,6 @@ this command fails without installing any of the @nonterm{pkg}s
|
|||
@item{@DFlag{scope} @nonterm{scope} --- Selects a @tech{package scope}, the same as for @command-ref{install}.}
|
||||
@item{@Flag{i} or @DFlag{installation} --- Shorthand for @exec{--scope installation}.}
|
||||
@item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.}
|
||||
@item{@Flag{s} or @DFlag{shared} --- Shorthand for @exec{--scope shared}.}
|
||||
@item{@DFlag{scope-dir} @nonterm{dir} --- Selects @nonterm{dir} as the @tech{package scope}, the same as for @command-ref{install}.}
|
||||
@item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{binary} --- Same as for @command-ref{install}.}
|
||||
|
|
@ -387,7 +382,6 @@ removing any of the @nonterm{pkg}s.
|
|||
@item{@DFlag{scope} @nonterm{scope} --- Selects a @tech{package scope}, the same as for @command-ref{install}.}
|
||||
@item{@Flag{i} or @DFlag{installation} --- Shorthand for @exec{--scope installation}.}
|
||||
@item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.}
|
||||
@item{@Flag{s} or @DFlag{shared} --- Shorthand for @exec{--scope shared}.}
|
||||
@item{@DFlag{scope-dir} @nonterm{dir} --- Selects @nonterm{dir} as the @tech{package scope}, the same as for @command-ref{install}.}
|
||||
@item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.}
|
||||
|
|
@ -395,8 +389,7 @@ removing any of the @nonterm{pkg}s.
|
|||
}
|
||||
|
||||
@item{@command/toc{show} @nonterm{option} ... --- Print information about currently installed packages.
|
||||
By default, packages are shown for all installation modes (installation-wide,
|
||||
user- and Racket-version-specific, and user-specific all-version), but only for packages
|
||||
By default, packages are shown for all @tech{package scopes}, but only for packages
|
||||
not marked as auto-installed to fulfill dependencies.
|
||||
|
||||
The @exec{show} sub-command accepts
|
||||
|
|
@ -410,15 +403,15 @@ removing any of the @nonterm{pkg}s.
|
|||
@item{@DFlag{scope} @nonterm{scope} --- Shows only packages in @nonterm{scope}, which is one of
|
||||
@itemlist[
|
||||
@item{@exec{installation} --- Show only installation-wide packages.}
|
||||
@item{@exec{user} --- Show only user-specific, version-specific packages.}
|
||||
@item{@exec{shared} --- Show only user-specific, all-version packages.}
|
||||
@item{@exec{user} --- Show only user-specific packages for the current installation's name/version
|
||||
or the name/version specified with @DFlag{version} or @Flag{v}.}
|
||||
]
|
||||
The default is to show packages for all @tech{package scopes}.}
|
||||
@item{@Flag{i} or @DFlag{installation} --- Shorthand for @exec{--scope installation}.}
|
||||
@item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.}
|
||||
@item{@Flag{s} or @DFlag{shared} --- Shorthand for @exec{--scope shared}.}
|
||||
@item{@DFlag{scope-dir} @nonterm{dir} --- Shows only packages installed in @nonterm{dir}.}
|
||||
@item{@DFlag{version} @nonterm{vers} or @Flag{v} @nonterm{vers} --- Show only user-specific packages for Racket version @nonterm{vers}.}
|
||||
@item{@DFlag{version} @nonterm{vers} or @Flag{v} @nonterm{vers} --- Show only user-specific packages for
|
||||
the installation name/version @nonterm{vers}.}
|
||||
]
|
||||
}
|
||||
|
||||
|
|
@ -462,20 +455,17 @@ View and modify configuration of the package manager itself, with the following
|
|||
@item{@DFlag{set} --- Sets an option, rather than printing it.}
|
||||
@item{@DFlag{scope} @nonterm{scope} --- Selects a @tech{package scope}, the same as for @command-ref{install}.
|
||||
A configuration value set at @exec{installation} scope serves
|
||||
as the default value at @exec{shared} scope, and
|
||||
a configuration value set at @exec{shared} scope serves
|
||||
as the default value at @exec{user} scope.}
|
||||
@item{@Flag{i} or @DFlag{installation} --- Shorthand for @exec{--scope installation}.}
|
||||
@item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.}
|
||||
@item{@Flag{s} or @DFlag{shared} --- Shorthand for @exec{--scope shared}.}
|
||||
]
|
||||
|
||||
The valid keys are:
|
||||
@itemlist[
|
||||
@item{@exec{catalogs} --- A list of URLs for @tech{package catalogs}.}
|
||||
@item{@exec{default-scope} --- Either @exec{installation}, @exec{user}, or @exec{shared}.
|
||||
@item{@exec{default-scope} --- Either @exec{installation} or @exec{user}.
|
||||
The value of this key at @exec{user} scope (possibly defaulting from
|
||||
@exec{shared} or @exec{installation} scope) is
|
||||
@exec{installation} scope) is
|
||||
the default @tech{package scope} for all @exec{raco pkg} commands
|
||||
(even @command{config}, which is consistent but potentially confusing).}
|
||||
]
|
||||
|
|
@ -930,13 +920,9 @@ and rebuilt.
|
|||
|
||||
If you change the default @tech{package scope}, you can use the
|
||||
@Flag{u} or @DFlag{user} flag with a specific @exec{raco pkg} command
|
||||
to perform the command with user- and version-specific @tech{package
|
||||
scope}.
|
||||
|
||||
Finally, you can use the @Flag{s} or @DFlag{shared} flag
|
||||
with @exec{raco pkg} commands to install user-specific packages that
|
||||
apply to all Racket versions that you run. (In contrast, @|Planet1|
|
||||
requires reinstallation of all packages every version change.)
|
||||
to perform the command with user-specific @tech{package scope}.
|
||||
User-specific scope is also specific for a Racket installation
|
||||
name, where an installation name is typically a Racket version.
|
||||
|
||||
@subsection{Where and how are packages installed?}
|
||||
|
||||
|
|
|
|||
|
|
@ -90,6 +90,11 @@ directory:
|
|||
path for resolving package names; an @racket[#f] in the list
|
||||
is replaced with the default search path.}
|
||||
|
||||
@item{@racket['installation-name] --- a string for the installation
|
||||
name, which is used for packages in @exec{user}
|
||||
@tech[#:doc '(lib "pkg/scribblings/pkg.scrbl")]{package
|
||||
scope}; the default is @racket[(version)].}
|
||||
|
||||
@item{@racket['absolute-installation?] --- a boolean that is
|
||||
@racket[#t] if the installation uses absolute path names,
|
||||
@racket[#f] otherwise.}
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@
|
|||
"common.rkt"
|
||||
(for-label racket/base
|
||||
racket/contract
|
||||
setup/link))
|
||||
setup/link
|
||||
setup/dirs))
|
||||
|
||||
@title[#:tag "link"]{@exec{raco link}: Library Collection Links}
|
||||
|
||||
|
|
@ -55,7 +56,7 @@ Full command-line options:
|
|||
any other command-line arguments are provided that modify the
|
||||
link table, the table is shown after modifications. If no
|
||||
directory arguments are provided, and if none of @Flag{u},
|
||||
@DFlag{user}, @Flag{s}, @DFlag{shared}, @Flag{i}, @DFlag{installation}, @Flag{f}, or
|
||||
@DFlag{user}, @Flag{i}, @DFlag{installation}, @Flag{f}, or
|
||||
@DFlag{file} are specified, then the link table is shown for
|
||||
all user-specific and installation-wide @tech[#:doc
|
||||
reference-doc]{collection links files}.}
|
||||
|
|
@ -86,7 +87,8 @@ Full command-line options:
|
|||
@nonterm{regexp} --- Sets a version regexp that limits the link
|
||||
to use only by Racket versions (as reported by
|
||||
@racket[version]) matching @nonterm{regexp}. This flag
|
||||
is normally used with @Flag{s} or @DFlag{shared}. When the @Flag{r}
|
||||
is normally used with @Flag{u} or @DFlag{user} with installations
|
||||
that have different versions but the same installation name. When the @Flag{r}
|
||||
or @DFlag{remove} flag is also used, only links with a
|
||||
version regexp matching @nonterm{regexp} are removed.}
|
||||
|
||||
|
|
@ -94,24 +96,17 @@ Full command-line options:
|
|||
of add mode.}
|
||||
|
||||
@item{@Flag{u} or @DFlag{user} --- Limits listing and removal
|
||||
of links to the user- and version-specific @tech[#:doc
|
||||
reference-doc]{collection links file} and not the all-version or
|
||||
collection-wide @tech[#:doc reference-doc]{collection links
|
||||
file}. This flag is mutually exclusive with @Flag{s}, @DFlag{shared}, @Flag{i},
|
||||
@DFlag{installation}, @Flag{f}, and @DFlag{file}.}
|
||||
|
||||
@item{@Flag{s} or @DFlag{shared} --- Limits listing and removal
|
||||
of links to the user-specific, all-version @tech[#:doc
|
||||
reference-doc]{collection links file} and not the version-specific or
|
||||
collection-wide @tech[#:doc reference-doc]{collection links
|
||||
file}. This flag is mutually exclusive with @Flag{u}, @DFlag{user}, @Flag{i},
|
||||
of links to the user-specific @tech[#:doc
|
||||
reference-doc]{collection links file} and not the
|
||||
installation-wide @tech[#:doc reference-doc]{collection links
|
||||
file}. This flag is mutually exclusive with @Flag{i},
|
||||
@DFlag{installation}, @Flag{f}, and @DFlag{file}.}
|
||||
|
||||
@item{@Flag{i} or @DFlag{installation} --- Reads and writes links in
|
||||
installation-wide @tech[#:doc reference-doc]{collection links
|
||||
file} and not the user-specific @tech[#:doc
|
||||
reference-doc]{collection links file}. This flag is mutually
|
||||
exclusive with @Flag{u}, @DFlag{user}, @Flag{s}, @DFlag{shared}, @Flag{f}, and
|
||||
exclusive with @Flag{u}, @DFlag{user}, @Flag{f}, and
|
||||
@DFlag{file}.}
|
||||
|
||||
@item{@Flag{f} @nonterm{file} or @DFlag{file} @nonterm{file} ---
|
||||
|
|
@ -120,6 +115,11 @@ Full command-line options:
|
|||
file}. This flag is mutually exclusive with @Flag{u},
|
||||
@DFlag{user}, @Flag{s}, @DFlag{shared}, @Flag{i}, and @DFlag{installation}.}
|
||||
|
||||
@item{@Flag{v} @nonterm{vers} or @DFlag{version} @nonterm{vers} ---
|
||||
Selects @nonterm{vers} as relevant installation name for
|
||||
operations on the user-specific @tech[#:doc
|
||||
reference-doc]{collection links file}.}
|
||||
|
||||
@item{@DFlag{repair} --- Enables repairs to the existing file content
|
||||
when the content is erroneous. The file is repaired by deleting
|
||||
individual links when possible.}
|
||||
|
|
@ -134,7 +134,7 @@ Full command-line options:
|
|||
|
||||
@defproc[(links [dir path?] ...
|
||||
[#:user? user? any/c #t]
|
||||
[#:shared? shared? any/c #t]
|
||||
[#:user-version user-version string? (get-installation-name)]
|
||||
[#:file file (or/c path-string? #f) #f]
|
||||
[#:name name (or/c string? #f) #f]
|
||||
[#:root? root? any/c #f]
|
||||
|
|
@ -149,11 +149,11 @@ Full command-line options:
|
|||
|
||||
A function version of the @exec{raco link} command that always works
|
||||
on a single file---either @racket[file] if it is a path string, the
|
||||
user- and version-specific @tech[#:doc reference-doc]{collection links file} if
|
||||
@racket[user?] is true and @racket[shared?] is false, the
|
||||
user-specific, all-version @tech[#:doc reference-doc]{collection links file} if
|
||||
@racket[shared?] is true, or the installation-wide @tech[#:doc
|
||||
reference-doc]{collection links file} otherwise.
|
||||
user--specific @tech[#:doc reference-doc]{collection links file} if
|
||||
@racket[user?] is true, or the installation-wide @tech[#:doc
|
||||
reference-doc]{collection links file} otherwise. If @racket[user?]
|
||||
is true, then @racket[user-version] determines the relevant
|
||||
installation name (defaulting to the current installation's name).
|
||||
|
||||
The @racket[static-root?] flag value is ignored unless @racket[root?]
|
||||
is true and @racket[remove?] is false, in which case each given
|
||||
|
|
|
|||
|
|
@ -991,16 +991,11 @@ v
|
|||
installation scope; the directory indicated by the returned path may
|
||||
or may not exist.}
|
||||
|
||||
@defproc[(find-user-pkgs-dir) path?]{
|
||||
@defproc[(find-user-pkgs-dir [vers string? (get-installation-name)]) path?]{
|
||||
Returns a path to the directory containing packages with
|
||||
user- and version-specific scope; the directory indicated by
|
||||
user-specific scope for installation name @racket[vers]; the directory indicated by
|
||||
the returned path may or may not exist.}
|
||||
|
||||
@defproc[(find-shared-pkgs-dir) path?]{
|
||||
Returns a path to the directory containing packages with
|
||||
user-specific, all-version scope; the directory indicated by the
|
||||
returned path may or may not exist.}
|
||||
|
||||
@defproc[(get-pkgs-search-dirs) (listof path?)]{
|
||||
Returns a list of paths to the directories containing packages in
|
||||
installation scope. (Normally, the result includes the result of
|
||||
|
|
@ -1104,6 +1099,11 @@ v
|
|||
Returns a string that is used by the documentation system, augmented
|
||||
with a version and search-key query, for remote documentation links.}
|
||||
|
||||
@defproc[(get-installation-name) string?]{ Returns the current
|
||||
installation's name, which is often @racket[(version)] but can be
|
||||
configured via @racket['installation-name] in @filepath{config.rktd}
|
||||
(see @secref["config-file"]).}
|
||||
|
||||
@defthing[absolute-installation? boolean?]{
|
||||
A binary boolean flag that is true if this installation is using
|
||||
absolute path names.}
|
||||
|
|
|
|||
|
|
@ -91,7 +91,7 @@ Produces a list of paths as follows:
|
|||
@itemize[
|
||||
|
||||
@item{The path produced by @racket[(build-path (find-system-path
|
||||
'addon-dir) (version) "collects")] is the first element of the
|
||||
'addon-dir) (get-installation-name) "collects")] is the first element of the
|
||||
default collection path list, unless the value of the
|
||||
@racket[use-user-specific-search-paths] parameter is @racket[#f].}
|
||||
|
||||
|
|
@ -197,17 +197,14 @@ The @deftech{collection links files} are used by
|
|||
default @tech{module name resolver} to locate collections before
|
||||
trying the @racket[(current-library-collection-paths)] search
|
||||
path, but only if the @racket[use-collection-link-paths] parameter is set to
|
||||
@racket[#t]. Furthermore, a user- and version-specific @tech{collection links file} takes
|
||||
precedence over a user-specific and all-version @tech{collection links file},
|
||||
which in turn takes precedence over an installation-wide @tech{collection links file}.
|
||||
The user-specific @tech{collection links files} are used only if the
|
||||
@racket[#t]. Furthermore, a user-specific @tech{collection links file} takes
|
||||
precedence over an installation-wide @tech{collection links file}.
|
||||
The user-specific @tech{collection links file} is used only if the
|
||||
@racket[use-user-specific-search-paths] parameter is set to
|
||||
@racket[#t].
|
||||
|
||||
The path of the user- and version-specific @tech{collection links file} is
|
||||
@racket[(build-path (find-system-path 'addon-dir) (version) "links.rktd")].
|
||||
The path of the user-specific and all-version @tech{collection links file} is
|
||||
@racket[(build-path (find-system-path 'addon-dir) "links.rktd")].
|
||||
The path of the user--specific @tech{collection links file} is
|
||||
@racket[(build-path (find-system-path 'addon-dir) (get-installation-name) "links.rktd")].
|
||||
The path of the installation-wide @tech{collection links file} is
|
||||
@racket[(build-path (find-config-dir) "links.rktd")].
|
||||
Each @tech{collection links file} is cached by Racket, but
|
||||
|
|
|
|||
|
|
@ -7,20 +7,12 @@
|
|||
(shelly-case
|
||||
"reading and writing configs"
|
||||
$ "raco pkg config catalogs" =stdout> "https://pkg.racket-lang.org\nhttps://planet-compat.racket-lang.org\n"
|
||||
$ "raco pkg config -s --set catalogs http://localhost:9000"
|
||||
$ "raco pkg config -s catalogs" =stdout> "http://localhost:9000\n"
|
||||
|
||||
;; shared value inherited as user:
|
||||
$ "raco pkg config catalogs" =stdout> "http://localhost:9000\n"
|
||||
|
||||
;; user separate from shared:
|
||||
$ "raco pkg config --set -u catalogs http://localhost:0999"
|
||||
$ "raco pkg config -u catalogs" =stdout> "http://localhost:0999\n"
|
||||
$ "raco pkg config -s catalogs" =stdout> "http://localhost:9000\n"
|
||||
$ "raco pkg config -u --set catalogs http://localhost:9000"
|
||||
$ "raco pkg config -u catalogs" =stdout> "http://localhost:9000\n"
|
||||
|
||||
;; can set default scope:
|
||||
$ "raco pkg config --set -u default-scope shared"
|
||||
$ "raco pkg config -u default-scope" =stdout> "shared\n"
|
||||
$ "raco pkg config -s default-scope" =stdout> "user\n"
|
||||
$ "raco pkg config --set -u default-scope installation"
|
||||
$ "raco pkg config -u default-scope" =stdout> "installation\n"
|
||||
$ "raco pkg config -i default-scope" =stdout> "user\n"
|
||||
$ "raco pkg config default-scope" =stdout> "user\n"
|
||||
$ "raco pkg config catalogs" =stdout> "http://localhost:9000\n")))
|
||||
$ "raco pkg config -u catalogs" =stdout> "http://localhost:9000\n")))
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@
|
|||
(shelly-case
|
||||
"remove and show"
|
||||
(shelly-case "remove of not installed package fails"
|
||||
$ "raco pkg show -u" =stdout> " [none]\n"
|
||||
$ "raco pkg show -u -a" =stdout> " [none]\n"
|
||||
$ "raco pkg remove not-there" =exit> 1)
|
||||
(shelly-install "remove test"
|
||||
"test-pkgs/pkg-test1.zip")
|
||||
|
|
@ -29,12 +29,12 @@
|
|||
"pkg-test1 pkg-test1")
|
||||
(shelly-install "remove of dep fails"
|
||||
"test-pkgs/pkg-test1.zip"
|
||||
$ "raco pkg show -u" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1 +[a-f0-9]+ +\\(file .+tests/pkg/test-pkgs/pkg-test1.zip\\)\n"
|
||||
$ "raco pkg show -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1 +[a-f0-9]+ +\\(file .+tests/pkg/test-pkgs/pkg-test1.zip\\)\n"
|
||||
$ "raco pkg install test-pkgs/pkg-test2.zip"
|
||||
$ "raco pkg show -u" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1 +[a-f0-9]+ +\\(file .+tests/pkg/test-pkgs/pkg-test1.zip\\)\npkg-test2 +[a-f0-9]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\\)\n"
|
||||
$ "raco pkg show -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1 +[a-f0-9]+ +\\(file .+tests/pkg/test-pkgs/pkg-test1.zip\\)\npkg-test2 +[a-f0-9]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\\)\n"
|
||||
$ "raco pkg remove pkg-test1" =exit> 1 =stderr> #rx"pkg-test1 \\(required by: \\(pkg-test2\\)\\)"
|
||||
$ "raco pkg remove pkg-test2"
|
||||
$ "raco pkg show -u" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1 +[a-f0-9]+ +\\(file .+tests/pkg/test-pkgs/pkg-test1.zip\\)\n")
|
||||
$ "raco pkg show -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1 +[a-f0-9]+ +\\(file .+tests/pkg/test-pkgs/pkg-test1.zip\\)\n")
|
||||
(shelly-install "remove of dep can be forced"
|
||||
"test-pkgs/pkg-test1.zip"
|
||||
$ "raco pkg install test-pkgs/pkg-test2.zip"
|
||||
|
|
@ -62,21 +62,21 @@
|
|||
$ "racket -e '(require pkg-test1)'" =exit> 1
|
||||
$ "racket -e '(require pkg-test2)'" =exit> 1
|
||||
$ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0
|
||||
$ "raco pkg show -u" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9]+ +\\(catalog pkg-test1\\)\npkg-test2 +[a-f0-9]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\\)\n"
|
||||
$ "raco pkg show -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9]+ +\\(catalog pkg-test1\\)\npkg-test2 +[a-f0-9]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\\)\n"
|
||||
$ "racket -e '(require pkg-test1)'" =exit> 0
|
||||
$ "racket -e '(require pkg-test2)'" =exit> 0
|
||||
$ "racket -e '(require pkg-test2/contains-dep)'" =exit> 0
|
||||
$ "raco pkg remove pkg-test2"
|
||||
$ "raco pkg show -u" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9]+ +\\(catalog pkg-test1\\)\n"
|
||||
$ "raco pkg show -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9]+ +\\(catalog pkg-test1\\)\n"
|
||||
$ "racket -e '(require pkg-test1)'" =exit> 0
|
||||
$ "raco pkg remove --auto"
|
||||
$ "raco pkg show -u" =stdout> " [none]\n"
|
||||
$ "raco pkg show -u -a" =stdout> " [none]\n"
|
||||
$ "racket -e '(require pkg-test1)'" =exit> 1
|
||||
$ "racket -e '(require pkg-test2)'" =exit> 1))
|
||||
(with-fake-root
|
||||
(shelly-case
|
||||
"different scope error"
|
||||
$ "raco pkg install --shared test-pkgs/pkg-test1.zip" =exit> 0
|
||||
$ "raco pkg remove pkg-test1" =exit> 1
|
||||
=stderr> #rx"package installed in a different scope: shared"
|
||||
$ "raco pkg remove --shared pkg-test1")))))
|
||||
$ "raco pkg install test-pkgs/pkg-test1.zip" =exit> 0
|
||||
$ "raco pkg remove --installation pkg-test1" =exit> 1
|
||||
=stderr> #rx"package installed in a different scope: user"
|
||||
$ "raco pkg remove pkg-test1")))))
|
||||
|
|
|
|||
|
|
@ -46,12 +46,12 @@
|
|||
'source
|
||||
"http://localhost:9999/pkg-a-first.plt"))
|
||||
$ "raco pkg install --deps search-auto pkg-b" =exit> 0 <input= "y\n"
|
||||
$ "raco pkg show -u" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-a\\* +[a-f0-9]+ \\(catalog pkg-a\\)\npkg-b +[a-f0-9]+ +\\(catalog pkg-b\\)\n"
|
||||
$ "raco pkg show -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-a\\* +[a-f0-9]+ \\(catalog pkg-a\\)\npkg-b +[a-f0-9]+ +\\(catalog pkg-b\\)\n"
|
||||
$ "racket -e '(require pkg-b)'" =exit> 43
|
||||
$ "racket -e '(require pkg-a)'" =exit> 0
|
||||
;; remove auto doesn't do anything because everything is needed
|
||||
$ "raco pkg remove --auto"
|
||||
$ "raco pkg show -u" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-a\\* +[a-f0-9]+ \\(catalog pkg-a\\)\npkg-b +[a-f0-9]+ +\\(catalog pkg-b\\)\n"
|
||||
$ "raco pkg show -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-a\\* +[a-f0-9]+ \\(catalog pkg-a\\)\npkg-b +[a-f0-9]+ +\\(catalog pkg-b\\)\n"
|
||||
$ "racket -e '(require pkg-b)'" =exit> 43
|
||||
$ "racket -e '(require pkg-a)'" =exit> 0
|
||||
;; pkg-a is now an auto
|
||||
|
|
@ -63,9 +63,9 @@
|
|||
$ "raco pkg update -a" =exit> 0
|
||||
$ "racket -e '(require pkg-a)'" =exit> 43
|
||||
$ "raco pkg remove pkg-b"
|
||||
$ "raco pkg show -u" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-a\\* +[a-f0-9]+ +\\(catalog pkg-a\\)\n"
|
||||
$ "raco pkg show -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-a\\* +[a-f0-9]+ +\\(catalog pkg-a\\)\n"
|
||||
$ "racket -e '(require pkg-b)'" =exit> 1
|
||||
;; pkg-a is now not needed
|
||||
$ "raco pkg remove --auto"
|
||||
$ "raco pkg show -u" =stdout> " [none]\n"
|
||||
$ "raco pkg show -u -a" =stdout> " [none]\n"
|
||||
$ "racket -e '(require pkg-a)'" =exit> 1)))
|
||||
|
|
|
|||
|
|
@ -930,13 +930,11 @@
|
|||
#:when (file-exists? f))
|
||||
(links #:root? #t #:file f)))
|
||||
(links #:root? #t #:user? #t)
|
||||
(links #:root? #t #:shared? #t)
|
||||
(apply append
|
||||
(for/list ([f (get-links-search-files)]
|
||||
#:when (file-exists? f))
|
||||
(map cdr (links #:file f #:with-path? #t))))
|
||||
(map cdr (links #:user? #t #:with-path? #t))
|
||||
(map cdr (links #:shared? #t #:with-path? #t))))
|
||||
(map cdr (links #:user? #t #:with-path? #t))))
|
||||
(read-bytecode ,(PLANET-BASE-DIR))
|
||||
(exists ,(find-system-path 'addon-dir))
|
||||
(read ,(build-path (find-system-path 'addon-dir) "links.rktd"))
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@
|
|||
(define current-pkg-scope
|
||||
(make-parameter 'user))
|
||||
(define current-pkg-scope-version
|
||||
(make-parameter (version)))
|
||||
(make-parameter (get-installation-name)))
|
||||
(define current-pkg-error
|
||||
(make-parameter (lambda args (apply error 'pkg args))))
|
||||
(define current-no-pkg-db
|
||||
|
|
@ -409,13 +409,9 @@
|
|||
(for*/hash ([dir (in-list (get-pkgs-search-dirs))]
|
||||
[(k v) (read-pkgs-db dir)])
|
||||
(values k v))]
|
||||
[(shared)
|
||||
(define db (read-pkgs-db 'shared))
|
||||
(for/fold ([ht (merge-next-pkg-dbs 'installation)]) ([(k v) (in-hash db)])
|
||||
(hash-set ht k v))]
|
||||
[(user)
|
||||
(define db (read-pkgs-db 'user))
|
||||
(for/fold ([ht (merge-next-pkg-dbs 'shared)]) ([(k v) (in-hash db)])
|
||||
(for/fold ([ht (merge-next-pkg-dbs 'installation)]) ([(k v) (in-hash db)])
|
||||
(hash-set ht k v))])))
|
||||
|
||||
(define (package-info pkg-name [fail? #t] #:db [given-db #f])
|
||||
|
|
@ -430,7 +426,6 @@
|
|||
(pkg-not-installed pkg-name db)]))
|
||||
|
||||
;; return the current scope as a string
|
||||
;; -> (or/c "user" "shared" "installation")
|
||||
(define (current-scope->string)
|
||||
(define scope (current-pkg-scope))
|
||||
(cond
|
||||
|
|
@ -446,22 +441,17 @@
|
|||
(define user-db
|
||||
(parameterize ([current-pkg-scope 'user])
|
||||
(read-pkg-db)))
|
||||
(define shared-db
|
||||
(parameterize ([current-pkg-scope 'shared])
|
||||
(read-pkg-db)))
|
||||
|
||||
;; see if the package is installed in any scope
|
||||
(define-values (in-install? in-user? in-shared?)
|
||||
(define-values (in-install? in-user?)
|
||||
(values
|
||||
(and (hash-ref installation-db pkg-name #f)
|
||||
"--installation")
|
||||
(and (hash-ref user-db pkg-name #f)
|
||||
"--user")
|
||||
(and (hash-ref shared-db pkg-name #f)
|
||||
"--shared")))
|
||||
"--user")))
|
||||
|
||||
(define not-installed-msg
|
||||
(cond [(or in-user? in-install? in-shared?)
|
||||
(cond [(or in-user? in-install?)
|
||||
=>
|
||||
(λ (scope-str)
|
||||
(~a "could not remove package\n"
|
||||
|
|
@ -510,9 +500,7 @@
|
|||
;; Hard-wided:
|
||||
(get-default)
|
||||
;; Enclosing:
|
||||
(parameterize ([current-pkg-scope (if (eq? s 'user)
|
||||
'shared
|
||||
'installation)])
|
||||
(parameterize ([current-pkg-scope 'installation])
|
||||
(read-pkg-cfg/def k)))]
|
||||
[else
|
||||
(match k
|
||||
|
|
@ -535,7 +523,6 @@
|
|||
(define (default-pkg-scope)
|
||||
(match (default-pkg-scope-as-string)
|
||||
["installation" 'installation]
|
||||
["shared" 'shared]
|
||||
[else 'user]))
|
||||
(define (default-pkg-scope-as-string)
|
||||
(read-pkg-cfg/def 'default-scope))
|
||||
|
|
@ -568,7 +555,7 @@
|
|||
(if (path? current-scope)
|
||||
(list current-scope)
|
||||
(member current-scope
|
||||
(append '(user shared)
|
||||
(append '(user)
|
||||
(let ([main (find-pkgs-dir)])
|
||||
(for/list ([d (get-pkgs-search-dirs)])
|
||||
(if (equal? d main)
|
||||
|
|
@ -603,21 +590,17 @@
|
|||
(define scope (current-pkg-scope))
|
||||
(define user? (not (or (eq? scope 'installation)
|
||||
(path? scope))))
|
||||
(define shared? (and user?
|
||||
(eq? (current-pkg-scope) 'shared)))
|
||||
(match orig-pkg
|
||||
[`(,(or 'link 'static-link) ,_)
|
||||
(links pkg-dir
|
||||
#:remove? #t
|
||||
#:user? user?
|
||||
#:shared? shared?
|
||||
#:file (scope->links-file scope)
|
||||
#:root? (not (sc-pkg-info? pi)))]
|
||||
[_
|
||||
(links pkg-dir
|
||||
#:remove? #t
|
||||
#:user? user?
|
||||
#:shared? shared?
|
||||
#:file (scope->links-file scope)
|
||||
#:root? (not (sc-pkg-info? pi)))
|
||||
(delete-directory/files pkg-dir)]))
|
||||
|
|
@ -1323,7 +1306,6 @@
|
|||
#:name single-collect
|
||||
#:user? (not (or (eq? 'installation scope)
|
||||
(path? scope)))
|
||||
#:shared? (eq? 'shared scope)
|
||||
#:file (scope->links-file scope)
|
||||
#:root? (not single-collect)
|
||||
#:static-root? (and (pair? orig-pkg)
|
||||
|
|
@ -1641,11 +1623,11 @@
|
|||
[(list* (and key "catalogs") val)
|
||||
(update-pkg-cfg! 'catalogs val)]
|
||||
[(list (and key "default-scope") val)
|
||||
(unless (member val '("installation" "user" "shared"))
|
||||
(unless (member val '("installation" "user"))
|
||||
(pkg-error (~a "invalid value for config key\n"
|
||||
" config key: ~a\n"
|
||||
" given value: ~a\n"
|
||||
" valid values: installation, user, or shared")
|
||||
" valid values: installation, user")
|
||||
key
|
||||
val))
|
||||
(update-pkg-cfg! 'default-scope val)]
|
||||
|
|
@ -1784,10 +1766,9 @@
|
|||
(parameterize ([current-pkg-scope scope])
|
||||
(with-pkg-lock/read-only
|
||||
(pkg-directory* dir-or-name))))
|
||||
(define dir (or (get-dir 'user)
|
||||
(get-dir 'shared)))
|
||||
(define dir (get-dir 'user))
|
||||
(unless dir
|
||||
(pkg-error (~a "package not installed in user or shared scope\n"
|
||||
(pkg-error (~a "package not installed in user scope\n"
|
||||
" package name: ~a"
|
||||
(if (get-dir 'installation)
|
||||
"\n installed in scope: installation"
|
||||
|
|
@ -2258,7 +2239,7 @@
|
|||
(or/c #f 'fail 'force 'search-ask 'search-auto))
|
||||
|
||||
(define package-scope/c
|
||||
(or/c 'installation 'user 'shared
|
||||
(or/c 'installation 'user
|
||||
(and/c path? complete-path?)))
|
||||
|
||||
(provide
|
||||
|
|
|
|||
|
|
@ -1,6 +1,5 @@
|
|||
#lang racket/base
|
||||
(require (only-in racket/base [version r:version])
|
||||
racket/function
|
||||
(require racket/function
|
||||
racket/list
|
||||
raco/command-name
|
||||
setup/dirs
|
||||
|
|
@ -31,15 +30,14 @@
|
|||
(string->symbol (format "~a ~a" (short-program+command-name) cmd))
|
||||
args))
|
||||
|
||||
(define (call-with-package-scope who given-scope scope-dir installation shared user thunk)
|
||||
(define (call-with-package-scope who given-scope scope-dir installation user thunk)
|
||||
(define scope
|
||||
(case given-scope
|
||||
[(installation user shared) given-scope]
|
||||
[(installation user) given-scope]
|
||||
[else
|
||||
(cond
|
||||
[installation 'installation]
|
||||
[user 'user]
|
||||
[shared 'shared]
|
||||
[scope-dir (path->complete-path scope-dir)]
|
||||
[else (default-pkg-scope)])]))
|
||||
(parameterize ([current-pkg-scope scope]
|
||||
|
|
@ -83,14 +81,12 @@
|
|||
#:once-each
|
||||
[#:bool skip-installed () ("Skip a <pkg-source> if already installed")]
|
||||
#:once-any
|
||||
[(#:sym scope [installation user shared] #f) scope ()
|
||||
[(#:sym scope [installation user] #f) scope ()
|
||||
("Select package <scope>, one of"
|
||||
" installation: Install for all users of the Racket installation"
|
||||
" user: Install as user- and version-specific"
|
||||
" shared: Install as user-specific but shared for all Racket versions")]
|
||||
" user: Install as user-specific for an installation version/name")]
|
||||
[#:bool installation ("-i") "Shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "Shorthand for `--scope user'"]
|
||||
[#:bool shared ("-s") "Shorthand for `--scope shared'"]
|
||||
[(#:str dir #f) scope-dir () "Install for package scope <dir>"]
|
||||
#:once-each
|
||||
[(#:str catalog #f) catalog () "Use <catalog> instead of configured catalogs"]
|
||||
|
|
@ -100,7 +96,7 @@
|
|||
#:args pkg-source
|
||||
(call-with-package-scope
|
||||
'install
|
||||
scope scope-dir installation shared user
|
||||
scope scope-dir installation user
|
||||
(lambda ()
|
||||
(unless (or (not name) (package-source->name name))
|
||||
((current-pkg-error) (format "~e is an invalid package name" name)))
|
||||
|
|
@ -135,14 +131,12 @@
|
|||
" search-auto: like 'search-ask' but does not ask for permission to install")]
|
||||
[#:bool update-deps () "Check named packages' dependencies for updates"]
|
||||
#:once-any
|
||||
[(#:sym scope [installation user shared] #f) scope ()
|
||||
[(#:sym scope [installation user] #f) scope ()
|
||||
("Select package scope, one of"
|
||||
" installation: Update only for all users of the Racket installation"
|
||||
" user: Update only user- and version-specific packages"
|
||||
" shared: Update only user-specific packages for all Racket versions")]
|
||||
" user: Update only user-specific for an installation version/name")]
|
||||
[#:bool installation ("-i") "Shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "Shorthand for `--scope user'"]
|
||||
[#:bool shared ("-s") "Shorthand for `--scope shared'"]
|
||||
[(#:str dir #f) scope-dir () "Update for package scope <dir>"]
|
||||
#:once-any
|
||||
[#:bool source () ("Strip built elements of the package before installing")]
|
||||
|
|
@ -154,7 +148,7 @@
|
|||
#:args pkg
|
||||
(call-with-package-scope
|
||||
'update
|
||||
scope scope-dir installation shared user
|
||||
scope scope-dir installation user
|
||||
(lambda ()
|
||||
(define setup-collects
|
||||
(with-pkg-lock
|
||||
|
|
@ -170,14 +164,12 @@
|
|||
[#:bool force () "Force removal of packages"]
|
||||
[#:bool auto () "Remove automatically installed packages with no dependencies"]
|
||||
#:once-any
|
||||
[(#:sym scope [installation user shared] #f) scope ()
|
||||
[(#:sym scope [installation user] #f) scope ()
|
||||
("Select package <scope>, one of"
|
||||
" installation: Remove packages for all users of the Racket installation"
|
||||
" user: Remove user- and version-specific packages"
|
||||
" shared: Remove user-specific packages for all Racket versions")]
|
||||
" user: Remove user-specific for an installation version/name")]
|
||||
[#:bool installation ("-i") "Shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "Shorthand for `--scope user'"]
|
||||
[#:bool shared ("-s") "Shorthand for `--scope shared'"]
|
||||
[(#:str dir #f) scope-dir () "Remove for package scope <dir>"]
|
||||
#:once-each
|
||||
[#:bool no-setup () ("Don't run `raco setup' after changing packages (usually"
|
||||
|
|
@ -186,7 +178,7 @@
|
|||
#:args pkg
|
||||
(call-with-package-scope
|
||||
'remove
|
||||
scope scope-dir installation shared user
|
||||
scope scope-dir installation user
|
||||
(lambda ()
|
||||
(define setup-collects
|
||||
(with-pkg-lock
|
||||
|
|
@ -200,24 +192,21 @@
|
|||
[#:bool all ("-a") "Show auto-installed packages, too"]
|
||||
[#:bool dir ("-d") "Show the directory where the package is installed"]
|
||||
#:once-any
|
||||
[(#:sym scope [installation user shared] #f) scope ()
|
||||
[(#:sym scope [installation user] #f) scope ()
|
||||
("Show only for package <scope>, one of"
|
||||
" installation: Show only for all users of the Racket installation"
|
||||
" user: Show only user- and version-specific"
|
||||
" shared: Show only user-specific for all Racket versions")]
|
||||
[(#:str vers #f) version ("-v") "Show only user-specific for Racket <vers>"]
|
||||
" user: Show only user-specific for an installation version/name")]
|
||||
[(#:str vers #f) version ("-v") "Show user-specific for installation <vers>"]
|
||||
[#:bool installation ("-i") "Shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "Shorthand for `--scope user'"]
|
||||
[#:bool shared ("-s") "Shorthand for `--scope shared'"]
|
||||
[(#:str dir #f) scope-dir () "Show only for package scope <dir>"]
|
||||
#:args ()
|
||||
(define only-mode (case scope
|
||||
[(installation user shared) scope]
|
||||
[(installation user) scope]
|
||||
[else
|
||||
(cond
|
||||
[scope-dir (path->complete-path scope-dir)]
|
||||
[installation 'installation]
|
||||
[shared 'shared]
|
||||
[user 'user]
|
||||
[else (if version 'user #f)])]))
|
||||
(for ([mode (if only-mode
|
||||
|
|
@ -228,18 +217,17 @@
|
|||
(if (equal? d main)
|
||||
'installation
|
||||
d))))
|
||||
'(shared user)))])
|
||||
'(user)))])
|
||||
(when (or (equal? mode only-mode) (not only-mode))
|
||||
(unless only-mode
|
||||
(printf "~a\n" (case mode
|
||||
[(installation) "Installation-wide:"]
|
||||
[(shared) "User-specific, all-version:"]
|
||||
[(user) (format "User-specific, version-specific (~a):"
|
||||
(or version (r:version)))]
|
||||
[(user) (format "User-specific for installation ~s:"
|
||||
(or version (get-installation-name)))]
|
||||
[else (format "~a:" mode)])))
|
||||
(parameterize ([current-pkg-scope mode]
|
||||
[current-pkg-error (pkg-error 'show)]
|
||||
[current-pkg-scope-version (or version (r:version))])
|
||||
[current-pkg-scope-version (or version (get-installation-name))])
|
||||
(with-pkg-lock/read-only
|
||||
(pkg-show (if only-mode "" " ")
|
||||
#:auto? all
|
||||
|
|
@ -280,18 +268,16 @@
|
|||
#:once-each
|
||||
[#:bool set () "Completely replace the value"]
|
||||
#:once-any
|
||||
[(#:sym scope [installation user shared] #f) scope ()
|
||||
[(#:sym scope [installation user] #f) scope ()
|
||||
("Select configuration <scope>, one of"
|
||||
" installation: Operate on the installation-wide package configuration"
|
||||
" user: Operate on the user-specific, version-specific package configuration"
|
||||
" shared: Operate on the user-specific all-version package configuration")]
|
||||
" user: Operate on the user-specific for an installation name")]
|
||||
[#:bool installation ("-i") "Shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "Shorthand for `--scope user'"]
|
||||
[#:bool shared ("-s") "Shorthand for `--scope shared'"]
|
||||
#:args key/val
|
||||
(call-with-package-scope
|
||||
'config
|
||||
scope #f installation shared user
|
||||
scope #f installation user
|
||||
(lambda ()
|
||||
(if set
|
||||
(with-pkg-lock
|
||||
|
|
|
|||
|
|
@ -15,13 +15,12 @@
|
|||
|
||||
(define (check-scope who scope)
|
||||
(unless (or (eq? scope 'user)
|
||||
(eq? scope 'shared)
|
||||
(eq? scope 'installation)
|
||||
(and (path? scope)
|
||||
(complete-path? scope)))
|
||||
(raise-argument-error
|
||||
who
|
||||
"(or/c 'user 'shared 'installation (and/c path? complete-path?))"
|
||||
"(or/c 'user 'installation (and/c path? complete-path?))"
|
||||
scope)))
|
||||
|
||||
(define (get-pkgs-dir scope [user-version (version)])
|
||||
|
|
@ -33,7 +32,6 @@
|
|||
(case scope
|
||||
[(installation) (find-pkgs-dir)]
|
||||
[(user) (find-user-pkgs-dir user-version)]
|
||||
[(shared) (find-shared-pkgs-dir)]
|
||||
[else (error "unknown package scope")])))
|
||||
|
||||
(define (read-pkg-file-hash file)
|
||||
|
|
@ -87,7 +85,7 @@
|
|||
(define (build-path* l)
|
||||
(if (null? l) 'same (apply build-path l)))
|
||||
(for/fold ([pkg #f] [subpath #f] [collect #f])
|
||||
([scope (in-list (list* 'user 'shared
|
||||
([scope (in-list (list* 'user
|
||||
(get-pkgs-search-dirs)))]
|
||||
#:when (not pkg))
|
||||
(define d (or (and cache
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
Version 5.90.0.3
|
||||
Base user directoy paths on an installation name instead
|
||||
of the Racket version string
|
||||
Remove "shared" links and package scope
|
||||
|
||||
Version 5.90.0.2
|
||||
Added #%declare
|
||||
Cross-phase persistent modules must be declared with
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
(define show-mode (make-parameter #f))
|
||||
(define install-only (make-parameter #f))
|
||||
(define user-only (make-parameter #f))
|
||||
(define user-shared (make-parameter #f))
|
||||
(define user-version (make-parameter #f))
|
||||
|
||||
(define link-symbol (string->symbol (short-program+command-name)))
|
||||
|
||||
|
|
@ -42,16 +42,16 @@
|
|||
[("-r" "--remove") "Remove links for the specified directories"
|
||||
(remove-mode #t)]
|
||||
#:once-any
|
||||
[("-u" "--user") "Adjust/list user-specific, version-specific links"
|
||||
[("-u" "--user") "Adjust/list user-specific links for an installation name/version"
|
||||
(user-only #t)]
|
||||
[("-s" "--shared") "Adjust/list user-specific links"
|
||||
(user-only #t)
|
||||
(user-shared #t)]
|
||||
[("-i" "--installation") "Adjust/list installation-wide links"
|
||||
(install-only #t)]
|
||||
[("-f" "--file") file "Select an alternate link file"
|
||||
(link-file (path->complete-path file))]
|
||||
#:once-each
|
||||
[("-v" "--version") vers "Adjust/list user-specific links for <vers>"
|
||||
(user-only #t)
|
||||
(user-version vers)]
|
||||
[("--repair") "Enable repair mode to fix existing links"
|
||||
(repair-mode #t)]
|
||||
#:args
|
||||
|
|
@ -67,20 +67,19 @@
|
|||
(and (null? dirs)
|
||||
(show-mode)
|
||||
(not (user-only))
|
||||
(not (user-shared))
|
||||
(not (install-only))
|
||||
(not (link-file))))
|
||||
|
||||
(when show-all?
|
||||
(printf "User-specific, version-specific links:\n"))
|
||||
|
||||
(define (go user? shared?)
|
||||
(define (go user? vers)
|
||||
(apply links
|
||||
dirs
|
||||
#:root? (root-mode)
|
||||
#:static-root? (static-root-mode)
|
||||
#:user? user?
|
||||
#:shared? shared?
|
||||
#:user-version (or vers (get-installation-name))
|
||||
#:file (link-file)
|
||||
#:name (link-name)
|
||||
#:version-regexp (link-version)
|
||||
|
|
@ -92,15 +91,14 @@
|
|||
|
||||
(define l1
|
||||
(go (not (install-only))
|
||||
(user-shared)))
|
||||
(user-version)))
|
||||
(define l2
|
||||
(if (and (not (or (user-only)
|
||||
(user-shared)
|
||||
(install-only)))
|
||||
(remove-mode))
|
||||
(append
|
||||
(go #f #f)
|
||||
(go #t #t))
|
||||
(go #t (user-version)))
|
||||
null))
|
||||
|
||||
(when show-all?
|
||||
|
|
|
|||
|
|
@ -84,17 +84,21 @@
|
|||
(define-config config:3m-suffix '3m-suffix values)
|
||||
(define-config config:absolute-installation? 'absolute-installation? (lambda (x) (and x #t)))
|
||||
(define-config config:doc-search-url 'doc-search-url values)
|
||||
(define-config config:installation-name 'installation-name values)
|
||||
|
||||
(provide get-absolute-installation?
|
||||
get-cgc-suffix
|
||||
get-3m-suffix
|
||||
get-doc-search-url)
|
||||
get-doc-search-url
|
||||
get-installation-name)
|
||||
|
||||
(define (get-absolute-installation?) (force config:absolute-installation?))
|
||||
(define (get-cgc-suffix) (force config:cgc-suffix))
|
||||
(define (get-3m-suffix) (force config:3m-suffix))
|
||||
(define (get-doc-search-url) (or (force config:doc-search-url)
|
||||
"http://docs.racket-lang.org"))
|
||||
(define (get-installation-name) (or (force config:installation-name)
|
||||
(version)))
|
||||
|
||||
;; ----------------------------------------
|
||||
;; "collects"
|
||||
|
|
@ -112,7 +116,7 @@
|
|||
(combine-search (force config:collects-search-dirs)
|
||||
(list (find-collects-dir))))
|
||||
(define user-collects-dir
|
||||
(delay (build-path (system-path* 'addon-dir) (version) "collects")))
|
||||
(delay (build-path (system-path* 'addon-dir) (get-installation-name) "collects")))
|
||||
(define (find-user-collects-dir)
|
||||
(force user-collects-dir))
|
||||
(define (get-collects-search-dirs)
|
||||
|
|
@ -180,7 +184,7 @@
|
|||
(define-finder provide config:id id get-false default)
|
||||
(provide user-id)
|
||||
(define user-dir
|
||||
(delay (build-path (system-path* 'addon-dir) (version) default)))
|
||||
(delay (build-path (system-path* 'addon-dir) (get-installation-name) default)))
|
||||
(define (user-id)
|
||||
(force user-dir)))]))
|
||||
|
||||
|
|
@ -361,12 +365,8 @@
|
|||
get-pkgs-search-dirs
|
||||
(chain-to (lambda () (build-path (find-share-dir) "pkgs"))))
|
||||
|
||||
(provide find-user-pkgs-dir
|
||||
find-shared-pkgs-dir)
|
||||
(define (find-user-pkgs-dir [vers (version)])
|
||||
(provide find-user-pkgs-dir)
|
||||
(define (find-user-pkgs-dir [vers (get-installation-name)])
|
||||
(build-path (find-system-path 'addon-dir)
|
||||
vers
|
||||
"pkgs"))
|
||||
(define (find-shared-pkgs-dir)
|
||||
(build-path (find-system-path 'addon-dir)
|
||||
"pkgs"))
|
||||
|
|
|
|||
|
|
@ -7,10 +7,11 @@
|
|||
|
||||
(define (links #:error [error error]
|
||||
#:user? [user? #t]
|
||||
#:user-version [user-version (and user?
|
||||
(get-installation-name))]
|
||||
#:file [in-file #f]
|
||||
#:name [name #f]
|
||||
#:version-regexp [version-regexp #f]
|
||||
#:shared? [shared? #f]
|
||||
#:root? [root? #f]
|
||||
#:static-root? [static-root? #f]
|
||||
#:remove? [remove? #f]
|
||||
|
|
@ -28,10 +29,8 @@
|
|||
(check-name name))
|
||||
|
||||
(define file (or in-file
|
||||
(if (or user? shared?)
|
||||
(if shared?
|
||||
(build-path (find-system-path 'addon-dir) "links.rktd")
|
||||
(build-path (find-system-path 'addon-dir) (version) "links.rktd"))
|
||||
(if user?
|
||||
(build-path (find-system-path 'addon-dir) user-version "links.rktd")
|
||||
(find-links-file))))
|
||||
|
||||
(define need-repair? #f)
|
||||
|
|
|
|||
|
|
@ -387,16 +387,15 @@
|
|||
#:info-path info-path
|
||||
#:info-path-mode 'abs-in-relative
|
||||
#:omit-root 'dir))
|
||||
(for ([shared? (in-list '(#t #f))])
|
||||
(for ([c+p (in-list (links #:shared? shared? #:with-path? #t))])
|
||||
(cc! (list (string->path (car c+p)))
|
||||
#:path (cdr c+p)))
|
||||
(for ([cp (in-list (links #:shared? shared? #:root? #t))]
|
||||
#:when (directory-exists? cp)
|
||||
[collection (directory-list cp)]
|
||||
#:unless (skip-collection-directory? collection)
|
||||
#:when (directory-exists? (build-path cp collection)))
|
||||
(cc! (list collection) #:path (build-path cp collection)))))
|
||||
(for ([c+p (in-list (links #:with-path? #t))])
|
||||
(cc! (list (string->path (car c+p)))
|
||||
#:path (cdr c+p)))
|
||||
(for ([cp (in-list (links #:root? #t))]
|
||||
#:when (directory-exists? cp)
|
||||
[collection (directory-list cp)]
|
||||
#:unless (skip-collection-directory? collection)
|
||||
#:when (directory-exists? (build-path cp collection)))
|
||||
(cc! (list collection) #:path (build-path cp collection))))
|
||||
|
||||
;; `all-collections' lists all top-level collections (not from Planet):
|
||||
(define all-collections
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "5.90.0.2"
|
||||
#define MZSCHEME_VERSION "5.90.0.3"
|
||||
|
||||
#define MZSCHEME_VERSION_X 5
|
||||
#define MZSCHEME_VERSION_Y 90
|
||||
#define MZSCHEME_VERSION_Z 0
|
||||
#define MZSCHEME_VERSION_W 2
|
||||
#define MZSCHEME_VERSION_W 3
|
||||
|
||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||
|
|
|
|||
|
|
@ -363,15 +363,6 @@
|
|||
"(find-col-file fail"
|
||||
" collection collection-path"
|
||||
" file-name)))"
|
||||
"(define-values(user-links-path)(build-path(find-system-path 'addon-dir)"
|
||||
"(version)"
|
||||
" \"links.rktd\"))"
|
||||
"(define-values(user-links-cache)(make-hasheq))"
|
||||
"(define-values(user-links-stamp) #f)"
|
||||
"(define-values(shared-links-path)(build-path(find-system-path 'addon-dir)"
|
||||
" \"links.rktd\"))"
|
||||
"(define-values(shared-links-cache)(make-hasheq))"
|
||||
"(define-values(shared-links-stamp) #f)"
|
||||
"(define-values(find-config-dir)"
|
||||
"(lambda()"
|
||||
"(let((c(find-system-path 'config-dir)))"
|
||||
|
|
@ -393,6 +384,11 @@
|
|||
"(lambda()"
|
||||
"(call-with-default-reading-parameterization read))))"
|
||||
" #hash()))))"
|
||||
"(define-values(get-installation-name)"
|
||||
"(lambda(config-table)"
|
||||
"(hash-ref config-table"
|
||||
" 'installation-name "
|
||||
"(version))))"
|
||||
"(define-values(coerce-to-path)"
|
||||
"(lambda(p)"
|
||||
"(cond"
|
||||
|
|
@ -430,7 +426,7 @@
|
|||
"((not(car l))(append orig-l(loop(cdr l))))"
|
||||
"(else(cons(coerce-to-path(car l))(loop(cdr l))))))"
|
||||
" orig-l))))"
|
||||
"(define-values(links-paths)(find-links-path!"
|
||||
"(define-values(all-links-paths)(find-links-path!"
|
||||
"(lambda()"
|
||||
"(let*((d(find-config-dir))"
|
||||
"(ht(get-config-table d))"
|
||||
|
|
@ -439,11 +435,18 @@
|
|||
"(build-path(or(hash-ref ht 'share-dir #f)"
|
||||
" (build-path 'up \"share\"))"
|
||||
" \"links.rktd\")))))"
|
||||
"(list->vector"
|
||||
"(cons(list->vector"
|
||||
"(add-config-search"
|
||||
" ht"
|
||||
" 'links-search-files"
|
||||
"(list lf)))))))"
|
||||
"(list lf)))"
|
||||
"(build-path(find-system-path 'addon-dir)"
|
||||
"(get-installation-name ht)"
|
||||
" \"links.rktd\"))))))"
|
||||
"(define-values(links-paths)(car all-links-paths))"
|
||||
"(define-values(user-links-path)(cdr all-links-paths))"
|
||||
"(define-values(user-links-cache)(make-hasheq))"
|
||||
"(define-values(user-links-stamp) #f)"
|
||||
"(define-values(links-caches)(make-vector(vector-length links-paths)(make-hasheq)))"
|
||||
"(define-values(links-stamps)(make-vector(vector-length links-paths) #f))"
|
||||
"(define-values(stamp-prompt-tag)(make-continuation-prompt-tag 'stamp))"
|
||||
|
|
@ -504,7 +507,7 @@
|
|||
"(or(not a)"
|
||||
"(not(car a)))))"
|
||||
"(define-values(get-linked-collections)"
|
||||
"(lambda(user? shared? ii)"
|
||||
"(lambda(user? ii)"
|
||||
"(call/ec(lambda(esc)"
|
||||
"(define-values(make-handler)"
|
||||
"(lambda(ts)"
|
||||
|
|
@ -517,7 +520,6 @@
|
|||
" \"error reading collection links file ~s: ~a\""
|
||||
"(cond"
|
||||
"(user? user-links-path)"
|
||||
"(shared? shared-links-path)"
|
||||
"(else(vector-ref links-paths ii)))"
|
||||
"(exn-message exn))"
|
||||
"(current-continuation-marks))))"
|
||||
|
|
@ -527,9 +529,6 @@
|
|||
"(user?"
|
||||
"(set! user-links-cache(make-hasheq))"
|
||||
"(set! user-links-stamp ts))"
|
||||
"(shared?"
|
||||
"(set! shared-links-cache(make-hasheq))"
|
||||
"(set! shared-links-stamp ts))"
|
||||
"(else"
|
||||
"(vector-set! links-caches ii(make-hasheq))"
|
||||
"(vector-set! links-stamps ii ts))))"
|
||||
|
|
@ -541,11 +540,9 @@
|
|||
"(make-handler #f)"
|
||||
"(let*((a-links-path(cond"
|
||||
"(user? user-links-path)"
|
||||
"(shared? shared-links-path)"
|
||||
"(else(vector-ref links-paths ii))))"
|
||||
"(a-links-stamp(cond"
|
||||
"(user? user-links-stamp)"
|
||||
"(shared? shared-links-stamp)"
|
||||
"(else(vector-ref links-stamps ii))))"
|
||||
"(ts(file->stamp a-links-path a-links-stamp)))"
|
||||
"(if(not(equal? ts a-links-stamp))"
|
||||
|
|
@ -614,16 +611,12 @@
|
|||
"(user?"
|
||||
"(set! user-links-cache ht)"
|
||||
"(set! user-links-stamp ts))"
|
||||
"(shared?"
|
||||
"(set! shared-links-cache ht)"
|
||||
"(set! shared-links-stamp ts))"
|
||||
"(else"
|
||||
"(vector-set! links-caches ii ht)"
|
||||
"(vector-set! links-stamps ii ts)))"
|
||||
" ht)))))"
|
||||
"(cond"
|
||||
"(user? user-links-cache)"
|
||||
"(shared? shared-links-cache)"
|
||||
"(else(vector-ref links-caches ii))))))))))"
|
||||
"(define-values(normalize-collection-reference)"
|
||||
"(lambda(collection collection-path)"
|
||||
|
|
@ -655,10 +648,7 @@
|
|||
"(append"
|
||||
"(if(and links?(use-user-specific-search-paths))"
|
||||
"(append"
|
||||
"(let((ht(get-linked-collections #t #f 0)))"
|
||||
"(append(hash-ref ht sym null)"
|
||||
"(hash-ref ht #f null)))"
|
||||
"(let((ht(get-linked-collections #f #t 0)))"
|
||||
"(let((ht(get-linked-collections #t 0)))"
|
||||
"(append(hash-ref ht sym null)"
|
||||
"(hash-ref ht #f null))))"
|
||||
" null)"
|
||||
|
|
@ -666,7 +656,7 @@
|
|||
"(let loop((ii 0))"
|
||||
"(if(ii . >= .(vector-length links-paths))"
|
||||
" null"
|
||||
"(let((ht(get-linked-collections #f #f ii)))"
|
||||
"(let((ht(get-linked-collections #f ii)))"
|
||||
"(append(hash-ref ht sym null)"
|
||||
"(hash-ref ht #f null)"
|
||||
"(loop(add1 ii))))))"
|
||||
|
|
@ -808,7 +798,8 @@
|
|||
"((extra-collects-dirs)(find-library-collection-paths extra-collects-dirs null))"
|
||||
"((extra-collects-dirs post-collects-dirs)"
|
||||
"(let((user-too?(use-user-specific-search-paths))"
|
||||
"(cons-if(lambda(f r)(if f(cons f r) r))))"
|
||||
"(cons-if(lambda(f r)(if f(cons f r) r)))"
|
||||
"(config-table(get-config-table(find-config-dir))))"
|
||||
"(path-list-string->path-list"
|
||||
"(if user-too?"
|
||||
"(let((c(environment-variables-ref(current-environment-variables)"
|
||||
|
|
@ -818,12 +809,12 @@
|
|||
" \"\"))"
|
||||
" \"\")"
|
||||
"(add-config-search"
|
||||
"(get-config-table(find-config-dir))"
|
||||
" config-table"
|
||||
" 'collects-search-dirs"
|
||||
"(cons-if"
|
||||
"(and user-too?"
|
||||
"(build-path(find-system-path 'addon-dir)"
|
||||
"(version)"
|
||||
"(get-installation-name config-table)"
|
||||
" \"collects\"))"
|
||||
"(let loop((l(append"
|
||||
" extra-collects-dirs"
|
||||
|
|
|
|||
|
|
@ -430,17 +430,6 @@
|
|||
collection collection-path
|
||||
file-name)))
|
||||
|
||||
(define-values (user-links-path) (build-path (find-system-path 'addon-dir)
|
||||
(version)
|
||||
"links.rktd"))
|
||||
(define-values (user-links-cache) (make-hasheq))
|
||||
(define-values (user-links-stamp) #f)
|
||||
|
||||
(define-values (shared-links-path) (build-path (find-system-path 'addon-dir)
|
||||
"links.rktd"))
|
||||
(define-values (shared-links-cache) (make-hasheq))
|
||||
(define-values (shared-links-stamp) #f)
|
||||
|
||||
(define-values (find-config-dir)
|
||||
(lambda ()
|
||||
(let ([c (find-system-path 'config-dir)])
|
||||
|
|
@ -464,6 +453,12 @@
|
|||
(call-with-default-reading-parameterization read))))
|
||||
#hash()))))
|
||||
|
||||
(define-values (get-installation-name)
|
||||
(lambda (config-table)
|
||||
(hash-ref config-table
|
||||
'installation-name
|
||||
(version))))
|
||||
|
||||
(define-values (coerce-to-path)
|
||||
(lambda (p)
|
||||
(cond
|
||||
|
|
@ -495,7 +490,7 @@
|
|||
(find-system-path 'orig-dir)))]
|
||||
[else
|
||||
(find-executable-path (find-system-path 'exec-file) collects-path #t)])))
|
||||
|
||||
|
||||
(define-values (add-config-search)
|
||||
(lambda (ht key orig-l)
|
||||
(let ([l (hash-ref ht key #f)])
|
||||
|
|
@ -507,25 +502,34 @@
|
|||
[else (cons (coerce-to-path (car l)) (loop (cdr l)))]))
|
||||
orig-l))))
|
||||
|
||||
(define-values (links-paths) (find-links-path!
|
||||
;; This thunk is called once per place, and the result
|
||||
;; is remembered for later invocations. Otherwise, the
|
||||
;; search for the config file can trip over filesystem
|
||||
;; restrictions imposed by security guards.
|
||||
(lambda ()
|
||||
(let* ([d (find-config-dir)]
|
||||
[ht (get-config-table d)]
|
||||
[lf (coerce-to-path
|
||||
(or (hash-ref ht 'links-file #f)
|
||||
(build-path (or (hash-ref ht 'share-dir #f)
|
||||
(build-path 'up "share"))
|
||||
"links.rktd")))])
|
||||
(list->vector
|
||||
(add-config-search
|
||||
ht
|
||||
'links-search-files
|
||||
(list lf)))))))
|
||||
|
||||
(define-values (all-links-paths) (find-links-path!
|
||||
;; This thunk is called once per place, and the result
|
||||
;; is remembered for later invocations. Otherwise, the
|
||||
;; search for the config file can trip over filesystem
|
||||
;; restrictions imposed by security guards.
|
||||
(lambda ()
|
||||
(let* ([d (find-config-dir)]
|
||||
[ht (get-config-table d)]
|
||||
[lf (coerce-to-path
|
||||
(or (hash-ref ht 'links-file #f)
|
||||
(build-path (or (hash-ref ht 'share-dir #f)
|
||||
(build-path 'up "share"))
|
||||
"links.rktd")))])
|
||||
(cons (list->vector
|
||||
(add-config-search
|
||||
ht
|
||||
'links-search-files
|
||||
(list lf)))
|
||||
(build-path (find-system-path 'addon-dir)
|
||||
(get-installation-name ht)
|
||||
"links.rktd"))))))
|
||||
|
||||
(define-values (links-paths) (car all-links-paths))
|
||||
(define-values (user-links-path) (cdr all-links-paths))
|
||||
|
||||
(define-values (user-links-cache) (make-hasheq))
|
||||
(define-values (user-links-stamp) #f)
|
||||
|
||||
(define-values (links-caches) (make-vector (vector-length links-paths) (make-hasheq)))
|
||||
(define-values (links-stamps) (make-vector (vector-length links-paths) #f))
|
||||
|
||||
|
|
@ -595,7 +599,7 @@
|
|||
(not (car a)))))
|
||||
|
||||
(define-values (get-linked-collections)
|
||||
(lambda (user? shared? ii)
|
||||
(lambda (user? ii)
|
||||
(call/ec (lambda (esc)
|
||||
(define-values (make-handler)
|
||||
(lambda (ts)
|
||||
|
|
@ -608,7 +612,6 @@
|
|||
"error reading collection links file ~s: ~a"
|
||||
(cond
|
||||
[user? user-links-path]
|
||||
[shared? shared-links-path]
|
||||
[else (vector-ref links-paths ii)])
|
||||
(exn-message exn))
|
||||
(current-continuation-marks))))
|
||||
|
|
@ -618,9 +621,6 @@
|
|||
[user?
|
||||
(set! user-links-cache (make-hasheq))
|
||||
(set! user-links-stamp ts)]
|
||||
[shared?
|
||||
(set! shared-links-cache (make-hasheq))
|
||||
(set! shared-links-stamp ts)]
|
||||
[else
|
||||
(vector-set! links-caches ii (make-hasheq))
|
||||
(vector-set! links-stamps ii ts)]))
|
||||
|
|
@ -633,11 +633,9 @@
|
|||
(make-handler #f)
|
||||
(let* ([a-links-path (cond
|
||||
[user? user-links-path]
|
||||
[shared? shared-links-path]
|
||||
[else (vector-ref links-paths ii)])]
|
||||
[a-links-stamp (cond
|
||||
[user? user-links-stamp]
|
||||
[shared? shared-links-stamp]
|
||||
[else (vector-ref links-stamps ii)])]
|
||||
[ts (file->stamp a-links-path a-links-stamp)])
|
||||
(if (not (equal? ts a-links-stamp))
|
||||
|
|
@ -714,16 +712,12 @@
|
|||
[user?
|
||||
(set! user-links-cache ht)
|
||||
(set! user-links-stamp ts)]
|
||||
[shared?
|
||||
(set! shared-links-cache ht)
|
||||
(set! shared-links-stamp ts)]
|
||||
[else
|
||||
(vector-set! links-caches ii ht)
|
||||
(vector-set! links-stamps ii ts)])
|
||||
ht)))))
|
||||
(cond
|
||||
[user? user-links-cache]
|
||||
[shared? shared-links-cache]
|
||||
[else (vector-ref links-caches ii)]))))))))
|
||||
|
||||
(define-values (normalize-collection-reference)
|
||||
|
|
@ -759,10 +753,7 @@
|
|||
;; list of paths and (box path)s:
|
||||
(if (and links? (use-user-specific-search-paths))
|
||||
(append
|
||||
(let ([ht (get-linked-collections #t #f 0)])
|
||||
(append (hash-ref ht sym null)
|
||||
(hash-ref ht #f null)))
|
||||
(let ([ht (get-linked-collections #f #t 0)])
|
||||
(let ([ht (get-linked-collections #t 0)])
|
||||
(append (hash-ref ht sym null)
|
||||
(hash-ref ht #f null))))
|
||||
null)
|
||||
|
|
@ -771,7 +762,7 @@
|
|||
(let loop ([ii 0])
|
||||
(if (ii . >= . (vector-length links-paths))
|
||||
null
|
||||
(let ([ht (get-linked-collections #f #f ii)])
|
||||
(let ([ht (get-linked-collections #f ii)])
|
||||
(append (hash-ref ht sym null)
|
||||
(hash-ref ht #f null)
|
||||
(loop (add1 ii))))))
|
||||
|
|
@ -927,7 +918,8 @@
|
|||
[(extra-collects-dirs) (find-library-collection-paths extra-collects-dirs null)]
|
||||
[(extra-collects-dirs post-collects-dirs)
|
||||
(let ([user-too? (use-user-specific-search-paths)]
|
||||
[cons-if (lambda (f r) (if f (cons f r) r))])
|
||||
[cons-if (lambda (f r) (if f (cons f r) r))]
|
||||
[config-table (get-config-table (find-config-dir))])
|
||||
(path-list-string->path-list
|
||||
(if user-too?
|
||||
(let ([c (environment-variables-ref (current-environment-variables)
|
||||
|
|
@ -937,12 +929,12 @@
|
|||
""))
|
||||
"")
|
||||
(add-config-search
|
||||
(get-config-table (find-config-dir))
|
||||
config-table
|
||||
'collects-search-dirs
|
||||
(cons-if
|
||||
(and user-too?
|
||||
(build-path (find-system-path 'addon-dir)
|
||||
(version)
|
||||
(get-installation-name config-table)
|
||||
"collects"))
|
||||
(let loop ([l (append
|
||||
extra-collects-dirs
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user