Could you possibly rewrite this a bit so as to use defstruct? cl is now a standard
part of XEmacs so there's absolutely no point in continuing to use vectors for
structs.
ben
Jan Vroonhof wrote:
> 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>
>
> * 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
--
ben
--
In order to save my hands, I am cutting back on my responses, especially to
XEmacs-related mail. You
_will_ get a response, but please be patient. If you need an immediate response
and its not apparent in
your message, please say so. Thanks for your understanding.