Add a flag for an extra file to include for the rendering.
(The extra file is just required dynamically, and it is supposed to register resources for rendering etc.)
This commit is contained in:
parent
95577a0aad
commit
fdb8751de3
|
@ -13,8 +13,10 @@ exec "$exe" "$0" "$@"
|
|||
"config.rkt" "navbar.rkt")
|
||||
|
||||
(define build-mode #f)
|
||||
(define output-dir (current-directory))
|
||||
(define distribute? #f)
|
||||
(define warn? #t)
|
||||
(define extra-file #f)
|
||||
|
||||
(command-line
|
||||
#:once-any
|
||||
|
@ -31,36 +33,46 @@ exec "$exe" "$0" "$@"
|
|||
" (defaults to the current directory)"
|
||||
(unless (directory-exists? dir)
|
||||
(printf "Creating \"~a\"\n" dir) (make-directory dir))
|
||||
(current-directory dir)]
|
||||
(set! output-dir 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)])
|
||||
(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"))
|
||||
|
||||
(define-runtime-path here ".")
|
||||
(let ([build (file-or-directory-identity (current-directory))])
|
||||
(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))))))
|
||||
|
||||
(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."))))
|
||||
(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)]) (render-all))
|
||||
(when distribute? (printf "Distributing...\n") (distribute distributions))
|
||||
(parameterize ([url-roots (and (eq? 'web build-mode) sites)])
|
||||
(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")
|
||||
|
|
Loading…
Reference in New Issue
Block a user