more `raco link' command-line changes: add -u, adjust -rn
This commit is contained in:
Matthew Flatt
parent
96098e678c
commit
71e92bcecf
|
|
@ -45,17 +45,19 @@ Full command-line options:
|
|||
@item{@Flag{l} or @DFlag{list} --- Shows the current link table. If
|
||||
any other command-line arguments are provided that modify the
|
||||
link table, the table is shown after modifications. If no
|
||||
directory arguments are provided, and if none of @Flag{r},
|
||||
@DFlag{remove}, @Flag{i}, @DFlag{installation}, @Flag{f}, or
|
||||
directory arguments are provided, and if none of @Flag{u},
|
||||
@DFlag{user}, @Flag{i}, @DFlag{installation}, @Flag{f}, or
|
||||
@DFlag{file} are specified, then the link table is shown for
|
||||
both the user-specific and installation-wide @tech[#:doc
|
||||
reference-doc]{collection links files}.}
|
||||
|
||||
@item{@Flag{n} @nonterm{name} or @DFlag{name} @nonterm{name} --- Sets
|
||||
the collection name for adding or removing a single link. By
|
||||
default, the collection name for an added link is derived from
|
||||
the directory name. When the @Flag{r} or @DFlag{remove} flag is
|
||||
also used, only links with a collection name matching
|
||||
the collection name for adding a single link or removing
|
||||
matching links. By default, the collection name for an added
|
||||
link is derived from the directory name. When the @Flag{r} or
|
||||
@DFlag{remove} flag is also used, only links with a collection
|
||||
name matching @nonterm{name} are removed, and if no directory
|
||||
arguments are provided, all links with a match to
|
||||
@nonterm{name} are removed.}
|
||||
|
||||
@item{@Flag{x} @nonterm{regexp} or @DFlag{version-regexp}
|
||||
|
|
@ -65,17 +67,28 @@ Full command-line options:
|
|||
or @DFlag{remove} flag is also used, only links with a
|
||||
version regexp matching @nonterm{regexp} are removed.}
|
||||
|
||||
@item{@Flag{r} or @DFlag{remove} --- Selects remove mode instead
|
||||
of add mode.}
|
||||
|
||||
@item{@Flag{u} or @DFlag{user} --- Limits listing and removal
|
||||
of links to the user-specific @tech[#:doc
|
||||
reference-doc]{collection links file} and not the
|
||||
collection-wide @tech[#:doc reference-doc]{collection links
|
||||
file}. This flag is mutually exclusive with @Flag{i},
|
||||
@DFlag{installation}, @Flag{f}, and @DFlag{file}.}
|
||||
|
||||
@item{@Flag{i} or @DFlag{installation} --- Reads and writes links in
|
||||
installation-wide @tech[#:doc reference-doc]{collection links
|
||||
file} instead of the user-specific @tech[#:doc
|
||||
reference-doc]{collection links file}. This flag is mutally
|
||||
exclusive with @Flag{f} and @DFlag{file}.}
|
||||
file} and not the user-specific @tech[#:doc
|
||||
reference-doc]{collection links file}. This flag is mutually
|
||||
exclusive with @Flag{u}, @DFlag{user}, @Flag{f}, and
|
||||
@DFlag{file}.}
|
||||
|
||||
@item{@Flag{f} @nonterm{file} or @DFlag{file} @nonterm{file} ---
|
||||
Reads and writes links in @nonterm{file} instead of the
|
||||
user-specific @tech[#:doc reference-doc]{collection links
|
||||
file}. This flag is mutally exclusive with @Flag{i} and
|
||||
@DFlag{installation}.}
|
||||
file}. This flag is mutually exclusive with @Flag{u},
|
||||
@DFlag{user}, @Flag{i}, and @DFlag{installation}.}
|
||||
|
||||
@item{@DFlag{repair} --- Enables repairs to the existing file content
|
||||
when the content is erroneous. The file is repaired by deleting
|
||||
|
|
@ -89,19 +102,28 @@ Full command-line options:
|
|||
|
||||
@defmodule[setup/link]
|
||||
|
||||
@defproc[(links [dirs (listof path?)]
|
||||
[#:file file path-string? (find-system-path 'links-file)]
|
||||
@defproc[(links [dir path?] ...
|
||||
[#:user? user? #t]
|
||||
[#:file file (or/c path-string? #f) #f]
|
||||
[#:name name (or/c string? #f) #f]
|
||||
[#:version-regexp version-regexp (or/c regexp? #f) #f]
|
||||
[#:error error-proc (symbol? string? any/c ... . -> . any) error]
|
||||
[#:remove? remove? any/c #f]
|
||||
[#:show? show? any/c #f]
|
||||
[#:repair? repair? any/c #f])
|
||||
(listof string?)]{
|
||||
list?]{
|
||||
|
||||
A function version of the @exec{raco link} command. The
|
||||
@racket[error-proc] argument is called to raise exceptions that would
|
||||
be fatal to the @exec{raco link} command.
|
||||
A function version of the @exec{raco link} command that always works
|
||||
on a single file---either @racket[file] if it is a path string, the
|
||||
user-specific @tech[#:doc reference-doc]{collection links file} if
|
||||
@racket[user?] is true, of the installation-wide @tech[#:doc
|
||||
reference-doc]{collection links file} if @racket[user?] is false.
|
||||
|
||||
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.}
|
||||
|
||||
The result is a list of top-level collections that are mapped by
|
||||
@racket[file] and that apply to the running version of Racket.}
|
||||
|
|
|
|||
|
|
@ -9,7 +9,8 @@
|
|||
(define remove-mode (make-parameter #f))
|
||||
(define repair-mode (make-parameter #f))
|
||||
(define show-mode (make-parameter #f))
|
||||
(define user-mode (make-parameter #t))
|
||||
(define install-only (make-parameter #f))
|
||||
(define user-only (make-parameter #f))
|
||||
|
||||
(define link-symbol (string->symbol (short-program+command-name)))
|
||||
|
||||
|
|
@ -19,7 +20,7 @@
|
|||
#:once-each
|
||||
[("-l" "--list") "Show the link table (after changes)"
|
||||
(show-mode #t)]
|
||||
[("-n" "--name") name "Set the collection name (for a single directory)"
|
||||
[("-n" "--name") name "Collection name to add (single <dir>) or remove"
|
||||
(link-name name)]
|
||||
[("-x" "--version-regexp") regexp "Set the version pregexp"
|
||||
(with-handlers ([exn:fail:contract? (lambda (exn)
|
||||
|
|
@ -30,8 +31,10 @@
|
|||
[("-r" "--remove") "Remove links for the specified directories"
|
||||
(remove-mode #t)]
|
||||
#:once-any
|
||||
[("-i" "--installation") "Adjust user-independent links in the installation"
|
||||
(user-mode #f)]
|
||||
[("-u" "--user") "Adjust/list user-specific links"
|
||||
(user-only #t)]
|
||||
[("-i" "--installation") "Adjust/list installation-wide links"
|
||||
(install-only #t)]
|
||||
[("-f" "--file") file "Select an alternate link file"
|
||||
(link-file (path->complete-path file))]
|
||||
#:once-each
|
||||
|
|
@ -41,6 +44,7 @@
|
|||
dir dir))
|
||||
|
||||
(when (and (link-name)
|
||||
(not (remove-mode))
|
||||
(not (= 1 (length dirs))))
|
||||
(raise-user-error link-symbol
|
||||
"expected a single directory for `--name' mode"))
|
||||
|
|
@ -48,27 +52,41 @@
|
|||
(define show-both?
|
||||
(and (null? dirs)
|
||||
(show-mode)
|
||||
(user-mode)
|
||||
(not (remove-mode))
|
||||
(not (user-only))
|
||||
(not (install-only))
|
||||
(not (link-file))))
|
||||
|
||||
(when show-both?
|
||||
(printf "User links:\n"))
|
||||
|
||||
(void
|
||||
(apply links
|
||||
dirs
|
||||
#:user? (user-mode)
|
||||
#:file (link-file)
|
||||
#:name (link-name)
|
||||
#:version-regexp (link-version)
|
||||
#:error (lambda (who . args)
|
||||
(apply raise-user-error link-symbol args))
|
||||
#:remove? (remove-mode)
|
||||
#:show? (show-mode)
|
||||
#:repair? (repair-mode)))
|
||||
(define (go user?)
|
||||
(apply links
|
||||
dirs
|
||||
#:user? user?
|
||||
#:file (link-file)
|
||||
#:name (link-name)
|
||||
#:version-regexp (link-version)
|
||||
#:error (lambda (who . args)
|
||||
(apply raise-user-error link-symbol args))
|
||||
#:remove? (remove-mode)
|
||||
#:show? (show-mode)
|
||||
#:repair? (repair-mode)))
|
||||
|
||||
(define l1
|
||||
(go (not (install-only))))
|
||||
(define l2
|
||||
(if (and (not (or (user-only)
|
||||
(install-only)))
|
||||
(remove-mode))
|
||||
(go #f)
|
||||
null))
|
||||
|
||||
(when show-both?
|
||||
(printf "Installation links:\n")
|
||||
(void (links #:user? #f #:show? #t)))
|
||||
|
||||
(when (and (remove-mode)
|
||||
(null? l1)
|
||||
(null? l2))
|
||||
(printf "[no links removed]\n"))
|
||||
|
||||
|
|
|
|||
|
|
@ -82,13 +82,18 @@
|
|||
|
||||
(define new-table
|
||||
(reverse
|
||||
(for/fold ([table (reverse table)]) ([d (in-list dirs)])
|
||||
(let* ([dp (path->complete-path d)]
|
||||
[a-name (or name
|
||||
(let-values ([(base name dir?) (split-path dp)])
|
||||
(path-element->string name)))]
|
||||
(for/fold ([table (reverse table)]) ([d (in-list
|
||||
(if (and (null? dirs)
|
||||
name)
|
||||
'(#f)
|
||||
dirs))])
|
||||
(let* ([dp (and d (path->complete-path d))]
|
||||
[a-name (and d
|
||||
(or name
|
||||
(let-values ([(base name dir?) (split-path dp)])
|
||||
(path-element->string name))))]
|
||||
[rx version-regexp]
|
||||
[d (path->string dp)])
|
||||
[d (and dp (path->string dp))])
|
||||
(unless remove?
|
||||
(unless (directory-exists? dp)
|
||||
(error 'links
|
||||
|
|
@ -96,7 +101,8 @@
|
|||
dp)))
|
||||
(if remove?
|
||||
(filter (lambda (e)
|
||||
(or (not (equal? (cadr e) d))
|
||||
(or (and d
|
||||
(not (equal? (cadr e) d)))
|
||||
(and name
|
||||
(not (equal? (car e) name)))
|
||||
(and version-regexp
|
||||
|
|
@ -148,10 +154,13 @@
|
|||
(format " version: ~s"
|
||||
(caddr e))))))
|
||||
|
||||
;; Return list of collections mapped for this version:
|
||||
(let ([ht (make-hash)])
|
||||
(for ([e (in-list new-table)])
|
||||
(when (or (null? (cddr e))
|
||||
(regexp-match? (caddr e) (version)))
|
||||
(hash-set! ht (car e) #t)))
|
||||
(hash-map ht (lambda (k e) k))))
|
||||
(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)))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user