diff --git a/command.rkt b/command.rkt index 0bc3851..71f29b5 100644 --- a/command.rkt +++ b/command.rkt @@ -34,6 +34,41 @@ clone copy project to desktop without source files" ,(world:curr ,@(if port (list `(world:current-server-port ,port)) null)) (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")))) + + `(begin + (displayln "Clone & prune ...") + (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)) + ))) + (define (handle-else command) `(if (regexp-match #rx"(shit|fuck)" ,command) (displayln (let ([responses '("Cursing at free software? Really?" "How uncouth." "Same to you, buddy.")]) diff --git a/file.rkt b/file.rkt index 02a22cf..cc67643 100644 --- a/file.rkt +++ b/file.rkt @@ -111,8 +111,15 @@ (coerce/symbol? . -> . (listof complete-path?)) (map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list (world:current-project-root))))) +(define+provide (racket-source? x) + (->boolean (and (pathish? x) (has-ext? (->path x) 'rkt)))) + ;; to identify unsaved sources in DrRacket (define (unsaved-source? path-string) ((substring (->string path-string) 0 7) . equal? . "unsaved")) +(define+provide (magic-directory? path) + (and (directory-exists? path) + (or (ends-with? (path->string path) "compiled") + ))) \ No newline at end of file diff --git a/raco.rkt b/raco.rkt index 53ac619..7d47b84 100644 --- a/raco.rkt +++ b/raco.rkt @@ -11,7 +11,7 @@ (with-handlers ([exn:fail? (λ(exn) (current-directory))]) (path->complete-path (simplify-path (string->path (vector-ref args 1)))))) -(define-for-syntax arg-server-port +(define-for-syntax second-arg (with-handlers ([exn:fail? (λ(exn) #f)]) (string->number (vector-ref args 2)))) @@ -24,8 +24,9 @@ (datum->syntax stx (case arg-command-name [(#f "help") (handle-help)] - [("start") (handle-start first-arg-or-current-dir arg-server-port)] + [("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)] [else (handle-else arg-command-name)]))) (select-syntax-for-command)