Mercurial > hg > xemacs-beta

comparison lisp/prim/itimer.el @ 126:1370575f1259 xemacs-20-1p1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag xemacs-20-1p1
author cvs
date Mon, 13 Aug 2007 09:27:39 +0200
parents 8619ce7e4c50
children 318232e2a3f0
comparison
equal deleted inserted replaced
125:8b0638b347ec 126:1370575f1259
44 ;; list-itimers 44 ;; list-itimers
45 ;; start-itimer 45 ;; start-itimer
46 ;; 46 ;;
47 ;; See the doc strings of these functions for more information. 47 ;; See the doc strings of these functions for more information.
48 48
49 (defvar itimer-version "1.05" 49 (defvar itimer-version "1.06"
50 "Version number of the itimer package.") 50 "Version number of the itimer package.")
51 51
52 (defvar itimer-list nil 52 (defvar itimer-list nil
53 "List of all active itimers.") 53 "List of all active itimers.")
54 54
94 (define-key itimer-edit-map "p" 'previous-line) 94 (define-key itimer-edit-map "p" 'previous-line)
95 (define-key itimer-edit-map "\C-?" 'itimer-edit-previous-field) 95 (define-key itimer-edit-map "\C-?" 'itimer-edit-previous-field)
96 (define-key itimer-edit-map "x" 'start-itimer) 96 (define-key itimer-edit-map "x" 'start-itimer)
97 (define-key itimer-edit-map "?" 'itimer-edit-help)) 97 (define-key itimer-edit-map "?" 'itimer-edit-help))
98 98
99 (defvar itimer-inside-driver nil)
100
99 (defvar itimer-edit-start-marker nil) 101 (defvar itimer-edit-start-marker nil)
100 102
101 ;; macros must come first... or byte-compile'd code will throw back its 103 ;; macros must come first... or byte-compile'd code will throw back its
102 ;; head and scream. 104 ;; head and scream.
103 105
801 (cond ((fboundp 'disable-timeout) 803 (cond ((fboundp 'disable-timeout)
802 (disable-timeout itimer-timer)) 804 (disable-timeout itimer-timer))
803 ((fboundp 'cancel-timer) 805 ((fboundp 'cancel-timer)
804 (cancel-timer itimer-timer))) 806 (cancel-timer itimer-timer)))
805 (setq itimer-timer (add-timeout itimer-short-interval 807 (setq itimer-timer (add-timeout itimer-short-interval
806 'itimer-timer-driver nil nil)))) 808 'itimer-timer-driver nil 5))))
807 809
808 (defun itimer-time-difference (t1 t2) 810 (defun itimer-time-difference (t1 t2)
809 (let (usecs secs 65536-secs carry) 811 (let (usecs secs 65536-secs carry)
810 (setq usecs (- (nth 2 t1) (nth 2 t2))) 812 (setq usecs (- (nth 2 t1) (nth 2 t2)))
811 (if (< usecs 0) 813 (if (< usecs 0)
828 ;; inhibit quit because if the user quits at an inopportune 830 ;; inhibit quit because if the user quits at an inopportune
829 ;; time, the timer process won't bne launched again and the 831 ;; time, the timer process won't bne launched again and the
830 ;; system stops working. itimer-run-expired-timers allows 832 ;; system stops working. itimer-run-expired-timers allows
831 ;; individual timer function to be aborted, so the user can 833 ;; individual timer function to be aborted, so the user can
832 ;; escape a feral timer function. 834 ;; escape a feral timer function.
833 (let* ((inhibit-quit t) 835 (if (not itimer-inside-driver)
834 (now (current-time)) 836 (let* ((inhibit-quit t)
835 (elapsed (itimer-time-difference now itimer-timer-last-wakeup)) 837 (itimer-inside-driver t)
836 (sleep nil)) 838 (now (current-time))
837 (setq itimer-timer-last-wakeup now) 839 (elapsed (itimer-time-difference now itimer-timer-last-wakeup))
838 (unwind-protect 840 (sleep nil))
839 (setq sleep (itimer-run-expired-timers elapsed)) 841 (setq itimer-timer-last-wakeup now
840 (and (null sleep) (add-timeout 1 'itimer-timer-driver nil nil))) 842 sleep (itimer-run-expired-timers elapsed))
841 (setq itimer-next-wakeup sleep 843 (disable-timeout itimer-timer)
842 itimer-timer (add-timeout sleep 'itimer-timer-driver nil nil)))) 844 (setq itimer-next-wakeup sleep
845 itimer-timer (add-timeout sleep 'itimer-timer-driver nil 5)))))
843 846
844 (defun itimer-driver-start () 847 (defun itimer-driver-start ()
845 (if (fboundp 'add-timeout) 848 (if (fboundp 'add-timeout)
846 (itimer-timer-start) 849 (itimer-timer-start)
847 (itimer-process-start))) 850 (itimer-process-start)))