Mercurial > hg > xemacs-beta

comparison lisp/prim/itimer.el @ 114:8619ce7e4c50 r20-1b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b9
author cvs
date Mon, 13 Aug 2007 09:21:54 +0200
parents fe104dbd9147
children 1370575f1259
comparison
equal deleted inserted replaced
113:2ec2fe4a4c89 114:8619ce7e4c50
20 20
21 (provide 'itimer) 21 (provide 'itimer)
22 22
23 ;; `itimer' feature means Emacs-Lisp programmers get: 23 ;; `itimer' feature means Emacs-Lisp programmers get:
24 ;; itimerp 24 ;; itimerp
25 ;; itimer-live-p
25 ;; itimer-value 26 ;; itimer-value
26 ;; itimer-restart 27 ;; itimer-restart
27 ;; itimer-function 28 ;; itimer-function
28 ;; itimer-uses-arguments 29 ;; itimer-uses-arguments
29 ;; itimer-function-arguments 30 ;; itimer-function-arguments
43 ;; list-itimers 44 ;; list-itimers
44 ;; start-itimer 45 ;; start-itimer
45 ;; 46 ;;
46 ;; See the doc strings of these functions for more information. 47 ;; See the doc strings of these functions for more information.
47 48
48 (defvar itimer-version "1.04" 49 (defvar itimer-version "1.05"
49 "Version number of the itimer package.") 50 "Version number of the itimer package.")
50 51
51 (defvar itimer-list nil 52 (defvar itimer-list nil
52 "List of all active itimers.") 53 "List of all active itimers.")
53 54
157 158
158 (defun itimerp (obj) 159 (defun itimerp (obj)
159 "Returns non-nil iff OBJ is an itimer." 160 "Returns non-nil iff OBJ is an itimer."
160 (and (consp obj) (eq (length obj) 8))) 161 (and (consp obj) (eq (length obj) 8)))
161 162
163 (defun itimer-live-p (obj)
164 "Returns non-nil iff OBJ is an itimer and is active.
165 ``Active'' means Emacs will run it when it expires.
166 `activate-timer' must be called on a itimer to make it active.
167 Itimers started with `start-itimer' are automatically active."
168 (and (itimerp obj) (memq obj itimer-list)))
169
162 (defun itimer-name (itimer) 170 (defun itimer-name (itimer)
163 "Returns the name of ITIMER." 171 "Returns the name of ITIMER."
164 (check-itimer itimer) 172 (check-itimer itimer)
165 (car itimer)) 173 (car itimer))
166 174
266 otherwise the function will be called with no arguments. 274 otherwise the function will be called with no arguments.
267 Returns FLAG." 275 Returns FLAG."
268 (check-itimer itimer) 276 (check-itimer itimer)
269 (setcar (nthcdr 5 itimer) flag)) 277 (setcar (nthcdr 5 itimer) flag))
270 278
271 (defun set-itimer-function-arguments (itimer &rest arguments) 279 (defun set-itimer-function-arguments (itimer &optional arguments)
272 "Set the function arguments of ITIMER to be ARGUMENTS. 280 "Set the function arguments of ITIMER to be ARGUMENTS.
273 The function of ITIMER will be called with ARGUMENTS when itimer expires. 281 The function of ITIMER will be called with ARGUMENTS when itimer expires.
274 Returns ARGUMENTS." 282 Returns ARGUMENTS."
275 (check-itimer itimer) 283 (check-itimer itimer)
276 (setcar (nthcdr 6 itimer) arguments)) 284 (setcar (nthcdr 6 itimer) arguments))
698 (condition-case condition-data 706 (condition-case condition-data
699 (save-match-data 707 (save-match-data
700 (let* ((current-itimer itimer) 708 (let* ((current-itimer itimer)
701 (quit-flag nil) 709 (quit-flag nil)
702 (inhibit-quit nil) 710 (inhibit-quit nil)
711 ;; for FSF Emacs timer.el emulation under XEmacs.
712 ;; eldoc expect this to be done, apparently.
713 (this-command nil)
703 itimer itimers time-elapsed) 714 itimer itimers time-elapsed)
704 (if (itimer-uses-arguments current-itimer) 715 (if (itimer-uses-arguments current-itimer)
705 (apply (itimer-function current-itimer) 716 (apply (itimer-function current-itimer)
706 (itimer-function-arguments current-itimer)) 717 (itimer-function-arguments current-itimer))
707 (funcall (itimer-function current-itimer))))) 718 (funcall (itimer-function current-itimer)))))
785 itimer-timer (add-timeout itimer-short-interval 796 itimer-timer (add-timeout itimer-short-interval
786 'itimer-timer-driver nil nil)))) 797 'itimer-timer-driver nil nil))))
787 798
788 (defun itimer-timer-wakeup () 799 (defun itimer-timer-wakeup ()
789 (let ((inhibit-quit t)) 800 (let ((inhibit-quit t))
790 (cond ;((fboundp 'cancel-timer) 801 (cond ((fboundp 'disable-timeout)
791 ; (cancel-timer itimer-timer)) 802 (disable-timeout itimer-timer))
792 ((fboundp 'disable-timeout) 803 ((fboundp 'cancel-timer)
793 (disable-timeout itimer-timer))) 804 (cancel-timer itimer-timer)))
794 (setq itimer-timer (add-timeout itimer-short-interval 805 (setq itimer-timer (add-timeout itimer-short-interval
795 'itimer-timer-driver nil nil)))) 806 'itimer-timer-driver nil nil))))
796 807
797 (defun itimer-time-difference (t1 t2) 808 (defun itimer-time-difference (t1 t2)
798 (let (usecs secs 65536-secs carry) 809 (let (usecs secs 65536-secs carry)