From: Pat Thoyts Date: Thu, 13 Dec 2007 00:10:59 +0000 (+0000) Subject: Moving towards event sinking X-Git-Tag: tclole-0-4~2 X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=bb554ed370c126983d81598a437686c6e66d1fd7;p=tclole Moving towards event sinking --- diff --git a/src/bind.c b/src/bind.c index 72167ff..23f1fb1 100644 --- a/src/bind.c +++ b/src/bind.c @@ -20,8 +20,6 @@ OleBindCmd(ClientData clientData, Tcl_Interp *interp, OleObjectData *dataPtr = NULL; IConnectionPointContainer *containerPtr = NULL; IConnectionPoint *connectionPtr = NULL; - IUnknown *sinkPtr = NULL; - DWORD cookie = 0; int r = TCL_OK; if (objc != 4) { @@ -52,13 +50,24 @@ OleBindCmd(ClientData clientData, Tcl_Interp *interp, hr = containerPtr->lpVtbl->FindConnectionPoint(containerPtr, &iid, &connectionPtr); if (SUCCEEDED(hr)) { - hr = connectionPtr->lpVtbl->Advise(connectionPtr, - sinkPtr, &cookie); + IUnknown *sinkPtr = NULL; + + /* create a Tcl sink instance */ + hr = Ole_CreateComInstance(interp, objv[2], + &IID_IUnknown, sinkPtr); if (SUCCEEDED(hr)) { - /* - * add the sink cookie into a list of sinks - * so we can unadvise at some point - */ + DWORD cookie = 0; + + hr = connectionPtr->lpVtbl->Advise(connectionPtr, + sinkPtr, &cookie); + if (SUCCEEDED(hr)) { + /* + * add the sink cookie into a list of sinks + * so we can unadvise at some point + */ + } + + sinkPtr->lpVtbl->Release(sinkPtr); } } dataPtr->typeinfoPtr->lpVtbl->ReleaseTypeAttr(dataPtr->typeinfoPtr, diff --git a/src/coimpl.c b/src/coimpl.c index b6171a7..2776aa5 100644 --- a/src/coimpl.c +++ b/src/coimpl.c @@ -15,6 +15,7 @@ typedef struct OleInterpCom { ISupportErrorInfoVtbl *lpVtbl2; long refcount; Tcl_Interp *interp; + Tcl_Obj *cmdObj; } OleInterpCom; static void OleInterpComDestroy(OleInterpCom *this); @@ -173,11 +174,14 @@ ISupportErrorInfo_InterfaceSupportsErrorInfo(ISupportErrorInfo *This, static void OleInterpComDestroy(OleInterpCom *this) { + Tcl_DecrRefCount(this->cmdObj); + Tcl_Release(this->interp); CoTaskMemFree(this); } HRESULT -Ole_CreateComInstance(Tcl_Interp *interp, REFIID riid, void **unkPtrPtr) +Ole_CreateComInstance(Tcl_Interp *interp, Tcl_Obj *cmdObj, + REFIID riid, void **unkPtrPtr) { static IDispatchVtbl vtbl = { OleInterpCom_QueryInterface, @@ -205,10 +209,13 @@ Ole_CreateComInstance(Tcl_Interp *interp, REFIID riid, void **unkPtrPtr) comPtr->lpVtbl2 = &vtbl2; comPtr->refcount = 0; comPtr->interp = interp; + comPtr->cmdObj = Tcl_DuplicateObj(cmdObj); + Tcl_IncrRefCount(comPtr->cmdObj); + Tcl_Preserve(comPtr->interp); hr = comPtr->lpVtbl->QueryInterface((IDispatch *)comPtr, riid, unkPtrPtr); if (FAILED(hr)) { - CoTaskMemFree(comPtr); + OleInterpComDestroy(comPtr); comPtr = NULL; } } diff --git a/src/invoke.c b/src/invoke.c index 76d861f..6bdb67b 100644 --- a/src/invoke.c +++ b/src/invoke.c @@ -117,8 +117,11 @@ OleVariantObj(Tcl_Interp *interp, const VARIANT *vPtr, Tcl_Obj **resultPtrPtr) *resultPtrPtr = Ole_NewOleObj(interp, V_DISPATCH(vPtr)); break; case VT_DISPATCH | VT_BYREF: - if (V_DISPATCHREF(vPtr) != NULL) + if (V_DISPATCHREF(vPtr)) { *resultPtrPtr = Ole_NewOleObj(interp, *V_DISPATCHREF(vPtr)); + } else { + *resultPtrPtr = Tcl_NewStringObj(NULL, 0); + } break; case VT_CY: case VT_DECIMAL: case VT_DATE: case VT_VARIANT: diff --git a/src/oleobj.c b/src/oleobj.c index e76ad1a..4cee29d 100644 --- a/src/oleobj.c +++ b/src/oleobj.c @@ -113,6 +113,10 @@ Ole_NewOleObj(Tcl_Interp *interp, IDispatch *dispPtr) int isnew = 0; char name[4 + TCL_INTEGER_SPACE]; + if (dispPtr == NULL) { + return Tcl_NewStringObj(NULL, 0); + } + pkgPtr = Tcl_GetAssocData(interp, "ole::package", NULL); entryPtr = Tcl_CreateHashEntry(&pkgPtr->table, (const char *)dispPtr, &isnew); diff --git a/src/tclole.c b/src/tclole.c index 0de8688..74f4300 100644 --- a/src/tclole.c +++ b/src/tclole.c @@ -161,6 +161,35 @@ RefEqualCmd(ClientData clientData, Tcl_Interp *interp, return TCL_OK; } +/* + * RefSelfCmd -- + * Return an COM object that has its IDispatch interface + * implemented by the given Tcl procedure. + */ +static int +RefSelfCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + HRESULT hr = S_OK; + IDispatch *dispPtr = NULL; + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "command"); + return TCL_ERROR; + } + + hr = Ole_CreateComInstance(interp, objv[2], + &IID_IDispatch, (void **)&dispPtr); + if (SUCCEEDED(hr)) { + Tcl_SetObjResult(interp, Ole_NewOleObj(interp, dispPtr)); + dispPtr->lpVtbl->Release(dispPtr); + } else { + Tcl_SetObjResult(interp, + Ole_Win32ErrorObj(interp, Tcl_GetString(objv[1]), hr)); + return TCL_ERROR; + } + return TCL_OK; +} + /* * RefCmd -- * ref command ensemble @@ -171,6 +200,7 @@ struct Ensemble RefEnsemble[] = { { "getactiveobject", RefGetActiveObjectCmd, NULL }, { "getobject", RefGetObjectCmd, NULL }, { "equal", RefEqualCmd, NULL }, + { "self", RefSelfCmd, NULL }, /* undocumented */ /*{ "count", RefCountCmd, NULL },*/ /*{ "querydispatch", RefQueryDispatch, NULL },*/ @@ -213,7 +243,6 @@ OlePackageDataDelete(ClientData clientData, Tcl_Interp *interp) OlePackageData *pkgPtr = clientData; Tcl_DeleteHashTable(&pkgPtr->table); if (pkgPtr->selfPtr) { - /* RevokeActiveObject(pkgPtr->activeid, NULL);*/ pkgPtr->selfPtr->lpVtbl->Release(pkgPtr->selfPtr); pkgPtr->selfPtr = NULL; } @@ -258,9 +287,6 @@ Ole_Init(Tcl_Interp *interp) tclTypes[tclCmdNameIndex] = Tcl_GetObjType("cmdName"); OleObjInit(interp); - Ole_CreateComInstance(interp, &IID_IDispatch, &pkgPtr->selfPtr); - /* RegisterActiveObject((IUnknown *)pkgPtr->selfPtr, &clsid, - ACTIVEOBJECT_WEAK, &pkgPtr->activeid); */ /* create commands */ Tcl_CreateObjCommand(interp, "ole::ref", RefCmd, NULL, NULL); diff --git a/src/tcloleInt.h b/src/tcloleInt.h index 6c3dc27..c117d39 100644 --- a/src/tcloleInt.h +++ b/src/tcloleInt.h @@ -90,7 +90,7 @@ int Ole_BackgroundEvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int flags); int OleForeachCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -HRESULT Ole_CreateComInstance(Tcl_Interp *interp, +HRESULT Ole_CreateComInstance(Tcl_Interp *interp, Tcl_Obj *cmdObj, REFIID riid, void **unkPtrPtr); int OleBindCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);