Mercurial > hg > xemacs-beta

comparison lisp/itimer.el @ 371:cc15677e0335 r21-2b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b1
author cvs
date Mon, 13 Aug 2007 11:03:08 +0200
parents 8e84bee8ddd0
children 8626e4521993
comparison
equal deleted inserted replaced
370:bd866891f083 371:cc15677e0335
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
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)
838 (if (< secs 0) 836 (if (< secs 0)
839 (setq carry 1 837 (setq carry 1
840 secs (+ secs 65536)) 838 secs (+ secs 65536))
841 (setq carry 0)) 839 (setq carry 0))
842 (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry)) 840 (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry))
843 (+ (* 65536-secs 65536.0) 841 ;; loses for interval larger than the maximum signed Lisp integer.
842 ;; can't really be helped.
843 (+ (* 65536-secs 65536)
844 secs 844 secs
845 (/ usecs 1000000.0)))) 845 (/ usecs (if (featurep 'lisp-float-type) 1e6 1000000)))))
846 846
847 (defun itimer-timer-driver (&rest ignored) 847 (defun itimer-timer-driver (&rest ignored)
848 ;; inhibit quit because if the user quits at an inopportune 848 ;; inhibit quit because if the user quits at an inopportune
849 ;; time, the timer process won't be launched again and the 849 ;; time, the timer process won't be launched again and the
850 ;; system stops working. itimer-run-expired-timers allows 850 ;; system stops working. itimer-run-expired-timers allows