suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add a flag for an extra file to include for the rendering.

Browse Source 
(The extra file is just required dynamically, and it is supposed to
register resources for rendering etc.)
This commit is contained in:
Eli Barzilay 2010-06-26 10:35:37 -04:00
parent 95577a0aad
commit fdb8751de3
1 changed files with 26 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/meta/web/build.rkt
View File

@ -13,8 +13,10 @@ exec "$exe" "$0" "$@"
"config.rkt" "navbar.rkt") "config.rkt" "navbar.rkt")
(define build-mode #f) (define build-mode #f)
(define output-dir (current-directory))
(define distribute? #f) (define distribute? #f)
(define warn? #t) (define warn? #t)
(define extra-file #f)
(command-line (command-line
#:once-any #:once-any
@ -31,26 +33,30 @@ exec "$exe" "$0" "$@"
" (defaults to the current directory)" " (defaults to the current directory)"
(unless (directory-exists? dir) (unless (directory-exists? dir)
(printf "Creating \"~a\"\n" dir) (make-directory dir)) (printf "Creating \"~a\"\n" dir) (make-directory dir))
(current-directory dir)] (set! output-dir dir)]
[("-f") [("-f")
"avoid warning about directory cleanup" "avoid warning about directory cleanup"
(set! warn? #f)] (set! warn? #f)]
[("-d" "--dist") [("-d" "--dist")
"distribute resulting content" "distribute resulting content"
" (will only work with the right access to the servers)" " (will only work with the right access to the servers)"
(set! distribute? #t)]) (set! distribute? #t)]
[("-e" "--extra") extra
"extra file to render more content"
(set! extra-file extra)])
(unless build-mode (raise-user-error 'build "build mode not specified")) (unless build-mode (raise-user-error 'build "build mode not specified"))
(define-runtime-path here ".") (define-runtime-path here ".")
(let ([build (file-or-directory-identity (current-directory))]) (let ([build (file-or-directory-identity output-dir)])
(let loop ([dir here]) (let loop ([dir here])
(if (equal? build (file-or-directory-identity dir)) (if (equal? build (file-or-directory-identity dir))
(raise-user-error 'build "might clobber sources, refusing to build") (raise-user-error 'build "might clobber sources, refusing to build")
(let-values ([(base name dir?) (split-path dir)]) (let-values ([(base name dir?) (split-path dir)])
(when base (loop base)))))) (when base (loop base))))))
(let ([paths (sort (map path->string (directory-list)) string<?)]) (parameterize ([current-directory output-dir])
(let ([paths (sort (map path->string (directory-list)) string<?)])
(when (pair? paths) (when (pair? paths)
(if (or (not warn?) (if (or (not warn?)
(begin (printf "Directory not empty, these will be deleted: ~a.\n" (begin (printf "Directory not empty, these will be deleted: ~a.\n"
@ -58,9 +64,15 @@ exec "$exe" "$0" "$@"
(printf "Continue? ") (flush-output) (printf "Continue? ") (flush-output)
(regexp-match? #rx" *[yY]" (read-line)))) (regexp-match? #rx" *[yY]" (read-line))))
(for-each delete-directory/files paths) (for-each delete-directory/files paths)
(raise-user-error 'build "Aborting.")))) (raise-user-error 'build "Aborting.")))))
(printf "Building ~a content...\n" build-mode) (printf "Building ~a content...\n" build-mode)
(parameterize ([url-roots (and (eq? 'web build-mode) sites)]) (render-all)) (parameterize ([url-roots (and (eq? 'web build-mode) sites)])
(when distribute? (printf "Distributing...\n") (distribute distributions)) (when (and extra-file (file-exists? extra-file))
(dynamic-require extra-file #f))
(parameterize ([current-directory output-dir])
(render-all)
(when distribute?
(printf "Distributing...\n")
(distribute distributions))))
(printf "Done.\n") (printf "Done.\n")