Mercurial > hg > xemacs-beta

comparison lisp/itimer.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
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)
24 22
25 ;; `itimer' feature means Emacs-Lisp programmers get: 23 ;; `itimer' feature means Emacs-Lisp programmers get:
26 ;; itimerp 24 ;; itimerp
27 ;; itimer-live-p 25 ;; itimer-live-p
28 ;; itimer-value 26 ;; itimer-value
46 ;; list-itimers 44 ;; list-itimers
47 ;; start-itimer 45 ;; start-itimer
48 ;; 46 ;;
49 ;; See the doc strings of these functions for more information. 47 ;; See the doc strings of these functions for more information.
50 48
51 (defvar itimer-version "1.09" 49 (defvar itimer-version "1.07"
52 "Version number of the itimer package.") 50 "Version number of the itimer package.")
53 51
54 (defvar itimer-list nil 52 (defvar itimer-list nil
55 "List of all active itimers.") 53 "List of all active itimers.")
56 54
62 is not being used to drive the system.") 60 is not being used to drive the system.")
63 61
64 (defvar itimer-timer-last-wakeup nil 62 (defvar itimer-timer-last-wakeup nil
65 "The time the timer driver function last ran.") 63 "The time the timer driver function last ran.")
66 64
67 (defvar itimer-short-interval 1e-3 65 (defvar itimer-short-interval (if (featurep 'lisp-float-type) 1e-3 1)
68 "Interval used for scheduling an event a very short time in the future. 66 "Interval used for scheduling an event a very short time in the future.
69 Used internally to make the scheduler wake up early. 67 Used internally to make the scheduler wake up early.
70 Unit is seconds.") 68 Unit is seconds.")
71 69
72 ;; This value is maintained internally; it does not determine 70 ;; This value is maintained internally; it does not determine
159 (list 'list ''stringp var))))) 157 (list 'list ''stringp var)))))
160 158
161 ;; Functions to access and modify itimer attributes. 159 ;; Functions to access and modify itimer attributes.
162 160
163 (defun itimerp (obj) 161 (defun itimerp (obj)
164 "Return non-nil if OBJ is an itimer." 162 "Return t if OBJ is an itimer."
165 (and (consp obj) (eq (length obj) 8))) 163 (and (consp obj) (eq (length obj) 8)))
166 164
167 (defun itimer-live-p (obj) 165 (defun itimer-live-p (obj)
168 "Return non-nil if OBJ is an itimer and is active. 166 "Return non-nil if OBJ is an itimer and is active.
169 ``Active'' means Emacs will run it when it expires. 167 ``Active'' means Emacs will run it when it expires.
181 (check-itimer itimer) 179 (check-itimer itimer)
182 (nth 1 itimer)) 180 (nth 1 itimer))
183 181
184 (defun itimer-restart (itimer) 182 (defun itimer-restart (itimer)
185 "Return the value to which ITIMER will be set at restart. 183 "Return the value to which ITIMER will be set at restart.
186 The value nil is returned if this itimer isn't set to restart." 184 Return nil if this itimer doesn't restart."
187 (check-itimer itimer) 185 (check-itimer itimer)
188 (nth 2 itimer)) 186 (nth 2 itimer))
189 187
190 (defun itimer-function (itimer) 188 (defun itimer-function (itimer)
191 "Return the function of ITIMER. 189 "Return the function of ITIMER.
194 (nth 3 itimer)) 192 (nth 3 itimer))
195 193
196 (defun itimer-is-idle (itimer) 194 (defun itimer-is-idle (itimer)
197 "Return non-nil if ITIMER is an idle timer. 195 "Return non-nil if ITIMER is an idle timer.
198 Normal timers expire after a set interval. Idle timers expire 196 Normal timers expire after a set interval. Idle timers expire
199 only after Emacs has been idle for a specific interval. ``Idle'' 197 only after Emacs has been idle for a specific interval.
200 means no command events have occurred within the interval." 198 ``Idle'' means no command events occur within the interval."
201 (check-itimer itimer) 199 (check-itimer itimer)
202 (nth 4 itimer)) 200 (nth 4 itimer))
203 201
204 (defun itimer-uses-arguments (itimer) 202 (defun itimer-uses-arguments (itimer)
205 "Return non-nil if the function of ITIMER will be called with arguments. 203 "Return non-nil if the function of ITIMER will be called with arguments.
208 (check-itimer itimer) 206 (check-itimer itimer)
209 (nth 5 itimer)) 207 (nth 5 itimer))
210 208
211 (defun itimer-function-arguments (itimer) 209 (defun itimer-function-arguments (itimer)
212 "Return the function arguments of ITIMER as a list. 210 "Return the function arguments of ITIMER as a list.
213 ITIMER's function is called with these arguments each time ITIMER expires." 211 ITIMER's function is called with these argument each time ITIMER expires."
214 (check-itimer itimer) 212 (check-itimer itimer)
215 (nth 6 itimer)) 213 (nth 6 itimer))
216 214
217 (defun itimer-recorded-run-time (itimer) 215 (defun itimer-recorded-run-time (itimer)
218 (check-itimer itimer) 216 (check-itimer itimer)
302 Optional second arg INITIAL-INPUT non-nil is inserted into the 300 Optional second arg INITIAL-INPUT non-nil is inserted into the
303 minibuffer as initial user input." 301 minibuffer as initial user input."
304 (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input))) 302 (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input)))
305 303
306 (defun delete-itimer (itimer) 304 (defun delete-itimer (itimer)
307 "Deletes ITIMER. ITIMER may be an itimer or the name of one." 305 "Delete ITIMER. ITIMER may be an itimer or the name of one."
308 (check-itimer-coerce-string itimer) 306 (check-itimer-coerce-string itimer)
309 (setq itimer-list (delq itimer itimer-list))) 307 (setq itimer-list (delq itimer itimer-list)))
310 308
311 (defun start-itimer (name function value &optional restart 309 (defun start-itimer (name function value &optional restart
312 is-idle with-args &rest function-arguments) 310 is-idle with-args &rest function-arguments)
327 If your version of Emacs supports floating point numbers then 325 If your version of Emacs supports floating point numbers then
328 VALUE can be a floating point number. Otherwise it 326 VALUE can be a floating point number. Otherwise it
329 must be an integer. 327 must be an integer.
330 Optional fourth arg RESTART non-nil means that this itimer should be 328 Optional fourth arg RESTART non-nil means that this itimer should be
331 restarted automatically after its function is called. Normally an itimer 329 restarted automatically after its function is called. Normally an itimer
332 is deleted at expiration after its function has returned. 330 is deleted at expiration after its function has returned.
333 If non-nil RESTART should be a number indicating the value at which the 331 If non-nil, RESTART should be a number indicating the value at which
334 itimer should be set at restart time. 332 the itimer should be set at restart time.
335 Optional fifth arg IS-IDLE specifies if this is an idle timer. 333 Optional fifth arg IS-IDLE specifies if this is an idle timer.
336 Normal timers expire after a set interval. Idle timers expire 334 Normal timers expire after a set interval. Idle timers expire
337 only after Emacs has been idle for specific interval. ``Idle'' 335 only after Emacs has been idle for specific interval.
338 means no command events have occurred within the interval. 336 ``Idle'' means no command events occur within the interval.
339 Returns the newly created itimer." 337 Returns the newly created itimer."
340 (interactive 338 (interactive
341 (list (completing-read "Start itimer: " itimer-list) 339 (list (completing-read "Start itimer: " itimer-list)
342 (read (completing-read "Itimer function: " obarray 'fboundp)) 340 (read (completing-read "Itimer function: " obarray 'fboundp))
343 (let (value) 341 (let (value)
503 mode-name "Itimer Edit" 501 mode-name "Itimer Edit"
504 truncate-lines t 502 truncate-lines t
505 tab-stop-list '(22 32 40 60 67)) 503 tab-stop-list '(22 32 40 60 67))
506 (abbrev-mode 0) 504 (abbrev-mode 0)
507 (auto-fill-mode 0) 505 (auto-fill-mode 0)
508 (buffer-disable-undo (current-buffer)) 506 (buffer-flush-undo (current-buffer))
509 (use-local-map itimer-edit-map) 507 (use-local-map itimer-edit-map)
510 (set-syntax-table emacs-lisp-mode-syntax-table)) 508 (set-syntax-table emacs-lisp-mode-syntax-table))
511 509
512 (put 'itimer-edit-mode 'mode-class 'special) 510 (put 'itimer-edit-mode 'mode-class 'special)
513 511
671 ;; Quit's are allowed from within itimer functions, but we 669 ;; Quit's are allowed from within itimer functions, but we
672 ;; catch them and print a message. 670 ;; catch them and print a message.
673 (inhibit-quit t)) 671 (inhibit-quit t))
674 (setq next-wakeup 600) 672 (setq next-wakeup 600)
675 (cond ((and (boundp 'last-command-event-time) 673 (cond ((and (boundp 'last-command-event-time)
676 (consp last-command-event-time)) 674 (consp 'last-command-event-time))
677 (setq last-event-time last-command-event-time 675 (setq last-event-time last-command-event-time
678 idle-time (itimer-time-difference (current-time) 676 idle-time (itimer-time-difference (current-time)
679 last-event-time))) 677 last-event-time)))
680 ((and (boundp 'last-input-time) (consp last-input-time)) 678 ((and (boundp 'last-input-time) (consp last-input-time))
681 (setq last-event-time (list (car last-input-time) 679 (setq last-event-time (list (car last-input-time)
712 ;; provide the variable `current-itimer' in case the function 710 ;; provide the variable `current-itimer' in case the function
713 ;; is interested. 711 ;; is interested.
714 (unwind-protect 712 (unwind-protect
715 (condition-case condition-data 713 (condition-case condition-data
716 (save-match-data 714 (save-match-data
717 ;; Suppress warnings - see comment below.
718 (defvar last-event-time)
719 (defvar next-wakeup)
720 (defvar itimer)
721 (defvar itimers)
722 (defvar time-elapsed)
723 (let* ((current-itimer itimer) 715 (let* ((current-itimer itimer)
724 (quit-flag nil) 716 (quit-flag nil)
725 (inhibit-quit nil) 717 (inhibit-quit nil)
726 ;; for FSF Emacs timer.el emulation under XEmacs. 718 ;; for FSF Emacs timer.el emulation under XEmacs.
727 ;; eldoc expect this to be done, apparently. 719 ;; eldoc expect this to be done, apparently.
728 (this-command nil) 720 (this-command nil))
729 ;; bind these variables so that the itimer
730 ;; function can't screw with them.
731 last-event-time next-wakeup
732 itimer itimers time-elapsed)
733 (if (itimer-uses-arguments current-itimer) 721 (if (itimer-uses-arguments current-itimer)
734 (apply (itimer-function current-itimer) 722 (apply (itimer-function current-itimer)
735 (itimer-function-arguments current-itimer)) 723 (itimer-function-arguments current-itimer))
736 (funcall (itimer-function current-itimer))))) 724 (funcall (itimer-function current-itimer)))))
737 (error (message "itimer \"%s\" signaled: %s" (itimer-name itimer) 725 (error (message "itimer \"%s\" signaled: %s" (itimer-name itimer)
847 (if (< secs 0) 835 (if (< secs 0)
848 (setq carry 1 836 (setq carry 1
849 secs (+ secs 65536)) 837 secs (+ secs 65536))
850 (setq carry 0)) 838 (setq carry 0))
851 (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry)) 839 (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry))
852 (+ (* 65536-secs 65536.0) 840 ;; loses for interval larger than the maximum signed Lisp integer.
841 ;; can't really be helped.
842 (+ (* 65536-secs 65536)
853 secs 843 secs
854 (/ usecs 1000000.0)))) 844 (/ usecs (if (featurep 'lisp-float-type) 1e6 1000000)))))
855 845
856 (defun itimer-timer-driver (&rest ignored) 846 (defun itimer-timer-driver (&rest ignored)
857 ;; inhibit quit because if the user quits at an inopportune 847 ;; inhibit quit because if the user quits at an inopportune
858 ;; time, the timer process won't be launched again and the 848 ;; time, the timer process won't be launched again and the
859 ;; system stops working. itimer-run-expired-timers allows 849 ;; system stops working. itimer-run-expired-timers allows