From: Bruce J. Weimer, MD
Subject: (read) with timeout
Date: 
Message-ID: <Rg%We.42115$1g2.30868@fe05.lga>
A newbie question:

Does anyone have or know of a keyboard "(read)" function that times out and 
doesn't hang if no input is received after say "X" seconds?

Bruce.

From: Pascal Bourguignon
Subject: Re: (read) with timeout
Date: 
Message-ID: <87ll1vv22h.fsf@thalassa.informatimago.com>
"Bruce J. Weimer, MD" <········@charter.net> writes:
> Does anyone have or know of a keyboard "(read)" function that times out and 
> doesn't hang if no input is received after say "X" seconds?

    (defun read-char-with-timeout (stream timeout)
        (loop with beg = (get-universal-time)
           until (or (listen stream) (< timeout (- (get-universal-time) beg)))
           do (sleep 0.01)
           finally (if (listen stream)
                       (read-char stream)
                       (error "Time out"))))


That said, on clisp you can use EXT:WITH-KEYBOARD-INPUT and *KEYBOARD-INPUT*
to get raw tty input.

-- 
__Pascal Bourguignon__                     http://www.informatimago.com/

The world will now reboot.  don't bother saving your artefacts.
From: Bruce J. Weimer, MD
Subject: Re: (read) with timeout
Date: 
Message-ID: <YciXe.9911$6Z3.8106@fe06.lga>
Thanks!  This then is what I came up with:

;;;;  ROUTINES TO (READ) A LINE WITH A 15 SECOND TIME OUT

(defun read-char-with-timeout (stream timeout)
    (loop with beg = (get-universal-time)
       until (or (listen stream) (< timeout (- (get-universal-time) beg)))
       do (sleep 0.01)
       finally (if (listen stream)
                   (return-from read-char-with-timeout (read-char stream))
                   nil)))


