Tcl Source Code

Artifact 960900de72d711745c6f4955a6646a57464edcaa:

Attachment "afterxinfo4.patch" to ticket [2010350fff] added by ferrieux 2010-02-02 05:40:40.

---

Index: generic/tclTimer.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTimer.c,v
retrieving revision 1.41
diff -u -p -r1.41 tclTimer.c
--- generic/tclTimer.c	28 Dec 2009 09:53:36 -0000	1.41
+++ generic/tclTimer.c	1 Feb 2010 22:39:36 -0000
@@ -786,9 +786,9 @@ Tcl_AfterObjCmd(
     int index;
     char buf[16 + TCL_INTEGER_SPACE];
     static const char *const afterSubCmds[] = {
-	"cancel", "idle", "info", NULL
+	"cancel", "idle", "info", "next", "xinfo", NULL
     };
-    enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
+    enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO, AFTER_NEXT, AFTER_XINFO};
     ThreadSpecificData *tsdPtr = InitTimer();
 
     if (objc < 2) {
@@ -824,7 +824,8 @@ Tcl_AfterObjCmd(
 	if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
 	    Tcl_AppendResult(interp, "bad argument \"",
 		    Tcl_GetString(objv[1]),
-		    "\": must be cancel, idle, info, or an integer", NULL);
+		    "\": must be cancel, idle, info, next, xinfo, or an integer",
+			     NULL);
 	    return TCL_ERROR;
 	}
     }
@@ -968,6 +969,57 @@ Tcl_AfterObjCmd(
 	Tcl_SetObjResult(interp, resultListPtr);
 	break;
     }
+    case AFTER_NEXT: {
+	TimerHandler *timerHandlerPtr;
+	Tcl_Time now;
+	if (objc != 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "");
+	    return TCL_ERROR;
+	}
+	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
+	if (!timerHandlerPtr) {
+	    ms=-1;
+	} else {
+	    Tcl_GetTime(&now);
+	    ms = TCL_TIME_DIFF_MS(timerHandlerPtr->time,now);
+#ifndef TCL_WIDE_INT_IS_LONG
+	    if (ms > LONG_MAX) {
+		ms = LONG_MAX;
+	    }
+#endif
+	}
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(ms));
+	break;
+    }
+    case AFTER_XINFO: {
+	Tcl_Obj *resultListPtr;
+	TimerHandler *timerHandlerPtr;
+	Tcl_Time now;
+	if (objc != 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "");
+	    return TCL_ERROR;
+	}
+	Tcl_GetTime(&now);
+	resultListPtr = Tcl_NewObj();
+	for(timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;timerHandlerPtr;timerHandlerPtr=timerHandlerPtr->nextPtr)    {
+		/* hide fileevent-originated [after 0] */
+		if (timerHandlerPtr->proc==AfterProc) {
+
+			ms = TCL_TIME_DIFF_MS(timerHandlerPtr->time,now);
+#ifndef TCL_WIDE_INT_IS_LONG
+			if (ms > LONG_MAX) {
+				ms = LONG_MAX;
+			}
+#endif
+			afterPtr=(AfterInfo *)timerHandlerPtr->clientData;
+			Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_ObjPrintf("after#%d", afterPtr->id));
+			Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
+			Tcl_ListObjAppendElement(interp, resultListPtr,  Tcl_NewWideIntObj(ms));
+		}
+	}
+	Tcl_SetObjResult(interp, resultListPtr);
+	break;
+    }
     default:
 	Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
     }