Add call-with-sigint

This commit is contained in:
Christopher Baines 2024-12-25 20:35:40 +00:00
parent dc2fe732ea
commit e8ab6f23d8

View file

@ -1,8 +1,11 @@
(define-module (knots) (define-module (knots)
#:use-module (ice-9 suspendable-ports) #:use-module (ice-9 suspendable-ports)
#:use-module (fibers conditions)
#:export (call-with-default-io-waiters #:export (call-with-default-io-waiters
wait-when-system-clock-behind)) wait-when-system-clock-behind
call-with-sigint))
(define (call-with-default-io-waiters thunk) (define (call-with-default-io-waiters thunk)
(parameterize (parameterize
@ -19,3 +22,18 @@
(simple-format (current-error-port) (simple-format (current-error-port)
"warning: system clock potentially behind, waiting\n") "warning: system clock potentially behind, waiting\n")
(sleep 20)))) (sleep 20))))
;; Copied from (fibers web server)
(define (call-with-sigint thunk cvar)
(let ((handler #f))
(dynamic-wind
(lambda ()
(set! handler
(sigaction SIGINT (lambda (sig) (signal-condition! cvar)))))
thunk
(lambda ()
(if handler
;; restore Scheme handler, SIG_IGN or SIG_DFL.
(sigaction SIGINT (car handler) (cdr handler))
;; restore original C handler.
(sigaction SIGINT #f))))))