Working towards adding all the Tcl_SetErrorCode calls that should be there.

** WORK IN PROGRESS **

5 files changed, 116 insertions, 121 deletions

diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index 4d60105..b0c7f4d 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -424,13 +424,11 @@ Tk_ChooseColorObjCmd(
 	/*
 	 * User has selected a color
 	 */
-	char color[100];
 
-	sprintf(color, "#%02x%02x%02x",
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("#%02x%02x%02x",
 		GetRValue(chooseColor.rgbResult),
 		GetGValue(chooseColor.rgbResult),
-		GetBValue(chooseColor.rgbResult));
-	Tcl_AppendResult(interp, color, NULL);
+		GetBValue(chooseColor.rgbResult)));
 	oldColor = chooseColor.rgbResult;
 	result = TCL_OK;
     }
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);
 }
 
 /*
diff --git a/win/tkWinSendCom.c b/win/tkWinSendCom.c
index c67e533..83dd56b 100644
--- a/win/tkWinSendCom.c
+++ b/win/tkWinSendCom.c
@@ -100,7 +100,6 @@ TkWinSendCom_CreateInstance(
 	ISupportErrorInfo_Release,
 	ISupportErrorInfo_InterfaceSupportsErrorInfo,
     };
-    HRESULT hr = S_OK;
     TkWinSendCom *obj = NULL;
 
     /*
@@ -111,21 +110,19 @@ TkWinSendCom_CreateInstance(
     obj = (TkWinSendCom *) CoTaskMemAlloc(sizeof(TkWinSendCom));
     if (obj == NULL) {
 	*ppv = NULL;
-	hr = E_OUTOFMEMORY;
-    } else {
-	obj->lpVtbl = &vtbl;
-	obj->lpVtbl2 = &vtbl2;
-	obj->refcount = 0;
-	obj->interp = interp;
-
-	/*
-	 * lock the interp? Tcl_AddRef/Retain?
-	 */
-
-	hr = obj->lpVtbl->QueryInterface((IDispatch*)obj, riid, ppv);
+	return E_OUTOFMEMORY;
     }
 
