add -U to avoid compiling user-specific collects

svn: r8590

collects/setup/option-sig.ss

@@ -14,6 +14,7 @@
      make-info-domain
      make-launchers
      make-docs
+     make-user
      make-planet
      call-install
      call-post-install

collects/setup/option-unit.ss

@@ -19,6 +19,7 @@
       (define make-launchers (make-parameter #t))
       (define make-info-domain (make-parameter #t))
       (define make-docs (make-parameter #t))
+      (define make-user (make-parameter #t))
       (define make-planet (make-parameter #t))
       (define call-install (make-parameter #t))
       (define call-post-install (make-parameter #t))

collects/setup/setup-cmdline.ss

@@ -46,6 +46,8 @@
       (add-flags '((make-info-domain #f)))]
      [("-D" "--no-docs") "Do not produce documentation"
       (add-flags '((make-docs #f)))]
+     [("-U" "--no-user-specific") "Do not setup user-specific collections (incl. planet)"
+      (add-flags '((make-user #f) (make-planet #f)))]
      [("--no-planet") "Do not setup PLaneT packages"
       (add-flags '((make-planet #f)))]
      [("-v" "--verbose") "See names of compiled files and info printfs"

collects/setup/setup-go.ss

@@ -22,14 +22,9 @@
 
   ;; Converting parse-cmdline results into parameter settings:
   (define (do-flag name param)
-    (let ([a (assq name x-flags)])
-      (when a
-	(param (cadr a)))))
+    (cond [(assq name x-flags) => (lambda (a) (param (cadr a)))]))
   (define-syntax all-flags
-    (syntax-rules ()
-      [(_ f ...) (begin
-		   (do-flag 'f f)
-		   ...)]))
+    (syntax-rules () [(_ f ...) (begin (do-flag 'f f) ...)]))
   (all-flags clean
 	     make-zo
 	     call-install
@@ -43,6 +38,7 @@
 	     all-users
 	     compile-mode
              make-docs
+             make-user
              make-planet
              doc-pdf-dest)
 

collects/setup/setup-unit.ss

@@ -42,6 +42,12 @@
 
   (define (exn->string x) (if (exn? x) (exn-message x) (format "~s" x)))
 
+  (unless (make-user)
+    (current-library-collection-paths
+     (filter (let ([main (find-collects-dir)])
+               (lambda (d) (equal? d main)))
+             (current-library-collection-paths))))
+
   (setup-printf "Setup version is ~a [~a]" (version) (system-type 'gc))
   (setup-printf "Available variants:~a"
                 (apply string-append
@@ -49,8 +55,7 @@
                             (available-mzscheme-variants))))
   (setup-printf "Main collection path is ~a" (find-collects-dir))
   (setup-printf "Collection search path is ~a"
-                (if (null? (current-library-collection-paths))
-                  "empty!" ""))
+                (if (null? (current-library-collection-paths)) "empty!" ""))
   (for ([p (current-library-collection-paths)])
     (setup-printf "  ~a" (path->string p)))