diff options
Diffstat (limited to 'win/tkWinSend.c')
| -rw-r--r-- | win/tkWinSend.c | 114 |
1 files changed, 55 insertions, 59 deletions
diff --git a/win/tkWinSend.c b/win/tkWinSend.c index b3edc62..a8e2109 100644 --- a/win/tkWinSend.c +++ b/win/tkWinSend.c @@ -55,7 +55,7 @@ typedef struct { int initialized; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * Functions internal to this file. @@ -66,12 +66,12 @@ static void CmdDeleteProc(ClientData clientData); static void InterpDeleteProc(ClientData clientData, Tcl_Interp *interp); static void RevokeObjectRegistration(RegisteredInterp *riPtr); -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ static HRESULT BuildMoniker(const char *name, LPMONIKER *pmk); #ifdef TK_SEND_ENABLED_ON_WINDOWS static HRESULT RegisterInterp(const char *name, RegisteredInterp *riPtr); -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ static int FindInterpreterObject(Tcl_Interp *interp, const char *name, LPDISPATCH *ppdisp); static int Send(LPDISPATCH pdispInterp, Tcl_Interp *interp, @@ -85,7 +85,7 @@ static Tcl_EventProc SendEventProc; #define TRACE SendTrace #else #define TRACE 1 ? ((void)0) : SendTrace -#endif +#endif /* DEBUG || _DEBUG */ /* *-------------------------------------------------------------- @@ -553,7 +553,7 @@ RevokeObjectRegistration( riPtr->name = NULL; } } -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * ---------------------------------------------------------------------- @@ -580,7 +580,7 @@ InterpDeleteProc( { CoUninitialize(); } -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * ---------------------------------------------------------------------- @@ -701,7 +701,7 @@ RegisterInterp( Tcl_DStringFree(&dString); return hr; } -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * ---------------------------------------------------------------------- @@ -782,21 +782,14 @@ Send( * variables. */ - if (hr == DISP_E_EXCEPTION) { + if (hr == DISP_E_EXCEPTION && ei.bstrSource != NULL) { Tcl_Obj *opError, *opErrorCode, *opErrorInfo; - if (ei.bstrSource != NULL) { - int len; - const char *szErrorInfo; - - opError = Tcl_NewUnicodeObj(ei.bstrSource, -1); - Tcl_ListObjIndex(interp, opError, 0, &opErrorCode); - Tcl_SetObjErrorCode(interp, opErrorCode); - - Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo); - szErrorInfo = Tcl_GetStringFromObj(opErrorInfo, &len); - Tcl_AddObjErrorInfo(interp, szErrorInfo, len); - } + 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); } /* @@ -852,7 +845,7 @@ Win32ErrorObj( errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer)); #else errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer)); -#endif +#endif /* _UNICODE */ if (lpBuffer != sBuffer) { LocalFree((HLOCAL)lpBuffer); @@ -864,7 +857,7 @@ Win32ErrorObj( /* * ---------------------------------------------------------------------- * - * SetErrorInfo -- + * TkWinSend_SetExcepInfo -- * * Convert the error information from a Tcl interpreter into a COM * exception structure. This information is then registered with the COM @@ -881,48 +874,51 @@ Win32ErrorObj( */ void -SetExcepInfo( - Tcl_Interp* interp, +TkWinSend_SetExcepInfo( + Tcl_Interp *interp, EXCEPINFO *pExcepInfo) { - if (pExcepInfo) { - Tcl_Obj *opError, *opErrorInfo, *opErrorCode; - ICreateErrorInfo *pCEI; - IErrorInfo *pEI, **ppEI = &pEI; - HRESULT hr; - - opError = Tcl_GetObjResult(interp); - opErrorInfo = Tcl_GetVar2Ex(interp, "errorInfo",NULL, TCL_GLOBAL_ONLY); - opErrorCode = Tcl_GetVar2Ex(interp, "errorCode",NULL, TCL_GLOBAL_ONLY); - - if (Tcl_IsShared(opErrorCode)) { - Tcl_Obj *ec = Tcl_DuplicateObj(opErrorCode); - - Tcl_IncrRefCount(ec); - Tcl_DecrRefCount(opErrorCode); - opErrorCode = ec; - } - Tcl_ListObjAppendElement(interp, opErrorCode, opErrorInfo); + Tcl_Obj *opError, *opErrorInfo, *opErrorCode; + ICreateErrorInfo *pCEI; + IErrorInfo *pEI, **ppEI = &pEI; + HRESULT hr; - pExcepInfo->bstrDescription = SysAllocString(Tcl_GetUnicode(opError)); - pExcepInfo->bstrSource = SysAllocString(Tcl_GetUnicode(opErrorCode)); - pExcepInfo->scode = E_FAIL; + if (!pExcepInfo) { + return; + } - hr = CreateErrorInfo(&pCEI); - if (SUCCEEDED(hr)) { - hr = pCEI->lpVtbl->SetGUID(pCEI, &IID_IDispatch); - hr = pCEI->lpVtbl->SetDescription(pCEI, - pExcepInfo->bstrDescription); - hr = pCEI->lpVtbl->SetSource(pCEI, pExcepInfo->bstrSource); - hr = pCEI->lpVtbl->QueryInterface(pCEI, &IID_IErrorInfo, - (void**) ppEI); - if (SUCCEEDED(hr)) { - SetErrorInfo(0, pEI); - pEI->lpVtbl->Release(pEI); - } - pCEI->lpVtbl->Release(pCEI); - } + opError = Tcl_GetObjResult(interp); + opErrorInfo = Tcl_GetVar2Ex(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); + opErrorCode = Tcl_GetVar2Ex(interp, "errorCode", NULL, TCL_GLOBAL_ONLY); + + /* + * Pack the trace onto the end of the Tcl exception descriptor. + */ + + opErrorCode = Tcl_DuplicateObj(opErrorCode); + Tcl_IncrRefCount(opErrorCode); + Tcl_ListObjAppendElement(interp, opErrorCode, opErrorInfo); + /* TODO: Handle failure to append */ + + pExcepInfo->bstrDescription = SysAllocString(Tcl_GetUnicode(opError)); + pExcepInfo->bstrSource = SysAllocString(Tcl_GetUnicode(opErrorCode)); + Tcl_DecrRefCount(opErrorCode); + pExcepInfo->scode = E_FAIL; + + hr = CreateErrorInfo(&pCEI); + if (!SUCCEEDED(hr)) { + return; + } + + hr = pCEI->lpVtbl->SetGUID(pCEI, &IID_IDispatch); + hr = pCEI->lpVtbl->SetDescription(pCEI, pExcepInfo->bstrDescription); + hr = pCEI->lpVtbl->SetSource(pCEI, pExcepInfo->bstrSource); + hr = pCEI->lpVtbl->QueryInterface(pCEI, &IID_IErrorInfo, (void **) ppEI); + if (SUCCEEDED(hr)) { + SetErrorInfo(0, pEI); + pEI->lpVtbl->Release(pEI); } + pCEI->lpVtbl->Release(pCEI); } /* |