syndicate-lang
/
minimart-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Allow control of tracing to stderr after process boot

This commit is contained in:
Tony Garnock-Jones 2014-08-12 15:36:33 -07:00
parent 2286c7c617
commit 33251164b2
1 changed files with 29 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
minimart/trace/stderr.rkt
View File

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