diff --git a/collects/drscheme/private/drsig.ss b/collects/drscheme/private/drsig.ss
index 69781251e7..877558bb1d 100644
--- a/collects/drscheme/private/drsig.ss
+++ b/collects/drscheme/private/drsig.ss
@@ -109,7 +109,8 @@
     ((struct successful-tool (spec bitmap name url))
      get-successful-tools
      only-in-phase
-     load/invoke-all-tools))
+     load/invoke-all-tools
+     add-prefs-panel))
   
   (define-signature drscheme:get/extend^
     (extend-tab
diff --git a/collects/drscheme/private/main.ss b/collects/drscheme/private/main.ss
index 940ddca76a..7e962343d1 100644
--- a/collects/drscheme/private/main.ss
+++ b/collects/drscheme/private/main.ss
@@ -191,7 +191,17 @@
          (not x))))
   
   (preferences:set-default 'drscheme:switch-to-module-language-automatically? #t boolean?)
+
+  (preferences:set-default
+   'drscheme:default-tools-configuration
+   'load
+   (lambda (p)
+     (memq p '(load skip))))
   
+  (preferences:set-default
+   'drscheme:tools-configuration
+   null
+   list?)
   
   (drscheme:font:setup-preferences)
   (drscheme:help-desk:add-help-desk-font-prefs #t)
@@ -275,6 +285,7 @@
                        warnings-panel))))
   (drscheme:debug:add-prefs-panel)
   (install-help-browser-preference-panel)
+  (drscheme:tools:add-prefs-panel)
   
   (drscheme:language:register-capability 'drscheme:define-popup
                                          (or/c (cons/c string? string?) false/c)
diff --git a/collects/drscheme/private/tools.ss b/collects/drscheme/private/tools.ss
index 437b98662c..d02b88846a 100644
--- a/collects/drscheme/private/tools.ss
+++ b/collects/drscheme/private/tools.ss
@@ -22,13 +22,20 @@
           [prefix drscheme:eval: drscheme:eval^]
           [prefix drscheme:modes: drscheme:modes^])
   (export drscheme:tools^)
+
+  ;; An installed-tool is
+  ;; (make-installed-tool directory-record module-spec string/#f string/#f string/#f string/#f)
+  (define-struct installed-tool (dir spec bitmap name url))
+
+  ;; installed-tools : (list-of installed-tool)
+  (define installed-tools null)
   
   ;; successful-tool = (make-successful-tool module-spec 
   ;;                                         (union #f (instanceof bitmap%))
   ;;                                         (union #f string)
   ;;                                         (union #f string))
   (define-struct successful-tool (spec bitmap name url))
-  
+
   ;; successful-tools : (listof successful-tool)
   (define successful-tools null)
   
@@ -48,68 +55,29 @@
   
   ;; load/invoke-all-tools : -> void
   (define (load/invoke-all-tools phase1-extras phase2-extras)
+    (rescan-installed-tools!)
     (set! current-phase 'loading-tools)
-    (load/invoke-all-tools/collections
-     (all-tool-directories)
-     phase1-extras
-     phase2-extras))
+    (let ([candidate-tools (filter candidate-tool? installed-tools)])
+      (for-each load/invoke-tool candidate-tools)
+      (run-phases phase1-extras phase2-extras)))
+
+  ;; rescan-installed-tools! : -> void
+  (define (rescan-installed-tools!)
+    (set! installed-tools (all-installed-tools)))
   
+  ;; all-installed-tools : -> (list-of installed-tool)
+  (define (all-installed-tools)
+    (apply append
+           (map installed-tools-for-directory
+                (all-tool-directories))))
   
+  ;; all-tool-directories : -> (list-of directory-record)
   (define (all-tool-directories)
-    (find-relevant-directories '(tools tool-icons tool-names tool-urls)))
+    (find-relevant-directory-records '(tools tool-icons tool-names tool-urls)))
   
-  ;; loads the the tools in each directory
-  ;; unless PLTNOTOOLS is set, in which case it
-  ;; just runs the phases. If PLTONLYTOOL is set,
-  ;; it only loads tools in those collections
-  (define (load/invoke-all-tools/collections directories phase1-extras phase2-extras)
-    (cond
-      [(getenv "PLTNOTOOLS") (printf "PLTNOTOOLS: skipping tools\n")]
-      [else
-       (let ([onlys (getenv "PLTONLYTOOL")])
-         (if onlys
-             (let* ([allowed (let ([exp (read (open-input-string onlys))])
-                               (cond 
-                                 [(symbol? exp) (list exp)]
-                                 [(pair? exp) exp]
-                                 [else '()]))]
-                    [filtered (filter (lambda (x) 
-                                        (let-values ([(base name dir) (split-path x)])
-                                          (memq (string->symbol (path->string name))
-                                                allowed)))
-                                      directories)])
-               (printf "PLTONLYTOOL: only loading ~s\n" filtered)
-               (for-each load/invoke-tools filtered))
-             (for-each load/invoke-tools directories)))])
-    (run-phases phase1-extras phase2-extras))
-  
-  
-  
-  ;;;                     ;;       ;   ;                        ;;            
-  ;                      ;      ;                              ;            
-  ;                      ;      ;                              ;            
-  ;     ;;;   ;;;;    ;;;;     ;   ;;;   ; ;;;  ;;; ;;;  ;;;   ;  ;;   ;;;  
-  ;    ;   ;      ;  ;   ;     ;     ;    ;;  ;  ;   ;  ;   ;  ; ;    ;   ; 
-  ;    ;   ;   ;;;;  ;   ;    ;      ;    ;   ;  ;   ;  ;   ;  ;;     ;;;;; 
-  ;    ;   ;  ;   ;  ;   ;    ;      ;    ;   ;   ; ;   ;   ;  ; ;    ;     
-  ;    ;   ;  ;   ;  ;   ;   ;       ;    ;   ;   ;;;   ;   ;  ;  ;   ;   ; 
-  ;;;;;;  ;;;    ;;; ;  ;;; ;  ;     ;;;;; ;;;  ;;   ;     ;;;  ;;   ;;  ;;;  
-  ;                                               
-  
-  
-  
-  
-  ;; load/invoke-tools : string[collection-name] -> void
-  ;; loads each tool in a collection
-  (define (load/invoke-tools coll-dir)
-    (let ([table (with-handlers ([(lambda (x) #f) ; exn:fail? 
-                                  (lambda (x)
-                                    (show-error
-                                     (format (string-constant error-getting-info-tool)
-                                             coll-dir)
-                                     x)
-                                    #f)])
-                   (get-info/full coll-dir))])
+  ;; installed-tools-for-directory : directory-record -> (list-of installed-tool)
+  (define (installed-tools-for-directory coll-dir)
+    (let ([table (get-info/full (directory-record-path coll-dir))])
       (when table
         (let* ([tools (table 'tools (lambda () null))]
                [tool-icons (table 'tool-icons (lambda () (map (lambda (x) #f) tools)))]
@@ -136,10 +104,112 @@
                          #f
                          '(ok stop))
             (set! tool-urls (map (lambda (x) #f) tools)))
-          (for-each (load/invoke-tool coll-dir) tools tool-icons tool-names tool-urls)))))
+          (map (lambda (t i n u) (make-installed-tool coll-dir t i n u))
+               tools tool-icons tool-names tool-urls)))))
   
-  ;; load/invoke-tool :    path[directory-of-collection] 
-  ;;                    -> (listof string[sub-collection-name]) 
+  ;; candidate-tool? : installed-tool -> boolean
+  ;; Predicate for tools selected for execution in this
+  ;; run of DrScheme (depending on env variables and preferences)
+  (define candidate-tool?
+    (cond
+      [(getenv "PLTNOTOOLS")
+       (printf "PLTNOTOOLS: skipping tools\n")
+       (lambda (it) #f)]
+      [(getenv "PLTONLYTOOL") =>
+       (lambda (onlys)
+         (let* ([allowed (let ([exp (read (open-input-string onlys))])
+                           (cond 
+                            [(symbol? exp) (list exp)]
+                            [(pair? exp) exp]
+                            [else '()]))]
+                [directory-ok? (lambda (x) 
+                                 (let-values ([(base name dir) (split-path x)])
+                                   (memq (string->symbol (path->string name))
+                                         allowed)))])
+           (printf "PLTONLYTOOL: only loading ~s\n" allowed)
+           (lambda (it)
+             (directory-ok?
+              (directory-record-path
+               (installed-tool-dir it))))))]
+      [else
+       (lambda (it)
+         (eq? (or (get-tool-configuration it)
+                  (default-tool-configuration it))
+              'load))]))
+
+  ;; get-tool-configuration : installed-tool -> symbol/#f
+  ;; Get tool configuration preference or #f if no preference set.
+  (define (get-tool-configuration it)
+    (let ([p (assoc (installed-tool->key it) (toolspref))])
+      (and p (cadr p))))
+  
+  ;; default-tool-configuration : installed-tool -> (union 'load 'skip)
+  (define (default-tool-configuration it)
+    (preferences:get 'drscheme:default-tools-configuration))
+
+  (define toolspref
+    (case-lambda
+      [() (preferences:get 'drscheme:tools-configuration)]
+      [(v) (preferences:set 'drscheme:tools-configuration v)]))
+
+  (define (installed-tool->key it)
+    (list (directory-record-spec (installed-tool-dir it))
+          (installed-tool-spec it)))
+
+  (define (installed-tool-full-path it)
+    (apply build-path
+           (directory-record-path (installed-tool-dir it))
+           (let ([path-parts (installed-tool-spec it)])
+             (cond [(list? path-parts)
+                    (append (cdr path-parts) (list (car path-parts)))]
+                   [else (list path-parts)]))))
+
+  (define (installed-tool->module-spec it)
+    (let* ([dirrec (installed-tool-dir it)]
+           [key (directory-record-spec dirrec)]
+           [maj (directory-record-maj dirrec)]
+           [min (directory-record-min dirrec)]
+           [parts (let ([parts0 (installed-tool-spec it)])
+                    (if (list? parts0)
+                        parts0
+                        (list parts0)))]
+           [file (car parts)]
+           [rest-parts (cdr parts)])
+      (case (car key)
+        ((lib)
+         `(lib ,file ,@(cdr key) ,@rest-parts))
+        ((planet)
+         `(planet ,file (,@(cdr key) ,maj ,min) ,@rest-parts)))))
+
+  ;; installed-tool-is-loaded : installed-tool -> boolean
+  (define (installed-tool-is-loaded? it)
+    (let ([path (installed-tool-full-path it)])
+      (ormap (lambda (st) (equal? path (successful-tool-spec st)))
+             (get-successful-tools))))
+  
+
+  ;;;                     ;;       ;   ;                        ;;            
+  ;                      ;      ;                              ;            
+  ;                      ;      ;                              ;            
+  ;     ;;;   ;;;;    ;;;;     ;   ;;;   ; ;;;  ;;; ;;;  ;;;   ;  ;;   ;;;  
+  ;    ;   ;      ;  ;   ;     ;     ;    ;;  ;  ;   ;  ;   ;  ; ;    ;   ; 
+  ;    ;   ;   ;;;;  ;   ;    ;      ;    ;   ;  ;   ;  ;   ;  ;;     ;;;;; 
+  ;    ;   ;  ;   ;  ;   ;    ;      ;    ;   ;   ; ;   ;   ;  ; ;    ;     
+  ;    ;   ;  ;   ;  ;   ;   ;       ;    ;   ;   ;;;   ;   ;  ;  ;   ;   ; 
+  ;;;;;;  ;;;    ;;; ;  ;;; ;  ;     ;;;;; ;;;  ;;   ;     ;;;  ;;   ;;  ;;;  
+  ;                                               
+
+
+  ;; load/invoke-tool : installed-tool -> void
+  (define (load/invoke-tool it)
+    (load/invoke-tool* (directory-record-path (installed-tool-dir it))
+                       (installed-tool-spec it)
+                       (installed-tool-bitmap it)
+                       (installed-tool-name it)
+                       (installed-tool-url it)))
+  
+  ;; load/invoke-tool* :   path
+  ;;                       (listof string[sub-collection-name]) 
   ;;                       (union #f (cons string[filename] (listof string[collection-name])))
   ;;                       (union #f string)
   ;;                       (union #f string)
@@ -148,60 +218,59 @@
   ;; `in-path' is the `coll'-relative collection-path spec for the tool module file
   ;; `icon-spec' is the collection-path spec for the tool's icon, if there is one.
   ;; `name' is the name of the tool (only used in about box)
-  (define (load/invoke-tool coll-dir)
-    (lambda (in-path icon-spec name tool-url)
-      (let* ([icon-path 
-              (cond
-                [(string? icon-spec)
-                 (build-path coll-dir icon-spec)]
-                [(and (list? icon-spec)
-                      (andmap string? icon-spec))
-                 (build-path (apply collection-path (cdr icon-spec)) (car icon-spec))]
-                [else #f])]
-             [tool-bitmap
-              (and icon-path
-                   (install-tool-bitmap name icon-path))])
-        (let/ec k
-          (unless (or (string? in-path)
-                      (and (list? in-path)
-                           (not (null? in-path))
-                           (andmap string? in-path)))
-            (message-box (string-constant drscheme)
-                         (format (string-constant invalid-tool-spec)
-                                 coll-dir in-path)
-                         #f
-                         '(ok stop))
-            (k (void)))
-          (let* ([tool-path
-                  (if (string? in-path) 
-                      (build-path coll-dir in-path)
-                      (apply build-path coll-dir (append (cdr in-path) (list (car in-path)))))]
-                 [unit 
-                   (with-handlers ([exn:fail? 
-                                    (lambda (x)
-                                      (show-error
-                                       (format (string-constant error-invoking-tool-title)
-                                               coll-dir in-path)
-                                       x)
-                                      (k (void)))])
-                     (dynamic-require tool-path 'tool@))])
-            (with-handlers ([exn:fail? 
-                             (lambda (x)
-                               (show-error 
-                                (format (string-constant error-invoking-tool-title)
-                                        coll-dir in-path)
-                                x))])
-              (let-values ([(phase1-thunk phase2-thunk) 
-                            (invoke-tool unit (string->symbol (or name (path->string coll-dir))))])
-                (set! successfully-loaded-tools 
-                      (cons (make-successfully-loaded-tool
-                             tool-path
-                             tool-bitmap
-                             name
-                             tool-url 
-                             phase1-thunk
-                             phase2-thunk)
-                            successfully-loaded-tools)))))))))
+  (define (load/invoke-tool* coll-dir in-path icon-spec name tool-url)
+    (let* ([icon-path 
+            (cond
+             [(string? icon-spec)
+              (build-path coll-dir icon-spec)]
+             [(and (list? icon-spec)
+                   (andmap string? icon-spec))
+              (build-path (apply collection-path (cdr icon-spec)) (car icon-spec))]
+             [else #f])]
+           [tool-bitmap
+            (and icon-path
+                 (install-tool-bitmap name icon-path))])
+      (let/ec k
+        (unless (or (string? in-path)
+                    (and (list? in-path)
+                         (not (null? in-path))
+                         (andmap string? in-path)))
+          (message-box (string-constant drscheme)
+                       (format (string-constant invalid-tool-spec)
+                               coll-dir in-path)
+                       #f
+                       '(ok stop))
+          (k (void)))
+        (let* ([tool-path
+                (if (string? in-path) 
+                    (build-path coll-dir in-path)
+                    (apply build-path coll-dir (append (cdr in-path) (list (car in-path)))))]
+               [unit 
+                 (with-handlers ([exn:fail? 
+                                  (lambda (x)
+                                    (show-error
+                                     (format (string-constant error-invoking-tool-title)
+                                             coll-dir in-path)
+                                     x)
+                                    (k (void)))])
+                   (dynamic-require tool-path 'tool@))])
+          (with-handlers ([exn:fail? 
+                           (lambda (x)
+                             (show-error 
+                              (format (string-constant error-invoking-tool-title)
+                                      coll-dir in-path)
+                              x))])
+            (let-values ([(phase1-thunk phase2-thunk) 
+                          (invoke-tool unit (string->symbol (or name (path->string coll-dir))))])
+              (set! successfully-loaded-tools 
+                    (cons (make-successfully-loaded-tool
+                           tool-path
+                           tool-bitmap
+                           name
+                           tool-url 
+                           phase1-thunk
+                           phase2-thunk)
+                          successfully-loaded-tools))))))))
   
   ;; invoke-tool : unit/sig string -> (values (-> void) (-> void))
   ;; invokes the tools and returns the two phase thunks.
@@ -362,4 +431,106 @@
       (error func "can only be called in phase: ~a"
              (apply string-append 
                     (map (lambda (x) (format "~e " x))
-                         (filter (lambda (x) x) phases)))))))
+                         (filter (lambda (x) x) phases))))))
+
+  ;; Preferences GUI
+
+  (define load-action "Load the tool")
+  (define skip-action "Skip the tool")
+  
+  (define (add-prefs-panel)
+    (preferences:add-panel
+     "Tools"
+     (lambda (parent)
+       (define main (new vertical-panel% (parent parent)))
+       (define advisory
+         (new message%
+              (parent main)
+              (label "Changes to tool configuration will take effect the next time you start DrScheme.")))
+       (define listing
+         (new list-box%
+              (parent main)
+              (label "Installed tools")
+              (choices null)
+              (callback (lambda _ (on-select-tool)))))
+       (define info
+         (new vertical-panel%
+              (parent main)
+              (style '(border))
+              (stretchable-height #f)))
+       (define location
+         (new text-field%
+              (parent info)
+              (label "Tool: ")))
+       (define location-editor (send location get-editor))
+       (define configuration
+         (new radio-box%
+              (label "Load the tool when DrScheme starts?")
+              (parent info)
+              (choices (list load-action skip-action #| default-action |#))
+              (callback (lambda _ (on-select-policy)))))
+
+       (define (populate-listing!)
+         (send listing clear)
+         (for-each
+          (lambda (entry+it)
+            (send listing append
+                  (car entry+it)
+                  (cdr entry+it)))
+          (sort (map (lambda (it) (cons (tool-list-entry it) it))
+                     installed-tools)
+                (lambda (a b)
+                  (string<? (car a) (car b))))))
+       (define (tool-list-entry it)
+         (let ([name (or (installed-tool-name it)
+                         (format "unnamed tool ~a"
+                                 (installed-tool->module-spec it)))])
+           (if (installed-tool-is-loaded? it)
+               (string-append name " (loaded)")
+               name)))
+       (define (on-select-tool)
+         (let ([it (get-selected-tool)])
+           (send* location-editor
+             (begin-edit-sequence)
+             (lock #f)
+             (erase)
+             (insert
+              (if it
+                  (format "~s" (installed-tool->module-spec it))
+                  ""))
+             (lock #t)
+             (end-edit-sequence))
+           (send configuration set-selection
+                 (case (and it (get-tool-configuration it))
+                   ((load) 0)
+                   ((skip) 1)
+                   ((#f) 0))) ;; XXX (or 2, if default is an option)
+           (send configuration enable (and it #t))
+           (void)))
+       (define (on-select-policy)
+         (let ([it (get-selected-tool)]
+               [policy
+                (case (send configuration get-selection)
+                  ((0) 'load)
+                  ((1) 'skip))])
+           (when it
+             (let ([key (installed-tool->key it)])
+               (case policy
+                 ((load)
+                  (toolspref (cons (list key 'load)
+                                   (let ([ts (toolspref)])
+                                     (remove (assoc key ts) ts)))))
+                 ((skip)
+                  (toolspref (cons (list key 'skip)
+                                   (let ([ts (toolspref)])
+                                     (remove (assoc key ts) ts)))))
+                 ((#f)
+                  (toolspref (let ([ts (toolspref)])
+                               (remove (assoc key ts) ts))))))))
+         (void))
+       (define (get-selected-tool)
+         (let ([index (send listing get-selection)])
+           (and index (send listing get-data index))))
+       (populate-listing!)
+       (send location-editor lock #t)
+       main))))
diff --git a/collects/help/private/colldocs.ss b/collects/help/private/colldocs.ss
index 33ec5d0806..89ae6457ae 100644
--- a/collects/help/private/colldocs.ss
+++ b/collects/help/private/colldocs.ss
@@ -4,26 +4,41 @@
            (lib "contract.ss"))
   
   (define (colldocs)
-    (let loop ([dirs (sort (map path->string (find-relevant-directories
-                                              '(doc.txt) 'all-available))
-                           string<?)]
+    (let loop ([dirrecs
+                (sort (find-relevant-directory-records '(doc.txt) 'all-available)
+                      (lambda (a b)
+                        (bytes<? (path->bytes (directory-record-path a))
+                                 (path->bytes (directory-record-path b)))))]
                [docs null]
                [names null])
       (cond
-        [(null? dirs) (values (reverse docs) (reverse names))]
-        [else (let* ([dir (string->path (car dirs))]
-                     [info-proc (get-info/full dir)])
-                (if info-proc
-                    (let ([doc.txt-path (info-proc 'doc.txt (lambda () #f))]
-                          [name (info-proc 'name (lambda () #f))])
-                      (if (and (path-string? doc.txt-path)
-                               (string? name))
-                          (loop (cdr dirs)
-                                (cons (list dir (string->path doc.txt-path))
-                                      docs)
-                                (cons name names))
-                          (loop (cdr dirs) docs names)))
-                    (loop (cdr dirs) docs names)))])))
+        [(null? dirrecs) (values (reverse docs) (reverse names))]
+        [else
+         (let* ([dirrec (car dirrecs)]
+                [dir (directory-record-path dirrec)]
+                [info-proc (get-info/full dir)])
+           (if info-proc
+               (let ([doc.txt-path (info-proc 'doc.txt (lambda () #f))]
+                     [name (info-proc 'name (lambda () #f))])
+                 (if (and (path-string? doc.txt-path)
+                          (string? name))
+                     (loop (cdr dirrecs)
+                           (cons (list dir (string->path doc.txt-path))
+                                 docs)
+                           (cons (pleasant-name name dirrec) names))
+                     (loop (cdr dirrecs) docs names)))
+               (loop (cdr dirrecs) docs names)))])))
+
+  (define (pleasant-name name dirrec)
+    (case (car (directory-record-spec dirrec))
+      ((lib)
+       (format "~a collection" name))
+      ((planet)
+       (format "~a package ~s"
+               name
+               `(,@(cdr (directory-record-spec dirrec))
+                 ,(directory-record-maj dirrec)
+                 ,(directory-record-min dirrec))))))
   
   (provide/contract 
    [colldocs (-> (values (listof (list/c path? path?))
diff --git a/collects/help/private/manuals.ss b/collects/help/private/manuals.ss
index 5e38e25946..a9c6b9ae01 100644
--- a/collects/help/private/manuals.ss
+++ b/collects/help/private/manuals.ss
@@ -190,13 +190,13 @@
                                          (cadr collection-doc-file))])
                    (format "<LI> ~a"
                            (if (file-exists? path)
-                               (format "<A HREF=\"/servlets/doc-anchor.ss?file=~a&name=~a&caption=Documentation for the ~a collection\">~a collection</A>"
+                               (format "<A HREF=\"/servlets/doc-anchor.ss?file=~a&name=~a&caption=Documentation for the ~a\">~a</A>"
                                        ;; escape colons and other junk
                                        (uri-encode (path->string path))
                                        (uri-encode name)
                                        (uri-encode name)
                                        name)
-                               (format "<FONT COLOR=\"RED\">~a collection: specified doc.txt file (~a) not found</FONT>"
+                               (format "<FONT COLOR=\"RED\">~a: specified doc.txt file (~a) not found</FONT>"
                                        name path))))))
               collections-doc-files
               collection-names)])
diff --git a/collects/help/private/search.ss b/collects/help/private/search.ss
index 5ef5af167c..8dcf76c6ed 100644
--- a/collects/help/private/search.ss
+++ b/collects/help/private/search.ss
@@ -68,7 +68,7 @@
     
     (set! doc-names (append
 		     std-doc-names
-		     (map (lambda (s) (format "the ~a collection" s))
+		     (map (lambda (s) (format "the ~a" s))
 			  txt-doc-names)))
     (set! doc-kinds (append (map (lambda (x) 'html) std-docs) (map (lambda (x) 'text) txt-docs)))
     
diff --git a/collects/setup/getinfo.ss b/collects/setup/getinfo.ss
index d26042dd34..a550c0b115 100644
--- a/collects/setup/getinfo.ss
+++ b/collects/setup/getinfo.ss
@@ -12,17 +12,18 @@
   (define info? (opt-> (symbol?) ((-> any/c)) any/c))
   (define path-or-string? (lambda (x) (or (path? x) (string? x))))
   
-  
   ;; in addition to infodomain/compiled/cache.ss, getinfo will look in this 
   ;; file to find mappings. PLaneT uses this to put info about installed
   ;; planet packages.
   (define user-infotable (get-planet-cache-path))
-  
+
+  ;; get-info : (listof path-or-string) -> info/#f
   (define (get-info coll-path)
     (let* ([coll-path (map (lambda (x) (if (path? x) (path->string x) x)) coll-path)]
 	   [dir (apply collection-path coll-path)])
       (get-info/full dir)))
-  
+
+  ;; get-info/full : path -> info/#f
   (define (get-info/full dir)
     (let ([file (build-path dir "info.ss")])
       (if (file-exists? file)
@@ -43,16 +44,20 @@
 	    (dynamic-require file '#%info-lookup))
 	  #f)))
 
-  ;; item : (list path (listof symbol) nat nat)
+  ;; directory-record = (make-directory-record nat nat key path (listof symbol))
+  ;; eg: (make-directory-record 1 0 '(lib "mzlib") #"mzlib" '(name))
+  (define-struct directory-record (maj min spec path syms))
   
-  (define-struct table (insert   ; item * listof item -> listof item
-                        ht       ; hashtable[key -o> item]
-                        paths    ; listof path
+  (define-struct table (insert   ; directory-record (listof directory-record)
+                                 ;  -> (listof directory-record)
+                        ht       ; hashtable[symbol -o> directory-record]
+                        paths    ; (listof (cons path boolean))
                         ))
   
   (define preferred-table #f)
   (define all-available-table #f)
-  
+
+  ;; reset-relevant-directories-state! : -> void
   (define (reset-relevant-directories-state!)
     (set! preferred-table 
           (make-table 
@@ -61,91 +66,107 @@
                [(null? l)
                 (list i)]
                [else 
-                (match-let ([(_ _ my-maj my-min) i]
-                            [(_ _ their-maj their-min) (car l)])
-                  (if
-                   (or (> my-maj their-maj)
-                       (and (= my-maj their-maj) (>= my-min their-min)))
-                   (list i)
-                   l))]))
+                (match-let ([($ directory-record my-maj my-min _ _ _) i]
+                            [($ directory-record their-maj their-min _ _ _) (car l)])
+                  (if (or (> my-maj their-maj)
+                          (and (= my-maj their-maj) (>= my-min their-min)))
+                      (list i)
+                      l))]))
            #f #f))
-    (set! all-available-table (make-table cons #f #f)))
-  (reset-relevant-directories-state!)
+    (set! all-available-table
+          (make-table cons #f #f)))
   
+  (reset-relevant-directories-state!)
+
+  ;; populate-table : table -> void
   (define (populate-table! t)
     ;; Use the colls ht because a collection might be in multiple
-    ;;  collection paths, and we only want one
+    ;; collection paths, and we only want one
     (let ([colls (make-hash-table 'equal)])
-      (for-each (lambda (f+root-dir)
-		  (let ([f (car f+root-dir)]
-			[root-dir (cdr f+root-dir)])
-		    (when (file-exists? f)
-		      (for-each 
-		       (lambda (i)
-			 (match i
-			   [((? bytes? pathbytes) 
-			     ((? symbol? fields) ...)
-			     key ;; anything is okay here
-			     (? integer? maj)
-			     (? integer? min))
-			    (let ((old-items (hash-table-get 
-					      colls
-					      key
-					      (lambda () '())))
-				  (new-item (list (let ([p (bytes->path pathbytes)])
-						    (if (and (relative-path? p) root-dir)
-							(build-path root-dir p)
-							p))
-						  fields 
-						  maj 
-						  min)))
-			      (hash-table-put! colls 
-					       key
-					       ((table-insert t) new-item old-items)))]
-			   [_
-			    (error 'find-relevant-directories
-				   "bad info-domain cache entry: ~e in: ~a" 
-				   i
-				   f)]))
-		       (let ([l (with-input-from-file f read)])
-			 (cond
-                           [(list? l) l]
-                           [(eof-object? l) '()] ;; allow completely empty files
-                           [else
-                            (error 'find-relevant-directories
-                                   "bad info-domain cache file: ~a" 
-                                   f)]))))))
-		(reverse (table-paths t)))
-      ;; For each coll, invert the mapping, adding the col name to the list for each sym: 
-      (hash-table-for-each colls
-			   (lambda (key vals)
-                             (for-each
-                              (lambda (val)
-                                (match val
-                                  [(path syms maj min)
-                                   (for-each (lambda (sym)
-                                               (hash-table-put! 
-                                                (table-ht t)
-                                                sym
-                                                (cons path (hash-table-get (table-ht t) sym (lambda () null)))))
-                                             syms)]
-                                  [_ (error 'get-info 
-                                            "Internal error: invalid info-domain value format: ~s" val)]))
-                              vals)))))
-
+      (for-each
+       (lambda (f+root-dir)
+         (let ([f (car f+root-dir)]
+               [root-dir (cdr f+root-dir)])
+           (when (file-exists? f)
+             (for-each 
+              (lambda (i)
+                (match i
+                  [((? bytes? pathbytes) 
+                    ((? symbol? fields) ...)
+                    key ;; anything is okay here
+                    (? integer? maj)
+                    (? integer? min))
+                   (let ((old-items (hash-table-get 
+                                     colls
+                                     key
+                                     (lambda () '())))
+                         (new-item
+                          (make-directory-record
+                           maj
+                           min
+                           key
+                           (let ([p (bytes->path pathbytes)])
+                             (if (and (relative-path? p) root-dir)
+                                 (build-path root-dir p)
+                                 p))
+                           fields)))
+                     (hash-table-put! colls 
+                                      key
+                                      ((table-insert t) new-item old-items)))]
+                  [_
+                   (error 'find-relevant-directories
+                          "bad info-domain cache entry: ~e in: ~a" 
+                          i
+                          f)]))
+              (let ([l (with-input-from-file f read)])
+                (cond
+                 [(list? l) l]
+                 [(eof-object? l) '()] ;; allow completely empty files
+                 [else
+                  (error 'find-relevant-directories
+                         "bad info-domain cache file: ~a" 
+                         f)]))))))
+       (reverse (table-paths t)))
+      ;; For each coll, invert the mapping, adding the col name to the list
+      ;; for each sym: 
+      (hash-table-for-each
+       colls
+       (lambda (key vals)
+         (for-each
+          (lambda (val)
+            (match val
+              [($ directory-record maj min spec path syms)
+               (for-each
+                (lambda (sym)
+                  (hash-table-put! 
+                   (table-ht t)
+                   sym
+                   (cons val
+                         (hash-table-get (table-ht t) sym (lambda () null)))))
+                syms)]
+              [_ (error 'get-info 
+                        "Internal error: invalid info-domain value format: ~s" val)]))
+          vals)))))
+  
   (define find-relevant-directories
+    (opt-lambda (syms [key 'preferred])
+      (map directory-record-path (find-relevant-directory-records syms key))))
+  
+  (define find-relevant-directory-records
     (opt-lambda (syms [key 'preferred])
       (define t (cond 
                   [(eq? key 'preferred) preferred-table]
                   [(eq? key 'all-available) all-available-table]
                   [else (error 'find-relevant-directories "Invalid key: ~s" key)]))
-
+      
       ;; A list of (cons cache.ss-path root-dir-path)
       ;;  If root-dir-path is not #f, then paths in the cache.ss
       ;;  file are relative to it. #f is used for the planet cache.ss file.
       (define search-path 
         (cons (cons user-infotable #f)
-              (map (lambda (coll) (cons (build-path coll "info-domain" "compiled" "cache.ss") coll))
+              (map (lambda (coll)
+                     (cons (build-path coll "info-domain" "compiled" "cache.ss")
+                           coll))
                    (current-library-collection-paths))))
       
       (unless (equal? (table-paths t) search-path)
@@ -153,19 +174,25 @@
         (set-table-paths! t search-path)
         (populate-table! t))
       
-      (let ([unsorted (if (= (length syms) 1)
-                          ;; Simple case: look up in table
-                          (hash-table-get (table-ht t) (car syms) (lambda () null))
-                          ;; Use a hash table, because the same collection might work for multiple syms
-                          (let ([result (make-hash-table 'equal)])
-                            (for-each (lambda (sym)
-                                        (let ([l (hash-table-get (table-ht t) sym (lambda () null))])
-                                          (for-each (lambda (c) (hash-table-put! result c #t))
-                                                    l)))
-                                      syms)
-                            ;; Extract the relevant collections:
-                            (hash-table-map result (lambda (k v) k))))])
-        (sort unsorted compare-directories))))
+      (let ([unsorted
+             (if (= (length syms) 1)
+                 ;; Simple case: look up in table
+                 (hash-table-get (table-ht t) (car syms) (lambda () null))
+                 ;; Use a hash table, because the same collection might work
+                 ;; for multiple syms
+                 (let ([result (make-hash-table 'equal)])
+                   (for-each
+                    (lambda (sym)
+                      (let ([l (hash-table-get (table-ht t) sym (lambda () null))])
+                        (for-each (lambda (c) (hash-table-put! result c #t))
+                                  l)))
+                    syms)
+                   ;; Extract the relevant collections:
+                   (hash-table-map result (lambda (k v) k))))])
+        (sort unsorted
+              (lambda (a b)
+                (compare-directories (directory-record-path a)
+                                     (directory-record-path b)))))))
   
   (define (compare-directories a b)
     (bytes<? (dir->sort-key a) (dir->sort-key b)))
@@ -185,4 +212,14 @@
    (find-relevant-directories (opt-> ((listof symbol?))
                                      ((lambda (x) (or (eq? x 'preferred)
                                                       (eq? x 'all-available))))
-                                     (listof path?)))))
+                                     (listof path?)))
+   (struct directory-record
+           ([maj integer?]
+            [min integer?]
+            [spec any/c]
+            [path path?]
+            [syms (listof symbol?)]))
+   (find-relevant-directory-records (opt-> ((listof symbol?))
+                                           ((lambda (x) (or (eq? x 'preferred)
+                                                            (eq? x 'all-available))))
+                                           (listof directory-record?)))))