Add call-with-sigint
This commit is contained in:
parent
dc2fe732ea
commit
e8ab6f23d8
1 changed files with 19 additions and 1 deletions
20
knots.scm
20
knots.scm
|
@ -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))))))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue