;; XEmacs has a buggy version of run-at-time. This file defines a
;; non-buggy version of the same.
-(require 'itimer)
-
-(eval-and-compile
- (when (featurep 'xemacs)
- (defalias
- 'run-at-time
- (if (condition-case nil
- (progn
- (unless (or itimer-process itimer-timer)
- (itimer-driver-start))
- ;; Check whether there is a bug to which the difference of
- ;; the present time and the time when the itimer driver was
- ;; woken up is subtracted from the initial itimer value.
- (let* ((inhibit-quit t)
- (ctime (current-time))
- (itimer-timer-last-wakeup
- (prog1
- ctime
- (setcar ctime (1- (car ctime)))))
- (itimer-list nil)
- (itimer (start-itimer "fixed-run-at-time" 'ignore 5)))
- (sleep-for 0.1) ;; Accept the timeout interrupt.
- (prog1
- (> (itimer-value itimer) 0)
- (delete-itimer itimer))))
- (error nil))
- (lambda (time repeat function &rest args)
- "Emulating function run as `run-at-time'.
+(defalias
+ 'run-at-time
+ (if (condition-case nil
+ (progn
+ (unless (or itimer-process itimer-timer)
+ (itimer-driver-start))
+ ;; Check whether there is a bug to which the difference of
+ ;; the present time and the time when the itimer driver was
+ ;; woken up is subtracted from the initial itimer value.
+ (let* ((inhibit-quit t)
+ (ctime (current-time))
+ (itimer-timer-last-wakeup
+ (prog1
+ ctime
+ (setcar ctime (1- (car ctime)))))
+ (itimer-list nil)
+ (itimer (start-itimer "run-at-time" 'ignore 5)))
+ (sleep-for 0.1) ;; Accept the timeout interrupt.
+ (prog1
+ (> (itimer-value itimer) 0)
+ (delete-itimer itimer))))
+ (error nil))
+ (lambda (time repeat function &rest args)
+ "Function emulating the function of the same name of Emacs.
TIME should be nil meaning now, or a number of seconds from now.
Return an itimer object which can be used in either `delete-itimer'
or `cancel-timer'."
- (apply #'start-itimer "fixed-run-at-time"
- function (if time (max time 1e-9) 1e-9)
- repeat nil t args))
- (lambda (time repeat function &rest args)
- "Emulating function run as `run-at-time' in the right way.
+ (apply #'start-itimer "run-at-time"
+ function (if time (max time 1e-9) 1e-9)
+ repeat nil t args))
+ (lambda (time repeat function &rest args)
+ "Function emulating the function of the same name of Emacs.
+It works correctly for TIME even if there is a bug in the XEmacs core.
TIME should be nil meaning now, or a number of seconds from now.
Return an itimer object which can be used in either `delete-itimer'
or `cancel-timer'."
- (let ((itimers (list nil)))
- (setcar
- itimers
- (apply #'start-itimer "fixed-run-at-time"
- (lambda (itimers repeat function &rest args)
- (let ((itimer (car itimers)))
- (if repeat
- (progn
- (set-itimer-function
- itimer
- (lambda (itimer repeat function &rest args)
- (set-itimer-restart itimer repeat)
- (set-itimer-function itimer function)
- (set-itimer-function-arguments itimer args)
- (apply function args)))
- (set-itimer-function-arguments
- itimer
- (append (list itimer repeat function) args)))
+ (let ((itimers (list nil)))
+ (setcar
+ itimers
+ (apply #'start-itimer "fixed-run-at-time"
+ (lambda (itimers repeat function &rest args)
+ (let ((itimer (car itimers)))
+ (if repeat
+ (progn
(set-itimer-function
itimer
- (lambda (itimer function &rest args)
- (delete-itimer itimer)
+ (lambda (itimer repeat function &rest args)
+ (set-itimer-restart itimer repeat)
+ (set-itimer-function itimer function)
+ (set-itimer-function-arguments itimer args)
(apply function args)))
(set-itimer-function-arguments
itimer
- (append (list itimer function) args)))))
- 1e-9 (if time (max time 1e-9) 1e-9)
- nil t itimers repeat function args))))))))
-
-(defvar run-at-time-saved (symbol-function 'run-at-time))
+ (append (list itimer repeat function) args)))
+ (set-itimer-function
+ itimer
+ (lambda (itimer function &rest args)
+ (delete-itimer itimer)
+ (apply function args)))
+ (set-itimer-function-arguments
+ itimer
+ (append (list itimer function) args)))))
+ 1e-9 (if time (max time 1e-9) 1e-9)
+ nil t itimers repeat function args))))))
(provide 'run-at-time)
projects / gnus / blobdiff