static void IvyDirectMsgCB(IvyClientPtr app, void *user_data, int id, char *msg) { filter_struct *filter = (filter_struct *) user_data; int result, size; char *script_to_call; char int_buffer[INTEGER_SPACE]; sprintf(int_buffer, "%d", id); size = strlen(filter->script) + 1; size += strlen(int_buffer) + 1; size += strlen(msg) + 1; script_to_call = ckalloc(size); strcpy(script_to_call, filter->script); strcat(script_to_call, " "); strcat(script_to_call, int_buffer); strcat(script_to_call, " \""); strcat(script_to_call, msg); strcat(script_to_call, "\""); Tcl_Preserve(filter->interp); result = Tcl_GlobalEval(filter->interp, script_to_call); ckfree(script_to_call); if (result != TCL_OK) { Tcl_BackgroundError(filter->interp); } Tcl_Release(filter->interp); }
static void tvfsExecTcl( Testvfs *p, const char *zMethod, Tcl_Obj *arg1, Tcl_Obj *arg2, Tcl_Obj *arg3, Tcl_Obj *arg4 ){ int rc; /* Return code from Tcl_EvalObj() */ Tcl_Obj *pEval; assert( p->pScript ); assert( zMethod ); assert( p ); assert( arg2==0 || arg1!=0 ); assert( arg3==0 || arg2!=0 ); pEval = Tcl_DuplicateObj(p->pScript); Tcl_IncrRefCount(p->pScript); Tcl_ListObjAppendElement(p->interp, pEval, Tcl_NewStringObj(zMethod, -1)); if( arg1 ) Tcl_ListObjAppendElement(p->interp, pEval, arg1); if( arg2 ) Tcl_ListObjAppendElement(p->interp, pEval, arg2); if( arg3 ) Tcl_ListObjAppendElement(p->interp, pEval, arg3); if( arg4 ) Tcl_ListObjAppendElement(p->interp, pEval, arg4); rc = Tcl_EvalObjEx(p->interp, pEval, TCL_EVAL_GLOBAL); if( rc!=TCL_OK ){ Tcl_BackgroundError(p->interp); Tcl_ResetResult(p->interp); } }
static void IvyDieCB(IvyClientPtr app, void *user_data, /* script a appeler */ int id) { filter_struct *filter = (filter_struct *) user_data; int result, size; char idstr[INTEGER_SPACE]; char *script_to_call; sprintf(idstr, "%d", id); size = strlen(filter->script) + INTEGER_SPACE + 1; script_to_call = ckalloc(size); strcpy(script_to_call, filter->script); strcat(script_to_call, " \""); strcat(script_to_call, idstr); strcat(script_to_call, "\""); Tcl_Preserve(filter->interp); result = Tcl_GlobalEval(filter->interp, script_to_call); ckfree(script_to_call); if (result != TCL_OK) { Tcl_BackgroundError(filter->interp); } Tcl_Release(filter->interp); }
static void IvyAppCB(IvyClientPtr app, void *user_data, /* script a appeler */ IvyApplicationEvent event) { static const char *app_event_str[] = { "Connected", "Disconnected" }; filter_struct *filter = (filter_struct *) user_data; int result, size, dummy; char *script_to_call; Tcl_HashEntry *entry; entry = Tcl_FindHashEntry(&app_table, IvyGetApplicationName(app)); if (event == IvyApplicationConnected) { if (!entry) { entry = Tcl_CreateHashEntry(&app_table, IvyGetApplicationName(app), &dummy); Tcl_SetHashValue(entry, (ClientData) app); } } size = strlen(filter->script) + INTEGER_SPACE; if (entry) { size += strlen(IvyGetApplicationName(app)) + 3; } else { size += 4; } script_to_call = ckalloc(size); strcpy(script_to_call, filter->script); strcat(script_to_call, " "); if (entry) { strcat(script_to_call, " \""); strcat(script_to_call, IvyGetApplicationName(app)); strcat(script_to_call, "\""); } else { strcat(script_to_call, "???"); } strcat(script_to_call, " \""); strcat(script_to_call, app_event_str[event%2]); strcat(script_to_call, "\""); Tcl_Preserve(filter->interp); result = Tcl_GlobalEval(filter->interp, script_to_call); ckfree(script_to_call); if (result != TCL_OK) { Tcl_BackgroundError(filter->interp); } Tcl_Release(filter->interp); if (event == IvyApplicationDisconnected) { if (entry) { Tcl_DeleteHashEntry(entry); } } }
/* ** Handler for events of type EvalEvent. */ static int tclScriptEvent(Tcl_Event *evPtr, int flags){ int rc; EvalEvent *p = (EvalEvent *)evPtr; rc = Tcl_Eval(p->interp, p->zScript); if( rc!=TCL_OK ){ Tcl_BackgroundError(p->interp); } UNUSED_PARAMETER(flags); return 1; }
static void ThemeChangedProc(ClientData clientData) { static char ThemeChangedScript[] = "ttk::ThemeChanged"; StylePackageData *pkgPtr = (StylePackageData *)clientData; if (Tcl_GlobalEval(pkgPtr->interp, ThemeChangedScript) != TCL_OK) { Tcl_BackgroundError(pkgPtr->interp); } pkgPtr->themeChangePending = 0; }
static gboolean doCommand( gpointer data ) { GnoclCommandData *cs = (GnoclCommandData *)data; int ret = Tcl_EvalEx( cs->interp, cs->command, -1, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT ); if( ret == TCL_ERROR ) Tcl_BackgroundError( cs->interp ); if( ret != TCL_OK ) return 0; return 1; }
/* UpdateScrollbarBG -- * Idle handler to update the scrollbar. */ static void UpdateScrollbarBG(ClientData clientData) { ScrollHandle h = (ScrollHandle)clientData; Tcl_Interp *interp = h->corePtr->interp; int code; h->flags &= ~SCROLL_UPDATE_PENDING; Tcl_Preserve((ClientData) interp); code = UpdateScrollbar(interp, h); if (code == TCL_ERROR && !Tcl_InterpDeleted(interp)) { Tcl_BackgroundError(interp); } Tcl_Release((ClientData) interp); }
static void dns_tcl_iporhostres(sockname_t *ip, char *hostn, int ok, void *other) { devent_tclinfo_t *tclinfo = (devent_tclinfo_t *) other; Tcl_DString list; Tcl_DStringInit(&list); Tcl_DStringAppendElement(&list, tclinfo->proc); Tcl_DStringAppendElement(&list, iptostr(&ip->addr.sa)); Tcl_DStringAppendElement(&list, hostn); Tcl_DStringAppendElement(&list, ok ? "1" : "0"); if (tclinfo->paras) { EGG_CONST char *argv[2]; char *output; argv[0] = Tcl_DStringValue(&list); argv[1] = tclinfo->paras; output = Tcl_Concat(2, argv); if (Tcl_Eval(interp, output) == TCL_ERROR) { putlog(LOG_MISC, "*", DCC_TCLERROR, tclinfo->proc, tcl_resultstring()); Tcl_BackgroundError(interp); } Tcl_Free(output); } else if (Tcl_Eval(interp, Tcl_DStringValue(&list)) == TCL_ERROR) { putlog(LOG_MISC, "*", DCC_TCLERROR, tclinfo->proc, tcl_resultstring()); Tcl_BackgroundError(interp); } Tcl_DStringFree(&list); nfree(tclinfo->proc); if (tclinfo->paras) nfree(tclinfo->paras); nfree(tclinfo); }
static OSErr PrefsHandler( const AppleEvent *event, AppleEvent *reply, long handlerRefcon) { Tcl_CmdInfo dummy; Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; if (interp && Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)){ if (Tcl_GlobalEval(interp, "::tk::mac::ShowPreferences") != TCL_OK) { Tcl_BackgroundError(interp); } } return noErr; }
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_AddErrorInfo(interp, "\n (command for \""); Tcl_AddErrorInfo(interp, Tk_GetAtomName((Tk_Window) winPtr, protocol)); Tcl_AddErrorInfo(interp, "\" window manager protocol)"); Tcl_BackgroundError(interp); } 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); } }
/* ** For the markup <a href=XXX>, find out if the URL has been visited ** before or not. Return COLOR_Visited or COLOR_Unvisited, as ** appropriate. ** ** This routine may invoke a callback procedure which could delete ** the HTML widget. The calling function should call HtmlLock() ** if it needs the widget structure to be preserved. */ static int GetLinkColor(HtmlWidget *htmlPtr, char *zURL){ char *zCmd; int result; int isVisited; if( htmlPtr->tkwin==0 ){ TestPoint(0); return COLOR_Normal; } if( htmlPtr->zIsVisited==0 || htmlPtr->zIsVisited[0]==0 ){ TestPoint(0); return COLOR_Unvisited; } zCmd = HtmlAlloc( strlen(htmlPtr->zIsVisited) + strlen(zURL) + 10 ); if( zCmd==0 ){ TestPoint(0); return COLOR_Unvisited; } sprintf(zCmd,"%s {%s}",htmlPtr->zIsVisited, zURL); HtmlLock(htmlPtr); result = Tcl_GlobalEval(htmlPtr->interp,zCmd); HtmlFree(zCmd); if( HtmlUnlock(htmlPtr) ){ return COLOR_Unvisited; } if( result!=TCL_OK ){ TestPoint(0); goto errorOut; } result = Tcl_GetBoolean(htmlPtr->interp, Tcl_GetStringResult(htmlPtr->interp), &isVisited); if( result!=TCL_OK ){ TestPoint(0); goto errorOut; } TestPoint(0); return isVisited ? COLOR_Visited : COLOR_Unvisited; errorOut: Tcl_AddErrorInfo(htmlPtr->interp, "\n (\"-isvisitedcommand\" command executed by html widget)"); Tcl_BackgroundError(htmlPtr->interp); TestPoint(0); return COLOR_Unvisited; }
static int asyncSignalHandler(ClientData data, Tcl_Interp *interp, int code) { ElTclSignalContext *ctx = data; Tcl_Obj *result, *errorInfo, *errorCode; if (ctx->script == ELTCL_SIGDFL || ctx->script == ELTCL_SIGIGN) { fputs("Warning: wrong signal delivered for Tcl\n", stdout); return code; } /* save interpreter state */ result = Tcl_GetObjResult(ctx->iinfo->interp); if (result != NULL) Tcl_IncrRefCount(result); errorInfo = Tcl_GetVar2Ex(ctx->iinfo->interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); if (errorInfo != NULL) Tcl_IncrRefCount(errorInfo); errorCode = Tcl_GetVar2Ex(ctx->iinfo->interp, "errorCode", NULL, TCL_GLOBAL_ONLY); if (errorCode != NULL) Tcl_IncrRefCount(errorCode); /* eval script */ if (Tcl_EvalObjEx(ctx->iinfo->interp, ctx->script, TCL_EVAL_GLOBAL) != TCL_OK) Tcl_BackgroundError(ctx->iinfo->interp); /* restore interpreter state */ if (errorInfo != NULL) { Tcl_SetVar2Ex(ctx->iinfo->interp, "errorInfo", NULL, errorInfo, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(errorInfo); } if (errorCode != NULL) { Tcl_SetVar2Ex(ctx->iinfo->interp, "errorCode", NULL, errorCode, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(errorCode); } if (result != NULL) { Tcl_SetObjResult(ctx->iinfo->interp, result); Tcl_DecrRefCount(result); } return code; }
static OSErr OappHandler( const AppleEvent *event, AppleEvent *reply, SRefCon handlerRefcon) { Tcl_CmdInfo dummy; Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; if (interp && Tcl_GetCommandInfo(interp, "::tk::mac::OpenApplication", &dummy)){ int code = Tcl_GlobalEval(interp, "::tk::mac::OpenApplication"); if (code != TCL_OK) { Tcl_BackgroundError(interp); } } return noErr; }
static int ReallyKillMe( Tcl_Event *eventPtr, int flags) { Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp; Tcl_CmdInfo dummy; int quit = Tcl_GetCommandInfo(interp, "::tk::mac::Quit", &dummy); if (Tcl_GlobalEval(interp, quit ? "::tk::mac::Quit" : "exit") != TCL_OK) { /* * Should be never reached... */ Tcl_BackgroundError(interp); } return 1; }
/* ** Delete all input controls. This happens when the HTML widget ** is cleared. ** ** When the TCL "exit" command is invoked, the order of operations ** here is very touchy. */ void HtmlDeleteControls(HtmlWidget *htmlPtr){ HtmlElement *p; /* For looping over all controls */ Tcl_Interp *interp; /* The interpreter */ interp = htmlPtr->interp; p = htmlPtr->firstInput; htmlPtr->firstInput = 0; htmlPtr->lastInput = 0; htmlPtr->nInput = 0; if( p==0 || htmlPtr->tkwin==0 ) return; HtmlLock(htmlPtr); for(; p; p=p->input.pNext){ if( p->input.pForm && p->input.pForm->form.id>0 && htmlPtr->zFormCommand && htmlPtr->zFormCommand[0] && !Tcl_InterpDeleted(interp) && htmlPtr->clipwin ){ Tcl_DString cmd; int result; char zBuf[60]; Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, htmlPtr->zFormCommand, -1); sprintf(zBuf," %d flush", p->input.pForm->form.id); Tcl_DStringAppend(&cmd, zBuf, -1); result = Tcl_GlobalEval(htmlPtr->interp, Tcl_DStringValue(&cmd)); Tcl_DStringFree(&cmd); if( !Tcl_InterpDeleted(interp) ){ if( result != TCL_OK ){ Tcl_AddErrorInfo(htmlPtr->interp, "\n (-formcommand flush callback executed by html widget)"); Tcl_BackgroundError(htmlPtr->interp); TestPoint(0); } Tcl_ResetResult(htmlPtr->interp); } p->input.pForm->form.id = 0; } if( p->input.tkwin ){ if( htmlPtr->clipwin!=0 ) Tk_DestroyWindow(p->input.tkwin); p->input.tkwin = 0; } p->input.sized = 0; } HtmlUnlock(htmlPtr); }
static OSErr RappHandler( const AppleEvent *event, AppleEvent *reply, long handlerRefcon) { Tcl_CmdInfo dummy; Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; ProcessSerialNumber thePSN = {0, kCurrentProcess}; OSStatus err = ChkErr(SetFrontProcess, &thePSN); if (interp && Tcl_GetCommandInfo(interp, "::tk::mac::ReopenApplication", &dummy)) { if (Tcl_GlobalEval(interp, "::tk::mac::ReopenApplication") != TCL_OK){ Tcl_BackgroundError(interp); } } return err; }
static void IvyMsgCB(IvyClientPtr app, void *user_data, int argc, char **argv) { filter_struct *filter = (filter_struct *) user_data; int result, i, size; char *script_to_call; size = strlen(filter->script) + 3; for (i = 0; i < argc; i++) { size += strlen(argv[i]) + 3; } size ++; size += strlen(IvyGetApplicationName(app))+4; script_to_call = ckalloc(size); strcpy(script_to_call, filter->script); strcat(script_to_call, " \""); strcat(script_to_call, IvyGetApplicationName(app)); strcat(script_to_call, "\""); /* strcat(script_to_call, " {"); */ for (i = 0; i < argc; i++) { strcat(script_to_call, " \""); strcat(script_to_call, argv[i]); strcat(script_to_call, "\""); } /* strcat(script_to_call, " }"); */ Tcl_Preserve(filter->interp); result = Tcl_GlobalEval(filter->interp, script_to_call); ckfree(script_to_call); if (result != TCL_OK) { Tcl_BackgroundError(filter->interp); } Tcl_Release(filter->interp); }
/* ** This is the callback from a quota-over-limit. */ static void tclQuotaCallback( const char *zFilename, /* Name of file whose size increases */ sqlite3_int64 *piLimit, /* IN/OUT: The current limit */ sqlite3_int64 iSize, /* Total size of all files in the group */ void *pArg /* Client data */ ){ TclQuotaCallback *p; /* Callback script object */ Tcl_Obj *pEval; /* Script to evaluate */ Tcl_Obj *pVarname; /* Name of variable to pass as 2nd arg */ unsigned int rnd; /* Random part of pVarname */ int rc; /* Tcl error code */ p = (TclQuotaCallback *)pArg; if( p==0 ) return; pVarname = Tcl_NewStringObj("::piLimit_", -1); Tcl_IncrRefCount(pVarname); sqlite3_randomness(sizeof(rnd), (void *)&rnd); Tcl_AppendObjToObj(pVarname, Tcl_NewIntObj((int)(rnd&0x7FFFFFFF))); Tcl_ObjSetVar2(p->interp, pVarname, 0, Tcl_NewWideIntObj(*piLimit), 0); pEval = Tcl_DuplicateObj(p->pScript); Tcl_IncrRefCount(pEval); Tcl_ListObjAppendElement(0, pEval, Tcl_NewStringObj(zFilename, -1)); Tcl_ListObjAppendElement(0, pEval, pVarname); Tcl_ListObjAppendElement(0, pEval, Tcl_NewWideIntObj(iSize)); rc = Tcl_EvalObjEx(p->interp, pEval, TCL_EVAL_GLOBAL); if( rc==TCL_OK ){ Tcl_Obj *pLimit = Tcl_ObjGetVar2(p->interp, pVarname, 0, 0); rc = Tcl_GetWideIntFromObj(p->interp, pLimit, piLimit); Tcl_UnsetVar(p->interp, Tcl_GetString(pVarname), 0); } Tcl_DecrRefCount(pEval); Tcl_DecrRefCount(pVarname); if( rc!=TCL_OK ) Tcl_BackgroundError(p->interp); }
void test_ota_delta(sqlite3_context *pCtx, int nArg, sqlite3_value **apVal){ Tcl_Interp *interp = (Tcl_Interp*)sqlite3_user_data(pCtx); Tcl_Obj *pScript; int i; pScript = Tcl_NewObj(); Tcl_IncrRefCount(pScript); Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj("ota_delta", -1)); for(i=0; i<nArg; i++){ sqlite3_value *pIn = apVal[i]; const char *z = (const char*)sqlite3_value_text(pIn); Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(z, -1)); } if( TCL_OK==Tcl_EvalObjEx(interp, pScript, TCL_GLOBAL_ONLY) ){ const char *z = Tcl_GetStringResult(interp); sqlite3_result_text(pCtx, z, -1, SQLITE_TRANSIENT); }else{ Tcl_BackgroundError(interp); } Tcl_DecrRefCount(pScript); }
void TkpDisplayScale( ClientData clientData) /* Widget record for scale. */ { TkScale *scalePtr = (TkScale *) clientData; Tk_Window tkwin = scalePtr->tkwin; Tcl_Interp *interp = scalePtr->interp; Pixmap pixmap; int result; char string[PRINT_CHARS]; XRectangle drawnArea; scalePtr->flags &= ~REDRAW_PENDING; if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) { goto done; } /* * Invoke the scale's command if needed. */ Tcl_Preserve((ClientData) scalePtr); if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) { Tcl_Preserve((ClientData) interp); sprintf(string, scalePtr->format, scalePtr->value); result = Tcl_VarEval(interp, scalePtr->command, " ", string, (char *) NULL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (command executed by scale)"); Tcl_BackgroundError(interp); } Tcl_Release((ClientData) interp); } scalePtr->flags &= ~INVOKE_COMMAND; if (scalePtr->flags & SCALE_DELETED) { Tcl_Release((ClientData) scalePtr); return; } Tcl_Release((ClientData) scalePtr); #ifndef TK_NO_DOUBLE_BUFFERING /* * In order to avoid screen flashes, this function redraws the scale in a * pixmap, then copies the pixmap to the screen in a single operation. * This means that there's no point in time where the on-sreen image has * been cleared. */ pixmap = Tk_GetPixmap(scalePtr->display, Tk_WindowId(tkwin), Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin)); #else pixmap = Tk_WindowId(tkwin); #endif /* TK_NO_DOUBLE_BUFFERING */ drawnArea.x = 0; drawnArea.y = 0; drawnArea.width = Tk_Width(tkwin); drawnArea.height = Tk_Height(tkwin); /* * Much of the redisplay is done totally differently for horizontal and * vertical scales. Handle the part that's different. */ if (scalePtr->orient == ORIENT_VERTICAL) { DisplayVerticalScale(scalePtr, pixmap, &drawnArea); } else { DisplayHorizontalScale(scalePtr, pixmap, &drawnArea); } /* * Now handle the part of redisplay that is the same for horizontal and * vertical scales: border and traversal highlight. */ if (scalePtr->flags & REDRAW_OTHER) { if (scalePtr->relief != TK_RELIEF_FLAT) { Tk_Draw3DRectangle(tkwin, pixmap, scalePtr->bgBorder, scalePtr->highlightWidth, scalePtr->highlightWidth, Tk_Width(tkwin) - 2*scalePtr->highlightWidth, Tk_Height(tkwin) - 2*scalePtr->highlightWidth, scalePtr->borderWidth, scalePtr->relief); } if (scalePtr->highlightWidth != 0) { GC gc; if (scalePtr->flags & GOT_FOCUS) { gc = Tk_GCForColor(scalePtr->highlightColorPtr, pixmap); } else { gc = Tk_GCForColor( Tk_3DBorderColor(scalePtr->highlightBorder), pixmap); } Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, pixmap); } } #ifndef TK_NO_DOUBLE_BUFFERING /* * Copy the information from the off-screen pixmap onto the screen, then * delete the pixmap. */ XCopyArea(scalePtr->display, pixmap, Tk_WindowId(tkwin), scalePtr->copyGC, drawnArea.x, drawnArea.y, drawnArea.width, drawnArea.height, drawnArea.x, drawnArea.y); Tk_FreePixmap(scalePtr->display, pixmap); #endif /* TK_NO_DOUBLE_BUFFERING */ done: scalePtr->flags &= ~REDRAW_ALL; }
HRESULT ComObject::invoke (const Method &method, bool isProperty, REFIID /*riid*/, LCID /*lcid*/, WORD wFlags, DISPPARAMS *pDispParams, VARIANT *pReturnValue, EXCEPINFO *pExcepInfo, UINT *pArgErr) { HRESULT hresult; try { // Construct Tcl script to invoke operation on the servant. TclObject script(m_servant); // Get the method or property to invoke on the servant. std::string operation; if ((wFlags & DISPATCH_PROPERTYGET) != 0 && isProperty) { operation = getPrefix + method.name(); } else if (wFlags & (DISPATCH_PROPERTYPUT | DISPATCH_PROPERTYPUTREF)) { operation = setPrefix + method.name(); } else if (wFlags & DISPATCH_METHOD) { operation = method.name(); } else { return DISP_E_MEMBERNOTFOUND; } script.lappend( Tcl_NewStringObj(const_cast<char *>(operation.c_str()), -1)); // Set the argument error pointer in case we need to use it. UINT argErr; if (pArgErr == 0) { pArgErr = &argErr; } // Convert arguments to Tcl values. // TODO: Should handle named arguments differently than positional // arguments. const Method::Parameters ¶meters = method.parameters(); int argIndex = pDispParams->cArgs - 1; Method::Parameters::const_iterator pParam; for (pParam = parameters.begin(); pParam != parameters.end(); ++pParam, --argIndex) { // Append argument value. VARIANT *pArg = &(pDispParams->rgvarg[argIndex]); try { script.lappend(getArgument(pArg, *pParam)); } catch (_com_error &) { *pArgErr = argIndex; throw; } } if (wFlags & (DISPATCH_PROPERTYPUT | DISPATCH_PROPERTYPUTREF)) { VARIANT *pArg = &(pDispParams->rgvarg[argIndex]); try { TclObject value(pArg, method.type(), m_interp); script.lappend(value); } catch (_com_error &) { *pArgErr = argIndex; throw; } } // Execute the Tcl script. TclObject result; int completionCode = eval(script, &result); if (completionCode == TCL_OK) { hresult = S_OK; } else { if (m_isSink) { Tcl_BackgroundError(m_interp); } hresult = hresultFromErrorCode(); if (FAILED(hresult)) { fillExcepInfo( pExcepInfo, hresult, m_servant.c_str(), result.c_str()); hresult = DISP_E_EXCEPTION; } } // Copy values to out arguments. argIndex = pDispParams->cArgs - 1; for (pParam = parameters.begin(); pParam != parameters.end(); ++pParam, --argIndex) { VARIANT *pArg = &(pDispParams->rgvarg[argIndex]); if ((pParam->flags() & PARAMFLAG_FOUT) && (V_VT(pArg) & VT_BYREF)) { // Get name of Tcl variable that holds out value. TclObject varName = getOutVariableName(*pParam); // Copy variable value to out argument. TclObject value; if (getVariable(varName, value) == TCL_OK) { putOutVariant(m_interp, pArg, value, pParam->type()); } } } // Convert return value. if (pReturnValue != 0 && method.type().vartype() != VT_VOID) { // Must increment reference count of interface pointers returned // from methods. result.toVariant(pReturnValue, method.type(), m_interp, true); } } catch (_com_error &e) { fillExcepInfo(pExcepInfo, e.Error(), m_servant.c_str(), 0); hresult = DISP_E_EXCEPTION; } return hresult; }
/*ARGSUSED*/ static int EmbWinLayoutProc( TkText *textPtr, /* Text widget being layed out. */ TkTextIndex *indexPtr, /* Identifies first character in chunk. */ TkTextSegment *ewPtr, /* Segment corresponding to indexPtr. */ int offset, /* Offset within segPtr corresponding to * indexPtr (always 0). */ int maxX, /* Chunk must not occupy pixels at this * position or higher. */ int maxChars, /* Chunk must not include more than this many * characters. */ int noCharsYet, /* Non-zero means no characters have been * assigned to this line yet. */ TkWrapMode wrapMode, /* Wrap mode to use for line: * TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_NONE, or * TEXT_WRAPMODE_WORD. */ register TkTextDispChunk *chunkPtr) /* Structure to fill in with information about * this chunk. The x field has already been * set by the caller. */ { int width, height; TkTextEmbWindowClient *client; if (offset != 0) { Tcl_Panic("Non-zero offset in EmbWinLayoutProc"); } client = EmbWinGetClient(textPtr, ewPtr); if (client == NULL) { ewPtr->body.ew.tkwin = NULL; } else { ewPtr->body.ew.tkwin = client->tkwin; } if ((ewPtr->body.ew.tkwin == NULL) && (ewPtr->body.ew.create != NULL)) { int code, isNew; Tk_Window ancestor; Tcl_HashEntry *hPtr; const char *before, *string; Tcl_DString name, buf, *dsPtr = NULL; before = ewPtr->body.ew.create; /* * Find everything up to the next % character and append it to the * result string. */ string = before; while (*string != 0) { if ((*string == '%') && (string[1] == '%' || string[1] == 'W')) { if (dsPtr == NULL) { Tcl_DStringInit(&buf); dsPtr = &buf; } if (string != before) { Tcl_DStringAppend(dsPtr, before, (int) (string-before)); before = string; } if (string[1] == '%') { Tcl_DStringAppend(dsPtr, "%", 1); } else { /* * Substitute string as proper Tcl list element. */ int spaceNeeded, cvtFlags, length; const char *str = Tk_PathName(textPtr->tkwin); spaceNeeded = Tcl_ScanElement(str, &cvtFlags); length = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, length + spaceNeeded); spaceNeeded = Tcl_ConvertElement(str, Tcl_DStringValue(dsPtr) + length, cvtFlags | TCL_DONT_USE_BRACES); Tcl_DStringSetLength(dsPtr, length + spaceNeeded); } before += 2; string++; } string++; } /* * The window doesn't currently exist. Create it by evaluating the * creation script. The script must return the window's path name: * look up that name to get back to the window token. Then register * ourselves as the geometry manager for the window. */ if (dsPtr != NULL) { Tcl_DStringAppend(dsPtr, before, (int) (string-before)); code = Tcl_GlobalEval(textPtr->interp, Tcl_DStringValue(dsPtr)); Tcl_DStringFree(dsPtr); } else { code = Tcl_GlobalEval(textPtr->interp, ewPtr->body.ew.create); } if (code != TCL_OK) { createError: Tcl_BackgroundException(textPtr->interp, code); goto gotWindow; } Tcl_DStringInit(&name); Tcl_DStringAppend(&name, Tcl_GetStringResult(textPtr->interp), -1); Tcl_ResetResult(textPtr->interp); ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp, Tcl_DStringValue(&name), textPtr->tkwin); Tcl_DStringFree(&name); if (ewPtr->body.ew.tkwin == NULL) { goto createError; } for (ancestor = textPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) { if (ancestor == Tk_Parent(ewPtr->body.ew.tkwin)) { break; } if (Tk_TopWinHierarchy(ancestor)) { badMaster: Tcl_AppendResult(textPtr->interp, "can't embed ", Tk_PathName(ewPtr->body.ew.tkwin), " relative to ", Tk_PathName(textPtr->tkwin), NULL); Tcl_BackgroundError(textPtr->interp); ewPtr->body.ew.tkwin = NULL; goto gotWindow; } } if (Tk_TopWinHierarchy(ewPtr->body.ew.tkwin) || (textPtr->tkwin == ewPtr->body.ew.tkwin)) { goto badMaster; } if (client == NULL) { /* * We just used a '-create' script to make a new window, which we * now need to add to our client list. */ client = (TkTextEmbWindowClient *) ckalloc(sizeof(TkTextEmbWindowClient)); client->next = ewPtr->body.ew.clients; client->textPtr = textPtr; client->tkwin = NULL; client->chunkCount = 0; client->displayed = 0; client->parent = ewPtr; ewPtr->body.ew.clients = client; } client->tkwin = ewPtr->body.ew.tkwin; Tk_ManageGeometry(client->tkwin, &textGeomType, client); Tk_CreateEventHandler(client->tkwin, StructureNotifyMask, EmbWinStructureProc, client); /* * Special trick! Must enter into the hash table *after* calling * Tk_ManageGeometry: if the window was already managed elsewhere in * this text, the Tk_ManageGeometry call will cause the entry to be * removed, which could potentially lose the new entry. */ hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->windowTable, Tk_PathName(client->tkwin), &isNew); Tcl_SetHashValue(hPtr, ewPtr); } /* * See if there's room for this window on this line. */ gotWindow: if (ewPtr->body.ew.tkwin == NULL) { width = 0; height = 0; } else { width = Tk_ReqWidth(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padX; height = Tk_ReqHeight(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padY; } if ((width > (maxX - chunkPtr->x)) && !noCharsYet && (textPtr->wrapMode != TEXT_WRAPMODE_NONE)) { return 0; } /* * Fill in the chunk structure. */ chunkPtr->displayProc = TkTextEmbWinDisplayProc; chunkPtr->undisplayProc = EmbWinUndisplayProc; chunkPtr->measureProc = NULL; chunkPtr->bboxProc = EmbWinBboxProc; chunkPtr->numBytes = 1; if (ewPtr->body.ew.align == ALIGN_BASELINE) { chunkPtr->minAscent = height - ewPtr->body.ew.padY; chunkPtr->minDescent = ewPtr->body.ew.padY; chunkPtr->minHeight = 0; } else { chunkPtr->minAscent = 0; chunkPtr->minDescent = 0; chunkPtr->minHeight = height; } chunkPtr->width = width; chunkPtr->breakIndex = -1; chunkPtr->breakIndex = 1; chunkPtr->clientData = ewPtr; if (client != NULL) { client->chunkCount += 1; } return 1; }
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); }
static int Pg_Notify_EventProc(Tcl_Event *evPtr, int flags) { NotifyEvent *event = (NotifyEvent *) evPtr; Pg_TclNotifies *notifies; char *callback; char *svcallback; /* We classify SQL notifies as Tcl file events. */ if (!(flags & TCL_FILE_EVENTS)) return 0; /* If connection's been closed, just forget the whole thing. */ if (event->connid == NULL) { if (event->notify) PQfreemem(event->notify); return 1; } /* * Preserve/Release to ensure the connection struct doesn't disappear * underneath us. */ Tcl_Preserve((ClientData) event->connid); /* * Loop for each interpreter that has ever registered on the * connection. Each one can get a callback. */ for (notifies = event->connid->notify_list; notifies != NULL; notifies = notifies->next) { Tcl_Interp *interp = notifies->interp; if (interp == NULL) continue; /* ignore deleted interpreter */ /* * Find the callback to be executed for this interpreter, if any. */ if (event->notify) { /* Ordinary NOTIFY event */ Tcl_HashEntry *entry; entry = Tcl_FindHashEntry(¬ifies->notify_hash, event->notify->relname); if (entry == NULL) continue; /* no pg_listen in this interpreter */ callback = (char *) Tcl_GetHashValue(entry); } else { /* Connection-loss event */ callback = notifies->conn_loss_cmd; } if (callback == NULL) continue; /* nothing to do for this interpreter */ /* * We have to copy the callback string in case the user executes a * new pg_listen or pg_on_connection_loss during the callback. */ svcallback = (char *) ckalloc((unsigned) (strlen(callback) + 1)); strcpy(svcallback, callback); /* * Execute the callback. */ Tcl_Preserve((ClientData) interp); if (Tcl_GlobalEval(interp, svcallback) != TCL_OK) { if (event->notify) Tcl_AddErrorInfo(interp, "\n (\"pg_listen\" script)"); else Tcl_AddErrorInfo(interp, "\n (\"pg_on_connection_loss\" script)"); Tcl_BackgroundError(interp); } Tcl_Release((ClientData) interp); ckfree(svcallback); /* * Check for the possibility that the callback closed the * connection. */ if (event->connid->conn == NULL) break; } Tcl_Release((ClientData) event->connid); if (event->notify) PQfreemem(event->notify); return 1; }
/*----------------------------------------------------------------------------- * ProcessSignals -- * * Called by the async handler to process pending signals in a safe state * interpreter state. This is often called just after a command completes. * The results of the command are passed to this procedure and may be altered * by it. If trap code is specified for the signal that was received, then * the trap will be executed, otherwise an error result will be returned * indicating that the signal occured. If an error is returned, clear the * errorInfo variable. This makes sure it exists and that it is empty, * otherwise bogus or non-existant information will be returned if this * routine was called somewhere besides Tcl_Eval. If a signal was received * multiple times and a trap is set on it, then that trap will be executed for * each time the signal was received. * * Parameters: * o clientData - Not used. * o interp (I/O) - interp result should contain the result for * the command that just executed. This will either be restored or * replaced with a new result. If this is NULL, then no interpreter * is directly available (i.e. event loop). In this case, the first * interpreter in internal interpreter table is used. If an error results * from signal processing, it is handled via Tcl_BackgroundError. * o cmdResultCode - The integer result returned by the command that * Tcl_Eval just completed. Should be TCL_OK if not called from * Tcl_Eval. * Returns: * Either the original result code, an error result if one of the * trap commands returned an error, or an error indicating the * a signal occured. *----------------------------------------------------------------------------- */ static int ProcessSignals (ClientData clientData, Tcl_Interp *interp, int cmdResultCode) { Tcl_Interp *sigInterp; Tcl_Obj *errStateObjPtr; int signalNum, result; /* * Get the interpreter if it wasn't supplied, if none is available, * bail out. */ if (interp == NULL) { if (numInterps == 0) return cmdResultCode; sigInterp = interpTable [0]; } else { sigInterp = interp; } errStateObjPtr = TclX_SaveResultErrorInfo (sigInterp); /* * Process all signals. Don't process any more if one returns an error. */ result = TCL_OK; for (signalNum = 1; signalNum < MAXSIG; signalNum++) { if (signalsReceived [signalNum] == 0) continue; result = ProcessASignal (sigInterp, (interp == NULL), signalNum); if (result == TCL_ERROR) break; } /* * Restore result and error state if we didn't get an error in signal * handling. */ if (result != TCL_ERROR) { TclX_RestoreResultErrorInfo (sigInterp, errStateObjPtr) ; } else { Tcl_DecrRefCount (errStateObjPtr); cmdResultCode = TCL_ERROR; } /* * Reset the signal received flag in case more signals are pending. */ for (signalNum = 1; signalNum < MAXSIG; signalNum++) { if (signalsReceived [signalNum] != 0) break; } if (signalNum < MAXSIG) { if (asyncHandler) Tcl_AsyncMark (asyncHandler); } /* * If a signal handler returned an error and an interpreter was not * supplied, call the background error handler. */ if ((result == TCL_ERROR) && (interp == NULL)) { Tcl_BackgroundError (sigInterp); } return cmdResultCode; }
static OSErr PrintHandler( const AppleEvent * event, AppleEvent * reply, long handlerRefcon) { Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon; AEDescList fileSpecList; FSRef file; DescType type; Size actual; long count, index; AEKeyword keyword; Tcl_DString command, pathName; Tcl_CmdInfo dummy; /* * Don't bother if we don't have an interp or the print document procedure * doesn't exist. */ if (!interp || !Tcl_GetCommandInfo(interp, "::tk::mac::PrintDocument", &dummy)) { return noErr; } /* * If we get any errors while retrieving our parameters we just return with * no error. */ if (ChkErr(AEGetParamDesc, event, keyDirectObject, typeAEList, &fileSpecList) != noErr) { return noErr; } if (ChkErr(MissedAnyParameters, event) != noErr) { return noErr; } if (ChkErr(AECountItems, &fileSpecList, &count) != noErr) { return noErr; } Tcl_DStringInit(&command); Tcl_DStringAppend(&command, "::tk::mac::PrintDocument", -1); for (index = 1; index <= count; index++) { if (ChkErr(AEGetNthPtr, &fileSpecList, index, typeFSRef, &keyword, &type, (Ptr) &file, sizeof(FSRef), &actual) != noErr) { continue; } if (ChkErr(FSRefToDString, &file, &pathName) == noErr) { Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName)); Tcl_DStringFree(&pathName); } } /* * Now handle the event by evaluating a script. */ if (Tcl_EvalEx(interp, Tcl_DStringValue(&command), Tcl_DStringLength(&command), TCL_EVAL_GLOBAL) != TCL_OK) { Tcl_BackgroundError(interp); } Tcl_DStringFree(&command); return noErr; }
int TnmSnmpEvalCallback(Tcl_Interp *interp, TnmSnmp *session, TnmSnmpPdu *pdu, char *cmd, char *instance, char *oid, char *value, char *last) { char buf[20]; int code; Tcl_DString tclCmd; char *startPtr, *scanPtr, *name; Tcl_DStringInit(&tclCmd); startPtr = cmd; for (scanPtr = startPtr; *scanPtr != '\0'; scanPtr++) { if (*scanPtr != '%') { continue; } Tcl_DStringAppend(&tclCmd, startPtr, scanPtr - startPtr); scanPtr++; startPtr = scanPtr + 1; switch (*scanPtr) { case 'R': sprintf(buf, "%d", pdu->requestId); Tcl_DStringAppend(&tclCmd, buf, -1); break; case 'S': if (session && session->interp && session->token) { Tcl_DStringAppend(&tclCmd, Tcl_GetCommandName(session->interp, session->token), -1); } break; case 'V': Tcl_DStringAppend(&tclCmd, Tcl_DStringValue(&pdu->varbind), -1); break; case 'E': name = TnmGetTableValue(tnmSnmpErrorTable, (unsigned) pdu->errorStatus); if (name == NULL) { name = "unknown"; } Tcl_DStringAppend(&tclCmd, name, -1); break; case 'I': sprintf(buf, "%d", pdu->errorIndex - 1); Tcl_DStringAppend(&tclCmd, buf, -1); break; case 'A': Tcl_DStringAppend(&tclCmd, inet_ntoa(pdu->addr.sin_addr), -1); break; case 'P': sprintf(buf, "%u", ntohs((unsigned short) pdu->addr.sin_port)); Tcl_DStringAppend(&tclCmd, buf, -1); break; #ifdef TNM_SNMPv3 case 'C': if (pdu->context && pdu->contextLength) { Tcl_DStringAppend(&tclCmd, pdu->context, pdu->contextLength); } break; case 'G': if (pdu->engineID && pdu->engineIDLength) { Tcl_DStringAppend(&tclCmd, pdu->engineID, pdu->engineIDLength); } break; #endif case 'T': name = TnmGetTableValue(tnmSnmpPDUTable, (unsigned) pdu->type); if (name == NULL) { name = "unknown"; } Tcl_DStringAppend(&tclCmd, name, -1); break; case 'o': if (instance) { Tcl_DStringAppend(&tclCmd, instance, -1); } break; case 'i': if (oid) { Tcl_DStringAppend(&tclCmd, oid, -1); } break; case 'v': if (value) { Tcl_DStringAppend(&tclCmd, value, -1); } break; case 'p': if (last) { Tcl_DStringAppend(&tclCmd, last, -1); } break; case '%': Tcl_DStringAppend(&tclCmd, "%", -1); break; default: sprintf(buf, "%%%c", *scanPtr); Tcl_DStringAppend(&tclCmd, buf, -1); } } Tcl_DStringAppend(&tclCmd, startPtr, scanPtr - startPtr); /* * Now evaluate the callback function and issue a background * error if the callback fails for some reason. Return the * original error message and code to the caller. */ Tcl_AllowExceptions(interp); code = Tcl_GlobalEval(interp, Tcl_DStringValue(&tclCmd)); Tcl_DStringFree(&tclCmd); /* * Call the usual error handling proc if we have evaluated * a binding not bound to a specific instance. Bindings * bound to an instance are usually called during PDU * processing where it is important to get the error message * back. */ if (code == TCL_ERROR && oid == NULL) { char *errorMsg = ckstrdup(Tcl_GetStringResult(interp)); Tcl_AddErrorInfo(interp, "\n (snmp callback)"); Tcl_BackgroundError(interp); Tcl_SetResult(interp, errorMsg, TCL_DYNAMIC); } return code; }
/* *--------------------------------------------------------------------------- * * HtmlImageServerGet -- * * Retrieve an HtmlImage2 object for the image at URL zUrl from * an image-server. The caller should match this call with a single * HtmlImageFree() when the image object is no longer required. * * If the image is not already in the cache, the Tcl script * configured as the widget -imagecmd is invoked. If this command * raises an error or returns an invalid result, then this function * returns NULL. A Tcl back-ground error is propagated in this case * also. * * Results: * Pointer to HtmlImage2 object containing the image from zUrl, or * NULL, if zUrl was invalid for some reason. * * Side effects: * May invoke -imagecmd script. * *--------------------------------------------------------------------------- */ HtmlImage2 * HtmlImageServerGet (HtmlImageServer *p, const char *zUrl) { Tcl_Obj *pImageCmd = p->pTree->options.imagecmd; Tcl_Interp *interp = p->pTree->interp; Tcl_HashEntry *pEntry = 0; HtmlImage2 *pImage = 0; /* Try to find the requested image in the hash table. */ if (pImageCmd) { int new_entry; pEntry = Tcl_CreateHashEntry(&p->aImage, zUrl, &new_entry); if (new_entry) { Tcl_Obj *pEval; Tcl_Obj *pResult; int rc; int nObj; Tcl_Obj **apObj = 0; Tk_Image img; /* The image could not be found in the hash table and an * -imagecmd callback is configured. The callback script * must be executed to obtain an image. Build up a script * in pEval and execute it. Put the result in variable pResult. */ pEval = Tcl_DuplicateObj(pImageCmd); Tcl_IncrRefCount(pEval); Tcl_ListObjAppendElement(interp, pEval, Tcl_NewStringObj(zUrl, -1)); rc = Tcl_EvalObjEx(interp, pEval, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL); Tcl_DecrRefCount(pEval); if (rc != TCL_OK) { goto image_get_out; } pResult = Tcl_GetObjResult(interp); /* Read the result into array apObj. If the result was * not a valid Tcl list, return NULL and raise a background * error about the badly formed list. */ rc = Tcl_ListObjGetElements(interp, pResult, &nObj, &apObj); if (rc != TCL_OK) { goto image_get_out; } if (nObj==0) { Tcl_DeleteHashEntry(pEntry); goto image_unavailable; } pImage = HtmlNew(HtmlImage2); if (nObj == 1 || nObj == 2) { img = Tk_GetImage( interp, p->pTree->tkwin, Tcl_GetString(apObj[0]), imageChanged, pImage ); } if ((nObj != 1 && nObj != 2) || !img) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "-imagecmd returned bad value", 0); HtmlFree(pImage); pImage = 0; goto image_get_out; } Tcl_SetHashValue(pEntry, (ClientData)pImage); Tcl_IncrRefCount(apObj[0]); pImage->pImageName = apObj[0]; if (nObj == 2) { Tcl_IncrRefCount(apObj[1]); pImage->pDelete = apObj[1]; } pImage->pImageServer = p; pImage->zUrl = Tcl_GetHashKey(&p->aImage, pEntry); pImage->image = img; Tk_SizeOfImage(pImage->image, &pImage->width, &pImage->height); pImage->isValid = 1; HtmlImagePixmap(pImage); } } image_get_out: pImage = (HtmlImage2 *)(pEntry ? Tcl_GetHashValue(pEntry) : 0); HtmlImageRef(pImage); if (!pImage && pImageCmd) { Tcl_BackgroundError(interp); Tcl_ResetResult(interp); assert(pEntry); Tcl_DeleteHashEntry(pEntry); } image_unavailable: return pImage; }
void TkpDisplayScale( ClientData clientData) /* Widget record for scale. */ { TkScale *scalePtr = (TkScale *) clientData; Tk_Window tkwin = scalePtr->tkwin; Tcl_Interp *interp = scalePtr->interp; int result; char string[TCL_DOUBLE_SPACE]; MacScale *macScalePtr = (MacScale *) clientData; Rect r; WindowRef windowRef; CGrafPtr destPort, savePort; Boolean portChanged; MacDrawable *macDraw; SInt32 initialValue, minValue, maxValue; UInt16 numTicks; #ifdef TK_MAC_DEBUG_SCALE TkMacOSXDbgMsg("TkpDisplayScale"); #endif scalePtr->flags &= ~REDRAW_PENDING; if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) { goto done; } /* * Invoke the scale's command if needed. */ Tcl_Preserve((ClientData) scalePtr); if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) { Tcl_Preserve((ClientData) interp); sprintf(string, scalePtr->format, scalePtr->value); result = Tcl_VarEval(interp, scalePtr->command, " ", string, NULL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (command executed by scale)"); Tcl_BackgroundError(interp); } Tcl_Release((ClientData) interp); } scalePtr->flags &= ~INVOKE_COMMAND; if (scalePtr->flags & SCALE_DELETED) { Tcl_Release((ClientData) scalePtr); return; } Tcl_Release((ClientData) scalePtr); /* * Now handle the part of redisplay that is the same for * horizontal and vertical scales: border and traversal * highlight. */ if (scalePtr->highlightWidth != 0) { GC gc = Tk_GCForColor(scalePtr->highlightColorPtr, Tk_WindowId(tkwin)); Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, Tk_WindowId(tkwin)); } Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), scalePtr->bgBorder, scalePtr->highlightWidth, scalePtr->highlightWidth, Tk_Width(tkwin) - 2*scalePtr->highlightWidth, Tk_Height(tkwin) - 2*scalePtr->highlightWidth, scalePtr->borderWidth, scalePtr->relief); /* * Set up port for drawing Macintosh control. */ macDraw = (MacDrawable *) Tk_WindowId(tkwin); destPort = TkMacOSXGetDrawablePort(Tk_WindowId(tkwin)); windowRef = TkMacOSXDrawableWindow(Tk_WindowId(tkwin)); portChanged = QDSwapPort(destPort, &savePort); TkMacOSXSetUpClippingRgn(Tk_WindowId(tkwin)); /* * Create Macintosh control. */ #define MAC_OSX_SCROLL_WIDTH 10 if (scalePtr->orient == ORIENT_HORIZONTAL) { int offset = (Tk_Height(tkwin) - MAC_OSX_SCROLL_WIDTH)/2; if (offset < 0) { offset = 0; } r.left = macDraw->xOff + scalePtr->inset; r.top = macDraw->yOff + offset; r.right = macDraw->xOff+Tk_Width(tkwin) - scalePtr->inset; r.bottom = macDraw->yOff + offset + MAC_OSX_SCROLL_WIDTH/2; } else { int offset = (Tk_Width(tkwin) - MAC_OSX_SCROLL_WIDTH)/2; if (offset < 0) { offset = 0; } r.left = macDraw->xOff + offset; r.top = macDraw->yOff + scalePtr->inset; r.right = macDraw->xOff + offset + MAC_OSX_SCROLL_WIDTH/2; r.bottom = macDraw->yOff+Tk_Height(tkwin) - scalePtr->inset; } if (macScalePtr->scaleHandle == NULL) { #ifdef TK_MAC_DEBUG_SCALE TkMacOSXDbgMsg("Initialising scale"); #endif initialValue = scalePtr->value; if (scalePtr->orient == ORIENT_HORIZONTAL) { minValue = scalePtr->fromValue; maxValue = scalePtr->toValue; } else { minValue = scalePtr->fromValue; maxValue = scalePtr->toValue; } if (scalePtr->tickInterval == 0) { numTicks = 0; } else { numTicks = (maxValue - minValue)/scalePtr->tickInterval; } CreateSliderControl(windowRef, &r, initialValue, minValue, maxValue, kControlSliderPointsDownOrRight, numTicks, 1, scaleActionProc, &(macScalePtr->scaleHandle)); SetControlReference(macScalePtr->scaleHandle, (UInt32) scalePtr); if (IsWindowActive(windowRef)) { macScalePtr->flags |= ACTIVE; } } else { SetControlBounds(macScalePtr->scaleHandle, &r); SetControl32BitValue(macScalePtr->scaleHandle, scalePtr->value); SetControl32BitMinimum(macScalePtr->scaleHandle, scalePtr->fromValue); SetControl32BitMaximum(macScalePtr->scaleHandle, scalePtr->toValue); } /* * Finally draw the control. */ SetControlVisibility(macScalePtr->scaleHandle,true,true); HiliteControl(macScalePtr->scaleHandle,0); Draw1Control(macScalePtr->scaleHandle); if (portChanged) { QDSwapPort(savePort, NULL); } done: scalePtr->flags &= ~REDRAW_ALL; }