From 03a550f219a17d6a115e5fd9cf3cf114db9b3bbb Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 27 Mar 2014 15:38:25 -0700 Subject: [PATCH] hupdates --- command.rkt | 89 +++++++++++------------------------------------------ file.rkt | 15 +++++++-- raco.rkt | 12 +++++--- world.rkt | 2 ++ 4 files changed, 41 insertions(+), 77 deletions(-) diff --git a/command.rkt b/command.rkt index 71f29b5..710b4d7 100644 --- a/command.rkt +++ b/command.rkt @@ -11,15 +11,15 @@ render [dir] render project in dir (default is current dir) render path render file clone copy project to desktop without source files" ,(world:current-server-port)))) -(define (handle-render dir-or-path [port #f]) +(define (handle-render dir-or-path rest-args) `(begin (require pollen/render pollen/world pollen/file sugar) (parameterize ([current-directory (world:current-project-root)]) (define dir-or-path ,dir-or-path) (apply render-batch (map ->complete-path (if (not (directory-exists? dir-or-path)) (begin - (displayln (format "Rendering ~a" dir-or-path)) - (list dir-or-path)) + (displayln (format "Rendering ~a" dir-or-path)) + (cons dir-or-path ',rest-args)) (begin (displayln (format "Rendering preproc & pagetree files in directory ~a" dir-or-path)) (apply append (map (λ(proc) (filter proc (directory-list dir-or-path))) (list preproc-source? pagetree-source?)))))))))) @@ -35,39 +35,25 @@ clone copy project to desktop without source files" ,(world:curr (start-server))))) -(define (handle-clone directory target) - (define target-path (or (and target (path->complete-path (string->path target))) - (build-path (find-system-path 'desk-dir) (string->path "clone")))) +(define (handle-clone directory rest-args) + (define target-path (or + (and rest-args (not (null? rest-args)) (path->complete-path (string->path (car rest-args)))) + (build-path (find-system-path 'desk-dir) (string->path world:clone-directory-name)))) `(begin - (displayln "Clone & prune ...") + (displayln "Cloning ...") (require racket/file pollen/file) - - (define (pollen-related-file? file) - (ormap (λ(proc) (proc file)) (list - preproc-source? - markup-source? - markdown-source? - template-source? - pagetree-source? - scribble-source? - null-source? - racket-source? - magic-directory?))) (define (delete-it path) - (when (directory-exists? path) - (delete-directory/files path)) - (when (file-exists? path) - (delete-file path))) - - (let ([source-dir ,directory] - [target-dir ,target-path]) - (when (directory-exists? target-dir) - (delete-directory/files target-dir)) - (copy-directory/files source-dir target-dir) - (map delete-it (find-files pollen-related-file? target-dir)) - (displayln (format "Completed to ~a" ,target-path)) - ))) + (cond + [(directory-exists? path) (delete-directory/files path)] + [(file-exists? path) (delete-file path)])) + (define source-dir ,directory) + (when (not (directory-exists? source-dir)) (error (format "clone error: source directory ~a does not exist" source-dir))) + (define target-dir ,target-path) + (when (directory-exists? target-dir) (delete-directory/files target-dir)) + (copy-directory/files source-dir target-dir) + (for-each delete-it (find-files pollen-related-file? target-dir)) + (displayln (format "Completed to ~a" ,target-path)))) (define (handle-else command) `(if (regexp-match #rx"(shit|fuck)" ,command) @@ -76,42 +62,3 @@ clone copy project to desktop without source files" ,(world:curr (displayln (format "unknown command ~a" ,command)))) - - -#| - - [("clone") (let ([target-path - (if (> (len args) 1) - (->path (get args 1)) - (build-path (find-system-path 'desk-dir) (->path "clone")))]) - `(begin - (displayln "Clone & prune ...") - (require racket/file) - (require "tools.rkt") - - (define (pollen-related-file? file) - (ormap (λ(proc) (proc file)) (list - markup-source? - preproc-source? - template-source? - pagetree-source? - pollen-script? - magic-directory? - racket-file?))) - - (define (delete-it path) - (when (directory-exists? path) - (delete-directory/files path)) - (when (file-exists? path) - (delete-file path))) - - (let ([source-dir (current-directory)] - [target-dir ,target-path]) - (when (directory-exists? target-dir) - (delete-directory/files target-dir)) - (copy-directory/files source-dir target-dir) - (map delete-it (find-files pollen-related-file? target-dir)) - (displayln (format "Completed to ~a" ,target-path)) - )))] - -|# \ No newline at end of file diff --git a/file.rkt b/file.rkt index cc67643..6bcdfe0 100644 --- a/file.rkt +++ b/file.rkt @@ -121,5 +121,16 @@ (define+provide (magic-directory? path) (and (directory-exists? path) - (or (ends-with? (path->string path) "compiled") - ))) \ No newline at end of file + (or (ends-with? (path->string path) "compiled")))) + +(define+provide (pollen-related-file? file) + (ormap (λ(proc) (proc file)) (list + preproc-source? + markup-source? + markdown-source? + template-source? + pagetree-source? + scribble-source? + null-source? + racket-source? + magic-directory?))) \ No newline at end of file diff --git a/raco.rkt b/raco.rkt index 7d47b84..0d5db40 100644 --- a/raco.rkt +++ b/raco.rkt @@ -11,7 +11,11 @@ (with-handlers ([exn:fail? (λ(exn) (current-directory))]) (path->complete-path (simplify-path (string->path (vector-ref args 1)))))) -(define-for-syntax second-arg +(define-for-syntax rest-args + (with-handlers ([exn:fail? (λ(exn) #f)]) + (cddr (vector->list (current-command-line-arguments))))) + +(define-for-syntax port-arg (with-handlers ([exn:fail? (λ(exn) #f)]) (string->number (vector-ref args 2)))) @@ -24,9 +28,9 @@ (datum->syntax stx (case arg-command-name [(#f "help") (handle-help)] - [("start") (handle-start first-arg-or-current-dir second-arg)] - [("render") (handle-render first-arg-or-current-dir)] - [("clone") (handle-clone first-arg-or-current-dir second-arg)] + [("start") (handle-start first-arg-or-current-dir port-arg)] + [("render") (handle-render first-arg-or-current-dir rest-args)] + [("clone") (handle-clone first-arg-or-current-dir rest-args)] [else (handle-else arg-command-name)]))) (select-syntax-for-command) diff --git a/world.rkt b/world.rkt index 53097e6..9a5f009 100644 --- a/world.rkt +++ b/world.rkt @@ -53,3 +53,5 @@ (define current-server-extras-path (make-parameter #f)) (define check-project-requires-in-render? (make-parameter #t)) + +(define clone-directory-name "clone")