-    return hr;
+    obj->lpVtbl = &vtbl;
+    obj->lpVtbl2 = &vtbl2;
+    obj->refcount = 0;
+    obj->interp = interp;
+
+    /*
+     * lock the interp? Tcl_AddRef/Retain?
+     */
+
+    return obj->lpVtbl->QueryInterface((IDispatch *) obj, riid, ppv);
 }
 
 /*
@@ -147,7 +144,7 @@ static void
 TkWinSendCom_Destroy(
     LPDISPATCH pdisp)
 {
-    CoTaskMemFree((void*)pdisp);
+    CoTaskMemFree((void *) pdisp);
 }
 
 /*
@@ -169,17 +166,17 @@ WinSendCom_QueryInterface(
     void **ppvObject)
 {
     HRESULT hr = E_NOINTERFACE;
-    TkWinSendCom *this = (TkWinSendCom*)This;
+    TkWinSendCom *this = (TkWinSendCom *) This;
     *ppvObject = NULL;
 
     if (memcmp(riid, &IID_IUnknown, sizeof(IID)) == 0
 	    || memcmp(riid, &IID_IDispatch, sizeof(IID)) == 0) {
-	*ppvObject = (void**)this;
+	*ppvObject = (void **) this;
 	this->lpVtbl->AddRef(This);
 	hr = S_OK;
     } else if (memcmp(riid, &IID_ISupportErrorInfo, sizeof(IID)) == 0) {
-	*ppvObject = (void**)(this + 1);
-	this->lpVtbl2->AddRef((ISupportErrorInfo*)(this + 1));
+	*ppvObject = (void **) (this + 1);
+	this->lpVtbl2->AddRef((ISupportErrorInfo *) (this + 1));
 	hr = S_OK;
     }
     return hr;
@@ -316,16 +313,16 @@ ISupportErrorInfo_QueryInterface(
     REFIID riid,
     void **ppvObject)
 {
-    TkWinSendCom *this = (TkWinSendCom*)(This - 1);
+    TkWinSendCom *this = (TkWinSendCom *)(This - 1);
 
-    return this->lpVtbl->QueryInterface((IDispatch*)this, riid, ppvObject);
+    return this->lpVtbl->QueryInterface((IDispatch *) this, riid, ppvObject);
 }
 
 static STDMETHODIMP_(ULONG)
 ISupportErrorInfo_AddRef(
     ISupportErrorInfo *This)
 {
-    TkWinSendCom *this = (TkWinSendCom*)(This - 1);
+    TkWinSendCom *this = (TkWinSendCom *)(This - 1);
 
     return InterlockedIncrement(&this->refcount);
 }
@@ -334,9 +331,9 @@ static STDMETHODIMP_(ULONG)
 ISupportErrorInfo_Release(
     ISupportErrorInfo *This)
 {
-    TkWinSendCom *this = (TkWinSendCom*)(This - 1);
+    TkWinSendCom *this = (TkWinSendCom *)(This - 1);
 
-    return this->lpVtbl->Release((IDispatch*)this);
+    return this->lpVtbl->Release((IDispatch *) this);
 }
 
 static STDMETHODIMP
@@ -380,17 +377,15 @@ Async(
     if (FAILED(hr)) {
 	Tcl_SetObjResult(obj->interp, Tcl_NewStringObj(
 		"invalid args: Async(command)", -1));
-	SetExcepInfo(obj->interp, pExcepInfo);
+	TkWinSend_SetExcepInfo(obj->interp, pExcepInfo);
 	hr = DISP_E_EXCEPTION;
     }
 
-    if (SUCCEEDED(hr)) {
-	if (obj->interp) {
-	    Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal,
-		    (int) SysStringLen(vCmd.bstrVal));
+    if (SUCCEEDED(hr) && obj->interp) {
+	Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal,
+		(int) SysStringLen(vCmd.bstrVal));
 
-	    TkWinSend_QueueCommand(obj->interp, scriptPtr);
-	}
+	TkWinSend_QueueCommand(obj->interp, scriptPtr);
     }
 
     VariantClear(&vCmd);
@@ -427,29 +422,36 @@ Send(
     HRESULT hr = S_OK;
     int result = TCL_OK;
     VARIANT v;
+    register Tcl_Interp *interp = obj->interp;
+    Tcl_Obj *scriptPtr;
 
+    if (interp == NULL) {
+	return S_OK;
+    }
     VariantInit(&v);
     hr = VariantChangeType(&v, &vCmd, 0, VT_BSTR);
-    if (SUCCEEDED(hr)) {
-	if (obj->interp) {
-	    Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(v.bstrVal,
-		    (int)SysStringLen(v.bstrVal));
-
-	    result = Tcl_EvalObjEx(obj->interp, scriptPtr,
-		    TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
-	    if (pvResult) {
-		VariantInit(pvResult);
-		pvResult->vt = VT_BSTR;
-		pvResult->bstrVal = SysAllocString(
-			Tcl_GetUnicode(Tcl_GetObjResult(obj->interp)));
-	    }
-	    if (result == TCL_ERROR) {
-		hr = DISP_E_EXCEPTION;
-		SetExcepInfo(obj->interp, pExcepInfo);
-	    }
-	}
-	VariantClear(&v);
+    if (!SUCCEEDED(hr)) {
+	return hr;
+    }
+
+    scriptPtr = Tcl_NewUnicodeObj(v.bstrVal, (int) SysStringLen(v.bstrVal));
+    Tcl_Preserve(interp);
+    Tcl_IncrRefCount(scriptPtr);
+    result = Tcl_EvalObjEx(interp, scriptPtr,
+	    TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
+    Tcl_DecrRefCount(scriptPtr);
+    if (pvResult != NULL) {
+	VariantInit(pvResult);
+	pvResult->vt = VT_BSTR;
+	pvResult->bstrVal = SysAllocString(Tcl_GetUnicode(
+		Tcl_GetObjResult(interp)));
+    }
+    if (result == TCL_ERROR) {
+	hr = DISP_E_EXCEPTION;
+	TkWinSend_SetExcepInfo(interp, pExcepInfo);
     }
+    Tcl_Release(interp);
+    VariantClear(&v);
     return hr;
 }
 
diff --git a/win/tkWinSendCom.h b/win/tkWinSendCom.h
index 4928bc7..cd6ec18 100644
--- a/win/tkWinSendCom.h
+++ b/win/tkWinSendCom.h
@@ -45,11 +45,11 @@ typedef struct {
  * TkWinSendCom public functions
  */
 
-HRESULT                 TkWinSendCom_CreateInstance(Tcl_Interp *interp,
+MODULE_SCOPE HRESULT    TkWinSendCom_CreateInstance(Tcl_Interp *interp,
                             REFIID riid, void **ppv);
-int                     TkWinSend_QueueCommand(Tcl_Interp *interp,
+MODULE_SCOPE int        TkWinSend_QueueCommand(Tcl_Interp *interp,
                             Tcl_Obj *cmdPtr);
-void                    SetExcepInfo(Tcl_Interp *interp,
+MODULE_SCOPE void       TkWinSend_SetExcepInfo(Tcl_Interp *interp,
                             EXCEPINFO *pExcepInfo);
 
 #endif /* _tkWinSendCom_h_INCLUDE */
diff --git a/win/tkWinX.c b/win/tkWinX.c
index e85b7e7..22edb60 100644
--- a/win/tkWinX.c
+++ b/win/tkWinX.c
@@ -120,20 +120,19 @@ TkGetServerInfo(
     Tk_Window tkwin)		/* Token for window; this selects a particular
 				 * display and server. */
 {
-    char buffer[60];
     OSVERSIONINFO os;
 
     os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
     GetVersionEx(&os);
-    sprintf(buffer, "Windows %d.%d %d %s", (int)os.dwMajorVersion,
-	    (int)os.dwMinorVersion, (int)os.dwBuildNumber,
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("Windows %d.%d %d %s",
+	    (int) os.dwMajorVersion, (int) os.dwMinorVersion,
+	    (int) os.dwBuildNumber,
 #ifdef _WIN64
 	    "Win64"
 #else
 	    "Win32"
 #endif
-	    );
-    Tcl_SetResult(interp, buffer, TCL_VOLATILE);
+	    ));
 }
 
 /*