(U-00024182): Apply new conventions for glyph granularity.

[chise/xemacs-chise.git.1] / lisp / itimer.el

diff --git a/lisp/itimer.el b/lisp/itimer.el
index 78610a9..6c2d793 100644 (file)
--- a/lisp/itimer.el
+++ b/lisp/itimer.el
@@ -20,6 +20,8 @@
 
 (provide 'itimer)
 
 
 (provide 'itimer)
 

+(require 'lisp-float-type)
+

 ;; `itimer' feature means Emacs-Lisp programmers get:
 ;;    itimerp
 ;;    itimer-live-p
 ;; `itimer' feature means Emacs-Lisp programmers get:
 ;;    itimerp
 ;;    itimer-live-p

@@ -46,7 +48,7 @@
 ;;
 ;; See the doc strings of these functions for more information.
 \f
 ;;
 ;; See the doc strings of these functions for more information.
 \f

-(defvar itimer-version "1.07"
+(defvar itimer-version "1.09"

   "Version number of the itimer package.")
 
 (defvar itimer-list nil
   "Version number of the itimer package.")
 
 (defvar itimer-list nil

@@ -62,7 +64,7 @@ is not being used to drive the system.")
 (defvar itimer-timer-last-wakeup nil
   "The time the timer driver function last ran.")
 
 (defvar itimer-timer-last-wakeup nil
   "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.")
   "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.")

@@ -118,7 +120,7 @@ many seconds.")
 ;; signal errors appropriately if the arguments are not valid.
 
 (defmacro check-itimer (var)
 ;; signal errors appropriately if the arguments are not valid.
 
 (defmacro check-itimer (var)

-  "If VAR is not bound to an itimer, signal wrong-type-argument.
+  "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
 This is a macro."
   (list 'setq var
        (list 'if (list 'itimerp var) var

@@ -137,7 +139,7 @@ wrong-type-argument.  This is a macro."
                            (list 'list ''string-or-itimer-p var))))))
 
 (defmacro check-nonnegative-number (var)
                            (list 'list ''string-or-itimer-p 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 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
 If VAR is not bound to a positive number, signal args-out-of-range.
 This is a macro."
   (list 'setq var

@@ -149,7 +151,7 @@ This is a macro."
                    var))))
 
 (defmacro check-string (var)
                    var))))
 
 (defmacro check-string (var)

-  "If VAR is not bound to a string, signal wrong-type-argument.
+  "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
 This is a macro."
   (list 'setq var
        (list 'if (list 'stringp var) var

@@ -158,16 +160,16 @@ This is a macro."
 \f
 ;; Functions to access and modify itimer attributes.
 
 \f
 ;; Functions to access and modify itimer attributes.
 

-(defun itimerp (obj)
-  "Return t if OBJ is an itimer."
-  (and (consp obj) (eq (length obj) 8)))
+(defun itimerp (object)
+  "Return non-nil if OBJECT is an itimer."
+  (and (consp object) (eq (length object) 8)))

 
 

-(defun itimer-live-p (obj)
-  "Return non-nil if OBJ is an itimer and is active.
+(defun itimer-live-p (object)
+  "Return non-nil if OBJECT is an itimer and is active.

 ``Active'' means Emacs will run it when it expires.
 ``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."
 Itimers started with `start-itimer' are automatically active."

-  (and (itimerp obj) (memq obj itimer-list)))
+  (and (itimerp object) (memq object itimer-list)))

 
 (defun itimer-name (itimer)
   "Return the name of ITIMER."
 
 (defun itimer-name (itimer)
   "Return the name of ITIMER."

@@ -181,7 +183,7 @@ Itimers started with `start-itimer' are automatically active."
 
 (defun itimer-restart (itimer)
   "Return the value to which ITIMER will be set at restart.
 
 (defun itimer-restart (itimer)
   "Return the value to which ITIMER will be set at restart.

-Return nil if this itimer doesn't restart."
+The value nil is returned if this itimer isn't set to restart."

   (check-itimer itimer)
   (nth 2 itimer))
 
   (check-itimer itimer)
   (nth 2 itimer))
 

@@ -194,8 +196,8 @@ This function is called each time ITIMER expires."
 (defun itimer-is-idle (itimer)
   "Return non-nil if ITIMER is an idle timer.
 Normal timers expire after a set interval.  Idle timers expire
 (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."
+only after Emacs has been idle for a specific interval.  ``Idle''
+means no command events have occurred within the interval."

   (check-itimer itimer)
   (nth 4 itimer))
 
   (check-itimer itimer)
   (nth 4 itimer))
 

@@ -208,7 +210,7 @@ The arguments themselves are retrievable with `itimer-function-arguments'."
 
 (defun itimer-function-arguments (itimer)
   "Return the function arguments of ITIMER as a list.
 
 (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."
+ITIMER's function is called with these arguments each time ITIMER expires."

   (check-itimer itimer)
   (nth 6 itimer))
 
   (check-itimer itimer)
   (nth 6 itimer))
 

@@ -302,7 +304,7 @@ minibuffer as initial user input."
   (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input)))
 
 (defun delete-itimer (itimer)
   (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input)))
 
 (defun delete-itimer (itimer)

-  "Delete ITIMER.  ITIMER may be an itimer or the name of one."
+  "Deletes ITIMER.  ITIMER may be an itimer or the name of one."

   (check-itimer-coerce-string itimer)
   (setq itimer-list (delq itimer itimer-list)))
 
   (check-itimer-coerce-string itimer)
   (setq itimer-list (delq itimer itimer-list)))
 

@@ -328,12 +330,12 @@ VALUE is the number of seconds until this itimer expires.
 Optional fourth arg RESTART non-nil means that this itimer should be
   restarted automatically after its function is called.  Normally an itimer
   is deleted at expiration after its function has returned.
 Optional fourth arg RESTART non-nil means that this itimer should be
   restarted automatically after its function is called.  Normally an itimer
   is deleted at expiration after its function has returned.

-  If non-nil, RESTART should be a number indicating the value at which
-  the itimer should be set at restart time.
+  If non-nil RESTART should be a number indicating the value at which the
+  itimer should be set at restart time.

 Optional fifth arg IS-IDLE specifies if this is an idle timer.
   Normal timers expire after a set interval.  Idle timers expire
 Optional fifth arg IS-IDLE specifies if this is an idle timer.
   Normal timers expire after a set interval.  Idle timers expire

-  only after Emacs has been idle for specific interval.
-  ``Idle'' means no command events occur within the interval.
+  only after Emacs has been idle for specific interval.  ``Idle''
+  means no command events have occurred within the interval.

 Returns the newly created itimer."
   (interactive
    (list (completing-read "Start itimer: " itimer-list)
 Returns the newly created itimer."
   (interactive
    (list (completing-read "Start itimer: " itimer-list)

@@ -404,6 +406,14 @@ its FUNCTION will be called when it expires, and so on."
        (error "itimer named \"%s\" already existing and activated"
               (itimer-name itimer))))
   (let ((inhibit-quit t))
        (error "itimer named \"%s\" already existing and activated"
               (itimer-name itimer))))
   (let ((inhibit-quit t))

+    (if itimer-timer
+       ;; Modify the itimer timeout value as if it were begun
+       ;; at the last time when the itimer driver was woken up.
+       (set-itimer-value
+        itimer
+        (+ (itimer-value itimer)
+           (itimer-time-difference (current-time)
+                                   itimer-timer-last-wakeup))))

     ;; 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
     ;; 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

@@ -503,7 +513,7 @@ x      start a new itimer
        tab-stop-list '(22 32 40 60 67))
   (abbrev-mode 0)
   (auto-fill-mode 0)
        tab-stop-list '(22 32 40 60 67))
   (abbrev-mode 0)
   (auto-fill-mode 0)

-  (buffer-flush-undo (current-buffer))
+  (buffer-disable-undo (current-buffer))

   (use-local-map itimer-edit-map)
   (set-syntax-table emacs-lisp-mode-syntax-table))
 
   (use-local-map itimer-edit-map)
   (set-syntax-table emacs-lisp-mode-syntax-table))
 

@@ -671,7 +681,7 @@ x      start a new itimer
        (inhibit-quit t))
     (setq next-wakeup 600)
     (cond ((and (boundp 'last-command-event-time)
        (inhibit-quit t))
     (setq next-wakeup 600)
     (cond ((and (boundp 'last-command-event-time)

-               (consp '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)))
           (setq last-event-time last-command-event-time
                 idle-time (itimer-time-difference (current-time)
                                                   last-event-time)))

@@ -712,12 +722,21 @@ x      start a new itimer
        (unwind-protect
            (condition-case condition-data
                (save-match-data
        (unwind-protect
            (condition-case condition-data
                (save-match-data

+                 ;; Suppress warnings - see comment below.
+                 (defvar last-event-time)
+                 (defvar next-wakeup)
+                 (defvar itimer)
+                 (defvar itimers)
+                 (defvar time-elapsed)

                  (let* ((current-itimer itimer)
                         (quit-flag nil)
                         (inhibit-quit nil)
                         ;; for FSF Emacs timer.el emulation under XEmacs.
                         ;; eldoc expect this to be done, apparently.
                         (this-command nil)
                  (let* ((current-itimer itimer)
                         (quit-flag nil)
                         (inhibit-quit nil)
                         ;; for FSF Emacs timer.el emulation under XEmacs.
                         ;; eldoc expect this to be done, apparently.
                         (this-command nil)

+                        ;; bind these variables so that the itimer
+                        ;; function can't screw with them.
+                        last-event-time next-wakeup

                         itimer itimers time-elapsed)
                    (if (itimer-uses-arguments current-itimer)
                        (apply (itimer-function current-itimer)
                         itimer itimers time-elapsed)
                    (if (itimer-uses-arguments current-itimer)
                        (apply (itimer-function current-itimer)

@@ -838,11 +857,9 @@ x      start a new itimer
               secs (+ secs 65536))
       (setq carry 0))
     (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry))
               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)
+    (+ (* 65536-secs 65536.0)

        secs
        secs

-       (/ usecs (if (featurep 'lisp-float-type) 1e6 1000000)))))
+       (/ usecs 1000000.0))))

 
 (defun itimer-timer-driver (&rest ignored)
   ;; inhibit quit because if the user quits at an inopportune
 
 (defun itimer-timer-driver (&rest ignored)
   ;; inhibit quit because if the user quits at an inopportune