path: root/elisp/erbot/contrib/timerfunctions.el

;;; timerfunctions.el---enhanced versions of some timer.el functions.
;; Time-stamp: <2003-05-09 08:23:24 deego>
;; Copyright (C) Deepak Goel 2000, 2001, 2002
;; Emacs Lisp Archive entry
;; Filename: timerfunctions.el
;; Author: Deepak Goel <deego@gnufans.org>
;; Version: 1.4.2
;; Created: 2000/11/20

;; Author's homepage: http://gnufans.net/~deego
;; For latest version: 

(defconst timerfunctions-home-page
  "http://gnufans.net/~deego/emacspub/timerfunctions")



(defvar timerfunctions-version "1.4.2")


;;;========================================================
;;;========================================================
;;; Commentary:   The latest version can always be downloaded from
;;; http://www.glue.umd.edu/~deego/emacs.html


 
;; This file is NOT (yet) part of GNU Emacs.
 
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
 
;; This is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.



;;; See also: midnight.el (part of emacs), timer.el




;;; New features:
(defconst timerfunctions-new-features
  "New since last posting: Changed the syntax of `tf-with-timeout' and
provided a `tf-with-timeout-check'.")

(defun timerfunctions-new-features ()
  "Provides electric help from variable `timerfunctions-new-features'."
  (interactive)
  (with-electric-help
   '(lambda () (insert timerfunctions-new-features) nil) "*doc*"))


(defconst timerfunctions-introduction
  "timerfunctions.el contains some 'enhanced' versions of a few timer.el
functions.  It is also used by vel.el, idledo.el etc.

 Suppose you want emacs to run an action every REDOSECS for
 _as_long_as emacs remains idle.  `tf-run-with-idle-timer' allows that.
  
 `tf-with-timeout' is a generalized with-timeout where you can inhibit
 breaks within parts of the body that you want.

 QUICKSTART: 
 Place this file somewhere in yr emacs-load-path, and add the
 foll. to your .emacs: (load \"timerfunctions.el\")
"
)

;;;###autoload
(defun timerfunctions-introduction ()
  "Provides electric help from variable `timerfunctions-introduction'."
  (interactive)
  (with-electric-help
   '(lambda () (insert timerfunctions-introduction) nil) "*doc*"))

;;; Real Code: 


;;;###autoload
(defun tf-time-difference (timeplus timesub)
  "Gives the time in seconds elaspsed from TIMESUB to TIMEPLUS.
Almost like \(- TIMEPLUS TIMESUB \)."
  (+ (* (expt 2 16) (- (car timeplus) (car timesub)))
     (- (cadr timeplus) (cadr timesub)))
)


;;;###autoload
(defun tf-run-with-idle-timer  (secs repeat redosecs redorepeat includeruntime function &rest args) 
  "Args are SECS, REPEAT, REDOSECS, REDOREPEAT, INCLUDERUNTIME,
FUNCTION and &rest ARGS.
Similar to run-with-idle-timer, except that provides more options.
Suppose you want emacs to run an action every REDOSECS for as long as
emacs remains idle.  Think you can do it with the emacs' 
run-with-idle-timer? Think again.. :)   That function will perform the
action exactly once every time emacs goes idle.  This funciton, 
tf-run-with-idle-timer *will* allow you to keep performing an action
as long as emacs remains idle.

SECS is the number of seconds to wait once emacs has first gone
idle. It can really be any expression whose at runtime yields a
number..  Note that the way run-with-idle-timer is defined, SECS will
unfortunately be evalled immediately after you call this function, but
redosecs will be *every* time emacs *remains* idle..yay..


If REDOREPEAT is non-nil, the action is repeated as long emacs remains
idle.  REDOSECS is the number of additional seconds (after the action
has been done) to wait if emacs remains idle before performing the
action again.  Again, redosecs does not have to be a number, it can be
any expression whose eval yields to a number...

If INCLUDERUNTIME is non-nil, REDOSECS is the number of
additional seconds to wait after the action has been invoked (not
finished).

If REPEAT is nonnil, the entire cycle is repeated every time emacs
next goes idle.. (as in the default run-with-idle-timer."
  (apply 'run-with-idle-timer 
	 (eval secs) repeat 'tf-run-while-idle 
	 redosecs redorepeat includeruntime
	 function args)
  )


(defun tf-run-while-idle (redosecs redorepeat includeruntime
function &rest args)
  "Runs FUNCTION with ARGS and optionally repeats if emacs idle.
Probably is of no use unless used in programs.
 If REDOREPEAT is non-nil, the function is repeated periodically every
REDOSECS as long as emacs remains idle. By default, emacs waits
REDOSECS *after* the function is done executing to repeat. If you want
the execution-time to count towards REDOSECS, make INCLUDERUNTIME
non-nil.
SECS and REDOSECS can be any expressions that eval at runtime to
numbers.. In particular, they can simply be numbers..

"
  (if (not includeruntime)
      (progn
	(apply function args)
	(if redorepeat
	    (while (sit-for (eval redosecs))
	      (apply function args))))
    (progn
      (let ((before-time (current-time)))
	(apply function args)
	(if redorepeat
	    (while (sit-for (- 
			     (eval redosecs)
			     (tf-time-difference (current-time)
						 before-time)))
	      (setq before-time (current-time))
	      (apply function args))))))
  )


;;;====================================================
;;;TESTS FOLLOW
(defun tf-test-display-time-internal
  ()
  (let ((thisbuffer (buffer-name)))
    (switch-to-buffer-other-window "*scratch*")
    (goto-char (point-max))
    (insert (concat "\n" (format "%S" (cadr (current-time)))))
    (recenter)
    (switch-to-buffer-other-window thisbuffer))
)


(defun tf-test-idle-timer ()
  "Run this and watch..Play around with the options.. If you run it,
you may have to exit your emacs session to restore normal emacs!
unless you are an expert, that is.."

  (interactive)
  (tf-run-with-idle-timer
  1 t 3 t nil 'tf-test-display-time-internal)
)


  


(defun tf-test-timeout ()
  "Bad count should be zero. "
  (interactive)
  (let ((inhi nil) (goodcount 0) (badcount 0) (ctr 0) (a 1) (b 2)
	(mytag nil)
	(myvar nil)
	)
    (loop 
     for ctr from 0 to 10 do
     (message "ctr=%S" ctr)
     (tf-with-timeout 'inhi 'mytah 'myvar
      (0.3 nil)
      (loop for i from 0 to 100000 do
	    (message "ctr=%S, i=%S" ctr i)
	    (setq inhi t)
	    (setq a (random 100))
	    (sleep-for 0.1)
	    (setq b a)
	    (setq inhi nil)
	    (sleep-for 0.02)
	    ))
     (if (equal b a) (incf goodcount) (incf badcount)))
    (message "Goodcount: %S; badcount: %S" goodcount badcount)))



(defun tf-test-timeout-complex ()
  "Should return a value of 20000 for a. "

  (interactive)
  (let ((inhi t) (goodcount 0) (badcount 0) (ctr 0) (a 1) (b 2)
	(mytag nil)
	(myvar nil)
	)
    (setq a 0)
    (message "ctr=%S" ctr)
    (tf-with-timeout 
     'inhi 'mytag 'myvar
     (0.1 nil)
     (loop for i from 0 to 10000 do
	   (message "first loop. i=%S" ctr i)
	   (incf a))
     (message "initial loop ends here.")
     ;; no throw here because loop prohibited. 
     (tf-with-timeout-check 'inhi 'mytag 'myvar)
     ;; this shouldn't help either
     (sit-for 0.3)

     (loop for i from 0 to 10000 do
	   (message "second loop.  i=%S" i)
	   (incf a))
     (message "second loop ends here.")
     (setq inhi nil)
     ;; this should throw. 
     (tf-with-timeout-check 'inhi 'mytag 'myvar)
     ;; this should NOT be needed. 
     ;;(sit-for 0.2)
     ;; this loop should never take place.
     (loop for i from 0 to 1000 do
	   (message "third loop, i=%S" i)
	   (incf a))
     (message "third loop ends here."))
    (message "%S" a)
    a))


(defun tf-wait-until-idle (&optional secs)
  "DOES NOT WORK YET. Waits until idle. 
Will help run processes in background.  This function will NOT create
a timer.  Will simply use sit-for.  "
  (if (null secs)
      (setq secs 1))
  (while (not (sit-for secs))
    (sit-for 1))
  (message "tf-wait-until-idle DONE WAITING!")
)


;;;Tue Jan 23 17:38:44 2001
(defmacro tf-ignore-errors (&rest body)
 "Like ignore-errors, but tells the error.."
 (let ((err (gensym)))
   (list 'condition-case err (cons 'progn body)
	 (list 'error
	       (list 'message
		     (list 'concat
			   "IGNORED ERROR: "
			   (list 'error-message-string err)))))
   ))




(defvar tf-with-timeout-repeat-sec 0.01
  "If the initial timeout fails because of inhibitedness, we shall
check every this many seconds to see if we are uninhibited.  This
variable is customizable. ")


(defun tf-with-timeout-handler-internal (tag timedoutvar inhibitp)
  (set timedoutvar t)
  ;;(tf-with-timeout-check tag timedoutvar inhibitp)
  ;; which is equivalent to:
  (unless (eval inhibitp) 
    (tf-ignore-errors (throw tag 'timeout)))
  )

(defun tf-with-timeout-check (inhibitp tag timedoutvar)
  ;; check whether timeout has actually reached. 
  ;; we need this step because this function might be called by the
  ;; user as well. 
  (when (eval timedoutvar)
    (unless (eval inhibitp) 
      (tf-ignore-errors (throw tag 'timeout)))))



(defvar tf-tag-tmpvar nil)

(defmacro tf-catch (tag &rest body)
  `(let 
       ;; unquote the tag here..
       ((,(cadr tag) 'tf-catch))
     (catch ,tag
       ,@body)))

(defmacro tf-throw (tag value)
  `(when (eql (eval ,tag) 'tf-catch)
     (throw ,tag value)))

  
;;;###autoload
(defmacro tf-with-timeout (inhibitp timertag timedoutvar tlist &rest body)
  "Like `with-timeout' but provide ability to inhibit timeout during
parts of the body.  Note that most of the time, you may not need this
functionality at all unless you want to be very 'clean' about
things---you could get by with the regular with-timeout and not using
sit-for's in the body.  Or with the regular with-timeout and using
unwind-protect.


TO DECIDE: IN VIEW OF THE UNWIND-PROTECT, DO WE NEED THIS FUNCTION AT ALL??

Run BODY, but if it doesn't finish in SECONDS seconds, give up.
If we give up, we run the TIMEOUT-FORMS which are contained in TLIST 
and return the value of the last one.
The call should look like:
 (tf-with-timeout quoted-expr (SECONDS TIMEOUT-FORMS...) BODY...)

The timeout is checked whenever Emacs waits for some kind of external
event \(such as keyboard input, input from subprocesses, or a certain time);
if the program loops without waiting in any way, the timeout will not
be detected.  Furthermore:

During the execution of the body, we SHALL NOT time out when INHIBITP
evals to non-nil.  Thus, for example, you might initially setq a
variable my-var as nil, supply inhibitp as 'my-var, and then you may
setq my-var to t or nil within the body of tf-with-timeout to enable
or disable timeout.  The best use of this functionality is to setq
inhibitp to t when during parts of loops where you do not want the
body broken within certain parts of the loop.  (Of course, if that
part of the loop does not contain any sit-for's or read's then you
don't have to worry about this in the first place..)


again, Do not forget my-var to some value before attempting to use this
tf-with-timeout :)

Here's an example: 

 
 (let ((myinhibit t))
  (tf-with-timeout 'myinhibit 'mytag 'mytimedoutvar
		   (2 2)
		   (setq a nil)
		   (setq b nil)
		   (sit-for 4)
		   (setq a 4)
		   (setq myinhibit nil)
		   (sit-for 2)
		   (setq b 5)
		   ))


The above example requests a timeout within 2 seconds.  However, the
timeout can takes place only when myinhibit is set to nil,
which becomes true after about 4 seconds.  Thus, after the execution of the
body, a has the value 4, but b has the value nil.

See `tf-test-timeout' for another example. 

Important Note: If the body of a loop tends to stay in a timeout
inhibited region for most of the time, then make sure that the timeout
enabled region atleast spans about 0.02 seconds.. thus, use (sleep-for
0.02) if needed.. this is because we check every 0.01 seconds if an
uninhibited timeout condition has been satisfied.  

But perhaps you do not want to include (sleep-for 0.02) because that
wastes precious cpu time.  Simple, don't include it, just after a long
inhibited body, you can include a timeout check within the body
instead of (sleep-for 0.02):
 (tf-with-timeout-check 'mytag 'mytimedoutvar 'myinhibitp)

Moreover, if that is the main check you rely on, you it perhaps makes
sense to increase the value of tf-with-timeout-repeat-sec, so that
your cpu cycles are not wasted every 0.01 sec.  See the doc of that
variable for more. 

Timertag should be a quoted symbol, also we WILL set that symbol to t
during the execution of these forms.

"
  (let ((seconds (car tlist))
	(timeout-forms (cdr tlist)))
    `(let (
	   ;;(with-timeout-tag (cons nil nil))
	   with-timeout-value with-timeout-timer)
       (set ,timedoutvar nil)
       (if (catch ,timertag
	     (progn
	       (setq with-timeout-timer
		     (run-with-timer ,seconds tf-with-timeout-repeat-sec
				     'tf-with-timeout-handler-internal
				     ,timertag ,timedoutvar 
				     ,inhibitp))
	       (setq with-timeout-value (progn ,@body))
	       nil))
	   (progn ,@timeout-forms)
	 (cancel-timer with-timeout-timer)
	 with-timeout-value))))


(provide 'timerfunctions)

;;;timerfunctions.el ends here.