Changeset 8489

Timestamp:

Feb 14, 2008, 1:10:47 AM (17 years ago)

Author:

Gary Byers

Message:

WITH-INPUT-TIMEOUT, WITH-OUTPUT-TIMEOUT.

File:

• trunk/source/lib/macros.lisp (modified) (1 diff)

trunk/source/lib/macros.lisp

@@ -3568 +3568 @@
   consing when N is a trivial constant integer."
   `(car (nthcdr ,n (multiple-value-list ,form))))
+
+
+
+(defmacro with-input-timeout (((stream-var &optional (stream-form stream-var)) timeout) &body body)
+  "Execute body with STREAM-VAR bound to STREAM-FORM and with that stream's
+stream-input-timeout set to TIMEOUT."
+  (let* ((old-input-timeout (gensym))
+         (stream (gensym)))
+    `(let* ((,stream ,stream-form)
+            (,stream-var ,stream)
+            (,old-input-timeout (stream-input-timeout ,stream)))
+      (unwind-protect
+           (progn
+             (setf (stream-input-timeout ,stream) ,timeout)
+             ,@body)
+        (setf (stream-input-timeout ,stream) ,old-input-timeout)))))
+
+(defmacro with-output-timeout (((stream-var &optional (stream-form stream-var)) timeout) &body body)
+  "Execute body with STREAM-VAR bound to STREAM-FORM and with that stream's
+stream-output-timeout set to TIMEOUT."
+  (let* ((old-output-timeout (gensym))
+         (stream (gensym)))
+    `(let* ((,stream ,stream-form)
+            (,stream-var ,stream)
+            (,old-output-timeout (stream-output-timeout ,stream)))
+      (unwind-protect
+           (progn
+             (setf (stream-output-timeout ,stream) ,timeout)
+             ,@body)
+        (setf (stream-output-timeout ,stream) ,old-output-timeout)))))