void Deactivate() {
if (active) {
if (!wmm)
hWndProc->ReleaseExtraProc(WindowsMessagingWndProc);
wmk = 0;
active = 0;
FreeState();
}
}
void Deactivate() {
FreeState();
if (active) {
if (!wmm)
ReleaseExtraProc(WindowsMessagingWndProc);
active = 0;
wmk = 0;
}
// hWndDlg = 0;
}
/*++
Alcoext_Unload
Unloads the extension from a process or interpreter.
Arguments:
interp - Current interpreter.
flags - Type of detachment.
Return Value:
A standard Tcl result.
--*/
int
Alcoext_Unload(
Tcl_Interp *interp,
int flags
)
{
DebugPrint("Unload: interp=%p flags=%d\n", interp, flags);
if (flags == TCL_UNLOAD_DETACH_FROM_INTERPRETER) {
ExtState *state;
Tcl_MutexLock(&stateListMutex);
for (state = stateHead; state != NULL; state = state->next) {
if (interp == state->interp) {
// Remove the interpreter's state from the list.
if (state->next != NULL) {
state->next->prev = state->prev;
}
if (state->prev != NULL) {
state->prev->next = state->next;
}
if (stateHead == state) {
stateHead = state->next;
}
FreeState(state, 1, 1);
break;
}
}
Tcl_MutexUnlock(&stateListMutex);
} else if (flags == TCL_UNLOAD_DETACH_FROM_PROCESS) {
// Remove registered exit handlers.
Tcl_DeleteExitHandler(ExitHandler, NULL);
Finalise(1);
} else {
// Unknown flags value.
return TCL_ERROR;
}
// Unregister the package (there is no Tcl_PkgForget(), or similar).
Tcl_Eval(interp, "package forget " PACKAGE_NAME);
return TCL_OK;
}
/*++
Alcoext_Unload
Unload the extension from a process or interpreter. As proposed
in Tcl TIP #100 (http://www.tcl.tk/cgi-bin/tct/tip/100.html).
Arguments:
interp - Current interpreter.
flags - Type of detachment.
Return Value:
A standard Tcl result.
--*/
int
Alcoext_Unload(
Tcl_Interp *interp,
int flags
)
{
if (flags == TCL_UNLOAD_DETACH_FROM_INTERPRETER) {
StateList *stateListPtr;
Tcl_MutexLock(&stateMutex);
for (stateListPtr = stateListHead; stateListPtr != NULL; stateListPtr = stateListPtr->next) {
if (interp == stateListPtr->interp) {
// Remove the interpreter's state from the list.
if (stateListPtr->next != NULL) {
stateListPtr->next->prev = stateListPtr->prev;
}
if (stateListPtr->prev != NULL) {
stateListPtr->prev->next = stateListPtr->next;
}
if (stateListHead == stateListPtr) {
stateListHead = stateListPtr->next;
}
FreeState(stateListPtr->state);
ckfree((char *)stateListPtr);
break;
}
}
Tcl_MutexUnlock(&stateMutex);
return TCL_OK;
} else if (flags == TCL_UNLOAD_DETACH_FROM_PROCESS) {
ExitHandler(NULL);
return TCL_OK;
}
// Unknown "flags" value.
return TCL_ERROR;
}
/*++
InterpDeleted
Frees the state structure for an interpreter that is being deleted.
Arguments:
clientData - Pointer to a "ExtState" structure.
interp - Current interpreter.
Return Value:
None.
--*/
static void
InterpDeleted(
ClientData clientData,
Tcl_Interp *interp
)
{
ExtState *state;
ExtState *stateCurrent = (ExtState *)clientData;
DebugPrint("InterpDeleted: interp=%p state=%p\n", interp, stateCurrent);
Tcl_MutexLock(&stateListMutex);
for (state = stateHead; state != NULL; state = state->next) {
if (state == stateCurrent) {
// Remove the interpreter's state from the list.
if (state->prev == NULL) {
stateHead = state->next;
if (state->next != NULL) {
stateHead->prev = NULL;
}
} else if (state->next == NULL) {
state->prev->next = NULL;
} else {
state->prev->next = state->next;
state->next->prev = state->prev;
}
//
// Tcl 8.5 calls the unload function before the interp deletion
// handler. Since all states are freed in the unload function,
// we must only free states present in the global state list.
//
FreeState(state, 0, 0);
break;
}
}
Tcl_MutexUnlock(&stateListMutex);
}
/*++
InterpDeleteHandler
Frees the state structure for an interpreter that is being deleted.
Arguments:
clientData - Pointer to a "ExtState" structure.
interp - Current interpreter.
Return Value:
None.
--*/
static void
InterpDeleteHandler(
ClientData clientData,
Tcl_Interp *interp
)
{
ExtState *statePtr = (ExtState *)clientData;
StateList *stateListPtr;
if (statePtr == NULL) {
return;
}
Tcl_MutexLock(&stateMutex);
for (stateListPtr = stateListHead; stateListPtr != NULL; stateListPtr = stateListPtr->next) {
if (statePtr == stateListPtr->state) {
// Remove the interpreter's state from the list.
if (stateListPtr->prev == NULL) {
stateListHead = stateListPtr->next;
if (stateListPtr->next != NULL) {
stateListHead->prev = NULL;
}
} else if (stateListPtr->next == NULL) {
stateListPtr->prev->next = NULL;
} else {
stateListPtr->prev->next = stateListPtr->next;
stateListPtr->next->prev = stateListPtr->prev;
}
ckfree((char *)stateListPtr);
break;
}
}
Tcl_MutexUnlock(&stateMutex);
FreeState(statePtr);
}
/*++
Finalise
Finalises the library; freeing all held resources.
Arguments:
removeCmds - Remove extension commands from all interpreters.
Return Value:
None.
--*/
static void
Finalise(
int removeCmds
)
{
DebugPrint("Finalise: removeCmds=%d\n", removeCmds);
#ifdef _WINDOWS
Tcl_MutexLock(&initMutex);
if (winProcs.module != NULL) {
FreeLibrary(winProcs.module);
}
ZeroMemory(&winProcs, sizeof(WinProcs));
Tcl_MutexUnlock(&initMutex);
#endif
Tcl_MutexFinalize(&initMutex);
initialised = 0;
Tcl_MutexLock(&stateListMutex);
if (stateHead != NULL) {
ExtState *state;
ExtState *stateNext;
// Free all states structures.
for (state = stateHead; state != NULL; state = stateNext) {
stateNext = state->next;
FreeState(state, removeCmds, 1);
}
stateHead = NULL;
}
Tcl_MutexUnlock(&stateListMutex);
Tcl_MutexFinalize(&stateListMutex);
#ifdef TCL_MEM_DEBUG
Tcl_DumpActiveMemory("MemDump.txt");
#endif
}
/*++
ExitHandler
Cleans up library on exit, frees all state structures
for every interpreter this extension was loaded in.
Arguments:
dummy - Not used.
Return Value:
None.
--*/
static void
ExitHandler(
ClientData dummy
)
{
Tcl_MutexLock(&initMutex);
#ifdef _WINDOWS
if (winProcs.module != NULL) {
FreeLibrary(winProcs.module);
}
ZeroMemory(&winProcs, sizeof(WinProcs));
#endif // _WINDOWS
initialised = 0;
Tcl_MutexUnlock(&initMutex);
Tcl_MutexLock(&stateMutex);
if (stateListHead != NULL) {
StateList *stateListPtr;
StateList *nextStateListPtr;
// Free all states structures.
for (stateListPtr = stateListHead; stateListPtr != NULL; stateListPtr = nextStateListPtr) {
nextStateListPtr = stateListPtr->next;
FreeState(stateListPtr->state);
ckfree((char *)stateListPtr);
}
stateListHead = NULL;
}
Tcl_MutexUnlock(&stateMutex);
#ifdef TCL_MEM_DEBUG
Tcl_DumpActiveMemory("MemDump.txt");
#endif
}
