comparison lisp/itimer.el @ 430:a5df635868b2 r21-2-23

Import from CVS: tag r21-2-23
author cvs
date Mon, 13 Aug 2007 11:29:08 +0200
parents 3ecd8885ac67
children 8de8e3f6228a
comparison
equal deleted inserted replaced
429:8305706cbb93 430:a5df635868b2
17 ;;; 02139, USA. 17 ;;; 02139, USA.
18 ;;; 18 ;;;
19 ;;; Send bug reports to kyle_jones@wonderworks.com 19 ;;; Send bug reports to kyle_jones@wonderworks.com
20 20
21 (provide 'itimer) 21 (provide 'itimer)
22
23 (require 'lisp-float-type)
22 24
23 ;; `itimer' feature means Emacs-Lisp programmers get: 25 ;; `itimer' feature means Emacs-Lisp programmers get:
24 ;; itimerp 26 ;; itimerp
25 ;; itimer-live-p 27 ;; itimer-live-p
26 ;; itimer-value 28 ;; itimer-value
44 ;; list-itimers 46 ;; list-itimers
45 ;; start-itimer 47 ;; start-itimer
46 ;; 48 ;;
47 ;; See the doc strings of these functions for more information. 49 ;; See the doc strings of these functions for more information.
48 50
49 (defvar itimer-version "1.07" 51 (defvar itimer-version "1.08"
50 "Version number of the itimer package.") 52 "Version number of the itimer package.")
51 53
52 (defvar itimer-list nil 54 (defvar itimer-list nil
53 "List of all active itimers.") 55 "List of all active itimers.")
54 56
60 is not being used to drive the system.") 62 is not being used to drive the system.")
61 63
62 (defvar itimer-timer-last-wakeup nil 64 (defvar itimer-timer-last-wakeup nil
63 "The time the timer driver function last ran.") 65 "The time the timer driver function last ran.")
64 66
65 (defvar itimer-short-interval (if (featurep 'lisp-float-type) 1e-3 1) 67 (defvar itimer-short-interval 1e-3
66 "Interval used for scheduling an event a very short time in the future. 68 "Interval used for scheduling an event a very short time in the future.
67 Used internally to make the scheduler wake up early. 69 Used internally to make the scheduler wake up early.
68 Unit is seconds.") 70 Unit is seconds.")
69 71
70 ;; This value is maintained internally; it does not determine 72 ;; This value is maintained internally; it does not determine
157 (list 'list ''stringp var))))) 159 (list 'list ''stringp var)))))
158 160
159 ;; Functions to access and modify itimer attributes. 161 ;; Functions to access and modify itimer attributes.
160 162
161 (defun itimerp (obj) 163 (defun itimerp (obj)
162 "Return t if OBJ is an itimer." 164 "Return non-nil if OBJ is an itimer."
163 (and (consp obj) (eq (length obj) 8))) 165 (and (consp obj) (eq (length obj) 8)))
164 166
165 (defun itimer-live-p (obj) 167 (defun itimer-live-p (obj)
166 "Return non-nil if OBJ is an itimer and is active. 168 "Return non-nil if OBJ is an itimer and is active.
167 ``Active'' means Emacs will run it when it expires. 169 ``Active'' means Emacs will run it when it expires.
179 (check-itimer itimer) 181 (check-itimer itimer)
180 (nth 1 itimer)) 182 (nth 1 itimer))
181 183
182 (defun itimer-restart (itimer) 184 (defun itimer-restart (itimer)
183 "Return the value to which ITIMER will be set at restart. 185 "Return the value to which ITIMER will be set at restart.
184 Return nil if this itimer doesn't restart." 186 The value nil is returned if this itimer isn't set to restart."
185 (check-itimer itimer) 187 (check-itimer itimer)
186 (nth 2 itimer)) 188 (nth 2 itimer))
187 189
188 (defun itimer-function (itimer) 190 (defun itimer-function (itimer)
189 "Return the function of ITIMER. 191 "Return the function of ITIMER.
192 (nth 3 itimer)) 194 (nth 3 itimer))
193 195
194 (defun itimer-is-idle (itimer) 196 (defun itimer-is-idle (itimer)
195 "Return non-nil if ITIMER is an idle timer. 197 "Return non-nil if ITIMER is an idle timer.
196 Normal timers expire after a set interval. Idle timers expire 198 Normal timers expire after a set interval. Idle timers expire
197 only after Emacs has been idle for a specific interval. 199 only after Emacs has been idle for a specific interval. ``Idle''
198 ``Idle'' means no command events occur within the interval." 200 means no command events have occurred within the interval."
199 (check-itimer itimer) 201 (check-itimer itimer)
200 (nth 4 itimer)) 202 (nth 4 itimer))
201 203
202 (defun itimer-uses-arguments (itimer) 204 (defun itimer-uses-arguments (itimer)
203 "Return non-nil if the function of ITIMER will be called with arguments. 205 "Return non-nil if the function of ITIMER will be called with arguments.
206 (check-itimer itimer) 208 (check-itimer itimer)
207 (nth 5 itimer)) 209 (nth 5 itimer))
208 210
209 (defun itimer-function-arguments (itimer) 211 (defun itimer-function-arguments (itimer)
210 "Return the function arguments of ITIMER as a list. 212 "Return the function arguments of ITIMER as a list.
211 ITIMER's function is called with these argument each time ITIMER expires." 213 ITIMER's function is called with these arguments each time ITIMER expires."
212 (check-itimer itimer) 214 (check-itimer itimer)
213 (nth 6 itimer)) 215 (nth 6 itimer))
214 216
215 (defun itimer-recorded-run-time (itimer) 217 (defun itimer-recorded-run-time (itimer)
216 (check-itimer itimer) 218 (check-itimer itimer)
300 Optional second arg INITIAL-INPUT non-nil is inserted into the 302 Optional second arg INITIAL-INPUT non-nil is inserted into the
301 minibuffer as initial user input." 303 minibuffer as initial user input."
302 (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input))) 304 (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input)))
303 305
304 (defun delete-itimer (itimer) 306 (defun delete-itimer (itimer)
305 "Delete ITIMER. ITIMER may be an itimer or the name of one." 307 "Deletes ITIMER. ITIMER may be an itimer or the name of one."
306 (check-itimer-coerce-string itimer) 308 (check-itimer-coerce-string itimer)
307 (setq itimer-list (delq itimer itimer-list))) 309 (setq itimer-list (delq itimer itimer-list)))
308 310
309 (defun start-itimer (name function value &optional restart 311 (defun start-itimer (name function value &optional restart
310 is-idle with-args &rest function-arguments) 312 is-idle with-args &rest function-arguments)
325 If your version of Emacs supports floating point numbers then 327 If your version of Emacs supports floating point numbers then
326 VALUE can be a floating point number. Otherwise it 328 VALUE can be a floating point number. Otherwise it
327 must be an integer. 329 must be an integer.
328 Optional fourth arg RESTART non-nil means that this itimer should be 330 Optional fourth arg RESTART non-nil means that this itimer should be
329 restarted automatically after its function is called. Normally an itimer 331 restarted automatically after its function is called. Normally an itimer
330 is deleted at expiration after its function has returned. 332 is deleted at expiration after its function has returned.
331 If non-nil, RESTART should be a number indicating the value at which 333 If non-nil RESTART should be a number indicating the value at which the
332 the itimer should be set at restart time. 334 itimer should be set at restart time.
333 Optional fifth arg IS-IDLE specifies if this is an idle timer. 335 Optional fifth arg IS-IDLE specifies if this is an idle timer.
334 Normal timers expire after a set interval. Idle timers expire 336 Normal timers expire after a set interval. Idle timers expire
335 only after Emacs has been idle for specific interval. 337 only after Emacs has been idle for specific interval. ``Idle''
336 ``Idle'' means no command events occur within the interval. 338 means no command events have occurred within the interval.
337 Returns the newly created itimer." 339 Returns the newly created itimer."
338 (interactive 340 (interactive
339 (list (completing-read "Start itimer: " itimer-list) 341 (list (completing-read "Start itimer: " itimer-list)
340 (read (completing-read "Itimer function: " obarray 'fboundp)) 342 (read (completing-read "Itimer function: " obarray 'fboundp))
341 (let (value) 343 (let (value)
715 (let* ((current-itimer itimer) 717 (let* ((current-itimer itimer)
716 (quit-flag nil) 718 (quit-flag nil)
717 (inhibit-quit nil) 719 (inhibit-quit nil)
718 ;; for FSF Emacs timer.el emulation under XEmacs. 720 ;; for FSF Emacs timer.el emulation under XEmacs.
719 ;; eldoc expect this to be done, apparently. 721 ;; eldoc expect this to be done, apparently.
720 (this-command nil)) 722 (this-command nil)
723 ;; bind these variables so that the
724 ;; itimer function can't screw with
725 ;; them.
726 last-event-time next-wakeup
727 itimer itimers time-elapsed)
721 (if (itimer-uses-arguments current-itimer) 728 (if (itimer-uses-arguments current-itimer)
722 (apply (itimer-function current-itimer) 729 (apply (itimer-function current-itimer)
723 (itimer-function-arguments current-itimer)) 730 (itimer-function-arguments current-itimer))
724 (funcall (itimer-function current-itimer))))) 731 (funcall (itimer-function current-itimer)))))
725 (error (message "itimer \"%s\" signaled: %s" (itimer-name itimer) 732 (error (message "itimer \"%s\" signaled: %s" (itimer-name itimer)
835 (if (< secs 0) 842 (if (< secs 0)
836 (setq carry 1 843 (setq carry 1
837 secs (+ secs 65536)) 844 secs (+ secs 65536))
838 (setq carry 0)) 845 (setq carry 0))
839 (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry)) 846 (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry))
840 ;; loses for interval larger than the maximum signed Lisp integer. 847 (+ (* 65536-secs 65536.0)
841 ;; can't really be helped.
842 (+ (* 65536-secs 65536)
843 secs 848 secs
844 (/ usecs (if (featurep 'lisp-float-type) 1e6 1000000))))) 849 (/ usecs 1000000.0))))
845 850
846 (defun itimer-timer-driver (&rest ignored) 851 (defun itimer-timer-driver (&rest ignored)
847 ;; inhibit quit because if the user quits at an inopportune 852 ;; inhibit quit because if the user quits at an inopportune
848 ;; time, the timer process won't be launched again and the 853 ;; time, the timer process won't be launched again and the
849 ;; system stops working. itimer-run-expired-timers allows 854 ;; system stops working. itimer-run-expired-timers allows