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