Mercurial > hg > xemacs-beta
annotate lisp/itimer.el @ 5704:37b107e878b8
More corrections to INSTALL by Robert Royer.
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Fri, 28 Dec 2012 12:35:44 +0900 |
| 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))) |