1 ;;; timerfunctions.el --- Enhanced versions of some timer.el functions
3 ;; Copyright (C) 2000-2002, 2015 Free Software Foundation, Inc.
5 ;; Time-stamp: <2015-03-02 12:23:21 deego>
6 ;; Emacs Lisp Archive entry
7 ;; Filename: timerfunctions.el
8 ;; Author: Dave Goel <deego3@gmail.com>
10 ;; Package-Requires: ((cl-lib "0.5"))
11 ;; Created: 2000/11/20
12 ;; Author's homepage: http://gnufans.net/~deego
14 ;; This file is NOT (yet) part of GNU Emacs.
16 ;; This is free software; you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation; either version 3, or (at your option)
21 ;; This is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 ;; For latest version:
30 ;; Gives me a "Not found"!
31 ;;(defconst timerfunctions-home-page
32 ;; "http://gnufans.net/~deego/emacspub/timerfunctions")
36 ;; See also: midnight.el (part of Emacs), timer.el
40 (eval-when-compile (require 'cl-lib))
42 (defvar timerfunctions-version "1.4.2")
46 (defconst timerfunctions-new-features
47 "New since last posting: Changed the syntax of `tf-with-timeout' and
48 provided a `tf-with-timeout-check'.")
50 (defun timerfunctions-new-features ()
51 "Provides electric help from variable `timerfunctions-new-features'."
54 (lambda () (insert timerfunctions-new-features) nil) "*doc*"))
57 (defconst timerfunctions-introduction
58 "timerfunctions.el contains some 'enhanced' versions of a few timer.el
59 functions. It is also used by vel.el, idledo.el etc.
61 Suppose you want Emacs to run an action every REDOSECS for
62 _as_long_as Emacs remains idle. `tf-run-with-idle-timer' allows that.
64 `tf-with-timeout' is a generalized with-timeout where you can inhibit
65 breaks within parts of the body that you want.
68 Place this file somewhere in your load-path, and add the
69 following to your ~/.emacs: (load \"timerfunctions.el\")
74 (defun timerfunctions-introduction ()
75 "Provides electric help from variable `timerfunctions-introduction'."
78 '(lambda () (insert timerfunctions-introduction) nil) "*doc*"))
84 (defun tf-time-difference (timeplus timesub)
85 "Return the time in seconds elaspsed from TIMESUB to TIMEPLUS.
87 Conceptually: \(- TIMEPLUS TIMESUB \)."
88 (+ (* (expt 2 16) (- (car timeplus) (car timesub)))
89 (- (cadr timeplus) (cadr timesub)))
94 (defun tf-run-with-idle-timer (secs repeat redosecs redorepeat includeruntime function &rest args)
95 "Similar to `run-with-idle-timer', except that provides more options.
97 Args are SECS, REPEAT, REDOSECS, REDOREPEAT, INCLUDERUNTIME,
98 FUNCTION and &rest ARGS.
100 Similar to `run-with-idle-timer', but provides more options.
101 Suppose you want Emacs to run an action every REDOSECS for as
102 long as Emacs remains idle. Emacs' `run-with-idle-timer' will
103 perform the action exactly once every time Emacs goes idle. This
104 funciton, on the other hand, will allow
105 you to keep performing an action as long as Emacs remains idle.
107 SECS is the number of seconds to wait once Emacs has first gone
108 idle. It can really be any expression whose at runtime yields a
109 number. Note that the way `run-with-idle-timer' is defined, SECS will
110 unfortunately be evalled immediately after you call this function, but
111 redosecs will be *every* time Emacs *remains* idle..yay..
113 If REDOREPEAT is non-nil, the action is repeated as long Emacs remains
114 idle. REDOSECS is the number of additional seconds (after the action
115 has been done) to wait if Emacs remains idle before performing the
116 action again. Again, redosecs does not have to be a number, it can be
117 any expression whose eval yields to a number...
119 If INCLUDERUNTIME is non-nil, REDOSECS is the number of
120 additional seconds to wait after the action has been invoked (not
123 If REPEAT is nonnil, the entire cycle is repeated every time Emacs
124 next goes idle.. (as in the default `run-with-idle-timer'."
125 (apply 'run-with-idle-timer
126 (eval secs) repeat 'tf-run-while-idle
127 redosecs redorepeat includeruntime
132 (defun tf-run-while-idle (redosecs redorepeat includeruntime function &rest args)
133 "A simplified version of `tf-run-with-idle-timer'.
135 Runs FUNCTION with ARGS and optionally repeats if emacs remains idle.
136 Probably is of no use unless used in programs.
137 If REDOREPEAT is non-nil, the function is repeated periodically every
138 REDOSECS as long as emacs remains idle. By default, emacs waits
139 REDOSECS *after* the function is done executing to repeat. If you want
140 the execution-time to count towards REDOSECS, make INCLUDERUNTIME
142 SECS and REDOSECS can be any expressions that eval at runtime to
143 numbers. In particular, of course, they can simply be numbers."
144 (if (not includeruntime)
146 (apply function args)
148 (while (sit-for (eval redosecs))
149 (apply function args))))
151 (let ((before-time (current-time)))
152 (apply function args)
156 (tf-time-difference (current-time)
158 (setq before-time (current-time))
159 (apply function args))))))
163 ;;;====================================================
165 (defun tf-test-display-time-internal ()
168 (let ((thisbuffer (buffer-name)))
169 (switch-to-buffer-other-window "*scratch*")
170 (goto-char (point-max))
171 (insert (concat "\n" (format "%S" (cadr (current-time)))))
173 (switch-to-buffer-other-window thisbuffer))
177 (defun tf-test-idle-timer ()
180 Run this and watch Play around with the options. If you run it,
181 you may have to exit your Emacs session to restore normal Emacs,
182 unless you clean things up carefully!"
185 (tf-run-with-idle-timer
186 1 t 3 t nil 'tf-test-display-time-internal)
193 (defun tf-test-timeout ()
194 "Bad count should be zero."
196 (let ((inhi nil) (goodcount 0) (badcount 0) (ctr 0) (a 1) (b 2)
201 for ctr from 0 to 10 do
202 (message "ctr=%S" ctr)
203 (tf-with-timeout 'inhi 'mytah 'myvar
205 (cl-loop for i from 0 to 100000 do
206 (message "ctr=%S, i=%S" ctr i)
208 (setq a (random 100))
214 (if (equal b a) (cl-incf goodcount) (cl-incf badcount)))
215 (message "Goodcount: %S; badcount: %S" goodcount badcount)))
219 (defun tf-test-timeout-complex ()
220 "Should return a value of 20000 for a."
223 (let ((inhi t) (goodcount 0) (badcount 0) (ctr 0) (a 1) (b 2)
228 (message "ctr=%S" ctr)
232 (cl-loop for i from 0 to 10000 do
233 (message "first loop. ctr=%S, i=%S, " ctr i)
235 (message "initial loop ends here.")
236 ;; no throw here because loop prohibited.
237 (tf-with-timeout-check 'inhi 'mytag 'myvar)
238 ;; this shouldn't help either
241 (cl-loop for i from 0 to 10000 do
242 (message "second loop. i=%S" i)
244 (message "second loop ends here.")
246 ;; this should throw.
247 (tf-with-timeout-check 'inhi 'mytag 'myvar)
248 ;; this should NOT be needed.
250 ;; this loop should never take place.
251 (cl-loop for i from 0 to 1000 do
252 (message "third loop, i=%S" i)
254 (message "third loop ends here."))
260 (defvar tf-internal-var-recenter 1)
262 (defun tf-test-internal-recenter-toggle ()
266 (setq tf-internal-var-recenter (- 0 tf-internal-var-recenter)))
268 (defun tf-test-example-timer-recenter ()
270 Changes the screen display every 3 seconds, thus ensuring that you
271 don't time out of ssh sessions."
273 (tf-run-with-idle-timer 3 t 3 t nil 'tf-test-internal-recenter-toggle))
278 (defun tf-todo-wait-until-idle (&optional secs)
279 "This function is not functional yet.
281 Waits until idle. Arguments are SECS.
282 Will help run processes in background. This function will NOT create
283 a timer. Will simply use `sit-for'."
286 (while (not (sit-for secs))
288 (message "tf-todo-wait-until-idle DONE WAITING!")
292 ;;;Tue Jan 23 17:38:44 2001
293 ;; FIXME: Use `with-demoted-errors' instead.
294 (defmacro tf-ignore-errors (&rest body)
295 "Ignore errors in BODY, but loudly."
296 (let ((err (make-symbol "err")))
297 `(condition-case ,err (progn ,@body)
298 (error (message "IGNORED ERROR: %s" (error-message-string ,err))))))
301 (defvar tf-with-timeout-repeat-sec 0.01
302 "Interval between checks for inhibitedness.
304 If the initial timeout fails because of inhibitedness, we shall
305 check every `tf-with-timeout-repeat-sec' seconds to see if we are
306 uninhibited, yet. This variable is customizable.")
309 (defun tf-with-timeout-handler-internal (tag timedoutvar inhibitp)
311 Arguments are TAG, TIMEDOUTVAR, and INHIBITP."
313 ;;(tf-with-timeout-check tag timedoutvar inhibitp)
314 ;; which is equivalent to:
315 (unless (eval inhibitp)
316 (tf-ignore-errors (throw tag 'timeout)))
319 (defun tf-with-timeout-check (inhibitp tag timedoutvar)
321 Check whether timeout has actually reached.
322 We need this step because this function might be called by the
323 user as well. Arguments are INHIBITP, TAG and TIMEDOUTVAR."
324 (when (eval timedoutvar)
325 (unless (eval inhibitp)
326 (tf-ignore-errors (throw tag 'timeout)))))
330 (defvar tf-tag-tmpvar nil)
332 (defmacro tf-catch (tag &rest body)
333 "Catch a TAG in BODY."
335 ;; unquote the tag here..
336 ((,(cadr tag) 'tf-catch))
340 (defmacro tf-throw (tag value)
341 "Throw a TAG with value VALUE."
342 `(when (eql (eval ,tag) 'tf-catch)
347 (defmacro tf-with-timeout (inhibitp timertag timedoutvar tlist &rest body)
348 "Like `with-timeout' but with support for unbreakable code.
350 Provides ability to inhibit timeout during parts of the body.
351 Note that most of the time, you may not need this functionality
352 at all unless you want to be very 'clean' about things---you
353 could get by with the regular with-timeout and not using
354 sit-for's in the body. Or with the regular with-timeout and
355 using unwind-protect.
358 A judicious use of `unwind-protect' may seem to alleviate the
359 need for this function. This function, however, provides
360 additional flexibility in that the inhibitedness can be altered
361 at run-time depending on various conditions.
364 Run BODY, but if it doesn't finish in SECONDS seconds, give up.
365 If we give up, we run the TIMEOUT-FORMS which are contained in TLIST
366 and return the value of the last one.
367 The call should look like:
368 (tf-with-timeout quoted-expr (SECONDS TIMEOUT-FORMS...) BODY...)
370 The timeout is checked whenever Emacs waits for some kind of external
371 event \(such as keyboard input, input from subprocesses, or a certain time);
372 if the program loops without waiting in any way, the timeout will not
373 be detected. Furthermore:
375 During the execution of the body, we SHALL NOT time out when INHIBITP
376 evals to non-nil. Thus, for example, you might initially setq a
377 variable my-var as nil, supply inhibitp as 'my-var, and then you may
378 setq my-var to t or nil within the body of tf-with-timeout to enable
379 or disable timeout. The best use of this functionality is to setq
380 inhibitp to t when during parts of loops where you do not want the
381 body broken within certain parts of the loop. (Of course, if that
382 part of the loop does not contain any sit-for's or read's then you
383 don't have to worry about this in the first place..)
386 Again, Do not forget to bind my-var to some value before attempting to use this
393 (tf-with-timeout 'myinhibit 'mytag 'mytimedoutvar
405 The above example requests a timeout within 2 seconds. However, the
406 timeout can takes place only when myinhibit is set to nil,
407 which becomes true after about 4 seconds. Thus, after the execution of the
408 body, a has the value 4, but b has the value nil.
410 See `tf-test-timeout' for another example.
412 Important Note: If the body of a loop tends to stay in a timeout
413 inhibited region for most of the time, then make sure that the timeout
414 enabled region atleast spans about 0.02 seconds.. thus, use (sleep-for
415 0.02) if needed.. this is because we check every 0.01 seconds if an
416 uninhibited timeout condition has been satisfied.
418 But perhaps you do not want to include (sleep-for 0.02) because that
419 wastes precious cpu time. Simple, don't include it, just after a long
420 inhibited body, you can include a timeout check within the body
421 instead of (sleep-for 0.02):
422 (tf-with-timeout-check 'mytag 'mytimedoutvar 'myinhibitp)
424 Moreover, if that is the main check you rely on, you it perhaps makes
425 sense to increase the value of tf-with-timeout-repeat-sec, so that
426 your cpu cycles are not wasted every 0.01 sec. See the doc of that
429 TIMERTAG should be a quoted symbol, also we WILL set that symbol to t
430 during the execution of these forms.
432 TIMEDOUTVAR is the variable that times out."
433 (let ((seconds (car tlist))
434 (timeout-forms (cdr tlist)))
436 ;;(with-timeout-tag (cons nil nil))
437 with-timeout-value with-timeout-timer)
438 (set ,timedoutvar nil)
441 (setq with-timeout-timer
442 (run-with-timer ,seconds tf-with-timeout-repeat-sec
443 'tf-with-timeout-handler-internal
444 ,timertag ,timedoutvar
446 (setq with-timeout-value (progn ,@body))
448 (progn ,@timeout-forms)
449 (cancel-timer with-timeout-timer)
450 with-timeout-value))))
453 (provide 'timerfunctions)
454 ;;; timerfunctions.el ends here