static int FinalizeEval( ClientData data[], Tcl_Interp *interp, int result) { if (result == TCL_ERROR) { Object *oPtr = data[0]; const char *namePtr; if (oPtr) { namePtr = TclGetString(TclOOObjectName(interp, oPtr)); } else { namePtr = "my"; } Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in \"%s eval\" script line %d)", namePtr, Tcl_GetErrorLine(interp))); } /* * Restore the previous "current" namespace. */ TclPopStackFrame(interp); return result; }
void TkWmProtocolEventProc( TkWindow *winPtr, /* Window to which the event was sent. */ XEvent *eventPtr) /* X event. */ { WmInfo *wmPtr; ProtocolHandler *protPtr; Tcl_Interp *interp; Atom protocol; int result; wmPtr = winPtr->wmInfoPtr; if (wmPtr == NULL) { return; } protocol = (Atom) eventPtr->xclient.data.l[0]; for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protocol == protPtr->protocol) { Tcl_Preserve(protPtr); interp = protPtr->interp; Tcl_Preserve(interp); result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL); if (result != TCL_OK) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (command for \"%s\" window manager protocol)", Tk_GetAtomName((Tk_Window) winPtr, protocol))); Tcl_BackgroundException(interp, result); } Tcl_Release(interp); Tcl_Release(protPtr); return; } } /* * No handler was present for this protocol. If this is a WM_DELETE_WINDOW * message then just destroy the window. */ if (protocol == Tk_InternAtom((Tk_Window) winPtr, "WM_DELETE_WINDOW")) { Tk_DestroyWindow((Tk_Window) winPtr); } }
static int Send( LPDISPATCH pdispInterp, /* Pointer to the remote interp's COM * object. */ Tcl_Interp *interp, /* The local interpreter. */ int async, /* Flag for the calling style. */ ClientData clientData, /* The RegisteredInterp structure for this * interp. */ int objc, /* Number of arguments to be sent. */ Tcl_Obj *const objv[]) /* The arguments to be sent. */ { VARIANT vCmd, vResult; DISPPARAMS dp; EXCEPINFO ei; UINT uiErr = 0; HRESULT hr = S_OK, ehr = S_OK; Tcl_Obj *cmd = NULL; DISPID dispid; cmd = Tcl_ConcatObj(objc, objv); /* * Setup the arguments for the COM method call. */ VariantInit(&vCmd); VariantInit(&vResult); memset(&dp, 0, sizeof(dp)); memset(&ei, 0, sizeof(ei)); vCmd.vt = VT_BSTR; vCmd.bstrVal = SysAllocString(Tcl_GetUnicode(cmd)); dp.cArgs = 1; dp.rgvarg = &vCmd; /* * Select the method to use based upon the async flag and call the method. */ dispid = async ? TKWINSENDCOM_DISPID_ASYNC : TKWINSENDCOM_DISPID_SEND; hr = pdispInterp->lpVtbl->Invoke(pdispInterp, dispid, &IID_NULL, LOCALE_SYSTEM_DEFAULT, DISPATCH_METHOD, &dp, &vResult, &ei, &uiErr); /* * Convert the result into a string and place in the interps result. */ ehr = VariantChangeType(&vResult, &vResult, 0, VT_BSTR); if (SUCCEEDED(ehr)) { Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(vResult.bstrVal, -1)); } /* * Errors are returned as dispatch exceptions. If an error code was * returned then we decode the exception and setup the Tcl error * variables. */ if (hr == DISP_E_EXCEPTION && ei.bstrSource != NULL) { Tcl_Obj *opError, *opErrorCode, *opErrorInfo; opError = Tcl_NewUnicodeObj(ei.bstrSource, -1); Tcl_ListObjIndex(interp, opError, 0, &opErrorCode); Tcl_SetObjErrorCode(interp, opErrorCode); Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo); Tcl_AppendObjToErrorInfo(interp, opErrorInfo); } /* * Clean up any COM allocated resources. */ SysFreeString(ei.bstrDescription); SysFreeString(ei.bstrSource); SysFreeString(ei.bstrHelpFile); VariantClear(&vCmd); return (SUCCEEDED(hr) ? TCL_OK : TCL_ERROR); }
static void ImgBmapConfigureInstance( BitmapInstance *instancePtr)/* Instance to reconfigure. */ { BitmapMaster *masterPtr = instancePtr->masterPtr; XColor *colorPtr; XGCValues gcValues; GC gc; unsigned int mask; Pixmap oldBitmap, oldMask; /* * For each of the options in masterPtr, translate the string form into an * internal form appropriate for instancePtr. */ if (*masterPtr->bgUid != 0) { colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin, masterPtr->bgUid); if (colorPtr == NULL) { goto error; } } else { colorPtr = NULL; } if (instancePtr->bg != NULL) { Tk_FreeColor(instancePtr->bg); } instancePtr->bg = colorPtr; colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin, masterPtr->fgUid); if (colorPtr == NULL) { goto error; } if (instancePtr->fg != NULL) { Tk_FreeColor(instancePtr->fg); } instancePtr->fg = colorPtr; /* * Careful: We have to allocate new Pixmaps before deleting the old ones. * Otherwise, The XID allocator will always return the same XID for the * new Pixmaps as was used for the old Pixmaps. And that will prevent the * data and/or mask from changing in the GC below. */ oldBitmap = instancePtr->bitmap; instancePtr->bitmap = None; oldMask = instancePtr->mask; instancePtr->mask = None; if (masterPtr->data != NULL) { instancePtr->bitmap = XCreateBitmapFromData( Tk_Display(instancePtr->tkwin), RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)), masterPtr->data, (unsigned) masterPtr->width, (unsigned) masterPtr->height); } if (masterPtr->maskData != NULL) { instancePtr->mask = XCreateBitmapFromData( Tk_Display(instancePtr->tkwin), RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)), masterPtr->maskData, (unsigned) masterPtr->width, (unsigned) masterPtr->height); } if (oldMask != None) { Tk_FreePixmap(Tk_Display(instancePtr->tkwin), oldMask); } if (oldBitmap != None) { Tk_FreePixmap(Tk_Display(instancePtr->tkwin), oldBitmap); } if (masterPtr->data != NULL) { gcValues.foreground = instancePtr->fg->pixel; gcValues.graphics_exposures = False; mask = GCForeground|GCGraphicsExposures; if (instancePtr->bg != NULL) { gcValues.background = instancePtr->bg->pixel; mask |= GCBackground; if (instancePtr->mask != None) { gcValues.clip_mask = instancePtr->mask; mask |= GCClipMask; } } else { gcValues.clip_mask = instancePtr->bitmap; mask |= GCClipMask; } gc = Tk_GetGC(instancePtr->tkwin, mask, &gcValues); } else { gc = None; } if (instancePtr->gc != None) { Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc); } instancePtr->gc = gc; return; error: /* * An error occurred: clear the graphics context in the instance to make * it clear that this instance cannot be displayed. Then report the error. */ if (instancePtr->gc != None) { Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc); } instancePtr->gc = None; Tcl_AppendObjToErrorInfo(masterPtr->interp, Tcl_ObjPrintf( "\n (while configuring image \"%s\")", Tk_NameOfImage( masterPtr->tkMaster))); Tcl_BackgroundError(masterPtr->interp); }