diff --git a/command.rkt b/command.rkt index 640319f..7696fee 100644 --- a/command.rkt +++ b/command.rkt @@ -16,7 +16,7 @@ (current-directory))) (define-for-syntax (command-error error-string) - `(displayln (string-append "Error: ", error-string))) + `(displayln (string-append "Pollen error: ", error-string))) (define-syntax (just-a-hook-for-the-macro stx) (if arg-command-name @@ -31,9 +31,9 @@ (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.")]) + `(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)))])) + (command-error (format "unknown command '~a'" arg-command-name)))])) #'(begin))) (just-a-hook-for-the-macro) diff --git a/debug.rkt b/debug.rkt index 7d1520c..c5733c9 100644 --- a/debug.rkt +++ b/debug.rkt @@ -1,6 +1,6 @@ #lang racket/base (require racket/date racket/string) -(require sugar/debug sugar/define) +(require sugar/debug sugar/define "world.rkt") (provide (all-from-out sugar/debug)) @@ -61,7 +61,11 @@ (displayln (string-join `(,@(map (λ(x)(if (string? x) x (format "~v" x))) items))) (current-error-port))) (define+provide (message . items) - (displayln (string-join `(,(make-debug-timestamp) ,@(map (λ(x)(if (string? x) x (format "~v" x))) items))) (current-error-port))) + (apply message-threshold world:threshold-normal items)) + +(define+provide (message-threshold threshold . items) + (when (threshold . <= . (world:current-message-threshold)) + (displayln (string-join `(,(make-debug-timestamp) ,@(map (λ(x)(if (string? x) x (format "~v" x))) items))) (current-error-port)))) (define (exn+stack->string exn) (string-append diff --git a/world.rkt b/world.rkt index 7dacfaf..6ba131d 100644 --- a/world.rkt +++ b/world.rkt @@ -57,4 +57,8 @@ (define current-module-root (make-parameter #f)) (define current-server-extras-path (make-parameter #f)) +(define threshold-silent 0) +(define threshold-normal 10) +(define threshold-debug 100) +(define current-message-threshold (make-parameter threshold-debug))