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