/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tcltimer.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tcltimer.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 71 - (show annotations) (download)
Sat Nov 5 11:07:06 2016 UTC (8 years, 1 month ago) by dashley
File MIME type: text/plain
File size: 33067 byte(s)
Set EOL properties appropriately to facilitate simultaneous Linux and Windows development.
1 /* $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 */

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25