mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

hupdates

Browse Source
pull/9/head
Matthew Butterick 11 years ago
parent dbdde34401
commit 03a550f219
4 changed files with 41 additions and 77 deletions
Show Stats Download Patch File Download Diff File

87
command.rkt
Unescape Escape View File

@ -11,7 +11,7 @@ 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)])
@ -19,7 +19,7 @@ clone copy project to desktop without source files" ,(world:curr
(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))
(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))
)))]
|#

15
file.rkt
Unescape Escape View File

@ -121,5 +121,16 @@
(define+provide (magic-directory? path)
(and (directory-exists? path)
(or (ends-with? (path->string path) "compiled")
)))
(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?)))

12
raco.rkt
Unescape Escape View File

@ -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)

2
world.rkt
Unescape Escape View File

@ -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")

Write Preview
Loading…
Cancel
Save