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

raco link: "user" versus "shared" links

Browse Source 
By default, `raco link' is now more like `raco pkg' in terms of scope,
and version-specific information doesn't pile up in a user's "links.rktd"
file.
This commit is contained in:
Matthew Flatt 2013-06-25 14:03:23 +02:00
parent d8a297620b
commit 2aed2138a6
21 changed files with 915 additions and 873 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,19 +1,23 @@
#lang scribble/doc
@(require scribble/manual
(for-label racket/base
racket/contract))
racket/contract
setup/dirs))
@title[#:tag "config-file"]{Installation Configuration and Search Paths}
A configuration directory path is built into the Racket executable as
selected at install time. Use @racket[find-system-path 'config-dir] to
locate the configuration directory.
A configuration-directory path is built into the Racket executable as
selected at install time, or its location can be changed via the
@envvar{PLTCONFIGDIR} directory or @DFlag{config}/@Flag{G}
command-line flag. Use @racket[find-config-dir] to locate the
configuration directory.
Other directories and attributes of an installation can be configured
through files in the configuration directory. Instead of trying to
read configuraion files directly, however, use the
@racketmodname[setup/dirs] library, which combines information from
the configuration files and other sources.
Modify the @filepath{config.rktd} file as described below to configure
other directories, but use the @racketmodname[setup/dirs] library (which
combines information from the configuration files and other sources)
to locate configured directories.
A @filepath{config.rktd} file in the configuration directory should
contain a @racket[read]able hash table with any of the following

35
pkgs/racket-pkgs/racket-doc/scribblings/raco/link.scrbl
View File

@ -23,7 +23,7 @@ For example, the command
@commandline{raco link maze}
installs a user-specific link for the @racket["maze"] collection,
installs a user-specific and version-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:
@ -55,9 +55,9 @@ Full command-line options:
any other command-line arguments are provided that modify the
link table, the table is shown after modifications. If no
directory arguments are provided, and if none of @Flag{u},
@DFlag{user}, @Flag{i}, @DFlag{installation}, @Flag{f}, or
@DFlag{user}, @Flag{s}, @DFlag{shared}, @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
all user-specific and installation-wide @tech[#:doc
reference-doc]{collection links files}.}
@item{@Flag{n} @nonterm{name} or @DFlag{name} @nonterm{name} --- Sets
@ -80,7 +80,8 @@ Full command-line options:
@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}
@racket[version]) matching @nonterm{regexp}. This flag
is normally used with @Flag{s} or @DFlag{shared}. When the @Flag{r}
or @DFlag{remove} flag is also used, only links with a
version regexp matching @nonterm{regexp} are removed.}
@ -88,24 +89,31 @@ Full command-line options:
of add mode.}
@item{@Flag{u} or @DFlag{user} --- Limits listing and removal
of links to the user-specific @tech[#:doc
reference-doc]{collection links file} and not the
of links to the user- and version-specific @tech[#:doc
reference-doc]{collection links file} and not the all-version or
collection-wide @tech[#:doc reference-doc]{collection links
file}. This flag is mutually exclusive with @Flag{i},
file}. This flag is mutually exclusive with @Flag{s}, @DFlag{shared}, @Flag{i},
@DFlag{installation}, @Flag{f}, and @DFlag{file}.}
@item{@Flag{s} or @DFlag{shared} --- Limits listing and removal
of links to the user-specific, all-version @tech[#:doc
reference-doc]{collection links file} and not the version-specific or
collection-wide @tech[#:doc reference-doc]{collection links
file}. This flag is mutually exclusive with @Flag{u}, @DFlag{user}, @Flag{i},
@DFlag{installation}, @Flag{f}, and @DFlag{file}.}
@item{@Flag{i} or @DFlag{installation} --- Reads and writes links in
installation-wide @tech[#:doc reference-doc]{collection links
file} and not the user-specific @tech[#:doc
reference-doc]{collection links file}. This flag is mutually
exclusive with @Flag{u}, @DFlag{user}, @Flag{f}, and
exclusive with @Flag{u}, @DFlag{user}, @Flag{s}, @DFlag{shared}, @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 mutually exclusive with @Flag{u},
@DFlag{user}, @Flag{i}, and @DFlag{installation}.}
@DFlag{user}, @Flag{s}, @DFlag{shared}, @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
@ -121,6 +129,7 @@ Full command-line options:
@defproc[(links [dir path?] ...
[#:user? user? any/c #t]
[#:shared? shared? any/c #t]
[#:file file (or/c path-string? #f) #f]
[#:name name (or/c string? #f) #f]
[#:root? root? any/c #f]
@ -134,9 +143,11 @@ Full command-line options:
A function version of the @exec{raco link} command that always works
on a single file---either @racket[file] if it is a path string, the
user-specific @tech[#:doc reference-doc]{collection links file} if
@racket[user?] is true, of the installation-wide @tech[#:doc
reference-doc]{collection links file} if @racket[user?] is false.
user- and version-specific @tech[#:doc reference-doc]{collection links file} if
@racket[user?] is true and @racket[shared?] is false, the
user-specific, all-version @tech[#:doc reference-doc]{collection links file} if
@racket[shared?] is true, or the installation-wide @tech[#:doc
reference-doc]{collection links file} otherwise.
The @racket[error-proc] argument is called to raise exceptions that
would be fatal to the @exec{raco link} command.

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

@ -917,6 +917,11 @@ v
which means that this result is not sensitive to the value of the
@racket[use-user-specific-search-paths] parameter.}
@defproc[(find-config-dir) path?]{
Returns a path to the installation's @filepath{etc} directory, which
contains configuration and package information---including
configuration of some of the other directories (see @secref["config-file"]).}
@defproc[(find-doc-dir) (or/c path? #f)]{
Returns a path to the installation's @filepath{doc} directory.
The result is @racket[#f] if no such directory is available.}

32
pkgs/racket-pkgs/racket-doc/scribblings/reference/collects.scrbl
View File

@ -1,5 +1,6 @@
#lang scribble/doc
@(require "mz.rkt")
@(require "mz.rkt"
(for-label setup/dirs))
@title[#:tag "collects"]{Libraries and Collections}
@ -63,11 +64,11 @@ 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 content of @racket[(find-system-path
'links-file)] (if it exists) and the
collections is determined by the content of the @tech{collection links files}
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
@racket[current-library-collection-paths] are 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 link table and
search path is spliced together with the filesystem trees of other
@ -196,20 +197,23 @@ The @deftech{collection links files} are used by
default @tech{module name resolver} to locate collections before
trying the @racket[(current-library-collection-paths)] search
path, but only if the @racket[use-collection-link-paths] parameter is set to
@racket[#t]. Furthermore, a user-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[#t]. Furthermore, a user- and version-specific @tech{collection links file} takes
precedence over a user-specific and all-version @tech{collection links file},
which in turn takes precedence over an installation-wide @tech{collection links file}.
The user-specific @tech{collection links files} are used only if the
@racket[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.
The path of the user- and version-specific @tech{collection links file} is
@racket[(build-path (find-system-path 'addon-dir) (version) "links.rktd")].
The path of the user-specific and all-version @tech{collection links file} is
@racket[(build-path (find-system-path 'addon-dir) "links.rktd")].
The path of the installation-wide @tech{collection links file} is
@racket[(build-path (find-config-dir) "links.rktd")].
Each @tech{collection links file} is cached by Racket, but
the file is re-read if its content changes.
Each @tech{collection links file} is @racket[read] with default reader
A @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 one of the forms @racket[(list _string
_path)], @racket[(list _string _path _regexp)], @racket[(list 'root

24
pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl
View File

@ -85,23 +85,27 @@ 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
@item{@indexed-racket['config-dir] --- a directory for
the installation's configuration, packages, and extensions.
This directory is specified by the
@indexed-envvar{PLTCONFIGDIR} environment variable, and it can be
overridden by the @DFlag{config} or @Flag{G} 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)].}
legal path name, then this directory defaults to an
@filepath{etc} directory relative to the current executable.
If the result of @racket[(find-system-path 'config-dir)] is a
relative path, it is relative to the current executable.
The directory might not exist.}
@item{@indexed-racket['addon-dir] --- a directory for installing
user-specific Racket extensions. This directory is specified by the
@item{@indexed-racket['addon-dir] --- a directory for
user-specific Racket configuration, packages, and extension.
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
legal path name, then this directory defaults to
@filepath{Library/Racket} in the user's home directory on Mac
OS X and @racket['pref-dir] otherwise. This directory might not
OS X and @racket['pref-dir] otherwise. The directory might not
exist.}
@item{@indexed-racket['doc-dir] --- the standard directory for

5
pkgs/racket-pkgs/racket-doc/scribblings/reference/startup.scrbl
View File

@ -285,11 +285,6 @@ flags:
@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

5
pkgs/racket-pkgs/racket-index/setup/scribble.rkt
View File

@ -825,8 +825,6 @@
(or (not can-run?)
;; Need to rebuild if output file is older than input:
(my-time . >= . src-time)
;; Need to rebuild if database is out of sync:
(provides-time . >= . info-out-time)
;; But we can use in/out information if they're already built;
;; this is mostly useful if we interrupt setup-plt after
;; it runs some documents without rendering them:
@ -887,7 +885,8 @@
;; maybe info is up-to-date but not rendered doc:
(not (my-time . >= . src-time))))
#f
#f
;; Need to write if database is out of sync:
(provides-time . < . info-out-time)
vers
#f
#f))))

12
racket/lib/collects/pkg/lib.rkt
View File

@ -130,12 +130,6 @@
(define (pkg-lock-file)
(make-lock-file-name (pkg-db-file)))
(define (link-version-regexp)
(case (current-pkg-scope)
[(installation shared) #f]
[(user) (regexp (regexp-quote (version)))]
[else (error "unknown package scope")]))
(define (make-metadata-namespace)
(make-base-empty-namespace))
@ -593,13 +587,13 @@
(links pkg-dir
#:remove? #t
#:user? (not (eq? (current-pkg-scope) 'installation))
#:version-regexp (link-version-regexp)
#:shared? (eq? (current-pkg-scope) 'shared)
#:root? (not (sc-pkg-info? pi)))]
[_
(links pkg-dir
#:remove? #t
#:user? (not (eq? (current-pkg-scope) 'installation))
#:version-regexp (link-version-regexp)
#:shared? (eq? (current-pkg-scope) 'shared)
#:root? (not (sc-pkg-info? pi)))
(delete-directory/files pkg-dir)]))
@ -1254,7 +1248,7 @@
(links final-pkg-dir
#:name single-collect
#:user? (not (eq? 'installation (current-pkg-scope)))
#:version-regexp (link-version-regexp)
#:shared? (eq? 'shared (current-pkg-scope))
#:root? (not single-collect))
(define this-pkg-info
(if single-collect

13
racket/lib/collects/racket/HISTORY.txt
View File

@ -1,3 +1,16 @@
Version 5.3.900.2
Changed link-file handling to separate "user" and "shared" modes;
removed 'links-file mode for find-system-path, PLTLINKSFILE
environment variable, and -C command-line argument
raco link: -u/--user mode installs a version-specific link,
added -s/--shared for user-specific, all-version links
Added PLTCONFIGDIR
Version 5.3.900.1
Reorganized collections into packages
Added 'config-dir mode for find-system-path
setup/dirs: added find-config-dir
Version 5.3.4.11
Added current-directory-for-user, srcloc->string
Fixed is-a? so that it always signals an error when its second

3
racket/lib/collects/racket/sandbox.rkt
View File

@ -931,7 +931,8 @@
(map cdr (links #:user? #t #:with-path? #t))))
(read-bytecode ,(PLANET-BASE-DIR))
(exists ,(find-system-path 'addon-dir))
(read ,(find-system-path 'links-file))
(read ,(build-path (find-system-path 'addon-dir) "links.rktd"))
(read ,(build-path (find-system-path 'addon-dir) (version) "links.rktd"))
(read ,(build-path (find-config-dir) "links.rktd"))
(read ,(find-lib-dir))
,@(compute-permissions allow-for-require allow-for-load)

28
racket/lib/collects/setup/commands/link.rkt
View File

@ -12,6 +12,7 @@
(define show-mode (make-parameter #f))
(define install-only (make-parameter #f))
(define user-only (make-parameter #f))
(define user-shared (make-parameter #f))
(define link-symbol (string->symbol (short-program+command-name)))
@ -36,8 +37,11 @@
[("-r" "--remove") "Remove links for the specified directories"
(remove-mode #t)]
#:once-any
[("-u" "--user") "Adjust/list user-specific links"
[("-u" "--user") "Adjust/list user-specific, version-specific links"
(user-only #t)]
[("-s" "--shared") "Adjust/list user-specific links"
(user-only #t)
(user-shared #t)]
[("-i" "--installation") "Adjust/list installation-wide links"
(install-only #t)]
[("-f" "--file") file "Select an alternate link file"
@ -54,21 +58,23 @@
(raise-user-error link-symbol
"expected a single directory for `--name' mode"))
(define show-both?
(define show-all?
(and (null? dirs)
(show-mode)
(not (user-only))
(not (user-shared))
(not (install-only))
(not (link-file))))
(when show-both?
(printf "User links:\n"))
(when show-all?
(printf "User-specific, version-specific links:\n"))
(define (go user?)
(define (go user? shared?)
(apply links
dirs
#:root? (root-mode)
#:user? user?
#:shared? shared?
#:file (link-file)
#:name (link-name)
#:version-regexp (link-version)
@ -79,15 +85,21 @@
#:repair? (repair-mode)))
(define l1
(go (not (install-only))))
(go (not (install-only))
(user-shared)))
(define l2
(if (and (not (or (user-only)
(user-shared)
(install-only)))
(remove-mode))
(go #f)
(append
(go #f #f)
(go #t #t))
null))
(when show-both?
(when show-all?
(printf "User-specific, all-version links:\n")
(void (links #:user? #t #:shared? #t #:show? #t))
(printf "Installation links:\n")
(void (links #:user? #f #:show? #t)))

11
racket/lib/collects/setup/dirs.rkt
View File

@ -9,16 +9,7 @@
;; "config"
(define config-dir
(delay (let ([c (find-system-path 'config-dir)])
(if (absolute-path? c)
c
(or (parameterize ([current-directory (find-system-path 'orig-dir)])
(find-executable-path (find-system-path 'exec-file) c))
;; This is a bad configuration, but avoid producing #f:
(begin
(log-error "missing configuration directory: ~a" c)
(path->complete-path (find-system-path 'config-dir)
(find-system-path 'orig-dir))))))))
(delay (complete-path (find-system-path 'config-dir))))
(define (find-config-dir)
(force config-dir))

7
racket/lib/collects/setup/link.rkt
View File

@ -10,6 +10,7 @@
#:file [in-file #f]
#:name [name #f]
#:version-regexp [version-regexp #f]
#:shared? [shared? #f]
#:root? [root? #f]
#:remove? [remove? #f]
#:show? [show? #f]
@ -26,8 +27,10 @@
(check-name name))
(define file (or in-file
(if user?
(find-system-path 'links-file)
(if (or user? shared?)
(if shared?
(build-path (find-system-path 'addon-dir) "links.rktd")
(build-path (find-system-path 'addon-dir) (version) "links.rktd"))
(let ([d (find-config-dir)])
(if d
(build-path d "links.rktd")

27
racket/lib/collects/setup/setup-unit.rkt
View File

@ -340,8 +340,8 @@
(collection-cc! (list collection)
#:info-root cp
#:path (build-path cp collection)
#:main? (equal? cp (find-collects-dir))))
(let ([main-collects (find-collects-dir)])
#:main? (equal? cp main-collects-dir)))
(let ()
(define info-root (find-lib-dir))
(define info-path (build-path info-root "info-cache.rktd"))
(define (cc! col #:path path)
@ -372,15 +372,16 @@
#:info-path info-path
#:info-path-mode 'abs-in-relative
#:omit-root 'dir))
(for ([c+p (in-list (links #:with-path? #t))])
(cc! (list (string->path (car c+p)))
#:path (cdr c+p)))
(for ([cp (in-list (links #:root? #t))]
#:when (directory-exists? cp)
[collection (directory-list cp)]
#:unless (skip-collection-directory? collection)
#:when (directory-exists? (build-path cp collection)))
(cc! (list collection) #:path (build-path cp collection))))
(for ([shared? (in-list '(#t #f))])
(for ([c+p (in-list (links #:shared? shared? #:with-path? #t))])
(cc! (list (string->path (car c+p)))
#:path (cdr c+p)))
(for ([cp (in-list (links #:shared? shared? #:root? #t))]
#:when (directory-exists? cp)
[collection (directory-list cp)]
#:unless (skip-collection-directory? collection)
#:when (directory-exists? (build-path cp collection)))
(cc! (list collection) #:path (build-path cp collection)))))
;; `all-collections' lists all top-level collections (not from Planet):
(define all-collections
@ -841,7 +842,7 @@
(compile-directory-zos dir info
#:omit-root (cc-omit-root cc)
#:managed-compile-zo caching-managed-compile-zo
#:skip-path (and (avoid-main-installation) (find-collects-dir))
#:skip-path (and (avoid-main-installation) main-collects-dir)
#:skip-doc-sources? (not make-docs?))))))
(if (eq? 0 gcs)
0
@ -1025,7 +1026,7 @@
(for ([c (in-list (current-library-collection-paths))])
(when (and (directory-exists? c)
(not (and (avoid-main-installation)
(equal? c (find-collects-dir)))))
(equal? c main-collects-dir))))
(define info-path (build-path c "info-domain" "compiled" "cache.rktd"))
(when (file-exists? info-path)
(get-info-ht c info-path 'relative))))

43
racket/src/racket/cmdline.inc
View File

@ -753,7 +753,6 @@ static int run_from_cmd_line(int argc, char *_argv[],
Scheme_Object *collects_path = NULL, *collects_extra = NULL, *addon_dir = NULL;
Scheme_Object *config_path = NULL;
char *compiled_paths = NULL;
Scheme_Object *links_file = NULL;
#ifndef NO_FILE_SYSTEM_UTILS
Scheme_Object *collects_paths_l, *collects_paths_r;
#endif
@ -1033,8 +1032,6 @@ static int run_from_cmd_line(int argc, char *_argv[],
argv[0] = "-A";
else if (!strcmp("--config", argv[0]))
argv[0] = "-G";
else if (!strcmp("--links", argv[0]))
argv[0] = "-C";
# ifdef CMDLINE_STDIO_FLAG
else if (!strcmp("--stdio", argv[0]))
argv[0] = "-z";
@ -1119,17 +1116,6 @@ static int run_from_cmd_line(int argc, char *_argv[],
addon_dir = check_make_path(prog, real_switch, 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 = check_make_path(prog, real_switch, argv[0]);
was_config_flag = 1;
break;
case 'U':
scheme_set_ignore_user_paths(1);
was_config_flag = 1;
@ -1452,6 +1438,16 @@ static int run_from_cmd_line(int argc, char *_argv[],
}
scheme_set_collects_path(collects_path);
# ifdef GETENV_FUNCTION
if (!config_path) {
char *s;
s = getenv("PLTCONFIGDIR");
if (s) {
s = scheme_expand_filename(s, -1, NULL, NULL, 0);
if (s) config_path = scheme_make_path(s);
}
}
# endif
if (!config_path)
config_path = scheme_make_path(scheme_configdir XFORM_OK_PLUS _configdir_offset);
else
@ -1522,24 +1518,6 @@ static int run_from_cmd_line(int argc, char *_argv[],
}
#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 */
global_env = mk_basic_env();
@ -1633,7 +1611,6 @@ static int run_from_cmd_line(int argc, char *_argv[],
" -G <dir>, --config <dir> : Main configuration directory at <dir>\n"
" -A <dir>, --addon <dir> : Addon directory at <dir>\n"
" -R <paths>, --compiled <paths> : Set compiled-file search roots to <paths>\n"
" -C <file>, --links <file> : User-specific 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 CMDLINE_STDIO_FLAG

1
racket/src/racket/include/scheme.h
View File

@ -1910,7 +1910,6 @@ MZ_EXTERN void scheme_set_collects_path(Scheme_Object *p);
MZ_EXTERN void scheme_set_config_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);
MZ_EXTERN void scheme_set_compiled_file_roots(Scheme_Object *list);

1313
racket/src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

41
racket/src/racket/src/file.c
View File

@ -233,14 +233,13 @@ 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, *config_dir_symbol;
READ_ONLY static Scheme_Object *config_dir_symbol;
SHARED_OK static Scheme_Object *exec_cmd;
SHARED_OK static Scheme_Object *run_cmd;
SHARED_OK static Scheme_Object *collects_path, *config_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
@ -285,7 +284,6 @@ void scheme_init_file(Scheme_Env *env)
REGISTER_SO(config_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);
@ -314,7 +312,6 @@ void scheme_init_file(Scheme_Env *env)
config_dir_symbol = scheme_intern_symbol("config-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");
@ -6072,8 +6069,7 @@ enum {
id_init_dir,
id_init_file,
id_sys_dir,
id_addon_dir,
id_links_file
id_addon_dir
};
Scheme_Object *scheme_get_run_cmd(void)
@ -6129,19 +6125,10 @@ 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_contract("find-system-path",
"(or/c 'home-dir 'pref-dir 'pref-file 'temp-dir\n"
" 'init-dir 'init-file 'links-file 'addon-dir\n"
" 'init-dir 'init-file 'addon-dir\n"
" 'doc-dir 'desk-dir 'sys-dir 'exec-file 'run-file\n"
" 'collects-dir 'config-dir 'orig-dir)",
0, argc, argv);
@ -6184,11 +6171,9 @@ find_system_path(int argc, Scheme_Object **argv)
if ((which == id_pref_dir)
|| (which == id_pref_file)
|| (which == id_addon_dir)
|| (which == id_links_file)) {
|| (which == id_addon_dir)) {
#if defined(OS_X) && !defined(XONX)
if ((which == id_addon_dir)
|| (which == id_links_file))
if (which == id_addon_dir)
home_str = "~/Library/Racket/";
else
home_str = "~/Library/Preferences/";
@ -6235,8 +6220,6 @@ 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
@ -6274,8 +6257,7 @@ find_system_path(int argc, Scheme_Object **argv)
if ((which == id_addon_dir)
|| (which == id_pref_dir)
|| (which == id_pref_file)
|| (which == id_links_file))
|| (which == id_pref_file))
which_folder = CSIDL_APPDATA;
else if (which == id_doc_dir) {
# ifndef CSIDL_PERSONAL
@ -6379,8 +6361,6 @@ 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
@ -6458,15 +6438,6 @@ 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)

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.3.900.1"
#define MZSCHEME_VERSION "5.3.900.2"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 3
#define MZSCHEME_VERSION_Z 900
#define MZSCHEME_VERSION_W 1
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

68
racket/src/racket/src/startup.inc
View File

@ -341,9 +341,15 @@
"(find-col-file fail"
" collection collection-path"
" file-name)))"
"(define-values(user-links-path)(find-system-path 'links-file))"
"(define-values(user-links-path)(build-path(find-system-path 'addon-dir)"
"(version)"
" \"links.rktd\"))"
"(define-values(user-links-cache)(make-hasheq))"
"(define-values(user-links-stamp) #f)"
"(define-values(shared-links-path)(build-path(find-system-path 'addon-dir)"
" \"links.rktd\"))"
"(define-values(shared-links-cache)(make-hasheq))"
"(define-values(shared-links-stamp) #f)"
"(define-values(links-path)(find-links-path!"
"(lambda()"
"(let((d(let((c(find-system-path 'config-dir)))"
@ -386,7 +392,7 @@
" bstr)))"
"(lambda()(close-input-port p)))))))))"
"(define-values(get-linked-collections)"
"(lambda(user?)"
"(lambda(user? shared?)"
"(call/ec(lambda(esc)"
"(define-values(make-handler)"
"(lambda(ts)"
@ -397,16 +403,22 @@
"(log-message l 'error "
"(format"
" \"error reading collection links file ~s: ~a\""
"(if user? user-links-path links-path)"
"(cond"
"(user? user-links-path)"
"(shared? shared-links-path)"
"(else links-path))"
"(exn-message exn))"
"(current-continuation-marks))))"
"(void))"
"(when ts"
"(if user?"
"(begin"
"(cond"
"(user?"
"(set! user-links-cache(make-hasheq))"
"(set! user-links-stamp ts))"
"(begin"
"(shared?"
"(set! shared-links-cache(make-hasheq))"
"(set! shared-links-stamp ts))"
"(else"
"(set! links-cache(make-hasheq))"
"(set! links-stamp ts))))"
"(if(exn:fail? exn)"
@ -415,10 +427,15 @@
"(with-continuation-mark"
" exception-handler-key"
"(make-handler #f)"
"(let((ts(file->stamp(if user?"
" user-links-path"
" links-path))))"
"(if(not(equal? ts(if user? user-links-stamp links-stamp)))"
"(let*((a-links-path(cond"
"(user? user-links-path)"
"(shared? shared-links-path)"
"(else links-path)))"
"(ts(file->stamp a-links-path)))"
"(if(not(equal? ts(cond"
"(user? user-links-stamp)"
"(shared? shared-links-stamp)"
"(else links-stamp))))"
"(with-continuation-mark"
" exception-handler-key"
"(make-handler ts)"
@ -436,8 +453,7 @@
"(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)))"
"(let((v(let((p(open-input-file a-links-path 'binary)))"
"(dynamic-wind"
" void"
"(lambda() "
@ -459,9 +475,7 @@
" v))"
" (error \"ill-formed content\"))"
"(let((ht(make-hasheq))"
"(dir(let-values(((base name dir?)(split-path(if user?"
" user-links-path"
" links-path))))"
"(dir(let-values(((base name dir?)(split-path a-links-path)))"
" base)))"
"(for-each"
"(lambda(p)"
@ -484,17 +498,21 @@
"(hash-for-each"
" ht"
"(lambda(k v)(hash-set! ht k(reverse v))))"
"(if user?"
"(begin"
"(cond"
"(user?"
"(set! user-links-cache ht)"
"(set! user-links-stamp ts))"
"(begin"
"(shared?"
"(set! shared-links-cache ht)"
"(set! shared-links-stamp ts))"
"(else"
"(set! links-cache ht)"
"(set! links-stamp ts)))"
" ht))))"
"(if user?"
" user-links-cache"
" links-cache))))))))"
"(cond"
"(user? user-links-cache)"
"(shared? shared-links-cache)"
"(else links-cache)))))))))"
"(define-values(normalize-collection-reference)"
"(lambda(collection collection-path)"
"(cond"
@ -524,12 +542,16 @@
"(links?(use-collection-link-paths)))"
"(append"
"(if(and links?(use-user-specific-search-paths))"
"(let((ht(get-linked-collections #t)))"
"(append"
"(let((ht(get-linked-collections #t #f)))"
"(append(hash-ref ht sym null)"
"(hash-ref ht #f null)))"
"(let((ht(get-linked-collections #f #t)))"
"(append(hash-ref ht sym null)"
"(hash-ref ht #f null))))"
" null)"
"(if(and links? links-path)"
"(let((ht(get-linked-collections #f)))"
"(let((ht(get-linked-collections #f #f)))"
"(append(hash-ref ht sym null)"
"(hash-ref ht #f null)))"
" null)"

89
racket/src/racket/src/startup.rktl
View File

@ -405,10 +405,17 @@
collection collection-path
file-name)))
(define-values (user-links-path) (find-system-path 'links-file))
(define-values (user-links-path) (build-path (find-system-path 'addon-dir)
(version)
"links.rktd"))
(define-values (user-links-cache) (make-hasheq))
(define-values (user-links-stamp) #f)
(define-values (shared-links-path) (build-path (find-system-path 'addon-dir)
"links.rktd"))
(define-values (shared-links-cache) (make-hasheq))
(define-values (shared-links-stamp) #f)
(define-values (links-path) (find-links-path!
;; This thunk is called once per place, and the result
;; is remembered for later invocations. Otherwise, the
@ -462,7 +469,7 @@
(lambda () (close-input-port p)))))))))
(define-values (get-linked-collections)
(lambda (user?)
(lambda (user? shared?)
(call/ec (lambda (esc)
(define-values (make-handler)
(lambda (ts)
@ -473,18 +480,24 @@
(log-message l 'error
(format
"error reading collection links file ~s: ~a"
(if user? user-links-path links-path)
(cond
[user? user-links-path]
[shared? shared-links-path]
[else links-path])
(exn-message exn))
(current-continuation-marks))))
(void))
(when ts
(if user?
(begin
(set! user-links-cache (make-hasheq))
(set! user-links-stamp ts))
(begin
(set! links-cache (make-hasheq))
(set! links-stamp ts))))
(cond
[user?
(set! user-links-cache (make-hasheq))
(set! user-links-stamp ts)]
[shared?
(set! shared-links-cache (make-hasheq))
(set! shared-links-stamp ts)]
[else
(set! links-cache (make-hasheq))
(set! links-stamp ts)]))
(if (exn:fail? exn)
(esc (make-hasheq))
;; re-raise the exception (which is probably a break)
@ -492,10 +505,15 @@
(with-continuation-mark
exception-handler-key
(make-handler #f)
(let ([ts (file->stamp (if user?
user-links-path
links-path))])
(if (not (equal? ts (if user? user-links-stamp links-stamp)))
(let* ([a-links-path (cond
[user? user-links-path]
[shared? shared-links-path]
[else links-path])]
[ts (file->stamp a-links-path)])
(if (not (equal? ts (cond
[user? user-links-stamp]
[shared? shared-links-stamp]
[else links-stamp])))
(with-continuation-mark
exception-handler-key
(make-handler ts)
@ -513,8 +531,7 @@
[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)])
(let ([v (let ([p (open-input-file a-links-path 'binary)])
(dynamic-wind
void
(lambda ()
@ -536,9 +553,7 @@
v))
(error "ill-formed content"))
(let ([ht (make-hasheq)]
[dir (let-values ([(base name dir?) (split-path (if user?
user-links-path
links-path))])
[dir (let-values ([(base name dir?) (split-path a-links-path)])
base)])
(for-each
(lambda (p)
@ -567,17 +582,21 @@
ht
(lambda (k v) (hash-set! ht k (reverse v))))
;; save table & file content:
(if user?
(begin
(set! user-links-cache ht)
(set! user-links-stamp ts))
(begin
(set! links-cache ht)
(set! links-stamp ts)))
(cond
[user?
(set! user-links-cache ht)
(set! user-links-stamp ts)]
[shared?
(set! shared-links-cache ht)
(set! shared-links-stamp ts)]
[else
(set! links-cache ht)
(set! links-stamp ts)])
ht))))
(if user?
user-links-cache
links-cache))))))))
(cond
[user? user-links-cache]
[shared? shared-links-cache]
[else links-cache]))))))))
(define-values (normalize-collection-reference)
(lambda (collection collection-path)
@ -611,13 +630,17 @@
(append
;; list of paths and (box path)s:
(if (and links? (use-user-specific-search-paths))
(let ([ht (get-linked-collections #t)])
(append (hash-ref ht sym null)
(hash-ref ht #f null)))
(append
(let ([ht (get-linked-collections #t #f)])
(append (hash-ref ht sym null)
(hash-ref ht #f null)))
(let ([ht (get-linked-collections #f #t)])
(append (hash-ref ht sym null)
(hash-ref ht #f null))))
null)
;; list of paths and (box path)s:
(if (and links? links-path)
(let ([ht (get-linked-collections #f)])
(let ([ht (get-linked-collections #f #f)])
(append (hash-ref ht sym null)
(hash-ref ht #f null)))
null)