improve handling of source-dir argument in raco pollen publish

pull/160/head
Matthew Butterick 7 years ago
parent 3b6de79fdd
commit ed52c1dedd

@ -148,14 +148,16 @@ version print the version" (current-server-port) (make-publish-di
(displayln "Starting project server ...")
((dynamic-require 'pollen/private/project-server 'start-server) (format "/~a" (setup:main-pagetree dir)) launch-wanted)))
(define (make-publish-dir-name [arg-command-name #f])
(let ([user-publish-path (expand-user-path (->path (setup:publish-directory)))])
(if (complete-path? user-publish-path)
user-publish-path
(build-path (find-system-path 'desk-dir)
(->path (if (equal? arg-command-name "clone") ; bw compat
"clone"
user-publish-path))))))
(define (make-publish-dir-name [project-root (current-directory)] [arg-command-name #f])
(define user-publish-path
(expand-user-path (->path (setup:publish-directory project-root))))
(if (complete-path? user-publish-path)
user-publish-path
(build-path (find-system-path 'desk-dir)
(->path (if (equal? arg-command-name "clone") ; bw compat
"clone"
user-publish-path)))))
(define (delete-it path)
@ -185,9 +187,11 @@ version print the version" (current-server-port) (make-publish-di
other-args))
;; other-args looks like (list [maybe-source-dir-arg] [maybe-dest-dir-arg])
(define source-dir (simplify-path (get-first-arg-or-current-dir other-args)))
(define dest-dir (simplify-path
(with-handlers ([exn:fail? (λ (exn) (make-publish-dir-name command-name))])
(path->complete-path (string->path (cadr other-args))))))
(define dest-dir
(simplify-path
;; the source-dir might have its own pollen.rkt specifying a publish destination
(with-handlers ([exn:fail? (λ (exn) (make-publish-dir-name source-dir command-name))])
(path->complete-path (string->path (cadr other-args))))))
(unless (directory-exists? source-dir)
(error 'publish (format "source directory ~a does not exist" source-dir)))
@ -216,7 +220,11 @@ version print the version" (current-server-port) (make-publish-di
(when (directory-exists? dest-dir)
(delete-directory/files dest-dir))
(copy-directory/files source-dir dest-dir)
(parameterize ([current-project-root (current-directory)])
;; if source-dir is provided, we want it to be treated as current-directory.
;; if no source-dir is provided, it is set to current-directory,
;; so the parameterize is a no-op.
(parameterize* ([current-directory source-dir]
[current-project-root (current-directory)])
(define (delete-from-publish-dir? p)
(and (omitted-path? p) (not (extra-path? p))))
(for-each delete-it (find-files delete-from-publish-dir? dest-dir)))

@ -1 +1 @@
1508997122
1509468257

Loading…
Cancel
Save