diff options
-rw-r--r-- | win/Makefile.in | 3 | ||||
-rwxr-xr-x | win/configure | 4 | ||||
-rw-r--r-- | win/tcl.m4 | 2 | ||||
-rw-r--r-- | win/tkWinSend.c | 26 | ||||
-rw-r--r-- | win/tkWinSendCom.c | 111 |
5 files changed, 79 insertions, 67 deletions
diff --git a/win/Makefile.in b/win/Makefile.in index 8527a75..aa8c21a 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -4,7 +4,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.59 2003/01/13 07:30:58 mdejong Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.60 2003/10/08 21:49:56 patthoyts Exp $ TCLVERSION = @TCL_VERSION@ VERSION = @TK_VERSION@ @@ -259,6 +259,7 @@ TK_OBJS = \ tkWinRegion.$(OBJEXT) \ tkWinScrlbr.$(OBJEXT) \ tkWinSend.$(OBJEXT) \ + tkWinSendCom.$(OBJEXT) \ tkWinWindow.$(OBJEXT) \ tkWinWm.$(OBJEXT) \ tkWinX.$(OBJEXT) \ diff --git a/win/configure b/win/configure index 8d505c1..efd86a8 100755 --- a/win/configure +++ b/win/configure @@ -2599,7 +2599,7 @@ echo "$as_me: WARNING: \"64bit mode not supported with GCC on Windows\"" >&2;} SHLIB_LD="" SHLIB_LD_LIBS="" LIBS="" - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32" + LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -lole32 -loleaut32 -luuid" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= @@ -2778,7 +2778,7 @@ echo "$as_me: WARNING: \"could not find 64-bit SDK to enable 64bit mode\"" >&2;} SHLIB_LD="${LINKBIN} -dll -nologo -incremental:no" LIBS="user32.lib advapi32.lib" - LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib" + LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib" RC_OUT=-fo RC_TYPE=-r RC_INCLUDE=-i @@ -436,7 +436,7 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ SHLIB_LD="" SHLIB_LD_LIBS="" LIBS="" - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32" + LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -lole32 -loleaut32 -luuid" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= diff --git a/win/tkWinSend.c b/win/tkWinSend.c index 856e8f6..14a23c8 100644 --- a/win/tkWinSend.c +++ b/win/tkWinSend.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinSend.c,v 1.4 2003/09/26 23:59:26 patthoyts Exp $ + * RCS: @(#) $Id: tkWinSend.c,v 1.5 2003/10/08 21:49:57 patthoyts Exp $ */ #include "tkPort.h" @@ -197,7 +197,7 @@ TkGetInterpNames(interp, tkwin) LPRUNNINGOBJECTTABLE pROT = NULL; LPCOLESTR oleszStub = TKWINSEND_REGISTRATION_BASE; HRESULT hr = S_OK; - Tcl_Obj *objList; + Tcl_Obj *objList = NULL; int r = TCL_OK; hr = GetRunningObjectTable(0, &pROT); @@ -293,7 +293,6 @@ Tk_SendObjCmd(clientData, interp, objc, objv) }; int r = TCL_OK; int i, optind, async = 0; - HRESULT hr = S_OK; Tcl_Obj *displayPtr = NULL; /* process the command options */ @@ -660,7 +659,7 @@ Send(LPDISPATCH pdispInterp, Tcl_Interp *interp, HRESULT hr = S_OK, ehr = S_OK; Tcl_Obj *cmd = NULL; DISPID dispid; - RegisteredInterp *riPtr = (RegisteredInterp *)clientData; + /*RegisteredInterp *riPtr = (RegisteredInterp *)clientData;*/ cmd = Tcl_ConcatObj(objc, objv); @@ -687,13 +686,13 @@ Send(LPDISPATCH pdispInterp, Tcl_Interp *interp, dispid = async ? TKWINSENDCOM_DISPID_ASYNC : TKWINSENDCOM_DISPID_SEND; hr = pdispInterp->lpVtbl->Invoke(pdispInterp, dispid, - &IID_NULL, LOCALE_SYSTEM_DEFAULT, DISPATCH_METHOD, - &dp, &vResult, &ei, &uiErr); + &IID_NULL, LOCALE_SYSTEM_DEFAULT, DISPATCH_METHOD, + &dp, &vResult, &ei, &uiErr); /* * Convert the result into a string and place in the interps result. */ - + ehr = VariantChangeType(&vResult, &vResult, 0, VT_BSTR); if (SUCCEEDED(ehr)) Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(vResult.bstrVal, -1)); @@ -707,12 +706,12 @@ Send(LPDISPATCH pdispInterp, Tcl_Interp *interp, if (hr == DISP_E_EXCEPTION) { Tcl_Obj *opError, *opErrorCode, *opErrorInfo; - + if (ei.bstrSource != NULL) { int len; char * szErrorInfo; - + opError = Tcl_NewUnicodeObj(ei.bstrSource, -1); Tcl_ListObjIndex(interp, opError, 0, &opErrorCode); Tcl_SetObjErrorCode(interp, opErrorCode); @@ -760,7 +759,8 @@ Win32ErrorObj(HRESULT hrError) Tcl_Obj* errPtr = NULL; FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, - NULL, hrError, LANG_NEUTRAL, (LPTSTR)&lpBuffer, 0, NULL); + NULL, (DWORD)hrError, LANG_NEUTRAL, + (LPTSTR)&lpBuffer, 0, NULL); if (lpBuffer == NULL) { lpBuffer = sBuffer; @@ -771,9 +771,9 @@ Win32ErrorObj(HRESULT hrError) *p = _T('\0'); #ifdef _UNICODE - errPtr = Tcl_NewUnicodeObj(lpBuffer, wcslen(lpBuffer)); + errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer)); #else - errPtr = Tcl_NewStringObj(lpBuffer, strlen(lpBuffer)); + errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer)); #endif if (lpBuffer != sBuffer) @@ -903,7 +903,7 @@ SendEventProc(Tcl_Event *eventPtr, int flags) { int r = TCL_OK; SendEvent *evPtr = (SendEvent *)eventPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + /*ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);*/ TRACE("SendEventProc\n"); diff --git a/win/tkWinSendCom.c b/win/tkWinSendCom.c index 325f127..be612b8 100644 --- a/win/tkWinSendCom.c +++ b/win/tkWinSendCom.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinSendCom.c,v 1.1 2003/09/26 23:59:26 patthoyts Exp $ + * RCS: @(#) $Id: tkWinSendCom.c,v 1.2 2003/10/08 21:49:57 patthoyts Exp $ */ #include "tkWinSendCom.h" @@ -89,17 +89,17 @@ TkWinSendCom_CreateInstance(Tcl_Interp *interp, REFIID riid, void **ppv) WinSendCom_GetIDsOfNames, WinSendCom_Invoke, }; - + static ISupportErrorInfoVtbl vtbl2 = { ISupportErrorInfo_QueryInterface, ISupportErrorInfo_AddRef, ISupportErrorInfo_Release, ISupportErrorInfo_InterfaceSupportsErrorInfo, }; - + HRESULT hr = S_OK; TkWinSendCom *obj = NULL; - + /* * This had probably better always be globally visible memory so * we shall use the COM Task allocator. @@ -114,12 +114,12 @@ TkWinSendCom_CreateInstance(Tcl_Interp *interp, REFIID riid, void **ppv) obj->lpVtbl2 = &vtbl2; obj->refcount = 0; obj->interp = interp; - + /* lock the interp? Tcl_AddRef/Retain? */ - + hr = obj->lpVtbl->QueryInterface((IDispatch*)obj, riid, ppv); } - + return hr; } @@ -157,16 +157,17 @@ TkWinSendCom_Destroy(LPDISPATCH pdisp) */ static STDMETHODIMP -WinSendCom_QueryInterface(IDispatch *This, - REFIID riid, - void **ppvObject) +WinSendCom_QueryInterface( + IDispatch *This, + REFIID riid, + void **ppvObject) { HRESULT hr = E_NOINTERFACE; TkWinSendCom *this = (TkWinSendCom*)This; *ppvObject = NULL; if (memcmp(riid, &IID_IUnknown, sizeof(IID)) == 0 - || memcmp(riid, &IID_IDispatch, sizeof(IID)) == 0) { + || memcmp(riid, &IID_IDispatch, sizeof(IID)) == 0) { *ppvObject = (void**)this; this->lpVtbl->AddRef(This); hr = S_OK; @@ -208,8 +209,11 @@ WinSendCom_GetTypeInfoCount(IDispatch *This, UINT *pctinfo) } static STDMETHODIMP -WinSendCom_GetTypeInfo(IDispatch *This, UINT iTInfo, - LCID lcid, ITypeInfo **ppTI) +WinSendCom_GetTypeInfo( + IDispatch *This, + UINT iTInfo, + LCID lcid, + ITypeInfo **ppTI) { HRESULT hr = E_POINTER; if (ppTI) @@ -221,9 +225,12 @@ WinSendCom_GetTypeInfo(IDispatch *This, UINT iTInfo, } static STDMETHODIMP -WinSendCom_GetIDsOfNames(IDispatch *This, REFIID riid, +WinSendCom_GetIDsOfNames( + IDispatch *This, + REFIID riid, LPOLESTR *rgszNames, - UINT cNames, LCID lcid, + UINT cNames, + LCID lcid, DISPID *rgDispId) { HRESULT hr = E_POINTER; @@ -239,8 +246,12 @@ WinSendCom_GetIDsOfNames(IDispatch *This, REFIID riid, } static STDMETHODIMP -WinSendCom_Invoke(IDispatch *This, DISPID dispidMember, - REFIID riid, LCID lcid, WORD wFlags, +WinSendCom_Invoke( + IDispatch *This, + DISPID dispidMember, + REFIID riid, + LCID lcid, + WORD wFlags, DISPPARAMS *pDispParams, VARIANT *pvarResult, EXCEPINFO *pExcepInfo, @@ -248,31 +259,31 @@ WinSendCom_Invoke(IDispatch *This, DISPID dispidMember, { HRESULT hr = DISP_E_MEMBERNOTFOUND; TkWinSendCom *this = (TkWinSendCom*)This; - + switch (dispidMember) { - case TKWINSENDCOM_DISPID_SEND: - if (wFlags | DISPATCH_METHOD) - { - if (pDispParams->cArgs != 1) - hr = DISP_E_BADPARAMCOUNT; - else - hr = Send(this, pDispParams->rgvarg[0], - pvarResult, pExcepInfo, puArgErr); - } - break; - - case TKWINSENDCOM_DISPID_ASYNC: - if (wFlags | DISPATCH_METHOD) - { - if (pDispParams->cArgs != 1) - hr = DISP_E_BADPARAMCOUNT; - else - hr = Async(this, pDispParams->rgvarg[0], - pExcepInfo, puArgErr); - } - break; - + case TKWINSENDCOM_DISPID_SEND: + if (wFlags | DISPATCH_METHOD) + { + if (pDispParams->cArgs != 1) + hr = DISP_E_BADPARAMCOUNT; + else + hr = Send(this, pDispParams->rgvarg[0], + pvarResult, pExcepInfo, puArgErr); + } + break; + + case TKWINSENDCOM_DISPID_ASYNC: + if (wFlags | DISPATCH_METHOD) + { + if (pDispParams->cArgs != 1) + hr = DISP_E_BADPARAMCOUNT; + else + hr = Async(this, pDispParams->rgvarg[0], + pExcepInfo, puArgErr); + } + break; + } return hr; } @@ -314,7 +325,7 @@ static STDMETHODIMP ISupportErrorInfo_InterfaceSupportsErrorInfo(ISupportErrorInfo *This, REFIID riid) { - TkWinSendCom *this = (TkWinSendCom*)(This - 1); + /*TkWinSendCom *this = (TkWinSendCom*)(This - 1);*/ return S_OK; /* or S_FALSE */ } @@ -340,24 +351,24 @@ Async(TkWinSendCom* obj, VARIANT Cmd, EXCEPINFO *pExcepInfo, UINT *puArgErr) HRESULT hr = S_OK; int r = TCL_OK; VARIANT vCmd; - + VariantInit(&vCmd); - + hr = VariantChangeType(&vCmd, &Cmd, 0, VT_BSTR); if (FAILED(hr)) { Tcl_SetStringObj(Tcl_GetObjResult(obj->interp), - "invalid args: Async(command)", -1); + "invalid args: Async(command)", -1); SetExcepInfo(obj->interp, pExcepInfo); hr = DISP_E_EXCEPTION; } - - + + if (SUCCEEDED(hr)) { if (obj->interp) { Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal, - SysStringLen(vCmd.bstrVal)); + (int)SysStringLen(vCmd.bstrVal)); r = TkWinSend_QueueCommand(obj->interp, scriptPtr); } } @@ -393,7 +404,7 @@ Send(TkWinSendCom* obj, VARIANT vCmd, HRESULT hr = S_OK; int r = TCL_OK; VARIANT v; - + VariantInit(&v); hr = VariantChangeType(&v, &vCmd, 0, VT_BSTR); if (SUCCEEDED(hr)) @@ -401,10 +412,10 @@ Send(TkWinSendCom* obj, VARIANT vCmd, if (obj->interp) { Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(v.bstrVal, - SysStringLen(v.bstrVal)); + (int)SysStringLen(v.bstrVal)); r = Tcl_EvalObjEx(obj->interp, scriptPtr, - TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL); + TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL); if (pvResult) { VariantInit(pvResult); |