301.15: new install tree for Unix, moved docs, moved teachpacks, added config.ss

svn: r2962

collects/compiler/start.ss

@@ -54,6 +54,7 @@
   (define plt-files-replace (make-parameter #f))
   (define plt-files-plt-relative? (make-parameter #f))
   (define plt-files-plt-home-relative? (make-parameter #f))
+  (define plt-force-install-dir? (make-parameter #f))
   (define plt-setup-collections (make-parameter null))
   (define plt-include-compiled (make-parameter #f))
 
@@ -311,10 +312,17 @@
 	 ("Files in archive replace existing files when unpacked")]
 	[("--at-plt")
 	 ,(lambda (f) (plt-files-plt-relative? #t))
-	 ("Files/dirs in archive are relative to PLT add-ons directory")]
+	 ("Files/dirs in archive are relative to user's add-ons directory")]]
+       [once-any
 	[("--all-users")
 	 ,(lambda (f) (plt-files-plt-home-relative? #t))
-	 ("Files/dirs in archive are relative to PLT installation directory")]
+	 ("Files/dirs in archive go to PLT installation if writable")]
+	[("--force-all-users")
+	 ,(lambda (f) 
+	    (plt-files-plt-home-relative? #t)
+	    (plt-force-install-dir? #t))
+	 ("Files/dirs forced to PLT installation")]]
+       [once-each
 	[("--include-compiled")
 	 ,(lambda (f) (plt-include-compiled #t))
 	 ("Include \"compiled\" subdirectories in the archive")]]
@@ -539,25 +547,27 @@
 		    "file/directory is not relative to the current directory: \"~a\""
 		    fd)))
 	       source-files)
-     (pack (plt-output) (plt-name)
+     (pack-plt (plt-output) (plt-name)
-	   source-files
+	       source-files
-	   (map list (plt-setup-collections))
+	       #:collections (map list (plt-setup-collections))
-	   std-filter #t 
+	       #:file-mode (if (plt-files-replace)
-	   (if (plt-files-replace)
+			       'file-replace
-	       'file-replace
+			       'file)
-	       'file)
+	       #:plt-relative? (or (plt-files-plt-relative?)
-	   #f
+				   (plt-files-plt-home-relative?))
-	   (or (plt-files-plt-relative?)
+	       #:at-plt-home? (plt-files-plt-home-relative?)
-	       (plt-files-plt-home-relative?))
+	       #:test-plt-dirs (if (or (plt-force-install-dir?)
-	   ;; Get current version of mzscheme for require:
+				       (not (plt-files-plt-home-relative?)))
-	   (let ([i (get-info '("mzscheme"))])
+				   #f
-	     (let ([v (and i (i 'version (lambda () #f)))])
+				   (list "collects" "doc" "include" "lib"))
-	       (list (list '("mzscheme") v))))
+	       #:requires
-	   null
+	       ;; Get current version of mzscheme for require:
-	   (plt-files-plt-home-relative?))
+	       (let ([i (get-info '("mzscheme"))])
+		 (let ([v (and i (i 'version (lambda () #f)))])
+		   (list (list '("mzscheme") v)))))
      (printf " [output to \"~a\"]~n" (plt-output))]
     [(plt-collect)
-     (pack-collections
+     (pack-collections-plt
       (plt-output)
       (if (eq? default-plt-name (plt-name))
 	  #f
@@ -569,13 +579,14 @@
 		     (cons (cadr m) (loop (caddr m)))
 		     (list sf)))))
 	   source-files)
-      (plt-files-replace)
+      #:replace? (plt-files-replace)
-      (map list (plt-setup-collections))
+      #:extra-setup-collections (map list (plt-setup-collections))
-      (if (plt-include-compiled)
+      #:filter (if (plt-include-compiled)
-	  (lambda (path)
+		   (lambda (path)
-	    (or (regexp-match #rx"compiled$" path)
+		     (or (regexp-match #rx"compiled$" path)
-		(std-filter path)))
+			 (std-filter path)))
-	  std-filter)
+		   std-filter)
-      (plt-files-plt-home-relative?))
+      #:at-plt-home? (plt-files-plt-home-relative?)
+      #:test-plt-collects? (not (plt-force-install-dir?)))
      (printf " [output to \"~a\"]~n" (plt-output))]
     [else (printf "bad mode: ~a~n" mode)]))

collects/config/config.ss

@@ -0,0 +1,8 @@
+
+;; The config module doesn't have to use "configtab.ss";
+;; it just has the have the right exports. But using
+;; "configtab.ss" makes it easier to generate the
+;; code at install time.
+(module config (lib "configtab.ss" "setup")
+  ;; An empty table means that all defaults apply
+  )

collects/drscheme/private/language-configuration.ss

@@ -1024,9 +1024,7 @@
              (floor (inexact->exact (unbox y-box))))))
 
       (define teachpack-directory 
-        (let ([lib-dir (build-path 
+        (let ([lib-dir (collection-path "teachpack")])
-                        (collection-path "mzlib")
-                        'up 'up "teachpack")])
           (if (directory-exists? lib-dir)
               lib-dir
               #f)))

collects/help/installer.ss

@@ -3,7 +3,8 @@
   
   (require (lib "match.ss")
 	   (lib "file.ss")
-	   (lib "list.ss"))
+	   (lib "list.ss")
+	   (lib "dirs.ss" "setup"))
   
   (define installer
     (lambda (path)   
@@ -28,9 +29,8 @@
 		       (build-path (collection-path "help") "servlets")))
   (define exploded-servlet-dir-len (length (explode-path servlet-dir)))
   
-  ;; assume that there is only a single `help' collection and that the
+  ;; assume that "help" is in the main doc directory
-  ;; original PLT tree help directory is a sibling of that.
+  (define dest-dir (build-path (find-doc-dir) "help"))
-  (define dest-dir (build-path (collection-path "help") 'up "doc" "help"))
   
   (unless (directory-exists? dest-dir)
     (make-directory* dest-dir))

collects/help/private/colldocs.ss

@@ -27,56 +27,4 @@
                                       docs)
                                 (cons name names))
                           (loop (cdr dirs) docs names)))
-                    (loop (cdr dirs) docs names)))])))
+                    (loop (cdr dirs) docs names)))]))))
-                        
-  
-  ; Gets a list of collections that contain a doc.txt file
-  ; returns two parallel lists.
-  ; the first has the locations of the docs and the second is their names.
-  #;
-  (define (colldocs)
-    (let loop ([collection-paths (current-library-collection-paths)]
-               [docs null]
-               [names null])
-      (cond
-	[(null? collection-paths)
-	 (let* ([collections-docs (map cons docs names)]
-		[l (sort collections-docs
-                         (lambda (a b) (string<? (cdr a) (cdr b))))])
-	   (values (map car l) (map cdr l)))]
-	[else (let ([path (car collection-paths)])
-		(let cloop ([l (with-handlers ([exn:fail:filesystem? (lambda (x) null)])
-                                 (directory-list path))]
-			    [path path]
-			    [collpath null]
-			    [docs docs]
-			    [names names])
-                  (cond
-                    [(null? l) (if (null? collpath)
-                                   (loop (cdr collection-paths) docs names)
-                                   (values docs names))]
-                    [else 
-                     (let* ([coll (car l)]
-                            [colldir (build-path path coll)])
-                       (cond
-                         [(and (directory-exists? colldir)
-                               (not (member (path->string coll) names)))
-                          (let* ([lcollpath (append collpath (list coll))]
-                                 [doc-txt-file (list colldir (string->path "doc.txt"))]
-                                 [this? (file-exists? (apply build-path doc-txt-file))])
-                            (let-values ([(sub-docs sub-names)
-                                          (with-handlers ([exn:fail:filesystem?
-                                                           (lambda (x) (values null null))])
-                                            (let ([info-proc/f (get-info lcollpath)])
-                                              (if info-proc/f
-                                                  (let ([l (info-proc/f 'doc-sub-collections (lambda () null))])
-                                                    (cloop (map string->path l) colldir lcollpath null null))
-                                                  (values null null))))])
-                              (let ([sub-names (map (lambda (s) (string-append (path->string coll) " " s)) sub-names)])
-                                (let-values ([(ldocs lnames)
-                                              (if this?
-                                                  (values (cons doc-txt-file sub-docs)
-                                                          (cons (path->string coll) sub-names))
-                                                  (values sub-docs sub-names))])
-                                  (cloop (cdr l) path collpath (append ldocs docs) (append lnames names))))))]
-                         [else (cloop (cdr l) path collpath docs names)]))])))]))))

collects/help/private/config.ss

@@ -1,6 +1,7 @@
 (module config mzscheme
   (require (lib "file.ss")
            (lib "configuration.ss" "web-server")
+	   (lib "dirs.ss" "setup")
            "internal-hp.ss")
   
   (provide config)
@@ -11,7 +12,6 @@
               (normalize-path
                (apply build-path args)))]
            [help-path (build-normal-path (collection-path "help"))]
-           [doc-path (build-normal-path help-path 'up "doc")]
            [host-root (build-normal-path help-path "web-root")]
            [servlet-root help-path]
            [make-host-config
@@ -46,8 +46,11 @@
          (max-waiting 40)
          (initial-connection-timeout 30)
          (default-host-table
-           ,(make-host-config (build-normal-path doc-path 'up)))
+           ,(make-host-config (find-collects-dir)))
-         (virtual-host-table
+	 (virtual-host-table
-          (,addon-host 
+	  ,@(map
-           ,(make-host-config
+	     (lambda (virtual-host dir)
-             (build-path (find-system-path 'addon-dir))))))))))
+	       `(,virtual-host 
+		 ,(make-host-config dir)))
+	     (append doc-hosts collects-hosts)
+	     (append doc-dirs collects-dirs))))))))

collects/help/private/finddoc.ss

@@ -1,10 +1,12 @@
 (module finddoc mzscheme
-  (require "path.ss")
+  (require "path.ss"
+	   (lib "dirs.ss" "setup"))
 
   (provide finddoc
 	   findreldoc
            finddoc-page
-	   finddoc-page-anchor)
+	   finddoc-page-anchor
+	   find-doc-directory)
   
   ;; Creates a "file:" link into the indicated manual.
   ;; The link doesn't go to a particular anchor,
@@ -39,7 +41,7 @@
           (let ([path (if anchor?
                           (string-append (caddr m) "#" (cadddr m))
                           (caddr m))])
-            (if (servlet-path? path)
+            (if (servlet-path? (string->path (caddr m)))
                 path
                 (format "/doc/~a/~a" manual path))))))
   
@@ -63,7 +65,7 @@
   ;; (list docdir index-key filename anchor title)
   (define (lookup manual index-key label)
     (let ([key (string->symbol manual)]
-	  [docdir (build-path (collection-path "doc") manual)])
+	  [docdir (find-doc-directory manual)])
       (let ([l (hash-table-get
 		ht
 		key
@@ -77,6 +79,13 @@
 	(let ([m (assoc index-key l)])
 	  (if m 
 	      (cons docdir m)
-	      (error 'finddoc "index key ~s not found in manual ~s" index-key manual)))))))
+	      (error 'finddoc "index key ~s not found in manual ~s" index-key manual))))))
-
+  
-
+  ;; finds the full path of the doc directory, if one exists
+  ;; input is just the short name of the directory (as a path)
+  (define (find-doc-directory doc)
+    (ormap (lambda (d)
+	     (let ([p (build-path d doc)])
+	       (and (directory-exists? p)
+		    p)))
+	   (get-doc-search-dirs))))

collects/help/private/get-help-url.ss

@@ -4,7 +4,8 @@
   (require (lib "file.ss")
            "internal-hp.ss"
            (lib "contract.ss")
-           (lib "etc.ss"))
+           (lib "etc.ss")
+	   (lib "dirs.ss" "setup"))
   
   (provide/contract (get-help-url
                      (((lambda (x)
@@ -20,37 +21,39 @@
       (let ([segments (explode-path (normalize-path manual-path))])
         (let loop ([candidates manual-path-candidates])
           (cond
-            ;; shouldn't happen, unless documentation is found outside the user's addon dir
+	   ;; shouldn't happen, unless documentation is outside
-            ;; and also outside the PLT tree.
+	   ;; the set of doc dirs:
-            [(null? candidates) "/cannot-find-docs.html"]
+	   [(null? candidates) "/cannot-find-docs.html"]
-            [else
+	   [else
-             (let ([candidate (car candidates)])
+	    (let ([candidate (car candidates)])
-               (cond
+	      (cond
-                 [(subpath/tail (car candidate) segments)
+	       [(subpath/tail (car candidate) segments)
-                  =>
+		=>
-                  (λ (l-o-path)
+		(λ (l-o-path)
-                     ((cadr candidate) l-o-path anchor))]
+		  ((cadr candidate) l-o-path anchor))]
-                 [else (loop (cdr candidates))]))])))))
+	       [else (loop (cdr candidates))]))])))))
-  
+
   (define manual-path-candidates '())
   (define (maybe-add-candidate candidate host)
     (with-handlers ([exn:fail? void])
       (set! manual-path-candidates
             (cons (list (explode-path (normalize-path candidate))
                         (λ (segments anchor)
-                           (format "http://~a:~a~a~a"
+			  (format "http://~a:~a~a~a"
-                                   host
+				  host
-                                   internal-port
+				  internal-port
-                                   (apply string-append (map (λ (x) (format "/~a" (path->string x))) 
+				  (apply string-append (map (λ (x) (format "/~a" (path->string x))) 
-                                                             segments))
+					                    segments))
-                                   (if anchor
+				  (if anchor
-                                       (string-append "#" anchor)
+				      (string-append "#" anchor)
-                                       ""))))
+				      ""))))
-                  manual-path-candidates))))
+		  manual-path-candidates))))
-  (define stupid-internal-define-syntax1
+
-    (maybe-add-candidate (build-path (collection-path "doc") 'up) internal-host))
+  ;; Add doc dirs later, so that they take precedence:
-  (define stupid-internal-define-syntax2
+  (for-each (lambda (dir host)
-    (maybe-add-candidate (build-path (find-system-path 'addon-dir)) addon-host))
+              (maybe-add-candidate dir host))
+            (append collects-dirs doc-dirs)
+            (append collects-hosts doc-hosts))
   
   (define (subpath/tail short long)
     (let loop ([short short]

collects/help/private/gui.ss

@@ -24,6 +24,7 @@
            "standard-urls.ss"
            "docpos.ss"
            "manuals.ss"
+	   "get-help-url.ss"
            
            "internal-hp.ss")
   
@@ -115,27 +116,58 @@
                      [(is-download.plt-scheme.org/doc-url? url)
                       url]
                      
-                     ;; on the internal host
+                     ;; one of the "collects" hosts:
-                     [(and (equal? internal-host (url-host url))
+                     [(and (equal? internal-port (url-port url))
-                           (equal? internal-port (url-port url)))
+			   (or (equal? internal-host (url-host url))
-                      (let* ([path (url-path url)]
+			       (ormap (lambda (host)
-                             [coll (and (pair? path)
+					(equal? host (url-host url)))
-                                        (pair? (cdr path))
+				      collects-hosts)))
-                                        (path/param-path (cadr path)))]
+		      url]
-                             [coll-path (and coll (string->path coll))]
+
-                             [doc-pr (and coll-path (assoc coll-path known-docs))])
+		     ;; one of the "doc" hosts:
-                        
+                     [(and (equal? internal-port (url-port url))
-                        ;; check to see if the docs are installed
+                           (ormap (lambda (host)
-                        (if (and doc-pr
+				    (equal? host (url-host url)))
-                                 (not (has-index-installed? coll-path)))
+				  doc-hosts))
-                            (let ([url-str (url->string url)])
+		      ;; Two things can go wrong with the URL:
-                              (string->url 
+		      ;;  1. The corresponding doc might not be installed
-                               (make-missing-manual-url coll (cdr doc-pr) url-str)))
+		      ;;  2. There's a relative reference from X to Y, and
-                            url))]
+		      ;;     X and Y are installed in different directories,
-                     
+		      ;;     so the host is wrong for Y
-                     [(and (equal? addon-host (url-host url))
+		      ;; Resolve 2, then check 1.
-                           (equal? internal-port (url-port url)))
+		      (let* ([path (url-path url)]
-                      url]
+			     [manual (and (pair? path)
+					  (path/param-path (car path)))])
+			(if manual
+			    ;; Find out where this manual is really located:
+			    (let* ([path (find-doc-directory (string->path manual))]
+				   [real-url (and path
+						  (get-help-url path))]
+				   [url (if real-url
+					    ;; Use the actual host:
+					    (make-url (url-scheme url)
+						      (url-user url)
+						      (url-host (string->url real-url))
+						      (url-port url)
+						      (url-path-absolute? url)
+						      (url-path url)
+						      (url-query url)
+						      (url-fragment url))
+					    ;; Can't do better than the original URL?
+					    ;;  The manual is not installed.
+					    url)])
+			      (if (or (not path)
+				      (not (has-index-installed? path)))
+				  ;; Manual not installed...
+				  (let ([doc-pr (assoc (string->path manual) known-docs)])
+				    (string->url
+				     (make-missing-manual-url manual
+							      (cdr doc-pr) 
+							      (url->string url))))
+				  ;; Manual here; use revised URL
+				  url))
+			    ;; Not a manual? Shouldn't happen.
+			    url))]
                      
                      ;; send the url off to another browser
                      [(or (and (string? (url-scheme url))
@@ -151,16 +183,8 @@
               (super-new)))
           
           ;; has-index-installed? : path -> boolean
-          (define (has-index-installed? doc-coll)
+          (define (has-index-installed? path)
-            (let loop ([docs-dirs (find-doc-directories)])
+	    (and (get-index-file path) #t))
-              (cond
-                [(null? docs-dirs) #f]
-                [else
-                 (let ([doc-dir (car docs-dirs)])
-                   (let-values ([(base name dir?) (split-path doc-dir)])
-                     (or (and (equal? doc-coll name)
-                              (get-index-file doc-dir))
-                         (loop (cdr docs-dirs)))))])))
           
           (define sk-bitmap #f)
           

collects/help/private/internal-hp.ss

@@ -1,6 +1,38 @@
 (module internal-hp mzscheme
-  (provide internal-host internal-port addon-host)
+  (require (lib "dirs.ss" "setup"))
-  
+  (provide internal-port internal-host
-  (define internal-host "helpdesk.plt-scheme.org") ;; should not exist.
+	   collects-hosts collects-dirs
-  (define addon-host "addon-helpdesk.plt-scheme.org") ;; ditto
+	   doc-hosts doc-dirs)
-  (define internal-port 8000))
+
+  ;; Hostnames defined here should not exist as real machines
+
+  ;; The general idea is that there's one virtual host for
+  ;;  every filesystem tree that we need to access.
+  ;; The "get-help-url.ss" library provides a function to
+  ;;  convert a path into a suitable URL (i.e., a URL using
+  ;;  the right virtual host).
+  ;; The "gui.ss" library performs a bit of extra URL
+  ;;  processing at the last minute, sometimes switching
+  ;;  a URL for a manual to a different host. (That's needed
+  ;;  when cross-manual references are implemented as relative
+  ;;  URLs.)
+
+  (define internal-host "helpdesk.plt-scheme.org")
+  (define internal-port 8000)
+
+  (define (generate-hosts prefix dirs)
+    (let loop ([dirs dirs][n 0])
+      (if (null? dirs)
+	  null
+	  (cons (format "~a~a.helpdesk.plt-scheme.org" prefix n)
+		(loop (cdr dirs) (add1 n))))))
+
+  (define collects-dirs
+    (get-collects-search-dirs))
+  (define collects-hosts 
+    (generate-hosts "collects" collects-dirs))
+
+  (define doc-dirs
+    (get-doc-search-dirs))
+  (define doc-hosts 
+    (generate-hosts "doc" doc-dirs)))

collects/help/private/manuals.ss

@@ -7,6 +7,8 @@
            (lib "contract.ss")
            (lib "getinfo.ss" "setup")
            (lib "uri-codec.ss" "net")
+	   (lib "dirs.ss" "setup")
+	   "finddoc.ss"
            "colldocs.ss"
            "docpos.ss"
            "path.ss"
@@ -50,87 +52,13 @@
           (make-sec "Libraries" #rx"SRFI|MzLib|Framework|PLT Miscellaneous|Teachpack|Swindle" '())
           (make-sec "Writing extensions" #rx"Tools|Inside|Foreign" '())
           (make-sec "Other" #rx"" '())))
-  
+    
-  ;; Creates a "file:" link into the indicated manual.
-  ;; The link doesn't go to a particular anchor,
-  ;; because "file:" does not support that.
-  (define (finddoc manual index-key label)
-    (let ([m (finddoc-lookup manual index-key label)])
-      (if (string? m)
-          m
-          (format "<A href=\"file:~a\">~a</A>"
-                  (path->string (build-path (car m) (caddr m)))
-                  label))))
-
-  ;; Given a Unix-style relative path to reach the "doc"
-  ;; collection, creates a link that can go to a
-  ;; particular anchor.
-  (define (findreldoc todocs manual index-key label)
-    (let ([m (finddoc-lookup manual index-key label)])
-      (if (string? m)
-          m
-          (format "<A href=\"~a/~a/~a#~a\">~a</A>"
-                  todocs
-                  manual
-                  (caddr m)
-                  (cadddr m)
-                  label))))
-
-  (define (finddoc-page-help manual index-key anchor?)
-    (let ([m (finddoc-lookup manual index-key "dummy")])
-      (if (string? m)
-          (error (format "Error finding index \"~a\" in manual \"~a\""
-                         index-key manual))
-          (let ([path (if anchor?
-                          (string-append (caddr m) "#" (cadddr m))
-                          (caddr m))])
-            (if (servlet-path? (string->path (caddr m)))
-                path
-                (format "/doc/~a/~a" manual path))))))
-  
-  ; finddoc-page : string string -> string
-  ; returns path for use by PLT Web server
-  ;  path is of form /doc/manual/page, or
-  ;  /servlet/<rest-of-path>
-  (define (finddoc-page manual index-key)
-    (finddoc-page-help manual index-key #f))
-
-  ; finddoc-page-anchor : string string -> string
-  ; returns path (with anchor) for use by PLT Web server
-  ;  path is of form /doc/manual/page#anchor, or
-  ;  /servlet/<rest-of-path>#anchor
-  (define (finddoc-page-anchor manual index-key)
-    (finddoc-page-help manual index-key #t))
-
-  ;; returns either a string (failure) or
-  ;; (list docdir index-key filename anchor title)
-  (define finddoc-ht (make-hash-table))
-  (define (finddoc-lookup manual index-key label)
-    (let ([key (string->symbol manual)]
-	  [docdir (find-doc-directory (string->path manual))])
-      (unless docdir
-        (error 'finddoc-lookup "manual ~s not found"  manual))
-      (let ([l (hash-table-get
-		finddoc-ht
-		key
-		(lambda ()
-		  (let ([f (build-path docdir "hdindex")])
-                    (if (file-exists? f)
-                        (let ([l (with-input-from-file f read)])
-                          (hash-table-put! finddoc-ht key l)
-                          l)
-                        (error 'finddoc "manual index ~s not installed" manual)))))])
-	(let ([m (assoc index-key l)])
-	  (if m 
-	      (cons docdir m)
-	      (error 'finddoc "index key ~s not found in manual ~s" index-key manual))))))
-  
   ; manual is doc collection subdirectory, e.g. "mred"
   (define (main-manual-page manual)
     (let* ([entry (assoc (string->path manual) known-docs)]
 	   [name (or (and entry (cdr entry))
                      manual)]
-	   [href (string-append "/doc/" manual "/")])
+	   [href (get-help-url (find-doc-directory manual))])
       `(A ((HREF ,href)) ,name)))
   
   ; string string string -> xexpr
@@ -197,36 +125,22 @@
                     [else (loop (cdr dirs))]))]))))
   
   (define (find-doc-directories-in-doc-collection)
-    (let loop ([paths (current-library-collection-paths)]
+    (let loop ([dirs (get-doc-search-dirs)]
-               [acc null])
+	       [acc null])
       (cond
-        [(null? paths) acc]
+       [(null? dirs) acc]
-        [else (let* ([path (car paths)]
+       [else (let* ([doc-path (car dirs)])
-                     [doc-path (build-path path "doc")])
+	       (if (directory-exists? doc-path)
-                (if (directory-exists? doc-path)
+		   (let dloop ([doc-contents (directory-list doc-path)]
-                    (let dloop ([doc-contents (directory-list doc-path)]
+			       [acc acc])
-                                [acc acc])
+		     (cond
-                      (cond
+		      [(null? doc-contents) (loop (cdr dirs) acc)]
-                        [(null? doc-contents) (loop (cdr paths) acc)]
+		      [else 
-                        [else 
+		       (let ([candidate (build-path doc-path (car doc-contents))])
-                         (let ([candidate (build-path doc-path (car doc-contents))])
+			 (if (directory-exists? candidate)
-                           (if (directory-exists? candidate)
+			     (dloop (cdr doc-contents) (cons candidate acc))
-                               (dloop (cdr doc-contents) (cons candidate acc))
+			     (dloop (cdr doc-contents) acc)))]))
-                               (dloop (cdr doc-contents) acc)))]))
+		   (loop (cdr dirs) acc)))])))
-                    (loop (cdr paths) acc)))])))
-  
-  ;; finds the full path of the doc directory, if one exists
-  ;; input is just the short name of the directory (as a path)
-  (define (find-doc-directory doc)
-    (let loop ([dirs (find-doc-directories-in-doc-collection)])
-      (cond
-        [(null? dirs) #f]
-        [else (let ([dir (car dirs)])
-                (let-values ([(base name dir?) (split-path dir)])
-                  (if (equal? name doc)
-                      dir
-                      (loop (cdr dirs)))))])))
-                            
   
   (define re:title (regexp "<[tT][iI][tT][lL][eE]>(.*)</[tT][iI][tT][lL][eE]>"))
 

collects/help/private/search.ss

@@ -5,7 +5,8 @@
            "manuals.ss"
            (lib "list.ss")
            (lib "plt-match.ss")
-           (lib "contract.ss"))
+           (lib "contract.ss")
+	   (lib "dirs.ss" "setup"))
   
   (provide doc-collections-changed)
   (provide/contract
@@ -33,6 +34,7 @@
    
    (non-regexp (string? . -> . string?)))
 
+  (define doc-dirs (get-doc-search-dirs))
   
   ; These are set by reset-doc-lists:
   ; docs, doc-names and doc-kinds are parallel lists. doc-kinds
@@ -44,8 +46,12 @@
   ; doc-kinds : (list-of symbol)
   (define doc-kinds null)
   ; doc-collection-date : (union #f number 'none)
-  (define doc-collection-date #f)
+  (define doc-collection-dates (map (lambda (x) #f) doc-dirs))
   
+  (define (dir-date/none dir)
+    (with-handlers ([exn:fail:filesystem? (lambda (x) 'none)])
+      (file-or-directory-modify-seconds dir)))
+
   (define (reset-doc-lists)
   ; Locate standard HTML documentation
     (define-values (std-docs std-doc-names)
@@ -64,10 +70,7 @@
 			  txt-doc-names)))
     (set! doc-kinds (append (map (lambda (x) 'html) std-docs) (map (lambda (x) 'text) txt-docs)))
     
-    (with-handlers ([exn:fail:filesystem? (lambda (x) (set! doc-collection-date 'none))])
+    (set! doc-collection-dates (map dir-date/none doc-dirs)))
-		   (set! doc-collection-date 
-			 (file-or-directory-modify-seconds
-			  (collection-path "doc")))))
   
   (define MAX-HIT-COUNT 300)
   
@@ -284,7 +287,7 @@
        (string->list s)))))
       
   (define (doc-collections-changed)
-    (set! doc-collection-date #f)
+    (set! doc-collection-dates (map (lambda (x) #f) doc-dirs))
     (set! html-keywords (make-hash-table 'equal))
     (set! html-indices (make-hash-table 'equal))
     (set! text-keywords (make-hash-table 'equal))
@@ -325,11 +328,18 @@
                      add-doc-section add-kind-section add-choice)
     ; When new docs are installed, the directory's modification date changes:
     (set! max-reached #f)
-    (unless (eq? doc-collection-date 'none)
+
-      (when (or (not doc-collection-date)
+    (when (ormap (lambda (date new-date)
-                (> (file-or-directory-modify-seconds (collection-path "doc"))
+		   (cond
-                   doc-collection-date))
+		    [(not date) #t]
-        (reset-doc-lists)))
+		    [(equal? date new-date) #f]
+		    [(eq? date 'none) #t]
+		    [(eq? new-date 'none) #t]
+		    [else (new-date . > . date)]))
+		 doc-collection-dates
+		 (map dir-date/none doc-dirs))
+      (reset-doc-lists))
+
     (let ([hit-count 0])
       (let-values ([(string-finds finds) (build-string-finds/finds given-find regexp? exact?)]
                    [(filtered-docs filtered-doc-names filtered-doc-kinds)

collects/help/private/tcp-intercept.ss

@@ -108,7 +108,8 @@
       (define (gen-tcp-connect raw)
         (lambda (hostname-string port)
           (if (and (or (string=? internal-host hostname-string)
-                       (string=? addon-host hostname-string))
+                       (ormap (lambda (host) string=? host hostname-string)
+			      doc-hosts))
                    (equal? internal-port port))
               (let-values ([(req-in req-out) (make-pipe)]
                            [(resp-in resp-out) (make-pipe)])

collects/help/refresh-manuals.ss

@@ -175,7 +175,12 @@
         (when doc-dir
           (display (format sc-refresh-deleting... full-name))
           (newline)
-          (delete-directory/r doc-dir)))))
+	  (with-handlers ([exn:fail:filesystem?
+			   (lambda (exn)
+			     (fprintf (current-error-port)
+				      "Warning: delete failed: ~a\n"
+				      (exn-message exn)))])
+	    (delete-directory/r doc-dir))))))
       
   (define delete-local-plt-files
     (lambda (tmp-dir)
@@ -216,5 +221,7 @@
                   (display (format sc-refresh-installing... (cdr pr)))
                   (newline)
                   (run-single-installer (make-local-doc-filename tmp-dir (car pr))
-                                        parent))
+					(lambda ()
+					  (error 'install-docs
+						 "expected PLT-relative archive"))))
                 docs-to-install))))

collects/help/servlets/release/notes.ss

@@ -2,6 +2,7 @@
   (require (lib "servlet.ss" "web-server")
            (lib "list.ss")
            (lib "uri-codec.ss" "net")
+	   (lib "dirs.ss" "setup")
            "../private/util.ss"
            "../private/headelts.ss")
   
@@ -9,7 +10,7 @@
     (let* ([label (car s)]
            [dir (cadr s)]
            [filename (caddr s)]
-           [file (build-path (collection-path "mzlib") 'up 'up "notes" dir filename)])
+           [file (build-path (find-doc-dir) "release-notes" dir filename)])
       (if (file-exists? file)
           `(LI (A ((HREF ,(format "/servlets/doc-anchor.ss?file=~a&name=~a&caption=~a"
                                   (uri-encode (path->string file))

collects/help/servlets/results.ss

@@ -13,6 +13,7 @@ is stored in a module top-level and that's namespace-specific.
            (lib "string.ss")
            (lib "servlet.ss" "web-server")
            (lib "uri-codec.ss" "net")
+	   (lib "dirs.ss" "setup")
            "../private/internal-hp.ss"
            "../private/path.ss"
            "../private/docpos.ss"
@@ -81,7 +82,7 @@ is stored in a module top-level and that's namespace-specific.
       (define exp-web-root
         (explode-path 
          (normalize-path 
-          (build-path (collection-path "mzlib") 'up))))
+	  (find-collects-dir))))
       (define web-root-len (length exp-web-root))
         
       (define (keyword-string? ekey)

collects/mzlib/foreign.ss

@@ -2,7 +2,8 @@
 
 (module foreign mzscheme
 
-(require #%foreign)
+(require #%foreign
+	 (lib "dirs.ss" "setup"))
 (require-for-syntax (lib "stx.ss" "syntax"))
 
 ;; This module is full of unsafe bindings that are not provided to requiring
@@ -166,7 +167,12 @@
              [name  (if (regexp-match lib-suffix-re name0) ; name + suffix
                       (string-append name0 version)
                       (string-append name0 "." lib-suffix version))])
-        (or (ffi-lib name #t)         ; try good name first
+        (or (ormap (lambda (dir)
+		     (or (ffi-lib (build-path dir name) #t)      ; try good name first
+			 (ffi-lib (build-path dir name0) #t)))   ; try original
+		   (get-lib-search-dirs))
+	    ;; Try without DLL path:
+	    (ffi-lib name #t)         ; try good name first
             (ffi-lib name0 #t)        ; try original
             (and (file-exists? name)  ; try a relative path
                  (ffi-lib (fullpath name) #t))

collects/openssl/mzssl.ss

@@ -18,8 +18,7 @@
 	   (lib "port.ss")
 	   (lib "etc.ss")
 	   (lib "kw.ss")
-	   (lib "filename-version.ss" "dynext")
+	   (lib "filename-version.ss" "dynext"))
-	   (lib "dirs.ss" "setup"))
 
   (provide ssl-available?
 	   ssl-load-fail-reason
@@ -53,20 +52,11 @@
 
   (define ssl-load-fail-reason #f)
 
-  (define (ffi-lib-win name)
-    (let* ([d (find-dll-dir)]
-	   [f (and d (build-path d (format "~a.dll" name)))])
-      ;; Try PLT-specific lib:
-      (if (and f (file-exists? f))
-	  (ffi-lib f)
-	  ;; Try system-wide:
-	  (ffi-lib (format "~a.dll" name)))))
-
   (define (ffi-lib-xxxxxxx name)
     (let* ([f (format "~a~a" name filename-version-part)])
       (or (with-handlers ([exn? (lambda (x) #f)])
-            (ffi-lib-win (format "~a~a" name filename-version-part)))
+            (ffi-lib (format "~a~a" name filename-version-part)))
-	  (ffi-lib-win (format "~axxxxxxx" name)))))
+	  (ffi-lib (format "~axxxxxxx" name)))))
 
   (define 3m? (regexp-match #rx#"3m" (path->bytes (system-library-subpath))))
 
@@ -76,7 +66,7 @@
 				 #f)])
       (case (system-type)
 	[(windows)
-	 (ffi-lib-win "libeay32")]
+	 (ffi-lib "libeay32")]
 	[else
 	 (ffi-lib "libcrypto")])))
 
@@ -87,7 +77,7 @@
 				      #f)])
 	   (case (system-type)
 	     [(windows)
-	      (ffi-lib-win "ssleay32")]
+	      (ffi-lib "ssleay32")]
 	     [else
 	      (ffi-lib "libssl")]))))
 

collects/setup/configtab.ss

@@ -0,0 +1,92 @@
+
+;; Defines a language to be used by the "config.ss" file
+
+(module configtab mzscheme
+  
+  ;; These are the name that need to be provided
+  ;;  by the "config.ss" library:
+  (define-for-syntax exports
+    '(doc-dir
+      doc-search-dirs
+      lib-dir
+      lib-search-dirs
+      include-dir
+      include-search-dirs
+      bin-dir))
+
+  ;; ----------------------------------------
+  ;; For configure into into absolute paths
+
+  (define use-default (delay #f))
+  
+  (define (to-path l)
+    (cond
+     [(string? l) (complete-path (string->path l))]
+     [(bytes? l) (complete-path (bytes->path l))]
+     [(list? l) (map to-path l)]
+     [else l]))
+
+  (define (complete-path p)
+    (cond
+     [(complete-path? p) p]
+     [(absolute-path? p) (exe-relative p)]
+     [else
+      (or (parameterize ([current-directory (find-system-path 'orig-dir)])
+	    (find-executable-path (find-system-path 'exec-file) p))
+	  (exe-relative p))]))
+
+  (define (exe-relative p)
+    (let ([exec (path->complete-path 
+		 (find-executable-path (find-system-path 'exec-file))
+		 (find-system-path 'orig-dir))])
+      (let-values ([(base name dir?) (split-path exec)])
+	(path->complete-path p base))))
+
+  ;; ----------------------------------------
+  ;;  module-begin
+
+  (define-syntax config-module-begin
+    (lambda (stx)
+      (syntax-case stx (define define-values)
+	[(_ (define-values (name) val))
+	 ;; This can happen because a lone definition is expanded
+	 #'(config-module-begin (define name val))]
+	[(_ (define name val) ...)
+	 (let ([names (syntax->list #'(name ...))])
+	   (unless (andmap identifier? names)
+	     (raise-syntax-error
+	      #f
+	      "bad syntax"
+	      stx))
+	   (for-each (lambda (name)
+		       (unless (memq (syntax-e name) exports)
+			 (raise-syntax-error
+			  #f
+			  "not a config name"
+			  name)))
+		     names)
+	   (let ([syms (map syntax-e names)])
+	     (let loop ([names names][syms syms])
+	       (cond
+		[(null? names) 'done]
+		[(memq (car syms) (cdr syms))
+		 (raise-syntax-error
+		  #f
+		  "duplicate definition"
+		  (car names))]
+		[else
+		 (loop (cdr names) (cdr syms))]))
+	     #`(#%plain-module-begin
+		(provide #,@exports)
+		(define name (delay (to-path val))) ...
+		#,@(apply
+		    append
+		    (map (lambda (id)
+			   (if (memq id syms)
+			       ()
+			       (list #`(define #,id use-default))))
+			 exports)))))])))
+
+  (provide (rename config-module-begin #%module-begin)
+	   define
+	   #%datum quote))

collects/setup/dirs.ss

@@ -1,7 +1,11 @@
 (module dirs mzscheme
-  (require (lib "winutf16.ss" "compiler" "private")
+  (require (prefix config: (lib "config.ss" "config"))
+	   (lib "winutf16.ss" "compiler" "private")
 	   (lib "mach-o.ss" "compiler" "private"))
 
+  ;; ----------------------------------------
+  ;;  "collects"
+
   (define main-collects-dir
     (delay
       (let ([d (find-system-path 'collects-dir)])
@@ -10,11 +14,11 @@
 	 [(absolute-path? d)
 	  ;; This happens only under Windows; add a drive
 	  ;;  specification to make the path complete
-	  (let ([exec (find-system-path 'exec-file)])
+	  (let ([exec (path->complete-path 
-	    (if (complete-path? exec)
+		       (find-executable-path (find-system-path 'exec-file))
-		(let-values ([(base name dir?) (split-path exec)])
+		       (find-system-path 'orig-dir))])
-		  (path->complete-path d base))
+	    (let-values ([(base name dir?) (split-path exec)])
-		(path->complete-path d (find-system-path 'orig-dir))))]
+	      (path->complete-path d base)))]
 	 [else
 	  ;; Relative to executable...
 	  (parameterize ([current-directory (find-system-path 'orig-dir)])
@@ -24,36 +28,137 @@
 	      (and p
 		   (simplify-path p))))]))))
 
-  (provide find-main-collects-dir)
+  (provide find-collects-dir
-  (define (find-main-collects-dir)
+	   find-user-collects-dir
+	   get-collects-search-dirs)
+  (define (find-collects-dir)
     (force main-collects-dir))
+  (define user-collects-dir
+    (delay (build-path (find-system-path 'addon-dir) (version) "collects")))
+  (define (find-user-collects-dir)
+    (force user-collects-dir))
+  (define (get-collects-search-dirs)
+    (current-library-collection-paths))
+
+  ;; ----------------------------------------
+  ;; Helpers
+
+  (define (single p) (if p (list p) null))
+  (define (extra a l) (if (and a (not (member a l))) (cons a l) l))
+  (define (combine-search l default)
+    ;; Replace #f in list with default path:
+    (if l
+	(let loop ([l l])
+	  (cond
+	   [(null? l) null]
+	   [(not (car l)) (append default (loop (cdr l)))]
+	   [else (cons (car l) (loop (cdr l)))]))
+	default))
 
   (define-syntax define-finder
     (syntax-rules ()
-      [(_ provide id default)
+      [(_ provide config:id id user-id config:search-id search-id default)
        (begin
-	 (provide id)
+	 (define-finder provide config:id id user-id default)
+	 (provide search-id)
+	 (define (search-id)
+	   (combine-search (force config:search-id)
+			   (cons (user-id) (single (id))))))]
+      [(_ provide config:id id user-id config:search-id search-id extra-search-dir default)
+       (begin
+	 (define-finder provide config:id id user-id default)
+	 (provide search-id)
+	 (define (search-id)
+	   (combine-search (force config:search-id)
+			   (extra (extra-search-dir) 
+				  (cons (user-id) (single (id)))))))]
+      [(_ provide config:id id user-id default)
+       (begin
+	 (provide id user-id)
 	 (define dir
 	   (delay
-	     (let ([p (find-main-collects-dir)])
+	     (or (force config:id)
-	       (and p
+		 (let ([p (find-collects-dir)])
-		    (simplify-path (build-path p
+		   (and p
-					       'up
+			(simplify-path (build-path p
-					       default))))))
+						   'up
+						   default)))))))
 	 (define (id)
-	   (force dir)))]))
+	   (force dir))
+	 (define user-dir
+	   (delay (build-path (find-system-path 'addon-dir) (version) default)))
+	 (define (user-id)
+	   (force user-dir)))]))
 
-  (define-finder provide find-include-dir "include")
+  (define-syntax no-provide (syntax-rules () [(_ . rest) (begin)]))
-  (define-finder provide find-lib-dir "lib")
 
-  (define-finder provide find-console-bin-dir (case (system-type)
+  ;; ----------------------------------------
-						[(windows) 'same]
+  ;; "doc"
-						[(macosx unix) "bin"]))
 
-  (define-finder provide find-gui-bin-dir (case (system-type)
+  (define delayed-#f (delay #f))
-					    [(windows macosx) 'same]
-					    [(unix) "bin"]))
 
+  (provide find-doc-dir
+	   find-user-doc-dir
+	   get-doc-search-dirs)
+  (define-finder no-provide
+    config:doc-dir
+    find-doc-dir
+    find-user-doc-dir
+    delayed-#f
+    get-new-doc-search-dirs
+    "doc")
+  ;; For now, include "doc" pseudo-collections in search path:
+  (define (get-doc-search-dirs)
+    (combine-search (force config:doc-search-dirs)
+		    (append (get-new-doc-search-dirs)
+			    (map (lambda (p)
+				   (build-path p "doc"))
+				 (current-library-collection-paths)))))
+
+  ;; ----------------------------------------
+  ;; "include"
+
+  (define-finder provide
+    config:include-dir
+    find-include-dir
+    find-user-include-dir
+    config:include-search-dirs
+    get-include-search-dirs
+    "include")
+
+  ;; ----------------------------------------
+  ;; "lib"
+
+  (define-finder provide
+    config:lib-dir
+    find-lib-dir
+    find-user-lib-dir
+    config:lib-search-dirs
+    get-lib-search-dirs find-dll-dir
+    "lib")
+
+  ;; ----------------------------------------
+  ;; Executables
+
+  (define-finder provide 
+    config:bin-dir
+    find-console-bin-dir 
+    find-user-console-bin-dir
+    (case (system-type)
+      [(windows) 'same]
+      [(macosx unix) "bin"]))
+  
+  (define-finder provide
+    config:bin-dir
+    find-gui-bin-dir
+    find-user-gui-bin-dir
+    (case (system-type)
+      [(windows macosx) 'same]
+      [(unix) "bin"]))
+
+  ;; ----------------------------------------
+  ;; DLLs
+  
   (provide find-dll-dir)
   (define dll-dir
     (delay (case (system-type)
@@ -111,6 +216,4 @@
 	     [else
 	      (find-lib-dir)])))
   (define (find-dll-dir)
-    (force dll-dir))
+    (force dll-dir)))
-
-  )

collects/setup/doc.txt

@@ -242,8 +242,10 @@ parameters that control the setup process:
             "collects" directory, and a list of path choices; it
             returns a path for a "plt-relative" install; when
             unpacking an archive, either this or the procedure in
-            `current-target-directory-getter' will be called [default:
+            `current-target-directory-getter' will be called, and in
-            (lambda (preferred main-parent-dir choices) preferred)]
+            the former case, this procedure one may be called multiple
+	    times [default: (lambda (preferred main-parent-dir choices)
+            preferred)]
 
 Thus, to unpack a single .plt archive "x.plt", set the `archives'
 parameter to (list "x.plt") and leave `specific-collections' as null.
@@ -281,17 +283,33 @@ installation directories:
   #f if none can be found. (A #f result is likely only in an
   stand-alone executable that is distributed without libraries.)
 
-> (find-console-bin-dir)
+> (find-user-collects-dir)
 
-  Returns a path to the installation's executable directory, where the
+  Returns a path to the user-specific "collects" directory; the
-  stand-alone MzScheme executable resides. The result is #f if no such
+  directory indicated by the returned path may or may not exist.
-  directory is available.
 
-> (find-include-dir)
+> (get-collects-search-dir)
+
+  Returns the same result as `(current-library-collection-paths)'.
+
+
+> (find-doc-dir)
+
+  Returns a path to the installation's "doc" directory.  The result is
+  #f if no such directory is available.
+
+> (find-user-doc-dir)
+
+  Returns a path to a user-specific "doc" directory; the directory
+  indicated by the returned path may or may not exist.
+
+> (get-doc-search-dir)
+
+  Returns a list of paths to search for documentation, not including
+  documentation stored in individual collections. Unless it is
+  configured otherwise, the result includes any non-#f result of
+  `(find-doc-dir)' and `(find-user-doc-dir)'.
 
-  Returns a path to the installation's "include" directory, which
-  contains .h files for building MzScheme extensions and embedding
-  programs.  The result is #f if no such directory is available.
 
 > (find-lib-dir)
 
@@ -306,6 +324,49 @@ installation directories:
   is #f if no such directory is available, or if no specific directory
   is available (i.e., other than the platform's normal search path).
 
+> (find-user-lib-dir)
+
+  Returns a path to a user-specific "lib" directory; the directory
+  indicated by the returned path may or may not exist.
+
+> (get-lib-search-dir)
+
+  Returns a list of paths to search for libraries. Unless it is
+  configured otherwise, the result includes any non-#f result of
+  `(find-lib-dir)', `(find-dll-dir)', and `(find-user-lib-dir)'.
+
+
+> (find-include-dir)
+
+  Returns a path to the installation's "include" directory, which
+  contains .h files for building MzScheme extensions and embedding
+  programs.  The result is #f if no such directory is available.
+
+> (find-user-include-dir)
+
+  Returns a path to a user-specific "include" directory; the directory
+  indicated by the returned path may or may not exist.
+
+> (get-include-search-dir)
+
+  Returns a list of paths to search for .h files. Unless it is
+  configured otherwise, the result includes any non-#f result of
+  `(find-include-dir)' and `(find-user-include-dir)'.
+
+
+> (find-console-bin-dir)
+
+  Returns a path to the installation's executable directory, where the
+  stand-alone MzScheme executable resides. The result is #f if no such
+  directory is available.
+
+> (find-gui-bin-dir)
+
+  Returns a path to the installation's executable directory, where the
+  stand-alone MrEd executable resides. The result is #f if no such
+  directory is available.
+
+
 
 _Getting info.ss fields_
 ========================
@@ -411,7 +472,12 @@ The raw format is
 
      + 'plt-home-relative? - a boolean; if true and if `plt-relative?'
        is true, then the archive's content should be unpacked relative
-       to the plt installation directory.
+       to the PLT installation.
+
+     + 'test-plt-dirs - #f or a list of path strings; in the latter
+        case, a true value of 'plt-home-relative? is cancelled if
+        any of the directories in the list (relative to the PLT
+        installation) is unwritable by the user.
 
    The procedure is extracted from the archive using MzScheme's `read'
    and `eval' procedures (in a fresh namespace).
@@ -437,8 +503,9 @@ The raw format is
       + a relative path string - the pathname of the directory or file
         to be unpacked, relative to the unpack directory; and
 
-      + a path string for the unpack directory (which is often the
+      + a path string for the unpack directory (which can vary for a
-        parent of the main "collects" directory).
+      PLT-relative install when elements of the archive start with
+      "collects", "lib", etc.).
 
    If the filter procedure returns #f for a directory or file, the
    directory or file is not unpacked. If the filter procedure returns
@@ -492,7 +559,12 @@ mzc supports the creation of simple .plt files (see the mzc manual for
 details) but the setup collection's _pack.ss_ library provides more
 general functions to help make .plt archives:
 
-> (pack-collections dest name collections replace? extra-setup-collections [filter] [at-plt-home?])
+> (pack-collections-plt dest name collections 
+                        [#:replace? replace?]
+                        [#:at-plt-home? at-home?]
+                        [#:test-plt-collects? test?]
+                        [#:extra-setup-collections collection-list] 
+                        [#:filter filter-proc])
 
   Creates the .plt file specified by the pathname `dest', using the
   string `name' as the name reported to Setup PLT as the archive's
@@ -502,55 +574,96 @@ general functions to help make .plt archives:
   should be a list of collection paths; each collection path is, in
   turn, a list of relative-path strings.
 
-  If `replace?' is #f, then attempting to unpack the archive will
+  If the #:replace? argument is #f, then attempting to unpack the
-  report an error when any of the collections exist already, otherwise
+  archive will report an error when any of the collections exist
-  unpacking the archive will overwrite an existing collection.
+  already, otherwise unpacking the archive will overwrite an existing
+  collection.
 
-  The `extra-setup-collections' argument is a list of collection paths
+  If the #:at-plt-home? argument is true, then the archived
-  that are not included in the archive, but are set-up when the
+  collections will be installed into the PLT installation directory
-  archive is unpacked.
+  instead of the user's directory if the main "collects" directory is
+  writable by the user. If the #:test-plt-collects? argument is #f
+  (the default is #t) and the #:at-plt-home? argument is true, then
+  installation fails if the main "collects" directory is not writable.
 
-  The optional `filter' argument is the same as for `pack' (see
+  The optional #:extra-setup-collections argument is a list of
+  collection paths that are not included in the archive, but are
+  set-up when the archive is unpacked.
+
+  The optional #:filter argument is the same as for `pack-plt' (see
   below).
 
-  The optional `at-plt-home?' argument is the same as for `pack'
+> (pack-collections dest name collections replace? extra-setup-collections [filter] [at-plt-home?])
-  where `plt-relative?' is true.
 
-> (pack dest name paths collections [filter encode? file-mode unpack-unit plt-relative? requires conflicts at-plt-home?])
+  Old, keywordless variant of `pack-collections-plt' for backward compatibility.
+
+> (pack-plt dest name paths 
+            [#:filter filter-proc]
+            [#:encode? encode?]
+            [#:file-mode file-mode-sym]
+            [#:unpack-unit unit-expr-or-#f]
+            [#:collections collection-list]
+            [#:plt-relative? plt-relative?]
+            [#:at-plt-home? at-plt-home?]
+            [#:test-plt-dirs dir-list-or-#f]
+            [#:requires mod-and-version-list]
+            [#:conflicts mod-list])
 
   Creates the .plt file specified by the pathname `dest', using the
   string `name' as the name reported to Setup PLT as the archive's
-  description, and `collections' as the list of collection paths (to
+  description. The `paths' argument must be a list of relative paths
-  be compiled) returned by the unpacking unit. The `paths' argument
+  for directories and files; the contents of these files and
-  must be a list of relative paths for directories and files; the
+  directories will be packed into the archive.
-  contents of these files and directories will be packed into the
-  archive.
 
-  The `filter' procedure is called with the relative path of each
+  The #:filter procedure is called with the relative path of each
   candidate for packing. If it returns #f for some path, then that
   file or directory is omitted from the archive. If it returns 'file
   or 'file-replace for a file, the file is packed with that mode,
-  rather than the default mode. The default `filter' is `std-filter'
+  rather than the default mode. The default is `std-filter' (defined
-  (defined below).
+  below).
   
-  If `encode?' is #f, then the output archive is in raw form, and
+  If the #:encode? argument is #f, then the output archive is in raw
-  still must be gzipped and mime-encoded (in that order). The default
+  form, and still must be gzipped and mime-encoded (in that
-  value is #t.
+  order). The default value is #t.
 
-  The `file-mode' argument must be 'file or 'file-replace, indicating
+  The #:file-mode argument must be 'file or 'file-replace,
-  the default mode for a file in the archive. The default value is
+  indicating the default mode for a file in the archive. The default
-  'file.
+  is 'file.
 
   The `unpack-unit' argument is usually #f. Otherwise, it must be an
-  unsigned unit that performs the work of unpacking; see the above
+  S-expression for a unsigned unit that performs the work of
-  section on .plt internals for more information about the unit. If
+  unpacking; see the above section on .plt internals for more
-  `unpack-unit' is #f, an appropriate unpacking unit is generated.
+  information about the unit. If `unpack-unit' is #f, an appropriate
+  unpacking unit is generated.
 
-  If `plt-relative?', the archive's files and directories are to be
+  The #:collections argument is a list of collection paths to be
-  unpacked relative to the plt add-ons directory (unless
+  compiled after the archive is unpacked. The default is the empty
-  `plt-at-home?' is #t; see below).
+  list.
 
-  The `requires' argument should have the shape
+  If the #:plt-relative? argument is true (the default is #f), the
+  archive's files and directories are to be unpacked relative to the
+  user's add-ons directory or the PLT installation directories,
+  depending on whether the #:at-plt-home? argument is true and whether
+  directories specified by #;test-plt-dirs are writable by the user.
+
+  If the #:at-plt-home? argument is true (the default is #f), then
+  #:plt-relative? must be true, and the archive is unpacked relative
+  to the PLT installation directory. In that case, a relative path
+  that starts with "collects" is mapped to the installation's main
+  "collects" directory, and so on, for the following the initial
+  directory names:
+     - "collects"
+     - "doc"
+     - "lib"
+     - "include"
+
+  If #:test-plt-dirs is a list, then #:at-plt-home? must be true. In
+  that case, when the archive is unpacked, if any of the relative
+  directories in the #;test-plt-dirs list is unwritable by the current
+  user, then the archive is unpacked in the user's add-ons directory
+  after all.
+
+  The #:requires argument should have the shape
       (list (list <coll-path> <version>) ...)
   where each <coll-path> is a non-empty list of relative-path strings,
   and each <version> is a (possibly empty) list of exact integers. The
@@ -559,15 +672,15 @@ general functions to help make .plt archives:
   specified in the corresponding <version>. A collection's version is
   indicated by the `version' field of it's info.ss file.
 
-  The `conflicts' argument should have the shape
+  The #:conflicts argument should have the shape
        (list <coll-path> ...)
   where each <coll-path> is a non-empty list of relative-path
   strings. The indicated collections must *not* be installed at
   unpacking time.
 
-  If `at-plt-home?' and `plt-relative?', the archive is to be unpacked
+> (pack dest name paths collections [filter encode? file-mode unpack-unit plt-relative? requires conflicts at-plt-home?])
-  relative to the parent of the PLT Scheme installation's main
+
-  "collects" directory. The default is #f.
+  Old, keywordless variant of `pack-plt' for backward compatibility.
 
 > (std-filter p) - returns #t unless `p', after stripping its
   directory path and converting to a byte string, matches one of the

collects/setup/main-collects.ss

@@ -28,8 +28,8 @@
 	simplify-bytes-path))
 
   (define main-collects-dir-bytes
-    (delay (and (find-main-collects-dir)
+    (delay (and (find-collects-dir)
-		(path->bytes (find-main-collects-dir)))))
+		(path->bytes (find-collects-dir)))))
 
   (define main-collects-dir/
     (delay (and (force main-collects-dir-bytes)
@@ -68,7 +68,7 @@
     (cond [(and (pair? path)
                 (eq? 'collects (car path))
                 (bytes? (cdr path)))
-	   (let ([dir (or (find-main-collects-dir)
+	   (let ([dir (or (find-collects-dir)
 			  ;; No main "collects"? Use original working directory:
 			  (find-system-path 'orig-dir))])
 	     (if (equal? (cdr path) #"")

collects/setup/pack.ss

@@ -7,9 +7,23 @@
 	   (lib "etc.ss")
 	   (lib "port.ss")
 	   (lib "file.ss")
+	   (lib "kw.ss")
 	   (lib "getinfo.ss" "setup"))
 
-  (provide pack mztar std-filter pack-collections)
+  (provide pack 
+	   pack-plt
+	   mztar 
+	   std-filter 
+	   pack-collections
+	   pack-collections-plt)
+
+  (define (x-arg-needs-true-arg who arg1-name v arg2-name)
+    (error who 
+	   (string-append
+	    "true value for `~a' argument: ~e "
+	    "requires a true value for `~a' argument")
+	   arg1-name v
+	   arg2-name))
   
   (define pack
     (opt-lambda (dest name paths collections
@@ -20,7 +34,37 @@
 		      [plt-relative? #t]
 		      [requires null]
 		      [conflicts null]
-		      [plt-home-relative? #f])
+		      [at-plt-home? #f])
+      (pack-plt dest name paths 
+		#:collections collections
+		#:filter filter
+		#:encode? encode?
+		#:file-mode file-mode
+		#:unpack-unit unpack-unit
+		#:plt-relative? plt-relative?
+		#:requires null
+		#:conflicts null
+		#:at-plt-home? at-plt-home?)))
+
+  (define pack-plt
+    (lambda/kw (dest name paths 
+		     #:key
+		     [collections null]
+		     [filter std-filter]
+		     [encode? #t]
+		     [file-mode 'file]
+		     [unpack-unit #f]
+		     [plt-relative? #t]
+		     [requires null]
+		     [conflicts null]
+		     [at-plt-home? #f]
+		     [test-plt-dirs #f])
+      (when at-plt-home?
+	(unless plt-relative?
+	  (x-arg-needs-true-arg 'pack-plt 'at-plt-home? at-plt-home? 'plt-relative?)))
+      (when test-plt-dirs
+	(unless at-plt-home?
+	  (x-arg-needs-true-arg 'pack-plt 'test-plt-dirs test-plt-dirs 'at-plt-home?)))
       (let*-values ([(file) (open-output-file dest 'truncate/replace)]
                     [(fileout thd)
                      (if encode?
@@ -83,7 +127,10 @@
 	      [(conflicts) ',conflicts]
 	      [(plt-relative?) ,plt-relative?]
 	      [(plt-home-relative?) ,(and plt-relative?
-					  plt-home-relative?)]
+					  at-plt-home?)]
+	      [(test-plt-dirs) ,(and plt-relative?
+				     at-plt-home?
+				     `',test-plt-dirs)]
 	      [else (failure)]))
          fileout)
         (newline fileout)
@@ -161,7 +208,21 @@
 		 (regexp-match #rx#"^[.]#" name))))))
 
   (define pack-collections
-    (opt-lambda (output name collections replace? extra-setup-collections [file-filter std-filter] [plt-home-relative? #f])
+    (opt-lambda (output name collections replace? extra-setup-collections [file-filter std-filter] [at-plt-home? #f])
+      (pack-collections-plt output name collections 
+			    #:replace? replace? 
+			    #:extra-setup-collections  extra-setup-collections 
+			    #:filter file-filter
+			    #:at-plt-home? at-plt-home?)))
+
+  (define pack-collections-plt
+    (lambda/kw (output name collections 
+		       #:key
+		       [replace? #f]
+		       [extra-setup-collections null]
+		       [file-filter std-filter]
+		       [at-plt-home? #f]
+		       [test-plt-collects? #t])
       (let-values ([(dir source-files requires conflicts name)
 		    (let ([dirs (map (lambda (cp) (apply collection-path cp)) collections)])
 		      ;; Figure out the base path:
@@ -224,35 +285,39 @@
 				     (lambda () (caar collections)))))))])
 	(let ([output (path->complete-path output)])
 	  (parameterize ([current-directory dir])
-	    (pack output name
+	    (pack-plt
-		  source-files
+	     output name
-		  (append
+	     source-files
-		   extra-setup-collections
+	     #:collections (append
-		   (filter get-info collections))
+			    extra-setup-collections
-		  file-filter #t 
+			    (filter get-info collections))
-		  (if replace?
+	     #:filter file-filter 
-		      'file-replace
+	     #:file-mode (if replace?
-		      'file)
+			     'file-replace
-		  #f
+			     'file)
-		  #t ; plt-relative
+	     #:plt-relative? #t 
-		  ;; For each require, get current version
+	     #:requires
-		  (map (lambda (r)
+	     ;; For each require, get current version
-			 (let ([i (get-info r)])
+	     (map (lambda (r)
-			   (let ([v (and i (i 'version (lambda () #f)))])
+		    (let ([i (get-info r)])
-			     (if v
+		      (let ([v (and i (i 'version (lambda () #f)))])
-				 (begin
+			(if v
-				   (unless (and (list? v)
+			    (begin
-						(andmap number? v)
+			      (unless (and (list? v)
-						(andmap exact? v)
+					   (andmap number? v)
-						(andmap integer? v))
+					   (andmap exact? v)
-				     (error
+					   (andmap integer? v))
-				      'mzc
+				(error
-				      "bad version specification in info.ss for collection ~s"
+				 'mzc
-				      r))
+				 "bad version specification in info.ss for collection ~s"
-				   (list r v))
+				 r))
-				 (list r null)))))
+			      (list r v))
-		       (cons
+			    (list r null)))))
-			'("mzscheme")
+		  (cons
-			requires))
+		   '("mzscheme")
-		  conflicts
+		   requires))
-		  plt-home-relative?)))))))
+	     #:conflicts conflicts
+	     #:at-plt-home? at-plt-home?
+	     #:test-plt-dirs (and at-plt-home?
+				  test-plt-collects?
+				  '("collects")))))))))

collects/setup/setup-unit.ss

@@ -39,7 +39,7 @@
 	  (apply setup-fprintf (current-output-port) s args)))
       
       (setup-printf "Setup version is ~a" (version))
-      (setup-printf "Main collection path is ~a" (find-main-collects-dir))
+      (setup-printf "Main collection path is ~a" (find-collects-dir))
       (setup-printf "Collection search path is ~a" (if (null? (current-library-collection-paths))
 						       "empty!"
 						       ""))
@@ -75,7 +75,7 @@
 	 (specific-collections)
 	 (map (lambda (x) (unpack 
 			   x 
-			   (build-path (find-main-collects-dir) 'up)
+			   (build-path (find-collects-dir) 'up)
 			   (lambda (s) (setup-printf "~a" s)) 
 			   (current-target-directory-getter)
 			   (force-unpacks)
@@ -536,7 +536,7 @@
                       (setup-printf "~aInstalling ~a"
                                     (case part [(pre) "Pre-"] [(post) "Post-"] [else ""])
                                     (cc-name cc))
-		      (let ([dir (build-path (find-main-collects-dir) 'up)])
+		      (let ([dir (build-path (find-collects-dir) 'up)])
 			(if (procedure-arity-includes? installer 2)
 			    (installer dir (cc-path cc))
 			    (installer dir)))))))))

collects/setup/unpack.ss

@@ -6,7 +6,8 @@
 	   (lib "file.ss")
 	   (lib "unit.ss")
 	   (lib "base64.ss" "net")
-	   (lib "getinfo.ss" "setup"))
+	   (lib "getinfo.ss" "setup")
+	   "dirs.ss")
 
   ;; Returns a port and a kill thunk
   (define (port64gz->port p64gz)
@@ -41,34 +42,58 @@
 						   (path->string base)
 						   base)))))
 
-  (define (unmztar p filter main-collects-parent-dir print-status)
+  (define (shuffle-path parent-dir get-dir shuffle? v)
+    (if shuffle?
+	;; Re-arrange for "collects', etc.
+	(cond
+	 [(null? v) (values #f 'same)]
+	 [else
+	  (let ([dir
+		 (cond
+		  [(string=? (car v) "collects")
+		   (get-dir find-collects-dir find-user-collects-dir)]
+		  [(string=? (car v) "doc")
+		   (get-dir find-doc-dir find-user-doc-dir)]
+		  [(string=? (car v) "lib")
+		   (get-dir find-lib-dir find-user-lib-dir)]
+		  [(string=? (car v) "include")
+		   (get-dir find-include-dir find-user-include-dir)]
+		  [else #f])])
+	    (if dir
+		(if (null? (cdr v))
+		    (values dir 'same)
+		    (values dir (apply build-path (cdr v))))
+		(values parent-dir (apply build-path v))))])
+	(values parent-dir
+		(if (null? v)
+		    'same
+		    (apply build-path v)))))
+
+  (define (unmztar p filter parent-dir get-dir shuffle? print-status)
     (define bufsize 4096)
     (define buffer (make-bytes bufsize))
     (let loop ()
       (let ([kind (read p)])
 	(unless (eof-object? kind)
 	  (case kind
-	    [(dir) (let ([s (let ([v (read p)])
+	    [(dir) (let-values ([(target-dir s) (shuffle-path parent-dir get-dir shuffle? (read p))])
-			      (if (null? v)
-				  'same
-				  (apply build-path v)))])
 		     (unless (or (eq? s 'same) (relative-path? s))
 		       (error "expected a directory name relative path string, got" s))
-		     (when (or (eq? s 'same) (filter 'dir s main-collects-parent-dir))
+		     (when (or (eq? s 'same) (filter 'dir s target-dir))
-		       (let ([d (build-path main-collects-parent-dir s)])
+		       (let ([d (build-path target-dir s)])
 			 (unless (directory-exists? d)
 			   (print-status
 			    (format "  making directory ~a" (pretty-name d)))
 			   (make-directory* d)))))]
 	    [(file file-replace) 
-	     (let ([s (apply build-path (read p))])
+	     (let-values ([(target-dir s) (shuffle-path parent-dir get-dir shuffle? (read p))])
 	       (unless (relative-path? s)
 		 (error "expected a file name relative path string, got" s))
 	       (let ([len (read p)])
 		 (unless (and (number? len) (integer? len))
 		   (error "expected a file name size, got" len))
-		 (let* ([write? (filter kind s main-collects-parent-dir)]
+		 (let* ([write? (filter kind s target-dir)]
-			[path (build-path main-collects-parent-dir s)])
+			[path (build-path target-dir s)])
 		   (let ([out (and write?
 				   (if (file-exists? path)
 				       (if (eq? kind 'file)
@@ -147,26 +172,51 @@
 					   (lambda (n) 
 					     (unless (eq? n 'mzscheme)
 					       (error "unpacker isn't mzscheme:" n))))]
-		      [target-dir (let ([rel? (call-info info 'plt-relative? (lambda () #f) values)]
+		      [target-dir-info
-					[not-user-rel? (call-info info 'plt-home-relative? (lambda () #f) values)])
+		       (let ([rel? (call-info info 'plt-relative? (lambda () #f) values)]
-				    (if rel?
+			     [not-user-rel? (call-info info 'plt-home-relative? (lambda () #f) values)]
-					(if (and not-user-rel? 
+			     [test-dirs (call-info info 'test-plt-dirs (lambda () #f) values)])
-						 ;; Check for void because old unpacker didn't use
+			 (if rel?
-						 ;;  the failure thunk.
+			     ;; Shuffling...
-						 (not (void? not-user-rel?)))
+			     (if (and not-user-rel? 
-					    (get-target-plt-directory main-collects-parent-dir
+				      ;; Check for void because old unpacker didn't use
+				      ;;  the failure thunk.
+				      (not (void? not-user-rel?))
+				      ;; Non-user optional if test-dirs are writable
+				      (or (not test-dirs)
+					  (andmap (lambda (p)
+						    (and (string? p)
+							 (let ([dir (let-values ([(base dir)
+										  (shuffle-path main-collects-parent-dir
+												(lambda (a b) (a))
+												#t (list p))])
+								      (build-path base dir))])
+							   (memq 'write 
+								 (with-handlers ([exn:fail:filesystem? (lambda (x) null)])
+								   (file-or-directory-permissions dir))))))
+						  test-dirs)))
+				 ;; Shuffle to main directory always:
+				 (let ([dir (get-target-plt-directory main-collects-parent-dir
 								      main-collects-parent-dir
-								      (list main-collects-parent-dir))
+								      (list main-collects-parent-dir))])
-					    (let ([addons (build-path (find-system-path 'addon-dir)
+				   (list dir (lambda (sys user)
-								      (version))])
+					       (let ([a (sys)])
-					      (get-target-plt-directory
+						 (get-target-plt-directory a a (list a))))))
+				 ;; Prefer to shuffle to user directory:
+				 (let ([addons (find-user-collects-dir)])
+				   (let ([dir (get-target-plt-directory
 					       addons
 					       main-collects-parent-dir
-					       (list addons main-collects-parent-dir))))
+					       (list addons main-collects-parent-dir))])
-					(get-target-directory)))])
+				     (list dir (lambda (sys user)
+						 (let ([a (sys)]
+						       [b (user)])
+						   (get-target-plt-directory b a (list b a))))))))
+			     ;; No shuffling --- install to target directory:
+			     (list (get-target-directory))))])
 		  
 		  ;; Stop if no target directory:
-		  (if target-dir
+		  (if (car target-dir-info)
 
 		      ;; Check declared dependencies (none means v103)
 		      (begin
@@ -252,10 +302,15 @@
 			(let ([u (eval (read p) n)])
 			  (unless (eval `(unit? ,u) n)
 			    (error "expected a unit, got" u))
-			  (make-directory* target-dir)
+			  (make-directory* (car target-dir-info))
 			  (let ([unmztar (lambda (filter)
-					   (unmztar p filter target-dir print-status))])
+					   (unmztar p filter 
-			    (eval `(invoke-unit ,u ,target-dir ,unmztar) n))))
+						    (car target-dir-info) 
+						    (lambda (a b)
+						      ((cadr target-dir-info) a b))
+						    ((length target-dir-info) . > . 1)
+						    print-status))])
+			    (eval `(invoke-unit ,u ,(car target-dir-info) ,unmztar) n))))
 
 		      ;; Cancelled: no collections
 		      null))))

collects/setup/winvers.ss

@@ -22,7 +22,7 @@
       (dynamic-require `(lib "winvers-change.ss" "setup") #f)))
 
   (define collects-dir
-    (path->string (find-main-collects-dir)))
+    (path->string (find-collects-dir)))
 
   (let ([argv (current-command-line-arguments)])
     (cond

collects/sgl/make-gl-info.ss

@@ -3,6 +3,7 @@
            (all-except (lib "file.ss" "dynext") append-c-suffix)
            (prefix dynext: (lib "link.ss" "dynext"))
            (lib "file.ss")
+	   (lib "dirs.ss" "setup")
            (lib "string.ss" "srfi" "13"))
   
   (provide make-gl-info)
@@ -87,7 +88,7 @@ end-string
          (string-tokenize s)))
   
   (define (get-args which-arg home)
-    (let ((fp (build-path home "lib" "buildinfo")))
+    (let ((fp (build-path (find-lib-dir) "buildinfo")))
       (cond
         ((file-exists? fp)
          (call-with-input-file fp
@@ -108,7 +109,7 @@ end-string
                                 file.c
                                 file.o
                                 `(,@(parse-includes (get-args "X_CFLAGS" home))
-                                    ,(build-path home "collects" "compiler")))
+                                    ,(collection-path "compiler")))
       (dynext:link-extension #f (list file.o) file.so)
       (delete/continue file.o)))
 
@@ -129,7 +130,7 @@ end-string
     (let ([t (system-type)])
       (if (eq? t 'unix)
 	  ;; Check "buildinfo" for USE_GL flag:
-	  (let ([buildinfo (build-path home "lib" "buildinfo")])
+	  (let ([buildinfo (build-path (find-lib-dir) "buildinfo")])
 	    (if (file-exists? buildinfo)
 		(with-input-from-file buildinfo
 		  (lambda ()

src/Makefile.in

@@ -1,6 +1,20 @@
 
 # Builds MzScheme and MrEd
 
+srcdir = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+libdir = @libdir@
+includepltdir = @includepltdir@
+libpltdir = @libpltdir@
+collectsdir = @collectsdir@
+mandir = @mandir@
+docdir = @docdir@
+builddir = @builddir@
+
+ALLDIRINFO = "$(bindir)" "$(collectsdir)" "$(docdir)" "$(libdir)" "$(includepltdir)" "$(libpltdir)" "$(mandir)"
+
 all:
 	$(MAKE) mz
 	$(MAKE) mred-stub
@@ -23,6 +37,7 @@ install:
 	$(MAKE) setup-plt
 
 install-normal:
+	mzscheme/mzscheme -mvqu "$(srcdir)/mkdirs.ss" $(ALLDIRINFO)
 	if [ ! -d $(prefix) ] ; then mkdir $(prefix) ; fi
 	$(MAKE) mzinstall
 	$(MAKE) mredinstall-stub
@@ -78,16 +93,11 @@ mrinstall:
 mrinstall3m:
 	cd mred; $(MAKE) install-3m
 
-
 lib-finish:
-	@LIBFINISH@ @prefix@/lib
+	@LIBFINISH@ "$(prefix)/lib"
 
 srcdir = @srcdir@
 prefix = @prefix@
 
 copytree:
-	cp -p -r $(srcdir)/../collects $(prefix)/.
+	mzscheme/mzscheme -mvqu "$(srcdir)/copytree.ss" "$(srcdir)" $(ALLDIRINFO) @INSTALL_ORIG_TREE@
-	cp -p -r $(srcdir)/../include $(prefix)/.
-	cp -p -r $(srcdir)/../notes $(prefix)/.
-	cp -p -r $(srcdir)/../man $(prefix)/.
-	if [ -d $(srcdir)/../teachpack ] ; then  cp -r $(srcdir)/../teachpack $(prefix)/teachpack ; fi

src/README

@@ -94,11 +94,12 @@ the Unix instructions below, but note the following:
     your shell and PATH setting).
 
     If the --prefix flag is omitted, the binaries are built for an
-    in-place installation (i.e., the plt directory containing this
+    in-place installation (i.e., the parent of the directory
-    README will be used directly). Unless --enable-shared is used, the
+    containing this README will be used directly). Unless
-    plt directory can be moved later; most system administrators
+    --enable-shared is used, the plt directory can be moved later;
-    would recommend that you use --enable-shared, but the PLT Scheme
+    most system administrators would recommend that you use
-    developers distribute binaries built without --enable-shared.
+    --enable-shared, but the PLT Scheme developers distribute binaries
+    built without --enable-shared.
 
     The `configure' script generates the makefiles for building
     MzScheme and/or MrEd. The current directory at the time
@@ -164,6 +165,15 @@ the Unix instructions below, but note the following:
     --enabled-shared, beware that you may accumlate many old, unused
     versions of the dynamic libraries in plt/lib.
 
+ 4. [Optional] Run `help-desk' to install missing documentation.
+
+    The source distribution (or Subversion-based source) includes only
+    the release notes, and not the rest of the core documentation.
+    Run the newly installed `help-desk' and follow the "Manuals" link
+    to install the rest of the documentation. For a Subversion-based
+    build, the "Manuals" page includes a link to update previously
+    installed documentation.
+
 After an "in-place" install without Subversion, the plt/src directory
 is no longer needed, and it can be safely deleted. Build information
 is recorded in plt/lib/buildinfo.

src/configure

@@ -314,7 +314,7 @@ ac_subdirs_all="$ac_subdirs_all foreign/gcc/libffi"
 ac_subdirs_all="$ac_subdirs_all llvm/llvm"
 ac_subdirs_all="$ac_subdirs_all wxcommon/jpeg"
 ac_subdirs_all="$ac_subdirs_all wxxt/src/x/wbuild"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP CXX CXXFLAGS ac_ct_CXX CXXCPP RANLIB ac_ct_RANLIB PERL X_CFLAGS X_PRE_LIBS X_LIBS X_EXTRA_LIBS PREFLAGS COMPFLAGS PROFFLAGS SED AS AR STATIC_AR ARFLAGS WBUILD CC_FOR_BUILD REZ MZLINKER PLAIN_CC DYN_CFLAGS x_includes x_libraries OPTIONS MZOPTIONS CGCOPTIONS GC2OPTIONS MROPTIONS GCDIR MZBINTARGET MZINSTALLTARGET EXTRA_GMP_OBJ OSX NOT_OSX FRAMEWORK_INSTALL_DIR FRAMEWORK_REL_INSTALL MREDLINKER LIBSFX WXLIBS WXVARIANT ICP MRLIBINSTALL LIBFINISH MAKE_MRED MAKE_MRED3M MAKE_MREDINSTALL MAKE_MREDINSTALL3M MAKE_WBUILD MAKE_COPYTREE MAKE_FINISH WXPRECOMP USE_WXPRECOMP INCLUDEDEP WX_MMD_FLAG JPEG_A JPEG_INC ZLIB_A ZLIB_INC PNG_A OSKHOME EXTRA_OSK_LIBS FOREIGN_OBJSLIB_IF_USED FOREIGN_LIB_IF_USED FOREIGN_OBJSLIB FOREIGN_CONVENIENCE FOREIGNTARGET LIBMZSCHEME_DEP LIBMRED_DEP LLVMTARGET LTO LTA subdirs LIBOBJS LTLIBOBJS'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP CXX CXXFLAGS ac_ct_CXX CXXCPP RANLIB ac_ct_RANLIB PERL X_CFLAGS X_PRE_LIBS X_LIBS X_EXTRA_LIBS PREFLAGS COMPFLAGS PROFFLAGS SED AS AR STATIC_AR ARFLAGS WBUILD CC_FOR_BUILD REZ MZLINKER PLAIN_CC DYN_CFLAGS x_includes x_libraries OPTIONS MZOPTIONS CGCOPTIONS GC2OPTIONS MROPTIONS GCDIR MZBINTARGET MZINSTALLTARGET EXTRA_GMP_OBJ OSX NOT_OSX FRAMEWORK_INSTALL_DIR FRAMEWORK_REL_INSTALL INSTALL_ORIG_TREE MREDLINKER LIBSFX WXLIBS WXVARIANT ICP MRLIBINSTALL LIBFINISH MAKE_MRED MAKE_MRED3M MAKE_MREDINSTALL MAKE_MREDINSTALL3M MAKE_WBUILD MAKE_COPYTREE MAKE_FINISH WXPRECOMP USE_WXPRECOMP INCLUDEDEP WX_MMD_FLAG JPEG_A JPEG_INC ZLIB_A ZLIB_INC PNG_A OSKHOME EXTRA_OSK_LIBS FOREIGN_OBJSLIB_IF_USED FOREIGN_LIB_IF_USED FOREIGN_OBJSLIB FOREIGN_CONVENIENCE FOREIGNTARGET LIBMZSCHEME_DEP LIBMRED_DEP LLVMTARGET LTO LTA collectsdir libpltdir includepltdir docdir COLLECTS_PATH subdirs LIBOBJS LTLIBOBJS'
 ac_subst_files=''
 
 # Initialize some variables set by options.
@@ -819,34 +819,26 @@ _ACEOF
 
   cat <<_ACEOF
 Installation directories:
-  --prefix=TARGETDIR      install to TARGETDIR (usually ..../plt)
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+			  [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+			  [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+Fine tuning of the installation directories:
+  --bindir=DIR           user executables [EPREFIX/bin]
+  --datadir=DIR          read-only architecture-independent data [PREFIX/share]
+  --libdir=DIR           object code libraries [EPREFIX/lib]
+  --includedir=DIR       C header files [PREFIX/include]
+  --mandir=DIR           man documentation [PREFIX/man]
 _ACEOF
 
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
   cat <<\_ACEOF
 
 X features:
@@ -871,6 +863,7 @@ Optional Features:
   --enable-libjpeg        use libjpeg instead of building (enabled by default)
   --enable-shared         create shared libraries
   --enable-dynlib         same as --enable-shared
+  --enable-origtree       install with original directory structure
   --enable-foreign        compile foreign support (enabled by default)
   --enable-llvm           compile llvm support (disabled by default)
   --enable-sgc            use Senora GC instead of the Boehm GC
@@ -1399,6 +1392,11 @@ fi;
 if test "${enable_dynlib+set}" = set; then
   enableval="$enable_dynlib"
 
+fi;
+# Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+  enableval="$enable_shared"
+
 fi;
 
 # Check whether --enable-foreign or --disable-foreign was given.
@@ -5043,6 +5041,7 @@ if test "${enable_xonx}" = "yes" ; then
 else
   if test "$OS" = "Darwin" ; then
     enable_quartz=yes
+    enable_origtree=yes
   fi
 fi
 
@@ -5056,31 +5055,66 @@ if test "${enable_perl}" = "" ; then
   fi
 fi
 
-if test "${prefix}" = "NONE" ; then
-  prefix=`cd "${srcdir}/.." && pwd`
-else
-  # Check whether ${prefix} is redundant, because
-  # $prefix/src is $srcdir.
-  here_inode=`(ls -i -l -d ${srcdir}/. | cut -d d -f 1) 2> /dev/null`
-  there_inode=`(ls -i -l -d ${prefix}/src | cut -d d -f 1) 2> /dev/null`
-  if test "${here_inode}" = "${there_inode}" ; then
-    echo "in-place install, --prefix  specification is redundant"
-  else
-    echo "----> Installation will go to ${prefix}:"
-    echo "---->   ${prefix}/collects/..."
-    echo "---->   ${prefix}/bin/..."
-    echo "---->   ${prefix}/lib/..."
-    echo "---->   ${prefix}/include/..."
-    echo "---->   ${prefix}/man/..."
-    echo "---->   ${prefix}/notes/..."
-    MAKE_COPYTREE=copytree
-  fi
-fi
-
 if test "${enable_iconv}" = "" ; then
   enable_iconv=yes
 fi
 
+############## Install targets ################
+
+unixstyle=no
+if test "${prefix}" != "NONE" ; then
+  if test "${enable_origtree}" != "yes" ; then
+    unixstyle=yes
+  fi
+fi
+if test "${exec_prefix}" != "NONE" ; then
+ unixstyle=yes
+fi
+if test "${bindir}" != '${exec_prefix}/bin' ; then
+ unixstyle=yes
+fi
+if test "${datadir}" != '${prefix}/share' ; then
+ unixstyle=yes
+fi
+if test "${libdir}" != '${exec_prefix}/lib' ; then
+ unixstyle=yes
+fi
+if test "${includedir}" != '${prefix}/include' ; then
+ unixstyle=yes
+fi
+if test "${mandir}" != '${prefix}/man' ; then
+ unixstyle=yes
+fi
+
+if test "${unixstyle}" = "no" ; then
+  if test "${prefix}" = "NONE" ; then
+    inplacebuild=yes
+    prefix=`cd "${srcdir}/.." && pwd`
+  else
+    MAKE_COPYTREE=copytree
+  fi
+  bindir='${prefix}/bin'
+  libpltdir='${prefix}/lib'
+  collectsdir='${prefix}/collects'
+  includepltdir='${prefix}/include'
+  docdir='${prefix}/doc'
+  mandir='${prefix}/man'
+  COLLECTS_PATH="../collects"
+  INSTALL_ORIG_TREE=yes
+else
+  if test "${prefix}" = "NONE" ; then
+    # Set prefix explicitly so we can use it during configure
+    prefix="${ac_default_prefix}"
+  fi
+  libpltdir="${libdir}/plt"
+  collectsdir="${libdir}/plt/collects"
+  includepltdir="${includedir}/plt"
+  docdir="${datadir}/plt/doc"
+  MAKE_COPYTREE=copytree
+  COLLECTS_PATH='${collectsdir}'
+  INSTALL_ORIG_TREE=no
+fi
+
 ###### Make sure MrEd is really there ######
 
 if test "${enable_mred}" = "yes" ; then
@@ -8561,12 +8595,6 @@ case $OS in
     X_LIBS="-L/usr/contrib/X11R6/lib/ $X_LIBS"
     ;;
   CYGWIN*)
-    # Old cygwin approach, to make it Windows-like instead of Unix-like:
-    #  MZBINTARGET=cygwin-bin
-    #  MZINSTALLTARGET=cygwin-install
-    #  EXTRALIBS="$LIBS gmzwin.exp"
-    #  MZOPTIONS="$MZOPTIONS -DGC_DLL"
-    #  CGCOPTIONS="$CGCOPTIONS -DGC_DLL -DGC_BUILD -DUSE_MSVC_MD_LIBRARY -DMD_LIB_MAIN"
     MZINSTALLTARGET=unix-cygwin-install
     if test "${enable_shared}" = "yes" ; then
       ar_libtool_no_undefined=" -no-undefined"
@@ -8634,7 +8662,7 @@ case $OS in
         FRAMEWORK_INSTALL_DIR=~/Library/Frameworks
         FRAMEWORK_REL_INSTALL=no
       else
-        FRAMEWORK_INSTALL_DIR='${LIBIDIR}'
+        FRAMEWORK_INSTALL_DIR='${libdir}'
         FRAMEWORK_REL_INSTALL=yes
       fi
     else
@@ -11794,6 +11822,13 @@ LIBS="$LIBS $EXTRALIBS"
 
 
 
+
+
+
+
+
+
+
 
 
 
@@ -12636,6 +12671,7 @@ s,@OSX@,$OSX,;t t
 s,@NOT_OSX@,$NOT_OSX,;t t
 s,@FRAMEWORK_INSTALL_DIR@,$FRAMEWORK_INSTALL_DIR,;t t
 s,@FRAMEWORK_REL_INSTALL@,$FRAMEWORK_REL_INSTALL,;t t
+s,@INSTALL_ORIG_TREE@,$INSTALL_ORIG_TREE,;t t
 s,@MREDLINKER@,$MREDLINKER,;t t
 s,@LIBSFX@,$LIBSFX,;t t
 s,@WXLIBS@,$WXLIBS,;t t
@@ -12671,6 +12707,11 @@ s,@LIBMRED_DEP@,$LIBMRED_DEP,;t t
 s,@LLVMTARGET@,$LLVMTARGET,;t t
 s,@LTO@,$LTO,;t t
 s,@LTA@,$LTA,;t t
+s,@collectsdir@,$collectsdir,;t t
+s,@libpltdir@,$libpltdir,;t t
+s,@includepltdir@,$includepltdir,;t t
+s,@docdir@,$docdir,;t t
+s,@COLLECTS_PATH@,$COLLECTS_PATH,;t t
 s,@subdirs@,$subdirs,;t t
 s,@LIBOBJS@,$LIBOBJS,;t t
 s,@LTLIBOBJS@,$LTLIBOBJS,;t t
@@ -13337,3 +13378,20 @@ echo "$as_me: error: $ac_sub_configure failed for $ac_dir" >&2;}
   done
 fi
 
+
+if test "${inplacebuild}" = "yes" ; then
+  echo ">>> Installation is in-place"
+else
+  echo ">>> Installation targets:"
+  echo " executables  : ${bindir}/..."
+  echo " Scheme code  : ${collectsdir}/..."
+  echo " core docs    : ${docdir}/..."
+  echo " C libraries  : ${libdir}/..."
+  echo " C headers    : ${includepltdir}/..."
+  echo " extra C objs : ${libpltdir}/..."
+  echo " man pages    : ${mandir}/..."
+  echo "  where prefix = ${prefix}"
+  if test "${unixstyle}" = "yes" ; then
+    echo "    and exec_prefix = ${exec_prefix}"
+  fi
+fi

src/copytree.ss

@@ -0,0 +1,54 @@
+
+(module copytree mzscheme
+  
+  (define-values (srcdir bindir collectsdir docdir libdir includepltdir libpltdir mandir origtree)
+    (apply
+     values
+     (vector->list (current-command-line-arguments))))
+
+  (define pltdir (build-path srcdir 'up))
+
+  (define (skip-name? n)
+    (let ([s (path->bytes n)])
+      (or (regexp-match #rx#"^[.]svn$" s)
+	  (regexp-match #rx#"^compiled$" s))))
+
+  (define (copytree src dest)
+    (for-each (lambda (n)
+		(unless (skip-name? n)
+		  (let ([p (build-path src n)])
+		    (cond
+		     [(file-exists? p) 
+		      (let ([q (build-path dest n)])
+			(when (file-exists? q)
+			  (delete-file q))
+			(copy-file p q)
+			(let ([t (file-or-directory-modify-seconds p)])
+			  (file-or-directory-modify-seconds q t)))]
+		     [(directory-exists? p)
+		      (let ([q (build-path dest n)])
+			(unless (directory-exists? q)
+			  (make-directory q))
+			(copytree p q))]))))
+	      (directory-list src)))
+
+  (define (copytree* src dest)
+    (printf "Copying ~a\n   to ~a\n" src dest)
+    (copytree src dest))
+		
+  (copytree* (build-path pltdir "collects") collectsdir)
+  (copytree* (build-path pltdir "doc") docdir)
+  (copytree* (build-path pltdir "man") mandir)
+
+  (unless (equal? origtree "yes")
+    ;; Replace "config.ss"
+    (with-output-to-file (build-path collectsdir "config" "config.ss")
+      (lambda ()
+	(printf "(module config (lib \"configtab.ss\" \"setup\")\n")
+	(printf "  (define doc-dir ~s)\n" docdir)
+	(printf "  (define lib-dir ~s)\n" libpltdir)
+	(printf "  (define include-dir ~s)\n" includepltdir)
+	(printf "  (define bin-dir ~s))\n" bindir))
+      'truncate/replace))
+
+  )

src/mkdirs.ss

@@ -0,0 +1,14 @@
+
+(module mkdirs mzscheme
+  
+  (define dirs (vector->list (current-command-line-arguments)))
+
+  (define (make-directory* dir)
+    (unless (directory-exists? dir)
+      (let-values ([(base name dir?) (split-path dir)])
+	(when (path? base)
+	  (make-directory* base))
+	(printf "Making ~a\n" dir)
+	(make-directory dir))))
+
+  (for-each make-directory* dirs))

src/mred/Makefile.in

@@ -1,6 +1,11 @@
 
 srcdir = @srcdir@
 prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+libdir = @libdir@
+libpltdir = @libpltdir@
+collectsdir = @collectsdir@
 builddir = @builddir@
 
 # for version.mak:
@@ -231,17 +236,16 @@ install-no-lib:
 	echo "no dynamic libs"
 
 install-lib:
-	cd ..; $(ICP) mred/libmred.@LIBSFX@ `(cd $(prefix); pwd)`/lib/
+	cd ..; $(ICP) mred/libmred.@LIBSFX@ "$(libdir)"
 
 install_wx_xt:
-	cd ..; if [ ! -d $(prefix)/bin ] ; then mkdir $(prefix)/bin ; fi
+	cd ..; if [ ! -d "$(bindir)" ] ; then mkdir "$(bindir)" ; fi
-	cd ..; rm -f $(prefix)/bin/mred
+	cd ..; rm -f "$(bindir)/mred"
 	$(MAKE) @MRLIBINSTALL@
-	cd ..; $(ICP) mred/mred `(cd $(prefix); pwd)`/bin/
+	cd ..; $(ICP) mred/mred "$(bindir)"
-	$(MZSCHEME) -mvqu "$(srcdir)/../mzscheme/collects-path.ss" "$(prefix)/bin/mred" ../collects
+	$(MZSCHEME) -mvqu "$(srcdir)/../mzscheme/collects-path.ss" "$(prefix)/bin/mred" @COLLECTS_PATH@
 
-LIBIDIR=$(prefix)/lib
+BUILDINFO=$(libpltdir)/buildinfo
-BUILDINFO=$(LIBIDIR)/buildinfo
 
 MRFWDIR = @FRAMEWORK_INSTALL_DIR@/PLT_MrEd.framework
 
@@ -255,16 +259,16 @@ install_wx_mac:
 	if [ ! -d $(MRFWDIR) ] ; then mkdir $(MRFWDIR) ; fi
 	if [ ! -d $(MRFWDIR)/Versions ] ; then mkdir $(MRFWDIR)/Versions ; fi
 	if [ ! -d $(MRFWDIR)/Versions/$(FWVERSION) ] ; then mkdir $(MRFWDIR)/Versions/$(FWVERSION) ; fi
-	cd ..; rm -rf $(prefix)/collects/launcher/Starter.app
+	cd ..; rm -rf $(collectsdir)/launcher/Starter.app
 	cd ..; rm -rf $(prefix)/MrEd.app
 	cd ..; $(ICP) -r mred/MrEd.app $(prefix)/.
 	$(ICP) PLT_MrEd.framework/Versions/$(FWVERSION)/PLT_MrEd $(MRFWDIR)/Versions/$(FWVERSION)/PLT_MrEd
 	$(ICP) -r PLT_MrEd.framework/Versions/$(FWVERSION)/Resources $(MRFWDIR)/Versions/$(FWVERSION)/Resources
 	ln -s Versions/$(FWVERSION)/PLT_MrEd $(MRFWDIR)/
 	ln -s Versions/$(FWVERSION)/Resources $(MRFWDIR)/
-	if [ ! -d $(prefix)/collects ] ; then mkdir $(prefix)/collects ; fi
+	if [ ! -d $(collectsdir) ] ; then mkdir $(collectsdir) ; fi
-	if [ ! -d $(prefix)/collects/launcher ] ; then mkdir $(prefix)/collects/launcher ; fi
+	if [ ! -d $(collectsdir)/launcher ] ; then mkdir $(collectsdir)/launcher ; fi
-	cd ..; $(ICP) -r mred/Starter.app $(prefix)/collects/launcher/.
+	cd ..; $(ICP) -r mred/Starter.app $(collectsdir)/launcher/.
 	if [ @FRAMEWORK_REL_INSTALL@ = yes ] ; then /usr/bin/install_name_tool -change "@executable_path/../../../PLT_MrEd.framework/Versions/$(FWVERSION)/PLT_MrEd" "@executable_path/../../../lib/PLT_MrEd.framework/Versions/$(FWVERSION)/PLT_MrEd" "$(prefix)/MrEd.app/Contents/MacOS/MrEd" ; fi
 	$(MZSCHEME) -mvqu "$(srcdir)/../mzscheme/collects-path.ss" "$(prefix)/MrEd.app/Contents/MacOS/MrEd" ../../../collects
 
@@ -286,25 +290,25 @@ install-no-lib3m:
 	echo "no dynamic libs"
 
 install-lib3m:
-	cd ..; $(ICP) mred/libmred3m.@LIBSFX@ `(cd $(prefix); pwd)`/lib/
+	cd ..; $(ICP) mred/libmred3m.@LIBSFX@ "$(libdir)"
 
 install-3m_wx_xt:
-	cd ..; $(ICP) mred/mred3m $(prefix)/bin/
+	cd ..; $(ICP) mred/mred3m "$(bindir)"
-	$(MZSCHEME) -mvqu "$(srcdir)/../mzscheme/collects-path.ss" "$(prefix)/bin/mred3m" ../collects
+	$(MZSCHEME) -mvqu "$(srcdir)/../mzscheme/collects-path.ss" "$(bindir)/mred3m" @COLLECTS_PATH@
 	$(MAKE) @MRLIBINSTALL@3m
 
 install-3m_wx_mac:
 	rm -f $(MRFWDIR)/Versions/$(FWVERSION)_3m/PLT_MrEd
 	rm -rf $(MRFWDIR)/Versions/$(FWVERSION)_3m/Resources
 	if [ ! -d $(MRFWDIR)/Versions/$(FWVERSION)_3m ] ; then mkdir $(MRFWDIR)/Versions/$(FWVERSION)_3m ; fi
-	cd ..; rm -rf $(prefix)/collects/launcher/Starter3m.app
+	cd ..; rm -rf $(collectsdir)/launcher/Starter3m.app
 	cd ..; rm -rf $(prefix)/MrEd3m.app
 	cd ..; $(ICP) -r mred/MrEd3m.app $(prefix)/.
 	$(ICP) PLT_MrEd.framework/Versions/$(FWVERSION)_3m/PLT_MrEd $(MRFWDIR)/Versions/$(FWVERSION)_3m/PLT_MrEd
 	$(ICP) -r PLT_MrEd.framework/Versions/$(FWVERSION)_3m/Resources $(MRFWDIR)/Versions/$(FWVERSION)_3m/Resources
-	if [ ! -d $(prefix)/collects ] ; then mkdir $(prefix)/collects ; fi
+	if [ ! -d $(collectsdir) ] ; then mkdir $(collectsdir) ; fi
-	if [ ! -d $(prefix)/collects/launcher ] ; then mkdir $(prefix)/collects/launcher ; fi
+	if [ ! -d $(collectsdir)/launcher ] ; then mkdir $(collectsdir)/launcher ; fi
-	cd ..; $(ICP) -r mred/Starter3m.app $(prefix)/collects/launcher/.
+	cd ..; $(ICP) -r mred/Starter3m.app $(collectsdir)/launcher/.
 	if [ @FRAMEWORK_REL_INSTALL@ = yes ] ; then /usr/bin/install_name_tool -change "@executable_path/../../../PLT_MrEd.framework/Versions/$(FWVERSION)_3m/PLT_MrEd" "@executable_path/../../../lib/PLT_MrEd.framework/Versions/$(FWVERSION)_3m/PLT_MrEd" "$(prefix)/MrEd3m.app/Contents/MacOS/MrEd3m" ; fi
 	$(MZSCHEME) -mvqu "$(srcdir)/../mzscheme/collects-path.ss" "$(prefix)/MrEd3m.app/Contents/MacOS/MrEd3m" ../../../collects
 

src/mzscheme/Makefile.in

@@ -4,6 +4,12 @@
 
 srcdir = @srcdir@
 prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+libdir = @libdir@
+includepltdir = @includepltdir@
+libpltdir = @libpltdir@
+collectsdir = @collectsdir@
 builddir = @builddir@
 
 # for version.mak:
@@ -200,7 +206,7 @@ mark:
 	$(MAKE) $(srcdir)/src/mzmark.c
 
 headers:
-	./mzscheme -qr $(srcdir)/mkincludes.ss $(srcdir)/../.. . $(srcdir)
+	./mzscheme -qr $(srcdir)/mkincludes.ss "$(includepltdir)" . "$(srcdir)"
 	$(MAKE) $(srcdir)/../../collects/mzscheme/lib/mzdyn.c
 
 # mzdyn.c, used for MacOS "library"
@@ -228,7 +234,7 @@ zo:
 3m:
 	$(MAKE) bin
 	cd gc2; $(MAKE) all
-	cd dynsrc; $(MAKE) LIBDIR='$(LIBDIR)' dynlib3m
+	cd dynsrc; $(MAKE) dynlib3m
 	cd gc2; $(MAKE) ../mzscheme3m
 
 palmos:
@@ -254,9 +260,7 @@ clean@OSX@:
 	rm -rf PLT_MzScheme.framework
 	$(MAKE) clean@NOT_OSX@
 
-LIBIDIR=`(cd $(prefix); pwd)`/lib
+BUILDINFO="$(libpltdir)/buildinfo"
-BINDIR=`(cd $(prefix); pwd)`/bin
-BUILDINFO=$(LIBIDIR)/buildinfo
 ICP=@ICP@
 
 install:
@@ -264,25 +268,23 @@ install:
 	$(MAKE) @MZINSTALLTARGET@
 
 install-3m-basic:
-	cd ..; $(ICP) mzscheme/mzscheme3m $(prefix)/bin/mzscheme3m
+	cd ..; $(ICP) mzscheme/mzscheme3m $(bindir)/mzscheme3m
-	cd ..; $(ICP) mzscheme/mzdyn3m.o $(prefix)/lib/mzdyn3m.o
+	cd ..; $(ICP) mzscheme/mzdyn3m.o $(libpltdir)/mzdyn3m.o
-	./mzscheme -mvqu "$(srcdir)/collects-path.ss" "$(prefix)/bin/mzscheme3m" ../collects
+	./mzscheme -mvqu "$(srcdir)/collects-path.ss" "$(bindir)/mzscheme3m" @COLLECTS_PATH@
 
 install-3m@NOT_OSX@:
 	$(MAKE) install-3m-basic
-	cd ..; $(ICP) mzscheme/libmzscheme3m.@LIBSFX@ $(LIBIDIR)/libmzscheme3m.@LIBSFX@
+	cd ..; $(ICP) mzscheme/libmzscheme3m.@LIBSFX@ "$(libdir)/libmzscheme3m.@LIBSFX@"
 
 # Prefix might be relative to srcdir, or it might be absolute, so we
 # have to go up and install things from there.
 
 unix-install:
-	cd ..; if [ ! -d $(prefix)/bin ] ; then mkdir $(prefix)/bin ; fi
+	cd ..; rm -f $(bindir)/mzscheme
-	cd ..; rm -f $(prefix)/bin/mzscheme
+	cd ..; $(ICP) mzscheme/libmzgc.@LIBSFX@ "$(libdir)/libmzgc.@LIBSFX@"
-	cd ..; if [ ! -d $(LIBIDIR) ] ; then mkdir $(LIBIDIR) ; fi
+	cd ..; $(ICP) mzscheme/libmzscheme.@LIBSFX@ "$(libdir)/libmzscheme.@LIBSFX@"
-	cd ..; $(ICP) mzscheme/libmzgc.@LIBSFX@ $(LIBIDIR)/libmzgc.@LIBSFX@
+	cd ..; $(ICP) mzscheme/mzscheme "$(bindir)/mzscheme"
-	cd ..; $(ICP) mzscheme/libmzscheme.@LIBSFX@ $(LIBIDIR)/libmzscheme.@LIBSFX@
+	./mzscheme -mvqu "$(srcdir)/collects-path.ss" "$(bindir)/mzscheme" @COLLECTS_PATH@
-	cd ..; $(ICP) mzscheme/mzscheme "$(BINDIR)/mzscheme"
-	./mzscheme -mvqu "$(srcdir)/collects-path.ss" "$(BINDIR)/mzscheme" ../collects
 	cd ..; echo 'CC=@CC@' > $(BUILDINFO)
 	cd ..; echo 'CFLAGS=@CFLAGS@ @PREFLAGS@ @COMPFLAGS@' >> $(BUILDINFO)
 	cd ..; echo 'OPTIONS=@OPTIONS@' >> $(BUILDINFO)
@@ -292,7 +294,7 @@ unix-install:
 
 normal-install:
 	$(MAKE) unix-install
-	cd ..; cp mzscheme/mzdyn.o $(LIBIDIR)/mzdyn.o	
+	cd ..; cp mzscheme/mzdyn.o $(libpltdir)/mzdyn.o	
 
 MZFWDIR = @FRAMEWORK_INSTALL_DIR@/PLT_MzScheme.framework
 
@@ -307,7 +309,7 @@ osx-install:
 	if [ ! -d $(MZFWDIR)/Versions/$(FWVERSION) ] ; then mkdir $(MZFWDIR)/Versions/$(FWVERSION) ; fi
 	cp $(MZFW) $(MZFWDIR)/Versions/$(FWVERSION)/
 	ln -s Versions/$(FWVERSION)/PLT_MzScheme $(MZFWDIR)/
-	if [ @FRAMEWORK_REL_INSTALL@ = yes ] ; then /usr/bin/install_name_tool -change "@executable_path/PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme" "@executable_path/../lib/PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme" "$(BINDIR)/mzscheme" ; fi
+	if [ @FRAMEWORK_REL_INSTALL@ = yes ] ; then /usr/bin/install_name_tool -change "@executable_path/PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme" "@executable_path/../lib/PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme" "$(bindir)/mzscheme" ; fi
 
 MZFWMMM = PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme
 
@@ -316,23 +318,7 @@ install-3m@OSX@:
 	rm -f $(MZFWDIR)/Versions/$(FWVERSION)_3m/PLT_MzScheme
 	if [ ! -d $(MZFWDIR)/Versions/$(FWVERSION)_3m ] ; then mkdir $(MZFWDIR)/Versions/$(FWVERSION)_3m ; fi
 	cp $(MZFWMMM) $(MZFWDIR)/Versions/$(FWVERSION)_3m/
-	if [ @FRAMEWORK_REL_INSTALL@ = yes ] ; then /usr/bin/install_name_tool -change "@executable_path/PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "@executable_path/../lib/PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "$(BINDIR)/mzscheme3m" ; fi
+	if [ @FRAMEWORK_REL_INSTALL@ = yes ] ; then /usr/bin/install_name_tool -change "@executable_path/PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "@executable_path/../lib/PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "$(bindir)/mzscheme3m" ; fi
-
-WLIBIDIR=`(cd $(prefix); pwd)`/lib
-WBUILDINFO=$(WLIBIDIR)/buildinfo
-
-# OBSOLTE:
-cygwin-install:
-	cd ..; rm -f $(prefix)/mzscheme.exe
-	cd ..; cp mzscheme/mzscheme.exe $(prefix)/mzscheme.exe
-	cd ..; cp mzscheme/libmzschxxxxxxx.dll $(prefix)/libmzschxxxxxxx.dll
-	cd ..; cp mzscheme/libmzgcxxxxxxx.dll $(prefix)/libmzgcxxxxxxx.dll
-	cd dynsrc; $(MAKE) cygwin-install
-	cd ..; $(ICP) mzscheme/mzstart.exe `(cd $(prefix); pwd)`/collects/launcher/mzstart.exe
-	cd ..; if [ ! -d $(WLIBIDIR) ] ; then mkdir $(WLIBIDIR) ; fi
-	cd ..; echo 'CC=gcc' > $(WBUILDINFO)
-	cd ..; echo 'CFLAGS=@CFLAGS@ @OPTIONS@' >> $(WBUILDINFO)
-	cd ..; echo 'LIBS=@LIBS@' >> $(WBUILDINFO)
 
 unix-cygwin-install:
 	$(MAKE) unix-install

src/mzscheme/configure.ac

@@ -35,6 +35,7 @@ AC_ARG_ENABLE(libjpeg, [  --enable-libjpeg        use libjpeg instead of buildin
 
 AC_ARG_ENABLE(shared, [  --enable-shared         create shared libraries])
 AC_ARG_ENABLE(dynlib, [  --enable-dynlib         same as --enable-shared])
+AC_ARG_ENABLE(shared, [  --enable-origtree       install with original directory structure])
 
 AC_ARG_ENABLE(foreign, [  --enable-foreign        compile foreign support (enabled by default)], , enable_foreign=yes)
 AC_ARG_ENABLE(llvm,    [  --enable-llvm           compile llvm support (disabled by default)], , enable_llvm=no)
@@ -108,6 +109,7 @@ if test "${enable_xonx}" = "yes" ; then
 else
   if test "$OS" = "Darwin" ; then
     enable_quartz=yes
+    enable_origtree=yes
   fi
 fi
 
@@ -121,31 +123,66 @@ if test "${enable_perl}" = "" ; then
   fi
 fi
 
-if test "${prefix}" = "NONE" ; then
-  prefix=`cd "${srcdir}/.." && pwd`
-else
-  # Check whether ${prefix} is redundant, because
-  # $prefix/src is $srcdir.
-  here_inode=`(ls -i -l -d ${srcdir}/. | cut -d d -f 1) 2> /dev/null`
-  there_inode=`(ls -i -l -d ${prefix}/src | cut -d d -f 1) 2> /dev/null`
-  if test "${here_inode}" = "${there_inode}" ; then
-    echo "in-place install, --prefix  specification is redundant"
-  else 
-    echo "----> Installation will go to ${prefix}:"
-    echo "---->   ${prefix}/collects/..."
-    echo "---->   ${prefix}/bin/..."
-    echo "---->   ${prefix}/lib/..."
-    echo "---->   ${prefix}/include/..."
-    echo "---->   ${prefix}/man/..."
-    echo "---->   ${prefix}/notes/..."
-    MAKE_COPYTREE=copytree
-  fi
-fi
-
 if test "${enable_iconv}" = "" ; then
   enable_iconv=yes
 fi
 
+############## Install targets ################
+
+unixstyle=no
+if test "${prefix}" != "NONE" ; then
+  if test "${enable_origtree}" != "yes" ; then
+    unixstyle=yes
+  fi
+fi
+if test "${exec_prefix}" != "NONE" ; then
+ unixstyle=yes
+fi
+if test "${bindir}" != '${exec_prefix}/bin' ; then
+ unixstyle=yes
+fi
+if test "${datadir}" != '${prefix}/share' ; then
+ unixstyle=yes
+fi
+if test "${libdir}" != '${exec_prefix}/lib' ; then
+ unixstyle=yes
+fi
+if test "${includedir}" != '${prefix}/include' ; then
+ unixstyle=yes
+fi
+if test "${mandir}" != '${prefix}/man' ; then
+ unixstyle=yes
+fi
+
+if test "${unixstyle}" = "no" ; then
+  if test "${prefix}" = "NONE" ; then
+    inplacebuild=yes
+    prefix=`cd "${srcdir}/.." && pwd`
+  else
+    MAKE_COPYTREE=copytree
+  fi
+  bindir='${prefix}/bin'
+  libpltdir='${prefix}/lib'
+  collectsdir='${prefix}/collects'
+  includepltdir='${prefix}/include'
+  docdir='${prefix}/doc'
+  mandir='${prefix}/man'
+  COLLECTS_PATH="../collects"
+  INSTALL_ORIG_TREE=yes
+else
+  if test "${prefix}" = "NONE" ; then
+    # Set prefix explicitly so we can use it during configure
+    prefix="${ac_default_prefix}"
+  fi
+  libpltdir="${libdir}/plt"
+  collectsdir="${libdir}/plt/collects"
+  includepltdir="${includedir}/plt"
+  docdir="${datadir}/plt/doc"
+  MAKE_COPYTREE=copytree
+  COLLECTS_PATH='${collectsdir}'
+  INSTALL_ORIG_TREE=no
+fi
+
 ###### Make sure MrEd is really there ######
 
 if test "${enable_mred}" = "yes" ; then
@@ -428,12 +465,6 @@ case $OS in
     X_LIBS="-L/usr/contrib/X11R6/lib/ $X_LIBS"
     ;;
   CYGWIN*)
-    # Old cygwin approach, to make it Windows-like instead of Unix-like:
-    #  MZBINTARGET=cygwin-bin
-    #  MZINSTALLTARGET=cygwin-install
-    #  EXTRALIBS="$LIBS gmzwin.exp"
-    #  MZOPTIONS="$MZOPTIONS -DGC_DLL"
-    #  CGCOPTIONS="$CGCOPTIONS -DGC_DLL -DGC_BUILD -DUSE_MSVC_MD_LIBRARY -DMD_LIB_MAIN"
     MZINSTALLTARGET=unix-cygwin-install
     if test "${enable_shared}" = "yes" ; then
       ar_libtool_no_undefined=" -no-undefined"
@@ -501,7 +532,7 @@ case $OS in
         FRAMEWORK_INSTALL_DIR=~/Library/Frameworks
         FRAMEWORK_REL_INSTALL=no
       else
-        FRAMEWORK_INSTALL_DIR='${LIBIDIR}'
+        FRAMEWORK_INSTALL_DIR='${libdir}'
         FRAMEWORK_REL_INSTALL=yes
       fi
     else
@@ -1092,6 +1123,7 @@ AC_SUBST(OSX)
 AC_SUBST(NOT_OSX)
 AC_SUBST(FRAMEWORK_INSTALL_DIR)
 AC_SUBST(FRAMEWORK_REL_INSTALL)
+AC_SUBST(INSTALL_ORIG_TREE)
 
 AC_SUBST(MREDLINKER)
 AC_SUBST(LIBSFX)
@@ -1137,6 +1169,12 @@ AC_SUBST(LLVMTARGET)
 AC_SUBST(LTO)
 AC_SUBST(LTA)
 
+AC_SUBST(collectsdir)
+AC_SUBST(libpltdir)
+AC_SUBST(includepltdir)
+AC_SUBST(docdir)
+AC_SUBST(COLLECTS_PATH)
+
 mk_needed_dir()
 {
   if test ! -d "$1" ; then
@@ -1228,3 +1266,20 @@ if test "${enable_wbuild}" = "yes" ; then
 fi
 
 AC_OUTPUT($makefiles)
+
+if test "${inplacebuild}" = "yes" ; then
+  echo ">>> Installation is in-place"
+else
+  echo ">>> Installation targets:"
+  echo " executables  : ${bindir}/..."
+  echo " Scheme code  : ${collectsdir}/..."
+  echo " core docs    : ${docdir}/..."
+  echo " C libraries  : ${libdir}/..."
+  echo " C headers    : ${includepltdir}/..."
+  echo " extra C objs : ${libpltdir}/..."
+  echo " man pages    : ${mandir}/..."
+  echo "  where prefix = ${prefix}"
+  if test "${unixstyle}" = "yes" ; then
+    echo "    and exec_prefix = ${exec_prefix}"
+  fi
+fi