From 33251164b2317096545fc9e9178ee7756db06ca6 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Tue, 12 Aug 2014 15:36:33 -0700 Subject: [PATCH] Allow control of tracing to stderr after process boot --- minimart/trace/stderr.rkt | 41 +++++++++++++++++++++++++++------------ 1 file changed, 29 insertions(+), 12 deletions(-) diff --git a/minimart/trace/stderr.rkt b/minimart/trace/stderr.rkt index bec1355..ee0fc76 100644 --- a/minimart/trace/stderr.rkt +++ b/minimart/trace/stderr.rkt @@ -1,5 +1,7 @@ #lang racket/base +(provide set-stderr-trace-flags!) + (require racket/set) (require racket/match) (require racket/pretty) @@ -19,19 +21,34 @@ (define colored-output? (env-aref "MINIMART_COLOR" "true" '(("true" #t) ("false" #f)))) -(define flags (for/set [(c (or (getenv "MINIMART_TRACE") "xetpag"))] (string->symbol (string c)))) +(define flags (set)) +(define show-exceptions? #f) +(define show-routing-update-events? #f) +(define show-message-events? #f) +(define show-events? #f) +(define show-process-states-pre? #f) +(define show-process-states-post? #f) +(define show-process-lifecycle? #f) +(define show-routing-update-actions? #f) +(define show-message-actions? #f) +(define show-actions? #f) +(define show-world-gestalt? #f) -(define show-exceptions? (set-member? flags 'x)) -(define show-routing-update-events? (set-member? flags 'r)) -(define show-message-events? (set-member? flags 'm)) -(define show-events? (set-member? flags 'e)) -(define show-process-states-pre? (set-member? flags 's)) -(define show-process-states-post? (set-member? flags 't)) -(define show-process-lifecycle? (set-member? flags 'p)) -(define show-routing-update-actions? (set-member? flags 'R)) -(define show-message-actions? (set-member? flags 'M)) -(define show-actions? (set-member? flags 'a)) -(define show-world-gestalt? (set-member? flags 'g)) +(define (set-stderr-trace-flags! flags-string) + (set! flags (for/set [(c flags-string)] (string->symbol (string c)))) + (set! show-exceptions? (set-member? flags 'x)) + (set! show-routing-update-events? (set-member? flags 'r)) + (set! show-message-events? (set-member? flags 'm)) + (set! show-events? (set-member? flags 'e)) + (set! show-process-states-pre? (set-member? flags 's)) + (set! show-process-states-post? (set-member? flags 't)) + (set! show-process-lifecycle? (set-member? flags 'p)) + (set! show-routing-update-actions? (set-member? flags 'R)) + (set! show-message-actions? (set-member? flags 'M)) + (set! show-actions? (set-member? flags 'a)) + (set! show-world-gestalt? (set-member? flags 'g))) + +(set-stderr-trace-flags! (or (getenv "MINIMART_TRACE") "")) (define YELLOW-ON-RED ";1;33;41") (define WHITE-ON-RED ";1;37;41")