]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/timer.el
Merge from emacs-23
[gnu-emacs] / lisp / emacs-lisp / timer.el
index 16d1af331fabc55e1435286c23f3931087095b94..130b1ae23ebe2ce184bb0723e089eae56b231715 100644 (file)
@@ -4,6 +4,7 @@
 ;;   2009, 2010, 2011  Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
@@ -92,31 +93,20 @@ fire each time Emacs is idle for that many seconds."
 More precisely, the next value, after TIME, that is an integral multiple
 of SECS seconds since the epoch.  SECS may be a fraction."
   (let ((time-base (ash 1 16)))
-    (if (fboundp 'atan)
-       ;; Use floating point, taking care to not lose precision.
-       (let* ((float-time-base (float time-base))
-              (million 1000000.0)
-              (time-usec (+ (* million
-                               (+ (* float-time-base (nth 0 time))
-                                  (nth 1 time)))
-                            (nth 2 time)))
-              (secs-usec (* million secs))
-              (mod-usec (mod time-usec secs-usec))
-              (next-usec (+ (- time-usec mod-usec) secs-usec))
-              (time-base-million (* float-time-base million)))
-         (list (floor next-usec time-base-million)
-               (floor (mod next-usec time-base-million) million)
-               (floor (mod next-usec million))))
-      ;; Floating point is not supported.
-      ;; Use integer arithmetic, avoiding overflow if possible.
-      (let* ((mod-sec (mod (+ (* (mod time-base secs)
-                                (mod (nth 0 time) secs))
-                             (nth 1 time))
-                          secs))
-            (next-1-sec (+ (- (nth 1 time) mod-sec) secs)))
-       (list (+ (nth 0 time) (floor next-1-sec time-base))
-             (mod next-1-sec time-base)
-             0)))))
+    ;; Use floating point, taking care to not lose precision.
+    (let* ((float-time-base (float time-base))
+          (million 1000000.0)
+          (time-usec (+ (* million
+                           (+ (* float-time-base (nth 0 time))
+                              (nth 1 time)))
+                        (nth 2 time)))
+          (secs-usec (* million secs))
+          (mod-usec (mod time-usec secs-usec))
+          (next-usec (+ (- time-usec mod-usec) secs-usec))
+          (time-base-million (* float-time-base million)))
+      (list (floor next-usec time-base-million)
+           (floor (mod next-usec time-base-million) million)
+           (floor (mod next-usec million))))))
 
 (defun timer-relative-time (time secs &optional usecs)
   "Advance TIME by SECS seconds and optionally USECS microseconds.
@@ -321,7 +311,11 @@ This function is called, by name, directly by the C code."
          ;; We do this after rescheduling so that the handler function
          ;; can cancel its own timer successfully with cancel-timer.
          (condition-case nil
-             (apply (timer--function timer) (timer--args timer))
+              ;; Timer functions should not change the current buffer.
+              ;; If they do, all kinds of nasty surprises can happen,
+              ;; and it can be hellish to track down their source.
+              (save-current-buffer
+                (apply (timer--function timer) (timer--args timer)))
            (error nil))
          (if retrigger
              (setf (timer--triggered timer) nil)))
@@ -438,8 +432,6 @@ This function returns a timer object which you can use in `cancel-timer'."
   "This is the timer function used for the timer made by `with-timeout'."
   (throw tag 'timeout))
 
-(put 'with-timeout 'lisp-indent-function 1)
-
 (defvar with-timeout-timers nil
   "List of all timers used by currently pending `with-timeout' calls.")
 
@@ -451,6 +443,7 @@ event (such as keyboard input, input from subprocesses, or a certain time);
 if the program loops without waiting in any way, the timeout will not
 be detected.
 \n(fn (SECONDS TIMEOUT-FORMS...) BODY)"
+  (declare (indent 1))
   (let ((seconds (car list))
        (timeout-forms (cdr list)))
     `(let ((with-timeout-tag (cons nil nil))
@@ -539,5 +532,4 @@ If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
 \f
 (provide 'timer)
 
-;; arch-tag: b1a9237b-7787-4382-9e46-8f2c3b3273e0
 ;;; timer.el ends here