Generate -errorcode values to go with errors. Generate messages and postscript

using Tcl_Obj API, not the string result API.

1 files changed, 68 insertions, 70 deletions

diff --git a/win/tkWinSend.c b/win/tkWinSend.c
index b3edc62..a40c238 100644
--- a/win/tkWinSend.c
+++ b/win/tkWinSend.c
@@ -1,4 +1,4 @@
-/*
+`/*
  * tkWinSend.c --
  *
  *	This file provides functions that implement the "send" command,
@@ -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 */
 
 /*
  *--------------------------------------------------------------
@@ -136,9 +136,7 @@ Tk_SetAppName(
     HRESULT hr = S_OK;
 
     interp = winPtr->mainPtr->interp;
-
-    tsdPtr = (ThreadSpecificData *)
-	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+    tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
 
     /*
      * Initialise the COM library for this interpreter just once.
@@ -147,8 +145,9 @@ Tk_SetAppName(
     if (tsdPtr->initialized == 0) {
 	hr = CoInitialize(0);
 	if (FAILED(hr)) {
-	    Tcl_SetResult(interp,
-		    "failed to initialize the COM library", TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "failed to initialize the COM library", -1));
+	    Tcl_SetErrorcode(interp, "TK", "SEND", "COM", NULL);
 	    return "";
 	}
 	tsdPtr->initialized = 1;
@@ -363,8 +362,10 @@ Tk_SendObjCmd(
      */
 
     if (displayPtr) {
-	Tcl_SetResult(interp, "option not implemented: \"displayof\" is "
-		"not available for this platform.", TCL_STATIC);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"option not implemented: \"displayof\" is not available"
+		" for this platform.", -1));
+	Tcl_SetErrorcode(interp, "TK", "SEND", "DISPLAYOF_WIN", NULL);
 	result = TCL_ERROR;
     }
 
@@ -436,9 +437,10 @@ FindInterpreterObject(
 		    pUnkInterp->lpVtbl->Release(pUnkInterp);
 
 		} else {
-		    Tcl_ResetResult(interp);
-		    Tcl_AppendResult(interp,
-			    "no application named \"", name, "\"", NULL);
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "no application named \"%s\"", name));
+		    Tcl_SetErrorcode(interp, "TK", "LOOKUP", "APPLICATION",
+			    NULL);
 		    result = TCL_ERROR;
 		}
 
@@ -553,7 +555,7 @@ RevokeObjectRegistration(
 	riPtr->name = NULL;
     }
 }
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
 
 /*
  * ----------------------------------------------------------------------
@@ -580,7 +582,7 @@ InterpDeleteProc(
 {
     CoUninitialize();
 }
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
 
 /*
  * ----------------------------------------------------------------------
@@ -701,7 +703,7 @@ RegisterInterp(
     Tcl_DStringFree(&dString);
     return hr;
 }
-#endif
+#endif /* TK_SEND_ENABLED_ON_WINDOWS */
 
 /*
  * ----------------------------------------------------------------------
@@ -782,21 +784,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 +847,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 +859,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 +876,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);
 }
 
 /*