existing version of build scripts

collects/meta/build/bundle

@@ -0,0 +1,562 @@
+#!/bin/env mzscheme
+;; -*- scheme -*-
+
+#lang scheme/base
+
+(require scheme/cmdline scheme/runtime-path scheme/match scheme/promise
+         meta/checker (prefix-in dist: meta/dist-specs) meta/specs
+         (for-syntax scheme/base) ; for runtime-path
+         (except-in scheme/mpair mappend)
+         (only-in (lib "process.ss") system))
+
+(define (/-ify x)
+  (regexp-replace #rx"/?$" (if (path? x) (path->string x) x) "/"))
+(define home/     (/-ify (expand-user-path "~scheme")))
+(define binaries/ (/-ify (build-path home/ "binaries")))
+(define target/   (/-ify (build-path home/ "pre-installers")))
+(define plt/      (/-ify (or (getenv "PLTHOME")
+                             (error 'bundle "PLTHOME is not defined"))))
+(define plt-base/ (/-ify (simplify-path (build-path plt/ 'up) #f)))
+(define plt/-name (let-values ([(base name dir?) (split-path plt/)])
+                    (path-element->string name)))
+
+(define cd current-directory)
+
+(define *readme-file*
+  (build-path plt/ "readme.txt"))
+(define *info-domain-file*
+  (build-path plt/ "collects" "info-domain" "compiled" "cache.rktd"))
+
+(define *info-domain-cache* #f)
+
+(define-runtime-path *spec-file* "distribution-specs")
+(define-runtime-path *readme-specs-file* "readme-specs")
+
+(define *verify?*  #t)
+(define *btgz?*    #t)
+(define *pack?*    #t)
+(define *root?*    #t)
+(define *release?* #f)
+(define *verbose?* 'yes) ; #t, #f, or else -- show stderr stuff but not stdout
+
+;;; ===========================================================================
+;;; Utilities etc
+
+(define concat string-append)
+
+(define (sort* l)
+  (sort l string<?))
+
+(define (dir-list . args)
+  (sort* (map path->string (apply directory-list args))))
+
+(define (dprintf fmt . args)
+  (when *verbose?*
+    (apply fprintf (current-error-port) fmt args)
+    (flush-output (current-error-port))))
+
+;;; ===========================================================================
+;;; Tree utilities
+
+;; path -> tree
+;; Same as get-tree, but lists the contents of a tgz file via pax.
+(define (get-tgz-tree tgz)
+  (define base (regexp-replace #rx"/$" (path->string (cd)) ""))
+  (define tgz-name
+    (regexp-replace #rx"^.*/" (if (path? tgz) (path->string tgz) tgz) ""))
+  (define (tree+rest paths curdir)
+    (define cur-rx (regexp (concat "^" (regexp-quote curdir))))
+    (define m
+      (let ([m (and (pair? paths)
+                    (regexp-match-positions cur-rx (car paths)))])
+        (and m (regexp-match-positions #rx"/.*/" (car paths) (cdar m)))))
+    (if m
+      ;; we have too many "/"s => need to reconstruct a fake intermediate dir
+      (tree+rest (cons (substring (car paths) 0 (add1 (caar m))) paths) curdir)
+      (let loop ([paths paths] [contents '()])
+        (when (pair? paths)
+          (prop-set! (car paths) 'tgz  tgz-name)
+          (prop-set! (car paths) 'base base)
+          (prop-set!
+           (car paths) 'name
+           (cond [(regexp-match #rx"^(?:.*/)?([^/]+)/?$" (car paths)) => cadr]
+                 [else (error 'get-tgz-tree
+                              "bad path name: ~s" (car paths))])))
+        (if (and (pair? paths) (regexp-match? cur-rx (car paths)))
+          ;; still in the same subtree
+          (if (regexp-match? #rx"/$" (car paths))
+            ;; new directory
+            (let-values ([(tree rest) (tree+rest (cdr paths) (car paths))])
+              (loop rest (cons tree contents)))
+            ;; new file
+            (loop (cdr paths) (cons (car paths) contents)))
+          ;; in a new subtree
+          (values (cons curdir (reverse contents)) paths)))))
+  (define-values (p pout pin perr)
+    (subprocess #f /dev/null-in (current-error-port) /tar "tzf" tgz))
+  (parameterize ([current-input-port pout])
+    (let loop ([lines '()])
+      (let ([line (read-line)])
+        (if (eof-object? line)
+          (let ([paths (sort* (reverse lines))])
+            (subprocess-wait p)
+            (unless (eq? 0 (subprocess-status p))
+              (error 'get-tgz-tree "`tar' failed."))
+            (let-values ([(tree rest) (tree+rest paths "")])
+              (if (null? rest)
+                (cdr tree)
+                (error 'get-tgz-tree "something bad happened (~s...)"
+                       (car paths)))))
+          (loop (cons line lines)))))))
+
+;;; ===========================================================================
+;;; Spec management
+
+(define *readme-specs* (make-parameter #f))
+
+;;; ===========================================================================
+;;; Start working
+
+(register-macros!)
+
+(define *platforms* #f)
+(define *bin-types* #f)
+(define *src-types* #f)
+(define *platform-tree-lists* #f)
+(define /pax #f)
+(define /tar #f)
+(define /dev/null-out #f)
+(define /dev/null-in  #f)
+
+(define (process-command-line)
+  (command-line
+   #:multi
+   ["+d" "Verify dependencies (default)"         (set! *verify?*  #t)]
+   ["-d" "Don't verify dependencies"             (set! *verify?*  #f)]
+   ["+v" "Verbose mode (on stdout)"              (set! *verbose?* #t)]
+   ["-v" "Normal output (only stderr) (default)" (set! *verbose?* 'yes)]
+   ["-q" "Quiet mode"                            (set! *verbose?* #f)]
+   ["+b" "Create binary tgzs (default)"          (set! *btgz?*    #t)]
+   ["-b" "Skip binary tgzs, re-use binary trees" (set! *btgz?*    #f)]
+   ["+p" "Pack distributions (default)"          (set! *pack?*    #t)]
+   ["-p" "Skip packing"                          (set! *pack?*    #f)]
+   ["+r" "chown the contents to root (default)"  (set! *root?*    #t)]
+   ["-r" "Do not chown the contents to root"     (set! *root?*    #f)]
+   ["++release" "Build for a release"            (set! *release?* #t)]
+   ["-o" dest "Destination directory" (set! target/ (/-ify dest))]
+   ["--text" "Stands for -d +v -b -p -r (useful for debugging)"
+    (set!-values (*verify?* *verbose?* *btgz?* *pack?* *root?*)
+                 (values #f #t #f #f #f))])
+  (current-verbose-port (and *verbose?* current-error-port)))
+
+;; specs can have `lambda' expressions to evaluate, do it in this context
+(define-namespace-anchor bundle-specs)
+
+(define (read-spec-file file [param *specs*])
+  (process-specs
+   (with-input-from-file file
+     (lambda ()
+       (let loop ([xs '()])
+         (let ([x (read)])
+           (if (eof-object? x) (reverse xs) (loop (cons x xs)))))))
+   param))
+
+(define (read-specs)
+  (current-namespace (namespace-anchor->namespace bundle-specs))
+  (dprintf "Reading specs...")
+  (dist:register-specs!)
+  (read-spec-file *readme-specs-file* *readme-specs*)
+  (dprintf " done.\n"))
+
+(define (input-tgz-name? f)
+  (let ([f (if (path? f) (path->string f) f)])
+    ;; names of tgzs that are not the generated binary ones
+    (and (regexp-match? #rx"\\.tgz$" f)
+         (not (regexp-match? #rx"-binaries\\.tgz$" f)))))
+
+(define (initialize)
+  (when *release?* (*environment* (cons 'release (*environment*))))
+  (set! /pax (or (find-executable-path "pax" #f)
+                 (error "error: couldn't find a `pax' executable")))
+  (set! /tar (or (find-executable-path "gtar" #f)
+                 (error "error: couldn't find a `gtar' executable")))
+  (set! /dev/null-out (open-output-file "/dev/null" #:exists 'append))
+  (set! /dev/null-in  (open-input-file  "/dev/null"))
+  (unless (directory-exists? target/) (make-directory target/))
+  (let ([d (ormap (lambda (x) (and (not (directory-exists? x)) x))
+                  (list home/ plt/ binaries/ target/))])
+    (when d (error 'bundle "directory not found: ~a" d)))
+  (set! *platforms*
+        (parameterize ([cd binaries/])
+          (filter (lambda (x)
+                    (and (not (regexp-match? #rx"^[.]" x))
+                         (directory-exists? x)))
+                  (dir-list))))
+  (set! *bin-types* (map string->symbol *platforms*))
+  (set! *src-types*
+        (let loop ([bins *bin-types*] [r '()])
+          (if (null? bins)
+            (reverse r)
+            (let* ([bin (car bins)] [src (get-tag bin)])
+              (cond
+                [(not src) (error 'binaries "no type assigned to `~e'" bin)]
+                [(not (= 1 (length src)))
+                 (error 'binaries "bad type assignment for `~e': ~e" bin src)]
+                [else (loop (cdr bins)
+                            (if (memq (car src) r) r (cons (car src) r)))])))))
+  (dprintf "Scanning full tgzs")
+  (set! *platform-tree-lists*
+        (parameterize ([cd binaries/])
+          (map (lambda (platform)
+                 (dprintf ".")
+                 (parameterize ([cd platform])
+                   ;; if no btgz *and* "plt" already created then use get-tree
+                   ;; (useful when debugging stuff so re-use pre made ones)
+                   ;; should work the same with an old tree
+                   (if (and (directory-exists? "plt") (not *btgz?*))
+                     (filtered-map
+                      (lambda (x) ; only directories contain stuff we need
+                        (and (directory-exists? x) (get-tree x)))
+                      (dir-list))
+                     (let ([trees (filtered-map
+                                   (lambda (x)
+                                     (and (file-exists? x) (input-tgz-name? x)
+                                          (get-tgz-tree x)))
+                                   (dir-list))])
+                       (tag (list (string->symbol platform))
+                         (map (lambda (tree) (tree-filter 'binaries tree))
+                              (apply append trees)))))))
+               *platforms*)))
+  (dprintf " done.\n")
+  (for-each (lambda (platform trees)
+              (when (null? trees)
+                (error 'binaries "no binaries found for ~s" platform)))
+            *platforms* *platform-tree-lists*)
+  ;; Create the readme file so it is included with the plt tree
+  (with-output-to-file *readme-file* newline #:exists 'truncate)
+  ;; Get the plt tree, remove junk and binary stuff
+  (set-plt-tree! plt-base/ plt/-name *platform-tree-lists*)
+  (set-bin-files-delayed-lists!
+   (delay (map (lambda (trees)
+                 (sort* (mappend tree-flatten (add-trees trees))))
+               *platform-tree-lists*)))
+  ;; Get the plt tree, remove junk and binary stuff
+  (delete-file *readme-file*))
+
+;; works with any newline format, expects text that always ends with a newline,
+;; does not handle tabs, does not handle prefix whitespaces, is not efficient.
+(define (wrap-string str width)
+  (define (wrap-line str nl r)
+    (cond [(<= (string-length str) width) (list* nl str r)]
+          [(or (regexp-match-positions #rx"^.*( +)" str 0 width)
+               ;; no space in limit, go for the first space afterwards
+               (regexp-match-positions #rx"^.*?( +)" str))
+           => (lambda (m)
+                (wrap-line (substring str (cdadr m)) nl
+                           (list* nl (substring str 0 (caadr m)) r)))]
+          [else (list* nl str r)]))
+  (let loop ([str str] [r '()])
+    (let ([m (regexp-match #rx"^(.*?)(\r\n|\r|\n)(.*)$" str)])
+      (if m
+        (loop (cadddr m) (wrap-line (cadr m) (caddr m) r))
+        (apply string-append (reverse (cons str r)))))))
+
+(define (make-readme)
+  (let ([readme (parameterize ([*specs* (*readme-specs*)])
+                  (apply string-append (expand-spec 'readme)))])
+    (display (wrap-string readme 72))))
+
+(define (make-info-domain trees)
+  (unless (= 1 (length trees))
+    (error 'make-info-domain "got zero or multiple trees: ~e" trees))
+  (let* ([collects (or (tree-filter "/plt/collects/" (car trees))
+                       (error 'make-info-domain "got no collects in tree"))]
+         [info (filter (lambda (x)
+                         (let ([x (path->string (bytes->path (car x)))])
+                           (pair? (tree-filter (concat "/plt/collects/" x)
+                                               collects))))
+                       *info-domain-cache*)])
+    (lambda () (write info) (newline))))
+
+(define (create-binaries platform trees)
+  (parameterize ([cd (build-path binaries/ platform)])
+    (let ([full-tgz (concat "plt-"platform"-full.tgz")]
+          [bin-tgz  (concat "plt-"platform"-binaries.tgz")]
+          [all-tgzs (filter input-tgz-name?
+                            (map path->string (directory-list)))])
+      (unless (and (directory-exists? "plt") (not *btgz?*))
+        (dprintf "Unpacking binaries in ~s ~a\n" platform all-tgzs)
+        ;; even if a "plt" directory exists, we just overwrite the same stuff
+        (unless (member full-tgz all-tgzs)
+          (error 'create-binaries "~a/~a not found" (cd) full-tgz))
+        (for ([tgz all-tgzs]) (unpack tgz trees)))
+      (when *btgz?*
+        (dprintf "Creating ~s\n" bin-tgz)
+        (when (file-exists? bin-tgz) (delete-file bin-tgz))
+        (let-values ([(p pout pin perr)
+                      (subprocess
+                       (current-output-port) /dev/null-in (current-error-port)
+                       ;; see below for flag explanations
+                       /pax "-w" "-x" "ustar" "-z" "-f" bin-tgz
+                       ;; only pack the plt dir (only exception is Libraries on
+                       ;; OSX, but that has its own dir)
+                       "plt")])
+          (subprocess-wait p))))))
+
+(define (pack archive trees prefix)
+  ;; `pax' is used to create the tgz archives -- the main reasons for using it
+  ;; is the fact that it can generate portable "ustar" tar files, and that it
+  ;; is flexible enough to allow replacing file names, so we can collect files
+  ;; from different directories and make them all appear in a single one in the
+  ;; resulting archive.
+  (when (eq? #t *verbose?*) (printf "~a:\n" archive))
+  (cond [*pack?*
+         (dprintf " packing...")
+         (when (file-exists? archive) (delete-file archive))
+         (let*-values ([(output) (if (eq? #t *verbose?*)
+                                   (current-output-port) /dev/null-out)]
+                       [(p pout pin perr)
+                        ;; Note: pax prints converted paths on stderr, so
+                        ;; silence it too unless verbose.  Use only for
+                        ;; debugging.
+                        (subprocess
+                         output #f output
+                         /pax
+                         "-w"         ; write
+                         "-x" "ustar" ; create a POSIX ustar format
+                         "-z"         ; gzip the archive
+                         "-d"         ; dont go down directories implicitly
+                         "-s" (format ",^~a,,p" prefix) ; delete base paths
+                         "-f" archive ; pack to this file
+                         )])
+           (parameterize ([current-output-port pin])
+             (for ([t trees]) (print-tree t 'full)))
+           (close-output-port pin)
+           (subprocess-wait p)
+           (unless (eq? 0 (subprocess-status p))
+             (error 'pack "`pax' failed.")))]
+        [(eq? #t *verbose?*) (for ([t trees]) (print-tree t))])
+  (when (eq? #t *verbose?*) (newline))
+  (flush-output))
+
+(define (unpack archive trees)
+  ;; unpack using tar (doesn't look like there's a way to unpack according to
+  ;; files from stdin with pax, and it uses gnu format with @LongLinks).
+  (let-values
+      ([(p pout pin perr)
+        (subprocess
+         (current-output-port) #f (current-error-port) /tar
+         "x"              ; extract
+         "-z"             ; gunzip the archive
+         "-p"             ; preserve permissions
+         "--files-from=-" ; read files from stdin
+         "-f" archive     ; unpack this file
+         )]
+       [(trees)
+        (map (lambda (t)
+               (tree-filter
+                (lambda (t)
+                  ;; Problem: if this returns #t/#f only, then the sources can
+                  ;; come from multiple tgz since each file will be identified
+                  ;; by itself.  But if this is done, then no empty directories
+                  ;; will be included (see `tree-filter' comment) and this will
+                  ;; later be a problem (to have an empty dir in the tree but
+                  ;; not on disk) -- so return '+ and as soon as a root is
+                  ;; identified with the tgz, all of it will be used.
+                  (and
+                   (equal? archive
+                           (prop-get (tree-path t) 'tgz
+                                     (lambda ()
+                                       (error 'unpack
+                                              "no `tgz' property for ~e" t))))
+                   '+))
+                t))
+             trees)])
+    (parameterize ([current-output-port pin])
+      (for ([t trees]) (print-tree t 'only-files)))
+    (close-output-port pin)
+    (subprocess-wait p)
+    (unless (eq? 0 (subprocess-status p)) (error 'unpack "`tar' failed."))))
+
+;; This code implements the binary filtering of 3m/cgc files, see
+;; `binary-keep/throw-templates' in "distribution-specs.ss".
+;; Careful when editing!
+(define (filter-bintree tree)
+  (define (get-pattern spec)
+    (let ([rx (expand-spec spec)])
+      (if (and (pair? rx) (null? (cdr rx)) (string? (car rx)))
+        (car rx)
+        (error 'filter-bintree "bad value for ~e: ~e" spec rx))))
+  (define keep-pattern  (get-pattern 'binary-keep))
+  (define throw-pattern (get-pattern 'binary-throw))
+  (define keep-rx  (regexpify-spec (string-append "*" keep-pattern  "*")))
+  (define throw-rx (regexpify-spec (string-append "*" throw-pattern "*")))
+  (define templates
+    (let ([ts (expand-spec 'binary-keep/throw-templates)])
+      (for ([t ts])
+        (unless (and (string? t)
+                     ;; verify that it has exactly one "<...!...>" pattern
+                     (regexp-match? #rx"^[^<!>]*<[^<!>]*![^<!>]*>[^<!>]*$" t))
+          (error 'filter-bintree "bad keep/throw template: ~e" t)))
+      ts))
+  (define (make-matcher x) ; matchers return match-positions or #f
+    (let ([rxs (map (lambda (t)
+                      (let* ([x (regexp-replace #rx"!" t x)]
+                             [x (object-name (regexpify-spec x #t))]
+                             [x (regexp-replace #rx"<(.*)>" x "(\\1)")])
+                        (regexp x)))
+                    templates)])
+      (lambda (p) (ormap (lambda (rx) (regexp-match-positions rx p)) rxs))))
+  (define (rassoc x l)
+    (and (pair? l) (if (equal? x (cdar l)) (car l) (rassoc x (cdr l)))))
+  (define keep?  (make-matcher keep-pattern))
+  (define throw? (make-matcher throw-pattern))
+  (define existing-paths (tree-flatten tree))
+  ;; The two `*-paths' values are association lists: ((<path> . <plain>) ...)
+  ;; both sides are unique in each list, the lhs is always an existing path
+  (define (find-paths pred? mode rx)
+    (define res '())
+    (let loop ([t tree])
+      (let ([p (tree-path t)])
+        (cond [(pred? p)
+               => (lambda (m)
+                    (let ([plain (string-append (substring p 0 (caadr m))
+                                                (substring p (cdadr m)))])
+                      (when (rassoc plain res)
+                        (error 'filter-bintree
+                               "two ~s templates have the same plain: ~e -> ~e"
+                               mode p plain))
+                      (set! res `((,p . ,plain) ,@res)))
+                    #t)]
+              [(regexp-match? rx p)
+               ;; other matches are not allowed, unless on a directory where
+               ;; all files are selected
+               (when (or (not (pair? t))
+                         (memq #f (map loop (cdr t))))
+                 (error 'filter-bintree
+                        "~s path uncovered by patterns: ~e" mode p))
+               #t]
+              [(pair? t) (not (memq #f (map loop (cdr t))))]
+              [else #f])))
+    res)
+  (define keep-paths  (find-paths keep?  'keep  keep-rx))
+  (define throw-paths (find-paths throw? 'throw throw-rx))
+  (for ([k keep-paths])
+    (when (assoc (car k) throw-paths)
+      (error 'filter-bintree
+             "a path matched both keep and throw patterns: ~s" (car k))))
+  (let* ([ps (map cdr keep-paths)]
+         [ps (append ps (remove* ps (map cdr throw-paths)))]
+         [scan (lambda (f paths)
+                 (map (lambda (p) (cond [(f p paths) => car] [else #f])) ps))]
+         [plain (scan member existing-paths)]
+         [keep  (scan rassoc keep-paths)]
+         [throw (scan rassoc throw-paths)])
+    (define del
+      (map (lambda (p k t)
+             (cond
+               [(and p k t) (error 'filter-bintree "got keep+throw+plain")]
+               [(or k t) (or t p)]
+               [else (error 'filter-bintree "internal error")]))
+           plain keep throw))
+    (tree-filter `(not (or ,(lambda (t) (and (memq (tree-path t) del) '+))
+                           binary-throw-more))
+                 tree)))
+
+;; This is hooked below as a `distribute!' spec macro, and invoked through
+;; expand-spec.
+(define (distribute!)
+  (define (distribute tree) (tree-filter 'distribution tree))
+  (let* ([features (filter string? (reverse (*environment*)))]
+         [name     (apply concat (cdr (mappend (lambda (x) (list "-" x))
+                                               features)))]
+         [features (map string->symbol features)]
+         [bin?     (memq 'bin  features)]
+         [src?     (memq 'src  features)]
+         [full?    (memq 'full features)])
+    (when (and bin? src?)
+      (error 'distribute! "bad configuration (both bin & src): ~e" features))
+    (unless (or bin? src?)
+      (error 'distribute! "bad configuration (both bin & src): ~e" features))
+    (for ([type      (if bin? *bin-types*           *src-types*)]
+          ;; this is unused if bin? is false
+          [bin-trees (if bin? *platform-tree-lists* *src-types*)])
+      (tag (cons type features)
+        (let ([name (format "~a-~a.tgz" name type)])
+          (dprintf "Creating ~s: filtering..." name)
+          (let ([trees (add-trees
+                        (cons (distribute (get-plt-tree))
+                              (if bin?
+                                (tag 'in-binary-tree
+                                  (map (if full?
+                                         distribute
+                                         (lambda (t)
+                                           (distribute (filter-bintree t))))
+                                       bin-trees))
+                                '())))])
+            ;; make it possible to write these files
+            (chown 'me *readme-file* *info-domain-file*)
+            (with-output-to-file *readme-file* #:exists 'truncate make-readme)
+            (with-output-to-file *info-domain-file* #:exists 'truncate
+              (make-info-domain trees))
+            (chown 'root *readme-file* *info-domain-file*)
+            (pack (concat target/ name) trees
+                  (if bin?
+                    (format "\\(~a\\|~a~a/\\)" plt-base/ binaries/ type)
+                    plt-base/)))
+          (dprintf " done.\n")))))
+  '())
+(register-spec! 'distribute!
+  (lambda () (when (or *pack?* (eq? #t *verbose?*)) (distribute!))))
+
+(register-spec! 'verify! (lambda () (when *verify?* (verify!))))
+
+;; make auto-generated files exist
+(define (create-generated-files)
+  ;; no need to create the cache.ss, since it's there, but read it
+  (set! *info-domain-cache*
+        (with-input-from-file *info-domain-file* read))
+  (with-output-to-file *readme-file* newline #:exists 'truncate))
+(define (delete-generated-files)
+  ;; don't delete the cache, but write original unfiltered contents
+  (with-output-to-file *info-domain-file*
+    (lambda () (write *info-domain-cache*) (newline)) #:exists 'truncate)
+  (delete-file *readme-file*))
+
+;; mimic the chown syntax
+(define (chown #:rec [rec #f] who path . paths)
+  (when (and *root?* *pack?*)
+    (let ([user:group
+           (case who [(root) "root:root"] [(me) (force whoami)]
+                     [else (error 'chown "unknown user spec: ~e" who)])]
+          [paths (map (lambda (x) (if (path? x) (path->string x) x))
+                      (cons path paths))])
+      (when (ormap (lambda (x) (regexp-match? #rx"[^/a-zA-Z0-9_ .+-]" x)) paths)
+        (error 'chown "got a path that needs shell-quoting: ~a" paths))
+      (system (format "sudo chown ~a ~a ~a" (if rec "-R" "") user:group
+                      (apply string-append
+                             (map (lambda (p) (format " \"~a\"" p)) paths)))))))
+
+(define whoami
+  (delay
+    (parameterize ([current-output-port (open-output-string)])
+      (system "echo \"`id -nu`:`id -ng`\"")
+      (regexp-replace
+       #rx"[ \r\n]*$" (get-output-string (current-output-port)) ""))))
+
+(define (chown-dirs-to who)
+  (when (and *root?* *pack?*)
+    (dprintf "Changing owner to ~a..." who)
+    (for ([dir (list plt/ binaries/)])
+      (parameterize ([cd dir]) (chown #:rec #t who ".")))
+    (dprintf " done.\n")))
+
+(process-command-line)
+(read-specs)
+(initialize)
+(for-each create-binaries *platforms* *platform-tree-lists*)
+(dynamic-wind
+  (lambda () (create-generated-files) (chown-dirs-to 'root))
+  ;; Start the verification and distribution
+  (lambda () (expand-spec 'distributions) (void))
+  (lambda () (chown-dirs-to 'me) (delete-generated-files)))

collects/meta/build/info.rkt

@@ -0,0 +1,2 @@
+#lang setup/infotab
+(define compile-omit-paths 'all)

collects/meta/build/make-patch

@@ -0,0 +1,200 @@
+#!/bin/sh
+#| -*- scheme -*-
+exec racket "$0"
+
+Instructions:
+
+* Create a copy of a distributed PLT tree, change all files that need to change
+  for the patch.  If this is not a first patch, then begin this process with a
+  tree that has the previous patch applied.  (Patch numbers should go from 1
+  up.)
+
+  I do this:
+    cd
+    svn co http://svn.plt-scheme.org/plt/tags/<PREV-VER-OR-PATCH> patched
+    cd patched
+    svn merge -r<FIXREV-1>:<FIXREV> http://svn.plt-scheme.org/plt/trunk
+    ... more merges as needed ...
+
+* Make sure that "collects/version/patchlevel.ss" contains the new patch
+  number, and add comments about this patch, with a list of files that are
+  modified.  (This is good for the next step, when doing additional patches.)
+
+* In the code below,
+  - set `plt-version' to the version you're patching (base version, the code
+    will expect `(version)' to return an equal value).
+  - set `plt-base' to the location of the patched PLT tree on your system.
+  - put the list of files in the `files' definition.  Each patch should also
+    have all preceding patches in it, which means that if you're patching an
+    already-patched tree, then you should add more files.  (This is why it is
+    good to keep track of the modified files.)  Note that
+    "collects/version/patchlevel.ss" must be included in this list, and that
+    the file does have the correct patchlevel number (there is currently no way
+    to check whether the patchlevel makes sense).
+
+* Note that the patch is a collection with the same name ("plt-patch" below).
+  This means that installing a patch is a process that first overwrites any
+  preexisting patch collections.  This is fine, because patches are linear and
+  cumulative.  The worst that can happen is that someone downloads a patch
+  older than what's installed -- in that case the PLT tree already has the
+  higher patch level, and when the collection's installer is doing its work it
+  will simply be skipped (a successful patch installation happens only once,
+  and is later skipped when setup-plt is re-run).
+
+* Test, put in "iplt/web/download/patches/", publish new html, announce.
+
+* Commit the patched tree as a new tag.
+
+|#
+
+#lang mzscheme
+
+;; ============================================================================
+;; customization (items marked with `[*]' should be edited for all patches)
+
+;; [*] which PLT version is this patch for?
+(define plt-version "370")
+
+;; [*] location of a patched PLT tree
+(define plt-base "~/patched")
+
+;; [*] patched files in this tree (including previously patched files, if any)
+(define files '("collects/version/patchlevel.ss"
+                "collects/drscheme/private/module-language.ss"
+                "collects/framework/private/scheme.ss"
+                "collects/slideshow/tool.ss"
+                "collects/lang/htdp-langs.ss"
+                "collects/drscheme/private/unit.ss"))
+
+;; message to show after the last `Done' (#f => no extra text)
+(define exit-message "please restart DrScheme")
+
+;; template for the output archive file
+(define patchfile-template "/tmp/plt-patch-v~ap~a.plt")
+
+;; template for archive name
+(define name-template "PLT Scheme v~ap~a patch")
+
+;; patchlevel file in the PLT tree (must be included in `files' above)
+(define patchlevel-file "collects/version/patchlevel.ss")
+
+;; ============================================================================
+;; code folows
+
+(require (lib "list.ss") (lib "pack.ss" "setup"))
+
+;; move patchlevel file to the end
+(unless (member patchlevel-file files)
+  (error 'make-patch
+         "missing patchlevel file (~a) in the list of files" patchlevel-file))
+(set! files (append (remove patchlevel-file files) (list patchlevel-file)))
+
+(unless (absolute-path? plt-base)
+  (error 'make-patch "plt-base is not an absolute path: ~a" plt-base))
+
+(define patchlevel
+  ;; use `dynamic-require' -- not `require' since the patch can be built by a
+  ;; different PLT installation
+  (dynamic-require (build-path plt-base patchlevel-file) 'patchlevel))
+(define archive-name (format name-template plt-version patchlevel))
+(define archive-filename (format patchfile-template plt-version patchlevel))
+
+(define unpacker-body
+  `((define me ,(format "v~ap~a-patch" plt-version patchlevel))
+    (define (error* fmt . args)
+      (error (string-append "ERROR applying "me": " (apply format fmt args))))
+    (define (message fmt . args)
+      (printf "*** ~a: ~a\n" me (apply format fmt args)))
+    (define collects-dir (find-collects-dir))
+    (cond
+      [(not (equal? ,plt-version (version)))
+       (error* "bad version number; this patch is for version ~a, you have ~a"
+               ',plt-version (version))]
+      [(= patchlevel ,patchlevel) (error* "Already installed")]
+      [(> patchlevel ,patchlevel) (error* "Newer patch installed")]
+      [else (message "Applying patch...")])
+    (mzuntar void)
+    (message "Patch applied successfully, recompiling...")
+    ;; return a list of all toplevel collections to recompile
+    ;; (define (has-info? c)
+    ;;   (file-exists? (build-path collects-dir c "info.ss")))
+    ;; (let* ([cs (directory-list collects-dir)]
+    ;;        [cs (filter has-info? cs)]
+    ;;        [cs (map path->string cs)]
+    ;;        [cs (sort cs string<?)]
+    ;;        [cs (map list cs)])
+    ;;   cs)
+    ;; instead of the above, invoke setup-plt directly to avoid installers
+    ;; (otherwise, running this .plt from DrScheme on Windows complains about
+    ;; not being able to recreate the executable)
+    (let ([x 0])
+      (parameterize ([exit-handler (lambda (n) (set! x n))])
+        (run-setup))
+      (message ,(if exit-message (format "Done, ~a." exit-message) "Done."))
+      (exit x))
+    ;; everything below does not matter since we exit above
+    ;; (but just in case, return '() so no collections to recompile)
+    '()))
+
+(define run-setup
+  ;; This code is based on setup-go
+  `(module run-setup mzscheme
+     (require (lib "unit.ss") (lib "option-sig.ss" "setup")
+              (lib "option-unit.ss" "setup") (lib "cm.ss"))
+     (define-values/invoke-unit/infer setup:option@)
+     ;; settings
+     (clean              #f) ; no cleaning
+     (make-zo            #t) ; recompile zos
+     (call-install       #f) ; no installers
+     (make-launchers     #f) ; no launcher recreation
+     (make-so            #f) ; no extension compilation
+     (verbose            #f) ; be quiet
+     (make-verbose       #f) ; be quiet
+     (trust-existing-zos #f) ; recompile files when needed
+     (pause-on-errors    #f) ; no interactions
+     (force-unpacks      #f) ; not doing any unpacking
+     (compile-mode       #f) ; default compilation
+     ;; not unpacking, but just in case, make it go into the PLT tree
+     (current-target-plt-directory-getter
+      (lambda (preferred main-collects-parent-dir choices)
+        main-collects-parent-dir))
+     (specific-collections '()) ; no specifics, do all collections
+     (archives             '()) ; no archives to unpack
+     (specific-planet-dirs '()) ; no planet stuff
+     ;; invoke it
+     (require (lib "setup-unit.ss" "setup")
+              (lib "option-unit.ss" "compiler")
+              (lib "compiler-unit.ss" "compiler")
+              (lib "launcher-unit.ss" "launcher")
+              (lib "dynext-unit.ss" "dynext"))
+     (provide run-setup)
+     (define (run-setup)
+       (invoke-unit (compound-unit/infer (import setup-option^) (export)
+                      (link launcher@ dynext:compile@ dynext:link@ dynext:file@
+                            compiler:option@ compiler@ setup@))
+                    (import setup-option^)))))
+
+(define unpack-unit
+  `(begin (require (lib "list.ss")
+                   (lib "patchlevel.ss" "version")
+                   (lib "dirs.ss" "setup"))
+          ,run-setup
+          (require run-setup)
+          (unit (import main-collects-parent-dir mzuntar) (export)
+            ,@unpacker-body)))
+
+;; Pack up a .plt file
+
+(current-directory plt-base)
+
+(when (file-exists? archive-filename) (delete-file archive-filename))
+
+(pack-plt archive-filename
+          archive-name
+          files
+          #:requires `((("rackeg") ()) (("gracket") ()))
+          #:file-mode 'file-replace
+          #:plt-relative? #t
+          #:at-plt-home? #t
+          #:unpack-unit unpack-unit)
+(printf "Patch file created: ~a\n" archive-filename)

collects/meta/build/nsis/plt-installer.nsi

@@ -0,0 +1,305 @@
+!include "MUI2.nsh"
+!include "WinVer.nsh"
+!include "nsDialogs.nsh"
+
+;; ==================== Configuration
+
+;; The following should define:
+;;   PLTVersion, PLTVersionLong, PLTHumanName,
+;;   PLTDirName, PLTRegName
+
+!include plt-defs.nsh
+
+Name "${PLTHumanName}"
+OutFile "installer.exe"
+
+BrandingText "${PLTHumanName}"
+BGGradient 4040A0 101020
+
+SetCompressor /SOLID "LZMA"
+
+InstallDir "$PROGRAMFILES\${PLTDirName}"
+!ifndef SimpleInstaller
+  InstallDirRegKey HKLM "Software\${PLTRegName}" ""
+!endif
+!define MUI_STARTMENUPAGE_DEFAULTFOLDER "${PLTStartName}"
+!define MUI_ICON   "plt-installer.ico"
+!define MUI_UNICON "plt-uninstaller.ico"
+!define MUI_HEADERIMAGE
+!define MUI_HEADERIMAGE_BITMAP     "plt-header.bmp"
+!define MUI_HEADERIMAGE_BITMAP_RTL "plt-header-r.bmp"
+!define MUI_HEADERIMAGE_RIGHT
+
+!define MUI_WELCOMEFINISHPAGE_BITMAP "plt-welcome.bmp"
+!define MUI_UNWELCOMEFINISHPAGE_BITMAP "plt-welcome.bmp"
+
+!define MUI_WELCOMEPAGE_TITLE "${PLTHumanName} Setup"
+!define MUI_UNWELCOMEPAGE_TITLE "${PLTHumanName} Uninstall"
+!ifdef SimpleInstaller
+  !define MUI_WELCOMEPAGE_TEXT "This is a simple installer for ${PLTHumanName}.$\r$\n$\r$\nIt will only create the PLT folder.  To uninstall, simply remove the folder.$\r$\n$\r$\n$_CLICK"
+!else
+  !define MUI_WELCOMEPAGE_TEXT "This wizard will guide you through the installation of ${PLTHumanName}.$\r$\n$\r$\nPlease close other PLT applications (DrScheme, MrEd, MzScheme) so the installer can update relevant system files.$\r$\n$\r$\n$_CLICK"
+!endif
+!define MUI_UNWELCOMEPAGE_TEXT "This wizard will guide you through the removal of ${PLTHumanName}.$\r$\n$\r$\nBefore starting, make sure PLT applications (DrScheme, MrEd, MzScheme) are not running.$\r$\n$\r$\n$_CLICK"
+
+!define MUI_FINISHPAGE_TITLE "${PLTHumanName}"
+!ifdef SimpleInstaller
+  !define MUI_FINISHPAGE_RUN
+  !define MUI_FINISHPAGE_RUN_FUNCTION OpenInstDir
+  Function OpenInstDir
+    ExecShell "" "$INSTDIR"
+  FunctionEnd
+  !define MUI_FINISHPAGE_RUN_TEXT "Open the installation folder"
+!else
+  !define MUI_FINISHPAGE_RUN "$INSTDIR\DrScheme.exe"
+  !define MUI_FINISHPAGE_RUN_TEXT "Run DrScheme"
+!endif
+!define MUI_FINISHPAGE_LINK "Visit the PLT Scheme web site"
+!define MUI_FINISHPAGE_LINK_LOCATION "http://www.plt-scheme.org/"
+
+; !define MUI_UNFINISHPAGE_NOAUTOCLOSE ; to allow users see what was erased
+
+!define MUI_STARTMENUPAGE_REGISTRY_ROOT "HKLM"
+!define MUI_STARTMENUPAGE_REGISTRY_KEY "Software\${PLTRegName}"
+!define MUI_STARTMENUPAGE_REGISTRY_VALUENAME "Start Menu Folder"
+
+; Doesn't work on some non-xp machines
+; !define MUI_INSTFILESPAGE_PROGRESSBAR colored
+
+VIProductVersion "${PLTVersionLong}"
+VIAddVersionKey "ProductName" "PLT Scheme"
+VIAddVersionKey "Comments" "This is PLT Scheme, including DrScheme which is based on MrEd and MzScheme."
+VIAddVersionKey "CompanyName" "PLT"
+VIAddVersionKey "LegalCopyright" "© PLT"
+VIAddVersionKey "FileDescription" "PLT Scheme Installer"
+VIAddVersionKey "FileVersion" "${PLTVersion}"
+
+;; ==================== Variables
+
+!ifndef SimpleInstaller
+  Var MUI_TEMP
+  Var STARTMENU_FOLDER
+!endif
+
+;; ==================== Interface
+
+!define MUI_ABORTWARNING
+
+; Install
+!insertmacro MUI_PAGE_WELCOME
+!define MUI_PAGE_CUSTOMFUNCTION_LEAVE myTestInstDir
+!insertmacro MUI_PAGE_DIRECTORY
+!ifndef SimpleInstaller
+  !insertmacro MUI_PAGE_STARTMENU Application $STARTMENU_FOLDER
+!endif
+!insertmacro MUI_PAGE_INSTFILES
+
+; Uncheck and hide the "run" checkbox on vista, since it will run with
+; elevated permissions (see also ../nsis-vista-note.txt)
+!define MUI_PAGE_CUSTOMFUNCTION_SHOW DisableRunCheckBoxIfOnVista
+!insertmacro MUI_PAGE_FINISH
+Function DisableRunCheckBoxIfOnVista
+  ${If} ${AtLeastWinVista}
+    ; use EnableWindow instead of ShowWindow to just disable it
+    ShowWindow $mui.FinishPage.Run 0
+    ${NSD_Uncheck} $mui.FinishPage.Run
+  ${EndIf}
+FunctionEnd
+
+!ifndef SimpleInstaller
+  ; Uninstall
+  !define MUI_WELCOMEPAGE_TITLE "${MUI_UNWELCOMEPAGE_TITLE}"
+  !define MUI_WELCOMEPAGE_TEXT "${MUI_UNWELCOMEPAGE_TEXT}"
+  ; !insertmacro MUI_UNPAGE_WELCOME
+  !insertmacro MUI_UNPAGE_CONFIRM
+  !insertmacro MUI_UNPAGE_INSTFILES
+  ; !insertmacro MUI_UNPAGE_FINISH
+!endif
+
+!ifndef SimpleInstaller
+  !define MUI_CUSTOMFUNCTION_UNGUIINIT un.myGUIInit
+!endif
+
+!insertmacro MUI_LANGUAGE "English"
+
+!ifndef SimpleInstaller
+  !define UNINSTEXE "$INSTDIR\Uninstall.exe"
+!endif
+
+;; ==================== Installer
+
+!ifdef SimpleInstaller
+Function myTestInstDir
+  IfFileExists "$INSTDIR\*.*" +1 inst_dir_exists
+    MessageBox MB_YESNO "The directory '$INSTDIR' already exists, continue?" /SD IDYES IDYES inst_dir_exists
+    Abort
+  inst_dir_exists:
+FunctionEnd
+!else
+Function myTestInstDir
+  ; The assumption is that users might have all kinds of ways to get a PLT
+  ; tree, plus, they might have an old wise-based installation, so it is better
+  ; to rely on files rather than test registry keys.  Note: no version check.
+  ; if any of these exist, then we assume it's an old installation
+  IfFileExists "$INSTDIR\MzScheme.exe" plt_is_installed
+  IfFileExists "$INSTDIR\MrEd.exe"     plt_is_installed
+  IfFileExists "$INSTDIR\DrScheme.exe" plt_is_installed
+  IfFileExists "$INSTDIR\collects"     plt_is_installed
+  Goto plt_is_not_installed
+  plt_is_installed:
+    IfFileExists "${UNINSTEXE}" we_have_uninstall
+      MessageBox MB_YESNO "It appears that there is an existing PLT Scheme installation in '$INSTDIR', but no Uninstaller was found.$\r$\nContinue anyway (not recommended)?" /SD IDYES IDYES maybe_remove_tree
+      Abort
+    we_have_uninstall:
+      MessageBox MB_YESNO "It appears that there is an existing PLT Scheme installation in '$INSTDIR'.$\r$\nDo you want to uninstall it first (recommended)?" /SD IDNO IDNO maybe_remove_tree
+        HideWindow
+        ClearErrors
+        ExecWait '"${UNINSTEXE}" _?=$INSTDIR'
+        IfErrors uninstaller_problematic
+        IfFileExists "$INSTDIR\MzScheme.exe" uninstaller_problematic
+        IfFileExists "$INSTDIR\MrEd.exe" uninstaller_problematic
+          BringToFront
+          Goto plt_is_not_installed
+        uninstaller_problematic:
+          MessageBox MB_YESNO "Errors in uninstallation!$\r$\nDo you want to quit and sort things out now (highly recommended)?" /SD IDNO IDNO maybe_remove_tree
+          Quit
+    maybe_remove_tree:
+      MessageBox MB_YESNO "Since you insist, do you want to simply remove the previous directory now?$\r$\n(It is really better if you sort this out manually.)" /SD IDYES IDNO plt_is_not_installed
+        RMDir /r $INSTDIR
+  plt_is_not_installed:
+FunctionEnd
+!endif
+
+Section ""
+  SetShellVarContext all
+
+  SetDetailsPrint both
+  DetailPrint "Installing PLT Scheme..."
+  SetDetailsPrint listonly
+  SetOutPath "$INSTDIR"
+  File /a /r "plt\*.*"
+  !ifndef SimpleInstaller
+    WriteUninstaller "${UNINSTEXE}" ; Create uninstaller
+  !endif
+
+  !ifndef SimpleInstaller
+    SetDetailsPrint both
+    DetailPrint "Creating Shortcuts..."
+    SetDetailsPrint listonly
+    !insertmacro MUI_STARTMENU_WRITE_BEGIN Application
+      SetOutPath "$INSTDIR" ; Make installed links run in INSTDIR
+      CreateDirectory "$SMPROGRAMS\$STARTMENU_FOLDER"
+      CreateShortCut "$SMPROGRAMS\$STARTMENU_FOLDER\DrScheme.lnk" "$INSTDIR\DrScheme.exe"
+      CreateShortCut "$SMPROGRAMS\$STARTMENU_FOLDER\PLT Documentation.lnk" "$INSTDIR\plt-help.exe"
+      CreateShortCut "$SMPROGRAMS\$STARTMENU_FOLDER\MrEd.lnk" "$INSTDIR\MrEd.exe"
+      CreateShortCut "$SMPROGRAMS\$STARTMENU_FOLDER\MzScheme.lnk" "$INSTDIR\MzScheme.exe"
+      CreateShortCut "$SMPROGRAMS\$STARTMENU_FOLDER\PLT Folder.lnk" "$INSTDIR"
+      CreateShortCut "$SMPROGRAMS\$STARTMENU_FOLDER\Uninstall.lnk" "${UNINSTEXE}"
+    !insertmacro MUI_STARTMENU_WRITE_END
+
+    SetDetailsPrint both
+    DetailPrint "Setting Registry Keys..."
+    SetDetailsPrint listonly
+      WriteRegStr HKLM "Software\${PLTRegName}" "" "$INSTDIR" ; Save folder location
+      WriteRegStr HKCR ".ss" "" "Scheme.Document"
+      WriteRegStr HKCR ".scm" "" "Scheme.Document"
+      WriteRegStr HKCR ".scrbl" "" "Scheme.Document"
+      WriteRegStr HKCR "Scheme.Document" "" "PLT Scheme Document"
+      WriteRegStr HKCR "Scheme.Document\DefaultIcon" "" "$INSTDIR\collects\icons\schemedoc.ico"
+      WriteRegStr HKCR "Scheme.Document\shell\open\command" "" '"$INSTDIR\DrScheme.exe" "%1"'
+      ; Example, in case we want some things like this in the future
+      ; WriteRegStr HKCR "Scheme.Document\shell\mzscheme" "" "Run with MzScheme"
+      ; WriteRegStr HKCR "Scheme.Document\shell\mzscheme\command" "" '"$INSTDIR\MzScheme.exe" "-r" "%1"'
+      WriteRegStr HKCR ".plt" "" "Setup PLT.Document"
+      WriteRegStr HKCR "Setup PLT.Document" "" "PLT Scheme Package"
+      WriteRegStr HKCR "Setup PLT.Document\DefaultIcon" "" "$INSTDIR\collects\icons\schemedoc.ico"
+      WriteRegStr HKCR "Setup PLT.Document\shell\open\command" "" '"$INSTDIR\Setup PLT.exe" -p "%1"'
+
+      WriteRegExpandStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PLTRegName}" "UninstallString" '"${UNINSTEXE}"'
+      WriteRegExpandStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PLTRegName}" "InstallLocation" "$INSTDIR"
+      WriteRegStr       HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PLTRegName}" "DisplayName" "${PLTHumanName}"
+      WriteRegStr       HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PLTRegName}" "DisplayIcon" "$INSTDIR\DrScheme.exe,0"
+      WriteRegStr       HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PLTRegName}" "DisplayVersion" "${PLTVersion}"
+      ; used to also have "VersionMajor" & "VersionMinor" but looks like it's not needed
+      WriteRegStr       HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PLTRegName}" "HelpLink" "http://www.plt-scheme.org/"
+      WriteRegStr       HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PLTRegName}" "URLInfoAbout" "http://www.plt-scheme.org/"
+      WriteRegStr       HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PLTRegName}" "Publisher" "PLT Scheme Inc."
+      WriteRegDWORD     HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PLTRegName}" "NoModify" "1"
+      WriteRegDWORD     HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PLTRegName}" "NoRepair" "1"
+  !endif
+
+  SetDetailsPrint both
+  DetailPrint "Installation complete."
+SectionEnd
+
+;; ==================== Uninstaller
+
+!ifndef SimpleInstaller
+
+Function un.myGUIInit
+  ; if any of these exist, then we're fine
+  IfFileExists "$INSTDIR\MzScheme.exe" plt_is_installed_un
+  IfFileExists "$INSTDIR\MrEd.exe"     plt_is_installed_un
+  IfFileExists "$INSTDIR\DrScheme.exe" plt_is_installed_un
+  IfFileExists "$INSTDIR\collects"     plt_is_installed_un
+    MessageBox MB_YESNO "It does not appear that PLT Scheme is installed in '$INSTDIR'.$\r$\nContinue anyway (not recommended)?" /SD IDYES IDYES plt_is_installed_un
+    Abort "Uninstall aborted by user"
+  plt_is_installed_un:
+FunctionEnd
+
+Section "Uninstall"
+  SetShellVarContext all
+
+  SetDetailsPrint both
+  DetailPrint "Removing the PLT Scheme installation..."
+  SetDetailsPrint listonly
+    Delete "$INSTDIR\*.exe"
+    Delete "$INSTDIR\README*.*"
+    RMDir /r "$INSTDIR\collects"
+    RMDir /r "$INSTDIR\include"
+    RMDir /r "$INSTDIR\lib"
+    RMDir /r "$INSTDIR\doc"
+    ;; these exist in PLT-Full installations
+    RMDir /r "$INSTDIR\man"
+    RMDir /r "$INSTDIR\src"
+    Delete "${UNINSTEXE}"
+    RMDir "$INSTDIR"
+    ;; if the directory is opened, it will take some time to remove
+    Sleep 1000
+    IfErrors +1 uninstall_inst_dir_ok
+      MessageBox MB_YESNO "The PLT Scheme installation at '$INSTDIR' was not completely removed.$\r$\nForce deletion?$\r$\n(Make sure no PLT applications are running.)" /SD IDYES IDNO uninstall_inst_dir_ok
+        RMDir /r "$INSTDIR"
+        IfErrors +1 uninstall_inst_dir_ok
+          MessageBox MB_OK "Forced deletion did not work either, you will need to clean up '$INSTDIR' manually." /SD IDOK
+    uninstall_inst_dir_ok:
+
+  SetDetailsPrint both
+  DetailPrint "Removing Shortcuts..."
+  SetDetailsPrint listonly
+    !insertmacro MUI_STARTMENU_GETFOLDER Application $MUI_TEMP
+    Delete "$SMPROGRAMS\$MUI_TEMP\*.lnk"
+    ;; Delete empty start menu parent diretories
+    StrCpy $MUI_TEMP "$SMPROGRAMS\$MUI_TEMP"
+    startMenuDeleteLoop:
+      RMDir $MUI_TEMP
+      GetFullPathName $MUI_TEMP "$MUI_TEMP\.."
+      IfErrors startMenuDeleteLoopDone
+      StrCmp $MUI_TEMP $SMPROGRAMS startMenuDeleteLoopDone startMenuDeleteLoop
+    startMenuDeleteLoopDone:
+
+  SetDetailsPrint both
+  DetailPrint "Removing Registry Keys..."
+  SetDetailsPrint listonly
+    DeleteRegKey /ifempty HKLM "Software\${PLTRegName}\Start Menu Folder"
+    DeleteRegKey /ifempty HKLM "Software\${PLTRegName}"
+    DeleteRegKey HKCR ".ss"
+    DeleteRegKey HKCR ".scm"
+    DeleteRegKey HKCR ".scrbl"
+    DeleteRegKey HKCR "Scheme.Document"
+    DeleteRegKey HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PLTRegName}"
+
+  SetDetailsPrint both
+  DetailPrint "Uninstallation complete."
+SectionEnd
+
+!endif

collects/meta/build/patch-html

@@ -0,0 +1,93 @@
+#!/bin/sh
+#| -*- mode: scheme -*-
+if [ -x "$PLTHOME/bin/mzscheme" ]; then
+  exec "$PLTHOME/bin/mzscheme" -rm "$0" "$@"
+else
+  exec "mzscheme" -rm "$0" "$@"
+fi
+|#
+
+(define begin-pattern #"<!-- begin: __XXX__ -->\n")
+(define end-pattern   #"\n<!-- end: __XXX__ -->")
+
+(define begin-re (regexp-replace #"XXX" begin-pattern #"([^<> ]+)"))
+(define end-re   (regexp-replace #"XXX" end-pattern   #"([^<> ]+)"))
+
+(define (regexp-match1 rx inp . disp?)
+  (cond [(if (and (pair? disp?) (car disp?))
+           (regexp-match rx inp 0 #f (current-output-port))
+           (regexp-match rx inp))
+         => cadr]
+        [else #f]))
+
+(define (eprintf fmt . args)
+  (apply fprintf (current-error-port) fmt args))
+
+(define (patch-file skeleton html)
+  (let ([skeleton (open-input-file skeleton)]
+        [html     (open-input-file html)])
+    (let loop ()
+      (let ([begin-tag (regexp-match1 begin-re skeleton #t)])
+        ;; (eprintf ">>> skeleton: ~a begin\n" begin-tag)
+        (if begin-tag
+          (let ([begin-tag* (regexp-match1 begin-re html)])
+            ;; (eprintf ">>> html: ~a begin\n" begin-tag*)
+            (unless (equal? begin-tag begin-tag*)
+              (error 'patch-html
+                     "mismatched input begin-tags, expecting ~a got ~a"
+                     begin-tag begin-tag*))
+            ;; leave tags in, so it is possible to run this script again
+            (display (regexp-replace #"XXX" begin-pattern begin-tag))
+            (let ([end-tag (regexp-match1 end-re html #t)])
+              ;; (eprintf ">>> html: ~a end\n" end-tag)
+              (unless (equal? end-tag begin-tag)
+                (error 'patch-html "bad end tag (~a) for begin tag (~a)"
+                       end-tag begin-tag))
+              (let ([end-tag* (regexp-match1 end-re skeleton)])
+                ;; (eprintf ">>> skeleton: ~a end\n" end-tag*)
+                (unless (equal? end-tag end-tag*)
+                  (error 'patch-html
+                         "mismatched input end-tags, expecting ~a got ~a"
+                         end-tag end-tag*))
+                ;; leave tags in, so it is possible to run this script again
+                (display (regexp-replace #"XXX" end-pattern end-tag))
+                (loop))))
+          (cond [(regexp-match1 begin-re html) =>
+                 (lambda (tag)
+                   (error 'patch-html
+                          "mismatched input tags, extraneous tag in target: ~a"
+                          tag))]))))
+    (close-input-port skeleton)
+    (close-input-port html)))
+
+(define (patch-dir skeleton-dir)
+  (printf "patching directory: ~a\n" (current-directory))
+  (for-each (lambda (p)
+              (if (cdr p)
+                (begin
+                  (unless (directory-exists? (car p)) (make-directory (car p)))
+                  (parameterize ([current-directory (car p)])
+                    (patch-dir (build-path skeleton-dir (car p)))))
+                (let ([skeleton (build-path skeleton-dir (car p))])
+                  (if (file-exists? (car p))
+                    (let ([tmp "/tmp/patch-html-file"])
+                      (printf "patching file: ~a\n"
+                              (build-path (current-directory) (car p)))
+                      (with-output-to-file tmp
+                        (lambda () (patch-file skeleton (car p)))
+                        #:exists 'truncate)
+                      (delete-file (car p))
+                      (copy-file tmp (car p))
+                      (delete-file tmp))
+                    (begin (printf "copying file: ~a/~a\n"
+                                   (current-directory) (car p))
+                           (copy-file skeleton (car p)))))))
+            (parameterize ([current-directory skeleton-dir])
+              (map (lambda (p)
+                     (cons p (cond [(file-exists? p) #f]
+                                   [(directory-exists? p) #t]
+                                   [else (error "internal-error")])))
+                   (directory-list)))))
+
+(define (main arg)
+  (patch-dir (path->complete-path arg)))

collects/meta/build/readme-specs

@@ -0,0 +1,137 @@
+;; -*- scheme -*-
+
+;; This file defines the readme files for the different distributions.  It is
+;; similar to the distribution specs file, see that for explanations on its
+;; format.
+
+\\ := (cond win => "\r\n"
+            ;; (or ppc-osx-mac i386-osx-mac) => "\r" ; is this still needed?
+            else => "\n"  )
+
+package-name
+:= (cond full => "PLT Scheme Full Repository"
+         plt  => "PLT Scheme"
+         dr   => "DrScheme"
+         mr   => "MrEd"
+         mz   => "MzScheme")
+
+dist-type
+:= (cond src  => "source"
+         else => "executable")
+
+platform-type
+:= (cond unix => "Unix"
+         mac  => "Macintosh"
+         win  => "Windows")
+platform
+:= (cond i386-linux        => "Linux (i386)"
+         i386-linux-gcc2   => "Linux (i386/gcc2)"
+         i386-linux-fc2    => "Fedora Core 2 (i386)"
+         i386-linux-fc5    => "Fedora Core 5 (i386)"
+         i386-linux-fc6    => "Fedora Core 6 (i386)"
+         i386-linux-f7     => "Fedora 7 (i386)"
+         x86_64-linux-f7   => "Fedora 7 (x86_64)"
+         i386-linux-f9     => "Fedora 9 (i386)"
+         i386-linux-f12    => "Fedora 12 (i386)"
+         i386-linux-debian => "Debian Stable (i386)"
+         i386-linux-debian-testing  => "Debian Testing (i386)"
+         i386-linux-debian-unstable => "Debian Unstable (i386)"
+         i386-linux-ubuntu          => "Ubuntu (i386)"
+         i386-linux-ubuntu-dapper   => "Ubuntu Dapper (i386)"
+         i386-linux-ubuntu-edgy     => "Ubuntu Edgy (i386)"
+         i386-linux-ubuntu-feisty   => "Ubuntu Feisty (i386)"
+         i386-linux-ubuntu-hardy    => "Ubuntu Hardy (i386)"
+         i386-linux-ubuntu-intrepid => "Ubuntu Intrepid (i386)"
+         i386-linux-ubuntu-jaunty   => "Ubuntu Jaunty (i386)"
+         i386-freebsd      => "FreeBSD (i386)"
+         sparc-solaris     => "Solaris"
+         ppc-osx-mac       => "Mac OS X (PPC)"
+         i386-osx-mac      => "Mac OS X (Intel)"
+         ppc-darwin        => "Mac OS X using X11 (PPC)"
+         i386-darwin       => "Mac OS X using X11 (Intel)"
+         i386-win32        => "Windows"
+         else => platform-type)
+
+executable := (cond mac => "application" else => "executable")
+dir := (cond (or win mac) => "folder" else => "directory")
+
+version := (lambda () (version))
+
+drscheme*
+:= (cond unix => "bin/drscheme"  win => "DrScheme.exe"  mac => "DrScheme")
+plt-help*
+:= (cond unix => "bin/plt-help"  win => "plt-help.exe"  mac => "bin/plt-help")
+setup-plt*
+:= (cond unix => "bin/setup-plt" win => "Setup PLT.exe" mac => "bin/setup-plt")
+mred*
+:= (cond unix => "bin/mred"      win => "MrEd.exe"      mac => "MrEd")
+mzscheme*
+:= (cond unix => "bin/mzscheme"  win => "MzScheme.exe"  mac => "bin/mzscheme")
+mzc*
+:= (cond unix => "bin/mzc"       win => "mzc.exe"       mac => "bin/mzc")
+planet*
+:= (cond unix => "bin/planet"    win => "planet.exe"    mac => "bin/planet")
+
+intro
+:= "This is the "package-name" v"(version)" "dist-type" package "dir" for "
+   platform"." \\
+
+main-exe
+:= "These are some of the important "executable"s that are included:" \\
+   \\
+   (cond (or dr plt full) =>
+         "  "drscheme*" -- the PLT Scheme development environment" \\ \\)
+   "  "mzscheme*" -- a text-only Scheme interpreter" \\
+   (cond (or md dr plt full) =>
+         "  "mred*" -- a graphical Scheme interpreter" \\)
+   "  "mzc*" -- command-line tool for creating executables, etc." \\
+   (cond (or dr plt full) =>
+         "  "plt-help*" --- for Help (also built into DrScheme)" \\)
+   "  "setup-plt*" --- command-line setup tool" \\
+   "  "planet*" --- a command-line helper for for managing third-party "
+                   "libraries" \\
+   \\
+   (cond full => "This package contains the complete build tree, which "
+                 "includes `cgc' binaries that use a conservative collector." \\
+                 \\)
+
+main-src
+:= "You must compile MzScheme " (cond (or mr dr plt full) => "and MrEd ")
+   "before using the "package-name" software"
+   (cond (or dr plt full) => " (including DrScheme)")"." \\
+   \\
+   "For compilation instructions, see \""
+   (cond win  => "plt\\src\\worksp\\README"
+         else => "plt/src/README")
+   "\"." \\
+main
+:= (cond src => main-src else => main-exe)
+
+license
+:= "License" \\
+   "-------" \\ \\
+   "PLT Software" \\
+   "Copyright (c) 1995-2003 PLT" \\
+   "Copyright (c) 2004-2008 PLT Inc." \\
+   \\
+   "PLT software is distributed under the GNU Lesser General Public "
+   "License (LGPL).  This means you can link PLT software (such as "
+   "MzScheme or MrEd) into proprietary applications, provided you follow "
+   "the specific rules stated in the LGPL.  You can also modify PLT "
+   "software; if you distribute a modified version, you must distribute it "
+   "under the terms of the LGPL, which in particular means that you must "
+   "release the source code for the modified software.  See "
+   "doc/release-notes/COPYING.LIB for more information." \\
+   (cond full =>
+         \\ "Note that this is the "package-name" distribution, which might "
+         "contain parts that are GPL." \\)
+
+more-information
+:= "More Information" \\
+   "----------------" \\
+   \\
+   "For further information, use DrScheme's `Help' menu, or run "plt-help*". "
+   "Also, visit http://www.plt-scheme.org/." \\
+
+readme
+:= intro \\ main \\ \\ license \\ \\ more-information

collects/meta/build/sitemap/AUTHORS

@@ -0,0 +1 @@
+opensource@google.com

collects/meta/build/sitemap/COPYING

@@ -0,0 +1,37 @@
+Copyright (c) 2004, 2005, Google Inc.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Google Inc. nor the names of its contributors
+      may be used to endorse or promote products derived from this
+      software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+The sitemap_gen.py script is written in Python 2.2 and released to the open
+source community for continuous improvements under the BSD 2.0 new license,
+which can be found at:
+
+  http://www.opensource.org/licenses/bsd-license.php

collects/meta/build/sitemap/ChangeLog

@@ -0,0 +1,65 @@
+Wed Jun 01 01:00:00 2005  Google Inc. <opensource@google.com>
+
+	* sitemap_gen: initial release:
+	  This directory contains Python utilities for creating
+	  Sitemaps.
+
+Mon Jun 13 01:00:00 2005  Google Inc. <opensource@google.com>
+
+	* sitemap_gen.py: v1.1
+
+	  [BIG]
+	  Not blow up when dealing with international character encodings.
+
+	  [MODERATE]
+	  Fix platform and Python version issues.  In some versions of 2.2
+	  and certain platforms, True was not defined.  Gak!
+	
+Tue Jul 12 01:00:00 2005  Google Inc. <opensource@google.com>
+
+	* sitemap_gen.py: v1.2
+	  
+	  [MODERATE]
+	  Default_file option added to directory walking
+	  Support for Extended Logfile Format (IIS's log format)
+	  Allow wildcards in the "path" attribute on accesslog and urllist
+	    input methods.
+	  Running on Python 1.5 should exit cleanly with an error message
+	  Stricter processing of configuration files
+	  
+	  [SMALL]
+	  XML files written in "text" mode, so linefeeds are correct
+	  One more Unicode issue fixed: Sitemap filenames with non-ascii
+	    characters had still been problematic
+	  In directory walking, the root URL of the walk now gets included
+	  In directory walking, URLs to directories now have a "/" appended
+	  URLs to files we recognize as our own script's Sitemap output files
+	    are suppressed.
+	  'suppress_search_engine_notify="0"' now does what you would expect
+	  Default priority on URLs is now 0.5 instead of 1.0
+	  Priority values written by default to only 4 decimal places
+	  URLs to Sitemap files in the Sitemap index file are now encoded
+	  according to the user's default_encoding, instead of forcing to UTF-8
+
+Mon Aug 01 01:00:00 2005  Google Inc. <opensource@google.com>
+
+	* sitemap_gen.py: v1.3
+
+	  [BIG]
+	  <sitemap ... /> input method added.
+
+	  [MODERATE]
+	  Use proper IDNA encoding on international domain names.  This is
+	    only available on Python2.3 or higher.
+
+	  [SMALL]
+	  Fixed Windows bug where directory walking would generate bad URLs on
+	    2+ deep subdirectories
+
+Wed Nov 03 01:00:00 2005  Google Inc. <opensource@google.com>
+
+	* sitemap_gen.py: v1.4
+
+	  [SMALL]
+	  Fixed bug where writing a gzipped sitemap would store the server's
+	  file path in the archive.

collects/meta/build/sitemap/PKG-INFO

@@ -0,0 +1,10 @@
+Metadata-Version: 1.0
+Name: sitemap_gen
+Version: 1.4
+Summary: Sitemap Generator
+Home-page: http://sourceforge.net/projects/goog-sitemapgen/
+Author: Google Inc.
+Author-email: opensource@google.com
+License: BSD
+Description: UNKNOWN
+Platform: UNKNOWN

collects/meta/build/sitemap/README

@@ -0,0 +1,25 @@
+sitemap_gen.py
+
+Version 1.4
+
+The sitemap_gen.py script analyzes your web server and generates one or more
+Sitemap files.  These files are XML listings of content you make available on
+your web server.  The files can be directly submitted to search engines as
+hints for the search engine web crawlers as they index your web site.  This
+can result in better coverage of your web content in search engine indices,
+and less of your bandwidth spent doing it.
+  
+The sitemap_gen.py script is written in Python and released to the open
+source community for continuous improvements under the BSD 2.0 new license,
+which can be found at:
+
+  http://www.opensource.org/licenses/bsd-license.php
+
+The original release notes for the script, including a walk-through for
+webmasters on how to use it, can be found at the following site:
+
+  http://www.google.com/webmasters/sitemaps/sitemap-generator.html
+
+The minimum Python version required is Python 2.2.  However, if URLs on
+your site involve any non-ASCII characters, we strongly recommend
+Python 2.3 or later, as it better handles encoding issues.

collects/meta/build/sitemap/example_config.xml

@@ -0,0 +1,164 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!--
+  sitemap_gen.py example configuration script
+
+  This file specifies a set of sample input parameters for the
+  sitemap_gen.py client.
+
+  You should copy this file into "config.xml" and modify it for
+  your server.
+
+
+  ********************************************************* -->
+
+
+<!-- ** MODIFY **
+  The "site" node describes your basic web site.
+
+  Required attributes:
+    base_url   - the top-level URL of the site being mapped
+    store_into - the webserver path to the desired output file.
+                 This should end in '.xml' or '.xml.gz'
+                 (the script will create this file)
+
+  Optional attributes:
+    verbose    - an integer from 0 (quiet) to 3 (noisy) for
+                 how much diagnostic output the script gives
+    suppress_search_engine_notify="1"
+               - disables notifying search engines about the new map
+                 (same as the "testing" command-line argument.)
+    default_encoding
+               - names a character encoding to use for URLs and
+                 file paths.  (Example: "UTF-8")
+-->
+<site
+  base_url="http://www.example.com/"
+  store_into="/var/www/docroot/sitemap.xml.gz"
+  verbose="1"
+  >
+
+  <!-- ********************************************************
+          INPUTS
+
+  All the various nodes in this section control where the script
+  looks to find URLs.
+
+  MODIFY or DELETE these entries as appropriate for your server.
+  ********************************************************* -->
+
+  <!-- ** MODIFY or DELETE **
+    "url" nodes specify individual URLs to include in the map.
+
+    Required attributes:
+      href       - the URL
+
+    Optional attributes:
+      lastmod    - timestamp of last modification (ISO8601 format)
+      changefreq - how often content at this URL is usually updated
+      priority   - value 0.0 to 1.0 of relative importance in your site
+  -->
+  <url  href="http://www.example.com/stats?q=name"  />
+  <url
+     href="http://www.example.com/stats?q=age"
+     lastmod="2004-11-14T01:00:00-07:00"
+     changefreq="yearly"
+     priority="0.3"
+  />
+
+
+  <!-- ** MODIFY or DELETE **
+    "urllist" nodes name text files with lists of URLs.
+    An example file "example_urllist.txt" is provided.
+
+    Required attributes:
+      path       - path to the file
+
+    Optional attributes:
+      encoding   - encoding of the file if not US-ASCII
+  -->
+  <urllist  path="example_urllist.txt"  encoding="UTF-8"  />
+
+
+  <!-- ** MODIFY or DELETE **
+    "directory" nodes tell the script to walk the file system
+    and include all files and directories in the Sitemap.
+
+    Required attributes:
+      path       - path to begin walking from
+      url        - URL equivalent of that path
+
+    Optional attributes:
+      default_file - name of the index or default file for directory URLs
+  -->
+  <directory  path="/var/www/icons"    url="http://www.example.com/images/" />
+  <directory
+     path="/var/www/docroot"
+     url="http://www.example.com/"
+     default_file="index.html"
+  />
+
+
+  <!-- ** MODIFY or DELETE **
+    "accesslog" nodes tell the script to scan webserver log files to
+    extract URLs on your site.  Both Common Logfile Format (Apache's default
+    logfile) and Extended Logfile Format (IIS's default logfile) can be read.
+
+    Required attributes:
+      path       - path to the file
+
+    Optional attributes:
+      encoding   - encoding of the file if not US-ASCII
+  -->
+  <accesslog  path="/etc/httpd/logs/access.log"       encoding="UTF-8"  />
+  <accesslog  path="/etc/httpd/logs/access.log.0"     encoding="UTF-8"  />
+  <accesslog  path="/etc/httpd/logs/access.log.1.gz"  encoding="UTF-8"  />
+
+
+  <!-- ** MODIFY or DELETE **
+    "sitemap" nodes tell the script to scan other Sitemap files.  This can
+    be useful to aggregate the results of multiple runs of this script into
+    a single Sitemap.
+
+    Required attributes:
+      path       - path to the file
+  -->
+  <sitemap    path="/var/www/docroot/subpath/sitemap.xml" />
+
+
+  <!-- ********************************************************
+          FILTERS
+
+  Filters specify wild-card patterns that the script compares
+  against all URLs it finds.  Filters can be used to exclude
+  certain URLs from your Sitemap, for instance if you have
+  hidden content that you hope the search engines don't find.
+
+  Filters can be either type="wildcard", which means standard
+  path wildcards (* and ?) are used to compare against URLs,
+  or type="regexp", which means regular expressions are used
+  to compare.
+
+  Filters are applied in the order specified in this file.
+
+  An action="drop" filter causes exclusion of matching URLs.
+  An action="pass" filter causes inclusion of matching URLs,
+  shortcutting any other later filters that might also match.
+  If no filter at all matches a URL, the URL will be included.
+  Together you can build up fairly complex rules.
+
+  The default action is "drop".
+  The default type is "wildcard".
+
+  You can MODIFY or DELETE these entries as appropriate for
+  your site.  However, unlike above, the example entries in
+  this section are not contrived and may be useful to you as
+  they are.
+  ********************************************************* -->
+
+  <!-- Exclude URLs that end with a '~'   (IE: emacs backup files)      -->
+  <filter  action="drop"  type="wildcard"  pattern="*~"           />
+
+  <!-- Exclude URLs within UNIX-style hidden files or directories       -->
+  <filter  action="drop"  type="regexp"    pattern="/\.[^/]*"     />
+
+</site>

collects/meta/build/sitemap/example_urllist.txt

@@ -0,0 +1,21 @@
+# To add a list of URLs, make a space-delimited text file. The first
+# column contains the URL; then you can specify various optional
+# attributes in the form key=value:
+#
+#  lastmod    = modification time in ISO8601 (YYYY-MM-DDThh:mm:ss+00:00)
+#  changefreq = 'always' | 'hourly' | 'daily' | 'weekly' | 'monthly' |
+#               'yearly' | 'never'
+#  priority   = priority of the page relative to other pages on the same site;
+#                a number between 0.0 and 1.0, where 0.0 is the lowest priority
+#                and 1.0 is the highest priority
+#
+# Note that all URLs must be part of the site, and therefore must begin with
+# the base_url (e.g., 'http://www.example.com/') as specified in config.xml.
+#
+# Any line beginning with a # is a comment.
+#
+# Example contents of the file:
+#
+# http://www.example.com/foo/bar
+# http://www.example.com/foo/xxx.pdf lastmod=2003-12-31T14:05:06+00:00
+# http://www.example.com/foo/yyy?x=12&y=23 changefreq=weekly priority=0.3

collects/meta/build/sitemap/plt-pre.xml

@@ -0,0 +1,16 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<site base_url="http://pre.plt-scheme.org/"
+      store_into="/home/scheme/html/sitemap.xml.gz"
+      verbose="1">
+  <directory path="/home/scheme/html/"
+             url="http://pre.plt-scheme.org/"
+             default_file="index.html" />
+  <!-- Exclude URLs that end with a '~' (IE: emacs backup files) -->
+  <filter  action="drop" type="wildcard" pattern="*~" />
+  <!-- Exclude URLs within UNIX-style hidden files or directories -->
+  <filter  action="drop" type="regexp" pattern="/\.[^/]*" />
+  <!-- Exclude .plt files -->
+  <filter  action="drop" type="wildcard" pattern="*.plt" />
+  <!-- Exclude possible nested trees -->
+  <filter  action="drop" type="regexp" pattern="^http://[^/]*/[0-9]+" />
+</site>

collects/meta/build/sitemap/setup.py

@@ -0,0 +1,12 @@
+#!/usr/bin/env python
+
+from distutils.core import setup
+
+setup(name='sitemap_gen',
+      version='1.4',
+      description='Sitemap Generator',
+      license='BSD',
+      author='Google Inc.',
+      author_email='opensource@google.com',
+      url='http://sourceforge.net/projects/goog-sitemapgen/',
+     )

collects/meta/build/sitemap/test_sitemap_gen.py

@@ -0,0 +1,765 @@
+#!/usr/bin/env python
+#
+# Copyright (c) 2004, 2005 Google Inc.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+#
+# * Redistributions of source code must retain the above copyright
+#   notice, this list of conditions and the following disclaimer.
+#
+# * Redistributions in binary form must reproduce the above copyright
+#   notice, this list of conditions and the following disclaimer in
+#   the documentation and/or other materials provided with the
+#   distribution.
+#
+# * Neither the name of Google nor the names of its contributors may
+#   be used to endorse or promote products derived from this software
+#   without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+# COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+#
+#
+# The sitemap_gen.py script is written in Python 2.2 and released to
+# the open source community for continuous improvements under the BSD
+# 2.0 new license, which can be found at:
+#
+#   http://www.opensource.org/licenses/bsd-license.php
+#
+
+"""Unit tests for sitemap_gen.py, a script for generating sitemaps
+for a web server.
+"""
+
+# Please be careful that all syntax used in this file can be parsed on
+# Python 1.5 -- this version check is not evaluated until after the
+# entire file has been parsed.
+import sys
+if sys.hexversion < 0x02020000:
+  print 'This script requires Python 2.2 or later.'
+  print 'Currently run with version: %s' % sys.version
+  sys.exit(1)
+
+import binascii
+import fnmatch
+import gzip
+import os
+import tempfile
+import unittest
+import xml.dom.minidom
+import sitemap_gen
+
+# True and False were introduced in Python2.2.2
+try:
+  testTrue=True
+  del testTrue
+except NameError:
+  True=1
+  False=0
+
+
+class URLCounter(object):
+  """Counts returned URLs, determines how many valid v. invalid we get.
+  This is a helper for consuming what the many Input* objects produce."""
+  def __init__(self, root, print_invalid, expected):
+    """Input:
+      root          :: root URL for calling the URL's own Validate()
+      print_invalid :: print to output all invalid URLs
+      expected      :: sequence of wildcard filters to validate against
+    """
+    self._root     = root
+    self._print    = print_invalid
+    self._expected = expected
+    self._valid    = 0
+    self._invalid  = 0
+  #end def __init__
+
+  def Reset(self):
+    """Reset our counts without harming the validity filters."""
+    self._valid   = 0
+    self._invalid = 0
+  #end def Reset
+
+  def Valid(self):
+    """Returns number of valid URLs."""
+    return self._valid
+  #end def Valid
+ 
+  def Invalid(self):
+    """Returns number of invalid URLs."""
+    return self._invalid
+  #end def Valid
+
+  def Count(self, url, allow_fragment):
+    """The 'please consume this URL' function called by the URL producer."""
+    valid = True
+    if valid:
+      valid = url.Validate(self._root, allow_fragment)
+    if valid:
+      for filter in self._expected:
+        valid = fnmatch.fnmatchcase(url.loc, filter)
+        if valid:
+          break
+    if valid:
+      self._valid = self._valid + 1
+    else:
+      if self._print:
+        url.Log(prefix='URLCounter', level=0)
+      self._invalid = self._invalid + 1
+  #end def Count
+#end class URLCounter
+
+
+class TestSiteMap(unittest.TestCase):
+  """Tests the sitemap_gen application."""
+
+  def testTimestampISO8601(self):
+    """ Checks whether the TimestampISO8601 function works. """
+    self.assertEqual(sitemap_gen.TimestampISO8601(23),
+                     '1970-01-01T00:00:23Z')
+    self.assertEqual(sitemap_gen.TimestampISO8601(549876543),
+                     '1987-06-05T07:29:03Z')
+  #end def testTimestampISO8601
+
+  def testExpandPathAttribute(self):
+    """ Verifies our path globbing function works. """
+    temppath = tempfile.mktemp()
+    tempwild = tempfile.tempdir
+    if tempwild:
+      tempwild = tempwild + os.sep
+    tempwild = tempwild + '*'
+    try:
+      open(temppath, 'w').close()
+
+      dict1 = {}
+      dict2 = {'alpha' : 'beta', 'path' : 'DoesNotExist987654321.xyz'}
+      dict3 = {'alpha' : 'beta', 'path' : tempwild}
+
+      res1  = sitemap_gen.ExpandPathAttribute(dict1, 'path')
+      res2  = sitemap_gen.ExpandPathAttribute(dict2, 'path')
+      res3  = sitemap_gen.ExpandPathAttribute(dict3, 'path')
+
+      self.assertEqual(len(res1), 1)
+      self.assertEqual(res1[0], dict1)
+
+      self.assertEqual(len(res2), 1)
+      self.assertEqual(res2[0], dict2)
+   
+      self.assert_(len(res3) >= 1)
+      anymatch = False
+      for res in res3:
+        path = res['path']
+        if path.find(temppath) >= 0:
+          anymatch = True
+        self.assertEqual(res['alpha'], 'beta')
+      self.assert_(anymatch)
+
+    finally:
+      os.unlink(temppath)
+  #end def testExpandPathAttribute
+
+  def testEncoder(self):
+    """ Tests minimal functionality of the learning Unicode codec """
+    ENC_UTF8      = 'UTF-8'
+    ENC_LATIN1    = 'ISO-8859-1'
+    ENC_CYRILLIC  = 'ISO-8859-5'
+
+    STR1_LATIN1   = 'has an ' + binascii.a2b_hex('FC') + 'mlat'
+    STR1_UTF8     = 'has an ' + binascii.a2b_hex('C3BC') + 'mlat'
+    STR1_UCS2     = 'has an ' + unichr(252) + 'mlat'
+
+    STR2_LATIN1   = 'DRAGON' + binascii.a2b_hex('A7') + '!'
+    STR2_CYRILLIC = 'DRAGON' + binascii.a2b_hex('FD') + '!'
+    STR2_UCS2     = 'DRAGON' + unichr(167) + '!'
+    
+    # Spawn our own encoder instance so we don't abuse the module one.
+    encoder = sitemap_gen.Encoder()
+
+    # Convert Latin-1 to UTF-8, by way of Unicode
+    encoder.SetUserEncoding(ENC_LATIN1)
+    self.assertEqual(encoder.WidenText(STR1_LATIN1, None), STR1_UCS2)
+    self.assertEqual(encoder.NarrowText(STR1_UCS2, ENC_UTF8), STR1_UTF8)
+
+    # Test learning.  STR1 has no Cyrillic equivalent, STR2 just changes.
+    encoder.SetUserEncoding(None)
+    encoder._learned = []
+    self.assertEqual(encoder.WidenText(STR2_CYRILLIC, ENC_CYRILLIC), STR2_UCS2)
+    self.assertEqual(encoder.WidenText(STR2_CYRILLIC, None), STR2_UCS2)
+    self.assertEqual(encoder.NarrowText(STR1_UCS2, None), STR1_UTF8)
+    self.assert_(not encoder._learned)
+    self.assertEqual(encoder.NarrowText(STR1_UCS2, ENC_LATIN1), STR1_LATIN1)
+    self.assertEqual(encoder.NarrowText(STR1_UCS2, None), STR1_LATIN1)
+    self.assertEqual(encoder.NarrowText(STR2_UCS2, None), STR2_LATIN1)
+  #end def testEncoder
+
+  def testURL(self):
+    """ Vigorously tests our URL attribute processing. """
+
+    # Test the IsAbsolute method
+    self.assert_(sitemap_gen.URL.IsAbsolute('http://a.b.c/d/e.txt?f=g#h'))
+    self.assert_(sitemap_gen.URL.IsAbsolute('http://a.b.c'))
+    self.assert_(not sitemap_gen.URL.IsAbsolute('http:///d/e.txt?f=g#h'))
+    self.assert_(not sitemap_gen.URL.IsAbsolute('http:a.b.c/d/e.txt?f=g#h'))
+    self.assert_(not sitemap_gen.URL.IsAbsolute('a.b.c/d/e.txt?f=g#h'))
+    self.assert_(not sitemap_gen.URL.IsAbsolute('/d/e.txt?f=g#h'))
+
+    # Canonicalize our base URL
+    BASE_R = 'http://www.example.com/f' + binascii.a2b_hex('F6F6') + '/'
+    BASE_C = 'http://www.example.com/f%F6%F6/'
+    sitemap_gen.encoder.SetUserEncoding('ISO-8859-1')
+    self.assertEqual(sitemap_gen.URL.Canonicalize(BASE_R), BASE_C)
+
+    # Test how canonicalization handles pre-quoted values
+    self.assertEqual(sitemap_gen.URL.Canonicalize(
+      'http://www.example.com/my%25thing'),
+      'http://www.example.com/my%25thing')
+    self.assertEqual(sitemap_gen.URL.Canonicalize(
+      'http://www.example.com/my%thing'),
+      'http://www.example.com/my%25thing')
+
+    # Test IDNA encoding
+    # The generator can only do the "right thing" on Python 2.3 or higher
+    warn = sitemap_gen.output.num_warns
+    if sys.hexversion >= 0x02030000:
+      self.assertEqual(sitemap_gen.URL.Canonicalize(
+        'http://www.' + unichr(252) + 'mlat.com/' + unichr(252) + 'mlat.txt'),
+        'http://www.xn--mlat-zra.com/%FCmlat.txt')
+      self.assertEqual(sitemap_gen.output.num_warns, warn)
+    else:
+      self.assertEqual(sitemap_gen.URL.Canonicalize(
+        'http://www.' + unichr(252) + 'mlat.com/' + unichr(252) + 'mlat.txt'),
+        'http://www.%FCmlat.com/%FCmlat.txt')
+      self.assertEqual(sitemap_gen.output.num_warns, warn + 2)
+
+    # All valid data
+    warn = sitemap_gen.output.num_warns
+    url1 = sitemap_gen.URL()
+    url1.TrySetAttribute('loc', BASE_R + 'bar.html')
+    url1.TrySetAttribute('lastmod', '1987-06-05T07:29:03Z')
+    url1.TrySetAttribute('changefreq', 'daily')
+    url1.TrySetAttribute('priority', '0.3')
+    self.assert_(url1.Validate(BASE_C, True))
+    self.assertEqual(sitemap_gen.output.num_warns, warn)
+
+    # Valid ref, all else invalid
+    warn = sitemap_gen.output.num_warns
+    url2 = sitemap_gen.URL()
+    url2.TrySetAttribute('loc', BASE_C + 'bar.html')
+    url2.TrySetAttribute('lastmod', 'June 1, 2005')
+    url2.TrySetAttribute('changefreq', 'every second')
+    url2.TrySetAttribute('priority', 'infinite')
+    url2.TrySetAttribute('badattr', 'Nope!')
+    self.assert_(url2.Validate(BASE_C, True))
+    self.assertEqual(sitemap_gen.output.num_warns, warn + 4)
+
+    # Two URLs with same ref should compare equal
+    self.assertEqual(url1, url2)
+
+    # A ref not based
+    warn = sitemap_gen.output.num_warns
+    url3 = sitemap_gen.URL()
+    url3.TrySetAttribute('loc', 'http://www.example.com/bar/foo.html')
+    self.assert_(not url3.Validate(BASE_C, True))
+    self.assertEqual(sitemap_gen.output.num_warns, warn + 1)
+
+    # A fragmentary URL
+    warn = sitemap_gen.output.num_warns
+    url4 = sitemap_gen.URL()
+    url4.TrySetAttribute('loc', '/foo.html')
+    self.assert_(not url4.Validate(BASE_C, False))
+    self.assertEqual(sitemap_gen.output.num_warns, warn + 1)
+    url4.TrySetAttribute('loc', '/xyzzy/foo.html')
+    self.assert_(url4.Validate('http://www.example.com/', True))
+    self.assertEqual(url4.loc, 'http://www.example.com/xyzzy/foo.html')
+    self.assertEqual(sitemap_gen.output.num_warns, warn + 1)
+
+    # Test a whole sequence of good and bad timestamp values
+    timestamps_good = [
+      '2001',
+      '2001-01',
+      '2001-01-02',
+      '2001-01-03T01:02Z',
+      '2001-01-03T01:02:03Z',
+      '2001-01-03T01:02:03.0123Z',
+      '2001-01-03T01:02+00:00',
+      '2001-01-03T01:02:03-99:99',
+      '2001-01-03T01:02:03.0123+88:88',
+      ]
+    timestamps_bad = [
+      '2001:01:03T01:02Z',
+      '2001-01-03T01:02:03.Z',
+      'a2001-01-06T01:02:05-99:99',
+      '2001-01-06T01:02:05-99:99Z',
+      '2001-1-6T01:02:05-99:99',
+      'xyzzy',
+      '2001-01-03T01:02:03.1.2Z',
+      ]
+    warn = sitemap_gen.output.num_warns
+    url3.TrySetAttribute('loc', BASE_C + 'foo.html')
+    for ts in timestamps_good:
+      url3.TrySetAttribute('lastmod', ts)
+      self.assert_(url3.Validate(BASE_C, True))
+    self.assertEqual(sitemap_gen.output.num_warns, warn)
+    for ts in timestamps_bad:
+      url3.TrySetAttribute('lastmod', ts)
+      self.assert_(url3.Validate(BASE_C, True))
+    self.assertEqual(sitemap_gen.output.num_warns, warn + len(timestamps_bad))
+  #end def testURL
+
+  def testFilter(self):
+    """ Test the filtering object """
+    url1 = sitemap_gen.URL()
+    url2 = sitemap_gen.URL()
+    url1.TrySetAttribute('loc', 'http://www.example.com/foo/bar.html')
+    url2.TrySetAttribute('loc', 'http://www.example.com/bar/foo.html')
+    url1.Validate('http://www.example.com', True)
+    url2.Validate('http://www.example.com', True)
+
+    # Arguments
+    error = sitemap_gen.output.num_errors
+    args_bad = [
+      {},
+      {'pattern' : '*', 'type' : 'unknown'},
+      {'pattern' : '*', 'type' : 'wildcard', 'action' : 'look pretty'},
+      {'pattern' : '*', 'type' : 'regexp'},
+      ]
+    error = sitemap_gen.output.num_errors
+    for args in args_bad:
+      sitemap_gen.Filter(args)
+    self.assertEqual(sitemap_gen.output.num_errors, error + len(args_bad))
+
+    # Wildcard
+    filt_w = sitemap_gen.Filter({'pattern' : '*/foo/*', 'type' : 'wildcard' })
+    self.assertEqual(filt_w.Apply(url1), False)
+    self.assertEqual(filt_w.Apply(url2), None)
+
+    # Regexp
+    filt_r = sitemap_gen.Filter({'pattern' : '/bar/[^/]+$', 'type' : 'REGEXP',
+                                 'action' : 'PASS'})
+    self.assertEqual(filt_r.Apply(url1), None)
+    self.assertEqual(filt_r.Apply(url2), True)
+  #end def testFilter
+
+  def Count(self, url, allow_fragment):
+    if url.Validate('http://www.example.com/', allow_fragment):
+      self.valid_urls = self.valid_urls + 1
+    else:
+      self.invalid_urls = self.invalid_urls + 1
+  #end def Count
+  valid_urls   = 0
+  invalid_urls = 0
+
+  def testInputURL(self):
+    """ Test one of the Input mechanisms: InputURL """
+    
+    # Feed a couple URLs.  Make sure we get an error on extra attributes.
+    self.valid_urls   = 0
+    self.invalid_urls = 0
+    error = sitemap_gen.output.num_errors
+    warn = sitemap_gen.output.num_warns
+    generator1 = sitemap_gen.InputURL({'href' : 'http://www.example.com/1',
+                                      'priority' : '0.3',
+                                      'lastmod' : '2004-11-14T01:00-07:00',
+                                      'changefreq' : 'hourly',
+                                      'unknownInURL' : 'attribute'})
+    generator2 = sitemap_gen.InputURL({'href' : 'http://www.example.com/2',
+                                      'priority' : '0.3',
+                                      'lastmod' : '2004-11-14T01:00-07:00',
+                                      'changefreq' : 'hourly'})
+    generator1.ProduceURLs(self.Count)
+    generator2.ProduceURLs(self.Count)
+    self.assertEqual(self.valid_urls, 1)
+    self.assertEqual(self.invalid_urls, 0)
+    self.assertEqual(sitemap_gen.output.num_errors, error + 1)
+    self.assertEqual(sitemap_gen.output.num_warns, warn)
+  #end def testInputURL
+
+  def testInputURLList(self):
+    """ Test one of the Input mechanisms: InputURLList """
+    path = tempfile.mktemp()
+    file = open(path, 'w')
+
+    try:
+      # Create a temp file we can read
+      testText = """
+http://www.example.com/foo/bar unknownInURLList=attribute
+http://www.example.com/foo/xxx.pdf lastmod=2003-12-31T14:05:06+00:00
+http://www.example.com/foo/yyy?x=12&y=23   changefreq=weekly   priority=0.3
+      """
+      file.write(testText)
+      file.close()
+      
+      # Feed in the data.  Make sure we get a warning on the bad attribute.
+      self.valid_urls   = 0
+      self.invalid_urls = 0
+      warn = sitemap_gen.output.num_warns
+      generator = sitemap_gen.InputURLList({'path' : path})
+      generator.ProduceURLs(self.Count)
+      self.assertEqual(self.valid_urls, 3)
+      self.assertEqual(self.invalid_urls, 0)
+      self.assertEqual(sitemap_gen.output.num_warns, warn + 1)
+
+    finally:
+      os.unlink(path)
+  #end def testInputURLList
+
+  def testInputDirectory(self):
+    """Test one of the Input mechanisms: InputDirectory.
+    I've seen a subtle path-bug appear when going into sub-sub-directories
+    that didn't under just sub-directories.  So we go to the trouble to
+    make a whole little directory tree to read.
+    """
+    counter = URLCounter('http://www.example.com/', True, (
+      'http://www.example.com/',
+      'http://www.example.com/one.html',
+      'http://www.example.com/two.html',
+      'http://www.example.com/xyzzy/',
+      'http://www.example.com/xyzzy/thr.html',
+      'http://www.example.com/xyzzy/zyxxy/',
+      'http://www.example.com/xyzzy/zyxxy/fiv.html',
+      ))
+    path = tempfile.mktemp()
+    subpath = os.path.join(path, 'xyzzy')
+    subsubpath = os.path.join(subpath, 'zyxxy')
+   
+    try:
+      # Create some dummy empty files
+      os.mkdir(path)
+      os.mkdir(subpath)
+      os.mkdir(subsubpath)
+      path_one = os.path.join(path, 'one.html')
+      path_two = os.path.join(path, 'two.html')
+      path_thr = os.path.join(subpath, 'thr.html')
+      path_for = os.path.join(subpath, 'default.html')
+      path_fiv = os.path.join(subsubpath, 'fiv.html')
+      open(path_one, 'w').close()
+      open(path_two, 'w').close()
+      open(path_thr, 'w').close()
+      open(path_for, 'w').close()
+      open(path_fiv, 'w').close()
+
+      # Feed in the data.  There should be no warnings.
+      warn = sitemap_gen.output.num_warns
+      generator = sitemap_gen.InputDirectory({'path' : path,
+        'url' : 'http://www.example.com/', 'default_file' : 'default.html'},
+        'http://www.example.com/')
+      generator.ProduceURLs(counter.Count)
+      self.assertEqual(counter.Valid(), 7)
+      self.assertEqual(counter.Invalid(), 0)
+      self.assertEqual(sitemap_gen.output.num_warns, warn)
+
+    finally:
+      os.unlink(path_one)
+      os.unlink(path_two)
+      os.unlink(path_thr)
+      os.unlink(path_for)
+      os.unlink(path_fiv)
+      os.rmdir(subsubpath)
+      os.rmdir(subpath)
+      os.rmdir(path)
+  #end def testInputDirectory
+
+  def testInputAccessLogCLF(self):
+    """ Test one of the Input mechanisms: InputAccessLog (Common logfile) """
+    path = tempfile.mktemp()
+    file = open(path, 'w')
+
+    try:
+      # Create a temp file we can read
+      testText = '''
+msnbot.msn.com - - [15/May/2005:07:46:50 -0700] "GET /~guest/main/ HTTP/1.0" 200 5670
+221.216.237.71 - - [15/May/2005:07:59:25 -0700] "GET /~guest/bookmark/ HTTP/1.1" 200 39195
+221.216.237.71 - - [15/May/2005:07:59:27 -0700] "GET /favicon.ico HTTP/1.1" 404 217
+c-67-161-121-105.hsd1.wa.comcast.net - - [15/May/2005:11:17:23 -0700] "GET /picts/top.jpg HTTP/1.1" 200 10044
+cpe-65-24-155-46.columbus.res.rr.com - - [16/May/2005:22:53:07 -0700] "HEAD http://www.example.com/~guest HTTP/1.1" 200 0
+      '''
+      file.write(testText)
+      file.close()
+      
+      # Feed in the data
+      self.valid_urls   = 0
+      self.invalid_urls = 0
+      warn = sitemap_gen.output.num_warns
+      generator = sitemap_gen.InputAccessLog({'path' : path})
+      generator.ProduceURLs(self.Count)
+      self.assertEqual(self.valid_urls, 4)
+      self.assertEqual(self.invalid_urls, 0)
+      self.assertEqual(sitemap_gen.output.num_warns, warn)
+
+    finally:
+      os.unlink(path)
+  #end def testInputAccessLogCLF
+
+  def testInputAccessLogELF(self):
+    """ Test one of the Input mechanisms: InputAccessLog (Extended logfile) """
+    path = tempfile.mktemp()
+    file = open(path, 'w')
+
+    try:
+      # Create a temp file we can read
+      testText = '''
+#Software: Microsoft Internet Information Services 6.0
+#Version: 1.0
+#Date: 2004-03-22 09:20:36
+#Fields: date time s-ip cs-method cs-uri-stem cs-uri-query s-port cs-username c-ip cs(User-Agent) sc-status sc-substatus sc-w
+in32-status
+2004-03-22 09:20:36 192.168.0.58 GET /Default.htm - 80 - 4.5.11.3 Mozilla/4.0+(compatible;+MSIE+5.5;+Windows+98) 200 0 64
+2004-03-22 09:22:58 192.168.0.58 GET /Default.htm - 80 - 24.87.160.82 Mozilla/4.0+(compatible;+MSIE+5.5;+Windows+98) 200 0 6
+4
+      '''
+      file.write(testText)
+      file.close()
+      
+      # Feed in the data
+      self.valid_urls   = 0
+      self.invalid_urls = 0
+      warn = sitemap_gen.output.num_warns
+      generator = sitemap_gen.InputAccessLog({'path' : path})
+      generator.ProduceURLs(self.Count)
+      self.assertEqual(self.valid_urls, 2)
+      self.assertEqual(self.invalid_urls, 0)
+      self.assertEqual(sitemap_gen.output.num_warns, warn)
+
+    finally:
+      os.unlink(path)
+  #end def testInputAccessLogELF
+
+  def testInputSitemap(self):
+    """ Test one of the Input mechanisms: InputSitemap """
+    path1 = tempfile.mktemp('.xml')
+    path2 = tempfile.mktemp('.xml')
+    path3 = tempfile.mktemp('.xml')
+    path4 = tempfile.mktemp('.xml')
+    file1 = None
+    file2 = None
+    file3 = None
+    file4 = None
+
+    index = '''<?xml version="1.0" encoding="UTF-8"?>
+<sitemapindex
+  xmlns="http://www.google.com/schemas/sitemap/0.84"
+  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+  xsi:schemaLocation="http://www.google.com/schemas/sitemap/0.84
+                     http://www.google.com/schemas/sitemap/0.84/siteindex.xsd">
+ <sitemap>
+  <loc>http://www.example.com/path/to/%(PATH2)s</loc>
+  <lastmod>2005-07-15T17:41:22Z</lastmod>
+ </sitemap>
+ <sitemap>
+  <loc>http://www.example.com/path/to/%(PATH3)s</loc>
+  <lastmod>2005-07-15T17:41:22Z</lastmod>
+ </sitemap>
+</sitemapindex>
+'''
+    content1 = '''<?xml version="1.0" encoding="UTF-8"?>
+<urlset
+  xmlns="http://www.google.com/schemas/sitemap/0.84"
+  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+  xsi:schemaLocation="http://www.google.com/schemas/sitemap/0.84
+                      http://www.google.com/schemas/sitemap/0.84/sitemap.xsd">
+ <url>
+  <loc>http://www.example.com/another/path/to/samplefile1.html</loc>
+  <lastmod>2005-07-13T00:00:12Z</lastmod>
+  <priority>0.5000</priority>
+ </url>
+ <url>
+  <loc>http://www.example.com/another/path/to/samplefile2.html</loc>
+  <lastmod>2004-11-16T20:22:06Z</lastmod>
+  <priority>0.5000</priority>
+ </url>
+</urlset>
+'''
+    content2 = '''<?xml version="1.0" encoding="UTF-8"?>
+<urlset
+  xmlns="http://www.google.com/schemas/sitemap/0.84"
+  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+  xsi:schemaLocation="http://www.google.com/schemas/sitemap/0.84
+                      http://www.google.com/schemas/sitemap/0.84/sitemap.xsd">
+ <url badSitemapAttr="Hello, World!">
+  <loc>http://www.example.com/another/path/to/samplefile3.html</loc>
+  <lastmod>2005-07-13T00:00:12Z</lastmod>
+  <priority>0.5000</priority>
+ </url>
+ <url>
+  <loc>http://www.example.com/another/path/to/samplefile4.html</loc>
+  <lastmod>2004-11-16T20:22:06Z</lastmod>
+  <priority>0.5000</priority>
+ </url>
+</urlset>
+'''
+    # This index is invalid because it points to another index file.
+    badindex = '''<?xml version="1.0" encoding="UTF-8"?>
+<sitemapindex
+  xmlns="http://www.google.com/schemas/sitemap/0.84"
+  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+  xsi:schemaLocation="http://www.google.com/schemas/sitemap/0.84
+                     http://www.google.com/schemas/sitemap/0.84/siteindex.xsd">
+ <sitemap>
+  <loc>http://www.example.com/path/to/%(PATH2)s</loc>
+  <lastmod>2005-07-15T17:41:22Z</lastmod>
+ </sitemap>
+ <sitemap>
+  <loc>http://www.example.com/path/to/%(PATH1)s</loc>
+  <lastmod>2005-07-15T17:41:22Z</lastmod>
+ </sitemap>
+</sitemapindex>
+'''
+
+    # Make a nice complicated set of two index files and two sitemaps.
+    try:
+      file1 = open(path1, 'wt')
+      file2 = open(path2, 'wt')
+      file3 = open(path3, 'wt')
+      file4 = open(path4, 'wt')
+      file1.write(index % {
+        'PATH1' : os.path.basename(path1),
+        'PATH2' : os.path.basename(path2),
+        'PATH3' : os.path.basename(path3)})
+      file2.write(content1)
+      file3.write(content2)
+      file4.write(badindex % {
+        'PATH1' : os.path.basename(path1),
+        'PATH2' : os.path.basename(path2),
+        'PATH3' : os.path.basename(path3)})
+      file1.close()
+      file1 = None
+      file2.close()
+      file2 = None
+      file3.close()
+      file3 = None
+      file4.close()
+      file4 = None
+
+      # Feed in the good data.  Make sure we get warned on the bad attribute.
+      self.valid_urls   = 0
+      self.invalid_urls = 0
+      warn = sitemap_gen.output.num_warns
+      generator = sitemap_gen.InputSitemap({'path' : path1})
+      generator.ProduceURLs(self.Count)
+      self.assertEqual(self.valid_urls, 4)
+      self.assertEqual(self.invalid_urls, 0)
+      self.assertEqual(sitemap_gen.output.num_warns, warn + 1)
+
+      # Feed in the bad data.  Should error once on the bad index and once
+      # because it aborts processing the XML.
+      self.valid_urls   = 0
+      self.invalid_urls = 0
+      errors = sitemap_gen.output.num_errors
+      generator = sitemap_gen.InputSitemap({'path' : path4})
+      generator.ProduceURLs(self.Count)
+      self.assertEqual(self.valid_urls, 2)
+      self.assertEqual(self.invalid_urls, 0)
+      self.assertEqual(sitemap_gen.output.num_errors, errors + 2)
+
+    finally:
+      if file1 is not None:
+        file1.close()
+      if file2 is not None:
+        file2.close()
+      if file3 is not None:
+        file3.close()
+      if os.path.exists(path1):
+        os.unlink(path1)
+      if os.path.exists(path2):
+        os.unlink(path2)
+      if os.path.exists(path3):
+        os.unlink(path3)
+  #end def testInputSitemap
+
+  def testFilePathGenerator(self):
+    """ Test our iteration of filenames """
+    gen1 = sitemap_gen.FilePathGenerator()
+    gen2 = sitemap_gen.FilePathGenerator()
+    gen3 = sitemap_gen.FilePathGenerator()
+    self.assert_(gen1.Preload('/tmp/bar/foo.xml'))
+    self.assert_(gen2.Preload('foo.xml.gz'))
+    self.assert_(gen3.Preload('/foo.gz'))
+    self.assert_(not gen1.is_gzip)
+    self.assert_(    gen2.is_gzip)
+    self.assert_(    gen3.is_gzip)
+    self.assertEqual(gen1.GeneratePath(0),
+                     os.path.normpath('/tmp/bar/foo.xml'))
+    self.assertEqual(gen2.GeneratePath(1),'foo1.xml.gz')
+    self.assertEqual(gen1.GeneratePath('_index.xml'),
+                     os.path.normpath('/tmp/bar/foo_index.xml'))
+    self.assertEqual(gen1.GenerateURL('_index.xml', 'http://www.example.com/'),
+                     'http://www.example.com/foo_index.xml')
+    self.assertEqual(gen1.GenerateURL(2, 'http://www.example.com/'),
+                     'http://www.example.com/foo2.xml')
+    self.assertEqual(gen2.GenerateWildURL('http://www.example.com/'),
+                     'http://www.example.com/foo*.xml.gz')
+  #end def testFilePathGenerator
+
+  def testSitemap(self):
+    """Test a basic config of the overall sitemap class."""
+    path1 = tempfile.mktemp()
+    path2 = tempfile.mktemp(".xml.gz")
+    file = open(path1, 'w')
+
+    try:
+      # Create a temp file we can read
+      testText = '''<?xml version="1.0" encoding="UTF-8"?>
+<site
+  base_url="http://www.example.com/"
+  store_into="%(OUTPUTFILENAME)s"
+  default_encoding="UTF-8"
+  verbose="3"
+>
+  <url href="http://www.example.com/.htaccess" />
+  <url href="http://www.example.com/foo/bar.html" />
+  <url href="http://www.example.com/foo/bar.gif" />
+  <url href="http://www.example.com/foo/bar.html" />
+  <url href="http://www.example.com/percent%%%%percent.html" />
+  <url href="http://www.example.com/&#252;mlat.html" />
+  <filter action="drop" type="regexp" pattern="/\.[^/]*$" />
+</site>
+'''
+      file.write(testText % {'OUTPUTFILENAME' : path2})
+      file.close()
+
+      # Bring up the engine
+      warn = sitemap_gen.output.num_warns
+      error = sitemap_gen.output.num_errors
+      sitemap = sitemap_gen.CreateSitemapFromFile(path1, True)
+      self.assert_(sitemap)
+      sitemap.Generate()
+      self.assertEqual(sitemap_gen.output.num_warns, warn)
+      self.assertEqual(sitemap_gen.output.num_errors, error)
+
+      # Verify we got readable XML out of it
+      file = gzip.open(path2, mode='rb')
+      result = file.read()
+      file.close()
+      dom = xml.dom.minidom.parseString(result)
+      self.assertEqual(len(dom.getElementsByTagName('url')), 4)
+      self.assert_(result.find('http://www.example.com/foo/bar.html') > 0)
+      self.assert_(result.find('http://www.example.com/foo/bar.gif') > 0)
+      self.assert_(result.find('%25%25') > 0)
+      self.assert_(result.find('%C3%BC') > 0)
+    finally:
+      if os.path.exists(path2):
+        os.unlink(path2)
+      os.unlink(path1)
+  #end def testSitemap
+    
+#end class TestSiteMap
+
+#
+# __main__
+#
+
+if __name__ == '__main__':
+  unittest.main()

collects/meta/build/test-drscheme.ss

@@ -0,0 +1,76 @@
+#!/bin/sh
+#| -*- scheme -*-
+exec "$PLTHOME/bin/mred" "$0"
+|#
+
+#lang mzscheme
+
+(require (lib "mred.ss" "mred") (lib "class.ss") (lib "port.ss") (lib "file.ss"))
+
+;; save the original error port to send messages
+(define stderr (current-error-port))
+(define (die fmt . args)
+  (apply fprintf stderr fmt args)
+  (newline stderr)
+  (exit 1))
+
+(define (cleanup)
+  (when (directory-exists? (find-system-path 'pref-dir))
+    (delete-directory/files (find-system-path 'pref-dir))))
+
+(define (my-handler e)
+  (cleanup)
+  (die "uncaught exception: ~a\n" (if (exn? e) (exn-message e) e)))
+
+(define-values (in out) (make-pipe))
+(thread
+ (lambda ()
+   (let* ([bytes (make-bytes 1000)]
+          [len/eof (sync (read-bytes-avail!-evt bytes in))])
+     (die "got some data printed to stdout/stderr:\n~a\n"
+          (if (eof-object? len/eof) len/eof (subbytes bytes 0 len/eof))))))
+
+(uncaught-exception-handler my-handler)
+(current-output-port out)
+(current-error-port out)
+
+;; must create eventspace after setting parameters, so its thread
+;; inherits the new settings
+(define es (make-eventspace))
+
+(current-eventspace es)
+(thread (lambda () (sleep 60) (die "timeout!")))
+
+;; make sure the preferences are such that we don't get the welcome screen
+(cleanup)
+(make-directory (find-system-path 'pref-dir))
+(with-output-to-file (find-system-path 'pref-file)
+  (lambda ()
+    (printf "~s\n" `((plt:framework-prefs
+                      ((drscheme:last-version ,(version))
+                       (drscheme:last-language english))))))
+  'truncate)
+
+;; start drscheme
+(queue-callback
+ (lambda ()
+   (dynamic-require '(lib "drscheme.ss" "drscheme") #f)))
+
+;; wait for the drscheme window to appear
+(define (window-title w) (send w get-label))
+(let loop ()
+  (sleep 1/100)
+  (let ([wins (get-top-level-windows)])
+    (cond [(null? wins) (loop)]
+          [(and (regexp-match #rx"^Untitled( - DrScheme)?$"
+                              (window-title (car wins)))
+                (null? (cdr wins)))
+           (fprintf stderr "got a good window: ~a\n"
+                    (window-title (car wins)))]
+          [else (die "bad windows popped up: ~s" (map window-title wins))])))
+
+;; handle some events
+(let loop ([n 20]) (unless (zero? n) (yield) (loop (sub1 n))))
+
+;; queue a low priority callback to exit sucessfully
+(queue-callback (lambda () (cleanup) (exit 0)) #f)

collects/meta/build/unix-installer/check-install-paths

@@ -0,0 +1,61 @@
+#!/bin/sh
+#| -*- scheme -*-
+tmp="/tmp/path-compare-$$"
+if [ -x "$PLTHOME/bin/mzscheme" ]; then
+  "$PLTHOME/bin/mzscheme" -r "$0" "$@"
+else
+  "mzscheme" -r "$0" "$@"
+fi > "$tmp" || exit 1
+cd "`dirname \"$0\"`"
+if diff "paths-configure-snapshot" "$tmp"; then
+     echo "PATHS OK"; rm "$tmp"; exit 0
+else echo "*** PATHS DATA MISMATCH (see $tmp) ***"; exit 1
+fi
+|#
+
+;; Extract path information from the configure script, so it can be compared
+;; to a snapshot and generate an error each time things change
+
+(define configure-path
+  (simplify-path
+   (build-path
+    ;; (find-executable-path
+    ;;  (find-system-path 'exec-file) (find-system-path 'collects-dir) #t)
+    (find-system-path 'exec-file)
+    'up 'up "src" "configure")))
+(unless (file-exists? configure-path)
+  (error "Cannot find `configure':" configure-path))
+
+(define current-match (make-parameter #f))
+(define (match? . bytess)
+  (cond [(regexp-match (byte-regexp (apply bytes-append bytess))
+                       (current-input-port))
+         => (lambda (m) (current-match (car m)) #t)]
+        [else #f]))
+(define (show-match)
+  (write-bytes (current-match)))
+
+(with-input-from-file configure-path
+  (lambda ()
+    (if (match? #"\n# Installation directory options.\n"
+                #"(?:#[^\n]*\n)+"
+                #"(?:[a-z]+=[^\n]+\n)+"
+                #"\n")
+      (show-match)
+      (error "Did not find first block"))
+    (if (match? #"\n#+ Install targets #+\n\n"
+                #"unixstyle=no\n"
+                #"if (?:[^\n]+\n)+fi\n\n"
+                #"MAKE_COPYTREE=no\n"
+                #"if [^\n]+\n"
+                #"(?: +[^\n]+\n)+"
+                #"else\n"
+                #"(?: +[^\n]+\n)+"
+                #"fi\n\n")
+      (show-match)
+      (error "Did not find second block"))
+    (if (match? #"\n +echo \">>> Installation targets:\"\n"
+                #"(?: +echo [^\n]+\n)+")
+      (show-match)
+      (error "Did not find third block"))))
+(exit)

collects/meta/build/unix-installer/paths-configure-snapshot

@@ -0,0 +1,109 @@
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# and all the variables that are supposed to be based on exec_prefix
+# by default will actually change.
+# Use braces instead of parens because sh, perl, etc. also accept them.
+# (The list follows the same order as the GNU Coding Standards.)
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datarootdir='${prefix}/share'
+datadir='${datarootdir}'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+docdir='${datarootdir}/doc/${PACKAGE}'
+infodir='${datarootdir}/info'
+htmldir='${docdir}'
+dvidir='${docdir}'
+pdfdir='${docdir}'
+psdir='${docdir}'
+libdir='${exec_prefix}/lib'
+localedir='${datarootdir}/locale'
+mandir='${datarootdir}/man'
+
+
+############## 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
+ # Newer autoconf uses datarootdir:
+ if test "${datadir}" = '${datarootdir}' ; then
+   if test "${datarootdir}" != '${prefix}/share' ; then
+    unixstyle=yes
+   fi
+ else
+   unixstyle=yes
+ fi
+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
+ if test "${mandir}" = '${datarootdir}/man' ; then
+   if test "${datarootdir}" != '${prefix}/share' ; then
+    unixstyle=yes
+   fi
+ else
+   unixstyle=yes
+ fi
+fi
+
+MAKE_COPYTREE=no
+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
+
+
+  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}"
+  echo "  and datarootdir = ${datarootdir}"

collects/meta/build/unix-installer/plt-installer-header

@@ -0,0 +1,485 @@
+
+###############################################################################
+## Utilities
+
+PATH=/usr/bin:/bin
+
+if [ "x`echo -n`" = "x-n" ]; then
+  echon() { /bin/echo "$*\c"; }
+else
+  echon() { echo -n "$*"; }
+fi
+
+rm_on_abort=""
+failwith() {
+  echo "Error: $*" 1>&2
+  if test ! "x$rm_on_abort" = "x" && test -e "$rm_on_abort"; then
+    echon "  (Removing installation files in $rm_on_abort)"
+    "$rm" -rf "$rm_on_abort"
+    echo ""
+  fi
+  exit 1
+}
+exithandler() {
+  failwith "Aborting..."
+}
+
+trap exithandler 2 3 9 15
+
+lookfor() {
+  save_IFS="${IFS}"
+  IFS=":"
+  for dir in $PATH; do
+    if test -x "$dir/$1"; then
+      eval "$1=$dir/$1"
+      IFS="$save_IFS"
+      return
+    fi
+  done
+  IFS="$save_IFS"
+  failwith "could not find \"$1\"."
+}
+
+link() { # args are source, target, where we are
+  "$rm" -f "$2"      || failwith "could not remove \"$2\" in \"$3\"."
+  "$ln" -s "$1" "$2" || failwith "could not link \"$2\" in \"$3\"."
+}
+
+lookfor rm
+lookfor ls
+lookfor ln
+lookfor tail
+lookfor cksum
+lookfor tar
+lookfor gunzip
+lookfor mkdir
+lookfor basename
+lookfor dirname
+
+# Need this to make new `tail' respect old-style command-line arguments.  Can't
+# use `tail -n #' because some old tails won't know what to do with that.
+_POSIX2_VERSION=199209
+export _POSIX2_VERSION
+
+origpwd="`pwd`"
+
+echo "This program will extract and install $DISTNAME."
+echo ""
+echo "Note: the required diskspace for this installation is about $ORIGSIZE."
+
+###############################################################################
+## What kind of installation?
+
+echo ""
+echo "Do you want a Unix-style distribution?"
+echo "  In this distribution mode files go into different directories according"
+echo "  to Unix conventions.  A \"plt-uninstall\" script will be generated to"
+echo "  make it possible to remove the installation.  If say 'no', the whole"
+echo "  PLT directory is kept as a single (movable and erasable) unit, possibly"
+echo "  with external links into it."
+if test ! "x$RELEASED" = "xyes"; then
+  echo "*** This is a nightly build: such a distribution is not recommended"
+  echo "*** because it cannot be used to install multiple versions."
+fi
+unixstyle="x"
+while test "$unixstyle" = "x"; do
+  echon "Enter yes/no (default: no) > "
+  read unixstyle
+  case "$unixstyle" in
+    [yY]* ) unixstyle="yes" ;;
+    [nN]* ) unixstyle="no"  ;;
+    "" )    unixstyle="no"  ;;
+    * )     unixstyle="x"   ;;
+  esac
+done
+
+###############################################################################
+## Where do you want it?
+
+echo ""
+if test "$unixstyle" = "yes"; then
+  echo "Where do you want to base your installation of $DISTNAME?"
+  echo "  (Use an existing directory.  If you've done such an installation in"
+  echo "   the past, either use the same place, or manually run"
+  echo "   'plt-uninstaller' now.)"
+  TARGET1="..."
+else
+  echo "Where do you want to install the \"$TARGET\" directory tree?"
+  TARGET1="$TARGET"
+fi
+echo "  1 - /usr/$TARGET1 [default]"
+echo "  2 - /usr/local/$TARGET1"
+echo "  3 - \$HOME/$TARGET1 ($HOME/$TARGET1)"
+echo "  4 - ./$TARGET1 (here)"
+if test "$unixstyle" = "yes"; then
+  echo "  Or enter a different directory prefix to install in."
+else
+  echo "  Or enter a different \"plt\" directory to install in."
+fi
+echon "> "
+read where
+case "$where" in
+  "" | "1" ) where="/usr" ;;
+  "2" ) where="/usr/local" ;;
+  "3" ) where="$HOME" ;;
+  "4" | "." ) where="`pwd`" ;;
+  "/"* )
+    if test "$unixstyle" = "no"; then
+      TARGET="`\"$basename\" \"$where\"`"
+      where="`\"$dirname\" \"$where\"`"
+    fi
+    ;;
+  * )
+    if test "$unixstyle" = "no"; then
+      TARGET="`\"$basename\" \"$where\"`"
+      where="`\"$dirname\" \"$where\"`"
+    fi
+    if test -d "$where"; then cd "$where"; where="`pwd`"; cd "$origpwd"
+    else where="`pwd`/$where"; fi
+    ;;
+esac
+
+if test "$unixstyle" = "no"; then
+  # can happen when choosing the root
+  if test "$TARGET" = "/"; then
+    failwith "refusing to remove your root"
+  fi
+fi
+
+# WHERE1 can be used with "$WHERE1/$TARGET" to avoid a double slash
+case "$where" in
+  "" )   failwith "internal error (empty \$where)" ;;
+  "/" )  WHERE1="" ;;
+  *"/" ) failwith "internal error (\$where ends in a slash)" ;;
+  "/"* ) WHERE1="$where" ;;
+  * )    failwith "internal error (\$where is not absolute)" ;;
+esac
+
+if test ! -d "$where"; then
+  failwith "the directory \"$where\" does not exist."
+fi
+if test ! -w "$where"; then
+  failwith "cannot write to \"$where\"."
+fi
+
+###############################################################################
+## Deal with Unix-style path questions
+
+set_prefix() {
+  where="$1"
+  # default dirs -- mimic configure behavior
+  bindir="$WHERE1/bin"
+  collectsdir="$WHERE1/lib/plt/collects"
+  if   test -d "$WHERE1/share"; then docdir="$WHERE1/share/plt/doc"
+  elif test -d "$WHERE1/doc";   then docdir="$WHERE1/doc/plt"
+  else                               docdir="$WHERE1/share/plt/doc"
+  fi
+  libdir="$WHERE1/lib"
+  includepltdir="$WHERE1/include/plt"
+  libpltdir="$WHERE1/lib/plt"
+  mandir="$WHERE1/man"
+  # The source tree is always removed -- no point keeping it if it won't work
+  # if   test -d "$WHERE1/share"; then srcdir="$WHERE1/share/plt/src"
+  # elif test -d "$WHERE1/src";   then srcdir="$WHERE1/src/plt"
+  # else                               srcdir="$WHERE1/share/plt/src"
+  # fi
+}
+
+dir_createable() {
+  test_dir="`\"$dirname\" \"$1\"`"
+  if test -d "$test_dir" && test -w "$test_dir"; then return 0
+  elif test "$test_dir" = "/"; then return 1
+  else dir_createable "$test_dir"; fi
+}
+
+show_dir_var() {
+  if   test -f   "$2"; then dir_status="(error: not a directory!)"; err="yes"
+  elif test ! -d "$2"; then
+    if dir_createable "$2"; then dir_status="(will be created)"
+    else                    dir_status="(error: not writable!)"; err="yes"; fi
+  elif test ! -w "$2"; then dir_status="(error: not writable!)"; err="yes"
+  else                      dir_status="(exists)"
+  fi
+  echo "  $1 $2 $dir_status"
+}
+
+read_dir() {
+  read new_dir
+  case "$new_dir" in
+    "/"* ) echo "$new_dir" ;;
+    * )    echo "$WHERE1/$new_dir" ;;
+  esac
+}
+
+if test "$unixstyle" = "yes"; then
+  set_prefix "$where"
+  # loop for possible changes
+  done="no"
+  while test ! "$done" = "yes"; do
+    echo ""
+    echo "Target Directories:"
+    err="no"
+    show_dir_var "[e] Executables  " "$bindir"
+    show_dir_var "[s] Scheme Code  " "$collectsdir"
+    show_dir_var "[d] Core Docs    " "$docdir"
+    show_dir_var "[l] C Libraries  " "$libdir"
+    show_dir_var "[h] C headers    " "$includepltdir"
+    show_dir_var "[o] Extra C Objs " "$libpltdir"
+    show_dir_var "[m] Man Pages    " "$mandir"
+    if test "$PNAME" = "full"; then
+      echo "  (C sources are not kept)"
+      # show_dir_var "[r] Source Tree  " "$srcdir"
+    fi
+    if test "$err" = "yes"; then echo "*** Errors in some paths ***"; fi
+    echo "Enter a new prefix, a letter to change an entry, enter to continue"
+    echon "> "
+    read change_what
+    case "$change_what" in
+      [eE]* ) echon "New directory: "; bindir="`read_dir`" ;;
+      [sS]* ) echon "New directory: "; collectsdir="`read_dir`" ;;
+      [dD]* ) echon "New directory: "; docdir="`read_dir`" ;;
+      [lL]* ) echon "New directory: "; libdir="`read_dir`" ;;
+      [hH]* ) echon "New directory: "; includepltdir="`read_dir`" ;;
+      [oO]* ) echon "New directory: "; libpltdir="`read_dir`" ;;
+      [mM]* ) echon "New directory: "; mandir="`read_dir`" ;;
+      # [rR]* ) if test "$PNAME" = "full"; then
+      #           echon "New directory: "; srcdir="`read_dir`"
+      #         else
+      #           echo "Invalid response"
+      #         fi ;;
+      "/"*  ) set_prefix "$change_what" ;;
+      ""    ) done="yes" ;;
+      *     ) echo "Invalid response" ;;
+    esac
+  done
+  if test "$err" = "yes"; then failwith "errors in some paths"; fi
+fi
+
+###############################################################################
+## Integrity check
+
+echo ""
+echon "Checking the integrity of the binary archive... "
+SUM="`\"$tail\" +\"$BINSTARTLINE\" \"$0\" | \"$cksum\"`" \
+  || failwith "problems running cksum."
+SUM="`set $SUM; echo $1`"
+test "$BINSUM" = "$SUM" || failwith "bad CRC checksum."
+echo "ok."
+
+###############################################################################
+## Unpacking into $where/$TARGET
+
+unpack_installation() {
+  # test that no TARGET exists
+  if test -d "$WHERE1/$TARGET" || test -f "$WHERE1/$TARGET"; then
+    echon "\"$WHERE1/$TARGET\" exists, delete? "
+    read yesno
+    case "$yesno" in
+      [yY]*)
+        echon "Deleting old \"$WHERE1/$TARGET\"... "
+        "$rm" -rf "$WHERE1/$TARGET" \
+        || failwith "could not delete \"$WHERE1/$TARGET\"."
+        echo "done."
+        ;;
+      *) failwith "aborting because \"$WHERE1/$TARGET\" exists." ;;
+    esac
+  fi
+  # unpack
+  echon "Unpacking into \"$WHERE1/$TARGET\"... "
+  rm_on_abort="$WHERE1/$TARGET"
+  "$mkdir" "$WHERE1/$TARGET"
+  "$tail" +"$BINSTARTLINE" "$0" | "$gunzip" -c \
+  | { cd "$WHERE1/$TARGET"
+      "$tar" xf - || failwith "problems during unpacking of binary archive."
+    }
+  cd "$WHERE1/$TARGET"
+  test -d "collects" \
+    || failwith "unpack failed (could not find \"$WHERE1/$TARGET/collects\")."
+  echo "done."
+}
+
+###############################################################################
+## Whole-directory installations
+
+wholedir_install() {
+
+unpack_installation
+rm_on_abort=""
+
+cd "$where"
+if test -d "bin"; then
+  echo "Do you want to install new system links within the bin, lib, include,"
+  echo "  man, and doc subdirectories of \"$where\", possibly overriding"
+  echon "  existing links? "
+  read yesno
+  case "$yesno" in
+    [yY]* ) sysdir="$where" ;;
+    * ) sysdir="" ;;
+  esac
+else
+  cd "$origpwd"
+  echo ""
+  echo "If you want to install new system links within the bin, lib, include,"
+  echo "  man, and doc subdirectories of a common directory prefix (for"
+  echo "  example, \"/usr/local\") then enter the prefix you want to use."
+  echon "(default: skip links) > "
+  read sysdir
+  if test ! "x$sysdir" = "x"; then
+    if test ! -d "$sysdir"; then
+      echo "Directory \"$sysdir\" does not exist, skipping links."
+      sysdir=""
+    elif test ! -w "$sysdir"; then
+      echo "Directory \"$sysdir\" is not writable, skipping links."
+      sysdir=""
+    else
+      cd "$sysdir"
+      sysdir="`pwd`"
+    fi
+  fi
+fi
+
+if test ! "x$sysdir" = "x"; then
+  # binaries
+  cd "$sysdir"
+  if test -d "bin" && test -w "bin"; then
+    echo "Installing links in \"$sysdir/bin\"..."
+    printsep="  "
+    cd "bin"
+    for x in `cd "$WHERE1/$TARGET/bin"; ls`; do
+      if test -x "$WHERE1/$TARGET/bin/$x"; then
+        echon "${printsep}$x"
+        printsep=", "
+        link "$WHERE1/$TARGET/bin/$x" "$x" "$sysdir/bin"
+      fi
+    done
+    echo ""
+    echo "Done. (see \"$WHERE1/$TARGET/bin\" for other executables)"
+  else
+    echo "Skipping \"$sysdir/bin\" (does not exist or not writable)."
+  fi
+  # man pages
+  cd "$sysdir"
+  if test -d "man" && test -d "man/man1" && test -w "man/man1"; then
+    mandir="man/man1"
+  elif test -d "share" && test -d "share/man" && test -d "share/man/man1" \
+       && test -w "share/man/man1"; then
+    mandir="share/man/man1"
+  else
+    mandir=""
+  fi
+  if test "x$mandir" = "x"; then
+    echo "Skipping \"$sysdir/man/man1\" (does not exist or not writable)."
+  else
+    cd "$mandir"
+    echo "Installing links in \"$sysdir/$mandir\"..."
+    printsep="  "
+    for x in `cd "$WHERE1/$TARGET/man/man1/"; "$ls"`; do
+      echon "${printsep}$x"
+      printsep=", "
+      link "$WHERE1/$TARGET/man/man1/$x" "$x" "$sysdir/$mandir"
+    done
+    echo ""
+    echo "Done"
+  fi
+  # lib link
+  cd "$sysdir"
+  if test -d "lib" && test -w "lib"; then
+    libdir="lib"
+  elif test -d "share" && test -d "share/lib" && test -w "share/lib"; then
+    libdir="share/lib"
+  else
+    libdir=""
+  fi
+  if test "x$libdir" = "x"; then
+    echo "Skipping \"$sysdir/lib\" (does not exist or not writable)."
+  else
+    cd "$libdir"
+    echo "Installing \"$sysdir/$libdir/$TARGET\"."
+    link "$WHERE1/$TARGET/lib" "$TARGET" "$sysdir/$libdir"
+  fi
+  # include link
+  cd "$sysdir"
+  if test -d "include" && test -w "include"; then
+    incdir="include"
+  elif test -d "share" && test -d "share/include" \
+       && test -w "share/include"; then
+    incdir="share/include"
+  else
+    incdir=""
+  fi
+  if test "x$incdir" = "x"; then
+    echo "Skipping \"$sysdir/include\" (does not exist or not writable)."
+  else
+    cd "$incdir"
+    echo "Installing \"$sysdir/$incdir/$TARGET\"."
+    link "$WHERE1/$TARGET/include" "$TARGET" "$sysdir/$incdir"
+  fi
+  # doc link
+  cd "$sysdir"
+  if test -d "doc" && test -w "doc"; then
+    docdir="doc"
+  elif test -d "share" && test -d "share/doc" && test -w "share/doc"; then
+    docdir="share/doc"
+  else
+    docdir=""
+  fi
+  if test "x$docdir" = "x"; then
+    echo "Skipping \"$sysdir/doc\" (does not exist or not writable)."
+  else
+    cd "$docdir"
+    echo "Installing \"$sysdir/$docdir/$TARGET\"."
+    link "$WHERE1/$TARGET/notes" "$TARGET" "$sysdir/$docdir"
+  fi
+fi
+
+}
+
+###############################################################################
+## Unix-style installations
+
+unixstyle_install() {
+
+TARGET="$TARGET-tmp-install"
+if test -e "$WHERE1/$TARGET"; then
+  echo "\"$WHERE1/$TARGET\" already exists (needed for the installation),"
+  echon "  ok to remove? "
+  read R
+  case "$R" in
+    [yY]* ) "$rm" -rf "$WHERE1/$TARGET" ;;
+    * ) failwith "abort..." ;;
+  esac
+fi
+
+if test -x "$bindir/plt-uninstall"; then
+  echo "A previous PLT uninstaller is found at \"$bindir/plt-uninstall\","
+  echon "  ok to run it? "
+  read R
+  case "$R" in
+    [yY]* ) echon "  running uninstaller..."
+            "$bindir/plt-uninstall" || failwith "problems during uninstall"
+            echo " done." ;;
+    * ) failwith "abort..." ;;
+  esac
+fi
+
+unpack_installation
+
+cd "$where"
+"$TARGET/bin/mzscheme" "$TARGET/collects/setup/unixstyle-install.ss" \
+  "move" "$WHERE1/$TARGET" "$bindir" "$collectsdir" "$docdir" "$libdir" \
+  "$includepltdir" "$libpltdir" "$mandir" \
+|| failwith "installation failed"
+
+}
+
+###############################################################################
+## Done
+
+if test "$unixstyle" = "yes"; then unixstyle_install; else wholedir_install; fi
+
+echo ""
+echo "All done."
+
+exit
+
+========== tar.gz file follows ==========

collects/meta/build/versionpatch

@@ -0,0 +1,104 @@
+#!/bin/sh
+#| -*- scheme -*-
+exec racket -um "$0" "$@"
+|#
+
+#lang scheme/base
+(require version/utils scheme/file)
+
+(define (patches)
+  ;; no grouping parens in regexps
+  (let* ([3parts? (regexp-match? #rx"^[0-9]+\\.[0-9]+\\.[0-9]+$" the-version)]
+         [concat
+          (lambda xs
+            (apply bytes-append
+                   (map (lambda (x) (if (string? x) (string->bytes/utf-8 x) x))
+                        xs)))]
+         [commas  "<1>, *<2>, *<3>, *<4>"]
+         [periods "<1>.<2>.<3>.<4>"]
+         [rc-patch (list (concat "\r\n *FILEVERSION "commas" *"
+                                 "\r\n *PRODUCTVERSION "commas" *\r\n")
+                         (concat "\r\n *VALUE \"FileVersion\", *\""commas
+                                 "(?:\\\\0)?\"")
+                         (concat "\r\n *VALUE \"ProductVersion\", *\""commas
+                                 "(?:\\\\0)?\""))])
+    `([#t ; only verify that it has the right contents
+       "src/racket/src/schvers.h"
+       ,(concat  "\n#define MZSCHEME_VERSION \"<1>.<2>.<3>"
+                 (if 3parts? "" ".<4>") "\"\n")
+       ,@(map (lambda (x+n)
+                (format "\n#define MZSCHEME_VERSION_~a ~a\n"
+                        (car x+n)
+                        (if (and 3parts? (eq? 4 (cadr x+n)))
+                          "0" (format "<~a>" (cadr x+n)))))
+              '([X 1] [Y 2] [Z 3] [W 4]))]
+      ["src/worksp/racket/racket.rc"   ,@rc-patch]
+      ["src/worksp/gracket/gracket.rc" ,@rc-patch]
+      ["src/worksp/starters/start.rc"    ,@rc-patch]
+      ["src/worksp/gracket/gracket.manifest"
+       ,(concat "assemblyIdentity *\r\n *version *= *\""periods"\" *\r\n")]
+      ["src/worksp/mzcom/mzobj.rgs"
+       ,(concat "MzCOM.MzObj."periods" = s 'MzObj Class'")
+       ,(concat "CurVer = s 'MzCOM.MzObj."periods"'")
+       ,(concat "ProgID = s 'MzCOM.MzObj."periods"'")]
+      ["src/worksp/mzcom/mzcom.rc"       ,@rc-patch
+       #"\r\n *CTEXT +\"MzCOM v. <1>.<2>\",IDC_STATIC"
+       #"\r\n *CTEXT +\"Racket v. <1>.<2>\",IDC_STATIC"])))
+
+(define the-version #f)
+
+(define getv
+  (let ([vlist #f])
+    (lambda (i)
+      (unless vlist
+        (set! vlist (map (compose string->bytes/utf-8 number->string)
+                         (version->list the-version))))
+      (list-ref vlist i))))
+
+(define (replace-pattern pattern buf err)
+  (let* ([rx (regexp-replace* #rx#"<[1234]>" pattern #"([0-9]+)")]
+         [vs (map (lambda (m)
+                    (let* ([m (regexp-replace #rx#"^<(.+)>$" m #"\\1")]
+                           [m (string->number (bytes->string/utf-8 m))])
+                      (sub1 m)))
+                  (regexp-match* #rx#"<[1234]>" pattern))]
+         [m  (regexp-match-positions rx buf)])
+    (cond
+      [(not m) (err "pattern ~s not found" pattern)]
+      [(regexp-match? rx buf (cdar m))
+       (err "pattern ~s matches more than once" pattern)]
+      [else (let loop ([m (cdr m)] [i 0] [vs vs] [r '()])
+              (cond [(and (null? m) (null? vs))
+                     (apply bytes-append (reverse (cons (subbytes buf i) r)))]
+                    [(or (null? m) (null? vs)) (error "internal error")]
+                    [else (loop (cdr m) (cdar m) (cdr vs)
+                                (list* (getv (car vs))
+                                       (subbytes buf i (caar m))
+                                       r))]))])))
+
+(define (do-patch file . specs)
+  (let* ([only-verify? (eq? file #t)]
+         [file  (if only-verify? (car specs) file)]
+         [specs (if only-verify? (cdr specs) specs)]
+         [_ (begin (printf "  ~a..." file) (flush-output))]
+         [contents (file->bytes file)]
+         [buf contents]
+         [err (lambda (fmt . args)
+                (error 'versionpatch "~a, in ~s"
+                       (apply format fmt args) file))])
+    (for ([spec (in-list specs)]) (set! buf (replace-pattern spec buf err)))
+    (if (equal? buf contents)
+      (printf (if only-verify? " verified.\n" " no change.\n"))
+      (begin (printf " modified.\n")
+             (if only-verify?
+               (error 'versionpatch
+                      "this file is expected to have a correct version")
+               (with-output-to-file file (lambda () (write-bytes buf))
+                                    #:exists 'truncate))))))
+
+(provide main)
+(define (main ver)
+  (set! the-version ver)
+  ;; (printf "Patching files for ~a...\n" ver)
+  (for ([p (in-list (patches))]) (apply do-patch p))
+  (printf "Done.\n"))