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

Check once for unix-signal support, rather than every (!) time (!)

This commit is contained in:
Tony Garnock-Jones 2016-10-25 12:37:57 -04:00
parent acd9dde2b8
commit e90c0e580e
1 changed files with 10 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
racket/syndicate/trace/stderr.rkt
View File

@ -210,6 +210,7 @@
(define receiver (make-log-receiver logger 'info))
(define process-names (make-hash))
(name-process! process-names '() 'ground) ;; by convention
(define next-signal-evt (check-for-unix-signals-support!))
(parameterize ((pretty-print-columns 100))
(let loop ()
(sync (handle-evt receiver
@ -217,16 +218,15 @@
(match-define (vector level message-string data event-name) v)
(display-notification data process-names)
(loop)))
(let ((next-signal-evt (check-for-unix-signals-support!)))
(if next-signal-evt
(handle-evt next-signal-evt
(lambda (_signum)
(with-color WHITE-ON-GREEN
(output "\e[2J\e[HProcess name table:\n")
(for [((pid name) (in-hash process-names))]
(output "\t~v\t--> ~v\n" pid name)))
(loop)))
never-evt))))))
(if next-signal-evt
(handle-evt next-signal-evt
(lambda (_signum)
(with-color WHITE-ON-GREEN
(output "\e[2J\e[HProcess name table:\n")
(for [((pid name) (in-hash process-names))]
(output "\t~v\t--> ~v\n" pid name)))
(loop)))
never-evt)))))
(void (when (not (set-empty? flags))
(thread (display-trace (install-trace-procedure!)))))