summaryrefslogtreecommitdiffstats
path: root/generic/tkUtil.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkUtil.c')
-rw-r--r--generic/tkUtil.c115
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