264 collects/scribblings/guide/module-basics.scrbl
View file
@@ -1,38 +1,47 @@
#lang scribble/doc
@(require scribble/manual scribble/eval "guide-utils.rkt"
(for-label setup/dirs))
@(require scribble/manual
scribble/eval
"guide-utils.rkt"
"module-hier.rkt"
(for-label setup/dirs
setup/link
racket/date))

@title[#:tag "module-basics"]{Module Basics}

The space of module names is distinct from the space of normal Racket
definitions. Indeed, since modules typically reside in files, the
space of module names is explicitly tied to the filesystem at run
time. For example, if the file @filepath{/home/molly/cake.rkt} contains
Each Racket module typically resides in its own file. For example,
suppose the file @filepath{cake.rkt} contains the following module:

@racketmod[
#:file "cake.rkt"
racket

(provide print-cake)

(code:comment @#,t{draws a cake with @racket[n] candles})
(define (print-cake n)
(printf " ~a \n" (make-string n #\.))
(printf " .-~a-.\n" (make-string n #\|))
(printf " | ~a |\n" (make-string n #\space))
(printf "---~a---\n" (make-string n #\-)))
(show " ~a " n #\.)
(show " .-~a-. " n #\|)
(show " | ~a | " n #\space)
(show "---~a---" n #\-))

(define (show fmt n ch)
(printf fmt (make-string n ch))
(newline))
]

then it can be used as the source of a module whose full name is based
on the path @filepath{/home/molly/cake.rkt}. The @racket[provide] line
exports the definition @racket[print-cake] so that it can be used
outside the module.
Then, other modules can import @filepath{cake.rkt} to use the
@racket[print-cake] function, since the @racket[provide] line in
@filepath{cake.rkt} explicitly exports the definition
@racket[print-cake]. The @racket[show] function is private to
@filepath{cake.rkt} (i.e., it cannot be used from other modules),
since @racket[show] is not exported.

Instead of using its full path, a module is more likely to be
referenced by a relative path. For example, a file
@filepath{/home/molly/random-cake.rkt} could use the @filepath{cake.rkt} module
like this:
The following @filepath{random-cake.rkt} module imports
@filepath{cake.rkt}:

@racketmod[
#:file "random-cake.rkt"
racket

(require "cake.rkt")
@@ -41,17 +50,90 @@ racket
]

The relative reference @racket["cake.rkt"] in the import
@racket[(require "cake.rkt")] works because the @filepath{cake.rkt} module
source is in the same directory as the @filepath{random-cake.rkt}
file. (Unix-style relative paths are used for relative module
references on all platforms, much like relative URLs.)

Library modules that are distributed with Racket are usually
referenced through an unquoted, suffixless path. The path is relative
to the library installation directory, which contains directories for
individual library @deftech{collections}. The module below refers to
the @filepath{date.rkt} library that is part of the @filepath{racket}
@tech{collection}.
@racket[(require "cake.rkt")] works if the @filepath{cake.rkt} and
@filepath{random-cake.rkt} modules are in the same
directory. (Unix-style relative paths are used for relative module
references on all platforms, much like relative URLs in HTML pages.)

@; ----------------------------------------
@section[#:tag "module-org"]{Organizing Modules}

The @filepath{cake.rkt} and @filepath{random-cake.rkt} example
demonstrates the most common way to organize a program into modules:
put all module files in a single directory (perhaps with
subdirectories), and then have the modules reference each other
through relative paths. A directory of modules can act as a
project, since it can be moved around on the filesystem or copied to
other machines, and relative paths preserve the connections among
modules.

As another example, if you are building a candy-sorting program, you
might have a main @filepath{sort.rkt} module that uses other modules
to access a candy database and a control sorting machine. If the
candy-database module itself is organized into sub-modules that handle
barcode and manufacturer information, then the database module could
be @filepath{db/lookup.rkt} that uses helper modules
@filepath{db/barcodes.rkt} and @filepath{db/makers.rkt}. Similarly,
the sorting-machine driver @filepath{machine/control.rkt} might use
helper modules @filepath{machine/sensors.rkt} and
@filepath{machine/actuators.rkt}.

@centerline[module-hierarchy]

The @filepath{sort.rkt} module uses the relative paths
@filepath{db/lookup.rkt} and @filepath{machine/control.rkt} to import
from the database and machine-control libraries:

@racketmod[
#:file "sort.rkt"
racket
(require "db/lookup.rkt" "machine/control.rkt")
....]

The @filepath{db/lookup.rkt} module similarly uses paths relative to
its own source to access the @filepath{db/barcodes.rkt} and
@filepath{db/makers.rkt} modules:


@racketmod[
#:file "db/lookup.rkt"
racket
(require "barcode.rkt" "makers.rkt")
....]

Ditto for @filepath{machine/control.rkt}:

@racketmod[
#:file "machine/control.rkt"
racket
(require "sensors.rkt" "actuators.rkt")
....]

Racket tools all work automatically with relative paths. For example,

@commandline{racket sort.rkt}

on the comamnd line runs the @filepath{sort.rkt} program and
automatically loads and compiles required modules. With a large enough
program, compilation from source can take too long, so use

@commandline{raco make sort.rkt}

to compile @filepath{sort.rkt} and all its dependencies to bytecode
files. Running @exec{racket sort.rkt} will automatically use bytecode
files when they are present.

@margin-note{See @secref[#:doc '(lib "scribblings/raco/raco.scrbl")
"make"] for more information on @exec{raco make}.}

@; ----------------------------------------
@section{Library Collections}

A @deftech{collection} is a set of installed library modules. A
module in a @tech{collection} is referenced through an unquoted,
suffixless path. For example, the following module refers to the
@filepath{date.rkt} library that is part of the @filepath{racket}
@tech{collection}:

@racketmod[
racket
@@ -62,12 +144,41 @@ racket
(date->string (seconds->date (current-seconds))))
]

In addition to the main @tech{collection} directory, which contains
all collections that are part of the installation, collections can
also be installed in a user-specific location. Finally, additional
collection directories can be specified in configuration files or
through the @envvar{PLTCOLLECTS} search path. Try running the
following program to find out where your collections are:
When you search the online Racket documentation, the search results
indicate the module that provides each binding. Alternatively, if you
reach a binding's documentation by clicking on hyperlinks, you can
hover over the binding name to find out which modules provide
it.

A module reference like @racketmodname[racket/date] looks like an
identifier, but it is not treated in the same way as @racket[printf]
or @racket[date->string]. Instead, when @racket[require] sees a module
reference that is unquoted, it converts the reference to a
collection-based module path:

@itemlist[

@item{First, if the unquoted path contains no @litchar{/}, then
@racket[require] automatically adds a @filepath{/main} to the
reference. For example, @racket[(require
@#,racketmodname[slideshow])] is equivalent to @racket[(require
slideshow/main)].}

@item{Second, @racket[require] implicitly adds a @filepath{.rkt}
suffix to the path.}

@item{Finally, @racket[require] treats the path as relative to the
installation location of the collection, instead of relative to
the enclosing module's path.}

]

The @filepath{racket} collection is located in a directory with the
Racket installation. A user-specific directory can contain additional
collections, and even more collection directories can be specified in
configuration files or through the @envvar{PLTCOLLECTS} search
path. Try running the following program to find out how your
collection search path is configured:

@racketmod[
racket
@@ -79,5 +190,84 @@ racket
(get-collects-search-dirs) (code:comment @#,t{complete search path})
]

We discuss more forms of module reference later in
@secref["module-paths"].
@; ----------------------------------------
@section[#:tag "link-collection"]{Adding Collections}

Looking back at the candy-sorting example of @secref["module-org"],
suppose that modules in @filepath{db/} and @filepath{machine/} need a
common set of helper functions. Helper functions could be put in a
@filepath{utils/} directory, and modules in @filepath{db/} or
@filepath{machine/} could access utility modules with relative paths
that start @filepath{../utils/}. As long as a set of modules work
together in a single project, it's best to stick with relative paths.
A programmer can follow relative-path references without knowing about
your Racket configuration.

Some libraries are meant to be used across multiple projects, so that
keeping the library source in a directory with its uses does not make
sense. In that case, you have two options:

@itemlist[

@item{Add the library to a new or existing @tech{collection}. After
the library is in a collection, it can be referenced with an
unquoted path, just like libraries that are included with the
Racket distribution.}

@item{Add the library a new or existing @|PLaneT| package. Libraries
in a @|PLaneT| package are referenced with a path of the form
@racket[(planet ....)] path.

@margin-note{See @other-doc['(lib "planet/planet.scrbl")]
for more information on @|PLaneT|.}}

]

The simplest option is to add a new collection. You could add a new
collection by placing files in the Racket installation or one of the
directories reported by @racket[(get-collects-search-dirs)]---perhaps
setting the @envvar{PLTCOLLECTS} environment variable to extend the
search path---but using @exec{raco link} is usually the best approach.

The @exec{raco link} command-line tool creates a link from a collection
name to a directory for the collection's modules. For example, suppose
you have a directory @filepath{/usr/molly/bakery} that contains the
@filepath{cake.rkt} module (from the
@seclink["module-basics"]{beginning} of this section) and other
related modules. To make the modules available as a @filepath{bakery}
collection, use

@commandline{raco link /usr/molly/bakery}

Afterward, @racket[(require bakery/cake)] from any module will import
the @racket[print-cake] function from
@filepath{/usr/molly/bakery/cake.rkt}.

To make a collection name different from the name of the directory
that contains the collection's modules, use the @DFlag{name} or
@Flag{n} option for @exec{raco link}. By default, @exec{raco link}
installs a collection link only for the current user, but you can
supply the @DFlag{installation} or @Flag{i} flag to install the link
for all users of your Racket installation.

@margin-note{See @secref[#:doc '(lib "scribblings/raco/raco.scrbl")
"link"] for more information on @exec{raco link}.}

If you intend to distribute your library collection to others, choose
the collection name carefully. The collection namespace is
hierarchical, but (unlike @|PLaneT|) the collection system has no
built-in feature to avoid conflicts from different producers or
different versions. Consider putting one-off libraries under some
top-level name like @filepath{molly} that identifies the producer.
Use a collection name like @filepath{bakery} when producing the
definitive collection of baked-goods libraries.

After your libraries are in a @tech{collection}, then you can still
use @exec{raco make} to compile the library sources, but it's better
and more convenient to use @exec{raco setup}. The @exec{raco setup}
command takes a collection name (as opposed to a file name) and
compiles all libraries within the collection. In addition, it can
build documentation for the collection and add it to the documentation
index, as specified by a @filepath{info.rkt} module in the collection.
See @secref[#:doc '(lib "scribblings/raco/raco.scrbl") "setup"] for
more information on @exec{raco setup}.
97 collects/scribblings/guide/module-hier.rkt
View file
@@ -0,0 +1,97 @@
#lang racket/base
(require slideshow/pict
racket/draw
racket/class
racket/math)

(provide module-hierarchy)

(define GAP 12)

(define file-color (make-object color% #xEC #xF5 #xF5))

(define folder
(let ()
(define W 200)
(define H 144)
(define dy (* -8/3 2))
(define p (make-object dc-path%))
(send p move-to 0 50)
(send p arc 0 (+ 22 dy) 8 8 pi (/ pi 2) #f)
(send p arc 2 (+ 18 dy) 4 4 (/ pi -2) 0 #t)
(send p arc 6 0 20 20 pi (/ pi 2) #f)
(send p line-to 60 0)
(send p arc 50 0 20 20 (/ pi 2) 0 #f)
(send p arc 70 (+ 22 dy) 2 2 pi (* 3/2 pi))
(send p arc 180 (+ 24 dy) 20 20 (/ pi 2) 0 #f)
(send p arc 180 120 20 20 0 (/ pi -2) #f)
(send p arc 0 120 20 20 (/ pi -2) (- pi) #f)
(send p close)

(scale
(dc (lambda (dc x y)
(define b (send dc get-brush))
(send dc set-brush file-color 'solid)
(send dc draw-path p x y)
(send dc set-brush b))
W H)
12/32)))

(define file
(file-icon (/ 75 2) 54 file-color))

(define (lbl i t)
(vc-append 4 i (text t '(bold . modern) 12)))

(define (listing p)
(frame (inset p GAP)
#:color "blue"))

(define db-folder (launder folder))
(define mach-folder (launder folder))
(define db-listing
(listing
(vc-append
GAP
(lbl file "control.rkt")
(hc-append (* 2 GAP)
(lbl file "sensors.rkt")
(lbl file "actuators.rkt")))))
(define mach-listing
(listing
(vc-append
GAP
(lbl file "lookup.rkt")
(hc-append (* 2 GAP)
(lbl file "barcodes.rkt")
(lbl file "makers.rkt")))))

(define (zoom from to p)
(pin-line
(pin-line p
from lb-find
to lt-find
#:style 'dot)
from rb-find
to rt-find
#:style 'dot))


(define module-hierarchy
(inset
(zoom
db-folder db-listing
(zoom
mach-folder mach-listing
(vc-append
(* 3 GAP)
(listing
(hc-append (* 4 GAP)
(lbl file "sort.rkt")
(lbl db-folder "db")
(lbl mach-folder "machine")))
(hc-append
(* 2 GAP)
db-listing
mach-listing))))
2))
11 collects/scribblings/guide/welcome.scrbl
View file
@@ -162,9 +162,14 @@ racket
(extract "the cat out of the bag")
]

then it is a complete program that prints ``cat'' when run. To
package this program as an executable, choose one of the following
options:
then it is a complete program that prints ``cat'' when run. You can
run the program within DrRacket or using @racket[enter!] in
@exec{racket}, but if the program is saved in @nonterm{src-filename},
you can also run it from a command line with

@commandline{racket @nonterm{src-filename}}

To package the program as an executable, you have a few options:

@itemize[

6 collects/scribblings/raco/common.rkt
View file
@@ -1,7 +1,11 @@
#lang scheme/base
(require scribble/manual)

(provide inside-doc)
(provide inside-doc
reference-doc)

(define inside-doc
'(lib "scribblings/inside/inside.scrbl"))

(define reference-doc
'(lib "scribblings/reference/reference.scrbl"))
107 collects/scribblings/raco/link.scrbl
View file
@@ -0,0 +1,107 @@
#lang scribble/doc
@(require scribble/manual
scribble/bnf
"common.rkt"
(for-label racket/base))

@title[#:tag "link"]{@exec{raco link}: Library Collection Links}

The @exec{raco link} command inspects and modifies a @tech[#:doc
reference-doc]{collection links file} to display, add, or remove
mappings from collection names to filesystem directories.

For example, the command

@commandline{raco link maze}

installs a user-specific link for the @racket["maze"] collection,
mapping it to the @filepath{maze} subdirectory of the current
directory. Supply multiple directory paths to create multiple links at
once, especially with a command-shell wildcard:

@commandline{raco link *}

By default, the linked collection name is the same as each directory's
name, but the collection name can be set separately for a single
directory with the @DFlag{name} flag.

To remove the link created by the first example above, use

@commandline{raco link --remove maze}

or

@commandline{raco link -r maze}

Like link-adding mode, removing mode accepts multiple directory paths to
remove multiple links, and all links that match any directory are
removed. If @DFlag{name} is used with @DFlag{remove}, then only
links matching both the collection name and directory are removed.

Full command-line options:

@itemlist[

@item{@Flag{s} or @DFlag{show} --- Shows the current link table. If
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{r},
@DFlag{remove}, @Flag{i}, @DFlag{installation}, @Flag{f}, or
@DFlag{file} are specified, then the link table is shown for
both the user-specific and installation-wide @tech[#:doc
reference-doc]{collection links files}.}

@item{@Flag{n} @nonterm{name} or @DFlag{name} @nonterm{name} --- Sets
the collection name for adding or removing a single link. By
default, the collection name for an added link is derived from
the directory name. When the @Flag{r} or @DFlag{remove} flag is
also used, only links with a collection name matching
@nonterm{name} are removed.}

@item{@Flag{x} @nonterm{regexp} or @DFlag{version-regexp}
@nonterm{regexp} --- Sets a version regexp that limits the link
to use only by Racket versions (as reported by
@racket[version]) matching @nonterm{regexp}. When the @Flag{r}
or @DFlag{remove} flag is also used, only links with a
version regexp matching @nonterm{regexp} are removed.}

@item{@Flag{i} or @DFlag{installation} --- Reads and writes links in
installation-wide @tech[#:doc reference-doc]{collection links
file} instead of the user-specific @tech[#:doc
reference-doc]{collection links file}. This flag is mutally
exclusive with @Flag{f} and @DFlag{file}.}

@item{@Flag{f} @nonterm{file} or @DFlag{file} @nonterm{file} ---
Reads and writes links in @nonterm{file} instead of the
user-specific @tech[#:doc reference-doc]{collection links
file}. This flag is mutally exclusive with @Flag{i} and
@DFlag{installation}.}

@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.}

]

@; ----------------------------------------

@section{API for Collection Links}

@defmodule[setup/link]

@defproc[(links [dirs (listof path?)]
[#:file file path-string? (find-system-path 'links-file)]
[#:name name (or/c string? #f) #f]
[#:version-regexp version-regexp (or/c regexp? #f) #f]
[#:error error-proc (symbol? string? any/c ... . -> . any) error]
[#:remove? remove? any/c #f]
[#:show? show? any/c #f]
[#:repair? repair? any/c #f])
(listof string?)]{

A function version of the @exec{raco link} command. The
@racket[error-proc] argument is called to raise exceptions that would
be fatal to the @exec{raco link} command.

The result is a list of top-level collections that are mapped by
@racket[file] and that apply to the running version of Racket.}
1 collects/scribblings/raco/raco.scrbl
View file
@@ -16,6 +16,7 @@ a typical Racket installation.
@table-of-contents[]

@include-section["make.scrbl"]
@include-section["link.scrbl"]
@include-section["exe.scrbl"]
@include-section["dist.scrbl"]
@include-section["plt.scrbl"]
29 collects/scribblings/raco/setup.scrbl
View file
@@ -2,6 +2,7 @@

@(require scribble/manual
scribble/bnf
"common.rkt"
(for-label racket
racket/future
setup/setup-unit
@@ -1086,16 +1087,13 @@ An @deftech{unpackable} is one of the following:

@defproc[(find-relevant-directories
(syms (listof symbol?))
(mode (symbols 'preferred 'all-available) 'preferred)) (listof path?)]{
(mode (or/c 'preferred 'all-available 'no-planet) 'preferred)) (listof path?)]{

Returns a list of paths identifying installed directories (i.e.,
collections and installed @|PLaneT| packages) whose
@filepath{info.rkt} file defines one or more of the given
symbols. The result is based on a cache that is computed by
@exec{raco setup} and stored in the @indexed-file{info-domain}
sub-directory of each collection directory (as determined by the
@envvar{PLT_COLLECTION_PATHS} environment variable, etc.) and the
file @filepath{cache.rkt} in the user add-on directory.
@exec{raco setup}.
Note that the cache may be out of date by the time you call
@racket[get-info/full], so do not assume that it won't return
@racket[#f].
@@ -1105,20 +1103,27 @@ An @deftech{unpackable} is one of the following:
providing to @racket[get-info/full].

If @racket[mode] is specified, it must be either
@racket['preferred] (the default) or @racket['all-available]. If
mode is @racket['all-available], @racket[find-relevant-collections]
@racket['preferred] (the default), @racket['all-available], or @racket[no-planet]. If
@racket[mode] is @racket['all-available], @racket[find-relevant-collections]
returns all installed directories whose info files contain the
specified symbols---for instance, all installed PLaneT packages
will be searched if @racket['all-available] is specified. If mode
will be searched if @racket['all-available] is specified. If @racket[mode]
is @racket['preferred], then only a subset of ``preferred''
packages will be searched, and in particular only the directory
packages will be searched: only the directory
containing the most recent version of any PLaneT package will be
returned.
returned. If @racket[mode] is @racket['no-planet], then only PLaneT
packages are not included in the search.

No matter what @racket[mode] is specified, if more than one
collection has the same name, @racket[find-relevant-directories]
will only search the one that occurs first in the
@envvar{PLT_COLLECTION_PATHS} environment variable.}
will only search the one that occurs first in a search that through
the directories of @racket[current-library-collection-paths].
Collection links from the installation-wide @tech[#:doc
reference-doc]{collection links file} are cached with the
installation's main @filepath{collects} directory, and links from
the user-specific @tech[#:doc reference-doc]{collection links file}
are cached with the user-specific directory @racket[(build-path
(find-system-path 'addon-dir) (version) "collects")].}

@defproc[(find-relevant-directory-records
[syms (listof symbol?)]
74 collects/scribblings/reference/collects.scrbl
View file
@@ -5,10 +5,10 @@

A @deftech{library} is @racket[module] declaration for use by multiple
programs. Racket further groups libraries into @deftech{collections}
that can be easily distributed and easily added to a local Racket
that can be easily distributed and added to a local Racket
installation.

Some collections are distributed via @|PLaneT|. Such collections are
Some libraries are distributed via @|PLaneT| packages. Such libraries are
referenced through a @racket[planet] module path (see
@racket[require]) and are downloaded by Racket on demand.

@@ -17,9 +17,11 @@ collection is a directory that is located in a @filepath{collects}
directory relative to the Racket executable. A collection can also be
installed in a user-specific directory. More generally, the search
path for installed collections can be configured through the
@racket[current-library-collection-paths] parameter. In all of these
cases, the collections are referenced through @racket[lib] paths (see
@racket[require]).
@racket[current-library-collection-paths] parameter. Finally, the
location of collections can be specified through the @tech{collection
links files}; see @secref["links-file"] for more information. In all
of these cases, the collections are referenced through @racket[lib]
paths (see @racket[require]) or symbolic shorthands.

For example, the following module uses the @filepath{getinfo.rkt}
library module from the @filepath{setup} collection, and the
@@ -33,7 +35,8 @@ racket
....
]

This example is more compactly and more commonly written as
This example is more compactly and more commonly written using
symbolic shorthands:

@racketmod[
racket
@@ -60,14 +63,16 @@ resolver}, as specified by the @racket[current-module-name-resolver]
parameter.

For the default @tech{module name resolver}, the search path for
collections is determined by the
@racket[current-library-collection-paths] parameter. The list of paths
in @racket[current-library-collection-paths] is searched from first to
collections is determined by the content of @racket[(find-system-path
'links-file)] (if it exists) and the
@racket[current-library-collection-paths] parameter. The collection
links and then list of paths in
@racket[current-library-collection-paths] is searched from first to
last to locate the first that contains @racket[_rel-string]. In other
words, the filesystem tree for each element in the search path is
spliced together with the filesystem trees of other path
elements. Some Racket tools rely on unique resolution of module path
names, so an installation and
words, the filesystem tree for each element in the link table and
search path is spliced together with the filesystem trees of other
path elements. Some Racket tools rely on unique resolution of module
path names, so an installation and
@racket[current-library-collection-paths] configuration should not
allow multiple files to match the same collection and file name.

@@ -156,3 +161,46 @@ the directory produced by @racket[(find-system-path 'addon-dir)], are
included in search paths for collections and other files. For example,
@racket[find-library-collection-paths] omits the user-specific
collection directory when this parameter's value is @racket[#f].}

@; ----------------------------------------------------------------------

@section[#:tag "links-file"]{Collection Links}

The @deftech{collection links files} are used by
@racket[collection-file-path], @racket[collection-path], and the
default @tech{module name resolver} to locate collections before
trying the @racket[(current-library-collection-paths)] search
path. Furthermore, a user-specific @tech{collection links file} takes
precedence over an installation-wide @tech{collection links file}, but
the user-specific @tech{collection links file} is used only the
@racket[use-user-specific-search-paths] parameter is set to
@racket[#t].

The path of the user-specific @tech{collection links file} is by
@racket[(find-system-path 'links-file)], while an installation-wide
@tech{collection links file} is @filepath{links.rktd} in the
@filepath{config} collection within the installation's main collection
directory. Each @tech{collection links file} is cached by Racket, but
the file is re-read if its timestamp changes.

Each @tech{collection links file} is @racket[read] with default reader
parameter settings to obtain a list. Every element of the list must be
a link specification with either the form @racket[(_string _path)] or
the form @racket[(_string _path _regexp)]. In both cases, the
@racket[_string] names a top-level @tech{collection}, and
@racket[_path] is a path that can be used as the collection's path
(directly, as opposed to a subdirectory of @racket[_path] named by
@racket[_string]). If @racket[_path] is a relative path, it is
relative to the directory containing the @tech{collection links
file}. If @racket[_regexp] is specified in a link, then the link is
used only if @racket[(regexp-match? _regexp (version))] produces a
true result.

A single top-level collection can have multiple links in a
@tech{collection links file}. The corresponding paths are effectively
spliced together, since the paths are tried in order to locate a file
or sub-collection.

The @exec{raco link} command-link tool can display, install, and
remove links in the @tech{collection links file}. See @secref[#:doc
raco-doc "link"] in @other-manual[raco-doc] for more information.
11 collects/scribblings/reference/filesystem.scrbl
View file
@@ -85,8 +85,17 @@ by @racket[kind], which must be one of the following:

]}

@item{@indexed-racket['links-file] --- the user-specific
@tech{collection links file} for specifying the location of library
@tech{collections}. This file is specified by the
@indexed-envvar{PLTLINKSFILE} environment variable, and it can be
overridden by the @DFlag{links} or @Flag{C} command-line flag. If no
environment variable or flag is specified, or if the value is not a
legal path name, then this file defaults to @filepath{links.rktd} in
the directory reported by @racket[(find-system-path 'addon-dir)].}

@item{@indexed-racket['addon-dir] --- a directory for installing
Racket extensions. This directory is specified by the
user-specific Racket extensions. This directory is specified by the
@indexed-envvar{PLTADDONDIR} environment variable, and it can be
overridden by the @DFlag{addon} or @Flag{A} command-line flag. If no
environment variable or flag is specified, or if the value is not a
6 collects/scribblings/reference/mz.rkt
View file
@@ -91,7 +91,8 @@

(provide margin-note/ref
refalso moreref Guide guideintro guidealso guidesecref
HonuManual)
HonuManual
raco-doc)

(define (margin-note/ref . s)
(apply margin-note
@@ -127,6 +128,9 @@

(define HonuManual
(other-manual '(lib "scribblings/honu/honu.scrbl")))

(define raco-doc
'(lib "scribblings/raco/raco.scrbl"))

(provide speed)
(define-syntax speed
14 collects/scribblings/reference/startup.scrbl
View file
@@ -250,6 +250,15 @@ flags:
the @Flag{S}/@DFlag{dir} flag is supplied multiple times, the
search order is as supplied.}

@item{@FlagFirst{A} @nonterm{dir} or @DFlagFirst{addon}
@nonterm{dir} : Sets the directory that is returned by
@racket[(find-system-path 'addon-dir)].}

@item{@FlagFirst{C} @nonterm{file} or @DFlagFirst{links}
@nonterm{file} : Sets the user-specific @tech{collection links file} path
that is returned by @racket[(find-system-path 'links-file)];
see also @secref["links-file"].}

@item{@FlagFirst{U} or @DFlagFirst{no-user-path} : Omits
user-specific paths in the search for collections, C
libraries, etc. by initializing the
@@ -405,8 +414,9 @@ language specifies run-time configuration by

A @racket['configure-runtime] query returns a list of vectors, instead
of directly configuring the environment, so that the indicated modules
to be bundled with a program when creating a stand-alone
executable; see @secref[#:doc '(lib "scribblings/raco/raco.scrbl") "exe"].
to be bundled with a program when creating a stand-alone executable;
see @secref[#:doc raco-doc "exe"] in
@other-manual[raco-doc].

For information on defining a new @hash-lang[] language, see
@racketmodname[syntax/module-reader].
2 collects/setup/collects.rkt
View file
@@ -3,6 +3,6 @@
(provide (struct-out cc))

(define-struct cc
(collection path name info root-dir info-path shadowing-policy)
(collection path name info omit-root info-root info-path info-path-mode shadowing-policy)
#:inspector #f)

74 collects/setup/commands/link.rkt
View file
@@ -0,0 +1,74 @@
#lang scheme/base
(require racket/cmdline
raco/command-name
"../link.rkt")

(define link-file (make-parameter #f))
(define link-name (make-parameter #f))
(define link-version (make-parameter #f))
(define remove-mode (make-parameter #f))
(define repair-mode (make-parameter #f))
(define show-mode (make-parameter #f))
(define user-mode (make-parameter #t))

(define link-symbol (string->symbol (short-program+command-name)))

(define dirs
(command-line
#:program (short-program+command-name)
#:once-each
[("-s" "--show") "Show the link table (after changes)"
(show-mode #t)]
[("-n" "--name") name "Set the collection name (for a single directory)"
(link-name name)]
[("-x" "--version-regexp") regexp "Set the version pregexp"
(with-handlers ([exn:fail:contract? (lambda (exn)
(raise-user-error link-symbol
"bad version regexp: ~a"
regexp))])
(link-version (pregexp regexp)))]
[("-r" "--remove") "Remove links for the specified directories"
(remove-mode #t)]
#:once-any
[("-i" "--installation") "Adjust user-independent links in the installation"
(user-mode #f)]
[("-f" "--file") file "Select an alternate link file"
(link-file (path->complete-path file))]
#:once-each
[("--repair") "Enable repair mode to fix existing links"
(repair-mode #t)]
#:args
dir dir))

(when (and (link-name)
(not (= 1 (length dirs))))
(raise-user-error link-symbol
"expected a single directory for `--name' mode"))

(define show-both?
(and (null? dirs)
(show-mode)
(user-mode)
(not (remove-mode))
(not (link-file))))

(when show-both?
(printf "User links:\n"))

(void
(apply links
dirs
#:user? (user-mode)
#:file (link-file)
#:name (link-name)
#:version-regexp (link-version)
#:error (lambda (who . args)
(apply raise-user-error link-symbol args))
#:remove? (remove-mode)
#:show? (show-mode)
#:repair? (repair-mode)))

(when show-both?
(printf "Installation links:\n")
(void (links #:user? #f #:show? #t)))

29 collects/setup/getinfo.rkt
View file
@@ -88,6 +88,7 @@

(define preferred-table #f)
(define all-available-table #f)
(define no-planet-table #f)

;; reset-relevant-directories-state! : -> void
(define (reset-relevant-directories-state!)
@@ -104,7 +105,8 @@
(list i)
l))))
#f #f))
(set! all-available-table (make-table cons #f #f)))
(set! all-available-table (make-table cons #f #f))
(set! no-planet-table (make-table cons #f #f)))

(reset-relevant-directories-state!)

@@ -160,20 +162,23 @@
(define t
(cond [(eq? key 'preferred) preferred-table]
[(eq? key 'all-available) all-available-table]
[(eq? key 'no-planet) no-planet-table]
[else (error 'find-relevant-directories "Invalid key: ~s" key)]))
;; A list of (cons cache.rktd-path root-dir-path)
;; If root-dir-path is not #f, then paths in the cache.rktd
;; file are relative to it. #f is used for the planet cache.rktd file.
(define search-path
(cons (cons user-infotable #f)
(map (lambda (coll)
(cons (build-path coll "info-domain" "compiled" "cache.rktd")
coll))
(current-library-collection-paths))))
(unless (equal? (table-paths t) search-path)
(set-table-ht! t (make-hasheq))
(set-table-paths! t search-path)
(populate-table! t))
((if (eq? key 'no-planet) (lambda (a l) l) cons)
(cons user-infotable #f)
(map (lambda (coll)
(cons (build-path coll "info-domain" "compiled" "cache.rktd")
coll))
(current-library-collection-paths))))
(when t
(unless (equal? (table-paths t) search-path)
(set-table-ht! t (make-hasheq))
(set-table-paths! t search-path)
(populate-table! t)))
(let ([unsorted
(if (= (length syms) 1)
;; Simple case: look up in table
@@ -205,7 +210,7 @@
(get-info/full ((path?) (#:namespace (or/c namespace? #f)) . ->* . (or/c info? boolean?)))
(find-relevant-directories
(->* [(listof symbol?)]
[(lambda (x) (memq x '(preferred all-available)))]
[(lambda (x) (memq x '(preferred all-available no-planet)))]
(listof path?)))
(struct directory-record
([maj integer?]
@@ -215,5 +220,5 @@
[syms (listof symbol?)]))
(find-relevant-directory-records
(->* [(listof symbol?)]
[(or/c 'preferred 'all-available)]
[(or/c 'preferred 'all-available 'no-planet)]
(listof directory-record?))))
3 collects/setup/info.rkt
View file
@@ -5,4 +5,5 @@
(define mzscheme-launcher-libraries '("main.rkt"))
(define mzscheme-launcher-names '("Setup PLT"))

(define raco-commands '(("setup" setup/main "install and build libraries and documentation" 90)))
(define raco-commands '(("setup" setup/main "install and build libraries and documentation" 90)
("link" setup/commands/link "manage library-collection directories" 80)))
157 collects/setup/link.rkt
View file
@@ -0,0 +1,157 @@
#lang scheme/base
(require racket/file
setup/dirs)

(provide links)

(define (links #:error [error error]
#:user? [user? #t]
#:file [in-file #f]
#:name [name #f]
#:version-regexp [version-regexp #f]
#:remove? [remove? #f]
#:show? [show? #f]
#:repair? [repair? #f]
. dirs)
(define file (or in-file
(if user?
(find-system-path 'links-file)
(let ([d (find-collects-dir)])
(if d
(build-path d "config" "links.rktd")
(error 'links
"cannot find installation collections path"))))))

(define need-repair? #f)

(define (content-error str v)
(if repair?
(begin
(log-warning (format "~a~e" str v))
(set! need-repair? #t)
#f)
(error 'links "~a~e" str v)))

(define table
(with-handlers ([exn:fail?
(lambda (exn)
(let ([msg (format
"error reading from link file: ~s: ~a"
file
(exn-message exn))])
(if repair?
(begin
(log-warning msg)
(set! need-repair? #t)
null)
(error 'links "~a" msg))))])
(if (file-exists? file)
(let ([l (with-input-from-file file read)])
(if (list? l)
(for/list ([e (in-list l)]
#:when
(or (and (list? e)
(or (= 2 (length e))
(= 3 (length e))))
(content-error "entry is a not a 2- or 3-element list: " e))
#:when
(or (string? (car e))
(content-error "entry's first element is not a string: " e))
#:when
(or (path-string? (cadr e))
(content-error "entry's second element is not a path string: " e))
#:when
(or (null? (cddr e))
(regexp? (caddr e))
(content-error "entry's third element is not a version regexp: " e)))
e)
(begin
(content-error "content is not a list: " l)
null)))
null)))

(define mapped (make-hash))

(define (add-entry! e)
(hash-set! mapped
(car e)
(cons (cdr e) (hash-ref mapped (car e) null))))


(for ([e (in-list table)]) (add-entry! e))

(define new-table
(reverse
(for/fold ([table (reverse table)]) ([d (in-list dirs)])
(let* ([dp (path->complete-path d)]
[a-name (or name
(let-values ([(base name dir?) (split-path dp)])
(path-element->string name)))]
[rx version-regexp]
[d (path->string dp)])
(unless remove?
(unless (directory-exists? dp)
(error 'links
"no such directory for link: ~a"
dp)))
(if remove?
(filter (lambda (e)
(or (not (equal? (cadr e) d))
(and name
(not (equal? (car e) name)))
(and version-regexp
(pair? (cddr e))
(not (equal? (caddr e) version-regexp)))))
table)
(let ([l (hash-ref mapped a-name null)]
[e (list* a-name
d
(if rx (list rx) null))])
(if (member (cdr e) l)
table
(let ()
(add-entry! e)
(cons e table)))))))))

(unless (and (not need-repair?)
(equal? new-table table))
(let ([dir (let-values ([(base name dir?) (split-path file)])
base)])
(make-directory* dir)
(let ([tmp (make-temporary-file "links~a.rktd"
#f
dir)])
(with-output-to-file tmp
#:exists 'truncate
(lambda ()
(printf "(")
(let loop ([l new-table] [prefix ""])
(cond
[(null? l) (printf ")\n")]
[else
(printf "~a~s" prefix (car l))
(unless (null? (cdr l)) (newline))
(loop (cdr l) " ")]))))
(with-handlers ([exn:fail? (lambda (exn)
(with-handlers ([exn:fail? void])
(delete-file tmp))
(raise exn))])
(rename-file-or-directory tmp file #t)))))

(when show?
(for ([e (in-list new-table)])
(printf " collection: ~s path: ~s~a\n"
(car e)
(cadr e)
(if (null? (cddr e))
""
(format " version: ~s"
(caddr e))))))

;; Return list of collections mapped for this version:
(let ([ht (make-hash)])
(for ([e (in-list new-table)])
(when (or (null? (cddr e))
(regexp-match? (caddr e) (version)))
(hash-set! ht (car e) #t)))
(hash-map ht (lambda (k e) k))))
13 collects/setup/private/omitted-paths.rkt
View file
@@ -82,16 +82,21 @@
implicit?
get-info/full)))))))

(define (omitted-paths* dir get-info/full)
(define (omitted-paths* dir get-info/full root-dir)
(unless (and (path-string? dir) (complete-path? dir) (directory-exists? dir))
(raise-type-error 'omitted-paths
"complete path to an existing directory" dir))
(let* ([dir* (explode-path (simple-form-path dir))]
[r (ormap (lambda (root+table)
(let ([r (relative-from dir* (car root+table))])
(and r (cons (reverse r) root+table))))
(force roots))]
(if root-dir
(list (list (explode-path root-dir)
(make-hash)
#t))
(force roots)))]
[r (and r (apply accumulate-omitted get-info/full r))])

(unless r
(error 'omitted-paths
"given directory path is not in any collection root: ~e" dir))
@@ -101,5 +106,5 @@

(define omitted-paths-memo (make-hash))

(define (omitted-paths dir get-info/full)
(with-memo omitted-paths-memo dir (omitted-paths* dir get-info/full)))
(define (omitted-paths dir get-info/full [root-dir #f])
(with-memo omitted-paths-memo dir (omitted-paths* dir get-info/full root-dir)))
4 collects/setup/private/path-utils.rkt
View file
@@ -5,7 +5,7 @@
(provide doc-path)

;; user-doc-mode can be `false-if-missing' or `never'
(define (doc-path dir name flags [user-doc-mode #f])
(define (doc-path dir name flags under-main? [user-doc-mode #f])
(define (user-doc [sub #f])
(and (not (eq? 'never user-doc-mode))
(let ([d (find-user-doc-dir)])
@@ -15,6 +15,6 @@
(cond [(memq 'main-doc-root flags) (find-doc-dir)]
[(memq 'user-doc-root flags) (user-doc)]
[(memq 'user-doc flags) (user-doc name)]
[(or (memq 'main-doc flags) (pair? (path->main-collects-relative dir)))
[(or under-main? (memq 'main-doc flags) (pair? (path->main-collects-relative dir)))
(build-path (find-doc-dir) name)]
[else (build-path dir "doc" name)]))
11 collects/setup/scribble.rkt
View file
@@ -95,7 +95,7 @@
(apply validate i)))
infos)])
(and (not (memq #f infos)) infos))))
(define (get-docs i rec)
(define ((get-docs main-dirs) i rec)
(let ([s (validate-scribblings-infos (i 'scribblings))]
[dir (directory-record-path rec)])
(if s
@@ -106,6 +106,7 @@
(not (memq 'user-doc-root flags))
(not (memq 'user-doc flags))
(or (memq 'main-doc flags)
(hash-ref main-dirs dir #f)
(pair? (path->main-collects-relative dir))))])
(make-doc dir
(let ([spec (directory-record-spec rec)])
@@ -117,7 +118,7 @@
(list '= (directory-record-min rec)))))
(cdr spec))))
(build-path dir (car d))
(doc-path dir (cadddr d) flags)
(doc-path dir (cadddr d) flags under-main?)
flags under-main? (caddr d))))
s)
(begin (setup-printf
@@ -126,8 +127,12 @@
null))))
(define docs
(let* ([recs (find-relevant-directory-records '(scribblings) 'all-available)]
[main-dirs (parameterize ([current-library-collection-paths
(list (find-collects-dir))])
(for/hash ([k (in-list (find-relevant-directories '(scribblings) 'no-planet))])
(values k #t)))]
[infos (map get-info/full (map directory-record-path recs))])
(filter-user-docs (append-map get-docs infos recs) make-user?)))
(filter-user-docs (append-map (get-docs main-dirs) infos recs) make-user?)))
(define-values (main-docs user-docs) (partition doc-under-main? docs))
(define (can-build*? docs) (can-build? only-dirs docs))
(define auto-main? (and auto-start-doc? (ormap can-build*? main-docs)))
177 collects/setup/setup-unit.rkt
View file

Large diffs are not rendered by default.

9 collects/setup/xref.rkt
View file
@@ -3,6 +3,7 @@
(require scribble/xref
scheme/fasl
scheme/path
setup/dirs
"getinfo.rkt"
"private/path-utils.rkt")

@@ -11,6 +12,12 @@
(define cached-xref #f)

(define (get-dests)
(define main-dirs
(parameterize ([current-library-collection-paths
(let ([d (find-collects-dir)])
(if d (list d) null))])
(for/hash ([k (in-list (find-relevant-directories '(scribblings) 'no-planet))])
(values k #t))))
(for*/list ([dir (find-relevant-directories '(scribblings) 'all-available)]
[d ((get-info/full dir) 'scribblings)])
(unless (and (list? d) (pair? d))
@@ -23,7 +30,7 @@
(path-replace-suffix (file-name-from-path (car d))
#"")))])
(and (not (and (len . >= . 3) (memq 'omit (caddr d))))
(let* ([d (doc-path dir name flags 'false-if-missing)]
(let* ([d (doc-path dir name flags (hash-ref main-dirs dir #f) 'false-if-missing)]
[p (and d (build-path d "out.sxref"))])
(and p (file-exists? p) p))))))

4 doc/release-notes/racket/HISTORY.txt
View file
@@ -1,3 +1,7 @@
Version 5.1.3.4
Add support for the collection links file, including
(find-system-path 'links-file) and the raco link command

Version 5.1.3.3
unsafe/ffi: added support for C arrays and unions

38 src/racket/cmdline.inc
View file
@@ -556,6 +556,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
char *prog, *sprog = NULL;
Scheme_Object *sch_argv;
Scheme_Object *collects_path = NULL, *collects_extra = NULL, *addon_dir = NULL;
Scheme_Object *links_file = NULL;
#ifndef NO_FILE_SYSTEM_UTILS
Scheme_Object *collects_paths_l, *collects_paths_r;
#endif
@@ -804,6 +805,8 @@ static int run_from_cmd_line(int argc, char *_argv[],
argv[0] = "-S";
else if (!strcmp("--addon", argv[0]))
argv[0] = "-A";
else if (!strcmp("--links", argv[0]))
argv[0] = "-C";
# ifdef CMDLINE_STDIO_FLAG
else if (!strcmp("--stdio", argv[0]))
argv[0] = "-z";
@@ -860,6 +863,17 @@ static int run_from_cmd_line(int argc, char *_argv[],
addon_dir = scheme_make_path(argv[0]);
was_config_flag = 1;
break;
case 'C':
if (argc < 2) {
PRINTF("%s: missing path after %s switch\n",
prog, real_switch);
goto show_need_help;
}
argv++;
--argc;
links_file = scheme_make_path(argv[0]);
was_config_flag = 1;
break;
case 'U':
scheme_set_ignore_user_paths(1);
was_config_flag = 1;
@@ -1204,7 +1218,28 @@ static int run_from_cmd_line(int argc, char *_argv[],
}
}
# endif
if (addon_dir) scheme_set_addon_dir(addon_dir);
if (addon_dir) {
addon_dir = scheme_path_to_complete_path(addon_dir, NULL);
scheme_set_addon_dir(addon_dir);
}
#endif /* NO_FILE_SYSTEM_UTILS */

#ifndef NO_FILE_SYSTEM_UTILS
/* Setup path for "links" file: */
# ifdef GETENV_FUNCTION
if (!links_file) {
char *s;
s = getenv("PLTLINKSFILE");
if (s) {
s = scheme_expand_filename(s, -1, NULL, NULL, 0);
if (s) links_file = scheme_make_path(s);
}
}
# endif
if (links_file) {
links_file = scheme_path_to_complete_path(links_file, NULL);
scheme_set_links_file(links_file);
}
#endif /* NO_FILE_SYSTEM_UTILS */

/* Creates the main kernel environment */
@@ -1292,6 +1327,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
" -X <dir>, --collects <dir> : Main collects at <dir>\n"
" -S <dir>, --search <dir> : More collects at <dir> (after main collects)\n"
" -A <dir>, --addon <dir> : Addon directory at <dir>\n"
" -K <file>, --links <file> : Collection links at <file>\n"
" -U, --no-user-path : Ignore user-specific collects, etc.\n"
" -N <file>, --name <file> : Sets `(find-system-path 'run-file)' to <file>\n"
# ifdef MZ_USE_JIT
1 src/racket/include/scheme.h
View file
@@ -1801,6 +1801,7 @@ MZ_EXTERN Scheme_Object *scheme_set_run_cmd(char *s);
MZ_EXTERN void scheme_set_collects_path(Scheme_Object *p);
MZ_EXTERN void scheme_set_original_dir(Scheme_Object *d);
MZ_EXTERN void scheme_set_addon_dir(Scheme_Object *p);
MZ_EXTERN void scheme_set_links_file(Scheme_Object *p);
MZ_EXTERN void scheme_set_command_line_arguments(Scheme_Object *vec);
MZ_EXTERN void scheme_set_compiled_file_paths(Scheme_Object *list);

2 src/racket/include/schthread.h
View file
@@ -273,6 +273,7 @@ typedef struct Thread_Local_Variables {
int env_uid_counter_;
int scheme_overflow_count_;
struct Scheme_Object *original_pwd_;
struct Scheme_Object *inst_links_path_;
void *file_path_wc_buffer_;
intptr_t scheme_hash_request_count_;
intptr_t scheme_hash_iteration_count_;
@@ -605,6 +606,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
#define env_uid_counter XOA (scheme_get_thread_local_variables()->env_uid_counter_)
#define scheme_overflow_count XOA (scheme_get_thread_local_variables()->scheme_overflow_count_)
#define original_pwd XOA (scheme_get_thread_local_variables()->original_pwd_)
#define inst_links_path XOA (scheme_get_thread_local_variables()->inst_links_path_)
#define file_path_wc_buffer XOA (scheme_get_thread_local_variables()->file_path_wc_buffer_)
#define scheme_hash_request_count XOA (scheme_get_thread_local_variables()->scheme_hash_request_count_)
#define scheme_hash_iteration_count XOA (scheme_get_thread_local_variables()->scheme_hash_iteration_count_)
910 src/racket/src/cstartup.inc
View file

Large diffs are not rendered by default.

50 src/racket/src/file.c
View file
@@ -227,12 +227,15 @@ READ_ONLY static Scheme_Object *doc_dir_symbol, *desk_dir_symbol;
READ_ONLY static Scheme_Object *init_dir_symbol, *init_file_symbol, *sys_dir_symbol;
READ_ONLY static Scheme_Object *exec_file_symbol, *run_file_symbol, *collects_dir_symbol;
READ_ONLY static Scheme_Object *pref_file_symbol, *orig_dir_symbol, *addon_dir_symbol;
READ_ONLY static Scheme_Object *links_file_symbol;

SHARED_OK static Scheme_Object *exec_cmd;
SHARED_OK static Scheme_Object *run_cmd;
SHARED_OK static Scheme_Object *collects_path;
THREAD_LOCAL_DECL(static Scheme_Object *original_pwd);
SHARED_OK static Scheme_Object *addon_dir;
SHARED_OK static Scheme_Object *links_file;
THREAD_LOCAL_DECL(static Scheme_Object *inst_links_path);

#endif
READ_ONLY static Scheme_Object *windows_symbol, *unix_symbol;
@@ -275,6 +278,7 @@ void scheme_init_file(Scheme_Env *env)
REGISTER_SO(collects_dir_symbol);
REGISTER_SO(orig_dir_symbol);
REGISTER_SO(addon_dir_symbol);
REGISTER_SO(links_file_symbol);
#endif
REGISTER_SO(windows_symbol);
REGISTER_SO(unix_symbol);
@@ -302,6 +306,7 @@ void scheme_init_file(Scheme_Env *env)
collects_dir_symbol = scheme_intern_symbol("collects-dir");
orig_dir_symbol = scheme_intern_symbol("orig-dir");
addon_dir_symbol = scheme_intern_symbol("addon-dir");
links_file_symbol = scheme_intern_symbol("links-file");
#endif

windows_symbol = scheme_intern_symbol("windows");
@@ -5826,7 +5831,8 @@ enum {
id_init_dir,
id_init_file,
id_sys_dir,
id_addon_dir
id_addon_dir,
id_links_file
};

Scheme_Object *scheme_get_run_cmd(void)
@@ -5877,6 +5883,15 @@ find_system_path(int argc, Scheme_Object **argv)
} else if (argv[0] == addon_dir_symbol) {
if (addon_dir) return addon_dir;
which = id_addon_dir;
} else if (argv[0] == links_file_symbol) {
if (links_file) return links_file;
if (addon_dir) {
Scheme_Object *pa[2];
pa[0] = addon_dir;
pa[1] = scheme_make_path("links.rktd");
return scheme_build_path(2, pa);
}
which = id_links_file;
} else {
scheme_wrong_type("find-system-path", "system-path-symbol",
0, argc, argv);
@@ -5919,9 +5934,11 @@ find_system_path(int argc, Scheme_Object **argv)

if ((which == id_pref_dir)
|| (which == id_pref_file)
|| (which == id_addon_dir)) {
|| (which == id_addon_dir)
|| (which == id_links_file)) {
#if defined(OS_X) && !defined(XONX)
if (which == id_addon_dir)
if ((which == id_addon_dir)
|| (which == id_links_file))
home_str = "~/Library/Racket/";
else
home_str = "~/Library/Preferences/";
@@ -5968,6 +5985,8 @@ find_system_path(int argc, Scheme_Object **argv)
return append_path(home, scheme_make_path("/racket-prefs.rktd" + ends_in_slash));
#endif
}
if (which == id_links_file)
return append_path(home, scheme_make_path("/links.rktd" + ends_in_slash));
}
#endif

@@ -6005,7 +6024,8 @@ find_system_path(int argc, Scheme_Object **argv)

if ((which == id_addon_dir)
|| (which == id_pref_dir)
|| (which == id_pref_file))
|| (which == id_pref_file)
|| (which == id_links_file))
which_folder = CSIDL_APPDATA;
else if (which == id_doc_dir) {
# ifndef CSIDL_PERSONAL
@@ -6109,6 +6129,8 @@ find_system_path(int argc, Scheme_Object **argv)
return append_path(home, scheme_make_path("\\racketrc.rktl" + ends_in_slash));
if (which == id_pref_file)
return append_path(home, scheme_make_path("\\racket-prefs.rktd" + ends_in_slash));
if (which == id_links_file)
return append_path(home, scheme_make_path("\\links.rktd" + ends_in_slash));
return home;
}
#endif
@@ -6177,6 +6199,26 @@ void scheme_set_addon_dir(Scheme_Object *p)
addon_dir = p;
}

/* should only called from main */
void scheme_set_links_file(Scheme_Object *p)
{
if (!links_file) {
REGISTER_SO(links_file);
}
links_file = p;
}

Scheme_Object *scheme_find_links_path(int argc, Scheme_Object *argv[])
{
if (inst_links_path)
return inst_links_path;

REGISTER_SO(inst_links_path);
inst_links_path = scheme_apply(argv[0], 0, NULL);

return inst_links_path;
}

/********************************************************************************/

#ifdef DOS_FILE_SYSTEM
2 src/racket/src/schpriv.h
View file
@@ -3358,6 +3358,8 @@ Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, intptr_t fd, char *pa

Scheme_Object *scheme_extract_relative_to(Scheme_Object *obj, Scheme_Object *dir);

Scheme_Object *scheme_find_links_path(int argc, Scheme_Object *argv[]);

#ifdef DOS_FILE_SYSTEM
# define WIDE_PATH(s) scheme_convert_to_wchar(s, 0)
# define WIDE_PATH_COPY(s) scheme_convert_to_wchar(s, 1)
4 src/racket/src/schvers.h
View file
@@ -13,12 +13,12 @@
consistently.)
*/

#define MZSCHEME_VERSION "5.1.3.3"
#define MZSCHEME_VERSION "5.1.3.5"

#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 1
#define MZSCHEME_VERSION_Z 3
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_W 5

#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
349 src/racket/src/startup.inc
View file
@@ -133,7 +133,7 @@
);
EVAL_ONE_STR(
"(module #%utils '#%kernel"
"(#%require '#%min-stx)"
"(#%require '#%min-stx '#%paramz)"
"(#%provide path-string?"
" normal-case-path"
" path-replace-suffix"
@@ -178,6 +178,83 @@
" 'windows)))))"
"((string? s)(string->path s))"
"(else s))))"
"(define-values(find-executable-path)"
"(case-lambda "
"((program libpath reverse?)"
"(unless(path-string? program) "
" (raise-type-error 'find-executable-path \"path or string (sans nul)\" program))"
"(unless(or(not libpath)(and(path-string? libpath) "
"(relative-path? libpath)))"
" (raise-type-error 'find-executable-path \"#f or relative path or string\" libpath))"
"(letrec((found-exec"
"(lambda(exec-name)"
"(if libpath"
"(let-values(((base name isdir?)(split-path exec-name)))"
"(let((next"
"(lambda()"
"(let((resolved(resolve-path exec-name)))"
"(cond"
"((equal? resolved exec-name) #f)"
"((relative-path? resolved)"
"(found-exec(build-path base resolved)))"
"(else(found-exec resolved)))))))"
"(or(and reverse?(next))"
"(if(path? base)"
"(let((lib(build-path base libpath)))"
"(and(or(directory-exists? lib) "
"(file-exists? lib))"
" lib))"
" #f)"
"(and(not reverse?)(next)))))"
" exec-name))))"
"(if(and(relative-path? program)"
"(let-values(((base name dir?)(split-path program)))"
"(eq? base 'relative)))"
" (let ((paths-str (getenv \"PATH\"))"
"(win-add(lambda(s)(if(eq?(system-type) 'windows) "
" (cons (bytes->path #\".\") s) "
" s))))"
"(let loop((paths(if paths-str "
"(win-add(path-list-string->path-list paths-str null))"
" null)))"
"(if(null? paths)"
" #f"
"(let*((base(path->complete-path(car paths)))"
"(name(build-path base program)))"
"(if(file-exists? name)"
"(found-exec name)"
"(loop(cdr paths)))))))"
"(let((p(path->complete-path program)))"
"(and(file-exists? p)(found-exec p))))))"
"((program libpath)(find-executable-path program libpath #f))"
"((program)(find-executable-path program #f #f))))"
"(define-values(path-list-string->path-list)"
"(let((r(byte-regexp(string->bytes/utf-8"
"(let((sep(if(eq?(system-type) 'windows)"
" \";\"\n"
" \":\")))"
" (format \"([^~a]*)~a(.*)\" sep sep)))))"
"(cons-path(lambda(default s l) "
" (if (bytes=? s #\"\")"
"(append default l)"
"(cons(bytes->path(if(eq?(system-type) 'windows)"
" (regexp-replace* #rx#\"\\\"\" s #\"\")"
" s))"
" l)))))"
"(lambda(s default)"
"(unless(or(bytes? s)"
"(string? s))"
" (raise-type-error 'path-list-string->path-list \"byte string or string\" s))"
"(unless(and(list? default)"
"(andmap path? default))"
" (raise-type-error 'path-list-string->path-list \"list of paths\" default))"
"(let loop((s(if(string? s)"
"(string->bytes/utf-8 s)"
" s)))"
"(let((m(regexp-match r s)))"
"(if m"
"(cons-path default(cadr m)(loop(caddr m)))"
"(cons-path default s null)))))))"
"(define-values(-check-relpath)"
"(lambda(who s)"
"(unless(path-string? s)"
@@ -210,23 +287,196 @@
" collection collection-path"
" file-name)"
" file-name)))"
"(define-values(user-links-path)(find-system-path 'links-file))"
"(define-values(user-links-cache)(make-hasheq))"
"(define-values(user-links-timestamp) -inf.0)"
"(define-values(links-path)(find-links-path!"
"(lambda()"
"(let((d(let((c(find-system-path 'collects-dir)))"
"(if(absolute-path? c)"
" c"
"(parameterize((current-directory(find-system-path 'orig-dir)))"
"(find-executable-path(find-system-path 'exec-file) c))))))"
"(and d"
" (build-path d \"config\" \"links.rktd\"))))))"
"(define-values(links-cache)(make-hasheq))"
"(define-values(links-timestamp) -inf.0)"
"(define-values(get-linked-collections)"
"(lambda(user?)"
"(call/ec(lambda(esc)"
"(define-values(make-handler)"
"(lambda(ts)"
"(lambda(exn)"
"(let((l(current-logger)))"
"(when(log-level? l 'error)"
"(log-message l 'error "
"(format"
" \"error reading linked collections: ~a\""
"(exn-message exn))"
"(current-continuation-marks))))"
"(when ts"
"(if user?"
"(begin"
"(set! user-links-cache(make-hasheq))"
"(set! user-links-timestamp ts))"
"(begin"
"(set! links-cache(make-hasheq))"
"(set! links-timestamp ts))))"
"(esc(make-hasheq)))))"
"(with-continuation-mark"
" exception-handler-key"
"(make-handler #f)"
"(let((ts(file-or-directory-modify-seconds(if user?"
" user-links-path"
" links-path)"
" #f "
"(lambda() -inf.0))))"
"(if(ts . > .(if user? user-links-timestamp links-timestamp))"
"(with-continuation-mark"
" exception-handler-key"
"(make-handler ts)"
"(parameterize((read-case-sensitive #t)"
"(read-square-bracket-as-paren #t)"
"(read-curly-brace-as-paren #t)"
"(read-accept-box #t)"
"(read-accept-compiled #t)"
"(read-accept-bar-quote #t)"
"(read-accept-graph #t)"
"(read-decimal-as-inexact #t)"
"(read-accept-dot #t)"
"(read-accept-infix-dot #t)"
"(read-accept-quasiquote #t)"
"(read-accept-reader #t)"
"(read-accept-lang #f)"
"(current-readtable #f))"
"(let((v(let((p(open-input-file(if user? user-links-path links-path)"
" 'binary)))"
"(dynamic-wind"
" void"
"(lambda() "
"(begin0"
"(read p)"
"(unless(eof-object?(read p))"
" (error \"expected a single S-expression\"))))"
"(lambda()(close-input-port p))))))"
"(unless(and(list? v)"
"(andmap(lambda(p)"
"(and(list? p)"
"(or(= 2(length p))"
"(= 3(length p)))"
"(string?(car p))"
"(path-string?(cadr p))"
"(or(null?(cddr p))"
"(regexp?(caddr p)))))"
" v))"
" (error \"ill-formed content\"))"
"(let((ht(make-hasheq))"
"(dir(let-values(((base name dir?)(split-path(if user?"
" user-links-path"
" links-path))))"
" base)))"
"(for-each"
"(lambda(p)"
"(when(or(null?(cddr p))"
"(regexp-match?(caddr p)(version)))"
"(let((s(string->symbol(car p))))"
"(hash-set! ht s(cons(box(path->complete-path(cadr p) dir))"
"(hash-ref ht s null))))))"
" v)"
"(if user?"
"(begin"
"(set! user-links-cache ht)"
"(set! user-links-timestamp ts))"
"(begin"
"(set! links-cache ht)"
"(set! links-timestamp ts)))"
" ht))))"
"(if user?"
" user-links-cache"
" links-cache))))))))"
"(define-values(normalize-collection-reference)"
"(lambda(collection collection-path)"
"(cond"
"((string? collection)"
" (let ((m (regexp-match-positions #rx\"/+\" collection)))"
"(if m"
"(cond"
"((=(caar m)(sub1(string-length collection)))"
"(values(substring collection 0(caar m)) collection-path))"
"(else"
"(values(substring collection 0(caar m))"
"(cons(substring collection(cdar m))"
" collection-path))))"
"(values collection collection-path))))"
"(else"
"(let-values(((base name dir?)(split-path collection)))"
"(if(eq? base 'relative)"
"(values name collection-path)"
"(normalize-collection-reference base(cons name collection-path))))))))"
"(define-values(find-col-file)"
"(lambda(who fail collection collection-path file-name)"
"(let((all-paths(current-library-collection-paths)))"
"(let-values(((collection collection-path)"
"(normalize-collection-reference collection collection-path)))"
"(let((all-paths(let((sym(string->symbol(if(path? collection)"
"(path->string collection)"
" collection))))"
"(append"
"(if(use-user-specific-search-paths)"
"(hash-ref(get-linked-collections #t) sym null)"
" null)"
"(if links-path"
"(hash-ref(get-linked-collections #f) sym null)"
" null)"
"(current-library-collection-paths)))))"
"(define-values(*build-path-rep)"
"(lambda(p c)"
"(if(path? p)"
"(build-path p c)"
"(unbox p))))"
"(define-values(*directory-exists?)"
"(lambda(orig p)"
"(if(path? orig)"
"(directory-exists? p)"
" #t)))"
"(define-values(to-string)(lambda(p)(if(path? p)(path->string p) p)))"
"(let cloop((paths all-paths)(found-col #f))"
"(if(null? paths)"
"(if found-col"
" found-col"
"(let((rest-coll"
"(if(null? collection-path)"
" \"\""
"(apply"
" string-append"
"(let loop((cp collection-path))"
"(if(null?(cdr cp))"
"(list(to-string(car cp)))"
" (list* (to-string (car cp)) \"/\" (loop (cdr cp)))))))))"
"(define-values(filter)"
"(lambda(f l)"
"(if(null? l)"
" null"
"(if(f(car l))"
"(cons(car l)(filter f(cdr l)))"
"(filter f(cdr l))))))"
"(fail"
" (format \"~a: collection not found: ~s in any of: ~s\" "
" who(if(null? collection-path)"
" collection"
"(apply build-path collection collection-path))"
" all-paths)))"
"(let((dir(build-path(car paths) collection)))"
"(if(directory-exists? dir)"
" (format \"~a: collection not found: ~s in any of: ~s~a\" "
" who"
"(if(null? collection-path)"
"(to-string collection)"
" (string-append (to-string collection) \"/\" rest-coll))"
"(filter path? all-paths)"
"(if(ormap box? all-paths)"
" (format \" or: ~s in any of: ~s\" "
" rest-coll "
"(map unbox(filter box? all-paths)))"
" \"\")))))"
"(let((dir(*build-path-rep(car paths) collection)))"
"(if(*directory-exists?(car paths) dir)"
"(let((cpath(apply build-path dir collection-path)))"
"(if(directory-exists? cpath)"
"(if(if(null? collection-path)"
" #t"
"(directory-exists? cpath))"
"(if file-name"
"(if(or(file-exists?(build-path cpath file-name))"
"(let((alt-file-name"
@@ -243,7 +493,7 @@
"(cloop(cdr paths)(or found-col cpath)))"
" cpath)"
"(cloop(cdr paths) found-col)))"
"(cloop(cdr paths) found-col))))))))"
"(cloop(cdr paths) found-col)))))))))"
"(define-values(check-suffix-call)"
"(lambda(s sfx who)"
"(unless(or(path-for-some-system? s)"
@@ -324,83 +574,6 @@
"(cons(simplify-path(path->complete-path v(current-directory)))"
"(loop(cdr l)))"
"(loop(cdr l))))))))))))"
"(define-values(path-list-string->path-list)"
"(let((r(byte-regexp(string->bytes/utf-8"
"(let((sep(if(eq?(system-type) 'windows)"
" \";\"\n"
" \":\")))"
" (format \"([^~a]*)~a(.*)\" sep sep)))))"
"(cons-path(lambda(default s l) "
" (if (bytes=? s #\"\")"
"(append default l)"
"(cons(bytes->path(if(eq?(system-type) 'windows)"
" (regexp-replace* #rx#\"\\\"\" s #\"\")"
" s))"
" l)))))"
"(lambda(s default)"
"(unless(or(bytes? s)"
"(string? s))"
" (raise-type-error 'path-list-string->path-list \"byte string or string\" s))"
"(unless(and(list? default)"
"(andmap path? default))"
" (raise-type-error 'path-list-string->path-list \"list of paths\" default))"
"(let loop((s(if(string? s)"
"(string->bytes/utf-8 s)"
" s)))"
"(let((m(regexp-match r s)))"
"(if m"
"(cons-path default(cadr m)(loop(caddr m)))"
"(cons-path default s null)))))))"
"(define-values(find-executable-path)"
"(case-lambda "
"((program libpath reverse?)"
"(unless(path-string? program) "
" (raise-type-error 'find-executable-path \"path or string (sans nul)\" program))"
"(unless(or(not libpath)(and(path-string? libpath) "
"(relative-path? libpath)))"
" (raise-type-error 'find-executable-path \"#f or relative path or string\" libpath))"
"(letrec((found-exec"
"(lambda(exec-name)"
"(if libpath"
"(let-values(((base name isdir?)(split-path exec-name)))"
"(let((next"
"(lambda()"
"(let((resolved(resolve-path exec-name)))"
"(cond"
"((equal? resolved exec-name) #f)"
"((relative-path? resolved)"
"(found-exec(build-path base resolved)))"
"(else(found-exec resolved)))))))"
"(or(and reverse?(next))"
"(if(path? base)"
"(let((lib(build-path base libpath)))"
"(and(or(directory-exists? lib) "
"(file-exists? lib))"
" lib))"
" #f)"
"(and(not reverse?)(next)))))"
" exec-name))))"
"(if(and(relative-path? program)"
"(let-values(((base name dir?)(split-path program)))"
"(eq? base 'relative)))"
" (let ((paths-str (getenv \"PATH\"))"
"(win-add(lambda(s)(if(eq?(system-type) 'windows) "
" (cons (bytes->path #\".\") s) "
" s))))"
"(let loop((paths(if paths-str "
"(win-add(path-list-string->path-list paths-str null))"
" null)))"
"(if(null? paths)"
" #f"
"(let*((base(path->complete-path(car paths)))"
"(name(build-path base program)))"
"(if(file-exists? name)"
"(found-exec name)"
"(loop(cdr paths)))))))"
"(let((p(path->complete-path program)))"
"(and(file-exists? p)(found-exec p))))))"
"((program libpath)(find-executable-path program libpath #f))"
"((program)(find-executable-path program #f #f))))"
"(define(embedded-load start end str)"
"(let*((s(if str"
" str"
423 src/racket/src/startup.rktl
View file

Large diffs are not rendered by default.

1 src/racket/src/thread.c
View file
@@ -636,6 +636,7 @@ void scheme_init_paramz(Scheme_Env *env)
GLOBAL_PRIM_W_ARITY("check-for-break" , check_break_now , 0, 0, newenv);
GLOBAL_PRIM_W_ARITY("reparameterize" , reparameterize , 1, 1, newenv);
GLOBAL_PRIM_W_ARITY("make-custodian-from-main", make_custodian_from_main, 0, 0, newenv);
GLOBAL_PRIM_W_ARITY("find-links-path!" , scheme_find_links_path , 1, 1, newenv);

scheme_finish_primitive_module(newenv);
scheme_protect_primitive_provide(newenv, NULL);