Moving towards event sinking

diff --git a/src/bind.c b/src/bind.c
index 72167ffae4c0793a1fbeb3106b7d4a514e7dfe00..23f1fb16ae854f8ea843549423c89c9f7489b200 100644 (file)
--- 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 b6171a71ebcfda2857829128725ae8e8c292e3c7..2776aa53fcbac0c02216922305dd70d03040fe21 100644 (file)
--- 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 76d861f065fffd8f86677585bed4edac6924c095..6bdb67b8392a9ca2299090e77a40b4357c51ead5 100644 (file)
--- 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 e76ad1a0d2ec4fa3671bfa2dadd0f82f35eb3805..4cee29d7eed6b2f966e32f8c274d87d2ea93c8c0 100644 (file)
--- 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 0de868841c2ba70bcd8468722198c8cf73d2534e..74f4300d9cbd667d72247af7eb1c293f31a1e229 100644 (file)
--- a/src/tclole.c
+++ b/src/tclole.c
@@ -161,6 +161,35 @@ RefEqualCmd(ClientData clientData, Tcl_Interp *interp,
     return TCL_OK;
 }
 \f
+/*
+ * 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;
+}
+\f
 /*
  * 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 6c3dc2792c2a18736ffbba49164892fd31a3a3fa..c117d396b011d545fb77b50e995eaa7891eeb263 100644 (file)
--- 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[]);