1 ;;; Interval timers for SXEmacs
2 ;;; Copyright (C) 1988, 1991, 1993, 1997, 1998 Kyle E. Jones
4 ;; SXEmacs is free software: you can redistribute it and/or modify
5 ;; it under the terms of the GNU General Public License as published by
6 ;; the Free Software Foundation, either version 3 of the License, or
7 ;; (at your option) any later version.
9 ;; SXEmacs is distributed in the hope that it will be useful,
10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 ;; GNU General Public License for more details.
14 ;; You should have received a copy of the GNU General Public License
15 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
17 ;;; Send bug reports to kyle_jones@wonderworks.com
21 (require 'lisp-float-type)
23 ;; `itimer' feature means Emacs-Lisp programmers get:
29 ;; itimer-uses-arguments
30 ;; itimer-function-arguments
33 ;; set-itimer-function
34 ;; set-itimer-uses-arguments
35 ;; set-itimer-function-arguments
42 ;; Interactive users get these commands:
47 ;; See the doc strings of these functions for more information.
49 (defvar itimer-version "1.09"
50 "Version number of the itimer package.")
52 (defvar itimer-list nil
53 "List of all active itimers.")
55 (defvar itimer-process nil
56 "Process that drives all itimers, if a subprocess is being used.")
58 (defvar itimer-timer nil
59 "Emacs internal timer that drives the itimer system, if a subprocess
60 is not being used to drive the system.")
62 (defvar itimer-timer-last-wakeup nil
63 "The time the timer driver function last ran.")
65 (defvar itimer-short-interval 1e-3
66 "Interval used for scheduling an event a very short time in the future.
67 Used internally to make the scheduler wake up early.
70 ;; This value is maintained internally; it does not determine
71 ;; itimer granularity. Itimer granularity is 1 second if your
72 ;; Emacs doesn't support floats or your system doesn't have a
73 ;; clock with microsecond granularity. Otherwise granularity is
74 ;; to the microsecond, although you can't possibly get timers to be
75 ;; executed with this kind of accuracy in practice. There will
76 ;; be delays due to system and Emacs internal activity that delay
77 ;; dealing with synchronous events and process output.
78 (defvar itimer-next-wakeup itimer-short-interval
79 "Itimer process will wakeup to service running itimers within this
82 (defvar itimer-edit-map nil
83 "Keymap used when in Itimer Edit mode.")
87 (setq itimer-edit-map (make-sparse-keymap))
88 (define-key itimer-edit-map "s" 'itimer-edit-set-field)
89 (define-key itimer-edit-map "d" 'itimer-edit-delete-itimer)
90 (define-key itimer-edit-map "q" 'itimer-edit-quit)
91 (define-key itimer-edit-map "\t" 'itimer-edit-next-field)
92 (define-key itimer-edit-map " " 'next-line)
93 (define-key itimer-edit-map "n" 'next-line)
94 (define-key itimer-edit-map "p" 'previous-line)
95 (define-key itimer-edit-map "\C-?" 'itimer-edit-previous-field)
96 (define-key itimer-edit-map "x" 'start-itimer)
97 (define-key itimer-edit-map "?" 'itimer-edit-help))
99 (defvar itimer-inside-driver nil)
101 (defvar itimer-edit-start-marker nil)
103 ;; macros must come first... or byte-compile'd code will throw back its
106 (defmacro itimer-decrement (variable)
107 (list 'setq variable (list '1- variable)))
109 (defmacro itimer-increment (variable)
110 (list 'setq variable (list '1+ variable)))
112 (defmacro itimer-signum (n)
113 (list 'if (list '> n 0) 1
114 (list 'if (list 'zerop n) 0 -1)))
116 ;; Itimer access functions should behave as if they were subrs. These
117 ;; macros are used to check the arguments to the itimer functions and
118 ;; signal errors appropriately if the arguments are not valid.
120 (defmacro check-itimer (var)
121 "If VAR is not bound to an itimer, signal `wrong-type-argument'.
124 (list 'if (list 'itimerp var) var
125 (list 'signal ''wrong-type-argument
126 (list 'list ''itimerp var)))))
128 (defmacro check-itimer-coerce-string (var)
129 "If VAR is not bound to a string, look up the itimer that it names and
130 bind VAR to it. Otherwise, if VAR is not bound to an itimer, signal
131 wrong-type-argument. This is a macro."
134 (list (list 'itimerp var) var)
135 (list (list 'stringp var) (list 'get-itimer var))
136 (list t (list 'signal ''wrong-type-argument
137 (list 'list ''string-or-itimer-p var))))))
139 (defmacro check-nonnegative-number (var)
140 "If VAR is not bound to a number, signal `wrong-type-argument'.
141 If VAR is not bound to a positive number, signal args-out-of-range.
144 (list 'if (list 'not (list 'numberp var))
145 (list 'signal ''wrong-type-argument
146 (list 'list ''natnump var))
147 (list 'if (list '< var 0)
148 (list 'signal ''args-out-of-range (list 'list var))
151 (defmacro check-string (var)
152 "If VAR is not bound to a string, signal `wrong-type-argument'.
155 (list 'if (list 'stringp var) var
156 (list 'signal ''wrong-type-argument
157 (list 'list ''stringp var)))))
159 ;; Functions to access and modify itimer attributes.
161 (defun itimerp (object)
162 "Return non-nil if OBJECT is an itimer."
163 (and (consp object) (eq (length object) 8)))
165 (defun itimer-live-p (object)
166 "Return non-nil if OBJECT is an itimer and is active.
167 ``Active'' means Emacs will run it when it expires.
168 `activate-itimer' must be called on an itimer to make it active.
169 Itimers started with `start-itimer' are automatically active."
170 (and (itimerp object) (memq object itimer-list)))
172 (defun itimer-name (itimer)
173 "Return the name of ITIMER."
174 (check-itimer itimer)
177 (defun itimer-value (itimer)
178 "Return the number of seconds until ITIMER expires."
179 (check-itimer itimer)
182 (defun itimer-restart (itimer)
183 "Return the value to which ITIMER will be set at restart.
184 The value nil is returned if this itimer isn't set to restart."
185 (check-itimer itimer)
188 (defun itimer-function (itimer)
189 "Return the function of ITIMER.
190 This function is called each time ITIMER expires."
191 (check-itimer itimer)
194 (defun itimer-is-idle (itimer)
195 "Return non-nil if ITIMER is an idle timer.
196 Normal timers expire after a set interval. Idle timers expire
197 only after Emacs has been idle for a specific interval. ``Idle''
198 means no command events have occurred within the interval."
199 (check-itimer itimer)
202 (defun itimer-uses-arguments (itimer)
203 "Return non-nil if the function of ITIMER will be called with arguments.
204 ITIMER's function is called with the arguments each time ITIMER expires.
205 The arguments themselves are retrievable with `itimer-function-arguments'."
206 (check-itimer itimer)
209 (defun itimer-function-arguments (itimer)
210 "Return the function arguments of ITIMER as a list.
211 ITIMER's function is called with these arguments each time ITIMER expires."
212 (check-itimer itimer)
215 (defun itimer-recorded-run-time (itimer)
216 (check-itimer itimer)
219 (defun set-itimer-value (itimer value)
220 "Set the timeout value of ITIMER to be VALUE.
221 Itimer will expire in this many seconds.
222 If your version of Emacs supports floating point numbers then
223 VALUE can be a floating point number. Otherwise it
226 (check-itimer itimer)
227 (check-nonnegative-number value)
228 (let ((inhibit-quit t))
229 ;; If the itimer is in the active list, and under the new
230 ;; timeout value would expire before we would normally
231 ;; wakeup, wakeup now and recompute a new wakeup time.
232 (or (and (< value itimer-next-wakeup)
233 (and (itimer-name itimer) (get-itimer (itimer-name itimer)))
234 (progn (itimer-driver-wakeup)
235 (setcar (cdr itimer) value)
236 (itimer-driver-wakeup)
238 (setcar (cdr itimer) value))
241 ;; Same as set-itimer-value but does not wakeup the driver.
242 ;; Only should be used by the drivers when processing expired timers.
243 (defun set-itimer-value-internal (itimer value)
244 (check-itimer itimer)
245 (check-nonnegative-number value)
246 (setcar (cdr itimer) value))
248 (defun set-itimer-restart (itimer restart)
249 "Set the restart value of ITIMER to be RESTART.
250 If RESTART is nil, ITIMER will not restart when it expires.
251 If your version of Emacs supports floating point numbers then
252 RESTART can be a floating point number. Otherwise it
255 (check-itimer itimer)
256 (if restart (check-nonnegative-number restart))
257 (setcar (cdr (cdr itimer)) restart))
259 (defun set-itimer-function (itimer function)
260 "Set the function of ITIMER to be FUNCTION.
261 FUNCTION will be called when itimer expires.
263 (check-itimer itimer)
264 (setcar (nthcdr 3 itimer) function))
266 (defun set-itimer-is-idle (itimer flag)
267 "Set flag that says whether ITIMER is an idle timer.
268 If FLAG is non-nil, then ITIMER will be considered an idle timer.
270 (check-itimer itimer)
271 (setcar (nthcdr 4 itimer) flag))
273 (defun set-itimer-uses-arguments (itimer flag)
274 "Set flag that says whether the function of ITIMER is called with arguments.
275 If FLAG is non-nil, then the function will be called with one argument,
276 otherwise the function will be called with no arguments.
278 (check-itimer itimer)
279 (setcar (nthcdr 5 itimer) flag))
281 (defun set-itimer-function-arguments (itimer &optional arguments)
282 "Set the function arguments of ITIMER to be ARGUMENTS.
283 The function of ITIMER will be called with ARGUMENTS when itimer expires.
285 (check-itimer itimer)
286 (setcar (nthcdr 6 itimer) arguments))
288 (defun set-itimer-recorded-run-time (itimer time)
289 (check-itimer itimer)
290 (setcar (nthcdr 7 itimer) time))
292 (defun get-itimer (name)
293 "Return itimer named NAME, or nil if there is none."
295 (assoc name itimer-list))
297 (defun read-itimer (prompt &optional initial-input)
298 "Read the name of an itimer from the minibuffer and return the itimer
299 associated with that name. The user is prompted with PROMPT.
300 Optional second arg INITIAL-INPUT non-nil is inserted into the
301 minibuffer as initial user input."
302 (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input)))
304 (defun delete-itimer (itimer)
305 "Deletes ITIMER. ITIMER may be an itimer or the name of one."
306 (check-itimer-coerce-string itimer)
307 (setq itimer-list (delq itimer itimer-list)))
309 (defun start-itimer (name function value &optional restart
310 is-idle with-args &rest function-arguments)
313 NAME, FUNCTION, VALUE &optional RESTART, IS-IDLE, WITH-ARGS, &rest FUNCTION-ARGUMENTS.
314 NAME is an identifier for the itimer. It must be a string. If an itimer
315 already exists with this name, NAME will be modified slightly to make
317 FUNCTION should be a function (or symbol naming one). It
318 will be called each time the itimer expires with arguments of
319 FUNCTION-ARGUMENTS. The function can access the itimer that
320 invoked it through the variable `current-itimer'. If WITH-ARGS
321 is nil then FUNCTION is called with no arguments. This is for
322 backward compatibility with older versions of the itimer
323 package which always called FUNCTION with no arguments.
324 VALUE is the number of seconds until this itimer expires.
325 If your version of Emacs supports floating point numbers then
326 VALUE can be a floating point number. Otherwise it
328 Optional fourth arg RESTART non-nil means that this itimer should be
329 restarted automatically after its function is called. Normally an itimer
330 is deleted at expiration after its function has returned.
331 If non-nil RESTART should be a number indicating the value at which the
332 itimer should be set at restart time.
333 Optional fifth arg IS-IDLE specifies if this is an idle timer.
334 Normal timers expire after a set interval. Idle timers expire
335 only after Emacs has been idle for specific interval. ``Idle''
336 means no command events have occurred within the interval.
337 Returns the newly created itimer."
339 (list (completing-read "Start itimer: " itimer-list)
340 (read (completing-read "Itimer function: " obarray 'fboundp))
342 (while (or (not (numberp value)) (< value 0))
343 (setq value (read-from-minibuffer "Itimer value: " nil nil t)))
346 (while (and restart (or (not (numberp restart)) (< restart 0)))
347 (setq restart (read-from-minibuffer "Itimer restart: "
350 ;; hard to imagine the user specifying these interactively
354 (check-nonnegative-number value)
355 (if restart (check-nonnegative-number restart))
356 ;; Make proposed itimer name unique if it's not already.
359 (while (get-itimer name)
360 (setq name (format "%s<%d>" oname num))
361 (itimer-increment num)))
362 (activate-itimer (list name value restart function is-idle
363 with-args function-arguments (list 0 0 0)))
366 (defun make-itimer ()
367 "Create an unactivated itimer.
368 The itimer will not begin running until activated with `activate-itimer'.
369 Set the itimer's expire interval with `set-itimer-value'.
370 Set the itimer's function interval with `set-itimer-function'.
371 Once this is done, the timer can be activated."
372 (list nil 0 nil 'ignore nil nil nil (list 0 0 0)))
374 (defun activate-itimer (itimer)
375 "Activate ITIMER, which was previously created with `make-itimer'.
376 ITIMER will be added to the global list of running itimers,
377 its FUNCTION will be called when it expires, and so on."
378 (check-itimer itimer)
379 (if (memq itimer itimer-list)
380 (error "itimer already activated"))
381 (if (not (numberp (itimer-value itimer)))
382 (error "itimer timeout value not a number: %s" (itimer-value itimer)))
383 (if (<= (itimer-value itimer) 0)
384 (error "itimer timeout value not positive: %s" (itimer-value itimer)))
385 ;; If there's no itimer driver/process, start one now.
386 ;; Otherwise wake up the itimer driver so that seconds slept before
387 ;; the new itimer is created won't be counted against it.
388 (if (or itimer-process itimer-timer)
389 (itimer-driver-wakeup)
390 (itimer-driver-start))
391 ;; Roll a unique name for the timer if it doesn't have a name
393 (if (not (stringp (car itimer)))
394 (let ((name "itimer-0")
397 (while (get-itimer name)
398 (setq name (format "%s<%d>" oname num))
399 (itimer-increment num))
400 (setcar itimer name))
401 ;; signal an error if the timer's name matches an already
403 (if (get-itimer (itimer-name itimer))
404 (error "itimer named \"%s\" already existing and activated"
405 (itimer-name itimer))))
406 (let ((inhibit-quit t))
408 ;; Modify the itimer timeout value as if it were begun
409 ;; at the last time when the itimer driver was woken up.
412 (+ (itimer-value itimer)
413 (itimer-time-difference (current-time)
414 itimer-timer-last-wakeup))))
415 ;; add the itimer to the global list
416 (setq itimer-list (cons itimer itimer-list))
417 ;; If the itimer process is scheduled to wake up too late for
418 ;; the itimer we wake it up to calculate a correct wakeup
419 ;; value giving consideration to the newly added itimer.
420 (if (< (itimer-value itimer) itimer-next-wakeup)
421 (itimer-driver-wakeup))))
423 ;; User level functions to list and modify existing itimers.
424 ;; Itimer Edit major mode, and the editing commands thereof.
426 (defun list-itimers ()
427 "Pop up a buffer containing a list of all itimers.
428 The major mode of the buffer is Itimer Edit mode. This major mode provides
429 commands to manipulate itimers; see the documentation for
430 `itimer-edit-mode' for more information."
432 (let* ((buf (get-buffer-create "*Itimer List*"))
434 (standard-output buf)
435 (itimers (reverse itimer-list)))
438 (setq buffer-read-only nil)
441 "Name Value Restart Function Idle Arguments"
443 "---- ----- ------- -------- ---- --------")
444 (if (null itimer-edit-start-marker)
445 (setq itimer-edit-start-marker (point)))
448 (prin1 (itimer-name (car itimers)))
450 (insert (itimer-truncate-string
451 (format "%5.5s" (itimer-value (car itimers))) 5))
453 (insert (itimer-truncate-string
454 (format "%5.5s" (itimer-restart (car itimers))) 5))
456 (insert (itimer-truncate-string
457 (format "%.19s" (itimer-function (car itimers))) 19))
459 (if (itimer-is-idle (car itimers))
463 (if (itimer-uses-arguments (car itimers))
464 (prin1 (itimer-function-arguments (car itimers)))
466 (setq itimers (cdr itimers)))
469 (if (< (point) itimer-edit-start-marker)
470 (goto-char itimer-edit-start-marker))
471 (setq buffer-read-only t)
472 (display-buffer buf)))
474 (defun edit-itimers ()
475 "Display a list of all itimers and select it for editing.
476 The major mode of the buffer containing the listing is Itimer Edit mode.
477 This major mode provides commands to manipulate itimers; see the documentation
478 for `itimer-edit-mode' for more information."
480 ;; since user is editing, make sure displayed data is reasonably up-to-date
481 (if (or itimer-process itimer-timer)
482 (itimer-driver-wakeup))
484 (select-window (get-buffer-window "*Itimer List*"))
485 (goto-char itimer-edit-start-marker)
490 (message "type q to quit, ? for help"))
492 ;; no point in making this interactive.
493 (defun itimer-edit-mode ()
494 "Major mode for manipulating itimers.
495 Attributes of running itimers are changed by moving the cursor to the
496 desired field and typing `s' to set that field. The field will then be
497 set to the value read from the minibuffer.
500 TAB move forward a field
501 DEL move backward a field
503 d delete the selected itimer
506 (kill-all-local-variables)
507 (make-local-variable 'tab-stop-list)
508 (setq major-mode 'itimer-edit-mode
509 mode-name "Itimer Edit"
511 tab-stop-list '(22 32 40 60 67))
514 (buffer-disable-undo (current-buffer))
515 (use-local-map itimer-edit-map)
516 (set-syntax-table emacs-lisp-mode-syntax-table))
518 (put 'itimer-edit-mode 'mode-class 'special)
520 (defun itimer-edit-help ()
521 "Help function for Itimer Edit."
523 (if (eq last-command 'itimer-edit-help)
525 (message "TAB, DEL select fields, (s)et field, (d)elete itimer (type ? for more help)")))
527 (defun itimer-edit-quit ()
530 (bury-buffer (current-buffer))
532 (switch-to-buffer (other-buffer (current-buffer)))
535 (defun itimer-edit-set-field ()
537 ;; First two lines in list buffer are headers.
538 ;; Cry out against the luser who attempts to change a field there.
539 (if (<= (point) itimer-edit-start-marker)
541 ;; field-value must be initialized to be something other than a
542 ;; number, symbol, or list.
543 (let (itimer field (field-value ""))
544 (setq itimer (save-excursion
545 ;; read the name of the itimer from the beginning of
548 (get-itimer (read (current-buffer))))
549 field (save-excursion
550 (itimer-edit-beginning-of-field)
551 (let ((opoint (point))
553 ;; count the number of sexprs until we reach the cursor
554 ;; and use this info to determine which field the user
557 (while (and (>= opoint (point)) (< n 6))
560 (itimer-increment n))
561 (cond ((eq n 1) (error "Cannot change itimer name."))
566 (t 'function-argument)))))
567 (cond ((eq field 'value)
568 (let ((prompt "Set itimer value: "))
569 (while (not (natnump field-value))
570 (setq field-value (read-from-minibuffer prompt nil nil t)))))
572 (let ((prompt "Set itimer restart: "))
573 (while (and field-value (not (natnump field-value)))
574 (setq field-value (read-from-minibuffer prompt nil nil t)))))
575 ((eq field 'function)
576 (let ((prompt "Set itimer function: "))
577 (while (not (or (and (symbolp field-value) (fboundp field-value))
578 (and (consp field-value)
579 (memq (car field-value) '(lambda macro)))))
581 (read (completing-read prompt obarray 'fboundp nil))))))
583 (setq field-value (not (itimer-is-idle itimer))))
584 ((eq field 'function-argument)
585 (let ((prompt "Set itimer function argument: "))
586 (setq field-value (read-expression prompt))
587 (cond ((not (listp field-value))
588 (setq field-value (list field-value))))
589 (if (null field-value)
590 (set-itimer-uses-arguments itimer nil)
591 (set-itimer-uses-arguments itimer t)))))
592 ;; set the itimer field
593 (funcall (intern (concat "set-itimer-" (symbol-name field)))
595 ;; move to beginning of field to be changed
596 (itimer-edit-beginning-of-field)
597 ;; modify the list buffer to reflect the change.
598 (let (buffer-read-only kill-ring)
600 (kill-region (point) (progn (skip-chars-forward " \t") (point)))
601 (prin1 field-value (current-buffer))
606 (defun itimer-edit-delete-itimer ()
608 ;; First two lines in list buffer are headers.
609 ;; Cry out against the luser who attempts to change a field there.
610 (if (<= (point) itimer-edit-start-marker)
613 (read-itimer "Delete itimer: "
614 (save-excursion (beginning-of-line) (read (current-buffer)))))
615 ;; update list information
618 (defun itimer-edit-next-field (count)
620 (itimer-edit-beginning-of-field)
621 (cond ((> (itimer-signum count) 0)
622 (while (not (zerop count))
624 ;; wrap from eob to itimer-edit-start-marker
627 (goto-char itimer-edit-start-marker)
631 ;; treat fields at beginning of line as if they weren't there.
636 (itimer-decrement count)))
637 ((< (itimer-signum count) 0)
638 (while (not (zerop count))
640 ;; treat fields at beginning of line as if they weren't there.
643 ;; wrap from itimer-edit-start-marker to field at eob.
644 (if (<= (point) itimer-edit-start-marker)
646 (goto-char (point-max))
648 (itimer-increment count)))))
650 (defun itimer-edit-previous-field (count)
652 (itimer-edit-next-field (- count)))
654 (defun itimer-edit-beginning-of-field ()
655 (let ((forw-back (save-excursion (forward-sexp) (backward-sexp) (point)))
656 (back (save-excursion (backward-sexp) (point))))
657 (cond ((eq forw-back back) (backward-sexp))
658 ((eq forw-back (point)) t)
659 (t (backward-sexp)))))
661 (defun itimer-truncate-string (str len)
662 (if (<= (length str) len)
664 (substring str 0 len)))
666 ;; internals of the itimer implementation.
668 (defun itimer-run-expired-timers (time-elapsed)
669 (let ((itimers (copy-sequence itimer-list))
675 ;; process filters can be hit by stray C-g's from the user,
676 ;; so we must protect this stuff appropriately.
677 ;; Quit's are allowed from within itimer functions, but we
678 ;; catch them and print a message.
680 (setq next-wakeup 600)
681 (cond ((and (boundp 'last-command-event-time)
682 (consp last-command-event-time))
683 (setq last-event-time last-command-event-time
684 idle-time (itimer-time-difference (current-time)
686 ((and (boundp 'last-input-time) (consp last-input-time))
687 (setq last-event-time (list (car last-input-time)
688 (cdr last-input-time)
690 idle-time (itimer-time-difference (current-time)
692 ;; no way to do this under FSF Emacs yet.
693 (t (setq last-event-time '(0 0 0)
696 (setq itimer (car itimers))
697 (if (itimer-is-idle itimer)
698 (setq recorded-run-time (itimer-recorded-run-time itimer))
699 (set-itimer-value-internal itimer (max 0 (- (itimer-value itimer)
701 (if (if (itimer-is-idle itimer)
702 (or (> (itimer-time-difference recorded-run-time
705 (< idle-time (itimer-value itimer)))
706 (> (itimer-value itimer) 0))
708 (if (itimer-is-idle itimer)
709 (if (< idle-time (itimer-value itimer))
710 (min next-wakeup (- (itimer-value itimer) idle-time))
711 (min next-wakeup (itimer-value itimer)))
712 (min next-wakeup (itimer-value itimer))))
713 (and (itimer-is-idle itimer)
714 (set-itimer-recorded-run-time itimer (current-time)))
715 ;; itimer has expired, we must call its function.
716 ;; protect our local vars from the itimer function.
717 ;; allow keyboard quit to occur, but catch and report it.
718 ;; provide the variable `current-itimer' in case the function
721 (condition-case condition-data
723 ;; Suppress warnings - see comment below.
724 (defvar last-event-time)
728 (defvar time-elapsed)
729 (let* ((current-itimer itimer)
732 ;; for FSF Emacs timer.el emulation under XEmacs.
733 ;; eldoc expect this to be done, apparently.
735 ;; bind these variables so that the itimer
736 ;; function can't screw with them.
737 last-event-time next-wakeup
738 itimer itimers time-elapsed)
739 (if (itimer-uses-arguments current-itimer)
740 (apply (itimer-function current-itimer)
741 (itimer-function-arguments current-itimer))
742 (funcall (itimer-function current-itimer)))))
743 (error (message "itimer \"%s\" signaled: %s" (itimer-name itimer)
744 (prin1-to-string condition-data)))
745 (quit (message "itimer \"%s\" quit" (itimer-name itimer))))
746 ;; restart the itimer if we should, otherwise delete it.
747 (if (null (itimer-restart itimer))
748 (delete-itimer itimer)
749 (set-itimer-value-internal itimer (itimer-restart itimer))
750 (setq next-wakeup (min next-wakeup (itimer-value itimer))))))
751 (setq itimers (cdr itimers)))
752 ;; make another sweep through the list to catch any timers
753 ;; that might have been added by timer functions above.
754 (setq itimers itimer-list)
756 (setq next-wakeup (min next-wakeup (itimer-value (car itimers)))
757 itimers (cdr itimers)))
758 ;; if user is viewing the timer list, update displayed info.
759 (let ((b (get-buffer "*Itimer List*")))
760 (if (and b (get-buffer-window b))
765 (defun itimer-process-filter (process string)
766 ;; If the itimer process dies and generates output while doing
767 ;; so, we may be called before the process-sentinel. Sanity
768 ;; check the output just in case...
769 (if (not (string-match "^[0-9]" string))
770 (progn (message "itimer process gave odd output: %s" string)
771 ;; it may be still alive and waiting for input
772 (process-send-string itimer-process "3\n"))
773 ;; if there are no active itimers, return quickly.
777 (setq wakeup (itimer-run-expired-timers (string-to-int string)))
778 (and (null wakeup) (process-send-string process "1\n")))
779 (setq itimer-next-wakeup wakeup))
780 (setq itimer-next-wakeup 600))
781 ;; tell itimer-process when to wakeup again
782 (process-send-string itimer-process
783 (concat (int-to-string itimer-next-wakeup)
786 (defun itimer-process-sentinel (process message)
787 (let ((inhibit-quit t))
788 (if (eq (process-status process) 'stop)
789 (continue-process process)
790 ;; not stopped, so it must have died.
792 (delete-process process)
793 (setq itimer-process nil)
794 ;; now, if there are any active itimers then we need to immediately
795 ;; start another itimer process, otherwise we can wait until the next
796 ;; start-itimer call, which will start one automatically.
797 (if (null itimer-list)
799 ;; there may have been an error message in the echo area;
800 ;; give the user at least a little time to read it.
802 (message "itimer process %s... respawning." (substring message 0 -1))
803 (itimer-process-start)))))
805 (defun itimer-process-start ()
806 (let ((inhibit-quit t)
807 (process-connection-type nil))
808 (setq itimer-process (start-process "itimer" nil "itimer"))
809 (process-kill-without-query itimer-process)
810 (set-process-filter itimer-process 'itimer-process-filter)
811 (set-process-sentinel itimer-process 'itimer-process-sentinel)
812 ;; Tell itimer process to wake up quickly, so that a correct
813 ;; wakeup time can be computed. Zero loses because of
814 ;; underlying itimer implementations that use 0 to mean
815 ;; `disable the itimer'.
816 (setq itimer-next-wakeup itimer-short-interval)
817 (process-send-string itimer-process
818 (format "%s\n" itimer-next-wakeup))))
820 (defun itimer-process-wakeup ()
821 (interrupt-process itimer-process)
822 (accept-process-output))
824 (defun itimer-timer-start ()
825 (let ((inhibit-quit t))
826 (setq itimer-next-wakeup itimer-short-interval
827 itimer-timer-last-wakeup (current-time)
828 itimer-timer (add-timeout itimer-short-interval
829 'itimer-timer-driver nil nil))))
831 (defun itimer-disable-timeout (timeout)
832 ;; Disgusting hack, but necessary because there is no other way
833 ;; to remove a timer that has a restart value from while that
834 ;; timer's function is being run. (FSF Emacs only.)
835 (if (vectorp timeout)
836 (aset timeout 4 nil))
837 (disable-timeout timeout))
839 (defun itimer-timer-wakeup ()
840 (let ((inhibit-quit t))
841 (itimer-disable-timeout itimer-timer)
842 (setq itimer-timer (add-timeout itimer-short-interval
843 'itimer-timer-driver nil 5))))
845 (defun itimer-time-difference (t1 t2)
846 (let (usecs secs 65536-secs carry)
847 (setq usecs (- (nth 2 t1) (nth 2 t2)))
850 usecs (+ usecs 1000000))
852 (setq secs (- (nth 1 t1) (nth 1 t2) carry))
857 (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry))
858 (+ (* 65536-secs 65536.0)
860 (/ usecs 1000000.0))))
862 (defun itimer-timer-driver (&rest ignored)
863 ;; inhibit quit because if the user quits at an inopportune
864 ;; time, the timer process won't be launched again and the
865 ;; system stops working. itimer-run-expired-timers allows
866 ;; individual timer function to be aborted, so the user can
867 ;; escape a feral timer function.
868 (if (not itimer-inside-driver)
869 (let* ((inhibit-quit t)
870 (itimer-inside-driver t)
872 (elapsed (itimer-time-difference now itimer-timer-last-wakeup))
874 (setq itimer-timer-last-wakeup now
875 sleep (itimer-run-expired-timers elapsed))
876 (itimer-disable-timeout itimer-timer)
877 (setq itimer-next-wakeup sleep
878 itimer-timer (add-timeout sleep 'itimer-timer-driver nil 5)))))
880 (defun itimer-driver-start ()
881 (if (fboundp 'add-timeout)
883 (itimer-process-start)))
885 (defun itimer-driver-wakeup ()
886 (if (fboundp 'add-timeout)
887 (itimer-timer-wakeup)
888 (itimer-process-wakeup)))