80 lines
2.6 KiB
Racket
Executable File
80 lines
2.6 KiB
Racket
Executable File
#!/bin/sh
|
|
#| -*- scheme -*-
|
|
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/file scribble/html
|
|
"common/distribute.rkt" "config.rkt" "all.rkt")
|
|
|
|
(define build-mode #f)
|
|
(define output-dir (current-directory))
|
|
(define distribute? #f)
|
|
(define warn? #t)
|
|
(define extra-file #f)
|
|
|
|
(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))
|
|
(set! output-dir dir)]
|
|
[("-f" "--force")
|
|
"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)]
|
|
[("-e" "--extra") extra
|
|
"extra file to render more content"
|
|
(set! extra-file extra)]
|
|
#:help-labels
|
|
" ** Note: set $KNOWN_MIRRORS_FILE to a file if you want to poll mirror"
|
|
" links (see top comment in \"download/mirror-link.rkt\").")
|
|
|
|
(unless build-mode (raise-user-error 'build "build mode not specified"))
|
|
|
|
(define-runtime-path here ".")
|
|
(let ([build (file-or-directory-identity output-dir)])
|
|
(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))))))
|
|
|
|
(parameterize ([current-directory output-dir])
|
|
(let ([paths (sort (map path->string (directory-list)) string<?)])
|
|
(when (pair? paths)
|
|
(if (or (not warn?)
|
|
(begin (printf "Directory not empty, these will be deleted: ~a.\n"
|
|
(string-join paths ", "))
|
|
(printf "Continue? ") (flush-output)
|
|
(regexp-match? #rx" *[yY]" (read-line))))
|
|
(for-each delete-directory/files paths)
|
|
(raise-user-error 'build "Aborting.")))))
|
|
|
|
(printf "Building ~a content...\n" build-mode)
|
|
(parameterize ([url-roots (and (eq? 'web build-mode) sites)])
|
|
(when (and extra-file (file-exists? extra-file))
|
|
(dynamic-require `(file ,extra-file) #f))
|
|
(parameterize ([current-directory output-dir])
|
|
(render-all)
|
|
(when distribute?
|
|
(printf "Distributing...\n")
|
|
(distribute (distributions)))))
|
|
(printf "Done.\n")
|