diff --git a/collects/meta/props b/collects/meta/props index f8136e49b0..b22d672878 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -976,6 +976,7 @@ path/s is either such a string or a list of them. "collects/meta/check-dists.rkt" drdr:command-line #f "collects/meta/contrib/completion/racket-completion.bash" responsible (samth sstrickl) drdr:command-line #f "collects/meta/drdr" responsible (jay) drdr:command-line #f +"collects/meta/web/build.rkt" drdr:command-line #f "collects/mred" responsible (mflatt) "collects/mred/edit-main.rkt" drdr:command-line (mzc *) "collects/mred/edit.rkt" drdr:command-line (gracket-text "-t" *) diff --git a/collects/meta/web/build.rkt b/collects/meta/web/build.rkt new file mode 100755 index 0000000000..5e3c9367b0 --- /dev/null +++ b/collects/meta/web/build.rkt @@ -0,0 +1,70 @@ +#!/bin/sh +#| +exe="racket"; +if [ -x "$PLTHOME/bin/racket" ]; then exe="$PLTHOME/bin/racket"; fi +exec "$exe" "$0" "$@" +|# + +#lang racket/base + +(require racket/cmdline racket/runtime-path + racket/string racket/file + "html/resource.rkt" "config.rkt" "navbar.rkt") + +(define build-mode #f) +(define distribute? #f) +(define warn? #t) + +(command-line + #:once-any + [("-l" "--local") + "create content that is viewable in the build directory" + " (all links are relative) " + (set! build-mode 'local)] + [("-w" "--web") + "create content that is viewable on the Racket web pages" + (set! build-mode 'web)] + #:once-each + [("-o" "--output") dir + "output directory" + " (defaults to the current directory)" + (unless (directory-exists? dir) + (printf "Creating \"~a\"\n" dir) (make-directory dir)) + (current-directory dir)] + [("-f") + "avoid warning about directory cleanup" + (set! warn? #f)] + [("-d" "--dist") + "distribute resulting content" + " (will only work with the right access to the servers)" + (set! distribute? #t)]) + +(unless build-mode (raise-user-error 'build "build mode not specified")) + +(define-runtime-path here ".") +(let ([build (file-or-directory-identity (current-directory))]) + (let loop ([dir here]) + (if (equal? build (file-or-directory-identity dir)) + (raise-user-error 'build "might clobber sources, refusing to build") + (let-values ([(base name dir?) (split-path dir)]) + (when base (loop base)))))) + +(let ([paths (sort (map path->string (directory-list)) string