summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/tkWinDialog.c6
-rw-r--r--win/tkWinSend.c114
-rw-r--r--win/tkWinSendCom.c102
-rw-r--r--win/tkWinSendCom.h6
-rw-r--r--win/tkWinX.c9
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);
+ ));
}
/*
generated by cgit v0.12 at 2024-12-12 12:41:21 (GMT)