1 |
dashley |
71 |
/* $Header$ */ |
2 |
|
|
/* |
3 |
|
|
* tclTimer.c -- |
4 |
|
|
* |
5 |
|
|
* This file provides timer event management facilities for Tcl, |
6 |
|
|
* including the "after" command. |
7 |
|
|
* |
8 |
|
|
* Copyright (c) 1997 by Sun Microsystems, Inc. |
9 |
|
|
* |
10 |
|
|
* See the file "license.terms" for information on usage and redistribution |
11 |
|
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
12 |
|
|
* |
13 |
|
|
* RCS: @(#) $Id: tcltimer.c,v 1.1.1.1 2001/06/13 04:46:38 dtashley Exp $ |
14 |
|
|
*/ |
15 |
|
|
|
16 |
|
|
#include "tclInt.h" |
17 |
|
|
#include "tclPort.h" |
18 |
|
|
|
19 |
|
|
/* |
20 |
|
|
* For each timer callback that's pending there is one record of the following |
21 |
|
|
* type. The normal handlers (created by Tcl_CreateTimerHandler) are chained |
22 |
|
|
* together in a list sorted by time (earliest event first). |
23 |
|
|
*/ |
24 |
|
|
|
25 |
|
|
typedef struct TimerHandler { |
26 |
|
|
Tcl_Time time; /* When timer is to fire. */ |
27 |
|
|
Tcl_TimerProc *proc; /* Procedure to call. */ |
28 |
|
|
ClientData clientData; /* Argument to pass to proc. */ |
29 |
|
|
Tcl_TimerToken token; /* Identifies handler so it can be |
30 |
|
|
* deleted. */ |
31 |
|
|
struct TimerHandler *nextPtr; /* Next event in queue, or NULL for |
32 |
|
|
* end of queue. */ |
33 |
|
|
} TimerHandler; |
34 |
|
|
|
35 |
|
|
/* |
36 |
|
|
* The data structure below is used by the "after" command to remember |
37 |
|
|
* the command to be executed later. All of the pending "after" commands |
38 |
|
|
* for an interpreter are linked together in a list. |
39 |
|
|
*/ |
40 |
|
|
|
41 |
|
|
typedef struct AfterInfo { |
42 |
|
|
struct AfterAssocData *assocPtr; |
43 |
|
|
/* Pointer to the "tclAfter" assocData for |
44 |
|
|
* the interp in which command will be |
45 |
|
|
* executed. */ |
46 |
|
|
Tcl_Obj *commandPtr; /* Command to execute. */ |
47 |
|
|
int id; /* Integer identifier for command; used to |
48 |
|
|
* cancel it. */ |
49 |
|
|
Tcl_TimerToken token; /* Used to cancel the "after" command. NULL |
50 |
|
|
* means that the command is run as an |
51 |
|
|
* idle handler rather than as a timer |
52 |
|
|
* handler. NULL means this is an "after |
53 |
|
|
* idle" handler rather than a |
54 |
|
|
* timer handler. */ |
55 |
|
|
struct AfterInfo *nextPtr; /* Next in list of all "after" commands for |
56 |
|
|
* this interpreter. */ |
57 |
|
|
} AfterInfo; |
58 |
|
|
|
59 |
|
|
/* |
60 |
|
|
* One of the following structures is associated with each interpreter |
61 |
|
|
* for which an "after" command has ever been invoked. A pointer to |
62 |
|
|
* this structure is stored in the AssocData for the "tclAfter" key. |
63 |
|
|
*/ |
64 |
|
|
|
65 |
|
|
typedef struct AfterAssocData { |
66 |
|
|
Tcl_Interp *interp; /* The interpreter for which this data is |
67 |
|
|
* registered. */ |
68 |
|
|
AfterInfo *firstAfterPtr; /* First in list of all "after" commands |
69 |
|
|
* still pending for this interpreter, or |
70 |
|
|
* NULL if none. */ |
71 |
|
|
} AfterAssocData; |
72 |
|
|
|
73 |
|
|
/* |
74 |
|
|
* There is one of the following structures for each of the |
75 |
|
|
* handlers declared in a call to Tcl_DoWhenIdle. All of the |
76 |
|
|
* currently-active handlers are linked together into a list. |
77 |
|
|
*/ |
78 |
|
|
|
79 |
|
|
typedef struct IdleHandler { |
80 |
|
|
Tcl_IdleProc (*proc); /* Procedure to call. */ |
81 |
|
|
ClientData clientData; /* Value to pass to proc. */ |
82 |
|
|
int generation; /* Used to distinguish older handlers from |
83 |
|
|
* recently-created ones. */ |
84 |
|
|
struct IdleHandler *nextPtr;/* Next in list of active handlers. */ |
85 |
|
|
} IdleHandler; |
86 |
|
|
|
87 |
|
|
/* |
88 |
|
|
* The timer and idle queues are per-thread because they are associated |
89 |
|
|
* with the notifier, which is also per-thread. |
90 |
|
|
* |
91 |
|
|
* All static variables used in this file are collected into a single |
92 |
|
|
* instance of the following structure. For multi-threaded implementations, |
93 |
|
|
* there is one instance of this structure for each thread. |
94 |
|
|
* |
95 |
|
|
* Notice that different structures with the same name appear in other |
96 |
|
|
* files. The structure defined below is used in this file only. |
97 |
|
|
*/ |
98 |
|
|
|
99 |
|
|
typedef struct ThreadSpecificData { |
100 |
|
|
TimerHandler *firstTimerHandlerPtr; /* First event in queue. */ |
101 |
|
|
int lastTimerId; /* Timer identifier of most recently |
102 |
|
|
* created timer. */ |
103 |
|
|
int timerPending; /* 1 if a timer event is in the queue. */ |
104 |
|
|
IdleHandler *idleList; /* First in list of all idle handlers. */ |
105 |
|
|
IdleHandler *lastIdlePtr; /* Last in list (or NULL for empty list). */ |
106 |
|
|
int idleGeneration; /* Used to fill in the "generation" fields |
107 |
|
|
* of IdleHandler structures. Increments |
108 |
|
|
* each time Tcl_DoOneEvent starts calling |
109 |
|
|
* idle handlers, so that all old handlers |
110 |
|
|
* can be called without calling any of the |
111 |
|
|
* new ones created by old ones. */ |
112 |
|
|
int afterId; /* For unique identifiers of after events. */ |
113 |
|
|
} ThreadSpecificData; |
114 |
|
|
|
115 |
|
|
static Tcl_ThreadDataKey dataKey; |
116 |
|
|
|
117 |
|
|
/* |
118 |
|
|
* Prototypes for procedures referenced only in this file: |
119 |
|
|
*/ |
120 |
|
|
|
121 |
|
|
static void AfterCleanupProc _ANSI_ARGS_((ClientData clientData, |
122 |
|
|
Tcl_Interp *interp)); |
123 |
|
|
static void AfterProc _ANSI_ARGS_((ClientData clientData)); |
124 |
|
|
static void FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr)); |
125 |
|
|
static AfterInfo * GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr, |
126 |
|
|
Tcl_Obj *commandPtr)); |
127 |
|
|
static ThreadSpecificData *InitTimer _ANSI_ARGS_((void)); |
128 |
|
|
static void TimerExitProc _ANSI_ARGS_((ClientData clientData)); |
129 |
|
|
static int TimerHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr, |
130 |
|
|
int flags)); |
131 |
|
|
static void TimerCheckProc _ANSI_ARGS_((ClientData clientData, |
132 |
|
|
int flags)); |
133 |
|
|
static void TimerSetupProc _ANSI_ARGS_((ClientData clientData, |
134 |
|
|
int flags)); |
135 |
|
|
|
136 |
|
|
/* |
137 |
|
|
*---------------------------------------------------------------------- |
138 |
|
|
* |
139 |
|
|
* InitTimer -- |
140 |
|
|
* |
141 |
|
|
* This function initializes the timer module. |
142 |
|
|
* |
143 |
|
|
* Results: |
144 |
|
|
* A pointer to the thread specific data. |
145 |
|
|
* |
146 |
|
|
* Side effects: |
147 |
|
|
* Registers the idle and timer event sources. |
148 |
|
|
* |
149 |
|
|
*---------------------------------------------------------------------- |
150 |
|
|
*/ |
151 |
|
|
|
152 |
|
|
static ThreadSpecificData * |
153 |
|
|
InitTimer() |
154 |
|
|
{ |
155 |
|
|
ThreadSpecificData *tsdPtr = |
156 |
|
|
(ThreadSpecificData *) TclThreadDataKeyGet(&dataKey); |
157 |
|
|
|
158 |
|
|
if (tsdPtr == NULL) { |
159 |
|
|
tsdPtr = TCL_TSD_INIT(&dataKey); |
160 |
|
|
Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL); |
161 |
|
|
Tcl_CreateThreadExitHandler(TimerExitProc, NULL); |
162 |
|
|
} |
163 |
|
|
return tsdPtr; |
164 |
|
|
} |
165 |
|
|
|
166 |
|
|
/* |
167 |
|
|
*---------------------------------------------------------------------- |
168 |
|
|
* |
169 |
|
|
* TimerExitProc -- |
170 |
|
|
* |
171 |
|
|
* This function is call at exit or unload time to remove the |
172 |
|
|
* timer and idle event sources. |
173 |
|
|
* |
174 |
|
|
* Results: |
175 |
|
|
* None. |
176 |
|
|
* |
177 |
|
|
* Side effects: |
178 |
|
|
* Removes the timer and idle event sources. |
179 |
|
|
* |
180 |
|
|
*---------------------------------------------------------------------- |
181 |
|
|
*/ |
182 |
|
|
|
183 |
|
|
static void |
184 |
|
|
TimerExitProc(clientData) |
185 |
|
|
ClientData clientData; /* Not used. */ |
186 |
|
|
{ |
187 |
|
|
Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); |
188 |
|
|
} |
189 |
|
|
|
190 |
|
|
/* |
191 |
|
|
*-------------------------------------------------------------- |
192 |
|
|
* |
193 |
|
|
* Tcl_CreateTimerHandler -- |
194 |
|
|
* |
195 |
|
|
* Arrange for a given procedure to be invoked at a particular |
196 |
|
|
* time in the future. |
197 |
|
|
* |
198 |
|
|
* Results: |
199 |
|
|
* The return value is a token for the timer event, which |
200 |
|
|
* may be used to delete the event before it fires. |
201 |
|
|
* |
202 |
|
|
* Side effects: |
203 |
|
|
* When milliseconds have elapsed, proc will be invoked |
204 |
|
|
* exactly once. |
205 |
|
|
* |
206 |
|
|
*-------------------------------------------------------------- |
207 |
|
|
*/ |
208 |
|
|
|
209 |
|
|
Tcl_TimerToken |
210 |
|
|
Tcl_CreateTimerHandler(milliseconds, proc, clientData) |
211 |
|
|
int milliseconds; /* How many milliseconds to wait |
212 |
|
|
* before invoking proc. */ |
213 |
|
|
Tcl_TimerProc *proc; /* Procedure to invoke. */ |
214 |
|
|
ClientData clientData; /* Arbitrary data to pass to proc. */ |
215 |
|
|
{ |
216 |
|
|
register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; |
217 |
|
|
Tcl_Time time; |
218 |
|
|
ThreadSpecificData *tsdPtr; |
219 |
|
|
|
220 |
|
|
tsdPtr = InitTimer(); |
221 |
|
|
|
222 |
|
|
timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler)); |
223 |
|
|
|
224 |
|
|
/* |
225 |
|
|
* Compute when the event should fire. |
226 |
|
|
*/ |
227 |
|
|
|
228 |
|
|
TclpGetTime(&time); |
229 |
|
|
timerHandlerPtr->time.sec = time.sec + milliseconds/1000; |
230 |
|
|
timerHandlerPtr->time.usec = time.usec + (milliseconds%1000)*1000; |
231 |
|
|
if (timerHandlerPtr->time.usec >= 1000000) { |
232 |
|
|
timerHandlerPtr->time.usec -= 1000000; |
233 |
|
|
timerHandlerPtr->time.sec += 1; |
234 |
|
|
} |
235 |
|
|
|
236 |
|
|
/* |
237 |
|
|
* Fill in other fields for the event. |
238 |
|
|
*/ |
239 |
|
|
|
240 |
|
|
timerHandlerPtr->proc = proc; |
241 |
|
|
timerHandlerPtr->clientData = clientData; |
242 |
|
|
tsdPtr->lastTimerId++; |
243 |
|
|
timerHandlerPtr->token = (Tcl_TimerToken) tsdPtr->lastTimerId; |
244 |
|
|
|
245 |
|
|
/* |
246 |
|
|
* Add the event to the queue in the correct position |
247 |
|
|
* (ordered by event firing time). |
248 |
|
|
*/ |
249 |
|
|
|
250 |
|
|
for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL; |
251 |
|
|
prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) { |
252 |
|
|
if ((tPtr2->time.sec > timerHandlerPtr->time.sec) |
253 |
|
|
|| ((tPtr2->time.sec == timerHandlerPtr->time.sec) |
254 |
|
|
&& (tPtr2->time.usec > timerHandlerPtr->time.usec))) { |
255 |
|
|
break; |
256 |
|
|
} |
257 |
|
|
} |
258 |
|
|
timerHandlerPtr->nextPtr = tPtr2; |
259 |
|
|
if (prevPtr == NULL) { |
260 |
|
|
tsdPtr->firstTimerHandlerPtr = timerHandlerPtr; |
261 |
|
|
} else { |
262 |
|
|
prevPtr->nextPtr = timerHandlerPtr; |
263 |
|
|
} |
264 |
|
|
|
265 |
|
|
TimerSetupProc(NULL, TCL_ALL_EVENTS); |
266 |
|
|
|
267 |
|
|
return timerHandlerPtr->token; |
268 |
|
|
} |
269 |
|
|
|
270 |
|
|
/* |
271 |
|
|
*-------------------------------------------------------------- |
272 |
|
|
* |
273 |
|
|
* Tcl_DeleteTimerHandler -- |
274 |
|
|
* |
275 |
|
|
* Delete a previously-registered timer handler. |
276 |
|
|
* |
277 |
|
|
* Results: |
278 |
|
|
* None. |
279 |
|
|
* |
280 |
|
|
* Side effects: |
281 |
|
|
* Destroy the timer callback identified by TimerToken, |
282 |
|
|
* so that its associated procedure will not be called. |
283 |
|
|
* If the callback has already fired, or if the given |
284 |
|
|
* token doesn't exist, then nothing happens. |
285 |
|
|
* |
286 |
|
|
*-------------------------------------------------------------- |
287 |
|
|
*/ |
288 |
|
|
|
289 |
|
|
void |
290 |
|
|
Tcl_DeleteTimerHandler(token) |
291 |
|
|
Tcl_TimerToken token; /* Result previously returned by |
292 |
|
|
* Tcl_DeleteTimerHandler. */ |
293 |
|
|
{ |
294 |
|
|
register TimerHandler *timerHandlerPtr, *prevPtr; |
295 |
|
|
ThreadSpecificData *tsdPtr; |
296 |
|
|
|
297 |
|
|
tsdPtr = InitTimer(); |
298 |
|
|
for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; |
299 |
|
|
timerHandlerPtr != NULL; prevPtr = timerHandlerPtr, |
300 |
|
|
timerHandlerPtr = timerHandlerPtr->nextPtr) { |
301 |
|
|
if (timerHandlerPtr->token != token) { |
302 |
|
|
continue; |
303 |
|
|
} |
304 |
|
|
if (prevPtr == NULL) { |
305 |
|
|
tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; |
306 |
|
|
} else { |
307 |
|
|
prevPtr->nextPtr = timerHandlerPtr->nextPtr; |
308 |
|
|
} |
309 |
|
|
ckfree((char *) timerHandlerPtr); |
310 |
|
|
return; |
311 |
|
|
} |
312 |
|
|
} |
313 |
|
|
|
314 |
|
|
/* |
315 |
|
|
*---------------------------------------------------------------------- |
316 |
|
|
* |
317 |
|
|
* TimerSetupProc -- |
318 |
|
|
* |
319 |
|
|
* This function is called by Tcl_DoOneEvent to setup the timer |
320 |
|
|
* event source for before blocking. This routine checks both the |
321 |
|
|
* idle and after timer lists. |
322 |
|
|
* |
323 |
|
|
* Results: |
324 |
|
|
* None. |
325 |
|
|
* |
326 |
|
|
* Side effects: |
327 |
|
|
* May update the maximum notifier block time. |
328 |
|
|
* |
329 |
|
|
*---------------------------------------------------------------------- |
330 |
|
|
*/ |
331 |
|
|
|
332 |
|
|
static void |
333 |
|
|
TimerSetupProc(data, flags) |
334 |
|
|
ClientData data; /* Not used. */ |
335 |
|
|
int flags; /* Event flags as passed to Tcl_DoOneEvent. */ |
336 |
|
|
{ |
337 |
|
|
Tcl_Time blockTime; |
338 |
|
|
ThreadSpecificData *tsdPtr = InitTimer(); |
339 |
|
|
|
340 |
|
|
if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList) |
341 |
|
|
|| ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) { |
342 |
|
|
/* |
343 |
|
|
* There is an idle handler or a pending timer event, so just poll. |
344 |
|
|
*/ |
345 |
|
|
|
346 |
|
|
blockTime.sec = 0; |
347 |
|
|
blockTime.usec = 0; |
348 |
|
|
|
349 |
|
|
} else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { |
350 |
|
|
/* |
351 |
|
|
* Compute the timeout for the next timer on the list. |
352 |
|
|
*/ |
353 |
|
|
|
354 |
|
|
TclpGetTime(&blockTime); |
355 |
|
|
blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec; |
356 |
|
|
blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec - |
357 |
|
|
blockTime.usec; |
358 |
|
|
if (blockTime.usec < 0) { |
359 |
|
|
blockTime.sec -= 1; |
360 |
|
|
blockTime.usec += 1000000; |
361 |
|
|
} |
362 |
|
|
if (blockTime.sec < 0) { |
363 |
|
|
blockTime.sec = 0; |
364 |
|
|
blockTime.usec = 0; |
365 |
|
|
} |
366 |
|
|
} else { |
367 |
|
|
return; |
368 |
|
|
} |
369 |
|
|
|
370 |
|
|
Tcl_SetMaxBlockTime(&blockTime); |
371 |
|
|
} |
372 |
|
|
|
373 |
|
|
/* |
374 |
|
|
*---------------------------------------------------------------------- |
375 |
|
|
* |
376 |
|
|
* TimerCheckProc -- |
377 |
|
|
* |
378 |
|
|
* This function is called by Tcl_DoOneEvent to check the timer |
379 |
|
|
* event source for events. This routine checks both the |
380 |
|
|
* idle and after timer lists. |
381 |
|
|
* |
382 |
|
|
* Results: |
383 |
|
|
* None. |
384 |
|
|
* |
385 |
|
|
* Side effects: |
386 |
|
|
* May queue an event and update the maximum notifier block time. |
387 |
|
|
* |
388 |
|
|
*---------------------------------------------------------------------- |
389 |
|
|
*/ |
390 |
|
|
|
391 |
|
|
static void |
392 |
|
|
TimerCheckProc(data, flags) |
393 |
|
|
ClientData data; /* Not used. */ |
394 |
|
|
int flags; /* Event flags as passed to Tcl_DoOneEvent. */ |
395 |
|
|
{ |
396 |
|
|
Tcl_Event *timerEvPtr; |
397 |
|
|
Tcl_Time blockTime; |
398 |
|
|
ThreadSpecificData *tsdPtr = InitTimer(); |
399 |
|
|
|
400 |
|
|
if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { |
401 |
|
|
/* |
402 |
|
|
* Compute the timeout for the next timer on the list. |
403 |
|
|
*/ |
404 |
|
|
|
405 |
|
|
TclpGetTime(&blockTime); |
406 |
|
|
blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec; |
407 |
|
|
blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec - |
408 |
|
|
blockTime.usec; |
409 |
|
|
if (blockTime.usec < 0) { |
410 |
|
|
blockTime.sec -= 1; |
411 |
|
|
blockTime.usec += 1000000; |
412 |
|
|
} |
413 |
|
|
if (blockTime.sec < 0) { |
414 |
|
|
blockTime.sec = 0; |
415 |
|
|
blockTime.usec = 0; |
416 |
|
|
} |
417 |
|
|
|
418 |
|
|
/* |
419 |
|
|
* If the first timer has expired, stick an event on the queue. |
420 |
|
|
*/ |
421 |
|
|
|
422 |
|
|
if (blockTime.sec == 0 && blockTime.usec == 0 && |
423 |
|
|
!tsdPtr->timerPending) { |
424 |
|
|
tsdPtr->timerPending = 1; |
425 |
|
|
timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event)); |
426 |
|
|
timerEvPtr->proc = TimerHandlerEventProc; |
427 |
|
|
Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL); |
428 |
|
|
} |
429 |
|
|
} |
430 |
|
|
} |
431 |
|
|
|
432 |
|
|
/* |
433 |
|
|
*---------------------------------------------------------------------- |
434 |
|
|
* |
435 |
|
|
* TimerHandlerEventProc -- |
436 |
|
|
* |
437 |
|
|
* This procedure is called by Tcl_ServiceEvent when a timer event |
438 |
|
|
* reaches the front of the event queue. This procedure handles |
439 |
|
|
* the event by invoking the callbacks for all timers that are |
440 |
|
|
* ready. |
441 |
|
|
* |
442 |
|
|
* Results: |
443 |
|
|
* Returns 1 if the event was handled, meaning it should be removed |
444 |
|
|
* from the queue. Returns 0 if the event was not handled, meaning |
445 |
|
|
* it should stay on the queue. The only time the event isn't |
446 |
|
|
* handled is if the TCL_TIMER_EVENTS flag bit isn't set. |
447 |
|
|
* |
448 |
|
|
* Side effects: |
449 |
|
|
* Whatever the timer handler callback procedures do. |
450 |
|
|
* |
451 |
|
|
*---------------------------------------------------------------------- |
452 |
|
|
*/ |
453 |
|
|
|
454 |
|
|
static int |
455 |
|
|
TimerHandlerEventProc(evPtr, flags) |
456 |
|
|
Tcl_Event *evPtr; /* Event to service. */ |
457 |
|
|
int flags; /* Flags that indicate what events to |
458 |
|
|
* handle, such as TCL_FILE_EVENTS. */ |
459 |
|
|
{ |
460 |
|
|
TimerHandler *timerHandlerPtr, **nextPtrPtr; |
461 |
|
|
Tcl_Time time; |
462 |
|
|
int currentTimerId; |
463 |
|
|
ThreadSpecificData *tsdPtr = InitTimer(); |
464 |
|
|
|
465 |
|
|
/* |
466 |
|
|
* Do nothing if timers aren't enabled. This leaves the event on the |
467 |
|
|
* queue, so we will get to it as soon as ServiceEvents() is called |
468 |
|
|
* with timers enabled. |
469 |
|
|
*/ |
470 |
|
|
|
471 |
|
|
if (!(flags & TCL_TIMER_EVENTS)) { |
472 |
|
|
return 0; |
473 |
|
|
} |
474 |
|
|
|
475 |
|
|
/* |
476 |
|
|
* The code below is trickier than it may look, for the following |
477 |
|
|
* reasons: |
478 |
|
|
* |
479 |
|
|
* 1. New handlers can get added to the list while the current |
480 |
|
|
* one is being processed. If new ones get added, we don't |
481 |
|
|
* want to process them during this pass through the list to avoid |
482 |
|
|
* starving other event sources. This is implemented using the |
483 |
|
|
* token number in the handler: new handlers will have a |
484 |
|
|
* newer token than any of the ones currently on the list. |
485 |
|
|
* 2. The handler can call Tcl_DoOneEvent, so we have to remove |
486 |
|
|
* the handler from the list before calling it. Otherwise an |
487 |
|
|
* infinite loop could result. |
488 |
|
|
* 3. Tcl_DeleteTimerHandler can be called to remove an element from |
489 |
|
|
* the list while a handler is executing, so the list could |
490 |
|
|
* change structure during the call. |
491 |
|
|
* 4. Because we only fetch the current time before entering the loop, |
492 |
|
|
* the only way a new timer will even be considered runnable is if |
493 |
|
|
* its expiration time is within the same millisecond as the |
494 |
|
|
* current time. This is fairly likely on Windows, since it has |
495 |
|
|
* a course granularity clock. Since timers are placed |
496 |
|
|
* on the queue in time order with the most recently created |
497 |
|
|
* handler appearing after earlier ones with the same expiration |
498 |
|
|
* time, we don't have to worry about newer generation timers |
499 |
|
|
* appearing before later ones. |
500 |
|
|
*/ |
501 |
|
|
|
502 |
|
|
tsdPtr->timerPending = 0; |
503 |
|
|
currentTimerId = tsdPtr->lastTimerId; |
504 |
|
|
TclpGetTime(&time); |
505 |
|
|
while (1) { |
506 |
|
|
nextPtrPtr = &tsdPtr->firstTimerHandlerPtr; |
507 |
|
|
timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; |
508 |
|
|
if (timerHandlerPtr == NULL) { |
509 |
|
|
break; |
510 |
|
|
} |
511 |
|
|
|
512 |
|
|
if ((timerHandlerPtr->time.sec > time.sec) |
513 |
|
|
|| ((timerHandlerPtr->time.sec == time.sec) |
514 |
|
|
&& (timerHandlerPtr->time.usec > time.usec))) { |
515 |
|
|
break; |
516 |
|
|
} |
517 |
|
|
|
518 |
|
|
/* |
519 |
|
|
* Bail out if the next timer is of a newer generation. |
520 |
|
|
*/ |
521 |
|
|
|
522 |
|
|
if ((currentTimerId - (int)timerHandlerPtr->token) < 0) { |
523 |
|
|
break; |
524 |
|
|
} |
525 |
|
|
|
526 |
|
|
/* |
527 |
|
|
* Remove the handler from the queue before invoking it, |
528 |
|
|
* to avoid potential reentrancy problems. |
529 |
|
|
*/ |
530 |
|
|
|
531 |
|
|
(*nextPtrPtr) = timerHandlerPtr->nextPtr; |
532 |
|
|
(*timerHandlerPtr->proc)(timerHandlerPtr->clientData); |
533 |
|
|
ckfree((char *) timerHandlerPtr); |
534 |
|
|
} |
535 |
|
|
TimerSetupProc(NULL, TCL_TIMER_EVENTS); |
536 |
|
|
return 1; |
537 |
|
|
} |
538 |
|
|
|
539 |
|
|
/* |
540 |
|
|
*-------------------------------------------------------------- |
541 |
|
|
* |
542 |
|
|
* Tcl_DoWhenIdle -- |
543 |
|
|
* |
544 |
|
|
* Arrange for proc to be invoked the next time the system is |
545 |
|
|
* idle (i.e., just before the next time that Tcl_DoOneEvent |
546 |
|
|
* would have to wait for something to happen). |
547 |
|
|
* |
548 |
|
|
* Results: |
549 |
|
|
* None. |
550 |
|
|
* |
551 |
|
|
* Side effects: |
552 |
|
|
* Proc will eventually be called, with clientData as argument. |
553 |
|
|
* See the manual entry for details. |
554 |
|
|
* |
555 |
|
|
*-------------------------------------------------------------- |
556 |
|
|
*/ |
557 |
|
|
|
558 |
|
|
void |
559 |
|
|
Tcl_DoWhenIdle(proc, clientData) |
560 |
|
|
Tcl_IdleProc *proc; /* Procedure to invoke. */ |
561 |
|
|
ClientData clientData; /* Arbitrary value to pass to proc. */ |
562 |
|
|
{ |
563 |
|
|
register IdleHandler *idlePtr; |
564 |
|
|
Tcl_Time blockTime; |
565 |
|
|
ThreadSpecificData *tsdPtr = InitTimer(); |
566 |
|
|
|
567 |
|
|
idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler)); |
568 |
|
|
idlePtr->proc = proc; |
569 |
|
|
idlePtr->clientData = clientData; |
570 |
|
|
idlePtr->generation = tsdPtr->idleGeneration; |
571 |
|
|
idlePtr->nextPtr = NULL; |
572 |
|
|
if (tsdPtr->lastIdlePtr == NULL) { |
573 |
|
|
tsdPtr->idleList = idlePtr; |
574 |
|
|
} else { |
575 |
|
|
tsdPtr->lastIdlePtr->nextPtr = idlePtr; |
576 |
|
|
} |
577 |
|
|
tsdPtr->lastIdlePtr = idlePtr; |
578 |
|
|
|
579 |
|
|
blockTime.sec = 0; |
580 |
|
|
blockTime.usec = 0; |
581 |
|
|
Tcl_SetMaxBlockTime(&blockTime); |
582 |
|
|
} |
583 |
|
|
|
584 |
|
|
/* |
585 |
|
|
*---------------------------------------------------------------------- |
586 |
|
|
* |
587 |
|
|
* Tcl_CancelIdleCall -- |
588 |
|
|
* |
589 |
|
|
* If there are any when-idle calls requested to a given procedure |
590 |
|
|
* with given clientData, cancel all of them. |
591 |
|
|
* |
592 |
|
|
* Results: |
593 |
|
|
* None. |
594 |
|
|
* |
595 |
|
|
* Side effects: |
596 |
|
|
* If the proc/clientData combination were on the when-idle list, |
597 |
|
|
* they are removed so that they will never be called. |
598 |
|
|
* |
599 |
|
|
*---------------------------------------------------------------------- |
600 |
|
|
*/ |
601 |
|
|
|
602 |
|
|
void |
603 |
|
|
Tcl_CancelIdleCall(proc, clientData) |
604 |
|
|
Tcl_IdleProc *proc; /* Procedure that was previously registered. */ |
605 |
|
|
ClientData clientData; /* Arbitrary value to pass to proc. */ |
606 |
|
|
{ |
607 |
|
|
register IdleHandler *idlePtr, *prevPtr; |
608 |
|
|
IdleHandler *nextPtr; |
609 |
|
|
ThreadSpecificData *tsdPtr = InitTimer(); |
610 |
|
|
|
611 |
|
|
for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL; |
612 |
|
|
prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) { |
613 |
|
|
while ((idlePtr->proc == proc) |
614 |
|
|
&& (idlePtr->clientData == clientData)) { |
615 |
|
|
nextPtr = idlePtr->nextPtr; |
616 |
|
|
ckfree((char *) idlePtr); |
617 |
|
|
idlePtr = nextPtr; |
618 |
|
|
if (prevPtr == NULL) { |
619 |
|
|
tsdPtr->idleList = idlePtr; |
620 |
|
|
} else { |
621 |
|
|
prevPtr->nextPtr = idlePtr; |
622 |
|
|
} |
623 |
|
|
if (idlePtr == NULL) { |
624 |
|
|
tsdPtr->lastIdlePtr = prevPtr; |
625 |
|
|
return; |
626 |
|
|
} |
627 |
|
|
} |
628 |
|
|
} |
629 |
|
|
} |
630 |
|
|
|
631 |
|
|
/* |
632 |
|
|
*---------------------------------------------------------------------- |
633 |
|
|
* |
634 |
|
|
* TclServiceIdle -- |
635 |
|
|
* |
636 |
|
|
* This procedure is invoked by the notifier when it becomes |
637 |
|
|
* idle. It will invoke all idle handlers that are present at |
638 |
|
|
* the time the call is invoked, but not those added during idle |
639 |
|
|
* processing. |
640 |
|
|
* |
641 |
|
|
* Results: |
642 |
|
|
* The return value is 1 if TclServiceIdle found something to |
643 |
|
|
* do, otherwise return value is 0. |
644 |
|
|
* |
645 |
|
|
* Side effects: |
646 |
|
|
* Invokes all pending idle handlers. |
647 |
|
|
* |
648 |
|
|
*---------------------------------------------------------------------- |
649 |
|
|
*/ |
650 |
|
|
|
651 |
|
|
int |
652 |
|
|
TclServiceIdle() |
653 |
|
|
{ |
654 |
|
|
IdleHandler *idlePtr; |
655 |
|
|
int oldGeneration; |
656 |
|
|
Tcl_Time blockTime; |
657 |
|
|
ThreadSpecificData *tsdPtr = InitTimer(); |
658 |
|
|
|
659 |
|
|
if (tsdPtr->idleList == NULL) { |
660 |
|
|
return 0; |
661 |
|
|
} |
662 |
|
|
|
663 |
|
|
oldGeneration = tsdPtr->idleGeneration; |
664 |
|
|
tsdPtr->idleGeneration++; |
665 |
|
|
|
666 |
|
|
/* |
667 |
|
|
* The code below is trickier than it may look, for the following |
668 |
|
|
* reasons: |
669 |
|
|
* |
670 |
|
|
* 1. New handlers can get added to the list while the current |
671 |
|
|
* one is being processed. If new ones get added, we don't |
672 |
|
|
* want to process them during this pass through the list (want |
673 |
|
|
* to check for other work to do first). This is implemented |
674 |
|
|
* using the generation number in the handler: new handlers |
675 |
|
|
* will have a different generation than any of the ones currently |
676 |
|
|
* on the list. |
677 |
|
|
* 2. The handler can call Tcl_DoOneEvent, so we have to remove |
678 |
|
|
* the handler from the list before calling it. Otherwise an |
679 |
|
|
* infinite loop could result. |
680 |
|
|
* 3. Tcl_CancelIdleCall can be called to remove an element from |
681 |
|
|
* the list while a handler is executing, so the list could |
682 |
|
|
* change structure during the call. |
683 |
|
|
*/ |
684 |
|
|
|
685 |
|
|
for (idlePtr = tsdPtr->idleList; |
686 |
|
|
((idlePtr != NULL) |
687 |
|
|
&& ((oldGeneration - idlePtr->generation) >= 0)); |
688 |
|
|
idlePtr = tsdPtr->idleList) { |
689 |
|
|
tsdPtr->idleList = idlePtr->nextPtr; |
690 |
|
|
if (tsdPtr->idleList == NULL) { |
691 |
|
|
tsdPtr->lastIdlePtr = NULL; |
692 |
|
|
} |
693 |
|
|
(*idlePtr->proc)(idlePtr->clientData); |
694 |
|
|
ckfree((char *) idlePtr); |
695 |
|
|
} |
696 |
|
|
if (tsdPtr->idleList) { |
697 |
|
|
blockTime.sec = 0; |
698 |
|
|
blockTime.usec = 0; |
699 |
|
|
Tcl_SetMaxBlockTime(&blockTime); |
700 |
|
|
} |
701 |
|
|
return 1; |
702 |
|
|
} |
703 |
|
|
|
704 |
|
|
/* |
705 |
|
|
*---------------------------------------------------------------------- |
706 |
|
|
* |
707 |
|
|
* Tcl_AfterObjCmd -- |
708 |
|
|
* |
709 |
|
|
* This procedure is invoked to process the "after" Tcl command. |
710 |
|
|
* See the user documentation for details on what it does. |
711 |
|
|
* |
712 |
|
|
* Results: |
713 |
|
|
* A standard Tcl result. |
714 |
|
|
* |
715 |
|
|
* Side effects: |
716 |
|
|
* See the user documentation. |
717 |
|
|
* |
718 |
|
|
*---------------------------------------------------------------------- |
719 |
|
|
*/ |
720 |
|
|
|
721 |
|
|
/* ARGSUSED */ |
722 |
|
|
int |
723 |
|
|
Tcl_AfterObjCmd(clientData, interp, objc, objv) |
724 |
|
|
ClientData clientData; /* Points to the "tclAfter" assocData for |
725 |
|
|
* this interpreter, or NULL if the assocData |
726 |
|
|
* hasn't been created yet.*/ |
727 |
|
|
Tcl_Interp *interp; /* Current interpreter. */ |
728 |
|
|
int objc; /* Number of arguments. */ |
729 |
|
|
Tcl_Obj *CONST objv[]; /* Argument objects. */ |
730 |
|
|
{ |
731 |
|
|
int ms; |
732 |
|
|
AfterInfo *afterPtr; |
733 |
|
|
AfterAssocData *assocPtr = (AfterAssocData *) clientData; |
734 |
|
|
Tcl_CmdInfo cmdInfo; |
735 |
|
|
int length; |
736 |
|
|
char *argString; |
737 |
|
|
int index; |
738 |
|
|
char buf[16 + TCL_INTEGER_SPACE]; |
739 |
|
|
static char *afterSubCmds[] = {"cancel", "idle", "info", (char *) NULL}; |
740 |
|
|
enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO}; |
741 |
|
|
ThreadSpecificData *tsdPtr = InitTimer(); |
742 |
|
|
|
743 |
|
|
if (objc < 2) { |
744 |
|
|
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); |
745 |
|
|
return TCL_ERROR; |
746 |
|
|
} |
747 |
|
|
|
748 |
|
|
/* |
749 |
|
|
* Create the "after" information associated for this interpreter, |
750 |
|
|
* if it doesn't already exist. Associate it with the command too, |
751 |
|
|
* so that it will be passed in as the ClientData argument in the |
752 |
|
|
* future. |
753 |
|
|
*/ |
754 |
|
|
|
755 |
|
|
if (assocPtr == NULL) { |
756 |
|
|
assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData)); |
757 |
|
|
assocPtr->interp = interp; |
758 |
|
|
assocPtr->firstAfterPtr = NULL; |
759 |
|
|
Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, |
760 |
|
|
(ClientData) assocPtr); |
761 |
|
|
cmdInfo.proc = NULL; |
762 |
|
|
cmdInfo.clientData = (ClientData) NULL; |
763 |
|
|
cmdInfo.objProc = Tcl_AfterObjCmd; |
764 |
|
|
cmdInfo.objClientData = (ClientData) assocPtr; |
765 |
|
|
cmdInfo.deleteProc = NULL; |
766 |
|
|
cmdInfo.deleteData = (ClientData) assocPtr; |
767 |
|
|
Tcl_SetCommandInfo(interp, Tcl_GetStringFromObj(objv[0], &length), |
768 |
|
|
&cmdInfo); |
769 |
|
|
} |
770 |
|
|
|
771 |
|
|
/* |
772 |
|
|
* First lets see if the command was passed a number as the first argument. |
773 |
|
|
*/ |
774 |
|
|
|
775 |
|
|
if (objv[1]->typePtr == &tclIntType) { |
776 |
|
|
ms = (int) objv[1]->internalRep.longValue; |
777 |
|
|
goto processInteger; |
778 |
|
|
} |
779 |
|
|
argString = Tcl_GetStringFromObj(objv[1], &length); |
780 |
|
|
if (isdigit(UCHAR(argString[0]))) { /* INTL: digit */ |
781 |
|
|
if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) { |
782 |
|
|
return TCL_ERROR; |
783 |
|
|
} |
784 |
|
|
processInteger: |
785 |
|
|
if (ms < 0) { |
786 |
|
|
ms = 0; |
787 |
|
|
} |
788 |
|
|
if (objc == 2) { |
789 |
|
|
Tcl_Sleep(ms); |
790 |
|
|
return TCL_OK; |
791 |
|
|
} |
792 |
|
|
afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo))); |
793 |
|
|
afterPtr->assocPtr = assocPtr; |
794 |
|
|
if (objc == 3) { |
795 |
|
|
afterPtr->commandPtr = objv[2]; |
796 |
|
|
} else { |
797 |
|
|
afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); |
798 |
|
|
} |
799 |
|
|
Tcl_IncrRefCount(afterPtr->commandPtr); |
800 |
|
|
/* |
801 |
|
|
* The variable below is used to generate unique identifiers for |
802 |
|
|
* after commands. This id can wrap around, which can potentially |
803 |
|
|
* cause problems. However, there are not likely to be problems |
804 |
|
|
* in practice, because after commands can only be requested to |
805 |
|
|
* about a month in the future, and wrap-around is unlikely to |
806 |
|
|
* occur in less than about 1-10 years. Thus it's unlikely that |
807 |
|
|
* any old ids will still be around when wrap-around occurs. |
808 |
|
|
*/ |
809 |
|
|
afterPtr->id = tsdPtr->afterId; |
810 |
|
|
tsdPtr->afterId += 1; |
811 |
|
|
afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc, |
812 |
|
|
(ClientData) afterPtr); |
813 |
|
|
afterPtr->nextPtr = assocPtr->firstAfterPtr; |
814 |
|
|
assocPtr->firstAfterPtr = afterPtr; |
815 |
|
|
sprintf(buf, "after#%d", afterPtr->id); |
816 |
|
|
Tcl_AppendResult(interp, buf, (char *) NULL); |
817 |
|
|
return TCL_OK; |
818 |
|
|
} |
819 |
|
|
|
820 |
|
|
/* |
821 |
|
|
* If it's not a number it must be a subcommand. |
822 |
|
|
*/ |
823 |
|
|
|
824 |
|
|
if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "argument", |
825 |
|
|
0, &index) != TCL_OK) { |
826 |
|
|
Tcl_AppendResult(interp, "bad argument \"", argString, |
827 |
|
|
"\": must be cancel, idle, info, or a number", |
828 |
|
|
(char *) NULL); |
829 |
|
|
return TCL_ERROR; |
830 |
|
|
} |
831 |
|
|
switch ((enum afterSubCmds) index) { |
832 |
|
|
case AFTER_CANCEL: { |
833 |
|
|
Tcl_Obj *commandPtr; |
834 |
|
|
char *command, *tempCommand; |
835 |
|
|
int tempLength; |
836 |
|
|
|
837 |
|
|
if (objc < 3) { |
838 |
|
|
Tcl_WrongNumArgs(interp, 2, objv, "id|command"); |
839 |
|
|
return TCL_ERROR; |
840 |
|
|
} |
841 |
|
|
if (objc == 3) { |
842 |
|
|
commandPtr = objv[2]; |
843 |
|
|
} else { |
844 |
|
|
commandPtr = Tcl_ConcatObj(objc-2, objv+2);; |
845 |
|
|
} |
846 |
|
|
command = Tcl_GetStringFromObj(commandPtr, &length); |
847 |
|
|
for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; |
848 |
|
|
afterPtr = afterPtr->nextPtr) { |
849 |
|
|
tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr, |
850 |
|
|
&tempLength); |
851 |
|
|
if ((length == tempLength) |
852 |
|
|
&& (memcmp((void*) command, (void*) tempCommand, |
853 |
|
|
(unsigned) length) == 0)) { |
854 |
|
|
break; |
855 |
|
|
} |
856 |
|
|
} |
857 |
|
|
if (afterPtr == NULL) { |
858 |
|
|
afterPtr = GetAfterEvent(assocPtr, commandPtr); |
859 |
|
|
} |
860 |
|
|
if (objc != 3) { |
861 |
|
|
Tcl_DecrRefCount(commandPtr); |
862 |
|
|
} |
863 |
|
|
if (afterPtr != NULL) { |
864 |
|
|
if (afterPtr->token != NULL) { |
865 |
|
|
Tcl_DeleteTimerHandler(afterPtr->token); |
866 |
|
|
} else { |
867 |
|
|
Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr); |
868 |
|
|
} |
869 |
|
|
FreeAfterPtr(afterPtr); |
870 |
|
|
} |
871 |
|
|
break; |
872 |
|
|
} |
873 |
|
|
case AFTER_IDLE: |
874 |
|
|
if (objc < 3) { |
875 |
|
|
Tcl_WrongNumArgs(interp, 2, objv, "script script ..."); |
876 |
|
|
return TCL_ERROR; |
877 |
|
|
} |
878 |
|
|
afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo))); |
879 |
|
|
afterPtr->assocPtr = assocPtr; |
880 |
|
|
if (objc == 3) { |
881 |
|
|
afterPtr->commandPtr = objv[2]; |
882 |
|
|
} else { |
883 |
|
|
afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); |
884 |
|
|
} |
885 |
|
|
Tcl_IncrRefCount(afterPtr->commandPtr); |
886 |
|
|
afterPtr->id = tsdPtr->afterId; |
887 |
|
|
tsdPtr->afterId += 1; |
888 |
|
|
afterPtr->token = NULL; |
889 |
|
|
afterPtr->nextPtr = assocPtr->firstAfterPtr; |
890 |
|
|
assocPtr->firstAfterPtr = afterPtr; |
891 |
|
|
Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr); |
892 |
|
|
sprintf(buf, "after#%d", afterPtr->id); |
893 |
|
|
Tcl_AppendResult(interp, buf, (char *) NULL); |
894 |
|
|
break; |
895 |
|
|
case AFTER_INFO: { |
896 |
|
|
Tcl_Obj *resultListPtr; |
897 |
|
|
|
898 |
|
|
if (objc == 2) { |
899 |
|
|
for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; |
900 |
|
|
afterPtr = afterPtr->nextPtr) { |
901 |
|
|
if (assocPtr->interp == interp) { |
902 |
|
|
sprintf(buf, "after#%d", afterPtr->id); |
903 |
|
|
Tcl_AppendElement(interp, buf); |
904 |
|
|
} |
905 |
|
|
} |
906 |
|
|
return TCL_OK; |
907 |
|
|
} |
908 |
|
|
if (objc != 3) { |
909 |
|
|
Tcl_WrongNumArgs(interp, 2, objv, "?id?"); |
910 |
|
|
return TCL_ERROR; |
911 |
|
|
} |
912 |
|
|
afterPtr = GetAfterEvent(assocPtr, objv[2]); |
913 |
|
|
if (afterPtr == NULL) { |
914 |
|
|
Tcl_AppendResult(interp, "event \"", Tcl_GetString(objv[2]), |
915 |
|
|
"\" doesn't exist", (char *) NULL); |
916 |
|
|
return TCL_ERROR; |
917 |
|
|
} |
918 |
|
|
resultListPtr = Tcl_GetObjResult(interp); |
919 |
|
|
Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr); |
920 |
|
|
Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( |
921 |
|
|
(afterPtr->token == NULL) ? "idle" : "timer", -1)); |
922 |
|
|
Tcl_SetObjResult(interp, resultListPtr); |
923 |
|
|
break; |
924 |
|
|
} |
925 |
|
|
default: { |
926 |
|
|
panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds"); |
927 |
|
|
} |
928 |
|
|
} |
929 |
|
|
return TCL_OK; |
930 |
|
|
} |
931 |
|
|
|
932 |
|
|
/* |
933 |
|
|
*---------------------------------------------------------------------- |
934 |
|
|
* |
935 |
|
|
* GetAfterEvent -- |
936 |
|
|
* |
937 |
|
|
* This procedure parses an "after" id such as "after#4" and |
938 |
|
|
* returns a pointer to the AfterInfo structure. |
939 |
|
|
* |
940 |
|
|
* Results: |
941 |
|
|
* The return value is either a pointer to an AfterInfo structure, |
942 |
|
|
* if one is found that corresponds to "cmdString" and is for interp, |
943 |
|
|
* or NULL if no corresponding after event can be found. |
944 |
|
|
* |
945 |
|
|
* Side effects: |
946 |
|
|
* None. |
947 |
|
|
* |
948 |
|
|
*---------------------------------------------------------------------- |
949 |
|
|
*/ |
950 |
|
|
|
951 |
|
|
static AfterInfo * |
952 |
|
|
GetAfterEvent(assocPtr, commandPtr) |
953 |
|
|
AfterAssocData *assocPtr; /* Points to "after"-related information for |
954 |
|
|
* this interpreter. */ |
955 |
|
|
Tcl_Obj *commandPtr; |
956 |
|
|
{ |
957 |
|
|
char *cmdString; /* Textual identifier for after event, such |
958 |
|
|
* as "after#6". */ |
959 |
|
|
AfterInfo *afterPtr; |
960 |
|
|
int id; |
961 |
|
|
char *end; |
962 |
|
|
|
963 |
|
|
cmdString = Tcl_GetString(commandPtr); |
964 |
|
|
if (strncmp(cmdString, "after#", 6) != 0) { |
965 |
|
|
return NULL; |
966 |
|
|
} |
967 |
|
|
cmdString += 6; |
968 |
|
|
id = strtoul(cmdString, &end, 10); |
969 |
|
|
if ((end == cmdString) || (*end != 0)) { |
970 |
|
|
return NULL; |
971 |
|
|
} |
972 |
|
|
for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; |
973 |
|
|
afterPtr = afterPtr->nextPtr) { |
974 |
|
|
if (afterPtr->id == id) { |
975 |
|
|
return afterPtr; |
976 |
|
|
} |
977 |
|
|
} |
978 |
|
|
return NULL; |
979 |
|
|
} |
980 |
|
|
|
981 |
|
|
/* |
982 |
|
|
*---------------------------------------------------------------------- |
983 |
|
|
* |
984 |
|
|
* AfterProc -- |
985 |
|
|
* |
986 |
|
|
* Timer callback to execute commands registered with the |
987 |
|
|
* "after" command. |
988 |
|
|
* |
989 |
|
|
* Results: |
990 |
|
|
* None. |
991 |
|
|
* |
992 |
|
|
* Side effects: |
993 |
|
|
* Executes whatever command was specified. If the command |
994 |
|
|
* returns an error, then the command "bgerror" is invoked |
995 |
|
|
* to process the error; if bgerror fails then information |
996 |
|
|
* about the error is output on stderr. |
997 |
|
|
* |
998 |
|
|
*---------------------------------------------------------------------- |
999 |
|
|
*/ |
1000 |
|
|
|
1001 |
|
|
static void |
1002 |
|
|
AfterProc(clientData) |
1003 |
|
|
ClientData clientData; /* Describes command to execute. */ |
1004 |
|
|
{ |
1005 |
|
|
AfterInfo *afterPtr = (AfterInfo *) clientData; |
1006 |
|
|
AfterAssocData *assocPtr = afterPtr->assocPtr; |
1007 |
|
|
AfterInfo *prevPtr; |
1008 |
|
|
int result; |
1009 |
|
|
Tcl_Interp *interp; |
1010 |
|
|
char *script; |
1011 |
|
|
int numBytes; |
1012 |
|
|
|
1013 |
|
|
/* |
1014 |
|
|
* First remove the callback from our list of callbacks; otherwise |
1015 |
|
|
* someone could delete the callback while it's being executed, which |
1016 |
|
|
* could cause a core dump. |
1017 |
|
|
*/ |
1018 |
|
|
|
1019 |
|
|
if (assocPtr->firstAfterPtr == afterPtr) { |
1020 |
|
|
assocPtr->firstAfterPtr = afterPtr->nextPtr; |
1021 |
|
|
} else { |
1022 |
|
|
for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr; |
1023 |
|
|
prevPtr = prevPtr->nextPtr) { |
1024 |
|
|
/* Empty loop body. */ |
1025 |
|
|
} |
1026 |
|
|
prevPtr->nextPtr = afterPtr->nextPtr; |
1027 |
|
|
} |
1028 |
|
|
|
1029 |
|
|
/* |
1030 |
|
|
* Execute the callback. |
1031 |
|
|
*/ |
1032 |
|
|
|
1033 |
|
|
interp = assocPtr->interp; |
1034 |
|
|
Tcl_Preserve((ClientData) interp); |
1035 |
|
|
script = Tcl_GetStringFromObj(afterPtr->commandPtr, &numBytes); |
1036 |
|
|
result = Tcl_EvalEx(interp, script, numBytes, TCL_EVAL_GLOBAL); |
1037 |
|
|
if (result != TCL_OK) { |
1038 |
|
|
Tcl_AddErrorInfo(interp, "\n (\"after\" script)"); |
1039 |
|
|
Tcl_BackgroundError(interp); |
1040 |
|
|
} |
1041 |
|
|
Tcl_Release((ClientData) interp); |
1042 |
|
|
|
1043 |
|
|
/* |
1044 |
|
|
* Free the memory for the callback. |
1045 |
|
|
*/ |
1046 |
|
|
|
1047 |
|
|
Tcl_DecrRefCount(afterPtr->commandPtr); |
1048 |
|
|
ckfree((char *) afterPtr); |
1049 |
|
|
} |
1050 |
|
|
|
1051 |
|
|
/* |
1052 |
|
|
*---------------------------------------------------------------------- |
1053 |
|
|
* |
1054 |
|
|
* FreeAfterPtr -- |
1055 |
|
|
* |
1056 |
|
|
* This procedure removes an "after" command from the list of |
1057 |
|
|
* those that are pending and frees its resources. This procedure |
1058 |
|
|
* does *not* cancel the timer handler; if that's needed, the |
1059 |
|
|
* caller must do it. |
1060 |
|
|
* |
1061 |
|
|
* Results: |
1062 |
|
|
* None. |
1063 |
|
|
* |
1064 |
|
|
* Side effects: |
1065 |
|
|
* The memory associated with afterPtr is released. |
1066 |
|
|
* |
1067 |
|
|
*---------------------------------------------------------------------- |
1068 |
|
|
*/ |
1069 |
|
|
|
1070 |
|
|
static void |
1071 |
|
|
FreeAfterPtr(afterPtr) |
1072 |
|
|
AfterInfo *afterPtr; /* Command to be deleted. */ |
1073 |
|
|
{ |
1074 |
|
|
AfterInfo *prevPtr; |
1075 |
|
|
AfterAssocData *assocPtr = afterPtr->assocPtr; |
1076 |
|
|
|
1077 |
|
|
if (assocPtr->firstAfterPtr == afterPtr) { |
1078 |
|
|
assocPtr->firstAfterPtr = afterPtr->nextPtr; |
1079 |
|
|
} else { |
1080 |
|
|
for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr; |
1081 |
|
|
prevPtr = prevPtr->nextPtr) { |
1082 |
|
|
/* Empty loop body. */ |
1083 |
|
|
} |
1084 |
|
|
prevPtr->nextPtr = afterPtr->nextPtr; |
1085 |
|
|
} |
1086 |
|
|
Tcl_DecrRefCount(afterPtr->commandPtr); |
1087 |
|
|
ckfree((char *) afterPtr); |
1088 |
|
|
} |
1089 |
|
|
|
1090 |
|
|
/* |
1091 |
|
|
*---------------------------------------------------------------------- |
1092 |
|
|
* |
1093 |
|
|
* AfterCleanupProc -- |
1094 |
|
|
* |
1095 |
|
|
* This procedure is invoked whenever an interpreter is deleted |
1096 |
|
|
* to cleanup the AssocData for "tclAfter". |
1097 |
|
|
* |
1098 |
|
|
* Results: |
1099 |
|
|
* None. |
1100 |
|
|
* |
1101 |
|
|
* Side effects: |
1102 |
|
|
* After commands are removed. |
1103 |
|
|
* |
1104 |
|
|
*---------------------------------------------------------------------- |
1105 |
|
|
*/ |
1106 |
|
|
|
1107 |
|
|
/* ARGSUSED */ |
1108 |
|
|
static void |
1109 |
|
|
AfterCleanupProc(clientData, interp) |
1110 |
|
|
ClientData clientData; /* Points to AfterAssocData for the |
1111 |
|
|
* interpreter. */ |
1112 |
|
|
Tcl_Interp *interp; /* Interpreter that is being deleted. */ |
1113 |
|
|
{ |
1114 |
|
|
AfterAssocData *assocPtr = (AfterAssocData *) clientData; |
1115 |
|
|
AfterInfo *afterPtr; |
1116 |
|
|
|
1117 |
|
|
while (assocPtr->firstAfterPtr != NULL) { |
1118 |
|
|
afterPtr = assocPtr->firstAfterPtr; |
1119 |
|
|
assocPtr->firstAfterPtr = afterPtr->nextPtr; |
1120 |
|
|
if (afterPtr->token != NULL) { |
1121 |
|
|
Tcl_DeleteTimerHandler(afterPtr->token); |
1122 |
|
|
} else { |
1123 |
|
|
Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr); |
1124 |
|
|
} |
1125 |
|
|
Tcl_DecrRefCount(afterPtr->commandPtr); |
1126 |
|
|
ckfree((char *) afterPtr); |
1127 |
|
|
} |
1128 |
|
|
ckfree((char *) assocPtr); |
1129 |
|
|
} |
1130 |
|
|
|
1131 |
|
|
/* End of tcltimer.c */ |