home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / utils / with-timeout.el < prev    next >
Encoding:
Text File  |  1992-12-13  |  2.7 KB  |  68 lines
  1. ;; Timeout hackery.
  2. ;; Copyright (C) 1992 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 2, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (defun with-timeout-timer (tag)
  21.   ;; I'm pretty sure the condition-case isn't really necessary here,
  22.   ;; but it doesn't hurt.
  23.   (condition-case () (throw tag nil) (no-catch nil)))
  24.  
  25. ;##autoload
  26. (defmacro with-timeout (seconds-and-timeout-forms &rest body)
  27.   "Usage: (with-timeout (seconds &rest timeout-forms) &rest body)
  28. This is just like progn, but if the given number of seconds expires before
  29. the body returns, then timeout-forms are evaluated and returned instead.
  30. The body won't be interrupted in the middle of a computation: the check for 
  31. the timer expiration only occurs when body does a redisplay, or prompts the
  32. user for input, or calls accept-process-output."
  33.   (let ((seconds (car seconds-and-timeout-forms))
  34.     (timeout-forms (cdr seconds-and-timeout-forms)))
  35.     (` (let* ((with-timeout-tag (make-symbol "_with_timeout_"))
  36.           (with-timeout-timeout
  37.            (add-timeout (, seconds) 'with-timeout-timer with-timeout-tag)))
  38.      (unwind-protect
  39.          (let ((value (catch with-timeout-tag
  40.                 (prog1 (progn (,@ body))
  41.                   (setq with-timeout-tag nil)))))
  42.            (if with-timeout-tag
  43.            (progn (,@ timeout-forms))
  44.          value))
  45.        (disable-timeout with-timeout-timeout))))))
  46.  
  47. (put 'with-timeout 'lisp-indent-function 1)
  48.  
  49. ;##autoload
  50. (defun yes-or-no-p-with-timeout (timeout prompt &optional default-value)
  51.   "Just like yes-or-no-p, but will time out after TIMEOUT seconds
  52. if the user has not yes answered, returning DEFAULT-VALUE."
  53.   (with-timeout (timeout
  54.          (message (concat prompt "(yes or no) Timeout to "
  55.                   (if default-value "Yes" "No")))
  56.          default-value)
  57.     (yes-or-no-p prompt)))
  58.  
  59. ;##autoload
  60. (defun y-or-n-p-with-timeout (timeout prompt &optional default-value)
  61.   "Just like y-or-n-p, but will time out after TIMEOUT seconds
  62. if the user has not yes answered, returning DEFAULT-VALUE."
  63.   (with-timeout (timeout
  64.          (message (concat prompt "(yes or no) Timeout to "
  65.                   (if default-value "Yes" "No")))
  66.          default-value)
  67.     (y-or-n-p prompt)))
  68.