Mercurial > hg > xemacs-beta

comparison lisp/itimer.el @ 5655:b7ae5f44b950

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove some redundant functions, change others to labels, lisp/ lisp/ChangeLog addition: 2012-05-05 Aidan Kehoe <kehoea@parhasard.net> Remove some redundant functions; turn other utility functions into labels, avoiding visibility in the global namespace, and reducing the size of the dumped binary. * auto-save.el (auto-save-unhex): Removed. * auto-save.el (auto-save-unescape-name): Use #'string-to-number instead of #'auto-save-unhex. * files.el (save-some-buffers): * files.el (save-some-buffers-1): Changed to a label. * files.el (not-modified): * gui.el (make-gui-button): * gui.el (gui-button-action): Changed to a label. * gui.el (insert-gui-button): * indent.el (indent-for-tab-command): * indent.el (insert-tab): Changed to a label. * indent.el (indent-rigidly): * isearch-mode.el: * isearch-mode.el (isearch-ring-adjust): * isearch-mode.el (isearch-ring-adjust1): Changed to a label. * isearch-mode.el (isearch-pre-command-hook): * isearch-mode.el (isearch-maybe-frob-keyboard-macros): Changed to a label. * isearch-mode.el (isearch-highlight): * isearch-mode.el (isearch-make-extent): Changed to a label. * itimer.el: * itimer.el (itimer-decrement): Removed, replaced uses with decf. * itimer.el (itimer-increment): Removed, replaced uses with incf. * itimer.el (itimer-signum): Removed, replaced uses with minusp, plusp. * itimer.el (itimer-name): * itimer.el (check-itimer): Removed, replaced with #'check-type calls. * itimer.el (itimer-value): * itimer.el (check-itimer-coerce-string): Removed. * itimer.el (itimer-restart): * itimer.el (itimer-function): * itimer.el (check-nonnegative-number): Removed. * itimer.el (itimer-uses-arguments): * itimer.el (check-string): Removed. * itimer.el (itimer-function-arguments): * itimer.el (itimer-recorded-run-time): * itimer.el (set-itimer-name): * itimer.el (set-itimer-value): * itimer.el (set-itimer-value-internal): * itimer.el (set-itimer-restart): * itimer.el (set-itimer-function): * itimer.el (set-itimer-is-idle): * itimer.el (set-itimer-recorded-run-time): * itimer.el (get-itimer): * itimer.el (delete-itimer): * itimer.el (start-itimer): * itimer.el (activate-itimer): * itimer.el (itimer-edit-set-field): * itimer.el (itimer-edit-next-field): * itimer.el (itimer-edit-previous-field): Use incf, decf, plusp, minusp and the more general argument type checking macros. * lib-complete.el: * lib-complete.el (lib-complete:better-root): Changed to a label. * lib-complete.el (lib-complete:get-completion-table): Changed to a label. * lib-complete.el (read-library-internal): Include labels. * lib-complete.el (lib-complete:cache-completions): Changed to a label. * minibuf.el (read-buffer): Use #'set-difference, don't reinvent it. * newcomment.el (comment-padright): Use a label instead of repeating a lambda expression. * packages.el (package-get-key): * packages.el (package-get-key-1): Removed, use #'getf instead. * simple.el (kill-backward-chars): Removed; this isn't used. * simple.el (what-cursor-position): (lambda (arg) (format "%S" arg) -> #'prin1-to-string. * simple.el (debug-print-1): Renamed to #'debug-print. * simple.el (debug-print): Removed, #'debug-print-1 was equivalent. * subr.el (integer-to-bit-vector): check-nonnegative-number no longer available. * widget.el (define-widget): * widget.el (define-widget-keywords): Removed, this was long obsolete.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 05 May 2012 18:42:00 +0100
parents cc6f0266bc36
children
comparison
equal deleted inserted replaced
5654:ddf56c45634e 5655:b7ae5f44b950
100 100
101 (defvar itimer-inside-driver nil) 101 (defvar itimer-inside-driver nil)
102 102
103 (defvar itimer-edit-start-marker nil) 103 (defvar itimer-edit-start-marker nil)
104 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)
123 "If VAR is not bound to an itimer, signal `wrong-type-argument'.
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 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)
142 "If VAR is not bound to a number, signal `wrong-type-argument'.
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)
154 "If VAR is not bound to a string, signal `wrong-type-argument'.
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. 105 ;; Functions to access and modify itimer attributes.
162 106
163 (defun itimerp (object) 107 (defun itimerp (object)
164 "Return non-nil if OBJECT is an itimer." 108 "Return non-nil if OBJECT is an itimer."
165 (and (consp object) (eq (length object) 8))) 109 (and (consp object) (eq (length object) 8)))
171 Itimers started with `start-itimer' are automatically active." 115 Itimers started with `start-itimer' are automatically active."
172 (and (itimerp object) (memq object itimer-list))) 116 (and (itimerp object) (memq object itimer-list)))
173 117
174 (defun itimer-name (itimer) 118 (defun itimer-name (itimer)
175 "Return the name of ITIMER." 119 "Return the name of ITIMER."
176 (check-itimer itimer) 120 (check-type itimer itimer)
177 (car itimer)) 121 (car itimer))
178 122
179 (defun itimer-value (itimer) 123 (defun itimer-value (itimer)
180 "Return the number of seconds until ITIMER expires." 124 "Return the number of seconds until ITIMER expires."
181 (check-itimer itimer) 125 (check-type itimer itimer)
182 (nth 1 itimer)) 126 (nth 1 itimer))
183 127
184 (defun itimer-restart (itimer) 128 (defun itimer-restart (itimer)
185 "Return the value to which ITIMER will be set at restart. 129 "Return the value to which ITIMER will be set at restart.
186 The value nil is returned if this itimer isn't set to restart." 130 The value nil is returned if this itimer isn't set to restart."
187 (check-itimer itimer) 131 (check-type itimer itimer)
188 (nth 2 itimer)) 132 (nth 2 itimer))
189 133
190 (defun itimer-function (itimer) 134 (defun itimer-function (itimer)
191 "Return the function of ITIMER. 135 "Return the function of ITIMER.
192 This function is called each time ITIMER expires." 136 This function is called each time ITIMER expires."
193 (check-itimer itimer) 137 (check-type itimer itimer)
194 (nth 3 itimer)) 138 (nth 3 itimer))
195 139
196 (defun itimer-is-idle (itimer) 140 (defun itimer-is-idle (itimer)
197 "Return non-nil if ITIMER is an idle timer. 141 "Return non-nil if ITIMER is an idle timer.
198 Normal timers expire after a set interval. Idle timers expire 142 Normal timers expire after a set interval. Idle timers expire
199 only after Emacs has been idle for a specific interval. ``Idle'' 143 only after Emacs has been idle for a specific interval. ``Idle''
200 means no command events have occurred within the interval." 144 means no command events have occurred within the interval."
201 (check-itimer itimer) 145 (check-type itimer itimer)
202 (nth 4 itimer)) 146 (nth 4 itimer))
203 147
204 (defun itimer-uses-arguments (itimer) 148 (defun itimer-uses-arguments (itimer)
205 "Return non-nil if the function of ITIMER will be called with arguments. 149 "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. 150 ITIMER's function is called with the arguments each time ITIMER expires.
207 The arguments themselves are retrievable with `itimer-function-arguments'." 151 The arguments themselves are retrievable with `itimer-function-arguments'."
208 (check-itimer itimer) 152 (check-type itimer itimer)
209 (nth 5 itimer)) 153 (nth 5 itimer))
210 154
211 (defun itimer-function-arguments (itimer) 155 (defun itimer-function-arguments (itimer)
212 "Return the function arguments of ITIMER as a list. 156 "Return the function arguments of ITIMER as a list.
213 ITIMER's function is called with these arguments each time ITIMER expires." 157 ITIMER's function is called with these arguments each time ITIMER expires."
214 (check-itimer itimer) 158 (check-type itimer itimer)
215 (nth 6 itimer)) 159 (nth 6 itimer))
216 160
217 (defun itimer-recorded-run-time (itimer) 161 (defun itimer-recorded-run-time (itimer)
218 (check-itimer itimer) 162 (check-type itimer itimer)
219 (nth 7 itimer)) 163 (nth 7 itimer))
220 164
221 (defun set-itimer-name (itimer name) 165 (defun set-itimer-name (itimer name)
222 "Set the name of ITIMER to be NAME. 166 "Set the name of ITIMER to be NAME.
223 NAME is an identifier for the itimer. It must be a string. If an active 167 NAME is an identifier for the itimer. It must be a string. If an active
224 itimer already exists with this name, an error is signaled." 168 itimer already exists with this name, an error is signaled."
225 (check-string name) 169 (check-type name string)
226 (and (itimer-live-p itimer) 170 (and (itimer-live-p itimer)
227 (get-itimer name) 171 (get-itimer name)
228 (error "itimer named \"%s\" already existing and activated" name)) 172 (error "itimer named \"%s\" already existing and activated" name))
229 (setcar itimer name)) 173 (setcar itimer name))
230 174
233 Itimer will expire in this many seconds. 177 Itimer will expire in this many seconds.
234 If your version of Emacs supports floating point numbers then 178 If your version of Emacs supports floating point numbers then
235 VALUE can be a floating point number. Otherwise it 179 VALUE can be a floating point number. Otherwise it
236 must be an integer. 180 must be an integer.
237 Returns VALUE." 181 Returns VALUE."
238 (check-itimer itimer) 182 (check-type itimer itimer)
239 (check-nonnegative-number value) 183 (check-type value number)
184 (check-argument-range value 0 nil)
240 (let ((inhibit-quit t)) 185 (let ((inhibit-quit t))
241 ;; If the itimer is in the active list, and under the new 186 ;; If the itimer is in the active list, and under the new
242 ;; timeout value would expire before we would normally 187 ;; timeout value would expire before we would normally
243 ;; wakeup, wakeup now and recompute a new wakeup time. 188 ;; wakeup, wakeup now and recompute a new wakeup time.
244 (or (and (< value itimer-next-wakeup) 189 (or (and (< value itimer-next-wakeup)
251 value)) 196 value))
252 197
253 ;; Same as set-itimer-value but does not wakeup the driver. 198 ;; Same as set-itimer-value but does not wakeup the driver.
254 ;; Only should be used by the drivers when processing expired timers. 199 ;; Only should be used by the drivers when processing expired timers.
255 (defun set-itimer-value-internal (itimer value) 200 (defun set-itimer-value-internal (itimer value)
256 (check-itimer itimer) 201 (check-type itimer itimer)
257 (check-nonnegative-number value) 202 (check-type value number)
203 (check-argument-range value 0 nil)
258 (setcar (cdr itimer) value)) 204 (setcar (cdr itimer) value))
259 205
260 (defun set-itimer-restart (itimer restart) 206 (defun set-itimer-restart (itimer restart)
261 "Set the restart value of ITIMER to be RESTART. 207 "Set the restart value of ITIMER to be RESTART.
262 If RESTART is nil, ITIMER will not restart when it expires. 208 If RESTART is nil, ITIMER will not restart when it expires.
263 If your version of Emacs supports floating point numbers then 209 If your version of Emacs supports floating point numbers then
264 RESTART can be a floating point number. Otherwise it 210 RESTART can be a floating point number. Otherwise it
265 must be an integer. 211 must be an integer.
266 Returns RESTART." 212 Returns RESTART."
267 (check-itimer itimer) 213 (check-type itimer itimer)
268 (if restart (check-nonnegative-number restart)) 214 (when restart
215 (check-type restart number)
216 (check-argument-range restart 0 nil))
269 (setcar (cdr (cdr itimer)) restart)) 217 (setcar (cdr (cdr itimer)) restart))
270 218
271 (defun set-itimer-function (itimer function) 219 (defun set-itimer-function (itimer function)
272 "Set the function of ITIMER to be FUNCTION. 220 "Set the function of ITIMER to be FUNCTION.
273 FUNCTION will be called when itimer expires. 221 FUNCTION will be called when itimer expires.
274 Returns FUNCTION." 222 Returns FUNCTION."
275 (check-itimer itimer) 223 (check-type itimer itimer)
276 (setcar (nthcdr 3 itimer) function)) 224 (setcar (nthcdr 3 itimer) function))
277 225
278 (defun set-itimer-is-idle (itimer flag) 226 (defun set-itimer-is-idle (itimer flag)
279 "Set flag that says whether ITIMER is an idle timer. 227 "Set flag that says whether ITIMER is an idle timer.
280 If FLAG is non-nil, then ITIMER will be considered an idle timer. 228 If FLAG is non-nil, then ITIMER will be considered an idle timer.
281 Returns FLAG." 229 Returns FLAG."
282 (check-itimer itimer) 230 (check-type itimer itimer)
283 (setcar (nthcdr 4 itimer) flag)) 231 (setcar (nthcdr 4 itimer) flag))
284 232
285 (defun set-itimer-uses-arguments (itimer flag) 233 (defun set-itimer-uses-arguments (itimer flag)
286 "Set flag that says whether the function of ITIMER is called with arguments. 234 "Set flag that says whether the function of ITIMER is called with arguments.
287 If FLAG is non-nil, then the function will be called with one argument, 235 If FLAG is non-nil, then the function will be called with one argument,
288 otherwise the function will be called with no arguments. 236 otherwise the function will be called with no arguments.
289 Returns FLAG." 237 Returns FLAG."
290 (check-itimer itimer) 238 (check-type itimer itimer)
291 (setcar (nthcdr 5 itimer) flag)) 239 (setcar (nthcdr 5 itimer) flag))
292 240
293 (defun set-itimer-function-arguments (itimer &optional arguments) 241 (defun set-itimer-function-arguments (itimer &optional arguments)
294 "Set the function arguments of ITIMER to be ARGUMENTS. 242 "Set the function arguments of ITIMER to be ARGUMENTS.
295 The function of ITIMER will be called with ARGUMENTS when itimer expires. 243 The function of ITIMER will be called with ARGUMENTS when itimer expires.
296 Returns ARGUMENTS." 244 Returns ARGUMENTS."
297 (check-itimer itimer) 245 (check-type itimer itimer)
298 (setcar (nthcdr 6 itimer) arguments)) 246 (setcar (nthcdr 6 itimer) arguments))
299 247
300 (defun set-itimer-recorded-run-time (itimer time) 248 (defun set-itimer-recorded-run-time (itimer time)
301 (check-itimer itimer) 249 (check-type itimer itimer)
302 (setcar (nthcdr 7 itimer) time)) 250 (setcar (nthcdr 7 itimer) time))
303 251
304 (defun get-itimer (name) 252 (defun get-itimer (name)
305 "Return itimer named NAME, or nil if there is none." 253 "Return itimer named NAME, or nil if there is none."
306 (check-string name) 254 (check-type name string)
307 (assoc name itimer-list)) 255 (assoc name itimer-list))
308 256
309 (defun read-itimer (prompt &optional initial-input) 257 (defun read-itimer (prompt &optional initial-input)
310 "Read the name of an itimer from the minibuffer and return the itimer 258 "Read the name of an itimer from the minibuffer and return the itimer
311 associated with that name. The user is prompted with PROMPT. 259 associated with that name. The user is prompted with PROMPT.
313 minibuffer as initial user input." 261 minibuffer as initial user input."
314 (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input))) 262 (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input)))
315 263
316 (defun delete-itimer (itimer) 264 (defun delete-itimer (itimer)
317 "Deletes ITIMER. ITIMER may be an itimer or the name of one." 265 "Deletes ITIMER. ITIMER may be an itimer or the name of one."
318 (check-itimer-coerce-string itimer) 266 (if (stringp itimer) (setq itimer (get-itimer itimer)))
267 (check-type itimer itimer)
319 (setq itimer-list (delete* itimer itimer-list))) 268 (setq itimer-list (delete* itimer itimer-list)))
320 269
321 (defun start-itimer (name function value &optional restart 270 (defun start-itimer (name function value &optional restart
322 is-idle with-args &rest function-arguments) 271 is-idle with-args &rest function-arguments)
323 "Start an itimer. 272 "Start an itimer.
360 nil nil t))) 309 nil nil t)))
361 restart) 310 restart)
362 ;; hard to imagine the user specifying these interactively 311 ;; hard to imagine the user specifying these interactively
363 nil 312 nil
364 nil )) 313 nil ))
365 (check-string name) 314 (check-type name string)
366 (check-nonnegative-number value) 315 (check-type value number)
367 (if restart (check-nonnegative-number restart)) 316 (check-argument-range value 0 nil)
317 (when restart
318 (check-type restart number)
319 (check-argument-range restart 0 nil))
368 ;; Make proposed itimer name unique if it's not already. 320 ;; Make proposed itimer name unique if it's not already.
369 (let ((oname name) 321 (let ((oname name)
370 (num 2)) 322 (num 2))
371 (while (get-itimer name) 323 (while (get-itimer name)
372 (setq name (format "%s<%d>" oname num)) 324 (setq name (format "%s<%d>" oname num))
373 (itimer-increment num))) 325 (incf num)))
374 (activate-itimer (list name value restart function is-idle 326 (activate-itimer (list name value restart function is-idle
375 with-args function-arguments (list 0 0 0))) 327 with-args function-arguments (list 0 0 0)))
376 (car itimer-list)) 328 (car itimer-list))
377 329
378 (defun make-itimer () 330 (defun make-itimer ()
385 337
386 (defun activate-itimer (itimer) 338 (defun activate-itimer (itimer)
387 "Activate ITIMER, which was previously created with `make-itimer'. 339 "Activate ITIMER, which was previously created with `make-itimer'.
388 ITIMER will be added to the global list of running itimers, 340 ITIMER will be added to the global list of running itimers,
389 its FUNCTION will be called when it expires, and so on." 341 its FUNCTION will be called when it expires, and so on."
390 (check-itimer itimer) 342 (check-type itimer itimer)
391 (if (memq itimer itimer-list) 343 (if (memq itimer itimer-list)
392 (error "itimer already activated")) 344 (error "itimer already activated"))
393 (if (not (numberp (itimer-value itimer))) 345 (if (not (numberp (itimer-value itimer)))
394 (error "itimer timeout value not a number: %s" (itimer-value itimer))) 346 (error "itimer timeout value not a number: %s" (itimer-value itimer)))
395 (if (<= (itimer-value itimer) 0) 347 (if (<= (itimer-value itimer) 0)
406 (let ((name "itimer-0") 358 (let ((name "itimer-0")
407 (oname "itimer-") 359 (oname "itimer-")
408 (num 1)) 360 (num 1))
409 (while (get-itimer name) 361 (while (get-itimer name)
410 (setq name (format "%s<%d>" oname num)) 362 (setq name (format "%s<%d>" oname num))
411 (itimer-increment num)) 363 (incf num))
412 (setcar itimer name)) 364 (setcar itimer name))
413 ;; signal an error if the timer's name matches an already 365 ;; signal an error if the timer's name matches an already
414 ;; activated timer. 366 ;; activated timer.
415 (if (get-itimer (itimer-name itimer)) 367 (if (get-itimer (itimer-name itimer))
416 (error "itimer named \"%s\" already existing and activated" 368 (error "itimer named \"%s\" already existing and activated"
567 ;; wants to modify. 519 ;; wants to modify.
568 (beginning-of-line) 520 (beginning-of-line)
569 (while (and (>= opoint (point)) (< n 6)) 521 (while (and (>= opoint (point)) (< n 6))
570 (forward-sexp 2) 522 (forward-sexp 2)
571 (backward-sexp) 523 (backward-sexp)
572 (itimer-increment n)) 524 (incf n))
573 (cond ((eq n 1) (error "Cannot change itimer name.")) 525 (cond ((eq n 1) (error "Cannot change itimer name."))
574 ((eq n 2) 'value) 526 ((eq n 2) 'value)
575 ((eq n 3) 'restart) 527 ((eq n 3) 'restart)
576 ((eq n 4) 'function) 528 ((eq n 4) 'function)
577 ((eq n 5) 'is-idle) 529 ((eq n 5) 'is-idle)
628 (list-itimers)) 580 (list-itimers))
629 581
630 (defun itimer-edit-next-field (count) 582 (defun itimer-edit-next-field (count)
631 (interactive "p") 583 (interactive "p")
632 (itimer-edit-beginning-of-field) 584 (itimer-edit-beginning-of-field)
633 (cond ((> (itimer-signum count) 0) 585 (cond ((plusp count)
634 (while (not (zerop count)) 586 (while (not (zerop count))
635 (forward-sexp) 587 (forward-sexp)
636 ;; wrap from eob to itimer-edit-start-marker 588 ;; wrap from eob to itimer-edit-start-marker
637 (if (eobp) 589 (if (eobp)
638 (progn 590 (progn
643 ;; treat fields at beginning of line as if they weren't there. 595 ;; treat fields at beginning of line as if they weren't there.
644 (if (bolp) 596 (if (bolp)
645 (progn 597 (progn
646 (forward-sexp 2) 598 (forward-sexp 2)
647 (backward-sexp))) 599 (backward-sexp)))
648 (itimer-decrement count))) 600 (decf count)))
649 ((< (itimer-signum count) 0) 601 ((minusp count)
650 (while (not (zerop count)) 602 (while (not (zerop count))
651 (backward-sexp) 603 (backward-sexp)
652 ;; treat fields at beginning of line as if they weren't there. 604 ;; treat fields at beginning of line as if they weren't there.
653 (if (bolp) 605 (if (bolp)
654 (backward-sexp)) 606 (backward-sexp))
655 ;; wrap from itimer-edit-start-marker to field at eob. 607 ;; wrap from itimer-edit-start-marker to field at eob.
656 (if (<= (point) itimer-edit-start-marker) 608 (if (<= (point) itimer-edit-start-marker)
657 (progn 609 (progn
658 (goto-char (point-max)) 610 (goto-char (point-max))
659 (backward-sexp))) 611 (backward-sexp)))
660 (itimer-increment count))))) 612 (incf count)))))
661 613
662 (defun itimer-edit-previous-field (count) 614 (defun itimer-edit-previous-field (count)
663 (interactive "p") 615 (interactive "p")
664 (itimer-edit-next-field (- count))) 616 (itimer-edit-next-field (- count)))
665 617