links file and pkg directrory location and search paths in "config.rktd"
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
parent
2aed2138a6
commit
1ee88e2721
|
|
@ -1,5 +1,6 @@
|
|||
#lang scribble/doc
|
||||
@(require scribble/manual
|
||||
"common.rkt"
|
||||
(for-label racket/base
|
||||
racket/contract
|
||||
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
|
||||
configuration directory.
|
||||
|
||||
|
||||
|
||||
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)
|
||||
|
|
@ -27,36 +26,49 @@ symbolic keys:
|
|||
|
||||
@item{@racket['doc-dir] --- a path, string, or byte string for the
|
||||
main documentation directory. The value defaults to a
|
||||
@filepath{doc} sibling directory of the main collection
|
||||
directory's parent.}
|
||||
@filepath{doc} sibling directory of the configuration directory.}
|
||||
|
||||
@item{@racket['lib-dir] --- a path, string, or byte string for the
|
||||
main library directory; it defaults to the parent of the main
|
||||
collection directory.}
|
||||
main library directory; it defaults to a @filepath{lib} sibling
|
||||
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
|
||||
directory containing Unix shared libraries for the main
|
||||
executable; it defaults to the main library directory.}
|
||||
|
||||
@item{@racket['include-dir] --- a path, string, or byte string for
|
||||
the main directory containing C header files; it defaults to an
|
||||
@filepath{include} sibling directory of the main library
|
||||
directory.}
|
||||
@item{@racket['links-file] --- a path, string, or byte string for the
|
||||
@tech[#:doc reference-doc]{collection links file}; it defaults
|
||||
to a @filepath{links.rktd} file in the main library 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
|
||||
main directory containing executables; it defaults to a
|
||||
@filepath{bin} sibling directory of the main library
|
||||
directory.}
|
||||
|
||||
@item{@racket['doc-search-dirs] --- a path, string, byte string, or
|
||||
@racket[#f] representing the search path for 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['doc-search-dirs] --- like @racket['lib-search-dirs],
|
||||
but for directories containing documentation.}
|
||||
|
||||
@item{@racket['lib-search-dirs] --- like @racket[doc-search-dirs],
|
||||
but for directories containing foreign libraries.}
|
||||
@item{@racket['include-dir] --- a path, string, or byte string for
|
||||
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
|
||||
@racket[doc-search-dirs], but for directories containing C
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@
|
|||
setup/getinfo
|
||||
setup/pack
|
||||
setup/unpack
|
||||
setup/link
|
||||
compiler/compiler
|
||||
launcher/launcher
|
||||
compiler/sig
|
||||
|
|
@ -922,6 +923,41 @@ v
|
|||
contains configuration and package information---including
|
||||
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)]{
|
||||
Returns a path to the installation's @filepath{doc} directory.
|
||||
The result is @racket[#f] if no such directory is available.}
|
||||
|
|
|
|||
|
|
@ -104,14 +104,14 @@
|
|||
(define (compile-directory-visitor dir info worker omit-root
|
||||
#:verbose [verbose? #t]
|
||||
#:skip-path [orig-skip-path #f]
|
||||
#:skip-paths [orig-skip-paths null]
|
||||
#:skip-doc-sources? [skip-docs? #f])
|
||||
(define info* (or info (lambda (key mk-default) (mk-default))))
|
||||
(define omit-paths (omitted-paths dir c-get-info/full omit-root))
|
||||
(define skip-path (and orig-skip-path (path->bytes
|
||||
(simplify-path (if (string? orig-skip-path)
|
||||
(string->path orig-skip-path)
|
||||
orig-skip-path)
|
||||
#f))))
|
||||
(define skip-paths (for/list ([p (in-list (if orig-skip-path
|
||||
(cons orig-skip-path orig-skip-paths)
|
||||
orig-skip-paths))])
|
||||
(path->bytes (simplify-path p #f))))
|
||||
(unless (eq? 'all omit-paths)
|
||||
(let ([init (parameterize ([current-directory dir]
|
||||
[current-load-relative-directory dir]
|
||||
|
|
@ -125,12 +125,13 @@
|
|||
(lambda (path) ((compile-notify-handler) path))]
|
||||
[manager-skip-file-handler
|
||||
(lambda (path)
|
||||
(and skip-path
|
||||
(let ([b (path->bytes (simplify-path path #f))]
|
||||
[len (bytes-length skip-path)])
|
||||
(and ((bytes-length b) . > . len)
|
||||
(bytes=? (subbytes b 0 len) skip-path)))
|
||||
(cons -inf.0 "")))])
|
||||
(and (pair? skip-paths)
|
||||
(let ([b (path->bytes (simplify-path path #f))])
|
||||
(for/or ([skip-path (in-list skip-paths)])
|
||||
(let ([len (bytes-length skip-path)])
|
||||
(and ((bytes-length b) . > . len)
|
||||
(bytes=? (subbytes b 0 len) skip-path)
|
||||
(cons -inf.0 "")))))))])
|
||||
(let* ([sses (append
|
||||
;; Find all .rkt/.ss/.scm files:
|
||||
(filter extract-base-filename/ss (directory-list))
|
||||
|
|
@ -152,13 +153,15 @@
|
|||
(if (and (directory-exists? p*) (not (member p omit-paths)))
|
||||
(compile-directory-visitor p* (c-get-info/full p*) worker omit-root
|
||||
#:verbose verbose?
|
||||
#:skip-path skip-path
|
||||
#:skip-path orig-skip-path
|
||||
#:skip-paths orig-skip-paths
|
||||
#:skip-doc-sources? skip-docs?)
|
||||
init))))
|
||||
init))))
|
||||
(define (compile-directory dir info
|
||||
#:verbose [verbose? #t]
|
||||
#:skip-path [orig-skip-path #f]
|
||||
#:skip-paths [orig-skip-paths null]
|
||||
#:skip-doc-sources? [skip-docs? #f]
|
||||
#:managed-compile-zo [managed-compile-zo
|
||||
(make-caching-managed-compile-zo)]
|
||||
|
|
@ -168,11 +171,13 @@
|
|||
(compile-directory-visitor dir info worker omit-root
|
||||
#:verbose verbose?
|
||||
#:skip-path orig-skip-path
|
||||
#:skip-paths orig-skip-paths
|
||||
#:skip-doc-sources? skip-docs?))
|
||||
|
||||
(define (get-compile-directory-srcs dir info
|
||||
#:verbose [verbose? #t]
|
||||
#:skip-path [orig-skip-path #f]
|
||||
#:skip-paths [orig-skip-paths null]
|
||||
#:skip-doc-sources? [skip-docs? #f]
|
||||
#:managed-compile-zo [managed-compile-zo
|
||||
(make-caching-managed-compile-zo)]
|
||||
|
|
@ -180,6 +185,7 @@
|
|||
(compile-directory-visitor dir info append omit-root
|
||||
#:verbose verbose?
|
||||
#:skip-path orig-skip-path
|
||||
#:skip-paths orig-skip-paths
|
||||
#:skip-doc-sources? skip-docs?
|
||||
#:managed-compile-zo managed-compile-zo))
|
||||
|
||||
|
|
@ -187,6 +193,7 @@
|
|||
|
||||
(define (compile-collection-zos collection
|
||||
#:skip-path [skip-path #f]
|
||||
#:skip-paths [skip-paths null]
|
||||
#:skip-doc-sources? [skip-docs? #f]
|
||||
#:managed-compile-zo [managed-compile-zo
|
||||
(make-caching-managed-compile-zo)]
|
||||
|
|
@ -200,6 +207,7 @@
|
|||
omit-root)
|
||||
#:verbose #f
|
||||
#:skip-path skip-path
|
||||
#:skip-paths skip-paths
|
||||
#:skip-doc-sources? skip-docs?
|
||||
#:managed-compile-zo managed-compile-zo))
|
||||
|
||||
|
|
|
|||
|
|
@ -111,20 +111,17 @@
|
|||
(λ (ip) (copy-port ip op)))))))
|
||||
|
||||
(define (pkg-dir config?)
|
||||
(build-path (case (current-pkg-scope)
|
||||
[(installation) (if config?
|
||||
(find-config-dir)
|
||||
(find-lib-dir))]
|
||||
[(user)
|
||||
(build-path (find-system-path 'addon-dir) (current-pkg-scope-version))]
|
||||
[(shared)
|
||||
(find-system-path 'addon-dir)]
|
||||
[else (error "unknown package scope")])
|
||||
"pkgs"))
|
||||
(case (current-pkg-scope)
|
||||
[(installation) (if config?
|
||||
(find-config-dir)
|
||||
(find-pkg-dir))]
|
||||
[(user) (find-user-pkg-dir (current-pkg-scope-version))]
|
||||
[(shared) (find-shared-pkg-dir)]
|
||||
[else (error "unknown package scope")]))
|
||||
(define (pkg-config-file)
|
||||
(build-path (pkg-dir #t) "config.rktd"))
|
||||
(define (pkg-db-file)
|
||||
(build-path (pkg-dir #t) "pkgs.rktd"))
|
||||
(build-path (pkg-dir #f) "pkgs.rktd"))
|
||||
(define (pkg-installed-dir)
|
||||
(pkg-dir #f))
|
||||
(define (pkg-lock-file)
|
||||
|
|
@ -262,7 +259,7 @@
|
|||
(if (or (eq? mode held-mode)
|
||||
(eq? 'exclusive held-mode))
|
||||
(t)
|
||||
(let ([d (pkg-dir #t)])
|
||||
(let ([d (pkg-dir #f)])
|
||||
(unless read-only? (make-directory* d))
|
||||
(if (directory-exists? d)
|
||||
;; If the directory exists, assume that a lock file is
|
||||
|
|
@ -411,15 +408,40 @@
|
|||
(define (read-pkg-db)
|
||||
(if (current-no-pkg-db)
|
||||
#hash()
|
||||
(let ([the-db (read-file-hash (pkg-db-file))])
|
||||
;; compatibility: map 'pnr to 'catalog:
|
||||
(for/hash ([(k v) (in-hash the-db)])
|
||||
(values k
|
||||
(if (eq? 'pnr (car (pkg-info-orig-pkg 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-pkg-db-file (pkg-db-file))))
|
||||
|
||||
(define (read-pkg-db-file file)
|
||||
(let ([the-db (read-file-hash file)])
|
||||
;; compatibility: map 'pnr to 'catalog:
|
||||
(for/hash ([(k v) (in-hash the-db)])
|
||||
(values k
|
||||
(if (eq? 'pnr (car (pkg-info-orig-pkg 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 db (read-pkg-db))
|
||||
|
|
@ -988,30 +1010,7 @@
|
|||
descs)
|
||||
(define download-printf (if quiet? void printf))
|
||||
(define check-sums? (not ignore-checksums?))
|
||||
(define db (read-pkg-db))
|
||||
(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 all-db (merge-pkg-dbs))
|
||||
(define (install-package/outer infos desc info)
|
||||
(match-define (pkg-desc pkg type orig-name auto?) desc)
|
||||
(match-define
|
||||
|
|
@ -1025,7 +1024,7 @@
|
|||
(for/hash ([i (in-list infos)])
|
||||
(values (install-info-name i) (install-info-directory i))))
|
||||
(cond
|
||||
[(and (not updating?) (package-info pkg-name #f))
|
||||
[(and (not updating?) (hash-ref all-db pkg-name #f))
|
||||
(clean!)
|
||||
(pkg-error "package is already installed\n package: ~a" pkg-name)]
|
||||
[(and
|
||||
|
|
@ -1084,7 +1083,7 @@
|
|||
(or (equal? name "racket")
|
||||
(not (dependency-this-platform? dep))
|
||||
(hash-ref simultaneous-installs name #f)
|
||||
(hash-has-key? db name)))
|
||||
(hash-has-key? all-db name)))
|
||||
deps)))
|
||||
(and (not (empty? unsatisfied-deps))
|
||||
unsatisfied-deps)))
|
||||
|
|
@ -1418,28 +1417,45 @@
|
|||
(define (pkg-show indent #:directory? [dir? #f])
|
||||
(let ()
|
||||
(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)
|
||||
(printf " [none]\n")
|
||||
(table-display
|
||||
(list*
|
||||
(list* (format "~aPackage[*=auto]" indent) "Checksum" "Source"
|
||||
(if dir?
|
||||
(list "Directory")
|
||||
empty))
|
||||
(append
|
||||
(list (format "~aPackage[*=auto~a]"
|
||||
indent
|
||||
(if has-const?
|
||||
"; .=constant"
|
||||
""))
|
||||
"Checksum"
|
||||
"Source")
|
||||
(if dir?
|
||||
(list "Directory")
|
||||
empty))
|
||||
(for/list ([pkg (in-list pkgs)])
|
||||
(match-define (pkg-info orig-pkg checksum auto?) (hash-ref db pkg))
|
||||
(list* (format "~a~a~a"
|
||||
(match-define (pkg-info orig-pkg checksum auto?) (hash-ref all-db pkg))
|
||||
(append
|
||||
(list (format "~a~a~a~a"
|
||||
indent
|
||||
pkg
|
||||
(if auto?
|
||||
"*"
|
||||
""))
|
||||
"*"
|
||||
"")
|
||||
(if (and has-const?
|
||||
(not (equal? (hash-ref all-db pkg)
|
||||
(hash-ref db pkg #f))))
|
||||
"."
|
||||
""))
|
||||
(format "~a" checksum)
|
||||
(format "~a" orig-pkg)
|
||||
(if dir?
|
||||
(list (~a (pkg-directory* pkg)))
|
||||
empty))))))))
|
||||
(format "~a" orig-pkg))
|
||||
(if dir?
|
||||
(list (~a (pkg-directory* pkg)))
|
||||
empty))))))))
|
||||
|
||||
(define (installed-pkg-table #:scope [given-scope #f])
|
||||
(parameterize ([current-pkg-scope
|
||||
|
|
|
|||
|
|
@ -5,6 +5,10 @@ Changed link-file handling to separate "user" and "shared" modes;
|
|||
raco link: -u/--user mode installs a version-specific link,
|
||||
added -s/--shared for user-specific, all-version links
|
||||
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
|
||||
Reorganized collections into packages
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
#lang scheme/base
|
||||
(require racket/cmdline
|
||||
raco/command-name
|
||||
setup/dirs
|
||||
"../link.rkt")
|
||||
|
||||
(define link-file (make-parameter #f))
|
||||
|
|
@ -101,7 +102,13 @@
|
|||
(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)))
|
||||
(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)
|
||||
(null? l1)
|
||||
|
|
|
|||
|
|
@ -56,8 +56,9 @@
|
|||
(wrap
|
||||
(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-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:lib-dir 'lib-dir 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:bin-dir 'bin-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:3m-suffix '3m-suffix values)
|
||||
(define-config config:absolute-installation? 'absolute-installation? (lambda (x) (and x #t)))
|
||||
|
|
@ -84,10 +89,14 @@
|
|||
(delay (find-main-collects)))
|
||||
|
||||
(provide find-collects-dir
|
||||
get-main-collects-search-dirs
|
||||
find-user-collects-dir
|
||||
get-collects-search-dirs)
|
||||
(define (find-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
|
||||
(delay (build-path (system-path* 'addon-dir) (version) "collects")))
|
||||
(define (find-user-collects-dir)
|
||||
|
|
@ -110,10 +119,14 @@
|
|||
[else (cons (car l) (loop (cdr l)))]))
|
||||
default))
|
||||
(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
|
||||
(syntax-rules ()
|
||||
(syntax-rules (get-false chain-to)
|
||||
[(_ provide config:id id user-id config:search-id search-id default)
|
||||
(begin
|
||||
(define-finder provide config:id id user-id default)
|
||||
|
|
@ -130,16 +143,28 @@
|
|||
(combine-search (force config:search-id)
|
||||
(extra (extra-search-dir)
|
||||
(cons-user (user-id) (single (id)))))))]
|
||||
[(_ provide config:id id user-id default)
|
||||
[(_ provide config:id id get-false (chain-to get-default))
|
||||
(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
|
||||
(delay
|
||||
(or (force config:id)
|
||||
(let ([p (find-collects-dir)])
|
||||
(and p (simplify-path (build-path p 'up 'up default)))))))
|
||||
(let ([p (find-config-dir)])
|
||||
(and p (simplify-path (build-path p 'up default)))))))
|
||||
(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
|
||||
(delay (build-path (system-path* 'addon-dir) (version) default)))
|
||||
(define (user-id)
|
||||
|
|
@ -288,3 +313,37 @@
|
|||
#f)])))
|
||||
(define (find-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"))
|
||||
|
|
|
|||
|
|
@ -31,16 +31,7 @@
|
|||
(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")
|
||||
(if (or name
|
||||
(pair? dirs)
|
||||
repair?
|
||||
remove?)
|
||||
(error 'links
|
||||
"cannot find installation configuration path")
|
||||
#f))))))
|
||||
(find-links-file))))
|
||||
|
||||
(define need-repair? #f)
|
||||
|
||||
|
|
|
|||
|
|
@ -61,7 +61,9 @@
|
|||
|
||||
(define name-str (setup-program-name))
|
||||
(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
|
||||
(if (compile-mode)
|
||||
(build-path "compiled" (compile-mode))
|
||||
|
|
@ -69,9 +71,9 @@
|
|||
|
||||
(unless (make-user)
|
||||
(current-library-collection-paths
|
||||
(if (member main-collects-dir (current-library-collection-paths))
|
||||
(list main-collects-dir)
|
||||
'())))
|
||||
(for/list ([p (current-library-collection-paths)]
|
||||
#:when (hash-ref main-collects-dirs p #f))
|
||||
p)))
|
||||
|
||||
(current-library-collection-paths
|
||||
(map simple-form-path (current-library-collection-paths)))
|
||||
|
|
@ -340,7 +342,7 @@
|
|||
(collection-cc! (list collection)
|
||||
#:info-root cp
|
||||
#:path (build-path cp collection)
|
||||
#:main? (equal? cp main-collects-dir)))
|
||||
#:main? (hash-ref main-collects-dirs cp #f)))
|
||||
(let ()
|
||||
(define info-root (find-lib-dir))
|
||||
(define info-path (build-path info-root "info-cache.rktd"))
|
||||
|
|
@ -1026,7 +1028,7 @@
|
|||
(for ([c (in-list (current-library-collection-paths))])
|
||||
(when (and (directory-exists? c)
|
||||
(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"))
|
||||
(when (file-exists? info-path)
|
||||
(get-info-ht c info-path 'relative))))
|
||||
|
|
|
|||
|
|
@ -440,6 +440,7 @@
|
|||
;; grab paths before we change them
|
||||
(define bindir (dir: 'bin))
|
||||
(define librktdir (dir: 'librkt))
|
||||
(define configdir (dir: 'config))
|
||||
(define (remove-dest p)
|
||||
(let ([pfx (and (< destdirlen (string-length p))
|
||||
(substring p 0 destdirlen))])
|
||||
|
|
@ -451,7 +452,7 @@
|
|||
;; only when DESTDIR is present, so we're installing to a directory that
|
||||
;; has only our binaries
|
||||
(fix-executables bindir librktdir)
|
||||
(unless origtree? (write-config librktdir)))
|
||||
(unless origtree? (write-config configdir)))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -350,17 +350,57 @@
|
|||
" \"links.rktd\"))"
|
||||
"(define-values(shared-links-cache)(make-hasheq))"
|
||||
"(define-values(shared-links-stamp) #f)"
|
||||
"(define-values(links-path)(find-links-path!"
|
||||
"(define-values(find-config-dir)"
|
||||
"(lambda()"
|
||||
"(let((d(let((c(find-system-path 'config-dir)))"
|
||||
"(if(absolute-path? c)"
|
||||
"(let((c(find-system-path 'config-dir)))"
|
||||
"(if(complete-path? c)"
|
||||
" c"
|
||||
"(or(and(relative-path? c)"
|
||||
"(parameterize((current-directory(find-system-path 'orig-dir)))"
|
||||
"(find-executable-path(find-system-path 'exec-file) c))))))"
|
||||
"(and d"
|
||||
" (build-path d \"links.rktd\"))))))"
|
||||
"(define-values(links-cache)(make-hasheq))"
|
||||
"(define-values(links-stamp) #f)"
|
||||
"(find-executable-path(find-system-path 'exec-file) c)))"
|
||||
"(let((exec(path->complete-path "
|
||||
"(find-executable-path(find-system-path 'exec-file))"
|
||||
"(find-system-path 'orig-dir))))"
|
||||
"(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)"
|
||||
"(lambda(path)"
|
||||
"(call-with-continuation-prompt"
|
||||
|
|
@ -392,7 +432,7 @@
|
|||
" bstr)))"
|
||||
"(lambda()(close-input-port p)))))))))"
|
||||
"(define-values(get-linked-collections)"
|
||||
"(lambda(user? shared?)"
|
||||
"(lambda(user? shared? ii)"
|
||||
"(call/ec(lambda(esc)"
|
||||
"(define-values(make-handler)"
|
||||
"(lambda(ts)"
|
||||
|
|
@ -400,13 +440,13 @@
|
|||
"(if(exn:fail? exn)"
|
||||
"(let((l(current-logger)))"
|
||||
"(when(log-level? l 'error)"
|
||||
"(log-message l 'error "
|
||||
"(log-message l 'error"
|
||||
"(format"
|
||||
" \"error reading collection links file ~s: ~a\""
|
||||
"(cond"
|
||||
"(user? user-links-path)"
|
||||
"(shared? shared-links-path)"
|
||||
"(else links-path))"
|
||||
"(else(vector-ref links-paths ii)))"
|
||||
"(exn-message exn))"
|
||||
"(current-continuation-marks))))"
|
||||
"(void))"
|
||||
|
|
@ -419,8 +459,8 @@
|
|||
"(set! shared-links-cache(make-hasheq))"
|
||||
"(set! shared-links-stamp ts))"
|
||||
"(else"
|
||||
"(set! links-cache(make-hasheq))"
|
||||
"(set! links-stamp ts))))"
|
||||
"(vector-set! links-caches ii(make-hasheq))"
|
||||
"(vector-set! links-stamps ii ts))))"
|
||||
"(if(exn:fail? exn)"
|
||||
"(esc(make-hasheq))"
|
||||
" exn))))"
|
||||
|
|
@ -430,12 +470,12 @@
|
|||
"(let*((a-links-path(cond"
|
||||
"(user? user-links-path)"
|
||||
"(shared? shared-links-path)"
|
||||
"(else links-path)))"
|
||||
"(else(vector-ref links-paths ii))))"
|
||||
"(ts(file->stamp a-links-path)))"
|
||||
"(if(not(equal? ts(cond"
|
||||
"(user? user-links-stamp)"
|
||||
"(shared? shared-links-stamp)"
|
||||
"(else links-stamp))))"
|
||||
"(else(vector-ref links-stamps ii)))))"
|
||||
"(with-continuation-mark"
|
||||
" exception-handler-key"
|
||||
"(make-handler ts)"
|
||||
|
|
@ -506,13 +546,13 @@
|
|||
"(set! shared-links-cache ht)"
|
||||
"(set! shared-links-stamp ts))"
|
||||
"(else"
|
||||
"(set! links-cache ht)"
|
||||
"(set! links-stamp ts)))"
|
||||
"(vector-set! links-caches ii ht)"
|
||||
"(vector-set! links-stamps ii ts)))"
|
||||
" ht))))"
|
||||
"(cond"
|
||||
"(user? user-links-cache)"
|
||||
"(shared? shared-links-cache)"
|
||||
"(else links-cache)))))))))"
|
||||
"(else(vector-ref links-caches ii))))))))))"
|
||||
"(define-values(normalize-collection-reference)"
|
||||
"(lambda(collection collection-path)"
|
||||
"(cond"
|
||||
|
|
@ -543,17 +583,21 @@
|
|||
"(append"
|
||||
"(if(and links?(use-user-specific-search-paths))"
|
||||
"(append"
|
||||
"(let((ht(get-linked-collections #t #f)))"
|
||||
"(let((ht(get-linked-collections #t #f 0)))"
|
||||
"(append(hash-ref ht sym null)"
|
||||
"(hash-ref ht #f null)))"
|
||||
"(let((ht(get-linked-collections #f #t)))"
|
||||
"(let((ht(get-linked-collections #f #t 0)))"
|
||||
"(append(hash-ref ht sym null)"
|
||||
"(hash-ref ht #f null))))"
|
||||
" null)"
|
||||
"(if(and links? links-path)"
|
||||
"(let((ht(get-linked-collections #f #f)))"
|
||||
"(if links?"
|
||||
"(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)"
|
||||
"(hash-ref ht #f null)))"
|
||||
"(hash-ref ht #f null)"
|
||||
"(loop(add1 ii))))))"
|
||||
" null)"
|
||||
"(current-library-collection-paths)))))"
|
||||
"(define-values(done)"
|
||||
|
|
@ -701,6 +745,9 @@
|
|||
"(bytes->string/locale c #\\?)"
|
||||
" \"\"))"
|
||||
" \"\")"
|
||||
"(add-config-search"
|
||||
"(get-config-table(find-config-dir))"
|
||||
" 'collects-search-dirs"
|
||||
"(cons-if"
|
||||
"(and user-too?"
|
||||
"(build-path(find-system-path 'addon-dir)"
|
||||
|
|
@ -724,7 +771,7 @@
|
|||
"(if v"
|
||||
"(cons(simplify-path(path->complete-path v(current-directory)))"
|
||||
"(loop(cdr l)))"
|
||||
"(loop(cdr l))))))))))))"
|
||||
"(loop(cdr l)))))))))))))"
|
||||
"(define(embedded-load start end str)"
|
||||
"(let*((s(if str"
|
||||
" str"
|
||||
|
|
|
|||
|
|
@ -415,22 +415,67 @@
|
|||
"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
|
||||
;; search for the config file can trip over filesystem
|
||||
;; restrictions imposed by security guards.
|
||||
(lambda ()
|
||||
(let ([d (let ([c (find-system-path 'config-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 "links.rktd"))))))
|
||||
(define-values (links-cache) (make-hasheq))
|
||||
(define-values (links-stamp) #f)
|
||||
|
||||
(define-values (find-config-dir)
|
||||
(lambda ()
|
||||
(let ([c (find-system-path 'config-dir)])
|
||||
(if (complete-path? c)
|
||||
c
|
||||
(or (and (relative-path? c)
|
||||
(parameterize ([current-directory (find-system-path 'orig-dir)])
|
||||
(find-executable-path (find-system-path 'exec-file) c)))
|
||||
(let ([exec (path->complete-path
|
||||
(find-executable-path (find-system-path 'exec-file))
|
||||
(find-system-path 'orig-dir))])
|
||||
(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!
|
||||
;; 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)
|
||||
(lambda (path)
|
||||
|
|
@ -469,7 +514,7 @@
|
|||
(lambda () (close-input-port p)))))))))
|
||||
|
||||
(define-values (get-linked-collections)
|
||||
(lambda (user? shared?)
|
||||
(lambda (user? shared? ii)
|
||||
(call/ec (lambda (esc)
|
||||
(define-values (make-handler)
|
||||
(lambda (ts)
|
||||
|
|
@ -477,13 +522,13 @@
|
|||
(if (exn:fail? exn)
|
||||
(let ([l (current-logger)])
|
||||
(when (log-level? l 'error)
|
||||
(log-message l 'error
|
||||
(log-message l 'error
|
||||
(format
|
||||
"error reading collection links file ~s: ~a"
|
||||
(cond
|
||||
[user? user-links-path]
|
||||
[shared? shared-links-path]
|
||||
[else links-path])
|
||||
[else (vector-ref links-paths ii)])
|
||||
(exn-message exn))
|
||||
(current-continuation-marks))))
|
||||
(void))
|
||||
|
|
@ -496,8 +541,8 @@
|
|||
(set! shared-links-cache (make-hasheq))
|
||||
(set! shared-links-stamp ts)]
|
||||
[else
|
||||
(set! links-cache (make-hasheq))
|
||||
(set! links-stamp ts)]))
|
||||
(vector-set! links-caches ii (make-hasheq))
|
||||
(vector-set! links-stamps ii ts)]))
|
||||
(if (exn:fail? exn)
|
||||
(esc (make-hasheq))
|
||||
;; re-raise the exception (which is probably a break)
|
||||
|
|
@ -508,12 +553,12 @@
|
|||
(let* ([a-links-path (cond
|
||||
[user? user-links-path]
|
||||
[shared? shared-links-path]
|
||||
[else links-path])]
|
||||
[else (vector-ref links-paths ii)])]
|
||||
[ts (file->stamp a-links-path)])
|
||||
(if (not (equal? ts (cond
|
||||
[user? user-links-stamp]
|
||||
[shared? shared-links-stamp]
|
||||
[else links-stamp])))
|
||||
[else (vector-ref links-stamps ii)])))
|
||||
(with-continuation-mark
|
||||
exception-handler-key
|
||||
(make-handler ts)
|
||||
|
|
@ -590,13 +635,13 @@
|
|||
(set! shared-links-cache ht)
|
||||
(set! shared-links-stamp ts)]
|
||||
[else
|
||||
(set! links-cache ht)
|
||||
(set! links-stamp ts)])
|
||||
(vector-set! links-caches ii ht)
|
||||
(vector-set! links-stamps ii ts)])
|
||||
ht))))
|
||||
(cond
|
||||
[user? user-links-cache]
|
||||
[shared? shared-links-cache]
|
||||
[else links-cache]))))))))
|
||||
[else (vector-ref links-caches ii)]))))))))
|
||||
|
||||
(define-values (normalize-collection-reference)
|
||||
(lambda (collection collection-path)
|
||||
|
|
@ -631,18 +676,22 @@
|
|||
;; list of paths and (box path)s:
|
||||
(if (and links? (use-user-specific-search-paths))
|
||||
(append
|
||||
(let ([ht (get-linked-collections #t #f)])
|
||||
(let ([ht (get-linked-collections #t #f 0)])
|
||||
(append (hash-ref ht sym null)
|
||||
(hash-ref ht #f null)))
|
||||
(let ([ht (get-linked-collections #f #t)])
|
||||
(let ([ht (get-linked-collections #f #t 0)])
|
||||
(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 #f)])
|
||||
(append (hash-ref ht sym null)
|
||||
(hash-ref ht #f null)))
|
||||
(if links?
|
||||
(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)
|
||||
(hash-ref ht #f null)
|
||||
(loop (add1 ii))))))
|
||||
null)
|
||||
;; list of paths:
|
||||
(current-library-collection-paths)))])
|
||||
|
|
@ -795,39 +844,42 @@
|
|||
[(extra-collects-dirs) (find-library-collection-paths extra-collects-dirs null)]
|
||||
[(extra-collects-dirs post-collects-dirs)
|
||||
(let ([user-too? (use-user-specific-search-paths)]
|
||||
[cons-if (lambda (f r) (if f (cons f r) r))])
|
||||
(path-list-string->path-list
|
||||
(if user-too?
|
||||
[cons-if (lambda (f r) (if f (cons f r) r))])
|
||||
(path-list-string->path-list
|
||||
(if user-too?
|
||||
(let ([c (environment-variables-ref (current-environment-variables)
|
||||
#"PLTCOLLECTS")])
|
||||
(if c
|
||||
(bytes->string/locale c #\?)
|
||||
""))
|
||||
"")
|
||||
(cons-if
|
||||
(and user-too?
|
||||
(build-path (find-system-path 'addon-dir)
|
||||
(version)
|
||||
"collects"))
|
||||
(let loop ([l (append
|
||||
extra-collects-dirs
|
||||
(list (find-system-path 'collects-dir))
|
||||
post-collects-dirs)])
|
||||
(if (null? l)
|
||||
null
|
||||
(let* ([collects-path (car l)]
|
||||
[v
|
||||
(cond
|
||||
[(complete-path? collects-path) collects-path]
|
||||
[(absolute-path? collects-path)
|
||||
(path->complete-path collects-path
|
||||
(find-executable-path (find-system-path 'exec-file) #f #t))]
|
||||
[else
|
||||
(find-executable-path (find-system-path 'exec-file) collects-path #t)])])
|
||||
(if v
|
||||
(cons (simplify-path (path->complete-path v (current-directory)))
|
||||
(loop (cdr l)))
|
||||
(loop (cdr l)))))))))]))
|
||||
"")
|
||||
(add-config-search
|
||||
(get-config-table (find-config-dir))
|
||||
'collects-search-dirs
|
||||
(cons-if
|
||||
(and user-too?
|
||||
(build-path (find-system-path 'addon-dir)
|
||||
(version)
|
||||
"collects"))
|
||||
(let loop ([l (append
|
||||
extra-collects-dirs
|
||||
(list (find-system-path 'collects-dir))
|
||||
post-collects-dirs)])
|
||||
(if (null? l)
|
||||
null
|
||||
(let* ([collects-path (car l)]
|
||||
[v
|
||||
(cond
|
||||
[(complete-path? collects-path) collects-path]
|
||||
[(absolute-path? collects-path)
|
||||
(path->complete-path collects-path
|
||||
(find-executable-path (find-system-path 'exec-file) #f #t))]
|
||||
[else
|
||||
(find-executable-path (find-system-path 'exec-file) collects-path #t)])])
|
||||
(if v
|
||||
(cons (simplify-path (path->complete-path v (current-directory)))
|
||||
(loop (cdr l)))
|
||||
(loop (cdr l))))))))))]))
|
||||
|
||||
;; used for the -k command-line argument:
|
||||
(define (embedded-load start end str)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user