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

links file and pkg directrory location and search paths in "config.rktd"

Browse Source 
Allow the location of the installation-specific "links.rktd" file to
be specified in "config.rktd", and also allow extra link files to
be provided.

Allow the same for package directories.

The main file/directory in each case corresponds to the file/directory
that can be modified by an installation-scope install. Extra files
or directories in a search path supports constant links and libraries
that are shared across installations --- like "/usr/lib" versus "/lib".
This commit is contained in:
Matthew Flatt 2013-06-25 18:24:00 +02:00
parent 2aed2138a6
commit 1ee88e2721
13 changed files with 1228 additions and 858 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,6 @@
#lang scribble/doc #lang scribble/doc
@(require scribble/manual @(require scribble/manual
"common.rkt"
(for-label racket/base (for-label racket/base
racket/contract racket/contract
setup/dirs)) setup/dirs))
@ -12,8 +13,6 @@ selected at install time, or its location can be changed via the
command-line flag. Use @racket[find-config-dir] to locate the command-line flag. Use @racket[find-config-dir] to locate the
configuration directory. configuration directory.
Modify the @filepath{config.rktd} file as described below to configure Modify the @filepath{config.rktd} file as described below to configure
other directories, but use the @racketmodname[setup/dirs] library (which other directories, but use the @racketmodname[setup/dirs] library (which
combines information from the configuration files and other sources) combines information from the configuration files and other sources)
@ -27,36 +26,49 @@ symbolic keys:
@item{@racket['doc-dir] --- a path, string, or byte string for the @item{@racket['doc-dir] --- a path, string, or byte string for the
main documentation directory. The value defaults to a main documentation directory. The value defaults to a
@filepath{doc} sibling directory of the main collection @filepath{doc} sibling directory of the configuration directory.}
directory's parent.}
@item{@racket['lib-dir] --- a path, string, or byte string for the @item{@racket['lib-dir] --- a path, string, or byte string for the
main library directory; it defaults to the parent of the main main library directory; it defaults to a @filepath{lib} sibling
collection directory.} directory of the configuration directory.}
@item{@racket['lib-search-dirs] --- a list of paths, strings, byte
strings, or @racket[#f] representing the search path for
directories containing foreign libraries; each @racket[#f] in
the list, if any, is replaced with the default search path,
which is the user- and version-specific @filepath{lib}
directory followed by the main library directory.}
@item{@racket['dll-dir] --- a path, string, or byte string for a @item{@racket['dll-dir] --- a path, string, or byte string for a
directory containing Unix shared libraries for the main directory containing Unix shared libraries for the main
executable; it defaults to the main library directory.} executable; it defaults to the main library directory.}
@item{@racket['include-dir] --- a path, string, or byte string for @item{@racket['links-file] --- a path, string, or byte string for the
the main directory containing C header files; it defaults to an @tech[#:doc reference-doc]{collection links file}; it defaults
@filepath{include} sibling directory of the main library to a @filepath{links.rktd} file in the main library directory.}
directory.}
@item{@racket['links-search-files] --- like @racket['lib-search-dirs],
but for @tech[#:doc reference-doc]{collection links file}.}
@item{@racket['pkg-dir] --- a path, string, or byte string for
packages that have installation scope; it defaults to the main
library directory.}
@item{@racket['pkg-search-dirs] --- like @racket['lib-search-dirs],
but for packages in installation scope.}
@item{@racket['bin-dir] --- a path, string, or byte string for the @item{@racket['bin-dir] --- a path, string, or byte string for the
main directory containing executables; it defaults to a main directory containing executables; it defaults to a
@filepath{bin} sibling directory of the main library @filepath{bin} sibling directory of the main library
directory.} directory.}
@item{@racket['doc-search-dirs] --- a path, string, byte string, or @item{@racket['doc-search-dirs] --- like @racket['lib-search-dirs],
@racket[#f] representing the search path for documentation; but for directories containing documentation.}
each @racket[#f] in the list, if any, is replaced with the
default search path, which is the user- and version-specific
@filepath{doc} directory followed by the main documentation
directory.}
@item{@racket['lib-search-dirs] --- like @racket[doc-search-dirs], @item{@racket['include-dir] --- a path, string, or byte string for
but for directories containing foreign libraries.} the main directory containing C header files; it defaults to an
@filepath{include} sibling directory of the main library
directory.}
@item{@racket['include-search-dirs] --- like @item{@racket['include-search-dirs] --- like
@racket[doc-search-dirs], but for directories containing C @racket[doc-search-dirs], but for directories containing C

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

@ -16,6 +16,7 @@
setup/getinfo setup/getinfo
setup/pack setup/pack
setup/unpack setup/unpack
setup/link
compiler/compiler compiler/compiler
launcher/launcher launcher/launcher
compiler/sig compiler/sig
@ -922,6 +923,41 @@ v
contains configuration and package information---including contains configuration and package information---including
configuration of some of the other directories (see @secref["config-file"]).} configuration of some of the other directories (see @secref["config-file"]).}
@defproc[(find-links-file) path?]{
Returns a path to the installation's @tech[#:doc
reference-doc]{collection links file}. The file indicated by the
returned path may or may not exist.}
@defproc[(get-links-search-files) path?]{
Returns a list of paths to installation @tech[#:doc
reference-doc]{collection links files} that are search in
order. (Normally, the result includes the result of
@racket[(find-links-files)], which is where new installation-wide
links are installed by @exec{raco link} or @racket[links].) The
files indicated by the returned paths may or may not exist.}
@defproc[(find-pkg-dir) path?]{
Returns a path to the directory containing packages with
installation scope; the directory indicated by the returned path may
or may not exist.}
@defproc[(find-user-pkg-dir) path?]{
Returns a path to the directory containing packages with
user- and version-specific scope; the directory indicated by
the returned path may or may not exist.}
@defproc[(find-shared-pkg-dir) path?]{
Returns a path to the directory containing packages with
user-specific, all-version scope; the directory indicated by the
returned path may or may not exist.}
@defproc[(get-pkg-search-dirs) (listof path?)]{
Returns a list of paths to the directories containing packages in
installation scope. (Normally, the result includes the result of
@racket[(find-pkg-dir)], which is where new packages are installed
by @exec{raco pkg install}.) The directories indicated by the returned
paths may or may not exist.}
@defproc[(find-doc-dir) (or/c path? #f)]{ @defproc[(find-doc-dir) (or/c path? #f)]{
Returns a path to the installation's @filepath{doc} directory. Returns a path to the installation's @filepath{doc} directory.
The result is @racket[#f] if no such directory is available.} The result is @racket[#f] if no such directory is available.}

32
racket/lib/collects/compiler/compiler-unit.rkt
View File

@ -104,14 +104,14 @@
(define (compile-directory-visitor dir info worker omit-root (define (compile-directory-visitor dir info worker omit-root
#:verbose [verbose? #t] #:verbose [verbose? #t]
#:skip-path [orig-skip-path #f] #:skip-path [orig-skip-path #f]
#:skip-paths [orig-skip-paths null]
#:skip-doc-sources? [skip-docs? #f]) #:skip-doc-sources? [skip-docs? #f])
(define info* (or info (lambda (key mk-default) (mk-default)))) (define info* (or info (lambda (key mk-default) (mk-default))))
(define omit-paths (omitted-paths dir c-get-info/full omit-root)) (define omit-paths (omitted-paths dir c-get-info/full omit-root))
(define skip-path (and orig-skip-path (path->bytes (define skip-paths (for/list ([p (in-list (if orig-skip-path
(simplify-path (if (string? orig-skip-path) (cons orig-skip-path orig-skip-paths)
(string->path orig-skip-path) orig-skip-paths))])
orig-skip-path) (path->bytes (simplify-path p #f))))
#f))))
(unless (eq? 'all omit-paths) (unless (eq? 'all omit-paths)
(let ([init (parameterize ([current-directory dir] (let ([init (parameterize ([current-directory dir]
[current-load-relative-directory dir] [current-load-relative-directory dir]
@ -125,12 +125,13 @@
(lambda (path) ((compile-notify-handler) path))] (lambda (path) ((compile-notify-handler) path))]
[manager-skip-file-handler [manager-skip-file-handler
(lambda (path) (lambda (path)
(and skip-path (and (pair? skip-paths)
(let ([b (path->bytes (simplify-path path #f))] (let ([b (path->bytes (simplify-path path #f))])
[len (bytes-length skip-path)]) (for/or ([skip-path (in-list skip-paths)])
(and ((bytes-length b) . > . len) (let ([len (bytes-length skip-path)])
(bytes=? (subbytes b 0 len) skip-path))) (and ((bytes-length b) . > . len)
(cons -inf.0 "")))]) (bytes=? (subbytes b 0 len) skip-path)
(cons -inf.0 "")))))))])
(let* ([sses (append (let* ([sses (append
;; Find all .rkt/.ss/.scm files: ;; Find all .rkt/.ss/.scm files:
(filter extract-base-filename/ss (directory-list)) (filter extract-base-filename/ss (directory-list))
@ -152,13 +153,15 @@
(if (and (directory-exists? p*) (not (member p omit-paths))) (if (and (directory-exists? p*) (not (member p omit-paths)))
(compile-directory-visitor p* (c-get-info/full p*) worker omit-root (compile-directory-visitor p* (c-get-info/full p*) worker omit-root
#:verbose verbose? #:verbose verbose?
#:skip-path skip-path #:skip-path orig-skip-path
#:skip-paths orig-skip-paths
#:skip-doc-sources? skip-docs?) #:skip-doc-sources? skip-docs?)
init)))) init))))
init)))) init))))
(define (compile-directory dir info (define (compile-directory dir info
#:verbose [verbose? #t] #:verbose [verbose? #t]
#:skip-path [orig-skip-path #f] #:skip-path [orig-skip-path #f]
#:skip-paths [orig-skip-paths null]
#:skip-doc-sources? [skip-docs? #f] #:skip-doc-sources? [skip-docs? #f]
#:managed-compile-zo [managed-compile-zo #:managed-compile-zo [managed-compile-zo
(make-caching-managed-compile-zo)] (make-caching-managed-compile-zo)]
@ -168,11 +171,13 @@
(compile-directory-visitor dir info worker omit-root (compile-directory-visitor dir info worker omit-root
#:verbose verbose? #:verbose verbose?
#:skip-path orig-skip-path #:skip-path orig-skip-path
#:skip-paths orig-skip-paths
#:skip-doc-sources? skip-docs?)) #:skip-doc-sources? skip-docs?))
(define (get-compile-directory-srcs dir info (define (get-compile-directory-srcs dir info
#:verbose [verbose? #t] #:verbose [verbose? #t]
#:skip-path [orig-skip-path #f] #:skip-path [orig-skip-path #f]
#:skip-paths [orig-skip-paths null]
#:skip-doc-sources? [skip-docs? #f] #:skip-doc-sources? [skip-docs? #f]
#:managed-compile-zo [managed-compile-zo #:managed-compile-zo [managed-compile-zo
(make-caching-managed-compile-zo)] (make-caching-managed-compile-zo)]
@ -180,6 +185,7 @@
(compile-directory-visitor dir info append omit-root (compile-directory-visitor dir info append omit-root
#:verbose verbose? #:verbose verbose?
#:skip-path orig-skip-path #:skip-path orig-skip-path
#:skip-paths orig-skip-paths
#:skip-doc-sources? skip-docs? #:skip-doc-sources? skip-docs?
#:managed-compile-zo managed-compile-zo)) #:managed-compile-zo managed-compile-zo))
@ -187,6 +193,7 @@
(define (compile-collection-zos collection (define (compile-collection-zos collection
#:skip-path [skip-path #f] #:skip-path [skip-path #f]
#:skip-paths [skip-paths null]
#:skip-doc-sources? [skip-docs? #f] #:skip-doc-sources? [skip-docs? #f]
#:managed-compile-zo [managed-compile-zo #:managed-compile-zo [managed-compile-zo
(make-caching-managed-compile-zo)] (make-caching-managed-compile-zo)]
@ -200,6 +207,7 @@
omit-root) omit-root)
#:verbose #f #:verbose #f
#:skip-path skip-path #:skip-path skip-path
#:skip-paths skip-paths
#:skip-doc-sources? skip-docs? #:skip-doc-sources? skip-docs?
#:managed-compile-zo managed-compile-zo)) #:managed-compile-zo managed-compile-zo))

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

@ -111,20 +111,17 @@
(λ (ip) (copy-port ip op))))))) (λ (ip) (copy-port ip op)))))))
(define (pkg-dir config?) (define (pkg-dir config?)
(build-path (case (current-pkg-scope) (case (current-pkg-scope)
[(installation) (if config? [(installation) (if config?
(find-config-dir) (find-config-dir)
(find-lib-dir))] (find-pkg-dir))]
[(user) [(user) (find-user-pkg-dir (current-pkg-scope-version))]
(build-path (find-system-path 'addon-dir) (current-pkg-scope-version))] [(shared) (find-shared-pkg-dir)]
[(shared) [else (error "unknown package scope")]))
(find-system-path 'addon-dir)]
[else (error "unknown package scope")])
"pkgs"))
(define (pkg-config-file) (define (pkg-config-file)
(build-path (pkg-dir #t) "config.rktd")) (build-path (pkg-dir #t) "config.rktd"))
(define (pkg-db-file) (define (pkg-db-file)
(build-path (pkg-dir #t) "pkgs.rktd")) (build-path (pkg-dir #f) "pkgs.rktd"))
(define (pkg-installed-dir) (define (pkg-installed-dir)
(pkg-dir #f)) (pkg-dir #f))
(define (pkg-lock-file) (define (pkg-lock-file)
@ -262,7 +259,7 @@
(if (or (eq? mode held-mode) (if (or (eq? mode held-mode)
(eq? 'exclusive held-mode)) (eq? 'exclusive held-mode))
(t) (t)
(let ([d (pkg-dir #t)]) (let ([d (pkg-dir #f)])
(unless read-only? (make-directory* d)) (unless read-only? (make-directory* d))
(if (directory-exists? d) (if (directory-exists? d)
;; If the directory exists, assume that a lock file is ;; If the directory exists, assume that a lock file is
@ -411,15 +408,40 @@
(define (read-pkg-db) (define (read-pkg-db)
(if (current-no-pkg-db) (if (current-no-pkg-db)
#hash() #hash()
(let ([the-db (read-file-hash (pkg-db-file))]) (read-pkg-db-file (pkg-db-file))))
;; compatibility: map 'pnr to 'catalog:
(for/hash ([(k v) (in-hash the-db)]) (define (read-pkg-db-file file)
(values k (let ([the-db (read-file-hash file)])
(if (eq? 'pnr (car (pkg-info-orig-pkg v))) ;; compatibility: map 'pnr to 'catalog:
;; note: legacy 'pnr entry cannot be a single-collection package (for/hash ([(k v) (in-hash the-db)])
(struct-copy pkg-info v (values k
[orig-pkg `(catalog ,(cadr (pkg-info-orig-pkg v)))]) (if (eq? 'pnr (car (pkg-info-orig-pkg v)))
v)))))) ;; note: legacy 'pnr entry cannot be a single-collection package
(struct-copy pkg-info v
[orig-pkg `(catalog ,(cadr (pkg-info-orig-pkg v)))])
v)))))
;; read all packages in this scope or wider
(define (merge-pkg-dbs [scope (current-pkg-scope)])
(define (merge-next-pkg-dbs scope)
(parameterize ([current-pkg-scope scope])
(with-pkg-lock/read-only (merge-pkg-dbs scope))))
(case scope
[(installation)
(for*/hash ([dir (in-list (get-pkg-search-dirs))]
[file (in-value (build-path dir "pkgs.rktd"))]
#:when (file-exists? file)
[(k v) (read-pkg-db-file file)])
(values k v))]
[(shared)
(define db (read-pkg-db))
(for/fold ([ht (merge-next-pkg-dbs 'installation)]) ([(v k) (in-hash db)])
(hash-set ht k v))]
[(user)
(define db (read-pkg-db))
(for/fold ([ht (merge-next-pkg-dbs 'shared)]) ([(v k) (in-hash db)])
(hash-set ht k v))]))
(define (package-info pkg-name [fail? #t]) (define (package-info pkg-name [fail? #t])
(define db (read-pkg-db)) (define db (read-pkg-db))
@ -988,30 +1010,7 @@
descs) descs)
(define download-printf (if quiet? void printf)) (define download-printf (if quiet? void printf))
(define check-sums? (not ignore-checksums?)) (define check-sums? (not ignore-checksums?))
(define db (read-pkg-db)) (define all-db (merge-pkg-dbs))
(define db+with-dbs
(let ([with-sys-wide (lambda (t)
(parameterize ([current-pkg-scope 'installation])
(t)))]
[with-vers-spec (lambda (t)
(parameterize ([current-pkg-scope 'user])
(t)))]
[with-vers-all (lambda (t)
(parameterize ([current-pkg-scope 'shared])
(t)))]
[with-current (lambda (t) (t))])
(case (current-pkg-scope)
[(installation)
(list (cons db with-current))]
[(user)
(list (cons (with-sys-wide read-pkg-db) with-sys-wide)
(cons db with-current)
(cons (with-vers-all read-pkg-db) with-vers-all))]
[(shared)
(list (cons (with-sys-wide read-pkg-db) with-sys-wide)
(cons (with-vers-spec read-pkg-db) with-vers-spec)
(cons db with-current))]
[else (error "unknown package scope")])))
(define (install-package/outer infos desc info) (define (install-package/outer infos desc info)
(match-define (pkg-desc pkg type orig-name auto?) desc) (match-define (pkg-desc pkg type orig-name auto?) desc)
(match-define (match-define
@ -1025,7 +1024,7 @@
(for/hash ([i (in-list infos)]) (for/hash ([i (in-list infos)])
(values (install-info-name i) (install-info-directory i)))) (values (install-info-name i) (install-info-directory i))))
(cond (cond
[(and (not updating?) (package-info pkg-name #f)) [(and (not updating?) (hash-ref all-db pkg-name #f))
(clean!) (clean!)
(pkg-error "package is already installed\n package: ~a" pkg-name)] (pkg-error "package is already installed\n package: ~a" pkg-name)]
[(and [(and
@ -1084,7 +1083,7 @@
(or (equal? name "racket") (or (equal? name "racket")
(not (dependency-this-platform? dep)) (not (dependency-this-platform? dep))
(hash-ref simultaneous-installs name #f) (hash-ref simultaneous-installs name #f)
(hash-has-key? db name))) (hash-has-key? all-db name)))
deps))) deps)))
(and (not (empty? unsatisfied-deps)) (and (not (empty? unsatisfied-deps))
unsatisfied-deps))) unsatisfied-deps)))
@ -1418,28 +1417,45 @@
(define (pkg-show indent #:directory? [dir? #f]) (define (pkg-show indent #:directory? [dir? #f])
(let () (let ()
(define db (read-pkg-db)) (define db (read-pkg-db))
(define pkgs (sort (hash-keys db) string-ci<=?)) (define all-db (if (eq? (current-pkg-scope) 'installation)
(merge-pkg-dbs)
db))
(define has-const? (not (equal? all-db db)))
(define pkgs (sort (hash-keys all-db) string-ci<=?))
(if (null? pkgs) (if (null? pkgs)
(printf " [none]\n") (printf " [none]\n")
(table-display (table-display
(list* (list*
(list* (format "~aPackage[*=auto]" indent) "Checksum" "Source" (append
(if dir? (list (format "~aPackage[*=auto~a]"
(list "Directory") indent
empty)) (if has-const?
"; .=constant"
""))
"Checksum"
"Source")
(if dir?
(list "Directory")
empty))
(for/list ([pkg (in-list pkgs)]) (for/list ([pkg (in-list pkgs)])
(match-define (pkg-info orig-pkg checksum auto?) (hash-ref db pkg)) (match-define (pkg-info orig-pkg checksum auto?) (hash-ref all-db pkg))
(list* (format "~a~a~a" (append
(list (format "~a~a~a~a"
indent indent
pkg pkg
(if auto? (if auto?
"*" "*"
"")) "")
(if (and has-const?
(not (equal? (hash-ref all-db pkg)
(hash-ref db pkg #f))))
"."
""))
(format "~a" checksum) (format "~a" checksum)
(format "~a" orig-pkg) (format "~a" orig-pkg))
(if dir? (if dir?
(list (~a (pkg-directory* pkg))) (list (~a (pkg-directory* pkg)))
empty)))))))) empty))))))))
(define (installed-pkg-table #:scope [given-scope #f]) (define (installed-pkg-table #:scope [given-scope #f])
(parameterize ([current-pkg-scope (parameterize ([current-pkg-scope

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

@ -5,6 +5,10 @@ Changed link-file handling to separate "user" and "shared" modes;
raco link: -u/--user mode installs a version-specific link, raco link: -u/--user mode installs a version-specific link,
added -s/--shared for user-specific, all-version links added -s/--shared for user-specific, all-version links
Added PLTCONFIGDIR Added PLTCONFIGDIR
Added links-file and links-search-dirs to config, enabling
a search path of installation-wide link files
setup/dir: default paths found relative to the config directory,
instead of the main collection directory
Version 5.3.900.1 Version 5.3.900.1
Reorganized collections into packages Reorganized collections into packages

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

@ -1,6 +1,7 @@
#lang scheme/base #lang scheme/base
(require racket/cmdline (require racket/cmdline
raco/command-name raco/command-name
setup/dirs
"../link.rkt") "../link.rkt")
(define link-file (make-parameter #f)) (define link-file (make-parameter #f))
@ -101,7 +102,13 @@
(printf "User-specific, all-version links:\n") (printf "User-specific, all-version links:\n")
(void (links #:user? #t #:shared? #t #:show? #t)) (void (links #:user? #t #:shared? #t #:show? #t))
(printf "Installation links:\n") (printf "Installation links:\n")
(void (links #:user? #f #:show? #t))) (void (links #:user? #f #:show? #t))
(let ([p (filter file-exists?
(remove (find-links-file) (get-links-search-files)))])
(unless (null? p)
(printf "Installation constant links:\n")
(for ([f (in-list p)])
(void (links #:file f #:show? #t))))))
(when (and (remove-mode) (when (and (remove-mode)
(null? l1) (null? l1)

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

@ -56,8 +56,9 @@
(wrap (wrap
(hash-ref (force config-table) key #f))))) (hash-ref (force config-table) key #f)))))
(define-config config:collects-search-dirs 'collects-search-dirs to-path)
(define-config config:doc-dir 'doc-dir to-path) (define-config config:doc-dir 'doc-dir to-path)
(define-config config:doc-search-dirs 'doc-search-dir to-path) (define-config config:doc-search-dirs 'doc-search-dirs to-path)
(define-config config:dll-dir 'dll-dir to-path) (define-config config:dll-dir 'dll-dir to-path)
(define-config config:lib-dir 'lib-dir to-path) (define-config config:lib-dir 'lib-dir to-path)
(define-config config:lib-search-dirs 'lib-search-dirs to-path) (define-config config:lib-search-dirs 'lib-search-dirs to-path)
@ -65,6 +66,10 @@
(define-config config:include-search-dirs 'include-search-dirs to-path) (define-config config:include-search-dirs 'include-search-dirs to-path)
(define-config config:bin-dir 'bin-dir to-path) (define-config config:bin-dir 'bin-dir to-path)
(define-config config:man-dir 'man-dir to-path) (define-config config:man-dir 'man-dir to-path)
(define-config config:links-file 'links-file to-path)
(define-config config:links-search-files 'links-search-files to-path)
(define-config config:pkg-dir 'pkg-dir to-path)
(define-config config:pkg-search-dirs 'pkg-search-dirs to-path)
(define-config config:cgc-suffix 'cgc-suffix values) (define-config config:cgc-suffix 'cgc-suffix values)
(define-config config:3m-suffix '3m-suffix values) (define-config config:3m-suffix '3m-suffix values)
(define-config config:absolute-installation? 'absolute-installation? (lambda (x) (and x #t))) (define-config config:absolute-installation? 'absolute-installation? (lambda (x) (and x #t)))
@ -84,10 +89,14 @@
(delay (find-main-collects))) (delay (find-main-collects)))
(provide find-collects-dir (provide find-collects-dir
get-main-collects-search-dirs
find-user-collects-dir find-user-collects-dir
get-collects-search-dirs) get-collects-search-dirs)
(define (find-collects-dir) (define (find-collects-dir)
(force main-collects-dir)) (force main-collects-dir))
(define (get-main-collects-search-dirs)
(combine-search (force config:collects-search-dirs)
(list (find-collects-dir))))
(define user-collects-dir (define user-collects-dir
(delay (build-path (system-path* 'addon-dir) (version) "collects"))) (delay (build-path (system-path* 'addon-dir) (version) "collects")))
(define (find-user-collects-dir) (define (find-user-collects-dir)
@ -110,10 +119,14 @@
[else (cons (car l) (loop (cdr l)))])) [else (cons (car l) (loop (cdr l)))]))
default)) default))
(define (cons-user u r) (define (cons-user u r)
(if (use-user-specific-search-paths) (cons u r) r)) (if (and u (use-user-specific-search-paths))
(cons u r)
r))
(define (get-false) #f)
(define (chain-to f) f)
(define-syntax define-finder (define-syntax define-finder
(syntax-rules () (syntax-rules (get-false chain-to)
[(_ provide config:id id user-id config:search-id search-id default) [(_ provide config:id id user-id config:search-id search-id default)
(begin (begin
(define-finder provide config:id id user-id default) (define-finder provide config:id id user-id default)
@ -130,16 +143,28 @@
(combine-search (force config:search-id) (combine-search (force config:search-id)
(extra (extra-search-dir) (extra (extra-search-dir)
(cons-user (user-id) (single (id)))))))] (cons-user (user-id) (single (id)))))))]
[(_ provide config:id id user-id default) [(_ provide config:id id get-false (chain-to get-default))
(begin (begin
(provide id user-id) (provide id)
(define dir
(delay
(or (force config:id) (get-default))))
(define (id)
(force dir)))]
[(_ provide config:id id get-false default)
(begin
(provide id)
(define dir (define dir
(delay (delay
(or (force config:id) (or (force config:id)
(let ([p (find-collects-dir)]) (let ([p (find-config-dir)])
(and p (simplify-path (build-path p 'up 'up default))))))) (and p (simplify-path (build-path p 'up default)))))))
(define (id) (define (id)
(force dir)) (force dir)))]
[(_ provide config:id id user-id default)
(begin
(define-finder provide config:id id get-false default)
(provide user-id)
(define user-dir (define user-dir
(delay (build-path (system-path* 'addon-dir) (version) default))) (delay (build-path (system-path* 'addon-dir) (version) default)))
(define (user-id) (define (user-id)
@ -288,3 +313,37 @@
#f)]))) #f)])))
(define (find-dll-dir) (define (find-dll-dir)
(force dll-dir)) (force dll-dir))
;; ----------------------------------------
;; Links files
(provide find-links-file
get-links-search-files)
(define (find-links-file)
(or (force config:links-file)
(build-path (find-lib-dir) "links.rktd")))
(define (get-links-search-files)
(combine-search (force config:links-search-files)
(list (find-links-file))))
;; ----------------------------------------
;; Packages
(define-finder provide
config:pkg-dir
find-pkg-dir
get-false
config:pkg-search-dirs
get-pkg-search-dirs
(chain-to (lambda () (build-path (find-lib-dir) "pkgs"))))
(provide find-user-pkg-dir
find-shared-pkg-dir)
(define (find-user-pkg-dir [vers (version)])
(build-path (find-system-path 'addon-dir)
vers
"pkgs"))
(define (find-shared-pkg-dir)
(build-path (find-system-path 'addon-dir)
"pkgs"))

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

@ -31,16 +31,7 @@
(if shared? (if shared?
(build-path (find-system-path 'addon-dir) "links.rktd") (build-path (find-system-path 'addon-dir) "links.rktd")
(build-path (find-system-path 'addon-dir) (version) "links.rktd")) (build-path (find-system-path 'addon-dir) (version) "links.rktd"))
(let ([d (find-config-dir)]) (find-links-file))))
(if d
(build-path d "links.rktd")
(if (or name
(pair? dirs)
repair?
remove?)
(error 'links
"cannot find installation configuration path")
#f))))))
(define need-repair? #f) (define need-repair? #f)

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

@ -61,7 +61,9 @@
(define name-str (setup-program-name)) (define name-str (setup-program-name))
(define name-sym (string->symbol name-str)) (define name-sym (string->symbol name-str))
(define main-collects-dir (find-collects-dir)) (define main-collects-dir (simple-form-path (find-collects-dir)))
(define main-collects-dirs (for/hash ([p (in-list (get-main-collects-search-dirs))])
(values (simple-form-path p) #t)))
(define mode-dir (define mode-dir
(if (compile-mode) (if (compile-mode)
(build-path "compiled" (compile-mode)) (build-path "compiled" (compile-mode))
@ -69,9 +71,9 @@
(unless (make-user) (unless (make-user)
(current-library-collection-paths (current-library-collection-paths
(if (member main-collects-dir (current-library-collection-paths)) (for/list ([p (current-library-collection-paths)]
(list main-collects-dir) #:when (hash-ref main-collects-dirs p #f))
'()))) p)))
(current-library-collection-paths (current-library-collection-paths
(map simple-form-path (current-library-collection-paths))) (map simple-form-path (current-library-collection-paths)))
@ -340,7 +342,7 @@
(collection-cc! (list collection) (collection-cc! (list collection)
#:info-root cp #:info-root cp
#:path (build-path cp collection) #:path (build-path cp collection)
#:main? (equal? cp main-collects-dir))) #:main? (hash-ref main-collects-dirs cp #f)))
(let () (let ()
(define info-root (find-lib-dir)) (define info-root (find-lib-dir))
(define info-path (build-path info-root "info-cache.rktd")) (define info-path (build-path info-root "info-cache.rktd"))
@ -1026,7 +1028,7 @@
(for ([c (in-list (current-library-collection-paths))]) (for ([c (in-list (current-library-collection-paths))])
(when (and (directory-exists? c) (when (and (directory-exists? c)
(not (and (avoid-main-installation) (not (and (avoid-main-installation)
(equal? c main-collects-dir)))) (hash-ref main-collects-dirs c #f))))
(define info-path (build-path c "info-domain" "compiled" "cache.rktd")) (define info-path (build-path c "info-domain" "compiled" "cache.rktd"))
(when (file-exists? info-path) (when (file-exists? info-path)
(get-info-ht c info-path 'relative)))) (get-info-ht c info-path 'relative))))

3
racket/lib/collects/setup/unixstyle-install.rkt
View File

@ -440,6 +440,7 @@
;; grab paths before we change them ;; grab paths before we change them
(define bindir (dir: 'bin)) (define bindir (dir: 'bin))
(define librktdir (dir: 'librkt)) (define librktdir (dir: 'librkt))
(define configdir (dir: 'config))
(define (remove-dest p) (define (remove-dest p)
(let ([pfx (and (< destdirlen (string-length p)) (let ([pfx (and (< destdirlen (string-length p))
(substring p 0 destdirlen))]) (substring p 0 destdirlen))])
@ -451,7 +452,7 @@
;; only when DESTDIR is present, so we're installing to a directory that ;; only when DESTDIR is present, so we're installing to a directory that
;; has only our binaries ;; has only our binaries
(fix-executables bindir librktdir) (fix-executables bindir librktdir)
(unless origtree? (write-config librktdir))) (unless origtree? (write-config configdir)))
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------

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

File diff suppressed because it is too large Load Diff

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

@ -350,17 +350,57 @@
" \"links.rktd\"))" " \"links.rktd\"))"
"(define-values(shared-links-cache)(make-hasheq))" "(define-values(shared-links-cache)(make-hasheq))"
"(define-values(shared-links-stamp) #f)" "(define-values(shared-links-stamp) #f)"
"(define-values(links-path)(find-links-path!" "(define-values(find-config-dir)"
"(lambda()" "(lambda()"
"(let((d(let((c(find-system-path 'config-dir)))" "(let((c(find-system-path 'config-dir)))"
"(if(absolute-path? c)" "(if(complete-path? c)"
" c" " c"
"(or(and(relative-path? c)"
"(parameterize((current-directory(find-system-path 'orig-dir)))" "(parameterize((current-directory(find-system-path 'orig-dir)))"
"(find-executable-path(find-system-path 'exec-file) c))))))" "(find-executable-path(find-system-path 'exec-file) c)))"
"(and d" "(let((exec(path->complete-path "
" (build-path d \"links.rktd\"))))))" "(find-executable-path(find-system-path 'exec-file))"
"(define-values(links-cache)(make-hasheq))" "(find-system-path 'orig-dir))))"
"(define-values(links-stamp) #f)" "(let-values(((base name dir?)(split-path exec)))"
"(path->complete-path c base))))))))"
"(define-values(get-config-table)"
"(lambda(d)"
" (let ((p (build-path d \"config.rktd\")))"
"(or(and(file-exists? p)"
"(call-with-input-file p read))"
" #hash()))))"
"(define-values(coerce-to-path)"
"(lambda(p)"
"(cond"
"((string? p)(string->path p))"
"((bytes? p)(bytes->path p))"
"(else p))))"
"(define-values(add-config-search)"
"(lambda(ht key orig-l)"
"(let((l(hash-ref ht key #f)))"
"(if l"
"(let loop((l l))"
"(cond"
"((null? l) null)"
"((not(car l))(append orig-l(loop(cdr l))))"
"(else(cons(coerce-to-path(car l))(loop(cdr l))))))"
" orig-l))))"
"(define-values(links-paths)(find-links-path!"
"(lambda()"
"(let*((d(find-config-dir))"
"(ht(get-config-table d))"
"(lf(or(hash-ref ht 'links-file #f)"
"(build-path(or"
"(coerce-to-path(hash-ref ht 'lib-dir #f))"
" (build-path d 'up \"lib\"))"
" \"links.rktd\"))))"
"(list->vector"
"(add-config-search"
" ht"
" 'links-search-files"
"(list lf)))))))"
"(define-values(links-caches)(make-vector(vector-length links-paths)(make-hasheq)))"
"(define-values(links-stamps)(make-vector(vector-length links-paths) #f))"
"(define-values(file->stamp)" "(define-values(file->stamp)"
"(lambda(path)" "(lambda(path)"
"(call-with-continuation-prompt" "(call-with-continuation-prompt"
@ -392,7 +432,7 @@
" bstr)))" " bstr)))"
"(lambda()(close-input-port p)))))))))" "(lambda()(close-input-port p)))))))))"
"(define-values(get-linked-collections)" "(define-values(get-linked-collections)"
"(lambda(user? shared?)" "(lambda(user? shared? ii)"
"(call/ec(lambda(esc)" "(call/ec(lambda(esc)"
"(define-values(make-handler)" "(define-values(make-handler)"
"(lambda(ts)" "(lambda(ts)"
@ -400,13 +440,13 @@
"(if(exn:fail? exn)" "(if(exn:fail? exn)"
"(let((l(current-logger)))" "(let((l(current-logger)))"
"(when(log-level? l 'error)" "(when(log-level? l 'error)"
"(log-message l 'error " "(log-message l 'error"
"(format" "(format"
" \"error reading collection links file ~s: ~a\"" " \"error reading collection links file ~s: ~a\""
"(cond" "(cond"
"(user? user-links-path)" "(user? user-links-path)"
"(shared? shared-links-path)" "(shared? shared-links-path)"
"(else links-path))" "(else(vector-ref links-paths ii)))"
"(exn-message exn))" "(exn-message exn))"
"(current-continuation-marks))))" "(current-continuation-marks))))"
"(void))" "(void))"
@ -419,8 +459,8 @@
"(set! shared-links-cache(make-hasheq))" "(set! shared-links-cache(make-hasheq))"
"(set! shared-links-stamp ts))" "(set! shared-links-stamp ts))"
"(else" "(else"
"(set! links-cache(make-hasheq))" "(vector-set! links-caches ii(make-hasheq))"
"(set! links-stamp ts))))" "(vector-set! links-stamps ii ts))))"
"(if(exn:fail? exn)" "(if(exn:fail? exn)"
"(esc(make-hasheq))" "(esc(make-hasheq))"
" exn))))" " exn))))"
@ -430,12 +470,12 @@
"(let*((a-links-path(cond" "(let*((a-links-path(cond"
"(user? user-links-path)" "(user? user-links-path)"
"(shared? shared-links-path)" "(shared? shared-links-path)"
"(else links-path)))" "(else(vector-ref links-paths ii))))"
"(ts(file->stamp a-links-path)))" "(ts(file->stamp a-links-path)))"
"(if(not(equal? ts(cond" "(if(not(equal? ts(cond"
"(user? user-links-stamp)" "(user? user-links-stamp)"
"(shared? shared-links-stamp)" "(shared? shared-links-stamp)"
"(else links-stamp))))" "(else(vector-ref links-stamps ii)))))"
"(with-continuation-mark" "(with-continuation-mark"
" exception-handler-key" " exception-handler-key"
"(make-handler ts)" "(make-handler ts)"
@ -506,13 +546,13 @@
"(set! shared-links-cache ht)" "(set! shared-links-cache ht)"
"(set! shared-links-stamp ts))" "(set! shared-links-stamp ts))"
"(else" "(else"
"(set! links-cache ht)" "(vector-set! links-caches ii ht)"
"(set! links-stamp ts)))" "(vector-set! links-stamps ii ts)))"
" ht))))" " ht))))"
"(cond" "(cond"
"(user? user-links-cache)" "(user? user-links-cache)"
"(shared? shared-links-cache)" "(shared? shared-links-cache)"
"(else links-cache)))))))))" "(else(vector-ref links-caches ii))))))))))"
"(define-values(normalize-collection-reference)" "(define-values(normalize-collection-reference)"
"(lambda(collection collection-path)" "(lambda(collection collection-path)"
"(cond" "(cond"
@ -543,17 +583,21 @@
"(append" "(append"
"(if(and links?(use-user-specific-search-paths))" "(if(and links?(use-user-specific-search-paths))"
"(append" "(append"
"(let((ht(get-linked-collections #t #f)))" "(let((ht(get-linked-collections #t #f 0)))"
"(append(hash-ref ht sym null)" "(append(hash-ref ht sym null)"
"(hash-ref ht #f null)))" "(hash-ref ht #f null)))"
"(let((ht(get-linked-collections #f #t)))" "(let((ht(get-linked-collections #f #t 0)))"
"(append(hash-ref ht sym null)" "(append(hash-ref ht sym null)"
"(hash-ref ht #f null))))" "(hash-ref ht #f null))))"
" null)" " null)"
"(if(and links? links-path)" "(if links?"
"(let((ht(get-linked-collections #f #f)))" "(let loop((ii 0))"
"(if(ii . >= .(vector-length links-paths))"
" null"
"(let((ht(get-linked-collections #f #f ii)))"
"(append(hash-ref ht sym null)" "(append(hash-ref ht sym null)"
"(hash-ref ht #f null)))" "(hash-ref ht #f null)"
"(loop(add1 ii))))))"
" null)" " null)"
"(current-library-collection-paths)))))" "(current-library-collection-paths)))))"
"(define-values(done)" "(define-values(done)"
@ -701,6 +745,9 @@
"(bytes->string/locale c #\\?)" "(bytes->string/locale c #\\?)"
" \"\"))" " \"\"))"
" \"\")" " \"\")"
"(add-config-search"
"(get-config-table(find-config-dir))"
" 'collects-search-dirs"
"(cons-if" "(cons-if"
"(and user-too?" "(and user-too?"
"(build-path(find-system-path 'addon-dir)" "(build-path(find-system-path 'addon-dir)"
@ -724,7 +771,7 @@
"(if v" "(if v"
"(cons(simplify-path(path->complete-path v(current-directory)))" "(cons(simplify-path(path->complete-path v(current-directory)))"
"(loop(cdr l)))" "(loop(cdr l)))"
"(loop(cdr l))))))))))))" "(loop(cdr l)))))))))))))"
"(define(embedded-load start end str)" "(define(embedded-load start end str)"
"(let*((s(if str" "(let*((s(if str"
" str" " str"

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

@ -415,22 +415,67 @@
"links.rktd")) "links.rktd"))
(define-values (shared-links-cache) (make-hasheq)) (define-values (shared-links-cache) (make-hasheq))
(define-values (shared-links-stamp) #f) (define-values (shared-links-stamp) #f)
(define-values (links-path) (find-links-path! (define-values (find-config-dir)
;; This thunk is called once per place, and the result (lambda ()
;; is remembered for later invocations. Otherwise, the (let ([c (find-system-path 'config-dir)])
;; search for the config file can trip over filesystem (if (complete-path? c)
;; restrictions imposed by security guards. c
(lambda () (or (and (relative-path? c)
(let ([d (let ([c (find-system-path 'config-dir)]) (parameterize ([current-directory (find-system-path 'orig-dir)])
(if (absolute-path? c) (find-executable-path (find-system-path 'exec-file) c)))
c (let ([exec (path->complete-path
(parameterize ([current-directory (find-system-path 'orig-dir)]) (find-executable-path (find-system-path 'exec-file))
(find-executable-path (find-system-path 'exec-file) c))))]) (find-system-path 'orig-dir))])
(and d (let-values ([(base name dir?) (split-path exec)])
(build-path d "links.rktd")))))) (path->complete-path c base))))))))
(define-values (links-cache) (make-hasheq))
(define-values (links-stamp) #f) (define-values (get-config-table)
(lambda (d)
(let ([p (build-path d "config.rktd")])
(or (and (file-exists? p)
(call-with-input-file p read))
#hash()))))
(define-values (coerce-to-path)
(lambda (p)
(cond
[(string? p) (string->path p)]
[(bytes? p) (bytes->path p)]
[else p])))
(define-values (add-config-search)
(lambda (ht key orig-l)
(let ([l (hash-ref ht key #f)])
(if l
(let loop ([l l])
(cond
[(null? l) null]
[(not (car l)) (append orig-l (loop (cdr l)))]
[else (cons (coerce-to-path (car l)) (loop (cdr l)))]))
orig-l))))
(define-values (links-paths) (find-links-path!
;; This thunk is called once per place, and the result
;; is remembered for later invocations. Otherwise, the
;; search for the config file can trip over filesystem
;; restrictions imposed by security guards.
(lambda ()
(let* ([d (find-config-dir)]
[ht (get-config-table d)]
[lf (or (hash-ref ht 'links-file #f)
(build-path (or
(coerce-to-path (hash-ref ht 'lib-dir #f))
(build-path d 'up "lib"))
"links.rktd"))])
(list->vector
(add-config-search
ht
'links-search-files
(list lf)))))))
(define-values (links-caches) (make-vector (vector-length links-paths) (make-hasheq)))
(define-values (links-stamps) (make-vector (vector-length links-paths) #f))
(define-values (file->stamp) (define-values (file->stamp)
(lambda (path) (lambda (path)
@ -469,7 +514,7 @@
(lambda () (close-input-port p))))))))) (lambda () (close-input-port p)))))))))
(define-values (get-linked-collections) (define-values (get-linked-collections)
(lambda (user? shared?) (lambda (user? shared? ii)
(call/ec (lambda (esc) (call/ec (lambda (esc)
(define-values (make-handler) (define-values (make-handler)
(lambda (ts) (lambda (ts)
@ -477,13 +522,13 @@
(if (exn:fail? exn) (if (exn:fail? exn)
(let ([l (current-logger)]) (let ([l (current-logger)])
(when (log-level? l 'error) (when (log-level? l 'error)
(log-message l 'error (log-message l 'error
(format (format
"error reading collection links file ~s: ~a" "error reading collection links file ~s: ~a"
(cond (cond
[user? user-links-path] [user? user-links-path]
[shared? shared-links-path] [shared? shared-links-path]
[else links-path]) [else (vector-ref links-paths ii)])
(exn-message exn)) (exn-message exn))
(current-continuation-marks)))) (current-continuation-marks))))
(void)) (void))
@ -496,8 +541,8 @@
(set! shared-links-cache (make-hasheq)) (set! shared-links-cache (make-hasheq))
(set! shared-links-stamp ts)] (set! shared-links-stamp ts)]
[else [else
(set! links-cache (make-hasheq)) (vector-set! links-caches ii (make-hasheq))
(set! links-stamp ts)])) (vector-set! links-stamps ii ts)]))
(if (exn:fail? exn) (if (exn:fail? exn)
(esc (make-hasheq)) (esc (make-hasheq))
;; re-raise the exception (which is probably a break) ;; re-raise the exception (which is probably a break)
@ -508,12 +553,12 @@
(let* ([a-links-path (cond (let* ([a-links-path (cond
[user? user-links-path] [user? user-links-path]
[shared? shared-links-path] [shared? shared-links-path]
[else links-path])] [else (vector-ref links-paths ii)])]
[ts (file->stamp a-links-path)]) [ts (file->stamp a-links-path)])
(if (not (equal? ts (cond (if (not (equal? ts (cond
[user? user-links-stamp] [user? user-links-stamp]
[shared? shared-links-stamp] [shared? shared-links-stamp]
[else links-stamp]))) [else (vector-ref links-stamps ii)])))
(with-continuation-mark (with-continuation-mark
exception-handler-key exception-handler-key
(make-handler ts) (make-handler ts)
@ -590,13 +635,13 @@
(set! shared-links-cache ht) (set! shared-links-cache ht)
(set! shared-links-stamp ts)] (set! shared-links-stamp ts)]
[else [else
(set! links-cache ht) (vector-set! links-caches ii ht)
(set! links-stamp ts)]) (vector-set! links-stamps ii ts)])
ht)))) ht))))
(cond (cond
[user? user-links-cache] [user? user-links-cache]
[shared? shared-links-cache] [shared? shared-links-cache]
[else links-cache])))))))) [else (vector-ref links-caches ii)]))))))))
(define-values (normalize-collection-reference) (define-values (normalize-collection-reference)
(lambda (collection collection-path) (lambda (collection collection-path)
@ -631,18 +676,22 @@
;; list of paths and (box path)s: ;; list of paths and (box path)s:
(if (and links? (use-user-specific-search-paths)) (if (and links? (use-user-specific-search-paths))
(append (append
(let ([ht (get-linked-collections #t #f)]) (let ([ht (get-linked-collections #t #f 0)])
(append (hash-ref ht sym null) (append (hash-ref ht sym null)
(hash-ref ht #f null))) (hash-ref ht #f null)))
(let ([ht (get-linked-collections #f #t)]) (let ([ht (get-linked-collections #f #t 0)])
(append (hash-ref ht sym null) (append (hash-ref ht sym null)
(hash-ref ht #f null)))) (hash-ref ht #f null))))
null) null)
;; list of paths and (box path)s: ;; list of paths and (box path)s:
(if (and links? links-path) (if links?
(let ([ht (get-linked-collections #f #f)]) (let loop ([ii 0])
(append (hash-ref ht sym null) (if (ii . >= . (vector-length links-paths))
(hash-ref ht #f null))) null
(let ([ht (get-linked-collections #f #f ii)])
(append (hash-ref ht sym null)
(hash-ref ht #f null)
(loop (add1 ii))))))
null) null)
;; list of paths: ;; list of paths:
(current-library-collection-paths)))]) (current-library-collection-paths)))])
@ -795,39 +844,42 @@
[(extra-collects-dirs) (find-library-collection-paths extra-collects-dirs null)] [(extra-collects-dirs) (find-library-collection-paths extra-collects-dirs null)]
[(extra-collects-dirs post-collects-dirs) [(extra-collects-dirs post-collects-dirs)
(let ([user-too? (use-user-specific-search-paths)] (let ([user-too? (use-user-specific-search-paths)]
[cons-if (lambda (f r) (if f (cons f r) r))]) [cons-if (lambda (f r) (if f (cons f r) r))])
(path-list-string->path-list (path-list-string->path-list
(if user-too? (if user-too?
(let ([c (environment-variables-ref (current-environment-variables) (let ([c (environment-variables-ref (current-environment-variables)
#"PLTCOLLECTS")]) #"PLTCOLLECTS")])
(if c (if c
(bytes->string/locale c #\?) (bytes->string/locale c #\?)
"")) ""))
"") "")
(cons-if (add-config-search
(and user-too? (get-config-table (find-config-dir))
(build-path (find-system-path 'addon-dir) 'collects-search-dirs
(version) (cons-if
"collects")) (and user-too?
(let loop ([l (append (build-path (find-system-path 'addon-dir)
extra-collects-dirs (version)
(list (find-system-path 'collects-dir)) "collects"))
post-collects-dirs)]) (let loop ([l (append
(if (null? l) extra-collects-dirs
null (list (find-system-path 'collects-dir))
(let* ([collects-path (car l)] post-collects-dirs)])
[v (if (null? l)
(cond null
[(complete-path? collects-path) collects-path] (let* ([collects-path (car l)]
[(absolute-path? collects-path) [v
(path->complete-path collects-path (cond
(find-executable-path (find-system-path 'exec-file) #f #t))] [(complete-path? collects-path) collects-path]
[else [(absolute-path? collects-path)
(find-executable-path (find-system-path 'exec-file) collects-path #t)])]) (path->complete-path collects-path
(if v (find-executable-path (find-system-path 'exec-file) #f #t))]
(cons (simplify-path (path->complete-path v (current-directory))) [else
(loop (cdr l))) (find-executable-path (find-system-path 'exec-file) collects-path #t)])])
(loop (cdr l)))))))))])) (if v
(cons (simplify-path (path->complete-path v (current-directory)))
(loop (cdr l)))
(loop (cdr l))))))))))]))
;; used for the -k command-line argument: ;; used for the -k command-line argument:
(define (embedded-load start end str) (define (embedded-load start end str)