diff --git a/knots.scm b/knots.scm index d545770..4d1765b 100644 --- a/knots.scm +++ b/knots.scm @@ -1,8 +1,11 @@ (define-module (knots) #:use-module (ice-9 suspendable-ports) + #:use-module (fibers conditions) #: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) (parameterize @@ -19,3 +22,18 @@ (simple-format (current-error-port) "warning: system clock potentially behind, waiting\n") (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))))))