35 lines
836 B
Scheme
35 lines
836 B
Scheme
;;; -*-Scheme-*-
|
|
;;;
|
|
;;; Demonstrate signals and alarm
|
|
;;;
|
|
;;; (timeout-read fdescr seconds) -- read with timeout
|
|
|
|
(require 'unix)
|
|
|
|
;;; Read a string from file descriptor fd and return it (maximum length
|
|
;;; 1000 characters). Return #f on timeout (2nd arg, in seconds).
|
|
|
|
(define (timeout-read fd sec)
|
|
(let ((str (make-string 1000))
|
|
(old-handler 'default))
|
|
(call/cc
|
|
(lambda (tmo)
|
|
(dynamic-wind
|
|
(lambda ()
|
|
(set! old-handler (unix-signal 'sigalrm (lambda _ (tmo #f))))
|
|
(unix-alarm sec))
|
|
(lambda ()
|
|
(substring str 0 (unix-read-string-fill! fd str)))
|
|
(lambda ()
|
|
(unix-alarm 0)
|
|
(unix-signal 'sigalrm old-handler)))))))
|
|
|
|
|
|
;;; Test
|
|
|
|
(display "Enter a line (timeout 5 seconds): ")
|
|
(let ((ret (timeout-read 0 5)))
|
|
(if ret
|
|
(format #t "Got ~s~%" ret)
|
|
(format #t "~%Got timeout~%")))
|