use `filesystem-change-evt' and static roots to speed library search

Use `filesystem-change-evt' (where supported) to detect changes to
collection link files.

Add "static root" as a new kind of collection root directory in links
files. A static root directory is assumed to not change (in terms of
its collection subdirectories) as long as the links file itself does
not change.

Propagate the notion of static roots through `raco link' and `raco pkg
install'.

Change the `pkg-links' makefile target to install static links
instead of plain links.

The result of all of these changes is to cut 25%-33% of the
time for `racket -l racket', bringing it back in line with
the pre-package-reorganization time.

pkgs/drracket-pkgs/drracket/pkg/gui/by-list.rkt

@@ -234,7 +234,9 @@
       (send install-button enable (and (pair? sels)
                                        (or (and all-installed?
                                                 (not (for/or ([p (in-list sels)])
-                                                       (eq? 'link (car (pkg-info-orig-pkg (cdr p)))))))
+                                                       (define kind (car (pkg-info-orig-pkg (cdr p))))
+                                                       (or (eq? 'link kind)
+                                                           (eq? 'static-link kind)))))
                                            none-installed?)))
       (send install-button set-label (if all-installed?
                                          (string-constant install-pkg-update)
@@ -462,6 +464,7 @@
                     (case (car (pkg-info-orig-pkg info))
                       [(catalog) ""]
                       [(link) "="]
+                      [(static-link) "="]
                       [(url) "@"]))]))
             (for/list ([p list-pkgs]) (->label-string (db:pkg-name p)))
             (for/list ([p list-pkgs]) (->label-string (db:pkg-author p)))

pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl

@@ -70,7 +70,8 @@ catalogs}.}
 
 @defstruct[pkg-info ([orig-pkg (or/c (list/c 'catalog string?)
                                      (list/c 'url string?)
-                                     (list/c 'link string?))]
+                                     (list/c 'link string?)
+                                     (list/c 'static-link string?))]
                      [checksum (or/c #f string?)]
                      [auto? boolean?])
                      #:prefab]{
@@ -117,7 +118,8 @@ scope}.}
 @deftogether[(
 @defproc[(pkg-desc? [v any/c]) boolean?]
 @defproc[(pkg-desc [name string?]
-                   [type (or/c #f 'file 'dir 'link 'file-url 'dir-url 'github 'name)]
+                   [type (or/c #f 'file 'dir 'link 'static-link 
+                               'file-url 'dir-url 'github 'name)]
                    [checksum (or/c string? #f)]
                    [auto? boolean?])
          pkg-desc?]

pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl

@@ -311,6 +311,13 @@ sub-sub-commands:
         definition in @filepath{info.rkt} is changed (i.e., he package must be removed and re-installed
         for the change to take effect).}
 
+  @item{@DFlag{static-link} --- Implies @DFlag{link}, and also indicates that subdirectories
+        of the given directory will not change for each given directory that implements a
+        @tech{multi-collection package}.}
+
+  @item{@DFlag{skip-installed} --- Ignore any @nonterm{pkg-source}
+        whose name corresponds to an already-installed package.}
+
  @item{@DFlag{scope} @nonterm{scope} --- Selects the @tech{package scope} for installation, where @nonterm{scope} is one of
   @itemlist[
    @item{@exec{installation} --- Install packages for all users of a Racket installation, rather than user-specific.}
@@ -925,12 +932,13 @@ requires reinstallation of all packages every version change.)
 
 @subsection{Where and how are packages installed?}
 
-User-specific and Racket-version-specific packages are in @racket[(build-path
+User-specific and Racket-version-specific packages are in
-(find-system-path 'addon-dir) (version) "pkgs")], user-specific and
+@racket[(build-path (find-system-path 'addon-dir) (version) "pkgs")],
-all-version packages are in @racket[(build-path (find-system-path
+user-specific and all-version packages are in @racket[(build-path
-'addon-dir) "pkgs")], and installation-wide packages are in
+(find-system-path 'addon-dir) "pkgs")], and installation-wide packages
-@racket[(build-path (find-lib-dir) "pkgs")]. They are linked as
+are in @racket[(build-path (find-lib-dir) "pkgs")]. They are linked as
-collection roots with @exec{raco link}.
+collections (for single-collection packages) collection roots (for
+multi-collection packages) with @exec{raco link}.
 
 @subsection{How are user-specific and installation-wide @tech{package scopes}
 related for conflict checking?}

pkgs/racket-pkgs/racket-doc/scribblings/raco/link.scrbl

@@ -77,6 +77,11 @@ Full command-line options:
        that match a directory are removed. This flag is mutually
        exclusive with @Flag{n} and @DFlag{name}.}
 
+ @item{@Flag{D} or @DFlag{static-root} --- Like @Flag{d} or
+       @DFlag{root}, but each directory is assumed to have a constant
+       set of subdirectories (to improve the use of collection-search
+       caches) as long as the links file itself does not change.}
+
  @item{@Flag{x} @nonterm{regexp} or @DFlag{version-regexp}
        @nonterm{regexp} --- Sets a version regexp that limits the link
        to use only by Racket versions (as reported by
@@ -133,6 +138,7 @@ Full command-line options:
                 [#:file file (or/c path-string? #f) #f]
                 [#:name name (or/c string? #f) #f]
                 [#:root? root? any/c #f]
+                [#:static-root? static-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]
@@ -149,6 +155,10 @@ user-specific, all-version @tech[#:doc reference-doc]{collection links file} if
 @racket[shared?] is true, or the installation-wide @tech[#:doc
 reference-doc]{collection links file} otherwise.
 
+The @racket[static-root?] flag value is ignored unless @racket[root?]
+is true and @racket[remove?] is false, in which case each given
+@racket[dir] is added as a static root if @racket[static-root?] is true.
+
 The @racket[error-proc] argument is called to raise exceptions that
 would be fatal to the @exec{raco link} command.
 

pkgs/racket-pkgs/racket-doc/scribblings/reference/collects.scrbl

@@ -217,12 +217,16 @@ A @tech{collection links file} is @racket[read] with default reader
 parameter settings to obtain a list. Every element of the list must be
 a link specification with one of the forms @racket[(list _string
 _path)], @racket[(list _string _path _regexp)], @racket[(list 'root
-_path)], or @racket[(list 'root _regexp)]. A @racket[_string] names a
+_path)], @racket[(list 'root _path _regexp)], @racket[(list 'static-root
+_path)], @racket[(list 'static-root _path _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
+@racket[(current-library-collection-paths)].  A
+@racket['static-root] entry is like a @racket['root] entry, but
+where the immediate content of the directory is assumed not to change unless the
+@tech{collection links file} changes. 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

racket/lib/collects/pkg/lib.rkt

@@ -613,7 +613,7 @@
        (let ()
          (match-define (pkg-info orig-pkg checksum _) info)
          (match orig-pkg
-           [`(link ,orig-pkg-dir)
+           [`(,(or 'link 'static-link) ,orig-pkg-dir)
             orig-pkg-dir]
            [_
             (build-path (pkg-installed-dir) pkg-name)]))))
@@ -662,7 +662,7 @@
       (for/fold ([pkg #f] [subpath #f]) ([(k v) (in-hash (read-pkg-db/cached))]
                                          #:when (not pkg))
         (match (pkg-info-orig-pkg v)
-          [`(link ,orig-pkg-dir)
+          [`(,(or 'link 'static-link) ,orig-pkg-dir)
            (define e (explode orig-pkg-dir))
            (if (sub-path? <= p e)
                (values k (build-path* (list-tail p (length e))))
@@ -687,7 +687,7 @@
   (define shared? (and user?
                        (eq? (current-pkg-scope) 'shared)))
   (match orig-pkg
-    [`(link ,_)
+    [`(,(or 'link 'static-link) ,_)
      (links pkg-dir
             #:remove? #t
             #:user? user?
@@ -1040,14 +1040,16 @@
            (unless staged?
              (delete-directory/files pkg-dir))))]
    [(or (eq? type 'dir)
-        (eq? type 'link))
+        (eq? type 'link)
+        (eq? type 'static-link))
     (unless (directory-exists? pkg)
       (pkg-error "no such directory\n  path: ~a" pkg))
     (let ([pkg (directory-path-no-slash pkg)])
       (cond
-       [(eq? type 'link)
+       [(or (eq? type 'link)
+            (eq? type 'static-link))
         (install-info pkg-name
-                      `(link ,(simple-form-path* pkg))
+                      `(,type ,(simple-form-path* pkg))
                       pkg
                       #f #f
                       (directory->module-paths pkg pkg-name metadata-ns))]
@@ -1363,7 +1365,9 @@
                                  (path? scope)))
                 #:shared? (eq? 'shared scope)
                 #:file (scope->links-file scope)
-                #:root? (not single-collect))
+                #:root? (not single-collect)
+                #:static-root? (and (pair? orig-pkg)
+                                    (eq? 'static-link (car orig-pkg))))
          (define this-pkg-info
            (if single-collect
                (sc-pkg-info orig-pkg checksum auto? single-collect)
@@ -1503,13 +1507,13 @@
   (match-define (pkg-info orig-pkg checksum _)
                 (package-info pkg-name))
   (define ty (first orig-pkg))
-  (not (member ty '(link dir file))))
+  (not (member ty '(link static-link dir file))))
 
 (define ((update-package download-printf) pkg-name)
   (match-define (pkg-info orig-pkg checksum auto?)
                 (package-info pkg-name))
   (match orig-pkg
-    [`(link ,_)
+    [`(,(or 'link 'static-link) ,_)
      (pkg-error (~a "cannot update linked packages\n"
                     "  package name: ~a\n"
                     "  package source: ~a")
@@ -2258,7 +2262,7 @@
         (values (or/c #f string?) (or/c #f 'same path?)))]
   [pkg-desc 
    (-> string? 
-       (or/c #f 'file 'dir 'link 'file-url 'dir-url 'github 'name) 
+       (or/c #f 'file 'dir 'link 'static-link 'file-url 'dir-url 'github 'name) 
        (or/c string? #f) 
        boolean?
        pkg-desc?)]

racket/lib/collects/pkg/main.rkt

@@ -74,7 +74,10 @@
     "  search-auto: like 'search-ask' but does not ask for permission to install")]
   [#:bool force () "Ignores conflicts"]
   [#:bool ignore-checksums () "Ignores checksums"]
+  #:once-any
   [#:bool link () ("Link a directory package source in place")]
+  [#:bool static-link () ("Link in place, promising collections do not change")]
+  #:once-each
   [#:bool skip-installed () ("Skip a <pkg-source> if already installed")]
   #:once-any
   [(#:sym scope [installation user shared] #f) scope ()
@@ -107,7 +110,10 @@
                        #:ignore-checksums? ignore-checksums
                        #:skip-installed? skip-installed
                        (for/list ([p (in-list pkg-source)])
-                         (pkg-desc p (or (and link 'link) type) name #f))))))
+                         (define a-type (or (and link 'link) 
+                                            (and static-link 'static-link)
+                                            type))
+                         (pkg-desc p a-type name #f))))))
      (setup no-setup setup-collects jobs)))]
  [update
   "Update packages"

racket/lib/collects/pkg/name.rkt

@@ -95,7 +95,9 @@
     (define name (extract-archive-name name+ext))
     (values name 'file)]
    [(if type
-        (or (eq? type 'dir) (eq? type 'link))
+        (or (eq? type 'dir) 
+            (eq? type 'link)
+            (eq? type 'static-link))
         (path-string? s))
     (define-values (base name dir?) (split-path s))
     (define dir-name (and (path? name) (path->string name)))

racket/lib/collects/setup/commands/link.rkt

@@ -7,6 +7,7 @@
 (define link-file (make-parameter #f))
 (define link-name (make-parameter #f))
 (define root-mode (make-parameter #f))
+(define static-root-mode (make-parameter #f))
 (define link-version (make-parameter #f))
 (define remove-mode (make-parameter #f))
 (define repair-mode (make-parameter #f))
@@ -28,6 +29,9 @@
     (link-name name)]
    [("-d" "--root") "Treat <dir> as a collection root"
     (root-mode #t)]
+   [("-D" "--static-root") "Treat <dir> as a static collection root"
+    (root-mode #t)
+    (static-root-mode #t)]
    #:once-each
    [("-x" "--version-regexp") regexp "Set the version pregexp"
     (with-handlers ([exn:fail:contract? (lambda (exn)
@@ -74,6 +78,7 @@
   (apply links
          dirs
          #:root? (root-mode)
+         #:static-root? (static-root-mode)
          #:user? user?
          #:shared? shared?
          #:file (link-file)

racket/lib/collects/setup/link.rkt

@@ -12,6 +12,7 @@
                #:version-regexp [version-regexp #f]
                #:shared? [shared? #f]
                #:root? [root? #f]
+               #:static-root? [static-root? #f]
                #:remove? [remove? #f]
                #:show? [show? #f]
                #:repair? [repair? #f]
@@ -67,8 +68,9 @@
                                (content-error "entry is a not a 2- or 3-element list: " e))
                            #:when 
                            (or (or (string? (car e))
-                                   (eq? 'root (car e)))
+                                   (eq? 'root (car e))
-                               (content-error "entry's first element is not a string or 'root: " e))
+                                   (eq? 'static-root (car e)))
+                               (content-error "entry's first element is not a string, 'root, or 'static-root: " e))
                            #:when 
                            (or (path-string? (cadr e))
                                (content-error "entry's second element is not a path string: " e))
@@ -115,7 +117,9 @@
                                             (path->complete-path d))
                                            #:more-than-root? #t))]
               [a-name (if root?
-                          'root
+                          (if static-root?
+                              'static-root
+                              'root)
                           (and d
                                (or name
                                    (let-values ([(base name dir?) (split-path dp)])
@@ -136,7 +140,8 @@
                            (and name
                                 (not (equal? (car e) name)))
                            (and root?
-                                (not (eq? (car e) 'root)))
+                                (not (or (eq? (car e) 'root)
+                                         (eq? (car e) 'static-root))))
                            (and version-regexp
                                 (pair? (cddr e))
                                 (not (equal? (caddr e) version-regexp)))))
@@ -181,7 +186,8 @@
   (when show?
     (for ([e (in-list new-table)])
       (printf " ~a~s  path: ~s~a\n"
-              (if (eq? (car e) 'root)
+              (if (or (eq? (car e) 'root)
+                      (eq? (car e) 'static-root))
                   ""
                   "collection: ")
               (car e)
@@ -197,7 +203,8 @@
       (if root?
           ;; Return root paths:
           (for/list ([e (in-list new-table)]
-                     #:when (eq? 'root (car e))
+                     #:when (or (eq? 'root (car e))
+                                (eq? 'static-root (car e)))
 		     #:when (or (null? (cddr e))
 				(regexp-match? (caddr e) (version))))
             (simplify (cadr e)))

racket/src/link-all.rkt

@@ -174,7 +174,7 @@
                   (define auto? (is-auto? name))
                   (printf "Adding ~a~a as ~a\n" name (if auto? "*" "") dir)
                   (pkg-desc (path->string dir)
-                            'link
+                            'static-link
                             #f
                             auto?)))))
 

racket/src/racket/src/startup.inc

@@ -424,7 +424,13 @@
 "(define-values(links-stamps)(make-vector(vector-length links-paths) #f))"
 "(define-values(stamp-prompt-tag)(make-continuation-prompt-tag 'stamp))"
 "(define-values(file->stamp)"
-"(lambda(path)"
+"(lambda(path old-stamp)"
+"(cond"
+"((and old-stamp"
+"(cdr old-stamp)"
+"(not(sync/timeout 0(cdr old-stamp))))"
+" old-stamp)"
+"(else"
 "(call-with-continuation-prompt"
 "(lambda()"
 "(with-continuation-mark"
@@ -435,6 +441,18 @@
 "(if(exn:fail:filesystem? exn)"
 "(lambda() #f)"
 "(lambda()(raise exn)))))"
+"(let((dir-evt"
+"(let loop((path path))"
+"(let-values(((base name dir?)(split-path path)))"
+"(and(path? base)"
+"(if(directory-exists? base)"
+"(filesystem-change-evt base(lambda() #f))"
+"(loop base)))))))"
+"(if(not(file-exists? path))"
+"(cons #f dir-evt)"
+"(let((evt(filesystem-change-evt path(lambda() #f))))"
+"(when dir-evt(filesystem-change-evt-cancel dir-evt))"
+"(cons"
 "(let((p(open-input-file path)))"
 "(dynamic-wind"
 " void"
@@ -452,8 +470,18 @@
 " null"
 "(cons bstr(loop)))))))"
 " bstr)))"
-"(lambda()(close-input-port p))))))"
+"(lambda()(close-input-port p))))"
-" stamp-prompt-tag)))"
+" evt))))))"
+" stamp-prompt-tag)))))"
+"(define-values(stamp=?)"
+"(lambda(a b)"
+"(if(and(pair? a)(pair? b))"
+"(equal?(car a)(car b))"
+"(equal? a b))))"
+"(define-values(no-file-stamp?)"
+"(lambda(a)"
+"(or(not a)"
+"(not(car a)))))"
 "(define-values(get-linked-collections)"
 "(lambda(user? shared? ii)"
 "(call/ec(lambda(esc)"
@@ -494,11 +522,12 @@
 "(user? user-links-path)"
 "(shared? shared-links-path)"
 "(else(vector-ref links-paths ii))))"
-"(ts(file->stamp a-links-path)))"
+"(a-links-stamp(cond"
-"(if(not(equal? ts(cond"
 "(user? user-links-stamp)"
 "(shared? shared-links-stamp)"
-"(else(vector-ref links-stamps ii)))))"
+"(else(vector-ref links-stamps ii))))"
+"(ts(file->stamp a-links-path a-links-stamp)))"
+"(if(not(stamp=? ts a-links-stamp))"
 "(with-continuation-mark"
 " exception-handler-key"
 "(make-handler ts)"
@@ -516,7 +545,9 @@
 "(read-accept-reader #t)"
 "(read-accept-lang #f)"
 "(current-readtable #f))"
-"(let((v(let((p(open-input-file a-links-path 'binary)))"
+"(let((v(if(no-file-stamp? ts)"
+" null"
+"(let((p(open-input-file a-links-path 'binary)))"
 "(dynamic-wind"
 " void"
 "(lambda() "
@@ -524,14 +555,15 @@
 "(read p)"
 "(unless(eof-object?(read p))"
 " (error \"expected a single S-expression\"))))"
-"(lambda()(close-input-port p))))))"
+"(lambda()(close-input-port p)))))))"
 "(unless(and(list? v)"
 "(andmap(lambda(p)"
 "(and(list? p)"
 "(or(= 2(length p))"
 "(= 3(length p)))"
 "(or(string?(car p))"
-"(eq? 'root(car p)))"
+"(eq? 'root(car p))"
+"(eq? 'static-root(car p)))"
 "(path-string?(cadr p))"
 "(or(null?(cddr p))"
 "(regexp?(caddr p)))))"
@@ -546,17 +578,25 @@
 "(regexp-match?(caddr p)(version)))"
 "(let((dir(simplify-path"
 "(path->complete-path(cadr p) dir))))"
-"(if(symbol?(car p))"
+"(cond"
-"(begin"
+"((eq?(car p) 'static-root)"
+"(for-each"
+"(lambda(sub)"
+"(when(directory-exists?(build-path dir sub))"
+"(let((k(string->symbol(path->string sub))))"
+"(hash-set! ht k(cons dir(hash-ref ht k null))))))"
+"(directory-list dir)))"
+"((eq?(car p) 'root)"
 "(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)))))"
+"(else"
 "(let((s(string->symbol(car p))))"
 "(hash-set! ht s(cons(box dir)"
-"(hash-ref ht s null))))))))"
+"(hash-ref ht s null)))))))))"
 " v)"
 "(hash-for-each"
 " ht"

racket/src/racket/src/startup.rktl

@@ -505,12 +505,18 @@
   (define-values (stamp-prompt-tag) (make-continuation-prompt-tag 'stamp))
 
   (define-values (file->stamp)
-    (lambda (path)
+    (lambda (path old-stamp)
-      ;; We'd prefer to do something lighter than read the file every time!
+      ;; Using just the file's modification date almost works as a stamp,
-      ;; Using just the file's modification date almost works, but 1-second
+      ;; but 1-second granularity isn't fine enough. A stamp is therefore
-      ;; granularity isn't fine enough. To do this right, probably Racket needs
+      ;; the file content paired with a filesystem-change event (where
-      ;; to provide more support from the OS's filesystem (along the lines of
+      ;; supported), and the event lets us recycle the old stamp almost
-      ;; inotify, but the interface varies among platforms).
+      ;; always.
+      (cond
+       [(and old-stamp
+             (cdr old-stamp)
+             (not (sync/timeout 0 (cdr old-stamp))))
+        old-stamp]
+       [else
         (call-with-continuation-prompt
          (lambda ()
            (with-continuation-mark
@@ -521,6 +527,18 @@
                   (if (exn:fail:filesystem? exn)
                       (lambda () #f)
                       (lambda () (raise exn)))))
+             (let ([dir-evt
+                    (let loop ([path path])
+                      (let-values ([(base name dir?) (split-path path)])
+                        (and (path? base)
+                             (if (directory-exists? base)
+                                 (filesystem-change-evt base (lambda () #f))
+                                 (loop base)))))])
+               (if (not (file-exists? path))
+                   (cons #f dir-evt)
+                   (let ([evt (filesystem-change-evt path (lambda () #f))])
+                     (when dir-evt (filesystem-change-evt-cancel dir-evt))
+                     (cons
                       (let ([p (open-input-file path)])
                         (dynamic-wind
                             void
@@ -538,8 +556,20 @@
                                               null
                                               (cons bstr (loop)))))))
                                     bstr)))
-                 (lambda () (close-input-port p))))))
+                            (lambda () (close-input-port p))))
-       stamp-prompt-tag)))
+                      evt))))))
+         stamp-prompt-tag)])))
+  
+  (define-values (stamp=?)
+    (lambda (a b)
+      (if (and (pair? a) (pair? b))
+          (equal? (car a) (car b))
+          (equal? a b))))
+
+  (define-values (no-file-stamp?)
+    (lambda (a)
+      (or (not a)
+          (not (car a)))))
   
   (define-values (get-linked-collections)
     (lambda (user? shared? ii)
@@ -582,11 +612,12 @@
                                          [user? user-links-path]
                                          [shared? shared-links-path]
                                          [else (vector-ref links-paths ii)])]
-                          [ts (file->stamp a-links-path)])
+                          [a-links-stamp (cond
-                     (if (not (equal? ts (cond
                                           [user? user-links-stamp]
                                           [shared? shared-links-stamp]
-                                          [else (vector-ref links-stamps ii)])))
+                                          [else (vector-ref links-stamps ii)])]
+                          [ts (file->stamp a-links-path a-links-stamp)])
+                     (if (not (stamp=? ts a-links-stamp))
                          (with-continuation-mark
                              exception-handler-key
                              (make-handler ts)
@@ -604,7 +635,9 @@
                                           [read-accept-reader #t]
                                           [read-accept-lang #f]
                                           [current-readtable #f])
-                             (let ([v (let ([p (open-input-file a-links-path 'binary)])
+                             (let ([v (if (no-file-stamp? ts)
+                                          null
+                                          (let ([p (open-input-file a-links-path 'binary)])
                                             (dynamic-wind
                                                 void
                                                 (lambda () 
@@ -612,14 +645,15 @@
                                                    (read p)
                                                    (unless (eof-object? (read p))
                                                      (error "expected a single S-expression"))))
-                                            (lambda () (close-input-port p))))])
+                                                (lambda () (close-input-port p)))))])
                                (unless (and (list? v)
                                             (andmap (lambda (p)
                                                       (and (list? p)
                                                            (or (= 2 (length p))
                                                                (= 3 (length p)))
                                                            (or (string? (car p))
-                                                               (eq? 'root (car p)))
+                                                               (eq? 'root (car p))
+                                                               (eq? 'static-root (car p)))
                                                            (path-string? (cadr p))
                                                            (or (null? (cddr p))
                                                                (regexp? (caddr p)))))
@@ -634,21 +668,31 @@
                                               (regexp-match? (caddr p) (version)))
                                       (let ([dir (simplify-path
                                                   (path->complete-path (cadr p) dir))])
-                                        (if (symbol? (car p))
+                                        (cond
-                                            ;; add to every table element (to keep
+                                         [(eq? (car p) 'static-root)
-                                            ;; the choices in order); need a better
+                                          ;; multi-collection, constant content:
-                                            ;; data structure
+                                          (for-each
-                                            (begin
+                                           (lambda (sub)
+                                             (when (directory-exists? (build-path dir sub))
+                                               (let ([k (string->symbol (path->string sub))])
+                                                 (hash-set! ht k (cons dir (hash-ref ht k null))))))
+                                           (directory-list dir))]
+                                         [(eq? (car p) 'root)
+                                          ;; multi-collection, dynamic content:
+                                          ;; Add directory to the #f mapping, and also
+                                          ;; add to every existing table element (to keep
+                                          ;; the choices in order)
                                           (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)))))
+                                             (hash-set! ht k (cons dir v))))]
+                                         [else
                                           ;; single collection:
                                           (let ([s (string->symbol (car p))])
                                             (hash-set! ht s (cons (box dir)
-                                                                    (hash-ref ht s null))))))))
+                                                                  (hash-ref ht s null))))]))))
                                   v)
                                  ;; reverse all lists:
                                  (hash-for-each