add support for collection roots to the collection links file
This commit is contained in:
Matthew Flatt
parent
8f0487d8e4
commit
84e3ab2a20
|
|
@ -58,7 +58,15 @@ Full command-line options:
|
|||
@DFlag{remove} flag is also used, only links with a collection
|
||||
name matching @nonterm{name} are removed, and if no directory
|
||||
arguments are provided, all links with a match to
|
||||
@nonterm{name} are removed.}
|
||||
@nonterm{name} are removed. This flag is mutually exclusive with
|
||||
@Flag{d} and @DFlag{root}.}
|
||||
|
||||
@item{@Flag{d} or @DFlag{root} --- Treats each directory as a
|
||||
collection root that contains collection directories, instead of
|
||||
a directory for a specific collection. When the @Flag{r} or
|
||||
@DFlag{remove} flag is also used, only collection-root links
|
||||
that match a directory are removed. This flag is mutually
|
||||
exclusive with @Flag{n} and @DFlag{name}.}
|
||||
|
||||
@item{@Flag{x} @nonterm{regexp} or @DFlag{version-regexp}
|
||||
@nonterm{regexp} --- Sets a version regexp that limits the link
|
||||
|
|
@ -106,6 +114,7 @@ Full command-line options:
|
|||
[#:user? user? #t]
|
||||
[#:file file (or/c path-string? #f) #f]
|
||||
[#:name name (or/c string? #f) #f]
|
||||
[#:root? root? any/c #f]
|
||||
[#:version-regexp version-regexp (or/c regexp? #f) #f]
|
||||
[#:error error-proc (symbol? string? any/c ... . -> . any) error]
|
||||
[#:remove? remove? any/c #f]
|
||||
|
|
@ -122,8 +131,10 @@ reference-doc]{collection links file} if @racket[user?] is false.
|
|||
The @racket[error-proc] argument is called to raise exceptions that
|
||||
would be fatal to the @exec{raco link} command.
|
||||
|
||||
If @racket[remove?] is false, the result is a list of top-level
|
||||
collection names (as strings) that are mapped by @racket[file] and
|
||||
that apply to the running version of Racket. If @racket[remove?] is
|
||||
true, the result is a list of entries that were removed from the file.}
|
||||
|
||||
If @racket[remove?] is true, the result is a list of entries that were
|
||||
removed from the file. If @racket[remove?] is false but
|
||||
@racket[root?] is true, the result is a list of paths for collection
|
||||
roots. If @racket[remove?] and @racket[root?] are both false, the
|
||||
result is a list of top-level collection names (as strings) that are
|
||||
mapped by @racket[file] and that apply to the running version of
|
||||
Racket.}
|
||||
|
|
|
|||
|
|
@ -185,21 +185,23 @@ the file is re-read if its timestamp changes.
|
|||
|
||||
Each @tech{collection links file} is @racket[read] with default reader
|
||||
parameter settings to obtain a list. Every element of the list must be
|
||||
a link specification with either the form @racket[(_string _path)] or
|
||||
the form @racket[(_string _path _regexp)]. In both cases, the
|
||||
@racket[_string] names a top-level @tech{collection}, and
|
||||
@racket[_path] is a path that can be used as the collection's path
|
||||
(directly, as opposed to a subdirectory of @racket[_path] named by
|
||||
@racket[_string]). If @racket[_path] is a relative path, it is
|
||||
relative to the directory containing the @tech{collection links
|
||||
file}. If @racket[_regexp] is specified in a link, then the link is
|
||||
used only if @racket[(regexp-match? _regexp (version))] produces a
|
||||
true result.
|
||||
a link specification with one of the forms @racket[(list _string
|
||||
_path)], @racket[(list _string _path _regexp)], @racket[(list 'root
|
||||
_path)], or @racket[(list 'root _regexp)]. A @racket[_string] names a
|
||||
top-level @tech{collection}, in which case @racket[_path] is a path
|
||||
that can be used as the collection's path (directly, as opposed to a
|
||||
subdirectory of @racket[_path] named by @racket[_string]). A
|
||||
@racket['root] entry, in contrast, acts like an path in
|
||||
@racket[(current-library-collection-paths)]. If @racket[_path] is a
|
||||
relative path, it is relative to the directory containing the
|
||||
@tech{collection links file}. If @racket[_regexp] is specified in a
|
||||
link, then the link is used only if @racket[(regexp-match? _regexp
|
||||
(version))] produces a true result.
|
||||
|
||||
A single top-level collection can have multiple links in a
|
||||
@tech{collection links file}. The corresponding paths are effectively
|
||||
spliced together, since the paths are tried in order to locate a file
|
||||
or sub-collection.
|
||||
@tech{collection links file}, and any number of @racket['root] entries
|
||||
can appear. The corresponding paths are effectively spliced together,
|
||||
since the paths are tried in order to locate a file or sub-collection.
|
||||
|
||||
The @exec{raco link} command-link tool can display, install, and
|
||||
remove links in the @tech{collection links file}. See @secref[#:doc
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@
|
|||
|
||||
(define link-file (make-parameter #f))
|
||||
(define link-name (make-parameter #f))
|
||||
(define root-mode (make-parameter #f))
|
||||
(define link-version (make-parameter #f))
|
||||
(define remove-mode (make-parameter #f))
|
||||
(define repair-mode (make-parameter #f))
|
||||
|
|
@ -20,8 +21,12 @@
|
|||
#:once-each
|
||||
[("-l" "--list") "Show the link table (after changes)"
|
||||
(show-mode #t)]
|
||||
#:once-any
|
||||
[("-n" "--name") name "Collection name to add (single <dir>) or remove"
|
||||
(link-name name)]
|
||||
[("-d" "--root") "Treat <dir> as a collection root"
|
||||
(root-mode #t)]
|
||||
#:once-each
|
||||
[("-x" "--version-regexp") regexp "Set the version pregexp"
|
||||
(with-handlers ([exn:fail:contract? (lambda (exn)
|
||||
(raise-user-error link-symbol
|
||||
|
|
@ -62,6 +67,7 @@
|
|||
(define (go user?)
|
||||
(apply links
|
||||
dirs
|
||||
#:root? (root-mode)
|
||||
#:user? user?
|
||||
#:file (link-file)
|
||||
#:name (link-name)
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@
|
|||
#:file [in-file #f]
|
||||
#:name [name #f]
|
||||
#:version-regexp [version-regexp #f]
|
||||
#:root? [root? #f]
|
||||
#:remove? [remove? #f]
|
||||
#:show? [show? #f]
|
||||
#:repair? [repair? #f]
|
||||
|
|
@ -56,8 +57,9 @@
|
|||
(= 3 (length e))))
|
||||
(content-error "entry is a not a 2- or 3-element list: " e))
|
||||
#:when
|
||||
(or (string? (car e))
|
||||
(content-error "entry's first element is not a string: " e))
|
||||
(or (or (string? (car e))
|
||||
(eq? 'root (car e)))
|
||||
(content-error "entry's first element is not a string or 'root: " e))
|
||||
#:when
|
||||
(or (path-string? (cadr e))
|
||||
(content-error "entry's second element is not a path string: " e))
|
||||
|
|
@ -100,24 +102,29 @@
|
|||
(find-relative-path file-dir
|
||||
(simplify-path
|
||||
(path->complete-path d))))]
|
||||
[a-name (and d
|
||||
(or name
|
||||
(let-values ([(base name dir?) (split-path dp)])
|
||||
(path-element->string name))))]
|
||||
[a-name (if root?
|
||||
'root
|
||||
(and d
|
||||
(or name
|
||||
(let-values ([(base name dir?) (split-path dp)])
|
||||
(path-element->string name)))))]
|
||||
[rx version-regexp]
|
||||
[d (and dp (path->string dp))])
|
||||
[d (and dp (path->string dp))]
|
||||
[sd (and d (simplify d))])
|
||||
(unless remove?
|
||||
(unless (directory-exists? dp)
|
||||
(unless (directory-exists? sd)
|
||||
(error 'links
|
||||
"no such directory for link: ~a"
|
||||
dp)))
|
||||
sd)))
|
||||
(if remove?
|
||||
(filter (lambda (e)
|
||||
(or (and d
|
||||
(not (equal? (simplify (cadr e))
|
||||
(simplify d))))
|
||||
sd)))
|
||||
(and name
|
||||
(not (equal? (car e) name)))
|
||||
(and root?
|
||||
(not (eq? (car e) 'root)))
|
||||
(and version-regexp
|
||||
(pair? (cddr e))
|
||||
(not (equal? (caddr e) version-regexp)))))
|
||||
|
|
@ -159,7 +166,10 @@
|
|||
|
||||
(when show?
|
||||
(for ([e (in-list new-table)])
|
||||
(printf " collection: ~s path: ~s~a\n"
|
||||
(printf " ~a~s path: ~s~a\n"
|
||||
(if (eq? (car e) 'root)
|
||||
""
|
||||
"collection: ")
|
||||
(car e)
|
||||
(path->string (simplify (cadr e)))
|
||||
(if (null? (cddr e))
|
||||
|
|
@ -170,10 +180,17 @@
|
|||
(if remove?
|
||||
;; return list of removed entries:
|
||||
(filter (lambda (e) (not (member e new-table))) table)
|
||||
;; Return list of collections mapped for this version:
|
||||
(let ([ht (make-hash)])
|
||||
(for ([e (in-list new-table)])
|
||||
(when (or (null? (cddr e))
|
||||
(regexp-match? (caddr e) (version)))
|
||||
(hash-set! ht (car e) #t)))
|
||||
(hash-map ht (lambda (k e) k)))))
|
||||
(if root?
|
||||
;; Return root paths:
|
||||
(for/list ([e (in-list new-table)]
|
||||
#:when (eq? 'root (car e)))
|
||||
(simplify (cadr e)))
|
||||
;; Return list of collections mapped for this version:
|
||||
(let ([ht (make-hash)])
|
||||
(for ([e (in-list new-table)])
|
||||
(when (and (string? (car e))
|
||||
(or (null? (cddr e))
|
||||
(regexp-match? (caddr e) (version))))
|
||||
(hash-set! ht (car e) #t)))
|
||||
(hash-map ht (lambda (k e) k))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -283,31 +283,41 @@
|
|||
|
||||
(define all-collections
|
||||
(let ([ht (make-hash)])
|
||||
(define (maybe collection ->cc)
|
||||
(hash-ref ht collection
|
||||
(lambda ()
|
||||
(let ([cc (->cc collection)])
|
||||
(when cc (hash-set! ht collection cc))))))
|
||||
(for ([cp (current-library-collection-paths)]
|
||||
#:when (directory-exists? cp)
|
||||
[collection (directory-list cp)]
|
||||
#:when (directory-exists? (build-path cp collection)))
|
||||
(hash-ref ht collection
|
||||
(lambda ()
|
||||
(let ([cc (collection->cc (list collection))])
|
||||
(when cc (hash-set! ht collection cc))))))
|
||||
(maybe (list collection) collection->cc))
|
||||
(let ([main-collects (find-collects-dir)])
|
||||
(define (->cc col)
|
||||
(collection->cc col
|
||||
#:info-root main-collects
|
||||
#:info-path-mode 'abs-in-relative
|
||||
#:omit-root 'dir))
|
||||
(for ([c (in-list (links #:user? #f))])
|
||||
(let* ([c (string->path c)]
|
||||
[cc (collection->cc (list c)
|
||||
#:info-root main-collects
|
||||
#:info-path-mode 'abs-in-relative
|
||||
#:omit-root 'dir)])
|
||||
(when cc (hash-set! ht c cc)))))
|
||||
(maybe (list (string->path c)) ->cc))
|
||||
(for ([cp (in-list (links #:root? #t #:user? #f))]
|
||||
#:when (directory-exists? cp)
|
||||
[collection (directory-list cp)])
|
||||
(maybe (list collection) ->cc)))
|
||||
(when (make-user)
|
||||
(let ([user-collects (find-user-collects-dir)])
|
||||
(define (->cc col)
|
||||
(collection->cc col
|
||||
#:info-root user-collects
|
||||
#:info-path-mode 'abs-in-relative
|
||||
#:omit-root 'dir))
|
||||
(for ([c (in-list (links))])
|
||||
(let* ([c (string->path c)]
|
||||
[cc (collection->cc (list c)
|
||||
#:info-root user-collects
|
||||
#:info-path-mode 'abs-in-relative
|
||||
#:omit-root 'dir)])
|
||||
(when cc (hash-set! ht c cc))))))
|
||||
(maybe (list (string->path c)) ->cc))
|
||||
(for ([cp (in-list (links #:root? #t))]
|
||||
#:when (directory-exists? cp)
|
||||
[collection (directory-list cp)])
|
||||
(maybe (list collection) ->cc))))
|
||||
(hash-map ht (lambda (k v) v))))
|
||||
|
||||
;; Close over sub-collections
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -311,7 +311,8 @@
|
|||
"(when(log-level? l 'error)"
|
||||
"(log-message l 'error "
|
||||
"(format"
|
||||
" \"error reading linked collections: ~a\""
|
||||
" \"error reading collection links file ~s: ~a\""
|
||||
"(if user? user-links-path links-path)"
|
||||
"(exn-message exn))"
|
||||
"(current-continuation-marks))))"
|
||||
"(when ts"
|
||||
|
|
@ -364,7 +365,8 @@
|
|||
"(and(list? p)"
|
||||
"(or(= 2(length p))"
|
||||
"(= 3(length p)))"
|
||||
"(string?(car p))"
|
||||
"(or(string?(car p))"
|
||||
"(eq? 'root(car p)))"
|
||||
"(path-string?(cadr p))"
|
||||
"(or(null?(cddr p))"
|
||||
"(regexp?(caddr p)))))"
|
||||
|
|
@ -379,10 +381,23 @@
|
|||
"(lambda(p)"
|
||||
"(when(or(null?(cddr p))"
|
||||
"(regexp-match?(caddr p)(version)))"
|
||||
"(let((dir(simplify-path"
|
||||
"(path->complete-path(cadr p) dir))))"
|
||||
"(if(symbol?(car p))"
|
||||
"(begin"
|
||||
"(unless(hash-ref ht #f #f)"
|
||||
"(hash-set! ht #f null))"
|
||||
"(hash-for-each"
|
||||
" ht"
|
||||
"(lambda(k v)"
|
||||
"(hash-set! ht k(cons dir v)))))"
|
||||
"(let((s(string->symbol(car p))))"
|
||||
"(hash-set! ht s(cons(box(path->complete-path(cadr p) dir))"
|
||||
"(hash-ref ht s null))))))"
|
||||
"(hash-set! ht s(cons(box dir)"
|
||||
"(hash-ref ht s null))))))))"
|
||||
" v)"
|
||||
"(hash-for-each"
|
||||
" ht"
|
||||
"(lambda(k v)(hash-set! ht k(reverse v))))"
|
||||
"(if user?"
|
||||
"(begin"
|
||||
"(set! user-links-cache ht)"
|
||||
|
|
@ -422,10 +437,14 @@
|
|||
" collection))))"
|
||||
"(append"
|
||||
"(if(use-user-specific-search-paths)"
|
||||
"(hash-ref(get-linked-collections #t) sym null)"
|
||||
"(let((ht(get-linked-collections #t)))"
|
||||
"(or(hash-ref ht sym #f)"
|
||||
"(hash-ref ht #f null)))"
|
||||
" null)"
|
||||
"(if links-path"
|
||||
"(hash-ref(get-linked-collections #f) sym null)"
|
||||
"(let((ht(get-linked-collections #f)))"
|
||||
"(or(hash-ref ht sym #f)"
|
||||
"(hash-ref ht #f null)))"
|
||||
" null)"
|
||||
"(current-library-collection-paths)))))"
|
||||
"(define-values(*build-path-rep)"
|
||||
|
|
|
|||
|
|
@ -379,7 +379,8 @@
|
|||
(when (log-level? l 'error)
|
||||
(log-message l 'error
|
||||
(format
|
||||
"error reading linked collections: ~a"
|
||||
"error reading collection links file ~s: ~a"
|
||||
(if user? user-links-path links-path)
|
||||
(exn-message exn))
|
||||
(current-continuation-marks))))
|
||||
(when ts
|
||||
|
|
@ -432,7 +433,8 @@
|
|||
(and (list? p)
|
||||
(or (= 2 (length p))
|
||||
(= 3 (length p)))
|
||||
(string? (car p))
|
||||
(or (string? (car p))
|
||||
(eq? 'root (car p)))
|
||||
(path-string? (cadr p))
|
||||
(or (null? (cddr p))
|
||||
(regexp? (caddr p)))))
|
||||
|
|
@ -447,10 +449,29 @@
|
|||
(lambda (p)
|
||||
(when (or (null? (cddr p))
|
||||
(regexp-match? (caddr p) (version)))
|
||||
(let ([s (string->symbol (car p))])
|
||||
(hash-set! ht s (cons (box (path->complete-path (cadr p) dir))
|
||||
(hash-ref ht s null))))))
|
||||
(let ([dir (simplify-path
|
||||
(path->complete-path (cadr p) dir))])
|
||||
(if (symbol? (car p))
|
||||
;; add to every table element (to keep
|
||||
;; the choices in order); need a better
|
||||
;; data structure
|
||||
(begin
|
||||
(unless (hash-ref ht #f #f)
|
||||
(hash-set! ht #f null))
|
||||
(hash-for-each
|
||||
ht
|
||||
(lambda (k v)
|
||||
(hash-set! ht k (cons dir v)))))
|
||||
;; single collection:
|
||||
(let ([s (string->symbol (car p))])
|
||||
(hash-set! ht s (cons (box dir)
|
||||
(hash-ref ht s null))))))))
|
||||
v)
|
||||
;; reverse all lists:
|
||||
(hash-for-each
|
||||
ht
|
||||
(lambda (k v) (hash-set! ht k (reverse v))))
|
||||
;; save table & timestamp:
|
||||
(if user?
|
||||
(begin
|
||||
(set! user-links-cache ht)
|
||||
|
|
@ -492,13 +513,17 @@
|
|||
(path->string collection)
|
||||
collection))])
|
||||
(append
|
||||
;; list of (box path)s:
|
||||
;; list of paths and (box path)s:
|
||||
(if (use-user-specific-search-paths)
|
||||
(hash-ref (get-linked-collections #t) sym null)
|
||||
(let ([ht (get-linked-collections #t)])
|
||||
(or (hash-ref ht sym #f)
|
||||
(hash-ref ht #f null)))
|
||||
null)
|
||||
;; list of (box path)s:
|
||||
;; list of paths and (box path)s:
|
||||
(if links-path
|
||||
(hash-ref (get-linked-collections #f) sym null)
|
||||
(let ([ht (get-linked-collections #f)])
|
||||
(or (hash-ref ht sym #f)
|
||||
(hash-ref ht #f null)))
|
||||
null)
|
||||
;; list of paths:
|
||||
(current-library-collection-paths)))])
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user