Re: itimer rewrite

This was long overdue. Apart from streamlining the code this fixes two important bugs in the idle timer code. 1. The integer overflow reported earlier, causing no idle timers to run at all! 2. If XEmacs had been idle for a while at the moment of activation then, it would launch the ideal timers immediately. This version does what the FSF does, namely consider idle time from start time. This is intended for 21.2 and should go in 21.1 after some testing. Should there have been insufficient testing I suggest the patch for bug #1 I submitted earlier is used. Patch against 21.1.8 and complete file included. 1999-11-19 Jan Vroonhof <vroonhof(a)math.ethz.ch&gt; * itimer.el: Modernized, removed compatibility code. Use vectors for representation. Use floats for time everywhere. Start counting idle time from activation point for idle timers. Try to keep the code in the inner drivers loops fast by avoiding duplication of work and some defsubst. _Correctly_ keep cursor from jumping around in M-x edit-itimers Enforce a minimal update frequency for timer list buffer. Index: lisp/itimer.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs-20/lisp/itimer.el,v retrieving revision 1.5 diff -u -u -r1.5 itimer.el --- itimer.el 1998/05/18 05:42:08 1.5 +++ itimer.el 1999/11/18 23:55:29 ＠＠ -1,5 +1,6 ＠＠ -;;; Interval timers for GNU Emacs +;;; Interval timers for XEmacs ;;; Copyright (C) 1988, 1991, 1993, 1997, 1998 Kyle E. Jones +;;; Copyight 1999 Free Software Foundation ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ＠＠ -17,6 +18,11 ＠＠ ;;; 02139, USA. ;;; ;;; Send bug reports to kyle_jones(a)wonderworks.com +;;; +;;; Modernized and major bug fixes by jan(a)xemacs.org +;;; +;;; Synced with FSF: Not in FSF. Identical functionality with timer.el +;;; wrappers. (provide 'itimer) ＠＠ -46,23 +52,19 ＠＠ ;; ;; See the doc strings of these functions for more information. -(defvar itimer-version "1.07" +(defvar itimer-version "2.00" "Version number of the itimer package.") (defvar itimer-list nil "List of all active itimers.") -(defvar itimer-process nil - "Process that drives all itimers, if a subprocess is being used.") - (defvar itimer-timer nil - "Emacs internal timer that drives the itimer system, if a subprocess -is not being used to drive the system.") + "Emacs internal timer that drives the itimer system.") -(defvar itimer-timer-last-wakeup nil +(defvar itimer-timer-last-wakeup 'wakeup-not-set "The time the timer driver function last ran.") -(defvar itimer-short-interval (if (featurep 'lisp-float-type) 1e-3 1) +(defvar itimer-short-interval 1e-3 "Interval used for scheduling an event a very short time in the future. Used internally to make the scheduler wake up early. Unit is seconds.") ＠＠ -76,7 +78,7 ＠＠ ;; be delays due to system and Emacs internal activity that delay ;; dealing with synchronous events and process output. (defvar itimer-next-wakeup itimer-short-interval - "Itimer process will wakeup to service running itimers within this + "Itimer timer will wakeup to service running itimers within this many seconds.") (defvar itimer-edit-map nil ＠＠ -98,21 +100,15 ＠＠ (defvar itimer-inside-driver nil) +(defvar itimer-list-buffer nil) + +(defvar itimer-list-update-interval 1.0) + (defvar itimer-edit-start-marker nil) ;; macros must come first... or byte-compile'd code will throw back its ;; head and scream. -(defmacro itimer-decrement (variable) - (list 'setq variable (list '1- variable))) - -(defmacro itimer-increment (variable) - (list 'setq variable (list '1+ variable))) - -(defmacro itimer-signum (n) - (list 'if (list '> n 0) 1 - (list 'if (list 'zerop n) 0 -1))) - ;; Itimer access functions should behave as if they were subrs. These ;; macros are used to check the arguments to the itimer functions and ;; signal errors appropriately if the arguments are not valid. ＠＠ -120,102 +116,108 ＠＠ (defmacro check-itimer (var) "If VAR is not bound to an itimer, signal wrong-type-argument. This is a macro." - (list 'setq var - (list 'if (list 'itimerp var) var - (list 'signal ''wrong-type-argument - (list 'list ''itimerp var))))) - + `(setq ,var (if (itimerp ,var) ,var + (signal 'wrong-type-argument (list 'itimerp ,var))))) + (defmacro check-itimer-coerce-string (var) "If VAR is not bound to a string, look up the itimer that it names and bind VAR to it. Otherwise, if VAR is not bound to an itimer, signal wrong-type-argument. This is a macro." - (list 'setq var - (list 'cond - (list (list 'itimerp var) var) - (list (list 'stringp var) (list 'get-itimer var)) - (list t (list 'signal ''wrong-type-argument - (list 'list ''string-or-itimer-p var)))))) + `(setq ,var (cond + ((itimerp ,var) ,var) + ((stringp ,var) (get-itimer ,var))))) (defmacro check-nonnegative-number (var) "If VAR is not bound to a number, signal wrong-type-argument. If VAR is not bound to a positive number, signal args-out-of-range. This is a macro." - (list 'setq var - (list 'if (list 'not (list 'numberp var)) - (list 'signal ''wrong-type-argument - (list 'list ''natnump var)) - (list 'if (list '< var 0) - (list 'signal ''args-out-of-range (list 'list var)) - var)))) + `(setq ,var (if (not (numberp ,var)) + (signal 'wrong-type-argument (list 'natnump ,var)) + (if (< ,var 0) + (signal 'args-out-of-range (list ,var)) + ,var)))) (defmacro check-string (var) "If VAR is not bound to a string, signal wrong-type-argument. This is a macro." - (list 'setq var - (list 'if (list 'stringp var) var - (list 'signal ''wrong-type-argument - (list 'list ''stringp var))))) + `(setq ,var (if (stringp ,var) ,var + (signal 'wrong-type-argument (list 'stringp ,var))))) ;; Functions to access and modify itimer attributes. (defun itimerp (obj) "Return t if OBJ is an itimer." - (and (consp obj) (eq (length obj) 8))) + (and (vectorp obj) (eq (length obj) 8))) (defun itimer-live-p (obj) "Return non-nil if OBJ is an itimer and is active. ``Active'' means Emacs will run it when it expires. -`activate-timer' must be called on an itimer to make it active. +`activate-itimer' must be called on an itimer to make it active. Itimers started with `start-itimer' are automatically active." (and (itimerp obj) (memq obj itimer-list))) (defun itimer-name (itimer) "Return the name of ITIMER." (check-itimer itimer) - (car itimer)) + (aref itimer 0)) +(defsubst itimer-value-internal (itimer) + (aref itimer 1)) + (defun itimer-value (itimer) "Return the number of seconds until ITIMER expires." (check-itimer itimer) - (nth 1 itimer)) + (itimer-value-internal itimer)) (defun itimer-restart (itimer) "Return the value to which ITIMER will be set at restart. Return nil if this itimer doesn't restart." (check-itimer itimer) - (nth 2 itimer)) + (aref itimer 2)) (defun itimer-function (itimer) "Return the function of ITIMER. This function is called each time ITIMER expires." (check-itimer itimer) - (nth 3 itimer)) + (aref itimer 3)) + +(defsubst itimer-is-idle-internal (itimer) + (aref itimer 4)) +;; Reuse value +(defsubst itimer-activate-time (itimer) + (itimer-is-idle-internal itimer)) + (defun itimer-is-idle (itimer) "Return non-nil if ITIMER is an idle timer. Normal timers expire after a set interval. Idle timers expire only after Emacs has been idle for a specific interval. ``Idle'' means no command events occur within the interval." (check-itimer itimer) - (nth 4 itimer)) + (itimer-is-idle-internal itimer)) (defun itimer-uses-arguments (itimer) "Return non-nil if the function of ITIMER will be called with arguments. ITIMER's function is called with the arguments each time ITIMER expires. The arguments themselves are retrievable with `itimer-function-arguments'." (check-itimer itimer) - (nth 5 itimer)) + (aref itimer 5)) (defun itimer-function-arguments (itimer) "Return the function arguments of ITIMER as a list. ITIMER's function is called with these argument each time ITIMER expires." (check-itimer itimer) - (nth 6 itimer)) + (aref itimer 6)) (defun itimer-recorded-run-time (itimer) - (check-itimer itimer) - (nth 7 itimer)) + ;; (check-itimer itimer) + (aref itimer 7)) +;; Same as set-itimer-value but does not wakeup the driver. +;; Only should be used by the drivers when processing expired timers. +(defsubst set-itimer-value-internal (itimer value) + (aset itimer 1 value)) + (defun set-itimer-value (itimer value) "Set the timeout value of ITIMER to be VALUE. Itimer will expire in this many seconds. ＠＠ -231,20 +233,13 ＠＠ ;; wakeup, wakeup now and recompute a new wakeup time. (or (and (< value itimer-next-wakeup) (and (itimer-name itimer) (get-itimer (itimer-name itimer))) - (progn (itimer-driver-wakeup) - (setcar (cdr itimer) value) - (itimer-driver-wakeup) + (progn (itimer-timer-wakeup) + (set-itimer-value-internal itimer value) + (itimer-timer-wakeup) t )) - (setcar (cdr itimer) value)) + (set-itimer-value-internal itimer value)) value)) -;; Same as set-itimer-value but does not wakeup the driver. -;; Only should be used by the drivers when processing expired timers. -(defun set-itimer-value-internal (itimer value) - (check-itimer itimer) - (check-nonnegative-number value) - (setcar (cdr itimer) value)) - (defun set-itimer-restart (itimer restart) "Set the restart value of ITIMER to be RESTART. If RESTART is nil, ITIMER will not restart when it expires. ＠＠ -254,21 +249,22 ＠＠ Returns RESTART." (check-itimer itimer) (if restart (check-nonnegative-number restart)) - (setcar (cdr (cdr itimer)) restart)) + (aset itimer 2 restart)) (defun set-itimer-function (itimer function) "Set the function of ITIMER to be FUNCTION. FUNCTION will be called when itimer expires. Returns FUNCTION." (check-itimer itimer) - (setcar (nthcdr 3 itimer) function)) + (aset itimer 3 function)) (defun set-itimer-is-idle (itimer flag) "Set flag that says whether ITIMER is an idle timer. If FLAG is non-nil, then ITIMER will be considered an idle timer. Returns FLAG." (check-itimer itimer) - (setcar (nthcdr 4 itimer) flag)) + (aset itimer 4 0) + flag) (defun set-itimer-uses-arguments (itimer flag) "Set flag that says whether the function of ITIMER is called with arguments. ＠＠ -276,19 +272,22 ＠＠ otherwise the function will be called with no arguments. Returns FLAG." (check-itimer itimer) - (setcar (nthcdr 5 itimer) flag)) + (aset itimer 5 flag)) (defun set-itimer-function-arguments (itimer &optional arguments) "Set the function arguments of ITIMER to be ARGUMENTS. The function of ITIMER will be called with ARGUMENTS when itimer expires. Returns ARGUMENTS." (check-itimer itimer) - (setcar (nthcdr 6 itimer) arguments)) + (aset itimer 6 arguments)) -(defun set-itimer-recorded-run-time (itimer time) - (check-itimer itimer) - (setcar (nthcdr 7 itimer) time)) +(defsubst set-itimer-recorded-run-time (itimer time) + (aset itimer 7 time)) +;; Reuses the idle slot +(defun sync-itimer-activate-time (itimer time) + (aset itimer 4 time)) + (defun get-itimer (name) "Return itimer named NAME, or nil if there is none." (check-string name) ＠＠ -358,9 +357,9 ＠＠ (num 2)) (while (get-itimer name) (setq name (format "%s<%d>" oname num)) - (itimer-increment num))) - (activate-itimer (list name value restart function is-idle - with-args function-arguments (list 0 0 0))) + (incf num))) + (activate-itimer (vector name value restart function is-idle + with-args function-arguments 0)) (car itimer-list)) (defun make-itimer () ＠＠ -369,7 +368,7 ＠＠ Set the itimer's expire interval with `set-itimer-value'. Set the itimer's function interval with `set-itimer-function'. Once this is done, the timer can be activated." - (list nil 0 nil 'ignore nil nil nil (list 0 0 0))) + (vector nil 0 nil 'ignore nil nil nil 0)) (defun activate-itimer (itimer) "Activate ITIMER, which was previously created with `make-itimer'. ＠＠ -382,22 +381,27 ＠＠ (error "itimer timeout value not a number: %s" (itimer-value itimer))) (if (<= (itimer-value itimer) 0) (error "itimer timeout value not positive: %s" (itimer-value itimer))) - ;; If there's no itimer driver/process, start one now. + ;; make sure we count idle time _from now_ + (when (itimer-is-idle-internal itimer) + (sync-itimer-activate-time itimer (itimer-time-float (current-time))) + (set-itimer-recorded-run-time + itimer (itimer-time-float last-command-event-time))) + ;; If there's no itimer driver, start one now. ;; Otherwise wake up the itimer driver so that seconds slept before ;; the new itimer is created won't be counted against it. - (if (or itimer-process itimer-timer) - (itimer-driver-wakeup) - (itimer-driver-start)) + (if itimer-timer + (itimer-timer-wakeup) + (itimer-timer-start)) ;; Roll a unique name for the timer if it doesn't have a name ;; already. - (if (not (stringp (car itimer))) + (if (not (stringp (aref itimer 0))) (let ((name "itimer-0") (oname "itimer-") (num 1)) (while (get-itimer name) (setq name (format "%s<%d>" oname num)) - (itimer-increment num)) - (setcar itimer name)) + (incf num)) + (aset itimer 0 name)) ;; signal an error if the timer's name matches an already ;; activated timer. (if (get-itimer (itimer-name itimer)) ＠＠ -406,11 +410,11 ＠＠ (let ((inhibit-quit t)) ;; add the itimer to the global list (setq itimer-list (cons itimer itimer-list)) - ;; If the itimer process is scheduled to wake up too late for + ;; If the itimer timer is scheduled to wake up too late for ;; the itimer we wake it up to calculate a correct wakeup ;; value giving consideration to the newly added itimer. (if (< (itimer-value itimer) itimer-next-wakeup) - (itimer-driver-wakeup)))) + (itimer-timer-wakeup)))) ;; User level functions to list and modify existing itimers. ;; Itimer Edit major mode, and the editing commands thereof. ＠＠ -421,47 +425,49 ＠＠ commands to manipulate itimers; see the documentation for `itimer-edit-mode' for more information." (interactive) - (let* ((buf (get-buffer-create "*Itimer List*")) + (let* ((buf (or (if (buffer-live-p itimer-list-buffer) itimer-list-buffer) + (setq + itimer-list-buffer (get-buffer-create "*Itimer List*")))) (opoint (point)) (standard-output buf) (itimers (reverse itimer-list))) - (set-buffer buf) - (itimer-edit-mode) - (setq buffer-read-only nil) - (erase-buffer) - (insert + (with-current-buffer buf + (itimer-edit-mode) + (setq buffer-read-only nil) + (erase-buffer) + (insert "Name Value Restart Function Idle Arguments" "\n" "---- ----- ------- -------- ---- --------") - (if (null itimer-edit-start-marker) - (setq itimer-edit-start-marker (point))) - (while itimers - (newline 1) - (prin1 (itimer-name (car itimers))) - (tab-to-tab-stop) - (insert (itimer-truncate-string - (format "%5.5s" (itimer-value (car itimers))) 5)) - (tab-to-tab-stop) - (insert (itimer-truncate-string - (format "%5.5s" (itimer-restart (car itimers))) 5)) - (tab-to-tab-stop) - (insert (itimer-truncate-string + (if (null itimer-edit-start-marker) + (setq itimer-edit-start-marker (point))) + (while itimers + (newline 1) + (prin1 (itimer-name (car itimers))) + (tab-to-tab-stop) + (insert (itimer-truncate-string + (format "%5.5s" (itimer-value (car itimers))) 5)) + (tab-to-tab-stop) + (insert (itimer-truncate-string + (format "%5.5s" (itimer-restart (car itimers))) 5)) + (tab-to-tab-stop) + (insert (itimer-truncate-string (format "%.19s" (itimer-function (car itimers))) 19)) - (tab-to-tab-stop) - (if (itimer-is-idle (car itimers)) - (insert "yes") - (insert "no")) - (tab-to-tab-stop) - (if (itimer-uses-arguments (car itimers)) - (prin1 (itimer-function-arguments (car itimers))) - (prin1 'NONE)) - (setq itimers (cdr itimers))) - ;; restore point - (goto-char opoint) - (if (< (point) itimer-edit-start-marker) + (tab-to-tab-stop) + (if (itimer-is-idle (car itimers)) + (insert "yes") + (insert "no")) + (tab-to-tab-stop) + (if (itimer-uses-arguments (car itimers)) + (prin1 (itimer-function-arguments (car itimers))) + (prin1 'NONE)) + (setq itimers (cdr itimers))) + ;; restore point + (goto-char opoint) + (if (< (point) itimer-edit-start-marker) (goto-char itimer-edit-start-marker)) - (setq buffer-read-only t) - (display-buffer buf))) + (setq buffer-read-only t) + (display-buffer buf)))) (defun edit-itimers () "Display a list of all itimers and select it for editing. ＠＠ -470,8 +476,8 ＠＠ for `itimer-edit-mode' for more information." (interactive) ;; since user is editing, make sure displayed data is reasonably up-to-date - (if (or itimer-process itimer-timer) - (itimer-driver-wakeup)) + (if itimer-timer + (itimer-timer-wakeup)) (list-itimers) (select-window (get-buffer-window "*Itimer List*")) (goto-char itimer-edit-start-marker) ＠＠ -503,7 +509,7 ＠＠ tab-stop-list '(22 32 40 60 67)) (abbrev-mode 0) (auto-fill-mode 0) - (buffer-flush-undo (current-buffer)) + (buffer-disable-undo) (use-local-map itimer-edit-map) (set-syntax-table emacs-lisp-mode-syntax-table)) ＠＠ -549,7 +555,7 ＠＠ (while (and (>= opoint (point)) (< n 6)) (forward-sexp 2) (backward-sexp) - (itimer-increment n)) + (incf n)) (cond ((eq n 1) (error "Cannot change itimer name.")) ((eq n 2) 'value) ((eq n 3) 'restart) ＠＠ -610,7 +616,7 ＠＠ (defun itimer-edit-next-field (count) (interactive "p") (itimer-edit-beginning-of-field) - (cond ((> (itimer-signum count) 0) + (cond ((> count 0) (while (not (zerop count)) (forward-sexp) ;; wrap from eob to itimer-edit-start-marker ＠＠ -625,8 +631,8 ＠＠ (progn (forward-sexp 2) (backward-sexp))) - (itimer-decrement count))) - ((< (itimer-signum count) 0) + (decf count))) + ((< count 0) (while (not (zerop count)) (backward-sexp) ;; treat fields at beginning of line as if they weren't there. ＠＠ -637,7 +643,7 ＠＠ (progn (goto-char (point-max)) (backward-sexp))) - (itimer-increment count))))) + (incf count))))) (defun itimer-edit-previous-field (count) (interactive "p") ＠＠ -657,53 +663,44 ＠＠ ;; internals of the itimer implementation. -(defun itimer-run-expired-timers (time-elapsed) - (let ((itimers (copy-sequence itimer-list)) +(defsubst itimer-time-float (time) + (+ (* 65536.0 (first time)) (second time) (* 1e-6 (third time)))) + +(defun itimer-run-expired-timers (time-elapsed now) + (let* ((itimers (copy-sequence itimer-list)) (itimer) + (dorun) (next-wakeup 600) + ;; last-command-event-time is nil on startup + (last-event-time (if last-command-event-time + (itimer-time-float last-command-event-time) + 0)) (idle-time) - (last-event-time) - (recorded-run-time) ;; process filters can be hit by stray C-g's from the user, ;; so we must protect this stuff appropriately. ;; Quit's are allowed from within itimer functions, but we ;; catch them and print a message. - (inhibit-quit t)) - (setq next-wakeup 600) - (cond ((and (boundp 'last-command-event-time) - (consp 'last-command-event-time)) - (setq last-event-time last-command-event-time - idle-time (itimer-time-difference (current-time) - last-event-time))) - ((and (boundp 'last-input-time) (consp last-input-time)) - (setq last-event-time (list (car last-input-time) - (cdr last-input-time) - 0) - idle-time (itimer-time-difference (current-time) - last-event-time))) - ;; no way to do this under FSF Emacs yet. - (t (setq last-event-time '(0 0 0) - idle-time 0))) + (inhibit-quit t)) (while itimers (setq itimer (car itimers)) (if (itimer-is-idle itimer) - (setq recorded-run-time (itimer-recorded-run-time itimer)) - (set-itimer-value-internal itimer (max 0 (- (itimer-value itimer) - time-elapsed)))) - (if (if (itimer-is-idle itimer) - (or (> (itimer-time-difference recorded-run-time - last-event-time) - 0) - (< idle-time (itimer-value itimer))) - (> (itimer-value itimer) 0)) - (setq next-wakeup - (if (itimer-is-idle itimer) - (if (< idle-time (itimer-value itimer)) - (min next-wakeup (- (itimer-value itimer) idle-time)) - (min next-wakeup (itimer-value itimer))) - (min next-wakeup (itimer-value itimer)))) - (and (itimer-is-idle itimer) - (set-itimer-recorded-run-time itimer (current-time))) + (if (<= (itimer-recorded-run-time itimer) last-event-time) + (let ((idle-time (- now (max last-event-time + (itimer-activate-time itimer))))) + (if (< idle-time (itimer-value itimer)) + (setq next-wakeup + (min next-wakeup + (- (itimer-value itimer) idle-time))) + (set-itimer-recorded-run-time + itimer (itimer-time-float (current-time))) + (setq dorun t))) + (setq next-wakeup (min next-wakeup (itimer-value itimer)))) + (if (> (set-itimer-value-internal itimer + (max 0 (- (itimer-value itimer) time-elapsed))) + 0) + (setq next-wakeup (itimer-value itimer)) + (setq dorun t))) + (when dorun ;; itimer has expired, we must call its function. ;; protect our local vars from the itimer function. ;; allow keyboard quit to occur, but catch and report it. ＠＠ -731,6 +728,7 ＠＠ (delete-itimer itimer) (set-itimer-value-internal itimer (itimer-restart itimer)) (setq next-wakeup (min next-wakeup (itimer-value itimer)))))) + (setq dorun nil) (setq itimers (cdr itimers))) ;; make another sweep through the list to catch any timers ;; that might have been added by timer functions above. ＠＠ -739,111 +737,25 ＠＠ (setq next-wakeup (min next-wakeup (itimer-value (car itimers))) itimers (cdr itimers))) ;; if user is viewing the timer list, update displayed info. - (let ((b (get-buffer "*Itimer List*"))) - (if (and b (get-buffer-window b)) - (save-excursion - (list-itimers)))) + (when (and itimer-list-buffer (buffer-live-p itimer-list-buffer) + (get-buffer-window itimer-list-buffer)) + (setq next-wakeup (min itimer-list-update-interval next-wakeup)) + (list-itimers)) next-wakeup )) -(defun itimer-process-filter (process string) - ;; If the itimer process dies and generates output while doing - ;; so, we may be called before the process-sentinel. Sanity - ;; check the output just in case... - (if (not (string-match "^[0-9]" string)) - (progn (message "itimer process gave odd output: %s" string) - ;; it may be still alive and waiting for input - (process-send-string itimer-process "3\n")) - ;; if there are no active itimers, return quickly. - (if itimer-list - (let ((wakeup nil)) - (unwind-protect - (setq wakeup (itimer-run-expired-timers (string-to-int string))) - (and (null wakeup) (process-send-string process "1\n"))) - (setq itimer-next-wakeup wakeup)) - (setq itimer-next-wakeup 600)) - ;; tell itimer-process when to wakeup again - (process-send-string itimer-process - (concat (int-to-string itimer-next-wakeup) - "\n")))) - -(defun itimer-process-sentinel (process message) - (let ((inhibit-quit t)) - (if (eq (process-status process) 'stop) - (continue-process process) - ;; not stopped, so it must have died. - ;; cleanup first... - (delete-process process) - (setq itimer-process nil) - ;; now, if there are any active itimers then we need to immediately - ;; start another itimer process, otherwise we can wait until the next - ;; start-itimer call, which will start one automatically. - (if (null itimer-list) - () - ;; there may have been an error message in the echo area; - ;; give the user at least a little time to read it. - (sit-for 2) - (message "itimer process %s... respawning." (substring message 0 -1)) - (itimer-process-start))))) - -(defun itimer-process-start () - (let ((inhibit-quit t) - (process-connection-type nil)) - (setq itimer-process (start-process "itimer" nil "itimer")) - (process-kill-without-query itimer-process) - (set-process-filter itimer-process 'itimer-process-filter) - (set-process-sentinel itimer-process 'itimer-process-sentinel) - ;; Tell itimer process to wake up quickly, so that a correct - ;; wakeup time can be computed. Zero loses because of - ;; underlying itimer implementations that use 0 to mean - ;; `disable the itimer'. - (setq itimer-next-wakeup itimer-short-interval) - (process-send-string itimer-process - (format "%s\n" itimer-next-wakeup)))) - -(defun itimer-process-wakeup () - (interrupt-process itimer-process) - (accept-process-output)) - (defun itimer-timer-start () (let ((inhibit-quit t)) (setq itimer-next-wakeup itimer-short-interval - itimer-timer-last-wakeup (current-time) + itimer-timer-last-wakeup (itimer-time-float (current-time)) itimer-timer (add-timeout itimer-short-interval 'itimer-timer-driver nil nil)))) -(defun itimer-disable-timeout (timeout) - ;; Disgusting hack, but necessary because there is no other way - ;; to remove a timer that has a restart value from while that - ;; timer's function is being run. (FSF Emacs only.) - (if (vectorp timeout) - (aset timeout 4 nil)) - (disable-timeout timeout)) - (defun itimer-timer-wakeup () (let ((inhibit-quit t)) - (itimer-disable-timeout itimer-timer) + (disable-timeout itimer-timer) (setq itimer-timer (add-timeout itimer-short-interval 'itimer-timer-driver nil 5)))) -(defun itimer-time-difference (t1 t2) - (let (usecs secs 65536-secs carry) - (setq usecs (- (nth 2 t1) (nth 2 t2))) - (if (< usecs 0) - (setq carry 1 - usecs (+ usecs 1000000)) - (setq carry 0)) - (setq secs (- (nth 1 t1) (nth 1 t2) carry)) - (if (< secs 0) - (setq carry 1 - secs (+ secs 65536)) - (setq carry 0)) - (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry)) - ;; loses for interval larger than the maximum signed Lisp integer. - ;; can't really be helped. - (+ (* 65536-secs 65536) - secs - (/ usecs (if (featurep 'lisp-float-type) 1e6 1000000))))) - (defun itimer-timer-driver (&rest ignored) ;; inhibit quit because if the user quits at an inopportune ;; time, the timer process won't be launched again and the ＠＠ -853,21 +765,11 ＠＠ (if (not itimer-inside-driver) (let* ((inhibit-quit t) (itimer-inside-driver t) - (now (current-time)) - (elapsed (itimer-time-difference now itimer-timer-last-wakeup)) + (now (itimer-time-float (current-time))) + (elapsed (- now itimer-timer-last-wakeup)) (sleep nil)) (setq itimer-timer-last-wakeup now - sleep (itimer-run-expired-timers elapsed)) - (itimer-disable-timeout itimer-timer) + sleep (itimer-run-expired-timers elapsed now)) + (disable-timeout itimer-timer) (setq itimer-next-wakeup sleep - itimer-timer (add-timeout sleep 'itimer-timer-driver nil 5))))) - -(defun itimer-driver-start () - (if (fboundp 'add-timeout) - (itimer-timer-start) - (itimer-process-start))) - -(defun itimer-driver-wakeup () - (if (fboundp 'add-timeout) - (itimer-timer-wakeup) - (itimer-process-wakeup))) + itimer-timer (add-timeout sleep 'itimer-timer-driver nil 5))))) \ No newline at end of file ------------------------------------------------------------------------ Name: itimer.el itimer.el Type: application/emacs-lisp Encoding: 8bit Description: Itimer 2.00