Mercurial > hg > xemacs-beta

comparison lisp/itimer.el @ 359:8e84bee8ddd0 r21-1-9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-1-9
author cvs
date Mon, 13 Aug 2007 10:57:55 +0200
parents 57709be46d1b
children cc15677e0335
comparison
equal deleted inserted replaced
358:fed6e0f6a03a 359:8e84bee8ddd0
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.09"
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
669 ;; Quit's are allowed from within itimer functions, but we 671 ;; Quit's are allowed from within itimer functions, but we
670 ;; catch them and print a message. 672 ;; catch them and print a message.
671 (inhibit-quit t)) 673 (inhibit-quit t))
672 (setq next-wakeup 600) 674 (setq next-wakeup 600)
673 (cond ((and (boundp 'last-command-event-time) 675 (cond ((and (boundp 'last-command-event-time)
674 (consp 'last-command-event-time)) 676 (consp last-command-event-time))
675 (setq last-event-time last-command-event-time 677 (setq last-event-time last-command-event-time
676 idle-time (itimer-time-difference (current-time) 678 idle-time (itimer-time-difference (current-time)
677 last-event-time))) 679 last-event-time)))
678 ((and (boundp 'last-input-time) (consp last-input-time)) 680 ((and (boundp 'last-input-time) (consp last-input-time))
679 (setq last-event-time (list (car last-input-time) 681 (setq last-event-time (list (car last-input-time)
836 (if (< secs 0) 838 (if (< secs 0)
837 (setq carry 1 839 (setq carry 1
838 secs (+ secs 65536)) 840 secs (+ secs 65536))
839 (setq carry 0)) 841 (setq carry 0))
840 (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry)) 842 (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry))
841 ;; loses for interval larger than the maximum signed Lisp integer. 843 (+ (* 65536-secs 65536.0)
842 ;; can't really be helped.
843 (+ (* 65536-secs 65536)
844 secs 844 secs
845 (/ usecs (if (featurep 'lisp-float-type) 1e6 1000000))))) 845 (/ usecs 1000000.0))))
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