link development-mode packages in a separate pkg database
Use `PKGS' with the top-level makefile to select packages for a development-mode build. The default is "main-distribution", which includes all packages in "pkgs".
This commit is contained in:
Matthew Flatt
parent
4d6bf3192d
commit
d450ee9707
41
INSTALL.txt
41
INSTALL.txt
|
|
@ -1,5 +1,5 @@
|
|||
Quick Instrctions
|
||||
=================
|
||||
Quick Instructions
|
||||
==================
|
||||
|
||||
On Unix of Mac OS X, `make' (or `make in-place') creates a build in
|
||||
the "racket" directory.
|
||||
|
|
@ -27,6 +27,16 @@ On Windows, you must first clone "git://github.com/plt/libs.git"
|
|||
as "build/native-pkgs". Then, you can use `nmake win32-in-place',
|
||||
as long as you're using Microsoft Visual Studio 9.0 (2008).
|
||||
|
||||
To install a subset of the packages in "pkgs", supply `PKGS' value to
|
||||
`make'. For example,
|
||||
|
||||
make PKGS="gui-lib readline-lib"
|
||||
|
||||
links only the "gui-lib" and "readline-lib" packages and their
|
||||
dependencies. The default value of `PKGS' is "main-distribution",
|
||||
which has all packages in "pkgs" among its dependencies. See "Linking
|
||||
Packages for Development Mode", below, for more information.
|
||||
|
||||
|
||||
Building Racket Pieces
|
||||
======================
|
||||
|
|
@ -57,7 +67,6 @@ In the near future, after you've built the core, you can install
|
|||
packages via a package-catalog server (ignoring the content of
|
||||
"pkgs"). That catalog server is not ready, yet.
|
||||
|
||||
|
||||
Linking Packages for Development Mode
|
||||
-------------------------------------
|
||||
|
||||
|
|
@ -70,19 +79,26 @@ reinstalling packages).
|
|||
|
||||
The `pkg-links' target of the makefile links (or re-links) packages
|
||||
from "pkgs" into the "racket" build. (The `in-place' target of the
|
||||
makefile uses `pkg-links'.) Make the `pkg-links' target whenever the
|
||||
set of native packages or packages in "pkgs" changes.
|
||||
makefile uses `pkg-links'.) By default, `pkg-links' starts with the
|
||||
"main-distribution" package and links all of its dependencies, which
|
||||
includes all of the packages in "pkgs". Specify a subset of the
|
||||
packages with `PKG="...."' as an argument to `make pkg-links'. Make
|
||||
the `pkg-links' target whenever the set of dependencies can change
|
||||
(or, for the default mode, when any native package or package in
|
||||
"pkgs" changes).
|
||||
|
||||
Packages are linked using installation scope, so that the links affect
|
||||
only the build in the "racket" directory. Packages are linked with the
|
||||
`--no-setup' flag (effectively), which means that a `raco setup' is
|
||||
needed after installing links.
|
||||
Packages are linked in a database (at "racket/lib/devel-pkgs") that is
|
||||
added to the installation's search paths. As a result, the links
|
||||
affect only the build in the "racket" directory, and they are not
|
||||
mixed with any links that you specifically install in installation
|
||||
scope. Packages are linked with the `--no-setup' flag (effectively),
|
||||
which means that a `raco setup' is needed after installing links.
|
||||
|
||||
Native-library packages provide (on Mac OS X and Windows) pre-built
|
||||
native libraries, such as Cario. Currently, the libraries must be
|
||||
downloaded from GitHub. On a non-Windows platform, the
|
||||
`native-from-git' makefile target clones/updates the native-library
|
||||
reposiroty from GitHub; otherwise, clone
|
||||
repository from GitHub; otherwise, clone
|
||||
|
||||
git://github.com/plt/libs.git
|
||||
|
||||
|
|
@ -96,8 +112,9 @@ makefile target also links relavant native packages.
|
|||
Trying Packages Locally
|
||||
-----------------------
|
||||
|
||||
Suppose that you've built core "racket" and you want to see what
|
||||
it looks like to install individual packages.
|
||||
Suppose that you've built core "racket" and you want to see what it
|
||||
looks like to install individual packages as if provided by a server
|
||||
(i.e., not through development-mode links).
|
||||
|
||||
Use `make local-catalog' to create a package catalog that provides
|
||||
mappings for all of the packages in "pkgs" as well as packages
|
||||
|
|
|
|||
13
Makefile
13
Makefile
|
|
@ -64,7 +64,7 @@ racket/src/build/Makefile: racket/src/configure racket/src/Makefile.in
|
|||
# Configuration options for building installers
|
||||
|
||||
# Packages to include in a distribution:
|
||||
PKGS = drracket
|
||||
PKGS = main-distribution
|
||||
|
||||
# Catalog for sources and native packages; use "local" to bootstrap
|
||||
# from package directories (in the same directory as this makefile)
|
||||
|
|
@ -117,17 +117,16 @@ REMOTE_USER_AUTO = --catalog http://$(SERVER):9440/ $(USER_AUTO_OPTIONS)
|
|||
REMOTE_INST_AUTO = --catalog http://$(SERVER):9440/ --scope installation --deps search-auto
|
||||
|
||||
# ------------------------------------------------------------
|
||||
# Linking all packages (i.e., not an installer build)
|
||||
# Linking all packages (development mode; not an installer build)
|
||||
|
||||
pkg-links:
|
||||
$(PLAIN_RACKET) racket/src/link-all.rkt --platform build/native-pkgs
|
||||
$(PLAIN_RACKET) racket/src/link-all.rkt pkgs
|
||||
$(PLAIN_RACKET) -U -G build/config racket/src/link-all.rkt ++dir pkgs ++dir build/native-pkgs $(PKGS)
|
||||
|
||||
win32-pkg-links:
|
||||
$(MAKE) pkg-links PLAIN_RACKET="$(WIN32_PLAIN_RACKET)"
|
||||
|
||||
# ------------------------------------------------------------
|
||||
# On a server platform:
|
||||
# On a server platform (for an installer build):
|
||||
|
||||
server:
|
||||
$(MAKE) core
|
||||
|
|
@ -212,7 +211,7 @@ binary-catalog-server:
|
|||
$(RACKET) -l- distro-build/serve-catalog --mode binary
|
||||
|
||||
# ------------------------------------------------------------
|
||||
# On each supported platform:
|
||||
# On each supported platform (for an installer build):
|
||||
#
|
||||
# The `client' and `win32-client' targets are also used by
|
||||
# `distro-buid/drive-clients', which is in turn run by the
|
||||
|
|
@ -281,7 +280,7 @@ win32-installer-from-bundle:
|
|||
$(WIN32_RACKET) -l- distro-build/installer $(UPLOAD) $(RELEASE_MODE) "$(DIST_NAME)" $(DIST_DIR)
|
||||
|
||||
# ------------------------------------------------------------
|
||||
# On each supported platform:
|
||||
# Drive installer build:
|
||||
|
||||
DRIVE_ARGS = $(RELEASE_MODE) "$(FARM_CONFIG)" $(SERVER) "$(PKGS)" "$(DIST_NAME)" $(DIST_DIR)
|
||||
DRIVE_CMD = $(RACKET) -l- distro-build/drive-clients $(DRIVE_ARGS)
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@
|
|||
"string-constants-lib"
|
||||
"unstable-list-lib" ; for class-iop
|
||||
"unstable-options-lib"
|
||||
"compatibility-lib"
|
||||
("gui-i386-macosx" #:platform "i386-macosx")
|
||||
("gui-x86_64-macosx" #:platform "x86_64-macosx")
|
||||
("gui-win32-i386" #:platform "win32\\i386")
|
||||
|
|
|
|||
80
pkgs/main-distribution/info.rkt
Normal file
80
pkgs/main-distribution/info.rkt
Normal file
|
|
@ -0,0 +1,80 @@
|
|||
#lang setup/infotab
|
||||
|
||||
;; List enough to reach all packages in "pkgs".
|
||||
;; Lots of room for improvement...
|
||||
(define deps '("algol60"
|
||||
"at-exp-lib"
|
||||
"compatibility-lib"
|
||||
"contract-profile"
|
||||
"data-lib"
|
||||
"datalog"
|
||||
"deinprogramm"
|
||||
"distro-build"
|
||||
"draw"
|
||||
"draw-doc"
|
||||
"draw-lib"
|
||||
"drracket"
|
||||
"eopl"
|
||||
"errortrace"
|
||||
"frtime"
|
||||
"future-visualizer"
|
||||
"future-visualizer-typed"
|
||||
"games"
|
||||
"gui"
|
||||
"honu"
|
||||
"htdp"
|
||||
"html"
|
||||
"icons"
|
||||
"images"
|
||||
"lazy"
|
||||
"macro-debugger"
|
||||
"macro-debugger-text-lib"
|
||||
"make"
|
||||
"math"
|
||||
"mysterx"
|
||||
"mzcom"
|
||||
"mzscheme"
|
||||
"parser-tools"
|
||||
"pconvert-lib"
|
||||
"pict"
|
||||
"picturing-programs"
|
||||
"plai"
|
||||
"plot"
|
||||
"plt-services"
|
||||
"preprocessor"
|
||||
"profile"
|
||||
"r5rs"
|
||||
"r6rs"
|
||||
"racket-doc"
|
||||
"racket-index"
|
||||
"racket-lib"
|
||||
"racket-test"
|
||||
"racklog"
|
||||
"rackunit-lib"
|
||||
"readline"
|
||||
"realm"
|
||||
"redex"
|
||||
"sandbox-lib"
|
||||
"schemeunit"
|
||||
"scribble"
|
||||
"sgl"
|
||||
"slatex"
|
||||
"slideshow"
|
||||
"snip"
|
||||
"srfi"
|
||||
"string-constants-lib"
|
||||
"swindle"
|
||||
"syntax-color"
|
||||
"trace"
|
||||
"typed-racket"
|
||||
"typed-racket-more"
|
||||
"typed-racket-tests"
|
||||
"unstable"
|
||||
"unstable-contract-lib"
|
||||
"unstable-latent-contract-lib"
|
||||
"unstable-list-lib"
|
||||
"unstable-options-lib"
|
||||
"unstable-parameter-group-lib"
|
||||
"web-server"
|
||||
"wxme"
|
||||
"xrepl"))
|
||||
|
|
@ -32,7 +32,8 @@ 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 'shared
|
||||
(and/c path? complete-path?))]
|
||||
@defparam[current-pkg-scope-version s string?]
|
||||
)]{
|
||||
|
||||
|
|
@ -88,12 +89,14 @@ Returns the directory that holds the installation of the installed
|
|||
Returns the installed package containing @racket[path], if any.}
|
||||
|
||||
|
||||
@defproc[(default-pkg-scope) (or/c 'installation 'user 'shared)]{
|
||||
@defproc[(default-pkg-scope) (or/c 'installation 'user 'shared
|
||||
(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 'shared
|
||||
(and/c path? complete-path?))])
|
||||
(listof string?)]{
|
||||
|
||||
Returns a list of installed package names for the given @tech{package
|
||||
|
|
@ -101,7 +104,8 @@ 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 'shared
|
||||
(and/c path? complete-path?))])
|
||||
(hash/c string? pkg-info?)]{
|
||||
|
||||
Returns a hash table of installed packages for the given @tech{package
|
||||
|
|
|
|||
|
|
@ -259,8 +259,12 @@ 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. Finally, the @exec{shared} scope means
|
||||
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
|
||||
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).
|
||||
|
||||
@; ----------------------------------------
|
||||
|
||||
|
|
@ -329,6 +333,7 @@ sub-sub-commands:
|
|||
@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
|
||||
@tech{package catalogs}.}
|
||||
|
|
@ -355,6 +360,7 @@ this command fails without installing any of the @nonterm{pkg}s
|
|||
@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}.}
|
||||
]
|
||||
}
|
||||
|
||||
|
|
@ -375,6 +381,7 @@ removing any of the @nonterm{pkg}s.
|
|||
@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}.}
|
||||
]
|
||||
}
|
||||
|
||||
|
|
@ -399,6 +406,7 @@ removing any of the @nonterm{pkg}s.
|
|||
@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}.}
|
||||
]
|
||||
}
|
||||
|
|
|
|||
|
|
@ -53,11 +53,11 @@ directory:
|
|||
@item{@racket['links-search-files] --- like @racket['lib-search-dirs],
|
||||
but for @tech[#:doc reference-doc]{collection links file}.}
|
||||
|
||||
@item{@racket['pkg-dir] --- a path, string, or byte string for
|
||||
packages that have installation scope; it defaults to the main
|
||||
library directory.}
|
||||
@item{@racket['pkgs-dir] --- a path, string, or byte string for
|
||||
packages that have installation scope; it defaults to
|
||||
@filepath{pkgs} in the main library directory.}
|
||||
|
||||
@item{@racket['pkg-search-dirs] --- like @racket['lib-search-dirs],
|
||||
@item{@racket['pkgs-search-dirs] --- like @racket['lib-search-dirs],
|
||||
but for packages in installation scope.}
|
||||
|
||||
@item{@racket['bin-dir] --- a path, string, or byte string for the
|
||||
|
|
|
|||
|
|
@ -947,25 +947,25 @@ v
|
|||
links are installed by @exec{raco link} or @racket[links].) The
|
||||
files indicated by the returned paths may or may not exist.}
|
||||
|
||||
@defproc[(find-pkg-dir) path?]{
|
||||
@defproc[(find-pkgs-dir) path?]{
|
||||
Returns a path to the directory containing packages with
|
||||
installation scope; the directory indicated by the returned path may
|
||||
or may not exist.}
|
||||
|
||||
@defproc[(find-user-pkg-dir) path?]{
|
||||
@defproc[(find-user-pkgs-dir) path?]{
|
||||
Returns a path to the directory containing packages with
|
||||
user- and version-specific scope; the directory indicated by
|
||||
the returned path may or may not exist.}
|
||||
|
||||
@defproc[(find-shared-pkg-dir) path?]{
|
||||
@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-pkg-search-dirs) (listof path?)]{
|
||||
@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
|
||||
@racket[(find-pkg-dir)], which is where new packages are installed
|
||||
@racket[(find-pkgs-dir)], which is where new packages are installed
|
||||
by @exec{raco pkg install}.) The directories indicated by the returned
|
||||
paths may or may not exist.}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,5 @@
|
|||
#lang setup/infotab
|
||||
|
||||
(define collection 'multi)
|
||||
|
||||
(define deps '("data-lib"))
|
||||
|
|
|
|||
|
|
@ -1,2 +1,5 @@
|
|||
#lang setup/infotab
|
||||
|
||||
(define collection 'multi)
|
||||
|
||||
(define deps '("errortrace-lib"))
|
||||
|
|
|
|||
|
|
@ -4,4 +4,6 @@
|
|||
|
||||
(define deps '("at-exp-lib"
|
||||
"draw-lib"
|
||||
"syntax-color-lib"))
|
||||
"syntax-color-lib"
|
||||
"sandbox-lib"
|
||||
"rackunit-lib"))
|
||||
|
|
|
|||
|
|
@ -111,13 +111,16 @@
|
|||
(λ (ip) (copy-port ip op)))))))
|
||||
|
||||
(define (pkg-dir config?)
|
||||
(case (current-pkg-scope)
|
||||
[(installation) (if config?
|
||||
(find-config-dir)
|
||||
(find-pkg-dir))]
|
||||
[(user) (find-user-pkg-dir (current-pkg-scope-version))]
|
||||
[(shared) (find-shared-pkg-dir)]
|
||||
[else (error "unknown package scope")]))
|
||||
(define scope (current-pkg-scope))
|
||||
(if (path? scope)
|
||||
scope
|
||||
(case scope
|
||||
[(installation) (if config?
|
||||
(find-config-dir)
|
||||
(find-pkgs-dir))]
|
||||
[(user) (find-user-pkgs-dir (current-pkg-scope-version))]
|
||||
[(shared) (find-shared-pkgs-dir)]
|
||||
[else (error "unknown package scope")])))
|
||||
(define (pkg-config-file)
|
||||
(build-path (pkg-dir #t) "config.rktd"))
|
||||
(define (pkg-db-file)
|
||||
|
|
@ -426,21 +429,23 @@
|
|||
(define (merge-next-pkg-dbs scope)
|
||||
(parameterize ([current-pkg-scope scope])
|
||||
(with-pkg-lock/read-only (merge-pkg-dbs scope))))
|
||||
(case scope
|
||||
[(installation)
|
||||
(for*/hash ([dir (in-list (get-pkg-search-dirs))]
|
||||
[file (in-value (build-path dir "pkgs.rktd"))]
|
||||
#:when (file-exists? file)
|
||||
[(k v) (read-pkg-db-file file)])
|
||||
(values k v))]
|
||||
[(shared)
|
||||
(define db (read-pkg-db))
|
||||
(for/fold ([ht (merge-next-pkg-dbs 'installation)]) ([(v k) (in-hash db)])
|
||||
(hash-set ht k v))]
|
||||
[(user)
|
||||
(define db (read-pkg-db))
|
||||
(for/fold ([ht (merge-next-pkg-dbs 'shared)]) ([(v k) (in-hash db)])
|
||||
(hash-set ht k v))]))
|
||||
(if (path? scope)
|
||||
(read-pkg-db)
|
||||
(case scope
|
||||
[(installation)
|
||||
(for*/hash ([dir (in-list (get-pkgs-search-dirs))]
|
||||
[file (in-value (build-path dir "pkgs.rktd"))]
|
||||
#:when (file-exists? file)
|
||||
[(k v) (read-pkg-db-file file)])
|
||||
(values k v))]
|
||||
[(shared)
|
||||
(define db (read-pkg-db))
|
||||
(for/fold ([ht (merge-next-pkg-dbs 'installation)]) ([(v k) (in-hash db)])
|
||||
(hash-set ht k v))]
|
||||
[(user)
|
||||
(define db (read-pkg-db))
|
||||
(for/fold ([ht (merge-next-pkg-dbs 'shared)]) ([(v k) (in-hash db)])
|
||||
(hash-set ht k v))])))
|
||||
|
||||
|
||||
(define (package-info pkg-name [fail? #t])
|
||||
|
|
@ -457,7 +462,10 @@
|
|||
;; return the current scope as a string
|
||||
;; -> (or/c "user" "shared" "installation")
|
||||
(define (current-scope->string)
|
||||
(symbol->string (current-pkg-scope)))
|
||||
(define scope (current-pkg-scope))
|
||||
(cond
|
||||
[(path? scope) (path->string scope)]
|
||||
[else (symbol->string scope)]))
|
||||
|
||||
;; prints an error for packages that are not installed
|
||||
;; pkg-name db -> void
|
||||
|
|
@ -538,8 +546,26 @@
|
|||
(struct-copy install-info if
|
||||
[checksum op]))
|
||||
|
||||
(define (scope->links-file scope)
|
||||
(and (path? scope)
|
||||
(build-path scope "links.rktd")))
|
||||
|
||||
(define (get-scope-list)
|
||||
;; Get a list of scopes suitable for searches with respect to
|
||||
;; the current scope
|
||||
(define current-scope (current-pkg-scope))
|
||||
(if (path? current-scope)
|
||||
(list current-scope)
|
||||
(member current-scope
|
||||
(append '(user shared)
|
||||
(let ([main (find-pkgs-dir)])
|
||||
(for/list ([d (get-pkgs-search-dirs)])
|
||||
(if (equal? d main)
|
||||
'installation
|
||||
d)))))))
|
||||
|
||||
(define (pkg-directory pkg-name)
|
||||
(for/or ([scope (in-list '(user shared installation))])
|
||||
(for/or ([scope (in-list (get-scope-list))])
|
||||
(parameterize ([current-pkg-scope scope])
|
||||
(with-pkg-lock/read-only
|
||||
(pkg-directory* pkg-name)))))
|
||||
|
|
@ -568,7 +594,7 @@
|
|||
(define p (explode given-p))
|
||||
(define (build-path* l)
|
||||
(if (null? l) 'same (apply build-path l)))
|
||||
(for/fold ([pkg #f] [subpath #f]) ([scope (in-list '(user shared installation))]
|
||||
(for/fold ([pkg #f] [subpath #f]) ([scope (in-list (get-scope-list))]
|
||||
#:when (not pkg))
|
||||
(parameterize ([current-pkg-scope scope])
|
||||
(with-pkg-lock/read-only
|
||||
|
|
@ -604,18 +630,25 @@
|
|||
(match-define (pkg-info orig-pkg checksum _) pi)
|
||||
(define pkg-dir (pkg-directory* pkg-name))
|
||||
(remove-from-pkg-db! pkg-name)
|
||||
(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
|
||||
[`(link ,_)
|
||||
(links pkg-dir
|
||||
#:remove? #t
|
||||
#:user? (not (eq? (current-pkg-scope) 'installation))
|
||||
#:shared? (eq? (current-pkg-scope) 'shared)
|
||||
#:user? user?
|
||||
#:shared? shared?
|
||||
#:file (scope->links-file scope)
|
||||
#:root? (not (sc-pkg-info? pi)))]
|
||||
[_
|
||||
(links pkg-dir
|
||||
#:remove? #t
|
||||
#:user? (not (eq? (current-pkg-scope) 'installation))
|
||||
#:shared? (eq? (current-pkg-scope) 'shared)
|
||||
#:user? user?
|
||||
#:shared? shared?
|
||||
#:file (scope->links-file scope)
|
||||
#:root? (not (sc-pkg-info? pi)))
|
||||
(delete-directory/files pkg-dir)]))
|
||||
|
||||
|
|
@ -1249,10 +1282,13 @@
|
|||
(log-pkg-debug "creating ~alink to ~e"
|
||||
(if single-collect "single-collection " "")
|
||||
final-pkg-dir)
|
||||
(define scope (current-pkg-scope))
|
||||
(links final-pkg-dir
|
||||
#:name single-collect
|
||||
#:user? (not (eq? 'installation (current-pkg-scope)))
|
||||
#:shared? (eq? 'shared (current-pkg-scope))
|
||||
#:user? (not (or (eq? 'installation scope)
|
||||
(path? scope)))
|
||||
#:shared? (eq? 'shared scope)
|
||||
#:file (scope->links-file scope)
|
||||
#:root? (not single-collect))
|
||||
(define this-pkg-info
|
||||
(if single-collect
|
||||
|
|
@ -1450,40 +1486,25 @@
|
|||
(define (pkg-show indent #:directory? [dir? #f])
|
||||
(let ()
|
||||
(define db (read-pkg-db))
|
||||
(define all-db (if (eq? (current-pkg-scope) 'installation)
|
||||
(merge-pkg-dbs)
|
||||
db))
|
||||
(define has-const? (not (equal? all-db db)))
|
||||
(define pkgs (sort (hash-keys all-db) string-ci<=?))
|
||||
(define pkgs (sort (hash-keys db) string-ci<=?))
|
||||
(if (null? pkgs)
|
||||
(printf " [none]\n")
|
||||
(table-display
|
||||
(list*
|
||||
(append
|
||||
(list (format "~aPackage[*=auto~a]"
|
||||
indent
|
||||
(if has-const?
|
||||
"; .=constant"
|
||||
""))
|
||||
(list (format "~aPackage[*=auto]" indent)
|
||||
"Checksum"
|
||||
"Source")
|
||||
(if dir?
|
||||
(list "Directory")
|
||||
empty))
|
||||
(for/list ([pkg (in-list pkgs)])
|
||||
(match-define (pkg-info orig-pkg checksum auto?) (hash-ref all-db pkg))
|
||||
(match-define (pkg-info orig-pkg checksum auto?) (hash-ref db pkg))
|
||||
(append
|
||||
(list (format "~a~a~a~a"
|
||||
(list (format "~a~a~a"
|
||||
indent
|
||||
pkg
|
||||
(if auto?
|
||||
"*"
|
||||
"")
|
||||
(if (and has-const?
|
||||
(not (equal? (hash-ref all-db pkg)
|
||||
(hash-ref db pkg #f))))
|
||||
"."
|
||||
""))
|
||||
(if auto? "*" ""))
|
||||
(format "~a" checksum)
|
||||
(format "~a" orig-pkg))
|
||||
(if dir?
|
||||
|
|
@ -2110,7 +2131,8 @@
|
|||
(or/c #f 'fail 'force 'search-ask 'search-auto))
|
||||
|
||||
(define package-scope/c
|
||||
(or/c 'installation 'user 'shared))
|
||||
(or/c 'installation 'user 'shared
|
||||
(and/c path? complete-path?)))
|
||||
|
||||
(provide
|
||||
with-pkg-lock
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
racket/function
|
||||
racket/list
|
||||
raco/command-name
|
||||
setup/dirs
|
||||
net/url
|
||||
"name.rkt"
|
||||
"lib.rkt"
|
||||
|
|
@ -28,7 +29,7 @@
|
|||
(string->symbol (format "~a ~a" (short-program+command-name) cmd))
|
||||
args))
|
||||
|
||||
(define (call-with-package-scope who given-scope installation shared user thunk)
|
||||
(define (call-with-package-scope who given-scope scope-dir installation shared user thunk)
|
||||
(define scope
|
||||
(case given-scope
|
||||
[(installation user shared) given-scope]
|
||||
|
|
@ -37,6 +38,7 @@
|
|||
[installation 'installation]
|
||||
[user 'user]
|
||||
[shared 'shared]
|
||||
[scope-dir (path->complete-path scope-dir)]
|
||||
[else (default-pkg-scope)])]))
|
||||
(parameterize ([current-pkg-scope scope]
|
||||
[current-pkg-error (pkg-error who)])
|
||||
|
|
@ -80,15 +82,16 @@
|
|||
" 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")]
|
||||
[#:bool installation ("-i") "shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "shorthand for `--scope user'"]
|
||||
[#:bool shared ("-s") "shorthand for `--scope shared'"]
|
||||
[#: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"]
|
||||
#:args pkg-source
|
||||
(call-with-package-scope
|
||||
'install
|
||||
scope installation shared user
|
||||
scope scope-dir installation shared user
|
||||
(lambda ()
|
||||
(unless (or (not name) (package-source->name name))
|
||||
((current-pkg-error) (format "~e is an invalid package name" name)))
|
||||
|
|
@ -126,13 +129,14 @@
|
|||
" 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")]
|
||||
[#:bool installation ("-i") "shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "shorthand for `--scope user'"]
|
||||
[#:bool shared ("-s") "shorthand for `--scope shared'"]
|
||||
[#: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>"]
|
||||
#:args pkg
|
||||
(call-with-package-scope
|
||||
'update
|
||||
scope installation shared user
|
||||
scope scope-dir installation shared user
|
||||
(lambda ()
|
||||
(define setup-collects
|
||||
(with-pkg-lock
|
||||
|
|
@ -154,13 +158,14 @@
|
|||
" 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")]
|
||||
[#:bool installation ("-i") "shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "shorthand for `--scope user'"]
|
||||
[#:bool shared ("-s") "shorthand for `--scope shared'"]
|
||||
[#: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>"]
|
||||
#:args pkg
|
||||
(call-with-package-scope
|
||||
'remove
|
||||
scope installation shared user
|
||||
scope scope-dir installation shared user
|
||||
(lambda ()
|
||||
(define setup-collects
|
||||
(with-pkg-lock
|
||||
|
|
@ -179,26 +184,37 @@
|
|||
" 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>"]
|
||||
[#:bool installation ("-i") "shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "shorthand for `--scope user'"]
|
||||
[#:bool shared ("-s") "shorthand for `--scope shared'"]
|
||||
[#: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]
|
||||
[else
|
||||
(cond
|
||||
[scope-dir (path->complete-path scope-dir)]
|
||||
[installation 'installation]
|
||||
[shared 'shared]
|
||||
[user 'user]
|
||||
[else (if version 'user #f)])]))
|
||||
(for ([mode '(installation shared user)])
|
||||
(when (or (eq? mode only-mode) (not only-mode))
|
||||
(for ([mode (if only-mode
|
||||
(list only-mode)
|
||||
(append (let ([main (find-pkgs-dir)])
|
||||
(reverse
|
||||
(for/list ([d (get-pkgs-search-dirs)])
|
||||
(if (equal? d main)
|
||||
'installation
|
||||
d))))
|
||||
'(shared 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)))])))
|
||||
(or version (r:version)))]
|
||||
[else (format "~a:" mode)])))
|
||||
(parameterize ([current-pkg-scope mode]
|
||||
[current-pkg-error (pkg-error 'show)]
|
||||
[current-pkg-scope-version (or version (r:version))])
|
||||
|
|
@ -245,13 +261,13 @@
|
|||
" 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")]
|
||||
[#:bool installation ("-i") "shorthand for `--scope installation'"]
|
||||
[#:bool user ("-u") "shorthand for `--scope user'"]
|
||||
[#:bool shared ("-s") "shorthand for `--scope shared'"]
|
||||
[#: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 installation shared user
|
||||
scope #f installation shared user
|
||||
(lambda ()
|
||||
(if set
|
||||
(with-pkg-lock
|
||||
|
|
|
|||
|
|
@ -103,12 +103,11 @@
|
|||
(void (links #:user? #t #:shared? #t #:show? #t))
|
||||
(printf "Installation links:\n")
|
||||
(void (links #:user? #f #:show? #t))
|
||||
(let ([p (filter file-exists?
|
||||
(remove (find-links-file) (get-links-search-files)))])
|
||||
(unless (null? p)
|
||||
(printf "Installation constant links:\n")
|
||||
(for ([f (in-list p)])
|
||||
(void (links #:file f #:show? #t))))))
|
||||
(for ([f (in-list
|
||||
(filter file-exists?
|
||||
(remove (find-links-file) (get-links-search-files))))])
|
||||
(printf "Links from ~a:\n" f)
|
||||
(void (links #:file f #:show? #t))))
|
||||
|
||||
(when (and (remove-mode)
|
||||
(null? l1)
|
||||
|
|
|
|||
|
|
@ -68,8 +68,8 @@
|
|||
(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)
|
||||
(define-config config:pkg-dir 'pkg-dir to-path)
|
||||
(define-config config:pkg-search-dirs 'pkg-search-dirs to-path)
|
||||
(define-config config:pkgs-dir 'pkgs-dir to-path)
|
||||
(define-config config:pkgs-search-dirs 'pkgs-search-dirs to-path)
|
||||
(define-config config:cgc-suffix 'cgc-suffix values)
|
||||
(define-config config:3m-suffix '3m-suffix values)
|
||||
(define-config config:absolute-installation? 'absolute-installation? (lambda (x) (and x #t)))
|
||||
|
|
@ -331,19 +331,19 @@
|
|||
;; Packages
|
||||
|
||||
(define-finder provide
|
||||
config:pkg-dir
|
||||
find-pkg-dir
|
||||
config:pkgs-dir
|
||||
find-pkgs-dir
|
||||
get-false
|
||||
config:pkg-search-dirs
|
||||
get-pkg-search-dirs
|
||||
config:pkgs-search-dirs
|
||||
get-pkgs-search-dirs
|
||||
(chain-to (lambda () (build-path (find-lib-dir) "pkgs"))))
|
||||
|
||||
(provide find-user-pkg-dir
|
||||
find-shared-pkg-dir)
|
||||
(define (find-user-pkg-dir [vers (version)])
|
||||
(provide find-user-pkgs-dir
|
||||
find-shared-pkgs-dir)
|
||||
(define (find-user-pkgs-dir [vers (version)])
|
||||
(build-path (find-system-path 'addon-dir)
|
||||
vers
|
||||
"pkgs"))
|
||||
(define (find-shared-pkg-dir)
|
||||
(define (find-shared-pkgs-dir)
|
||||
(build-path (find-system-path 'addon-dir)
|
||||
"pkgs"))
|
||||
|
|
|
|||
|
|
@ -354,11 +354,11 @@
|
|||
#:info-path-mode 'abs-in-relative
|
||||
#:omit-root 'dir
|
||||
#:main? #t))
|
||||
(when (member (find-links-file) (get-links-search-files))
|
||||
(for ([c+p (in-list (links #:user? #f #:with-path? #t))])
|
||||
(for ([inst-links (in-list (get-links-search-files))])
|
||||
(for ([c+p (in-list (links #:file inst-links #:with-path? #t))])
|
||||
(cc! (list (string->path (car c+p)))
|
||||
#:path (cdr c+p)))
|
||||
(for ([cp (in-list (links #:root? #t #:user? #f))]
|
||||
(for ([cp (in-list (links #:root? #t #:file inst-links))]
|
||||
#:when (directory-exists? cp)
|
||||
[collection (directory-list cp)]
|
||||
#:unless (skip-collection-directory? collection)
|
||||
|
|
|
|||
|
|
@ -4,19 +4,60 @@
|
|||
racket/list
|
||||
racket/format
|
||||
racket/string
|
||||
racket/set
|
||||
setup/getinfo
|
||||
pkg/lib)
|
||||
|
||||
(define config-file-path (build-path "racket" "etc" "config.rktd"))
|
||||
(define devel-pkgs-dir (build-path "racket" "lib" "devel-pkgs"))
|
||||
|
||||
(define only-platform? #f)
|
||||
|
||||
(define dirs
|
||||
(define dirs null)
|
||||
|
||||
(define pkgs
|
||||
(command-line
|
||||
#:once-each
|
||||
[("--platform") "Only packages whose names match the platform name"
|
||||
(set! only-platform? #t)]
|
||||
#:multi
|
||||
[("++dir") dir "Use packages in <dir>"
|
||||
(set! dirs (cons dir dirs))]
|
||||
#:args
|
||||
dir
|
||||
dir))
|
||||
pkg
|
||||
(list->set pkg)))
|
||||
|
||||
(define devel-pkgs-bytes
|
||||
(path->bytes (path->complete-path devel-pkgs-dir)))
|
||||
(define devel-links-bytes
|
||||
(path->bytes (path->complete-path (build-path devel-pkgs-dir "links.rktd"))))
|
||||
|
||||
(when (file-exists? config-file-path)
|
||||
(call-with-input-file*
|
||||
config-file-path
|
||||
(lambda (i)
|
||||
(define r (read i))
|
||||
(define (check what id bytes)
|
||||
(define l (hash-ref r id #f))
|
||||
(unless (and (list? l)
|
||||
(member bytes l))
|
||||
(error 'link-all
|
||||
(~a "config file exists, but does not have a definition of `~a' that includes development ~a\n"
|
||||
" config file: ~a\n"
|
||||
" development packages: ~s\n"
|
||||
" possible solution: delete the config file")
|
||||
id
|
||||
what
|
||||
config-file-path
|
||||
bytes)))
|
||||
(check "packages"
|
||||
'pkgs-search-dirs
|
||||
devel-pkgs-bytes)
|
||||
(check "links"
|
||||
'links-search-files
|
||||
devel-links-bytes))))
|
||||
|
||||
;; found: maps each available package name to a directory
|
||||
(define found (make-hash))
|
||||
|
||||
(define rx:platform (regexp
|
||||
|
|
@ -49,33 +90,78 @@
|
|||
[(directory-exists? src-f)
|
||||
(loop src-f)])))))
|
||||
|
||||
;; Remove links that are no longer present or where the
|
||||
;; directory shape has changed.
|
||||
(let ([pkgs-exes (map explode-path (map path->complete-path dirs))])
|
||||
(for ([(name info) (in-hash (installed-pkg-table #:scope 'installation))])
|
||||
(when (eq? 'link (car (pkg-info-orig-pkg info)))
|
||||
(define dir (cadr (pkg-info-orig-pkg info)))
|
||||
(define ex (explode-path dir))
|
||||
(when (for/or ([pkgs-ex (in-list pkgs-exes)])
|
||||
(and ((length pkgs-ex) . < . (length ex))
|
||||
(equal? pkgs-ex (take ex (length pkgs-ex)))))
|
||||
(when (or (not (hash-ref found name #f))
|
||||
(not (equal?
|
||||
(pkg-single-collection dir)
|
||||
(and (sc-pkg-info? info)
|
||||
(sc-pkg-info-collect info)))))
|
||||
(parameterize ([current-pkg-scope 'installation])
|
||||
(printf "Removing ~a\n" dir)
|
||||
(pkg-remove (list name)
|
||||
#:force? #t)))))))
|
||||
;; Like `found', but just the packages we want
|
||||
(define wanted (make-hash))
|
||||
|
||||
(define all-pkgs
|
||||
(let loop ([all-pkgs pkgs] [pkgs pkgs])
|
||||
(define new-pkgs
|
||||
(for/fold ([new-pkgs (set)]) ([pkg-name (in-set pkgs)])
|
||||
(define dir (hash-ref found pkg-name #f))
|
||||
(unless dir
|
||||
(error 'link-all "requested package not available: ~s" pkg-name))
|
||||
(define i (get-info/full dir))
|
||||
(define deps
|
||||
(for/list ([dep (in-list (append (i 'deps (lambda () null))
|
||||
(i 'build-deps (lambda () null))))]
|
||||
#:when
|
||||
(let ([platform (and (list? dep)
|
||||
(member '#:platform dep))])
|
||||
(or (not platform)
|
||||
(let ([p (cadr platform)])
|
||||
(if (symbol? p)
|
||||
(eq? p (system-type))
|
||||
(let ([s (path->string (system-library-subpath #f))])
|
||||
(if (regexp? p)
|
||||
(regexp-match? p s)
|
||||
(equal? p s))))))))
|
||||
(if (pair? dep)
|
||||
(car dep)
|
||||
dep)))
|
||||
(set-union
|
||||
new-pkgs
|
||||
(for/set ([dep (in-list deps)]
|
||||
#:unless (or (set-member? all-pkgs dep)
|
||||
(set-member? pkgs dep)))
|
||||
dep))))
|
||||
(if (set-empty? new-pkgs)
|
||||
all-pkgs
|
||||
(loop (set-union new-pkgs all-pkgs) new-pkgs))))
|
||||
|
||||
;; flush old configuration
|
||||
(when (directory-exists? devel-pkgs-dir)
|
||||
(printf "Erasing previous development package configuration\n")
|
||||
(delete-directory/files devel-pkgs-dir))
|
||||
|
||||
(void
|
||||
(parameterize ([current-pkg-scope 'installation])
|
||||
(define installed (installed-pkg-table #:scope 'installation))
|
||||
(pkg-install (for/list ([(name v) (in-hash found)]
|
||||
#:when (not (hash-ref installed name #f)))
|
||||
(printf "Adding ~a\n" v)
|
||||
(pkg-desc (path->string v)
|
||||
(parameterize ([current-pkg-scope (path->complete-path devel-pkgs-dir)])
|
||||
(define (is-auto? name) (not (set-member? pkgs name)))
|
||||
(pkg-install (for/list ([name (in-list (sort (set->list all-pkgs)
|
||||
;; Non-auto before auto:
|
||||
(lambda (a b)
|
||||
(cond
|
||||
[(is-auto? a)
|
||||
(and (is-auto? b)
|
||||
(string<? a b))]
|
||||
[(is-auto? b) #t]
|
||||
[else (string<? a b)]))))])
|
||||
(define dir (hash-ref found name))
|
||||
(define auto? (is-auto? name))
|
||||
(printf "Adding ~a~a as ~a\n" name (if auto? "*" "") dir)
|
||||
(pkg-desc (path->string dir)
|
||||
'link
|
||||
#f
|
||||
#f)))))
|
||||
auto?)))))
|
||||
|
||||
;; link configuration
|
||||
(unless (file-exists? config-file-path)
|
||||
(printf "Writing ~a\n" config-file-path)
|
||||
(call-with-output-file*
|
||||
config-file-path
|
||||
(lambda (o)
|
||||
(write (hash 'pkgs-search-dirs
|
||||
(list #f devel-pkgs-bytes)
|
||||
'links-search-files
|
||||
(list #f devel-links-bytes))
|
||||
o)
|
||||
(newline o))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user