(defun read-with-timeout ()
  (let ((rcwt (read-char-with-timeout nil 15)))
    (cond ((null rcwt)  " timed out")
          ((string-equal rcwt #\Newline) (string #\ ))
          (t (concatenate 'string (string rcwt) (read-with-timeout))))))

Bruce.
From: Bruce J. Weimer, MD
Subject: Re: (read) with timeout
Date: 
Message-ID: <fiiXe.9913$6Z3.8939@fe06.lga>
Pascal,

Thanks!  I'm using the free version of LispWorks Personal Edition for
Windows.  I'm trying to have my program ask me (or someone) to type in my
(or his or her) name, but I don't want it to hang if after a few seconds
nothing's been entered.  This is what I came up with using your (modified)
code:

;;;;  ROUTINES TO (READ) A LINE WITH A 15 SECOND TIME OUT

(defun read-char-with-timeout (stream timeout)
    (loop with beg = (get-universal-time)
       until (or (listen stream) (< timeout (- (get-universal-time) beg)))
       do (sleep 0.01)
       finally (if (listen stream)
                   (return-from read-char-with-timeout (read-char stream))
                   nil)))


(defun read-with-timeout ()
  (let ((rcwt (read-char-with-timeout nil 15)))
    (cond ((null rcwt)  " timed out")
          ((string-equal rcwt #\Newline) (string #\ ))
          (t (concatenate 'string (string rcwt) (read-with-timeout))))))


This works, but I make no claim as to this being the best way to code this!

Bruce.
From: Wade Humeniuk
Subject: Re: (read) with timeout
Date: 
Message-ID: <ZFiXe.172689$wr.95933@clgrps12>
Bruce J. Weimer, MD wrote:
> Pascal,
> 
> Thanks!  I'm using the free version of LispWorks Personal Edition for
> Windows.  I'm trying to have my program ask me (or someone) to type in my
> (or his or her) name, but I don't want it to hang if after a few seconds
> nothing's been entered.  This is what I came up with using your (modified)
> code:
> 
> ;;;;  ROUTINES TO (READ) A LINE WITH A 15 SECOND TIME OUT
> 
> (defun read-char-with-timeout (stream timeout)
>     (loop with beg = (get-universal-time)
>        until (or (listen stream) (< timeout (- (get-universal-time) beg)))
>        do (sleep 0.01)
>        finally (if (listen stream)
>                    (return-from read-char-with-timeout (read-char stream))
>                    nil)))
> 
> 
> (defun read-with-timeout ()
>   (let ((rcwt (read-char-with-timeout nil 15)))
>     (cond ((null rcwt)  " timed out")
>           ((string-equal rcwt #\Newline) (string #\ ))
>           (t (concatenate 'string (string rcwt) (read-with-timeout))))))
> 
> 
> This works, but I make no claim as to this being the best way to code this!
> 

(define-condition stream-read-timeout (error) ())

(defun read-char-with-timeout (stream timeout)
   (let* ((process mp:*current-process*)
          (timer (mp:make-timer (lambda ()
                                  (mp:process-interrupt process (lambda () (error 
'stream-read-timeout)))))))
     (unwind-protect
         (progn
           (mp:schedule-timer-relative timer timeout)
           (read-char stream))
       (ignore-errors (mp:unschedule-timer timer)))))



CL-USER 1 > (read-char-with-timeout *standard-input* 2.0)

Error: The condition #<STREAM-READ-TIMEOUT 2067574C> occurred
   1 (abort) Return to level 0.
   2 Return to top loop level 0.

Type :b for backtrace, :c <option number> to proceed,  or :? for other options

CL-USER 2 : 1 > :a

CL-USER 3 > (read-char-with-timeout *standard-input* 10.0)
1
#\1

CL-USER 4 >


Wade
From: Pascal Bourguignon
Subject: Re: (read) with timeout
Date: 
Message-ID: <878xxuulyu.fsf@thalassa.informatimago.com>
"Bruce J. Weimer, MD" <········@charter.net> writes:

> Pascal,
>
> Thanks!  I'm using the free version of LispWorks Personal Edition for
> Windows.  I'm trying to have my program ask me (or someone) to type in my
> (or his or her) name, but I don't want it to hang if after a few seconds
> nothing's been entered.  This is what I came up with using your (modified)
> code:
>
> ;;;;  ROUTINES TO (READ) A LINE WITH A 15 SECOND TIME OUT
>
> (defun read-char-with-timeout (stream timeout)
>     (loop with beg = (get-universal-time)
>        until (or (listen stream) (< timeout (- (get-universal-time) beg)))
>        do (sleep 0.01)
>        finally (if (listen stream)
>                    (return-from read-char-with-timeout (read-char stream))
>                    nil)))
>
>
> (defun read-with-timeout ()
>   (let ((rcwt (read-char-with-timeout nil 15)))
>     (cond ((null rcwt)  " timed out")
>           ((string-equal rcwt #\Newline) (string #\ ))
>           (t (concatenate 'string (string rcwt) (read-with-timeout))))))
>
>
> This works, but I make no claim as to this being the best way to code this!

You'll want to rename  READ-WITH-TIMEOUT  as  READ-LINE-WITH-TIMEOUT.

There are READ-CHAR, READ-LINE and READ.
You could name the matching functions: 
READ-CHAR/TIMEOUT, READ-LINE/TIMEOUT and READ/TIMEOUT.



When you read more than one character, the notion of time-out is more complex.

Are the 15 seconds to be counted before the first character is typed?
or until the last character?
or between two characters?

If the later cases, if timeout occurs, what to do with the characters
already typed?  

In a sense, you've answered with these questions with your
implementation, but are you aware of the answers you've given?  What
specification have you implemented?

Finally, since at first you didn't specify the Common Lisp implemented
you used, I provided a portable implementation of
read-char-with-timeout, but there's an important aspect that will have
a bit impact on the behavior: that of the buffering.  With normal
line-buffered terminal I/O, READ-CHAR and LISTEN receive the
characters only when the user types RETURN at the terminal.

So the timeout is counted in effect to the last character, and if
something has been typed in this time, it's still is in the input
buffer, and will be read next: you might want to call CLEAR-INPUT when
a timeout occurs when you're doing line input.


If we continue with portable Common Lisp and line-buffered I/O, and
counting the timeout to the newline, READ-LINE/TIMEOUT could be
implemented simply with:


(define-condition stream-read-timeout (error)
  ((stream :initarg :stream :accessor stream-read-timeout-stream)))

(defun read-line/timeout (&key timeout
                          (timeout-value nil timeout-error-p)
                          (stream *standard-input*) 
                          (eof-error-p t) (eof-value nil))
  (loop with beg = (get-universal-time)
     until (or (listen stream) (< timeout (- (get-universal-time) beg)))
     do (sleep 0.01))
  (cond
    ((listen stream) (read-line stream eof-error-p eof-value))
    (timeout-error-p (clear-input stream)
                     (error 'stream-read-timeout :stream stream))
    (t               (clear-input stream)
                     timeout-value)))


-- 
"Klingon function calls do not have "parameters" -- they have
"arguments" and they ALWAYS WIN THEM."