|
|
|
|
@ -3,64 +3,42 @@
|
|
|
|
|
|
|
|
|
|
;; Handle commands from raco
|
|
|
|
|
|
|
|
|
|
;; arg 0 will be the command name
|
|
|
|
|
(define-for-syntax args (current-command-line-arguments))
|
|
|
|
|
(define-for-syntax arg-command-name (with-handlers ([exn:fail? (λ(exn) #f)])
|
|
|
|
|
(vector-ref args 0)))
|
|
|
|
|
(define-for-syntax arg-command-name (with-handlers ([exn:fail? (λ(exn) #f)]) (vector-ref args 0)))
|
|
|
|
|
|
|
|
|
|
(define-for-syntax arg-project-directory
|
|
|
|
|
(if (> (vector-length args) 1)
|
|
|
|
|
(with-handlers ([exn:fail? (λ(exn) #f)])
|
|
|
|
|
(let ([possible-path (path->complete-path (simplify-path (string->path (vector-ref args 1))))])
|
|
|
|
|
possible-path))
|
|
|
|
|
(current-directory)))
|
|
|
|
|
(with-handlers ([exn:fail? (λ(exn) (current-directory))])
|
|
|
|
|
(path->complete-path (simplify-path (string->path (vector-ref args 1))))))
|
|
|
|
|
|
|
|
|
|
(define-for-syntax (command-error error-string)
|
|
|
|
|
`(displayln (string-append "Error: ", error-string)))
|
|
|
|
|
|
|
|
|
|
;; we work in syntax layer because requiring pollen/server is slow.
|
|
|
|
|
(define-syntax (just-a-hook-for-the-macro stx)
|
|
|
|
|
(if arg-command-name
|
|
|
|
|
(datum->syntax stx
|
|
|
|
|
(case arg-command-name
|
|
|
|
|
[("test") `(displayln "All systems go")]
|
|
|
|
|
[("start")
|
|
|
|
|
(if (not (directory-exists? arg-project-directory))
|
|
|
|
|
(command-error (format "~a is not a directory" arg-project-directory))
|
|
|
|
|
`(begin
|
|
|
|
|
(require pollen/server pollen/world)
|
|
|
|
|
(parameterize ([world:current-project-root ,arg-project-directory])
|
|
|
|
|
(start-server))))]
|
|
|
|
|
[else (if (regexp-match #rx"(shit|fuck)" arg-command-name)
|
|
|
|
|
(displayln (let ([responses '("Cursing at free software? Really?" "How uncouth." "Same to you, buddy.")])
|
|
|
|
|
(list-ref responses (random (length responses)))))
|
|
|
|
|
(command-error (format "unknown command ~a" arg-command-name)))]))
|
|
|
|
|
#'(begin)))
|
|
|
|
|
(datum->syntax stx
|
|
|
|
|
(case arg-command-name
|
|
|
|
|
[(#f "help") ' (displayln "Pollen commands:
|
|
|
|
|
start starts project server
|
|
|
|
|
render renders all files in project directory
|
|
|
|
|
clone copies rendered files to desktop
|
|
|
|
|
[filename] renders individual file")]
|
|
|
|
|
[("start")
|
|
|
|
|
(if (not (directory-exists? arg-project-directory))
|
|
|
|
|
(command-error (format "~a is not a directory" arg-project-directory))
|
|
|
|
|
`(begin
|
|
|
|
|
(require pollen/server pollen/world)
|
|
|
|
|
(parameterize ([world:current-project-root ,arg-project-directory])
|
|
|
|
|
(start-server))))]
|
|
|
|
|
[else (if (regexp-match #rx"(shit|fuck)" arg-command-name)
|
|
|
|
|
(displayln (let ([responses '("Cursing at free software? Really?" "How uncouth." "Same to you, buddy.")])
|
|
|
|
|
(list-ref responses (random (length responses)))))
|
|
|
|
|
(command-error (format "unknown command ~a" arg-command-name)))])))
|
|
|
|
|
|
|
|
|
|
(just-a-hook-for-the-macro)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#|
|
|
|
|
|
|
|
|
|
|
#lang racket/base
|
|
|
|
|
(require (for-syntax racket/base))
|
|
|
|
|
|
|
|
|
|
;; todo: add command to check validity of installation
|
|
|
|
|
|
|
|
|
|
(require (for-syntax sugar "world.rkt"))
|
|
|
|
|
|
|
|
|
|
(define-syntax (handle-pollen-command stx)
|
|
|
|
|
(datum->syntax stx
|
|
|
|
|
(let* ([args (current-command-line-arguments)]
|
|
|
|
|
[arg (if (> (len args) 0) (get args 0) "")])
|
|
|
|
|
(display (format "~a: " world:command-file))
|
|
|
|
|
(case arg
|
|
|
|
|
[("help") (displayln "valid commands are
|
|
|
|
|
polcom start (starts project server)
|
|
|
|
|
polcom render (renders all files in project directory)
|
|
|
|
|
polcom clone (copies rendered files to desktop)
|
|
|
|
|
polcom [filename] (renders individual file)")]
|
|
|
|
|
[("start") `(require "server.rkt")]
|
|
|
|
|
[("render") `(begin
|
|
|
|
|
;; todo: take extensions off the comand line
|
|
|
|
|
(displayln "Render preproc & ptree files ...")
|
|
|
|
|
|
