aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2013-04-10 09:31:35 -0400
committerStefan Monnier2013-04-10 09:31:35 -0400
commit78ce603d02dd6f2492fb0178bb148d3d76e4312b (patch)
treebe868207d62596b1c5f99690de725a31645cd6a9
parent15e54145b44fc4e0e69207d1dc2bfa12f4ed0eb4 (diff)
downloademacs-78ce603d02dd6f2492fb0178bb148d3d76e4312b.tar.gz
emacs-78ce603d02dd6f2492fb0178bb148d3d76e4312b.zip
* src/keyboard.c (timer_start_idle): Call internal-timer-start-idle instead
of marking the idle timers directly. * lisp/emacs-lisp/timer.el (timer--check): New function. (timer--time, timer-set-function, timer-event-handler): Use it. (timer-set-idle-time): Simplify. (timer--activate): CSE. (timer-event-handler): Give more info in error message. (internal-timer-start-idle): New function, moved from C.
-rw-r--r--lisp/ChangeLog7
-rw-r--r--lisp/emacs-lisp/timer.el151
-rw-r--r--src/ChangeLog5
-rw-r--r--src/keyboard.c11
4 files changed, 95 insertions, 79 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9ca8db15ccd..a50f3bc8f15 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,12 @@
12013-04-10 Stefan Monnier <monnier@iro.umontreal.ca> 12013-04-10 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * emacs-lisp/timer.el (timer--check): New function.
4 (timer--time, timer-set-function, timer-event-handler): Use it.
5 (timer-set-idle-time): Simplify.
6 (timer--activate): CSE.
7 (timer-event-handler): Give more info in error message.
8 (internal-timer-start-idle): New function, moved from C.
9
3 * mpc.el (mpc-proc): Add `restart' argument. 10 * mpc.el (mpc-proc): Add `restart' argument.
4 (mpc-proc-cmd): Use it. 11 (mpc-proc-cmd): Use it.
5 (mpc--status-timer-run): Also catch signals from `mpc-proc'. 12 (mpc--status-timer-run): Also catch signals from `mpc-proc'.
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 8b1dca8cb78..a1bba2ddb6e 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -27,27 +27,34 @@
27 27
28;;; Code: 28;;; Code:
29 29
30;; Layout of a timer vector:
31;; [triggered-p high-seconds low-seconds usecs repeat-delay
32;; function args idle-delay psecs]
33;; triggered-p is nil if the timer is active (waiting to be triggered),
34;; t if it is inactive ("already triggered", in theory)
35
36(eval-when-compile (require 'cl-lib)) 30(eval-when-compile (require 'cl-lib))
37 31
38(cl-defstruct (timer 32(cl-defstruct (timer
39 (:constructor nil) 33 (:constructor nil)
40 (:copier nil) 34 (:copier nil)
41 (:constructor timer-create ()) 35 (:constructor timer-create ())
42 (:type vector) 36 (:type vector)
43 (:conc-name timer--)) 37 (:conc-name timer--))
38 ;; nil if the timer is active (waiting to be triggered),
39 ;; non-nil if it is inactive ("already triggered", in theory).
44 (triggered t) 40 (triggered t)
45 high-seconds low-seconds usecs repeat-delay function args idle-delay psecs) 41 ;; Time of next trigger: for normal timers, absolute time, for idle timers,
42 ;; time relative to idle-start.
43 high-seconds low-seconds usecs
44 ;; For normal timers, time between repetitions, or nil. For idle timers,
45 ;; non-nil iff repeated.
46 repeat-delay
47 function args ;What to do when triggered.
48 idle-delay ;If non-nil, this is an idle-timer.
49 psecs)
46 50
47(defun timerp (object) 51(defun timerp (object)
48 "Return t if OBJECT is a timer." 52 "Return t if OBJECT is a timer."
49 (and (vectorp object) (= (length object) 9))) 53 (and (vectorp object) (= (length object) 9)))
50 54
55(defsubst timer--check (timer)
56 (or (timerp timer) (signal 'wrong-type-argument (list #'timerp timer))))
57
51;; Pseudo field `time'. 58;; Pseudo field `time'.
52(defun timer--time (timer) 59(defun timer--time (timer)
53 (list (timer--high-seconds timer) 60 (list (timer--high-seconds timer)
@@ -57,17 +64,17 @@
57 64
58(gv-define-simple-setter timer--time 65(gv-define-simple-setter timer--time
59 (lambda (timer time) 66 (lambda (timer time)
60 (or (timerp timer) (error "Invalid timer")) 67 (timer--check timer)
61 (setf (timer--high-seconds timer) (pop time)) 68 (setf (timer--high-seconds timer) (pop time))
62 (let ((low time) (usecs 0) (psecs 0)) 69 (let ((low time) (usecs 0) (psecs 0))
63 (if (consp time) 70 (if (consp time)
64 (progn 71 (progn
65 (setq low (pop time)) 72 (setq low (pop time))
66 (if time 73 (if time
67 (progn 74 (progn
68 (setq usecs (pop time)) 75 (setq usecs (pop time))
69 (if time 76 (if time
70 (setq psecs (car time))))))) 77 (setq psecs (car time)))))))
71 (setf (timer--low-seconds timer) low) 78 (setf (timer--low-seconds timer) low)
72 (setf (timer--usecs timer) usecs) 79 (setf (timer--usecs timer) usecs)
73 (setf (timer--psecs timer) psecs)))) 80 (setf (timer--psecs timer) psecs))))
@@ -83,15 +90,13 @@ fire repeatedly that many seconds apart."
83 timer) 90 timer)
84 91
85(defun timer-set-idle-time (timer secs &optional repeat) 92(defun timer-set-idle-time (timer secs &optional repeat)
93 ;; FIXME: Merge with timer-set-time.
86 "Set the trigger idle time of TIMER to SECS. 94 "Set the trigger idle time of TIMER to SECS.
87SECS may be an integer, floating point number, or the internal 95SECS may be an integer, floating point number, or the internal
88time format returned by, e.g., `current-idle-time'. 96time format returned by, e.g., `current-idle-time'.
89If optional third argument REPEAT is non-nil, make the timer 97If optional third argument REPEAT is non-nil, make the timer
90fire each time Emacs is idle for that many seconds." 98fire each time Emacs is idle for that many seconds."
91 (if (consp secs) 99 (setf (timer--time timer) (if (consp secs) secs (seconds-to-time secs)))
92 (setf (timer--time timer) secs)
93 (setf (timer--time timer) '(0 0 0))
94 (timer-inc-time timer secs))
95 (setf (timer--repeat-delay timer) repeat) 100 (setf (timer--repeat-delay timer) repeat)
96 timer) 101 timer)
97 102
@@ -156,8 +161,7 @@ fire repeatedly that many seconds apart."
156 161
157(defun timer-set-function (timer function &optional args) 162(defun timer-set-function (timer function &optional args)
158 "Make TIMER call FUNCTION with optional ARGS when triggering." 163 "Make TIMER call FUNCTION with optional ARGS when triggering."
159 (or (timerp timer) 164 (timer--check timer)
160 (error "Invalid timer"))
161 (setf (timer--function timer) function) 165 (setf (timer--function timer) function)
162 (setf (timer--args timer) args) 166 (setf (timer--args timer) args)
163 timer) 167 timer)
@@ -181,9 +185,10 @@ fire repeatedly that many seconds apart."
181 (setcdr reuse-cell timers)) 185 (setcdr reuse-cell timers))
182 (setq reuse-cell (cons timer timers))) 186 (setq reuse-cell (cons timer timers)))
183 ;; Insert new timer after last which possibly means in front of queue. 187 ;; Insert new timer after last which possibly means in front of queue.
184 (cond (last (setcdr last reuse-cell)) 188 (setf (cond (last (cdr last))
185 (idle (setq timer-idle-list reuse-cell)) 189 (idle timer-idle-list)
186 (t (setq timer-list reuse-cell))) 190 (t timer-list))
191 reuse-cell)
187 (setf (timer--triggered timer) triggered-p) 192 (setf (timer--triggered timer) triggered-p)
188 (setf (timer--idle-delay timer) idle) 193 (setf (timer--idle-delay timer) idle)
189 nil) 194 nil)
@@ -223,8 +228,7 @@ timer will fire right away."
223 228
224(defun cancel-timer (timer) 229(defun cancel-timer (timer)
225 "Remove TIMER from the list of active timers." 230 "Remove TIMER from the list of active timers."
226 (or (timerp timer) 231 (timer--check timer)
227 (error "Invalid timer"))
228 (setq timer-list (delq timer timer-list)) 232 (setq timer-list (delq timer timer-list))
229 (setq timer-idle-list (delq timer timer-idle-list)) 233 (setq timer-idle-list (delq timer timer-idle-list))
230 nil) 234 nil)
@@ -283,44 +287,47 @@ This function is called, by name, directly by the C code."
283 (setq timer-event-last-1 timer-event-last) 287 (setq timer-event-last-1 timer-event-last)
284 (setq timer-event-last timer) 288 (setq timer-event-last timer)
285 (let ((inhibit-quit t)) 289 (let ((inhibit-quit t))
286 (if (timerp timer) 290 (timer--check timer)
287 (let (retrigger cell) 291 (let ((retrigger nil)
288 ;; Delete from queue. Record the cons cell that was used. 292 (cell
289 (setq cell (cancel-timer-internal timer)) 293 ;; Delete from queue. Record the cons cell that was used.
290 ;; Re-schedule if requested. 294 (cancel-timer-internal timer)))
291 (if (timer--repeat-delay timer) 295 ;; Re-schedule if requested.
292 (if (timer--idle-delay timer) 296 (if (timer--repeat-delay timer)
293 (timer-activate-when-idle timer nil cell) 297 (if (timer--idle-delay timer)
294 (timer-inc-time timer (timer--repeat-delay timer) 0) 298 (timer-activate-when-idle timer nil cell)
295 ;; If real time has jumped forward, 299 (timer-inc-time timer (timer--repeat-delay timer) 0)
296 ;; perhaps because Emacs was suspended for a long time, 300 ;; If real time has jumped forward,
297 ;; limit how many times things get repeated. 301 ;; perhaps because Emacs was suspended for a long time,
298 (if (and (numberp timer-max-repeats) 302 ;; limit how many times things get repeated.
299 (< 0 (timer-until timer (current-time)))) 303 (if (and (numberp timer-max-repeats)
300 (let ((repeats (/ (timer-until timer (current-time)) 304 (< 0 (timer-until timer (current-time))))
301 (timer--repeat-delay timer)))) 305 (let ((repeats (/ (timer-until timer (current-time))
302 (if (> repeats timer-max-repeats) 306 (timer--repeat-delay timer))))
303 (timer-inc-time timer (* (timer--repeat-delay timer) 307 (if (> repeats timer-max-repeats)
304 repeats))))) 308 (timer-inc-time timer (* (timer--repeat-delay timer)
305 (timer-activate timer t cell) 309 repeats)))))
306 (setq retrigger t))) 310 ;; Place it back on the timer-list before running
307 ;; Run handler. 311 ;; timer--function, so it can cancel-timer itself.
308 ;; We do this after rescheduling so that the handler function 312 (timer-activate timer t cell)
309 ;; can cancel its own timer successfully with cancel-timer. 313 (setq retrigger t)))
310 (condition-case-unless-debug err 314 ;; Run handler.
311 ;; Timer functions should not change the current buffer. 315 (condition-case-unless-debug err
312 ;; If they do, all kinds of nasty surprises can happen, 316 ;; Timer functions should not change the current buffer.
313 ;; and it can be hellish to track down their source. 317 ;; If they do, all kinds of nasty surprises can happen,
314 (save-current-buffer 318 ;; and it can be hellish to track down their source.
315 (apply (timer--function timer) (timer--args timer))) 319 (save-current-buffer
316 (error (message "Error in timer: %S" err))) 320 (apply (timer--function timer) (timer--args timer)))
317 (when (and retrigger 321 (error (message "Error running timer%s: %S"
318 ;; If the timer's been canceled, don't "retrigger" it 322 (if (symbolp (timer--function timer))
319 ;; since it might still be in the copy of timer-list kept 323 (format " `%s'" (timer--function timer)) "")
320 ;; by keyboard.c:timer_check (bug#14156). 324 err)))
321 (memq timer timer-list)) 325 (when (and retrigger
322 (setf (timer--triggered timer) nil))) 326 ;; If the timer's been canceled, don't "retrigger" it
323 (error "Bogus timer event")))) 327 ;; since it might still be in the copy of timer-list kept
328 ;; by keyboard.c:timer_check (bug#14156).
329 (memq timer timer-list))
330 (setf (timer--triggered timer) nil)))))
324 331
325;; This function is incompatible with the one in levents.el. 332;; This function is incompatible with the one in levents.el.
326(defun timeout-event-p (event) 333(defun timeout-event-p (event)
@@ -531,6 +538,12 @@ If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
531 secs 538 secs
532 (if (string-match-p "\\`[0-9.]+\\'" string) 539 (if (string-match-p "\\`[0-9.]+\\'" string)
533 (string-to-number string))))) 540 (string-to-number string)))))
541
542(defun internal-timer-start-idle ()
543 "Mark all idle-time timers as once again candidates for running."
544 (dolist (timer timer-idle-list)
545 (if (timerp timer) ;; FIXME: Why test?
546 (setf (timer--triggered timer) nil))))
534 547
535(provide 'timer) 548(provide 'timer)
536 549
diff --git a/src/ChangeLog b/src/ChangeLog
index 402792b5460..6fdf601fa95 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
12013-04-10 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * keyboard.c (timer_start_idle): Call internal-timer-start-idle instead
4 of marking the idle timers directly.
5
12013-04-09 Stefan Monnier <monnier@iro.umontreal.ca> 62013-04-09 Stefan Monnier <monnier@iro.umontreal.ca>
2 7
3 * minibuf.c (Ftest_completion): Ignore non-string/symbol keys in hash 8 * minibuf.c (Ftest_completion): Ignore non-string/symbol keys in hash
diff --git a/src/keyboard.c b/src/keyboard.c
index b4fafa22e41..12407bd536c 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -4198,16 +4198,7 @@ timer_start_idle (void)
4198 timer_last_idleness_start_time = timer_idleness_start_time; 4198 timer_last_idleness_start_time = timer_idleness_start_time;
4199 4199
4200 /* Mark all idle-time timers as once again candidates for running. */ 4200 /* Mark all idle-time timers as once again candidates for running. */
4201 for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers)) 4201 call0 (intern ("internal-timer-start-idle"));
4202 {
4203 Lisp_Object timer;
4204
4205 timer = XCAR (timers);
4206
4207 if (!VECTORP (timer) || ASIZE (timer) != 9)
4208 continue;
4209 ASET (timer, 0, Qnil);
4210 }
4211} 4202}
4212 4203
4213/* Record that Emacs is no longer idle, so stop running idle-time timers. */ 4204/* Record that Emacs is no longer idle, so stop running idle-time timers. */