InternalRep::~InternalRep ()
{
HandleNameToRepMap::erase(m_pNameEntry);
if (!Tcl_InterpDeleted(m_interp)) {
Tcl_DeleteCommandFromToken(m_interp, m_command);
}
}
int
TclOO_Object_Destroy(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
CallContext *contextPtr;
if (objc != Tcl_ObjectContextSkippedArgs(context)) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
NULL);
return TCL_ERROR;
}
if (!(oPtr->flags & DESTRUCTOR_CALLED)) {
oPtr->flags |= DESTRUCTOR_CALLED;
contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
if (contextPtr != NULL) {
contextPtr->callPtr->flags |= DESTRUCTOR;
contextPtr->skip = 0;
TclNRAddCallback(interp, AfterNRDestructor, contextPtr,
NULL, NULL, NULL);
TclPushTailcallPoint(interp);
return TclOOInvokeContext(contextPtr, interp, 0, NULL);
}
}
if (oPtr->command) {
Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
return TCL_OK;
}
EXTERN int
Pkgua_Unload(
Tcl_Interp *interp, /* Interpreter from which the package is to be
* unloaded. */
int flags) /* Flags passed by the unloading mechanism */
{
int code, cmdIndex;
Tcl_Command *cmdTokens = PkguaInterpToTokens(interp);
for (cmdIndex=0 ; cmdIndex<MAX_REGISTERED_COMMANDS ; cmdIndex++) {
if (cmdTokens[cmdIndex] == NULL) {
continue;
}
code = Tcl_DeleteCommandFromToken(interp, cmdTokens[cmdIndex]);
if (code != TCL_OK) {
return code;
}
}
PkguaDeleteTokens(interp);
Tcl_SetVar(interp, "::pkgua_detached", ".", TCL_APPEND_VALUE);
if (flags == TCL_UNLOAD_DETACH_FROM_PROCESS) {
/*
* Tcl is ready to detach this library from the running application.
* We should free all the memory that is not related to any
* interpreter.
*/
PkguaFreeTokensHashTable();
Tcl_SetVar(interp, "::pkgua_unloaded", ".", TCL_APPEND_VALUE);
}
return TCL_OK;
}
static int
AfterNRDestructor(
ClientData data[],
Tcl_Interp *interp,
int result)
{
CallContext *contextPtr = data[0];
if (contextPtr->oPtr->command) {
Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command);
}
TclOODeleteContext(contextPtr);
return result;
}
static void
NodeDeleteProc(TnmMapItem *itemPtr)
{
int i;
repeat:
for (i = 0; i < TnmVectorSize(&itemPtr->memberItems); i++) {
TnmMapItem *iPtr;
ClientData *elementPtr = TnmVectorElements(&itemPtr->memberItems);
iPtr = (TnmMapItem *) elementPtr[0];
if (iPtr && iPtr->mapPtr && iPtr->mapPtr->interp) {
Tcl_DeleteCommandFromToken(iPtr->mapPtr->interp, iPtr->token);
goto repeat;
}
}
}
static void
DestroyMenuButton(
char *memPtr) /* Info about button widget. */
{
register TkMenuButton *mbPtr = (TkMenuButton *) memPtr;
TkpDestroyMenuButton(mbPtr);
if (mbPtr->flags & REDRAW_PENDING) {
Tcl_CancelIdleCall(TkpDisplayMenuButton, mbPtr);
}
/*
* Free up all the stuff that requires special handling, then let
* Tk_FreeOptions handle all the standard option-related stuff.
*/
Tcl_DeleteCommandFromToken(mbPtr->interp, mbPtr->widgetCmd);
if (mbPtr->textVarName != NULL) {
Tcl_UntraceVar(mbPtr->interp, mbPtr->textVarName,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
MenuButtonTextVarProc, mbPtr);
}
if (mbPtr->image != NULL) {
Tk_FreeImage(mbPtr->image);
}
if (mbPtr->normalTextGC != None) {
Tk_FreeGC(mbPtr->display, mbPtr->normalTextGC);
}
if (mbPtr->activeTextGC != None) {
Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC);
}
if (mbPtr->disabledGC != None) {
Tk_FreeGC(mbPtr->display, mbPtr->disabledGC);
}
if (mbPtr->stippleGC != None) {
Tk_FreeGC(mbPtr->display, mbPtr->stippleGC);
}
if (mbPtr->gray != None) {
Tk_FreeBitmap(mbPtr->display, mbPtr->gray);
}
if (mbPtr->textLayout != NULL) {
Tk_FreeTextLayout(mbPtr->textLayout);
}
Tk_FreeConfigOptions((char *) mbPtr, mbPtr->optionTable, mbPtr->tkwin);
mbPtr->tkwin = NULL;
Tcl_EventuallyFree(mbPtr, TCL_DYNAMIC);
}
/* Object command for a PV object */
static int InstanceCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]) {
pvInfo *info = (pvInfo *) clientData;
if (objc<2) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand");
return TCL_ERROR;
}
Tcl_Obj *subcommand=objv[1];
int cmdindex;
if (Tcl_GetIndexFromObj(interp, subcommand, pvcmdtable, "subcommand", 0, &cmdindex) != TCL_OK) {
return TCL_ERROR;
}
switch (cmdindex) {
case PUT:
return PutCmd(interp, info, objc, objv);
case GET:
return GetCmd(interp, info, objc, objv);
case MONITOR:
return MonitorCmd(interp, info, objc, objv);
case NAME:
Tcl_SetObjResult(interp, Tcl_NewStringObj(info->name, -1));
return TCL_OK;
case CONNECTED:
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(info->connected));
return TCL_OK;
case NELEM:
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(info->nElem));
return TCL_OK;
case CHID:
Tcl_SetObjResult(interp, Tcl_NewWideIntObj((intptr_t)info->id));
return TCL_OK;
case TYPE:
Tcl_SetObjResult(interp, Tcl_NewStringObj(dbr_type_to_text(info->type), -1));
return TCL_OK;
case DESTROY: {
Tcl_Command self = Tcl_GetCommandFromObj(interp, objv[0]);
if (self != NULL) {
Tcl_DeleteCommandFromToken(interp, self);
}
return TCL_OK;
}
default:
Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown error", -1));
return TCL_ERROR;
}
}
/*++
FreeState
Deletes hash tables and frees state structure.
Arguments:
state - Pointer to a "ExtState" structure.
removeCmds - Remove registered commands.
removeProc - Remove the interp deletion callback.
Return Value:
None.
--*/
static void
FreeState(
ExtState *state,
int removeCmds,
int removeProc
)
{
assert(state != NULL);
DebugPrint("FreeState: state=%p state->interp=%p removeCmds=%d removeProc=%d\n",
state, state->interp, removeCmds, removeProc);
if (removeCmds) {
int i;
for (i = 0; i < ARRAYSIZE(state->cmds); i++) {
if (state->cmds[i] == NULL) {
continue;
}
Tcl_DeleteCommandFromToken(state->interp, state->cmds[i]);
}
}
if (removeProc) {
Tcl_DontCallWhenDeleted(state->interp, InterpDeleted, (ClientData)state);
}
// Free hash tables.
CryptCloseHandles(state->cryptTable);
Tcl_DeleteHashTable(state->cryptTable);
ckfree((char *)state->cryptTable);
#ifndef _WINDOWS
GlCloseHandles(state->glftpdTable);
Tcl_DeleteHashTable(state->glftpdTable);
ckfree((char *)state->glftpdTable);
#endif
ckfree((char *)state);
}
static void
ImgBmapDelete(
ClientData masterData) /* Pointer to BitmapMaster structure for
* image. Must not have any more instances. */
{
BitmapMaster *masterPtr = masterData;
if (masterPtr->instancePtr != NULL) {
Tcl_Panic("tried to delete bitmap image when instances still exist");
}
masterPtr->tkMaster = NULL;
if (masterPtr->imageCmd != NULL) {
Tcl_DeleteCommandFromToken(masterPtr->interp, masterPtr->imageCmd);
}
if (masterPtr->data != NULL) {
ckfree(masterPtr->data);
}
if (masterPtr->maskData != NULL) {
ckfree(masterPtr->maskData);
}
Tk_FreeOptions(configSpecs, (char *) masterPtr, NULL, 0);
ckfree((char *) masterPtr);
}
static void
DestroyScale(
char *memPtr) /* Info about scale widget. */
{
register TkScale *scalePtr = (TkScale *) memPtr;
scalePtr->flags |= SCALE_DELETED;
Tcl_DeleteCommandFromToken(scalePtr->interp, scalePtr->widgetCmd);
if (scalePtr->flags & REDRAW_PENDING) {
Tcl_CancelIdleCall(TkpDisplayScale, scalePtr);
}
/*
* Free up all the stuff that requires special handling, then let
* Tk_FreeOptions handle all the standard option-related stuff.
*/
if (scalePtr->varNamePtr != NULL) {
Tcl_UntraceVar(scalePtr->interp, Tcl_GetString(scalePtr->varNamePtr),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ScaleVarProc, scalePtr);
}
if (scalePtr->troughGC != None) {
Tk_FreeGC(scalePtr->display, scalePtr->troughGC);
}
if (scalePtr->copyGC != None) {
Tk_FreeGC(scalePtr->display, scalePtr->copyGC);
}
if (scalePtr->textGC != None) {
Tk_FreeGC(scalePtr->display, scalePtr->textGC);
}
Tk_FreeConfigOptions((char *) scalePtr, scalePtr->optionTable,
scalePtr->tkwin);
scalePtr->tkwin = NULL;
TkpDestroyScale(scalePtr);
}
int
Tk_CreateConsoleWindow(
Tcl_Interp *interp) /* Interpreter to use for prompting. */
{
Tcl_Channel chan;
ConsoleInfo *info;
Tk_Window mainWindow;
Tcl_Command token;
int result = TCL_OK;
int haveConsoleChannel = 1;
/* Init an interp with Tcl and Tk */
Tcl_Interp *consoleInterp = Tcl_CreateInterp();
if (Tcl_Init(consoleInterp) != TCL_OK) {
goto error;
}
if (Tk_Init(consoleInterp) != TCL_OK) {
goto error;
}
/*
* Fetch the instance data from whatever std channel is a
* console channel. If none, create fresh instance data.
*/
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
== &consoleChannelType) {
} else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
== &consoleChannelType) {
} else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
== &consoleChannelType) {
} else {
haveConsoleChannel = 0;
}
if (haveConsoleChannel) {
ChannelData *data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
info = data->info;
if (info->consoleInterp) {
/* New ConsoleInfo for a new console window */
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->refCount = 0;
/* Update any console channels to make use of the new console */
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
}
} else {
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->refCount = 0;
}
info->consoleInterp = consoleInterp;
info->interp = interp;
Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, info);
info->refCount++;
Tcl_CreateThreadExitHandler(DeleteConsoleInterp, consoleInterp);
/*
* Add console commands to the interp
*/
token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd, info,
ConsoleDeleteProc);
info->refCount++;
/*
* We don't have to count the ref held by the [consoleinterp] command
* in the consoleInterp. The ref held by the consoleInterp delete
* handler takes care of us.
*/
Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd,
info, NULL);
mainWindow = Tk_MainWindow(interp);
if (mainWindow) {
Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
ConsoleEventProc, info);
info->refCount++;
}
Tcl_Preserve(consoleInterp);
result = Tcl_GlobalEval(consoleInterp, "source $tk_library/console.tcl");
if (result == TCL_ERROR) {
Tcl_SetReturnOptions(interp,
Tcl_GetReturnOptions(consoleInterp, result));
Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
}
Tcl_Release(consoleInterp);
if (result == TCL_ERROR) {
Tcl_DeleteCommandFromToken(interp, token);
mainWindow = Tk_MainWindow(interp);
if (mainWindow) {
Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
ConsoleEventProc, info);
if (--info->refCount <= 0) {
ckfree((char *) info);
}
}
goto error;
}
return TCL_OK;
error:
Tcl_AddErrorInfo(interp, "\n (creating console window)");
if (!Tcl_InterpDeleted(consoleInterp)) {
Tcl_DeleteInterp(consoleInterp);
}
return TCL_ERROR;
}
int MkView::CloseCmd() {
// remove command instance... this will call delete...
Tcl_DeleteCommandFromToken(interp, cmdToken);
return TCL_OK;
}
QMetaTclQVariant::~QMetaTclQVariant()
{
Tcl_DeleteCommandFromToken(m_interp, m_tclCommandToken);
}
FUNCTION_HANDLER(session, closeConnection) {
BrlapiSession *session = data;
TEST_FUNCTION_NO_ARGUMENTS();
Tcl_DeleteCommandFromToken(interp, session->tclCommand);
return TCL_OK;
}