Mercurial > hg > xemacs-beta

comparison lisp/prim/itimer.el @ 102:a145efe76779 r20-1b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b3
author cvs
date Mon, 13 Aug 2007 09:15:49 +0200
parents 4be1180a9e89
children 360340f9fd5f
comparison
equal deleted inserted replaced
101:a0ec055d74dd 102:a145efe76779
53 ;; list-itimers 53 ;; list-itimers
54 ;; start-itimer 54 ;; start-itimer
55 ;; 55 ;;
56 ;; See the doc strings of these functions for more information. 56 ;; See the doc strings of these functions for more information.
57 57
58 (defvar itimer-version "1.01" 58 (defvar itimer-version "1.02"
59 "Version number of the itimer package.") 59 "Version number of the itimer package.")
60 60
61 (defvar itimer-list nil 61 (defvar itimer-list nil
62 "List of all active itimers.") 62 "List of all active itimers.")
63 63
699 (disable-timeout itimer-timer))) 699 (disable-timeout itimer-timer)))
700 (setq itimer-timer (add-timeout itimer-short-interval 700 (setq itimer-timer (add-timeout itimer-short-interval
701 'itimer-timer-driver nil nil)))) 701 'itimer-timer-driver nil nil))))
702 702
703 (defun itimer-time-difference (t1 t2) 703 (defun itimer-time-difference (t1 t2)
704 ;; ignore high 16 bits since we will never be dealing with 704 (let (usecs secs 65536-secs)
705 ;; times that long. 705 (setq usecs (- (nth 2 t1) (nth 2 t2)))
706 (setq t1 (cdr t1) 706 (if (< usecs 0)
707 t2 (cdr t2)) 707 (setq carry 1
708 (let ((usecs (- (nth 1 t1) (nth 1 t2))) 708 usecs (+ usecs 1000000))
709 (secs (- (car t1) (car t2)))) 709 (setq carry 0))
710 (if (< usecs 0) 710 (setq secs (- (nth 1 t1) (nth 1 t2) carry))
711 (setq secs (1- secs) 711 (if (< secs 0)
712 usecs (+ usecs 1000000))) 712 (setq carry 1
713 (+ secs (/ usecs (if (featurep 'lisp-float-type) 1e6 1000000))))) 713 secs (+ secs 65536))
714 (setq carry 0))
715 (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry))
716 ;; loses for interval larger than the maximum signed Lisp integer.
717 ;; can't really be helped.
718 (+ (* 65536-secs 65536)
719 secs
720 (/ usecs (if (featurep 'lisp-float-type) 1e6 1000000)))))
714 721
715 (defun itimer-timer-driver (&rest ignored) 722 (defun itimer-timer-driver (&rest ignored)
716 ;; inhibit quit because if the user quits at an inopportune 723 ;; inhibit quit because if the user quits at an inopportune
717 ;; time, the timer process won't bne launched again and the 724 ;; time, the timer process won't bne launched again and the
718 ;; system stops working. itimer-run-expired-timers allows 725 ;; system stops working. itimer-run-expired-timers allows