X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdeadline.lisp;h=97a147b717cec8dddef6284da01060f5af104b6c;hb=2c5a710f4da100f8aa9c7262fa76395f73ee4307;hp=413eb869a8d40d40508bdb788556924788e3956d;hpb=3ac386bf6520a67343aadce1b3e61f580406b740;p=sbcl.git

diff --git a/src/code/deadline.lisp b/src/code/deadline.lisp
index 413eb86..97a147b 100644
--- a/src/code/deadline.lisp
+++ b/src/code/deadline.lisp
@@ -88,19 +88,31 @@ for calling this when a deadline is reached."
         (error 'deadline-timeout :seconds *deadline-seconds*)
       (defer-deadline (&optional (seconds *deadline-seconds*))
         :report "Defer the deadline for SECONDS more."
+        :interactive (lambda ()
+                       (sb!int:read-evaluated-form
+                        "By how many seconds shall the deadline ~
+                         be deferred?: "))
         (let* ((new-deadline-seconds (coerce seconds 'single-float))
                (new-deadline (+ (seconds-to-internal-time new-deadline-seconds)
                                 (get-internal-real-time))))
           (setf *deadline* new-deadline
-                *deadline-seconds* new-deadline-seconds))))))
+                *deadline-seconds* new-deadline-seconds)))
+      (cancel-deadline ()
+        :report "Cancel the deadline and continue."
+        (setf *deadline* nil *deadline-seconds* nil))))
+  nil)
 
 (defun defer-deadline (seconds &optional condition)
   "Find the DEFER-DEADLINE restart associated with CONDITION, and
-calls it with SECONDS as argument (deferring the deadline by that many
-seconds.) Continues from the indicated restart, or returns NIL if the
-restart is not found."
+invoke it with SECONDS as argument (deferring the deadline by that many
+seconds.) Otherwise return NIL if the restart is not found."
   (try-restart 'defer-deadline condition seconds))
 
+(defun cancel-deadline (&optional condition)
+  "Find and invoke the CANCEL-DEADLINE restart associated with
+CONDITION, or return NIL if the restart is not found."
+  (try-restart 'cancel-deadline condition))
+
 ;;; Returns TIMEOUT-SEC, TIMEOUT-USEC, DEADLINE-SEC, DEADLINE-USEC, SIGNALP
 ;;;
 ;;; Takes *DEADLINE* into account: if it occurs before given SECONDS,
@@ -158,3 +170,4 @@ it will signal a timeout condition."
                      (decode-internal-time final-deadline)
                    (values to-sec to-usec stop-sec stop-usec signalp)))
                (values nil nil nil nil nil)))))))
+