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 ;; Created: 2000/11/20
11 ;; Author's homepage: http://gnufans.net/~deego
13 ;; This file is NOT (yet) part of GNU Emacs.
15 ;; This is free software; you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation; either version 3, or (at your option)
20 ;; This is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;; For latest version:
29 ;; Gives me a "Not found"!
30 ;;(defconst timerfunctions-home-page
31 ;; "http://gnufans.net/~deego/emacspub/timerfunctions")
35 ;; See also: midnight.el (part of Emacs), timer.el
39 (defvar timerfunctions-version "1.4.2")
43 (defconst timerfunctions-new-features
44 "New since last posting: Changed the syntax of `tf-with-timeout' and
45 provided a `tf-with-timeout-check'.")
47 (defun timerfunctions-new-features ()
48 "Provides electric help from variable `timerfunctions-new-features'."
51 (lambda () (insert timerfunctions-new-features) nil) "*doc*"))
54 (defconst timerfunctions-introduction
55 "timerfunctions.el contains some 'enhanced' versions of a few timer.el
56 functions. It is also used by vel.el, idledo.el etc.
58 Suppose you want Emacs to run an action every REDOSECS for
59 _as_long_as Emacs remains idle. `tf-run-with-idle-timer' allows that.
61 `tf-with-timeout' is a generalized with-timeout where you can inhibit
62 breaks within parts of the body that you want.
65 Place this file somewhere in your load-path, and add the
66 following to your ~/.emacs: (load \"timerfunctions.el\")
71 (defun timerfunctions-introduction ()
72 "Provides electric help from variable `timerfunctions-introduction'."
75 '(lambda () (insert timerfunctions-introduction) nil) "*doc*"))
81 (defun tf-time-difference (timeplus timesub)
82 "Return the time in seconds elaspsed from TIMESUB to TIMEPLUS.
84 Conceptually: \(- TIMEPLUS TIMESUB \)."
85 (+ (* (expt 2 16) (- (car timeplus) (car timesub)))
86 (- (cadr timeplus) (cadr timesub)))
91 (defun tf-run-with-idle-timer (secs repeat redosecs redorepeat includeruntime function &rest args)
92 "Similar to `run-with-idle-timer', except that provides more options.
94 Args are SECS, REPEAT, REDOSECS, REDOREPEAT, INCLUDERUNTIME,
95 FUNCTION and &rest ARGS.
97 Similar to `run-with-idle-timer', but provides more options.
98 Suppose you want Emacs to run an action every REDOSECS for as
99 long as Emacs remains idle. Emacs' `run-with-idle-timer' will
100 perform the action exactly once every time Emacs goes idle. This
101 funciton, on the other hand, will allow
102 you to keep performing an action as long as Emacs remains idle.
104 SECS is the number of seconds to wait once Emacs has first gone
105 idle. It can really be any expression whose at runtime yields a
106 number. Note that the way `run-with-idle-timer' is defined, SECS will
107 unfortunately be evalled immediately after you call this function, but
108 redosecs will be *every* time Emacs *remains* idle..yay..
110 If REDOREPEAT is non-nil, the action is repeated as long Emacs remains
111 idle. REDOSECS is the number of additional seconds (after the action
112 has been done) to wait if Emacs remains idle before performing the
113 action again. Again, redosecs does not have to be a number, it can be
114 any expression whose eval yields to a number...
116 If INCLUDERUNTIME is non-nil, REDOSECS is the number of
117 additional seconds to wait after the action has been invoked (not
120 If REPEAT is nonnil, the entire cycle is repeated every time Emacs
121 next goes idle.. (as in the default `run-with-idle-timer'."
122 (apply 'run-with-idle-timer
123 (eval secs) repeat 'tf-run-while-idle
124 redosecs redorepeat includeruntime
129 (defun tf-run-while-idle (redosecs redorepeat includeruntime function &rest args)
130 "A simplified version of `tf-run-with-idle-timer'.
132 Runs FUNCTION with ARGS and optionally repeats if emacs remains idle.
133 Probably is of no use unless used in programs.
134 If REDOREPEAT is non-nil, the function is repeated periodically every
135 REDOSECS as long as emacs remains idle. By default, emacs waits
136 REDOSECS *after* the function is done executing to repeat. If you want
137 the execution-time to count towards REDOSECS, make INCLUDERUNTIME
139 SECS and REDOSECS can be any expressions that eval at runtime to
140 numbers. In particular, of course, they can simply be numbers."
141 (if (not includeruntime)
143 (apply function args)
145 (while (sit-for (eval redosecs))
146 (apply function args))))
148 (let ((before-time (current-time)))
149 (apply function args)
153 (tf-time-difference (current-time)
155 (setq before-time (current-time))
156 (apply function args))))))
160 ;;;====================================================
162 (defun tf-test-display-time-internal ()
165 (let ((thisbuffer (buffer-name)))
166 (switch-to-buffer-other-window "*scratch*")
167 (goto-char (point-max))
168 (insert (concat "\n" (format "%S" (cadr (current-time)))))
170 (switch-to-buffer-other-window thisbuffer))
174 (defun tf-test-idle-timer ()
177 Run this and watch Play around with the options. If you run it,
178 you may have to exit your Emacs session to restore normal Emacs,
179 unless you clean things up carefully!"
182 (tf-run-with-idle-timer
183 1 t 3 t nil 'tf-test-display-time-internal)
190 (defun tf-test-timeout ()
191 "Bad count should be zero."
193 (let ((inhi nil) (goodcount 0) (badcount 0) (ctr 0) (a 1) (b 2)
198 for ctr from 0 to 10 do
199 (message "ctr=%S" ctr)
200 (tf-with-timeout 'inhi 'mytah 'myvar
202 (loop for i from 0 to 100000 do
203 (message "ctr=%S, i=%S" ctr i)
205 (setq a (random 100))
211 (if (equal b a) (incf goodcount) (incf badcount)))
212 (message "Goodcount: %S; badcount: %S" goodcount badcount)))
216 (defun tf-test-timeout-complex ()
217 "Should return a value of 20000 for a."
220 (let ((inhi t) (goodcount 0) (badcount 0) (ctr 0) (a 1) (b 2)
225 (message "ctr=%S" ctr)
229 (loop for i from 0 to 10000 do
230 (message "first loop. ctr=%S, i=%S, " ctr i)
232 (message "initial loop ends here.")
233 ;; no throw here because loop prohibited.
234 (tf-with-timeout-check 'inhi 'mytag 'myvar)
235 ;; this shouldn't help either
238 (loop for i from 0 to 10000 do
239 (message "second loop. i=%S" i)
241 (message "second loop ends here.")
243 ;; this should throw.
244 (tf-with-timeout-check 'inhi 'mytag 'myvar)
245 ;; this should NOT be needed.
247 ;; this loop should never take place.
248 (loop for i from 0 to 1000 do
249 (message "third loop, i=%S" i)
251 (message "third loop ends here."))
257 (defvar tf-internal-var-recenter 1)
259 (defun tf-test-internal-recenter-toggle ()
263 (setq tf-internal-var-recenter (- 0 tf-internal-var-recenter)))
265 (defun tf-test-example-timer-recenter ()
267 Changes the screen display every 3 seconds, thus ensuring that you
268 don't time out of ssh sessions."
270 (tf-run-with-idle-timer 3 t 3 t nil 'tf-test-internal-recenter-toggle))
275 (defun tf-todo-wait-until-idle (&optional secs)
276 "This function is not functional yet.
278 Waits until idle. Arguments are SECS.
279 Will help run processes in background. This function will NOT create
280 a timer. Will simply use `sit-for'."
283 (while (not (sit-for secs))
285 (message "tf-todo-wait-until-idle DONE WAITING!")
289 ;;;Tue Jan 23 17:38:44 2001
290 ;; FIXME: Use `with-demoted-errors' instead.
291 (defmacro tf-ignore-errors (&rest body)
292 "Ignore errors in BODY, but loudly."
293 (let ((err (gensym)))
294 (list 'condition-case err (cons 'progn body)
299 (list 'error-message-string err)))))
305 (defvar tf-with-timeout-repeat-sec 0.01
306 "Interval between checks for inhibitedness.
308 If the initial timeout fails because of inhibitedness, we shall
309 check every `tf-with-timeout-repeat-sec' seconds to see if we are
310 uninhibited, yet. This variable is customizable.")
313 (defun tf-with-timeout-handler-internal (tag timedoutvar inhibitp)
315 Arguments are TAG, TIMEDOUTVAR, and INHIBITP."
317 ;;(tf-with-timeout-check tag timedoutvar inhibitp)
318 ;; which is equivalent to:
319 (unless (eval inhibitp)
320 (tf-ignore-errors (throw tag 'timeout)))
323 (defun tf-with-timeout-check (inhibitp tag timedoutvar)
325 Check whether timeout has actually reached.
326 We need this step because this function might be called by the
327 user as well. Arguments are INHIBITP, TAG and TIMEDOUTVAR."
328 (when (eval timedoutvar)
329 (unless (eval inhibitp)
330 (tf-ignore-errors (throw tag 'timeout)))))
334 (defvar tf-tag-tmpvar nil)
336 (defmacro tf-catch (tag &rest body)
337 "Catch a TAG in BODY."
339 ;; unquote the tag here..
340 ((,(cadr tag) 'tf-catch))
344 (defmacro tf-throw (tag value)
345 "Throw a TAG with value VALUE."
346 `(when (eql (eval ,tag) 'tf-catch)
351 (defmacro tf-with-timeout (inhibitp timertag timedoutvar tlist &rest body)
352 "Like `with-timeout' but with support for unbreakable code.
354 Provides ability to inhibit timeout during parts of the body.
355 Note that most of the time, you may not need this functionality
356 at all unless you want to be very 'clean' about things---you
357 could get by with the regular with-timeout and not using
358 sit-for's in the body. Or with the regular with-timeout and
359 using unwind-protect.
362 A judicious use of `unwind-protect' may seem to alleviate the
363 need for this function. This function, however, provides
364 additional flexibility in that the inhibitedness can be altered
365 at run-time depending on various conditions.
368 Run BODY, but if it doesn't finish in SECONDS seconds, give up.
369 If we give up, we run the TIMEOUT-FORMS which are contained in TLIST
370 and return the value of the last one.
371 The call should look like:
372 (tf-with-timeout quoted-expr (SECONDS TIMEOUT-FORMS...) BODY...)
374 The timeout is checked whenever Emacs waits for some kind of external
375 event \(such as keyboard input, input from subprocesses, or a certain time);
376 if the program loops without waiting in any way, the timeout will not
377 be detected. Furthermore:
379 During the execution of the body, we SHALL NOT time out when INHIBITP
380 evals to non-nil. Thus, for example, you might initially setq a
381 variable my-var as nil, supply inhibitp as 'my-var, and then you may
382 setq my-var to t or nil within the body of tf-with-timeout to enable
383 or disable timeout. The best use of this functionality is to setq
384 inhibitp to t when during parts of loops where you do not want the
385 body broken within certain parts of the loop. (Of course, if that
386 part of the loop does not contain any sit-for's or read's then you
387 don't have to worry about this in the first place..)
390 Again, Do not forget to bind my-var to some value before attempting to use this
397 (tf-with-timeout 'myinhibit 'mytag 'mytimedoutvar
409 The above example requests a timeout within 2 seconds. However, the
410 timeout can takes place only when myinhibit is set to nil,
411 which becomes true after about 4 seconds. Thus, after the execution of the
412 body, a has the value 4, but b has the value nil.
414 See `tf-test-timeout' for another example.
416 Important Note: If the body of a loop tends to stay in a timeout
417 inhibited region for most of the time, then make sure that the timeout
418 enabled region atleast spans about 0.02 seconds.. thus, use (sleep-for
419 0.02) if needed.. this is because we check every 0.01 seconds if an
420 uninhibited timeout condition has been satisfied.
422 But perhaps you do not want to include (sleep-for 0.02) because that
423 wastes precious cpu time. Simple, don't include it, just after a long
424 inhibited body, you can include a timeout check within the body
425 instead of (sleep-for 0.02):
426 (tf-with-timeout-check 'mytag 'mytimedoutvar 'myinhibitp)
428 Moreover, if that is the main check you rely on, you it perhaps makes
429 sense to increase the value of tf-with-timeout-repeat-sec, so that
430 your cpu cycles are not wasted every 0.01 sec. See the doc of that
433 TIMERTAG should be a quoted symbol, also we WILL set that symbol to t
434 during the execution of these forms.
436 TIMEDOUTVAR is the variable that times out."
437 (let ((seconds (car tlist))
438 (timeout-forms (cdr tlist)))
440 ;;(with-timeout-tag (cons nil nil))
441 with-timeout-value with-timeout-timer)
442 (set ,timedoutvar nil)
445 (setq with-timeout-timer
446 (run-with-timer ,seconds tf-with-timeout-repeat-sec
447 'tf-with-timeout-handler-internal
448 ,timertag ,timedoutvar
450 (setq with-timeout-value (progn ,@body))
452 (progn ,@timeout-forms)
453 (cancel-timer with-timeout-timer)
454 with-timeout-value))))
457 (provide 'timerfunctions)
458 ;;; timerfunctions.el ends here