annotate lisp/itimer.el @ 2303:0da64f4bd0bc

[xemacs-hg @ 2004-09-22 22:14:47 by james] Do not uniquify names in set-itimer-name, as requested by Kyle.
author james
date Wed, 22 Sep 2004 22:14:51 +0000
parents 13a418960a88
children d8c340c9adb6
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 446
diff changeset
1 ;;; Interval timers for XEmacs
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 ;;; Copyright (C) 1988, 1991, 1993, 1997, 1998 Kyle E. Jones
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;;; This program is free software; you can redistribute it and/or modify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;;; it under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;;; This program is distributed in the hope that it will be useful,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;;; GNU General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;;; A copy of the GNU General Public License can be obtained from this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;;; 02139, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;;; Send bug reports to kyle_jones@wonderworks.com
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 (provide 'itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
23 (require 'lisp-float-type)
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
24
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; `itimer' feature means Emacs-Lisp programmers get:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;; itimerp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;; itimer-live-p
2285
914c5afaac33 [xemacs-hg @ 2004-09-20 19:11:29 by james]
james
parents: 2284
diff changeset
28 ;; itimer-name
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;; itimer-value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;; itimer-restart
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; itimer-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;; itimer-uses-arguments
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; itimer-function-arguments
2285
914c5afaac33 [xemacs-hg @ 2004-09-20 19:11:29 by james]
james
parents: 2284
diff changeset
34 ;; set-itimer-name
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; set-itimer-value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;; set-itimer-restart
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; set-itimer-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; set-itimer-uses-arguments
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; set-itimer-function-arguments
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; get-itimer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;; start-itimer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; read-itimer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; delete-itimer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; activate-itimer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ;; Interactive users get these commands:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; edit-itimers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;; list-itimers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;; start-itimer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;; See the doc strings of these functions for more information.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
53 (defvar itimer-version "1.09"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 "Version number of the itimer package.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 (defvar itimer-list nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 "List of all active itimers.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 (defvar itimer-process nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 "Process that drives all itimers, if a subprocess is being used.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (defvar itimer-timer nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 "Emacs internal timer that drives the itimer system, if a subprocess
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 is not being used to drive the system.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 (defvar itimer-timer-last-wakeup nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 "The time the timer driver function last ran.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
69 (defvar itimer-short-interval 1e-3
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 "Interval used for scheduling an event a very short time in the future.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 Used internally to make the scheduler wake up early.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 Unit is seconds.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;; This value is maintained internally; it does not determine
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;; itimer granularity. Itimer granularity is 1 second if your
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;; Emacs doesn't support floats or your system doesn't have a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ;; clock with microsecond granularity. Otherwise granularity is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 ;; to the microsecond, although you can't possibly get timers to be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 ;; executed with this kind of accuracy in practice. There will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 ;; be delays due to system and Emacs internal activity that delay
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;; dealing with synchronous events and process output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (defvar itimer-next-wakeup itimer-short-interval
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 "Itimer process will wakeup to service running itimers within this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 many seconds.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 (defvar itimer-edit-map nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 "Keymap used when in Itimer Edit mode.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (if itimer-edit-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 (setq itimer-edit-map (make-sparse-keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (define-key itimer-edit-map "s" 'itimer-edit-set-field)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 (define-key itimer-edit-map "d" 'itimer-edit-delete-itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (define-key itimer-edit-map "q" 'itimer-edit-quit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 (define-key itimer-edit-map "\t" 'itimer-edit-next-field)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (define-key itimer-edit-map " " 'next-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 (define-key itimer-edit-map "n" 'next-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (define-key itimer-edit-map "p" 'previous-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (define-key itimer-edit-map "\C-?" 'itimer-edit-previous-field)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (define-key itimer-edit-map "x" 'start-itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 (define-key itimer-edit-map "?" 'itimer-edit-help))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (defvar itimer-inside-driver nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (defvar itimer-edit-start-marker nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 ;; macros must come first... or byte-compile'd code will throw back its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 ;; head and scream.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (defmacro itimer-decrement (variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 (list 'setq variable (list '1- variable)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 (defmacro itimer-increment (variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 (list 'setq variable (list '1+ variable)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (defmacro itimer-signum (n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (list 'if (list '> n 0) 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 (list 'if (list 'zerop n) 0 -1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 ;; Itimer access functions should behave as if they were subrs. These
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 ;; macros are used to check the arguments to the itimer functions and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 ;; signal errors appropriately if the arguments are not valid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 (defmacro check-itimer (var)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
125 "If VAR is not bound to an itimer, signal `wrong-type-argument'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 This is a macro."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 (list 'setq var
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 (list 'if (list 'itimerp var) var
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 (list 'signal ''wrong-type-argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 (list 'list ''itimerp var)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (defmacro check-itimer-coerce-string (var)
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 2292
diff changeset
133 "If VAR is bound to a string, look up the itimer that it names and
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 bind VAR to it. Otherwise, if VAR is not bound to an itimer, signal
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 2292
diff changeset
135 `wrong-type-argument'. This is a macro."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (list 'setq var
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (list 'cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 (list (list 'itimerp var) var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 (list (list 'stringp var) (list 'get-itimer var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 (list t (list 'signal ''wrong-type-argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (list 'list ''string-or-itimer-p var))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 (defmacro check-nonnegative-number (var)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
144 "If VAR is not bound to a number, signal `wrong-type-argument'.
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 2292
diff changeset
145 If VAR is not bound to a positive number, signal `args-out-of-range'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 This is a macro."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 (list 'setq var
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 (list 'if (list 'not (list 'numberp var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (list 'signal ''wrong-type-argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (list 'list ''natnump var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (list 'if (list '< var 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 (list 'signal ''args-out-of-range (list 'list var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 var))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (defmacro check-string (var)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
156 "If VAR is not bound to a string, signal `wrong-type-argument'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 This is a macro."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (list 'setq var
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (list 'if (list 'stringp var) var
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (list 'signal ''wrong-type-argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 (list 'list ''stringp var)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 ;; Functions to access and modify itimer attributes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
165 (defun itimerp (object)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
166 "Return non-nil if OBJECT is an itimer."
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
167 (and (consp object) (eq (length object) 8)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
169 (defun itimer-live-p (object)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
170 "Return non-nil if OBJECT is an itimer and is active.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 ``Active'' means Emacs will run it when it expires.
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
172 `activate-itimer' must be called on an itimer to make it active.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 Itimers started with `start-itimer' are automatically active."
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
174 (and (itimerp object) (memq object itimer-list)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 (defun itimer-name (itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 "Return the name of ITIMER."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 (car itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 (defun itimer-value (itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 "Return the number of seconds until ITIMER expires."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 (nth 1 itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 (defun itimer-restart (itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 "Return the value to which ITIMER will be set at restart.
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
188 The value nil is returned if this itimer isn't set to restart."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 (nth 2 itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (defun itimer-function (itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 "Return the function of ITIMER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 This function is called each time ITIMER expires."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (nth 3 itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 (defun itimer-is-idle (itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 "Return non-nil if ITIMER is an idle timer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 Normal timers expire after a set interval. Idle timers expire
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
201 only after Emacs has been idle for a specific interval. ``Idle''
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
202 means no command events have occurred within the interval."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 (nth 4 itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (defun itimer-uses-arguments (itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 "Return non-nil if the function of ITIMER will be called with arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 ITIMER's function is called with the arguments each time ITIMER expires.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 The arguments themselves are retrievable with `itimer-function-arguments'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (nth 5 itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 (defun itimer-function-arguments (itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 "Return the function arguments of ITIMER as a list.
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
215 ITIMER's function is called with these arguments each time ITIMER expires."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 (nth 6 itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (defun itimer-recorded-run-time (itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (nth 7 itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222
2285
914c5afaac33 [xemacs-hg @ 2004-09-20 19:11:29 by james]
james
parents: 2284
diff changeset
223 (defun set-itimer-name (itimer name)
914c5afaac33 [xemacs-hg @ 2004-09-20 19:11:29 by james]
james
parents: 2284
diff changeset
224 "Set the name of ITIMER to be NAME.
2303
0da64f4bd0bc [xemacs-hg @ 2004-09-22 22:14:47 by james]
james
parents: 2297
diff changeset
225 NAME is an identifier for the itimer. It must be a string. If an active
0da64f4bd0bc [xemacs-hg @ 2004-09-22 22:14:47 by james]
james
parents: 2297
diff changeset
226 itimer already exists with this name, an error is signaled."
2285
914c5afaac33 [xemacs-hg @ 2004-09-20 19:11:29 by james]
james
parents: 2284
diff changeset
227 (check-string name)
2303
0da64f4bd0bc [xemacs-hg @ 2004-09-22 22:14:47 by james]
james
parents: 2297
diff changeset
228 (and (itimer-live-p itimer)
0da64f4bd0bc [xemacs-hg @ 2004-09-22 22:14:47 by james]
james
parents: 2297
diff changeset
229 (get-itimer name)
0da64f4bd0bc [xemacs-hg @ 2004-09-22 22:14:47 by james]
james
parents: 2297
diff changeset
230 (error "itimer named \"%s\" already existing and activated" name))
2285
914c5afaac33 [xemacs-hg @ 2004-09-20 19:11:29 by james]
james
parents: 2284
diff changeset
231 (setcar itimer name))
914c5afaac33 [xemacs-hg @ 2004-09-20 19:11:29 by james]
james
parents: 2284
diff changeset
232
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 (defun set-itimer-value (itimer value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 "Set the timeout value of ITIMER to be VALUE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 Itimer will expire in this many seconds.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 If your version of Emacs supports floating point numbers then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 VALUE can be a floating point number. Otherwise it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 must be an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 Returns VALUE."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 (check-nonnegative-number value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (let ((inhibit-quit t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 ;; If the itimer is in the active list, and under the new
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 ;; timeout value would expire before we would normally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 ;; wakeup, wakeup now and recompute a new wakeup time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (or (and (< value itimer-next-wakeup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 (and (itimer-name itimer) (get-itimer (itimer-name itimer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (progn (itimer-driver-wakeup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (setcar (cdr itimer) value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (itimer-driver-wakeup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 t ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 (setcar (cdr itimer) value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 ;; Same as set-itimer-value but does not wakeup the driver.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 ;; Only should be used by the drivers when processing expired timers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 (defun set-itimer-value-internal (itimer value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (check-nonnegative-number value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 (setcar (cdr itimer) value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (defun set-itimer-restart (itimer restart)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 "Set the restart value of ITIMER to be RESTART.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 If RESTART is nil, ITIMER will not restart when it expires.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 If your version of Emacs supports floating point numbers then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 RESTART can be a floating point number. Otherwise it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 must be an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 Returns RESTART."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 (if restart (check-nonnegative-number restart))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 (setcar (cdr (cdr itimer)) restart))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (defun set-itimer-function (itimer function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 "Set the function of ITIMER to be FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 FUNCTION will be called when itimer expires.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 Returns FUNCTION."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (setcar (nthcdr 3 itimer) function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 (defun set-itimer-is-idle (itimer flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 "Set flag that says whether ITIMER is an idle timer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 If FLAG is non-nil, then ITIMER will be considered an idle timer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 Returns FLAG."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (setcar (nthcdr 4 itimer) flag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (defun set-itimer-uses-arguments (itimer flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 "Set flag that says whether the function of ITIMER is called with arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 If FLAG is non-nil, then the function will be called with one argument,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 otherwise the function will be called with no arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 Returns FLAG."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (setcar (nthcdr 5 itimer) flag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (defun set-itimer-function-arguments (itimer &optional arguments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 "Set the function arguments of ITIMER to be ARGUMENTS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 The function of ITIMER will be called with ARGUMENTS when itimer expires.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 Returns ARGUMENTS."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (setcar (nthcdr 6 itimer) arguments))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 (defun set-itimer-recorded-run-time (itimer time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (setcar (nthcdr 7 itimer) time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (defun get-itimer (name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 "Return itimer named NAME, or nil if there is none."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 (check-string name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (assoc name itimer-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (defun read-itimer (prompt &optional initial-input)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 "Read the name of an itimer from the minibuffer and return the itimer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 associated with that name. The user is prompted with PROMPT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 Optional second arg INITIAL-INPUT non-nil is inserted into the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 minibuffer as initial user input."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 (defun delete-itimer (itimer)
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
319 "Deletes ITIMER. ITIMER may be an itimer or the name of one."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 (check-itimer-coerce-string itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 (setq itimer-list (delq itimer itimer-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (defun start-itimer (name function value &optional restart
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 is-idle with-args &rest function-arguments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 "Start an itimer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 Arguments are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 NAME, FUNCTION, VALUE &optional RESTART, IS-IDLE, WITH-ARGS, &rest FUNCTION-ARGUMENTS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 NAME is an identifier for the itimer. It must be a string. If an itimer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 already exists with this name, NAME will be modified slightly to make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 it unique.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 FUNCTION should be a function (or symbol naming one). It
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 will be called each time the itimer expires with arguments of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 FUNCTION-ARGUMENTS. The function can access the itimer that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 invoked it through the variable `current-itimer'. If WITH-ARGS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 is nil then FUNCTION is called with no arguments. This is for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 backward compatibility with older versions of the itimer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 package which always called FUNCTION with no arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 VALUE is the number of seconds until this itimer expires.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 If your version of Emacs supports floating point numbers then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 VALUE can be a floating point number. Otherwise it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 must be an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 Optional fourth arg RESTART non-nil means that this itimer should be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 restarted automatically after its function is called. Normally an itimer
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
344 is deleted at expiration after its function has returned.
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
345 If non-nil RESTART should be a number indicating the value at which the
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
346 itimer should be set at restart time.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 Optional fifth arg IS-IDLE specifies if this is an idle timer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 Normal timers expire after a set interval. Idle timers expire
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
349 only after Emacs has been idle for specific interval. ``Idle''
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
350 means no command events have occurred within the interval.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 Returns the newly created itimer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (list (completing-read "Start itimer: " itimer-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (read (completing-read "Itimer function: " obarray 'fboundp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 (let (value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 (while (or (not (numberp value)) (< value 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (setq value (read-from-minibuffer "Itimer value: " nil nil t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (let ((restart t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (while (and restart (or (not (numberp restart)) (< restart 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (setq restart (read-from-minibuffer "Itimer restart: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 nil nil t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 restart)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 ;; hard to imagine the user specifying these interactively
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 nil ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (check-nonnegative-number value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (if restart (check-nonnegative-number restart))
2292
9eeed79aee25 [xemacs-hg @ 2004-09-21 14:54:25 by james]
james
parents: 2285
diff changeset
369 (let ((itimer (list name value restart function is-idle
9eeed79aee25 [xemacs-hg @ 2004-09-21 14:54:25 by james]
james
parents: 2285
diff changeset
370 with-args function-arguments (list 0 0 0))))
9eeed79aee25 [xemacs-hg @ 2004-09-21 14:54:25 by james]
james
parents: 2285
diff changeset
371 ;; Make proposed itimer name unique if it's not already.
9eeed79aee25 [xemacs-hg @ 2004-09-21 14:54:25 by james]
james
parents: 2285
diff changeset
372 (set-itimer-name itimer name)
9eeed79aee25 [xemacs-hg @ 2004-09-21 14:54:25 by james]
james
parents: 2285
diff changeset
373 (activate-itimer itimer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (car itimer-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (defun make-itimer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 "Create an unactivated itimer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 The itimer will not begin running until activated with `activate-itimer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 Set the itimer's expire interval with `set-itimer-value'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 Set the itimer's function interval with `set-itimer-function'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 Once this is done, the timer can be activated."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (list nil 0 nil 'ignore nil nil nil (list 0 0 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (defun activate-itimer (itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 "Activate ITIMER, which was previously created with `make-itimer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 ITIMER will be added to the global list of running itimers,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 its FUNCTION will be called when it expires, and so on."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (check-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 (if (memq itimer itimer-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (error "itimer already activated"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (if (not (numberp (itimer-value itimer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (error "itimer timeout value not a number: %s" (itimer-value itimer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (if (<= (itimer-value itimer) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 (error "itimer timeout value not positive: %s" (itimer-value itimer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 ;; If there's no itimer driver/process, start one now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 ;; Otherwise wake up the itimer driver so that seconds slept before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 ;; the new itimer is created won't be counted against it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (if (or itimer-process itimer-timer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (itimer-driver-wakeup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (itimer-driver-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 ;; Roll a unique name for the timer if it doesn't have a name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 ;; already.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (if (not (stringp (car itimer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (let ((name "itimer-0")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (oname "itimer-")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (num 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (while (get-itimer name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 (setq name (format "%s<%d>" oname num))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 (itimer-increment num))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (setcar itimer name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 ;; signal an error if the timer's name matches an already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 ;; activated timer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (if (get-itimer (itimer-name itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 (error "itimer named \"%s\" already existing and activated"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 (itimer-name itimer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 (let ((inhibit-quit t))
2284
17dfe8e3aead [xemacs-hg @ 2004-09-20 18:11:33 by james]
james
parents: 613
diff changeset
417 (if itimer-timer
17dfe8e3aead [xemacs-hg @ 2004-09-20 18:11:33 by james]
james
parents: 613
diff changeset
418 ;; Modify the itimer timeout value as if it were begun
17dfe8e3aead [xemacs-hg @ 2004-09-20 18:11:33 by james]
james
parents: 613
diff changeset
419 ;; at the last time when the itimer driver was woken up.
17dfe8e3aead [xemacs-hg @ 2004-09-20 18:11:33 by james]
james
parents: 613
diff changeset
420 (set-itimer-value
17dfe8e3aead [xemacs-hg @ 2004-09-20 18:11:33 by james]
james
parents: 613
diff changeset
421 itimer
17dfe8e3aead [xemacs-hg @ 2004-09-20 18:11:33 by james]
james
parents: 613
diff changeset
422 (+ (itimer-value itimer)
17dfe8e3aead [xemacs-hg @ 2004-09-20 18:11:33 by james]
james
parents: 613
diff changeset
423 (itimer-time-difference (current-time)
17dfe8e3aead [xemacs-hg @ 2004-09-20 18:11:33 by james]
james
parents: 613
diff changeset
424 itimer-timer-last-wakeup))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 ;; add the itimer to the global list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 (setq itimer-list (cons itimer itimer-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 ;; If the itimer process is scheduled to wake up too late for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 ;; the itimer we wake it up to calculate a correct wakeup
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 ;; value giving consideration to the newly added itimer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 (if (< (itimer-value itimer) itimer-next-wakeup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (itimer-driver-wakeup))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 ;; User level functions to list and modify existing itimers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 ;; Itimer Edit major mode, and the editing commands thereof.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 (defun list-itimers ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 "Pop up a buffer containing a list of all itimers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 The major mode of the buffer is Itimer Edit mode. This major mode provides
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 commands to manipulate itimers; see the documentation for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 `itimer-edit-mode' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 (let* ((buf (get-buffer-create "*Itimer List*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 (opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (standard-output buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (itimers (reverse itimer-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (set-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (itimer-edit-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 (setq buffer-read-only nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 (insert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 "Name Value Restart Function Idle Arguments"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 "\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 "---- ----- ------- -------- ---- --------")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 (if (null itimer-edit-start-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (setq itimer-edit-start-marker (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (while itimers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (newline 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (prin1 (itimer-name (car itimers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (tab-to-tab-stop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 (insert (itimer-truncate-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 (format "%5.5s" (itimer-value (car itimers))) 5))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 (tab-to-tab-stop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 (insert (itimer-truncate-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 (format "%5.5s" (itimer-restart (car itimers))) 5))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (tab-to-tab-stop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (insert (itimer-truncate-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (format "%.19s" (itimer-function (car itimers))) 19))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (tab-to-tab-stop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (if (itimer-is-idle (car itimers))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (insert "yes")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 (insert "no"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 (tab-to-tab-stop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 (if (itimer-uses-arguments (car itimers))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 (prin1 (itimer-function-arguments (car itimers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (prin1 'NONE))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (setq itimers (cdr itimers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 ;; restore point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 (goto-char opoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 (if (< (point) itimer-edit-start-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 (goto-char itimer-edit-start-marker))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (setq buffer-read-only t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 (display-buffer buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 (defun edit-itimers ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 "Display a list of all itimers and select it for editing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 The major mode of the buffer containing the listing is Itimer Edit mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 This major mode provides commands to manipulate itimers; see the documentation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 for `itimer-edit-mode' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 ;; since user is editing, make sure displayed data is reasonably up-to-date
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (if (or itimer-process itimer-timer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (itimer-driver-wakeup))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (list-itimers)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (select-window (get-buffer-window "*Itimer List*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 (goto-char itimer-edit-start-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 (if itimer-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 (forward-sexp 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (backward-sexp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 (message "type q to quit, ? for help"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 ;; no point in making this interactive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 (defun itimer-edit-mode ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 "Major mode for manipulating itimers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 Attributes of running itimers are changed by moving the cursor to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 desired field and typing `s' to set that field. The field will then be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 set to the value read from the minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 Commands:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 TAB move forward a field
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 DEL move backward a field
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 s set a field
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 d delete the selected itimer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 x start a new itimer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 ? help"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 (kill-all-local-variables)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 (make-local-variable 'tab-stop-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 (setq major-mode 'itimer-edit-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 mode-name "Itimer Edit"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 truncate-lines t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 tab-stop-list '(22 32 40 60 67))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 (abbrev-mode 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 (auto-fill-mode 0)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
524 (buffer-disable-undo (current-buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (use-local-map itimer-edit-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (set-syntax-table emacs-lisp-mode-syntax-table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 (put 'itimer-edit-mode 'mode-class 'special)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 (defun itimer-edit-help ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 "Help function for Itimer Edit."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (if (eq last-command 'itimer-edit-help)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 (describe-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 (message "TAB, DEL select fields, (s)et field, (d)elete itimer (type ? for more help)")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (defun itimer-edit-quit ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 "End Itimer Edit."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 (bury-buffer (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 (if (one-window-p t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (switch-to-buffer (other-buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 (delete-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (defun itimer-edit-set-field ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 ;; First two lines in list buffer are headers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 ;; Cry out against the luser who attempts to change a field there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 (if (<= (point) itimer-edit-start-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 (error ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 ;; field-value must be initialized to be something other than a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 ;; number, symbol, or list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 (let (itimer field (field-value ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 (setq itimer (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 ;; read the name of the itimer from the beginning of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 ;; the current line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 (get-itimer (read (current-buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 field (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 (itimer-edit-beginning-of-field)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 (let ((opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 (n 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 ;; count the number of sexprs until we reach the cursor
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 ;; and use this info to determine which field the user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 ;; wants to modify.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 (while (and (>= opoint (point)) (< n 6))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (forward-sexp 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 (backward-sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 (itimer-increment n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (cond ((eq n 1) (error "Cannot change itimer name."))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 ((eq n 2) 'value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 ((eq n 3) 'restart)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 ((eq n 4) 'function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 ((eq n 5) 'is-idle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 (t 'function-argument)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 (cond ((eq field 'value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 (let ((prompt "Set itimer value: "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 (while (not (natnump field-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 (setq field-value (read-from-minibuffer prompt nil nil t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 ((eq field 'restart)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 (let ((prompt "Set itimer restart: "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 (while (and field-value (not (natnump field-value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 (setq field-value (read-from-minibuffer prompt nil nil t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 ((eq field 'function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 (let ((prompt "Set itimer function: "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 (while (not (or (and (symbolp field-value) (fboundp field-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 (and (consp field-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 (memq (car field-value) '(lambda macro)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 (setq field-value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 (read (completing-read prompt obarray 'fboundp nil))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 ((eq field 'is-idle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 (setq field-value (not (itimer-is-idle itimer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 ((eq field 'function-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (let ((prompt "Set itimer function argument: "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (setq field-value (read-expression prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (cond ((not (listp field-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 (setq field-value (list field-value))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 (if (null field-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 (set-itimer-uses-arguments itimer nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 (set-itimer-uses-arguments itimer t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 ;; set the itimer field
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (funcall (intern (concat "set-itimer-" (symbol-name field)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 itimer field-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 ;; move to beginning of field to be changed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (itimer-edit-beginning-of-field)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 ;; modify the list buffer to reflect the change.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 (let (buffer-read-only kill-ring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (kill-sexp 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (kill-region (point) (progn (skip-chars-forward " \t") (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (prin1 field-value (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 (if (not (eolp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (tab-to-tab-stop))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 (backward-sexp))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 (defun itimer-edit-delete-itimer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 ;; First two lines in list buffer are headers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 ;; Cry out against the luser who attempts to change a field there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 (if (<= (point) itimer-edit-start-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 (error ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 (delete-itimer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 (read-itimer "Delete itimer: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 (save-excursion (beginning-of-line) (read (current-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 ;; update list information
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (list-itimers))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 (defun itimer-edit-next-field (count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 (itimer-edit-beginning-of-field)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 (cond ((> (itimer-signum count) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 (while (not (zerop count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 (forward-sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 ;; wrap from eob to itimer-edit-start-marker
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 (if (eobp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (goto-char itimer-edit-start-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 (forward-sexp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 (forward-sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 (backward-sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 ;; treat fields at beginning of line as if they weren't there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 (if (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 (forward-sexp 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 (backward-sexp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 (itimer-decrement count)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 ((< (itimer-signum count) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 (while (not (zerop count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 (backward-sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 ;; treat fields at beginning of line as if they weren't there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 (if (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 (backward-sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 ;; wrap from itimer-edit-start-marker to field at eob.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 (if (<= (point) itimer-edit-start-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 (backward-sexp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 (itimer-increment count)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (defun itimer-edit-previous-field (count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 (itimer-edit-next-field (- count)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 (defun itimer-edit-beginning-of-field ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 (let ((forw-back (save-excursion (forward-sexp) (backward-sexp) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 (back (save-excursion (backward-sexp) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 (cond ((eq forw-back back) (backward-sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 ((eq forw-back (point)) t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 (t (backward-sexp)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 (defun itimer-truncate-string (str len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 (if (<= (length str) len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 str
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 (substring str 0 len)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 ;; internals of the itimer implementation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (defun itimer-run-expired-timers (time-elapsed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (let ((itimers (copy-sequence itimer-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 (itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 (next-wakeup 600)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 (idle-time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 (last-event-time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 (recorded-run-time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 ;; process filters can be hit by stray C-g's from the user,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 ;; so we must protect this stuff appropriately.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 ;; Quit's are allowed from within itimer functions, but we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 ;; catch them and print a message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 (inhibit-quit t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 (setq next-wakeup 600)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 (cond ((and (boundp 'last-command-event-time)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
692 (consp last-command-event-time))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (setq last-event-time last-command-event-time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 idle-time (itimer-time-difference (current-time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 last-event-time)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 ((and (boundp 'last-input-time) (consp last-input-time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (setq last-event-time (list (car last-input-time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (cdr last-input-time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 idle-time (itimer-time-difference (current-time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 last-event-time)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 ;; no way to do this under FSF Emacs yet.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 (t (setq last-event-time '(0 0 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 idle-time 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 (while itimers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 (setq itimer (car itimers))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 (if (itimer-is-idle itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (setq recorded-run-time (itimer-recorded-run-time itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 (set-itimer-value-internal itimer (max 0 (- (itimer-value itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 time-elapsed))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (if (if (itimer-is-idle itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 (or (> (itimer-time-difference recorded-run-time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 last-event-time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 (< idle-time (itimer-value itimer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 (> (itimer-value itimer) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 (setq next-wakeup
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 (if (itimer-is-idle itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 (if (< idle-time (itimer-value itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 (min next-wakeup (- (itimer-value itimer) idle-time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 (min next-wakeup (itimer-value itimer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 (min next-wakeup (itimer-value itimer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 (and (itimer-is-idle itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 (set-itimer-recorded-run-time itimer (current-time)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 ;; itimer has expired, we must call its function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 ;; protect our local vars from the itimer function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 ;; allow keyboard quit to occur, but catch and report it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 ;; provide the variable `current-itimer' in case the function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 ;; is interested.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 (condition-case condition-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 (save-match-data
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
733 ;; Suppress warnings - see comment below.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
734 (defvar last-event-time)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
735 (defvar next-wakeup)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
736 (defvar itimer)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
737 (defvar itimers)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
738 (defvar time-elapsed)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 (let* ((current-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 (quit-flag nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 (inhibit-quit nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 ;; for FSF Emacs timer.el emulation under XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 ;; eldoc expect this to be done, apparently.
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
744 (this-command nil)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
745 ;; bind these variables so that the itimer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
746 ;; function can't screw with them.
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
747 last-event-time next-wakeup
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
748 itimer itimers time-elapsed)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 (if (itimer-uses-arguments current-itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 (apply (itimer-function current-itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 (itimer-function-arguments current-itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 (funcall (itimer-function current-itimer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 (error (message "itimer \"%s\" signaled: %s" (itimer-name itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 (prin1-to-string condition-data)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 (quit (message "itimer \"%s\" quit" (itimer-name itimer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 ;; restart the itimer if we should, otherwise delete it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 (if (null (itimer-restart itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 (delete-itimer itimer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 (set-itimer-value-internal itimer (itimer-restart itimer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 (setq next-wakeup (min next-wakeup (itimer-value itimer))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 (setq itimers (cdr itimers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 ;; make another sweep through the list to catch any timers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 ;; that might have been added by timer functions above.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 (setq itimers itimer-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 (while itimers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 (setq next-wakeup (min next-wakeup (itimer-value (car itimers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 itimers (cdr itimers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 ;; if user is viewing the timer list, update displayed info.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 (let ((b (get-buffer "*Itimer List*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 (if (and b (get-buffer-window b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (list-itimers))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 next-wakeup ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 (defun itimer-process-filter (process string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 ;; If the itimer process dies and generates output while doing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 ;; so, we may be called before the process-sentinel. Sanity
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 ;; check the output just in case...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 (if (not (string-match "^[0-9]" string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 (progn (message "itimer process gave odd output: %s" string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 ;; it may be still alive and waiting for input
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 (process-send-string itimer-process "3\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 ;; if there are no active itimers, return quickly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 (if itimer-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (let ((wakeup nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 (setq wakeup (itimer-run-expired-timers (string-to-int string)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 (and (null wakeup) (process-send-string process "1\n")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 (setq itimer-next-wakeup wakeup))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 (setq itimer-next-wakeup 600))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 ;; tell itimer-process when to wakeup again
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 (process-send-string itimer-process
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 (concat (int-to-string itimer-next-wakeup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 "\n"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 (defun itimer-process-sentinel (process message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 (let ((inhibit-quit t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 (if (eq (process-status process) 'stop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 (continue-process process)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 ;; not stopped, so it must have died.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 ;; cleanup first...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 (delete-process process)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 (setq itimer-process nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 ;; now, if there are any active itimers then we need to immediately
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 ;; start another itimer process, otherwise we can wait until the next
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 ;; start-itimer call, which will start one automatically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 (if (null itimer-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 ;; there may have been an error message in the echo area;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 ;; give the user at least a little time to read it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 (sit-for 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 (message "itimer process %s... respawning." (substring message 0 -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 (itimer-process-start)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 (defun itimer-process-start ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 (let ((inhibit-quit t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 (process-connection-type nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 (setq itimer-process (start-process "itimer" nil "itimer"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 (process-kill-without-query itimer-process)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 (set-process-filter itimer-process 'itimer-process-filter)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 (set-process-sentinel itimer-process 'itimer-process-sentinel)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 ;; Tell itimer process to wake up quickly, so that a correct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 ;; wakeup time can be computed. Zero loses because of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 ;; underlying itimer implementations that use 0 to mean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 ;; `disable the itimer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 (setq itimer-next-wakeup itimer-short-interval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 (process-send-string itimer-process
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 (format "%s\n" itimer-next-wakeup))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 (defun itimer-process-wakeup ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 (interrupt-process itimer-process)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 (accept-process-output))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 (defun itimer-timer-start ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 (let ((inhibit-quit t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 (setq itimer-next-wakeup itimer-short-interval
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 itimer-timer-last-wakeup (current-time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 itimer-timer (add-timeout itimer-short-interval
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 'itimer-timer-driver nil nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 (defun itimer-disable-timeout (timeout)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 ;; Disgusting hack, but necessary because there is no other way
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 ;; to remove a timer that has a restart value from while that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 ;; timer's function is being run. (FSF Emacs only.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 (if (vectorp timeout)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 (aset timeout 4 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 (disable-timeout timeout))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 (defun itimer-timer-wakeup ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 (let ((inhibit-quit t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 (itimer-disable-timeout itimer-timer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 (setq itimer-timer (add-timeout itimer-short-interval
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 'itimer-timer-driver nil 5))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 (defun itimer-time-difference (t1 t2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 (let (usecs secs 65536-secs carry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 (setq usecs (- (nth 2 t1) (nth 2 t2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 (if (< usecs 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 (setq carry 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 usecs (+ usecs 1000000))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 (setq carry 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 (setq secs (- (nth 1 t1) (nth 1 t2) carry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 (if (< secs 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 (setq carry 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 secs (+ secs 65536))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 (setq carry 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry))
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
868 (+ (* 65536-secs 65536.0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 secs
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
870 (/ usecs 1000000.0))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 (defun itimer-timer-driver (&rest ignored)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 ;; inhibit quit because if the user quits at an inopportune
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 ;; time, the timer process won't be launched again and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 ;; system stops working. itimer-run-expired-timers allows
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 ;; individual timer function to be aborted, so the user can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 ;; escape a feral timer function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 (if (not itimer-inside-driver)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 (let* ((inhibit-quit t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 (itimer-inside-driver t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 (now (current-time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 (elapsed (itimer-time-difference now itimer-timer-last-wakeup))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 (sleep nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 (setq itimer-timer-last-wakeup now
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 sleep (itimer-run-expired-timers elapsed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 (itimer-disable-timeout itimer-timer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 (setq itimer-next-wakeup sleep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 itimer-timer (add-timeout sleep 'itimer-timer-driver nil 5)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 (defun itimer-driver-start ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 (if (fboundp 'add-timeout)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 (itimer-timer-start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 (itimer-process-start)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 (defun itimer-driver-wakeup ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 (if (fboundp 'add-timeout)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 (itimer-timer-wakeup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 (itimer-process-wakeup)))