diff lisp/itimer.el @ 267:966663fcf606 r20-5b32

Import from CVS: tag r20-5b32
author cvs
date Mon, 13 Aug 2007 10:26:29 +0200
parents 41ff10fd062f
children c5d627a313b1
line wrap: on
line diff
--- a/lisp/itimer.el	Mon Aug 13 10:25:39 2007 +0200
+++ b/lisp/itimer.el	Mon Aug 13 10:26:29 2007 +0200
@@ -1,36 +1,22 @@
-;;; itimer.el --- Interval timers for XEmacs
-
-;; Copyright (C) 1988, 1991, 1993, 1997 Kyle E. Jones
-
-;; Author: Kyle Jones <kyle_jones@wonderworks.com>
-;; Keywords: internal, dumped
-
-;; This file is part of XEmacs.
-
-;; XEmacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; XEmacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; This file is dumped with XEmacs.
-
-;; Send bug reports to kyle_jones@wonderworks.com
-
-;;; Code:
+;;; Interval timers for GNU Emacs
+;;; Copyright (C) 1988, 1991, 1993, 1997, 1998 Kyle E. Jones
+;;;
+;;; 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
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; A copy of the GNU General Public License can be obtained from this
+;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
+;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+;;; 02139, USA.
+;;;
+;;; Send bug reports to kyle_jones@wonderworks.com
 
 (provide 'itimer)
 
@@ -60,7 +46,7 @@
 ;;
 ;; See the doc strings of these functions for more information.
 
-(defvar itimer-version "1.06"
+(defvar itimer-version "1.07"
   "Version number of the itimer package.")
 
 (defvar itimer-list nil
@@ -83,12 +69,12 @@
 
 ;; This value is maintained internally; it does not determine
 ;; itimer granularity.  Itimer granularity is 1 second if your
-;; Emacs doens't support floats or your system doesn't have a
+;; Emacs doesn't support floats or your system doesn't have a
 ;; clock with microsecond granularity.  Otherwise granularity is
-;; to the microsend, although you can't possibly get timers to be
+;; to the microsecond, although you can't possibly get timers to be
 ;; executed with this kind of accuracy in practice.  There will
 ;; be delays due to system and Emacs internal activity that delay
-;; dealing with syunchronous events and process output.
+;; dealing with synchronous events and process output.
 (defvar itimer-next-wakeup itimer-short-interval
   "Itimer process will wakeup to service running itimers within this
 many seconds.")
@@ -517,7 +503,7 @@
 	tab-stop-list '(22 32 40 60 67))
   (abbrev-mode 0)
   (auto-fill-mode 0)
-  (buffer-disable-undo (current-buffer))
+  (buffer-flush-undo (current-buffer))
   (use-local-map itimer-edit-map)
   (set-syntax-table emacs-lisp-mode-syntax-table))
 
@@ -684,15 +670,20 @@
 	;; catch them and print a message.
 	(inhibit-quit t))
     (setq next-wakeup 600)
-    (if (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.
-      (setq last-event-time '(0 0 0)
-	    idle-time 0))
+    (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)))
     (while itimers
       (setq itimer (car itimers))
       (if (itimer-is-idle itimer)
@@ -741,9 +732,17 @@
 	    (set-itimer-value-internal itimer (itimer-restart itimer))
 	    (setq next-wakeup (min next-wakeup (itimer-value itimer))))))
       (setq itimers (cdr itimers)))
-    ;; if user is editing itimers, update displayed info
-    (if (eq major-mode 'itimer-edit-mode)
-	(list-itimers))
+    ;; make another sweep through the list to catch any timers
+    ;; that might have been added by timer functions above.
+    (setq itimers itimer-list)
+    (while itimers
+      (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))))
     next-wakeup ))
 
 (defun itimer-process-filter (process string)
@@ -812,12 +811,17 @@
 	  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))
-    (cond ((fboundp 'disable-timeout)
-	   (disable-timeout itimer-timer))
-	  ((fboundp 'cancel-timer)
-	   (cancel-timer itimer-timer)))
+    (itimer-disable-timeout itimer-timer)
     (setq itimer-timer (add-timeout itimer-short-interval
 				    'itimer-timer-driver nil 5))))
 
@@ -842,7 +846,7 @@
 
 (defun itimer-timer-driver (&rest ignored)
   ;; inhibit quit because if the user quits at an inopportune
-  ;; time, the timer process won't bne launched again and the
+  ;; time, the timer process won't be launched again and the
   ;; system stops working.  itimer-run-expired-timers allows
   ;; individual timer function to be aborted, so the user can
   ;; escape a feral timer function.
@@ -854,7 +858,7 @@
 	     (sleep nil))
 	(setq itimer-timer-last-wakeup now
 	      sleep (itimer-run-expired-timers elapsed))
-	(disable-timeout itimer-timer)
+	(itimer-disable-timeout itimer-timer)
 	(setq itimer-next-wakeup sleep
 	      itimer-timer (add-timeout sleep 'itimer-timer-driver nil 5)))))
 
@@ -867,5 +871,3 @@
   (if (fboundp 'add-timeout)
       (itimer-timer-wakeup)
     (itimer-process-wakeup)))
-
-;;; itimer.el ends here