TIP #324 IMPLEMENTATION

1 files changed, 114 insertions, 1 deletions

diff --git a/generic/tkUtil.c b/generic/tkUtil.c
index 8cfaf9a..5218740 100644
--- a/generic/tkUtil.c
+++ b/generic/tkUtil.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkUtil.c,v 1.26 2008/12/10 04:27:45 das Exp $
+ * RCS: @(#) $Id: tkUtil.c,v 1.27 2008/12/10 05:02:51 das Exp $
  */
 
 #include "tkInt.h"
@@ -978,6 +978,89 @@ TkFindStateNumObj(
 }
 
 /*
+ * ----------------------------------------------------------------------
+ *
+ * TkBackgroundEvalObjv --
+ *
+ *	Evaluate a command while ensuring that we do not affect the
+ *	interpreters state. This is important when evaluating script
+ *	during background tasks.
+ *
+ * Results:
+ *	A standard Tcl result code.
+ *
+ * Side Effects:
+ *	The interpreters variables and code may be modified by the script
+ *	but the result will not be modified.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TkBackgroundEvalObjv(
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv,
+    int flags)
+{
+    Tcl_DString errorInfo, errorCode;
+    Tcl_SavedResult state;
+    int n, r = TCL_OK;
+
+    Tcl_DStringInit(&errorInfo);
+    Tcl_DStringInit(&errorCode);
+
+    Tcl_Preserve(interp);
+
+    /*
+     * Record the state of the interpreter
+     */
+
+    Tcl_SaveResult(interp, &state);
+    Tcl_DStringAppend(&errorInfo,
+	Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1);
+    Tcl_DStringAppend(&errorCode,
+	Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY), -1);
+
+    /*
+     * Evaluate the command and handle any error.
+     */
+
+    for (n = 0; n < objc; ++n) {
+	Tcl_IncrRefCount(objv[n]);
+    }
+    r = Tcl_EvalObjv(interp, objc, objv, flags);
+    for (n = 0; n < objc; ++n) {
+	Tcl_DecrRefCount(objv[n]);
+    }
+    if (r == TCL_ERROR) {
+        Tcl_AddErrorInfo(interp, "\n    (background event handler)");
+        Tcl_BackgroundError(interp);
+    }
+
+    Tcl_Release(interp);
+
+    /*
+     * Restore the state of the interpreter
+     */
+
+    Tcl_SetVar(interp, "errorInfo",
+	Tcl_DStringValue(&errorInfo), TCL_GLOBAL_ONLY);
+    Tcl_SetVar(interp, "errorCode",
+	Tcl_DStringValue(&errorCode), TCL_GLOBAL_ONLY);
+    Tcl_RestoreResult(interp, &state);
+
+    /*
+     * Clean up references.
+     */
+
+    Tcl_DStringFree(&errorInfo);
+    Tcl_DStringFree(&errorCode);
+
+    return r;
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * TkMakeEnsemble --
@@ -1060,6 +1143,36 @@ TkMakeEnsemble(
     Tcl_DStringFree(&ds);
     return ensemble;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSendVirtualEvent --
+ *
+ * 	Send a virtual event notification to the specified target window.
+ * 	Equivalent to "event generate $target <<$eventName>>"
+ *
+ * 	Note that we use Tk_QueueWindowEvent, not Tk_HandleEvent,
+ * 	so this routine does not reenter the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSendVirtualEvent(Tk_Window target, const char *eventName)
+{
+    XEvent event;
+
+    memset(&event, 0, sizeof(event));
+    event.xany.type = VirtualEvent;
+    event.xany.serial = NextRequest(Tk_Display(target));
+    event.xany.send_event = False;
+    event.xany.window = Tk_WindowId(target);
+    event.xany.display = Tk_Display(target);
+    ((XVirtualEvent *) &event)->name = Tk_GetUid(eventName);
+
+    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+}
 /*
  * Local Variables:
  * mode: c