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