You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
pollen/command.rkt

80 lines
4.5 KiB
Racket

#lang racket/base
11 years ago
(require pollen/world)
(provide (all-defined-out))
11 years ago
(define (handle-test)
`(displayln "raco pollen is installed correctly"))
(define (handle-help)
11 years ago
`(displayln (format "Pollen commands:
help show this message
start [dir] [port] starts project server in dir (default is current dir)
(default port is ~a)
render [dir] [dest] render project in dir (default is current dir)
to dest (default is desktop)
render filename render filename only (can be source or output name)
11 years ago
clone copy project to desktop without source files" ,(world:current-server-port))))
11 years ago
(define (handle-render dir-or-path rest-args)
`(begin
(require pollen/render pollen/world pollen/file sugar pollen/pagetree racket/list)
(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
11 years ago
(displayln (format "Rendering ~a" dir-or-path))
(cons dir-or-path ',rest-args))
(let ([dir dir-or-path]) ; now we know it's a dir
(displayln (format "Rendering preproc & pagetree files in directory ~a" dir))
(define preprocs (filter preproc-source? (directory-list dir)))
(define static-pagetrees (filter pagetree-source? (directory-list dir)))
;; if there are no static pagetrees, use make-project-pagetree
;; (which will synthesize a pagetree if needed, which includes all sources)
(define pagetrees (if (empty? static-pagetrees)
(list (make-project-pagetree dir))
static-pagetrees))
(append* preprocs pagetrees))))))))
(define (handle-start directory [port #f])
(if (not (directory-exists? directory))
(error (format "~a is not a directory" directory))
`(begin
(require pollen/server pollen/world)
(parameterize ([world:current-project-root ,directory]
,@(if port (list `(world:current-server-port ,port)) null))
(start-server)))))
11 years ago
(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
10 years ago
(require racket/file pollen/file racket/list)
(define (delete-it path)
11 years ago
(cond
[(directory-exists? path) (delete-directory/files path)]
[(file-exists? path) (delete-file path)]))
10 years ago
(define (contains-directory? possible-superdir possible-subdir)
(define (has-prefix? xs prefix)
(and (>= (length xs) (length prefix))
(andmap equal? prefix (take xs (length prefix)))))
((explode-path possible-subdir) . has-prefix? . (explode-path possible-superdir)))
(define source-dir (simplify-path ,directory))
10 years ago
(when (not (directory-exists? source-dir)) (error 'clone (format "source directory ~a does not exist" source-dir)))
(define target-dir (simplify-path ,target-path))
10 years ago
(when (source-dir . contains-directory? . target-dir) (error 'clone "aborted because target directory for cloning (~a) can't be inside source directory (~a)" target-dir source-dir))
(displayln "Cloning ...")
11 years ago
(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-dir))))
(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.")])
(list-ref responses (random (length responses)))))
(displayln (format "unknown command ~a" ,command))))