[enhancement] extend "vwait" with same options as "update", new syntax "vwait ?options? ?timeout? varname".

some small improvements and fixing:
- Tcl_DoOneEvent can wait for block time that was set with Tcl_SetMaxBlockTime outside an event source traversal,
  and stop waiting if Tcl_SetMaxBlockTime was called outside an event source (another event occurs and interrupt waiting loop), etc;
- safer more precise pre-lookup by options (use TclObjIsIndexOfTable instead of simply comparison of type with tclIndexType);
test cases extended to cover conditional "vwait" usage;

6 files changed, 151 insertions, 89 deletions

diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 6413d10..84e4637 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1300,6 +1300,17 @@ TclInThreadExit(void)
 }
 
 
+static CONST char *updateEventOptions[] = {
+	"-idle", "-noidle",	/* new options */
+	"-timer", "-notimer",
+	"-file", "-nofile",
+	"-window", "-nowindow",
+	"-async", "-noasync",
+	"-nowait", "-wait",
+	"idletasks",  		/* backwards compat. */
+	NULL
+};
+
 static int
 GetEventFlagsFromOpts(
     Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
@@ -1309,15 +1320,6 @@ GetEventFlagsFromOpts(
 {
     int i, optionIndex, result = TCL_ERROR;
     int flags = *flagsPtr; /* default flags */
-    static CONST char *updateOptions[] = {
-	"-idle", "-noidle",	/* new options */
-	"-timer", "-notimer",
-	"-file", "-nofile",
-	"-window", "-nowindow",
-	"-async", "-noasync",
-	"-nowait", "-wait",
-	"idletasks",  		/* backwards compat. */
-	NULL};
     static CONST struct {
 	int mask;
 	int flags;
@@ -1334,7 +1336,7 @@ GetEventFlagsFromOpts(
     };
 
     for (i = 0; i < objc; i++) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], updateOptions,
+	if (Tcl_GetIndexFromObj(interp, objv[i], updateEventOptions,
 		"option", 0, &optionIndex) != TCL_OK) {
 	    goto done;
 	}
@@ -1354,14 +1356,6 @@ GetEventFlagsFromOpts(
     return result;
 }
 
-static void
-VwaitTimeOutProc(
-    ClientData clientData)
-{
-    int *donePtr = (int *) clientData;
-
-    *donePtr = -1;
-}
 /*
  *----------------------------------------------------------------------
  *
@@ -1387,27 +1381,26 @@ Tcl_VwaitObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
-    int done = 0, foundEvent;
+    int done = 0, foundEvent = 1;
     int flags = TCL_ALL_EVENTS; /* default flags */
     char *nameString;
     int opti = 1,	 /* start option index (and index of varname later) */
     	optc = objc - 2; /* options count without cmd and varname */
-    TimerEntry *timerEvent = NULL;
     Tcl_WideInt ms = -1;
+    Tcl_Time wakeup;
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?options? name ?timeout?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?options? ?timeout? name");
 	return TCL_ERROR;
     }
 
     /* if arguments available - wrap options to flags */
     if (objc >= 3) {
 	/* first try to recognize options up to the possible end, thereby
-	 * we assume that varname is not integer, try to get numeric timeout,
-	 * (just assume precidence of option fewer as timeout)
+	 * we assume that option is not an integer, try to get numeric timeout
 	 */
-	if (Tcl_GetWideIntFromObj(NULL, objv[objc-1], &ms) == TCL_OK) {
-	    objc--;
+	if (!TclObjIsIndexOfTable(objv[optc], updateEventOptions)
+	  && Tcl_GetWideIntFromObj(NULL, objv[optc], &ms) == TCL_OK) {
 	    optc--;
 	}
 
@@ -1417,16 +1410,12 @@ Tcl_VwaitObjCmd(
 	) {
 	    return TCL_ERROR;
 	}
-	/* opti points to varname */
-	opti += optc;
     }
 
     done = 0;
 
     /* if timeout specified - create timer event or no-wait by 0ms */
     if (ms != -1) {
-	Tcl_Time wakeup;
-
 	if (ms > 0) {
 	    Tcl_GetTime(&wakeup);
 	    wakeup.sec += (long)(ms / 1000);
@@ -1435,26 +1424,38 @@ Tcl_VwaitObjCmd(
 		wakeup.sec++;
 		wakeup.usec -= 1000000;
 	    }
-	    timerEvent = TclCreateAbsoluteTimerHandlerEx(&wakeup, VwaitTimeOutProc, NULL, 0);
-	    timerEvent->clientData = &done;
 	} else if (ms == 0) {
 	    flags |= TCL_DONT_WAIT;
 	}
     }
 
-    nameString = Tcl_GetString(objv[opti]);
+    nameString = Tcl_GetString(objv[objc-1]);
     if (Tcl_TraceVar(interp, nameString,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 	    VwaitVarProc, (ClientData) &done) != TCL_OK) {
-
-	/* if timeout-timer and no timeout fired, cancel timer event */
-	if (timerEvent && done != -1) {
-	    TclDeleteTimerEntry(timerEvent);
-	}
 	return TCL_ERROR;
     };
 
     do {
+    	/* if wait - set blocking time */
+	if (ms > 0) {
+	    Tcl_Time blockTime;
+	    Tcl_GetTime(&blockTime);
+	    blockTime.sec = wakeup.sec - blockTime.sec;
+	    blockTime.usec = wakeup.usec - blockTime.usec;
+	    if (blockTime.usec < 0) {
+		blockTime.sec -= 1;
+		blockTime.usec += 1000000;
+	    }
+	    if (  blockTime.sec < 0 
+	      || (blockTime.sec == 0 && blockTime.usec <= 0)
+	    ) {
+		/* timeout occurs */
+		done = -1;
+		break;
+	    }
+	    Tcl_SetMaxBlockTime(&blockTime);
+	}
 	if ((foundEvent = Tcl_DoOneEvent(flags)) == 0) {
 	    /* 
 	     * If don't wait flag set - no error, and two cases:
@@ -1463,14 +1464,16 @@ Tcl_VwaitObjCmd(
 	     */
 	    if (flags & TCL_DONT_WAIT) {
 		foundEvent = 1;
-		if (ms != 0) {
-		    goto checkLimit; /* continue waiting */
-		}
 		done = -2;
 	    }
+	    if (ms > 0) {
+		foundEvent = 1;
+		goto checkWait; /* continue waiting */
+	    }
 	    break;
 	}
-      checkLimit:
+      checkWait:
+	/* check interpreter limit exceeded */
 	if (Tcl_LimitExceeded(interp)) {
 	    foundEvent = -1;
 	    break;
@@ -1481,11 +1484,6 @@ Tcl_VwaitObjCmd(
 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 	    VwaitVarProc, (ClientData) &done);
 
-    /* if timeout-timer and no timeout fired, cancel timer event */
-    if (timerEvent && done != -1) {
-	TclDeleteTimerEntry(timerEvent);
-    }
-
     /* if timeout specified (and no errors) */
     if (ms != -1 && foundEvent > 0) {
     	Tcl_Obj *objPtr;
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index ced7bd9..4caba7a 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -63,6 +63,43 @@ typedef struct {
 /*
  *----------------------------------------------------------------------
  *
+ * TclObjIsIndexOfStruct --
+ *
+ *	This function looks up an object's is a index of given table.
+ *
+ *	Used for fast lookup by dynamic options count to check for other
+ *	object types.
+ *
+ * Results:
+ *	1 if object is an option of table, otherwise 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclObjIsIndexOfStruct(
+    Tcl_Obj *objPtr,		/* Object containing the string to lookup. */
+    const void *tablePtr)	/* Array of strings to compare against the
+				 * value of objPtr; last entry must be NULL
+				 * and there must not be duplicate entries. */
+{
+    IndexRep *indexRep;
+    if (objPtr->typePtr != &tclIndexType) {
+	return 0;
+    }
+    indexRep = objPtr->internalRep.twoPtrValue.ptr1;
+
+    if (indexRep->tablePtr != (void *) tablePtr) {
+	return 0;
+    }
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_GetIndexFromObj --
  *
  *	This function looks up an object's value in a table of strings and
diff --git a/generic/tclInt.h b/generic/tclInt.h
index dd73eac..42223e4 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2561,6 +2561,12 @@ MODULE_SCOPE char	tclEmptyString;
  *----------------------------------------------------------------
  */
 
+MODULE_SCOPE int	TclObjIsIndexOfStruct(Tcl_Obj *objPtr,
+			    const void *tablePtr);
+#define TclObjIsIndexOfTable(objPtr, tablePtr) \
+	((objPtr->typePtr == &tclIndexType) \
+		&& TclObjIsIndexOfStruct(objPtr, tablePtr))
+
 MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
 			    const unsigned char *bytes, int len);
 MODULE_SCOPE void       TclAdvanceContinuations(int* line, int** next, int loc);
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index f13fca3..fb251b7 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -989,14 +989,18 @@ Tcl_SetMaxBlockTime(
  * Results:
  *	The return value is 1 if the function actually found an event to
  *	process. If no processing occurred, then 0 is returned (this can
- *	happen if the TCL_DONT_WAIT flag is set or if there are no event
- *	handlers to wait for in the set specified by flags).
+ *	happen if the TCL_DONT_WAIT flag is set or block time was set using
+ *	Tcl_SetMaxBlockTime before or if there are no event handlers to wait
+ *	for in the set specified by flags).
  *
  * Side effects:
  *	May delay execution of process while waiting for an event, unless
  *	TCL_DONT_WAIT is set in the flags argument. Event sources are invoked
  *	to check for and queue events. Event handlers may produce arbitrary
  *	side effects.
+ *	If block time was set (Tcl_SetMaxBlockTime) but another event occurs
+ *	and interrupt wait, the function can return early, thereby it resets
+ *	the block time (caller should use Tcl_SetMaxBlockTime again).
  *
  *----------------------------------------------------------------------
  */
@@ -1013,6 +1017,7 @@ Tcl_DoOneEvent(
     EventSource *sourcePtr;
     Tcl_Time *timePtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    int stopWait;
 
     /*
      * No event flags is equivalent to TCL_ALL_EVENTS.
@@ -1022,20 +1027,26 @@ Tcl_DoOneEvent(
 	flags |= TCL_ALL_EVENTS;
     }
 
+    /* Block time was set outside an event source traversal or no wait */
+    stopWait = tsdPtr->blockTimeSet || (flags & TCL_DONT_WAIT);
+
     /*
      * Asynchronous event handlers are considered to be the highest priority
      * events, and so must be invoked before we process events on the event
      * queue.
      */
 
-    if ((flags & TCL_ASYNC_EVENTS) && Tcl_AsyncReady()) {
-	(void) Tcl_AsyncInvoke(NULL, 0);
-	return 1;
-    }
+    if (flags & TCL_ASYNC_EVENTS) {
+	if (Tcl_AsyncReady()) {
+	    (void) Tcl_AsyncInvoke(NULL, 0);
+	    return 1;
+	}
 
-    /* Async only */
-    if ((flags & TCL_ALL_EVENTS) == TCL_ASYNC_EVENTS) {
-	return 0;
+	/* Async only and don't wait - return */
+	if ( (flags & (TCL_ALL_EVENTS|TCL_DONT_WAIT))
+			== (TCL_ASYNC_EVENTS|TCL_DONT_WAIT) ) {
+	    return 0;
+	}
     }
 
     /*
@@ -1047,12 +1058,10 @@ Tcl_DoOneEvent(
     tsdPtr->serviceMode = TCL_SERVICE_NONE;
 
     /*
-     * The core of this function is an infinite loop, even though we only
-     * service one event. The reason for this is that we may be processing
-     * events that don't do anything inside of Tcl.
+     * Main loop until servicing exact one event or block time resp. 
+     * TCL_DONT_WAIT specified (infinite loop if stopWait = 0).
      */
-
-    while (1) {
+    do {
 	/*
 	 * If idle events are the only things to service, skip the main part
 	 * of the loop and go directly to handle idle events (i.e. don't wait
@@ -1060,7 +1069,6 @@ Tcl_DoOneEvent(
 	 */
 
 	if ((flags & TCL_ALL_EVENTS) == TCL_IDLE_EVENTS) {
-	    flags |= TCL_DONT_WAIT;
 	    goto idleEvents;
 	}
 
@@ -1096,8 +1104,6 @@ Tcl_DoOneEvent(
 	    tsdPtr->blockTimeSet = 1;
 	    timePtr = &tsdPtr->blockTime;
 	    goto wait; /* for notifier resp. system events */
-	} else {
-	    tsdPtr->blockTimeSet = 0;
 	}
 
 	/*
@@ -1164,9 +1170,6 @@ Tcl_DoOneEvent(
 		break;
 	    }
 	}
-	if (flags & TCL_DONT_WAIT) {
-	    break;
-	}
 
 	/*
 	 * If Tcl_WaitForEvent has returned 1, indicating that one system
@@ -1176,16 +1179,13 @@ Tcl_DoOneEvent(
 	 * had the side effect of changing the variable (so the vwait can
 	 * return and unwind properly).
 	 *
-	 * NB: We will process idle events if any first, because otherwise we
-	 *     might never do the idle events if the notifier always gets
-	 *     system events.
+	 * We can stop also if block time was set outside an event source,
+	 * that means timeout was set (so exit loop also without event/result).
 	 */
 
-	if (result) {
-	    break;
-	}
-    }
+    } while (!stopWait);
 
+    tsdPtr->blockTimeSet = 0;
     tsdPtr->serviceMode = oldMode;
     return result;
 }
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 52a3073..63346a1 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -1139,7 +1139,7 @@ Tcl_AfterObjCmd(
      */
 
     index = -1;
-    if ( ( objv[1]->typePtr == &tclIndexType 
+    if ( ( TclObjIsIndexOfTable(objv[1], afterSubCmds)
 	|| Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK
       )
       && Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
diff --git a/tests/event.test b/tests/event.test
index cce486a..d2dd2fc 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -488,7 +488,7 @@ test event-10.1 {Tcl_Exit procedure} {stdio} {
 
 test event-11.1 {Tcl_VwaitCmd procedure} {
     list [catch {vwait} msg] $msg
-} {1 {wrong # args: should be "vwait ?options? name ?timeout?"}}
+} {1 {wrong # args: should be "vwait ?options? ?timeout? name"}}
 test event-11.2 {Tcl_VwaitCmd procedure} {
     list [catch {vwait a b} msg] $msg
 } {1 {bad option "a": must be -idle, -noidle, -timer, -notimer, -file, -nofile, -window, -nowindow, -async, -noasync, -nowait, -wait, or idletasks}}
@@ -527,26 +527,26 @@ test event-11.4.0 {vwait - interp limit precedence} {} {
 
     # no limit in between:
     $i limit time -seconds {} -milliseconds {}
-    lappend result 2. [catch {$i eval {vwait x 0}} msg] $msg
+    lappend result 2. [catch {$i eval {vwait 0 x}} msg] $msg
 
     # limit should be exceeded: (wait infinite by -1)
     $i limit time -milliseconds 0
-    lappend result 3. [catch {$i eval {vwait x -1}} msg] $msg
+    lappend result 3. [catch {$i eval {vwait -1 x}} msg] $msg
     # limit should be exceeded (wait too long - 1000ms):
     $i limit time -milliseconds 0
-    lappend result 4. [catch {$i eval {vwait x 1000}} msg] $msg
+    lappend result 4. [catch {$i eval {vwait 1000 x}} msg] $msg
 
     set tout [clock seconds]; incr tout 10
     # wait timeout (before limit):
     $i limit time -seconds $tout
-    lappend result 5. [catch {$i eval {vwait x 0}} msg] $msg
+    lappend result 5. [catch {$i eval {vwait 0 x}} msg] $msg
     # wait timeout (before limit):
     $i limit time -seconds $tout
-    lappend result 6. [catch {$i eval {vwait x 10}} msg] $msg
+    lappend result 6. [catch {$i eval {vwait 10 x}} msg] $msg
 
     # wait successful (before limit):
     $i limit time -seconds $tout
-    lappend result 7. [catch {$i eval {after 0 {set x ""}; vwait x 10}} msg] $msg
+    lappend result 7. [catch {$i eval {after 0 {set x ""}; vwait 10 x}} msg] $msg
 
     interp delete $i
     set result
@@ -560,6 +560,27 @@ test event-11.4.0 {vwait - interp limit precedence} {} {
     7. 0 1 \
 ]
 
+test event-11.4.0 {vwait conditional with timeout (bypass timer)} {} {
+    set x {}
+    after 1000 {lappend x "error-too-slow"}
+    after 0 {lappend x 1-timer}
+    after 1 {lappend x 2-timer}
+    after idle {lappend x 3-idle}
+    vwait -async 50 x; # ignore all except async (timer also)
+    lappend x 4-async
+    vwait -idle 50 x; # ignore all except idle (timer also)
+    lappend x 5-idle
+    after idle {lappend x 6-idle}
+    vwait 100 x; # now we accept timer events
+    lappend x 7-idle
+    vwait 100 x;
+    # cleanup:
+    foreach i [after info] {
+	after cancel $i
+    }
+    set x
+} {4-async 3-idle 5-idle 1-timer 2-timer 7-idle 6-idle}
+
 test event-11.4.1 {vwait with timeout} {} {
     foreach i [after info] {
 	after cancel $i
@@ -568,15 +589,15 @@ test event-11.4.1 {vwait with timeout} {} {
     set x {}
     # success cases:
     after 0 {lappend z 0}
-    after 100 {lappend x 1}
-    after 100 {lappend x 2}
-    after 500 {lappend x 3}
+    after 50 {lappend x 1}
+    after 50 {lappend x 2}
+    after 250 {lappend x 3}
     after 1000 {lappend x "error-too-slow"}
-    vwait x 0; # no-wait
+    vwait 0 x; # no-wait
     lappend z $x; # 0 {} - (x still empty)
-    vwait x 200; # wait up-to 200ms
+    vwait 200 x; # wait up-to 200ms
     lappend z $x; # 0 {} {1 2}
-    vwait x -1; # infinite wait
+    vwait -1 x; # infinite wait
     lappend z $x; # 0 {} {1 2} {1 2 3}
     foreach i [after info] {
 	after cancel $i
@@ -746,7 +767,7 @@ test event-12.5 {update -idle, update -noidle} {
     update -idle
     lappend x 6
     update
-    lappend x res:[vwait x 500]
+    lappend x res:[vwait 500 x]
     set x
 } {0 2 idle 3 idle 6 4 5 1 res:1}
 
@@ -775,7 +796,7 @@ test event-12.6 {update -timer, update -notimer} {
     update -timer -idle
     lappend x 6
     update
-    lappend x res:[vwait x 500]
+    lappend x res:[vwait 500 x]
     update -noidle
     lappend x 7
     update