static int InitCmds(Tcl_Interp *interp, int safe) { CmdInfo *cmdInfoPtr; Tcl_CmdInfo info; for (cmdInfoPtr = tnmCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { /* * Due to some Tcl limitations, we need to remove the Tnm * namespace qualifier if we register the commands in a * safe Tcl interpreter (since we can only hide commands * in the global namespace). This is truely ugly - but Tcl * forces me to do this. */ char *cmdName = cmdInfoPtr->name; if (safe && ! cmdInfoPtr->isSafe) { char *newName = strstr(cmdName, "::"); while (newName) { cmdName = newName + 2; newName = strstr(cmdName, "::"); } } /* * Check if the command already exists and return an error * to ensure we detect name clashes while loading the Tnm * extension. */ if (Tcl_GetCommandInfo(interp, cmdName, &info)) { Tcl_AppendResult(interp, "command \"", cmdName, "\" already exists", (char *) NULL); return TCL_ERROR; } if (cmdInfoPtr->objProc) { Tcl_CreateObjCommand(interp, cmdName, cmdInfoPtr->objProc, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); } /* * Hide all unsafe commands from the interpreter * if it is a safe Tcl interpreter. */ if (safe && ! cmdInfoPtr->isSafe) { if (Tcl_HideCommand(interp, cmdName, cmdName) != TCL_OK) { return TCL_ERROR; } } } return TCL_OK; }
char * Tk_SetAppName( Tk_Window tkwin, /* Token for any window in the application * to be named: it is just used to identify * the application and the display. */ char *name) /* The name that will be used to * refer to the interpreter in later * "send" commands. Must be globally * unique. */ { TkWindow *winPtr = (TkWindow *) tkwin; Tcl_Interp *interp = winPtr->mainPtr->interp; int i, suffix, offset, result; int createCommand = 0; RegisteredInterp *riPtr, *prevPtr; char *actualName; Tcl_DString dString; Tcl_Obj *resultObjPtr, *interpNamePtr; char *interpName; if (!initialized) { SendInit(interp); } /* * See if the application is already registered; if so, remove its * current name from the registry. The deletion of the command * will take care of disposing of this entry. */ for (riPtr = interpListPtr, prevPtr = NULL; riPtr != NULL; prevPtr = riPtr, riPtr = riPtr->nextPtr) { if (riPtr->interp == interp) { if (prevPtr == NULL) { interpListPtr = interpListPtr->nextPtr; } else { prevPtr->nextPtr = riPtr->nextPtr; } break; } } /* * Pick a name to use for the application. Use "name" if it's not * already in use. Otherwise add a suffix such as " #2", trying * larger and larger numbers until we eventually find one that is * unique. */ actualName = name; suffix = 1; offset = 0; Tcl_DStringInit(&dString); TkGetInterpNames(interp, tkwin); resultObjPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultObjPtr); for (i = 0; ; ) { result = Tcl_ListObjIndex(NULL, resultObjPtr, i, &interpNamePtr); if (interpNamePtr == NULL) { break; } interpName = Tcl_GetStringFromObj(interpNamePtr, NULL); if (strcmp(actualName, interpName) == 0) { if (suffix == 1) { Tcl_DStringAppend(&dString, name, -1); Tcl_DStringAppend(&dString, " #", 2); offset = Tcl_DStringLength(&dString); Tcl_DStringSetLength(&dString, offset + 10); actualName = Tcl_DStringValue(&dString); } suffix++; sprintf(actualName + offset, "%d", suffix); i = 0; } else { i++; } } Tcl_DecrRefCount(resultObjPtr); Tcl_ResetResult(interp); /* * We have found a unique name. Now add it to the registry. */ riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); riPtr->interp = interp; riPtr->name = ckalloc(strlen(actualName) + 1); riPtr->nextPtr = interpListPtr; interpListPtr = riPtr; strcpy(riPtr->name, actualName); Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd, (ClientData) riPtr, NULL /* TODO: DeleteProc */); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "send", "send"); } Tcl_DStringFree(&dString); return riPtr->name; }
const char * Tk_SetAppName( Tk_Window tkwin, /* Token for any window in the application to * be named: it is just used to identify the * application and the display. */ const char *name) /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ { #ifndef TK_SEND_ENABLED_ON_WINDOWS /* * Temporarily disabled for bug #858822 */ return name; #else /* TK_SEND_ENABLED_ON_WINDOWS */ ThreadSpecificData *tsdPtr = NULL; TkWindow *winPtr = (TkWindow *) tkwin; RegisteredInterp *riPtr = NULL; Tcl_Interp *interp; HRESULT hr = S_OK; interp = winPtr->mainPtr->interp; tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Initialise the COM library for this interpreter just once. */ if (tsdPtr->initialized == 0) { hr = CoInitialize(0); if (FAILED(hr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "failed to initialize the COM library", -1)); Tcl_SetErrorCode(interp, "TK", "SEND", "COM", NULL); return ""; } tsdPtr->initialized = 1; TRACE("Initialized COM library for interp 0x%08X\n", (long)interp); } /* * If the interp hasn't been registered before then we need to create the * registration structure and the COM object. If it has been registered * already then we can reuse all and just register the new name. */ riPtr = Tcl_GetAssocData(interp, "tkWinSend::ri", NULL); if (riPtr == NULL) { LPUNKNOWN *objPtr; riPtr = ckalloc(sizeof(RegisteredInterp)); memset(riPtr, 0, sizeof(RegisteredInterp)); riPtr->interp = interp; objPtr = &riPtr->obj; hr = TkWinSendCom_CreateInstance(interp, &IID_IUnknown, (void **) objPtr); Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd, riPtr, CmdDeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "send", "send"); } Tcl_SetAssocData(interp, "tkWinSend::ri", NULL, riPtr); } else { RevokeObjectRegistration(riPtr); } RegisterInterp(name, riPtr); return (const char *) riPtr->name; #endif /* TK_SEND_ENABLED_ON_WINDOWS */ }