Support conversion of binary data and lists into arrays

diff --git a/src/invoke.c b/src/invoke.c
index 6bdb67b8392a9ca2299090e77a40b4357c51ead5..45d0ee842269a12d47a73700d2b3c8158400e97b 100644 (file)
--- a/src/invoke.c
+++ b/src/invoke.c
@@ -71,6 +71,10 @@ SafeArrayToObj(Tcl_Interp *interp,
     return hr;
 }
 
+/*
+ * Convert a VARIANT into a Tcl object
+ */
+
 HRESULT
 OleVariantObj(Tcl_Interp *interp, const VARIANT *vPtr, Tcl_Obj **resultPtrPtr)
 {
@@ -140,21 +144,89 @@ OleVariantObj(Tcl_Interp *interp, const VARIANT *vPtr, Tcl_Obj **resultPtrPtr)
     return hr;
 }
 
+/*
+ * Convert a Tcl object into a VARIANT.
+ * NOTE: needs better error handling.
+ */
+
+HRESULT
+OleTclToVariant(Tcl_Obj *objPtr, VARIANT *argPtr)
+{
+    HRESULT hr = S_FALSE;
+    VariantInit(argPtr);
+    if (objPtr->typePtr != NULL) {
+       if (objPtr->typePtr == tclTypes[tclBooleanIndex]) {
+           int b;
+           Tcl_GetBooleanFromObj(NULL, objPtr, &b);
+           argPtr->boolVal = (b ? VARIANT_TRUE : VARIANT_FALSE);
+           argPtr->vt = VT_BOOL;
+       } else if (objPtr->typePtr == tclTypes[tclIntegerIndex]) {
+           Tcl_GetLongFromObj(NULL, objPtr, &argPtr->lVal);
+           argPtr->vt = VT_I4;
+       } else if (objPtr->typePtr == tclTypes[tclDoubleIndex]) {
+           Tcl_GetDoubleFromObj(NULL, objPtr, &argPtr->dblVal);
+           argPtr->vt = VT_R8;
+       } else if (objPtr->typePtr == tclTypes[tclByteArrayIndex]) {
+           int count = 0;
+           unsigned char *bytesPtr, *arrayPtr;
+           bytesPtr = Tcl_GetByteArrayFromObj(objPtr, &count);
+           argPtr->parray = SafeArrayCreateVectorEx(VT_UI1, 0, count, NULL);
+           SafeArrayAccessData(argPtr->parray, (void **)&arrayPtr);
+           memcpy(arrayPtr, bytesPtr, count);
+           SafeArrayUnaccessData(argPtr->parray);
+           argPtr->vt = VT_ARRAY | VT_UI1;
+       } else if (objPtr->typePtr == tclTypes[tclListIndex]) {
+           int count = 0, n = 0;
+           Tcl_Obj **eltv = NULL;
+           VARIANT *varPtr = NULL;
+           Tcl_ListObjGetElements(NULL, objPtr, &count, &eltv);
+           argPtr->parray = SafeArrayCreateVectorEx(VT_VARIANT, 0, count, NULL);
+           SafeArrayAccessData(argPtr->parray, (void **)&varPtr);
+           for (n = 0; n < count; ++n, ++varPtr) {
+               OleTclToVariant(eltv[n], varPtr);
+           }
+           SafeArrayUnaccessData(argPtr->parray);
+           argPtr->vt = VT_ARRAY | VT_VARIANT;
+       } else if (objPtr->typePtr == &tclVariantType) {
+           VariantCopy(argPtr, GET_VARIANTREP(objPtr));
+           argPtr->vt = VT_VARIANT;
+       } else if (objPtr->typePtr == tclTypes[tclCmdNameIndex]) {
+           OleObjectData *dataPtr = GET_OLEREP(objPtr);
+           if (dataPtr && dataPtr->magic == OLEDATAMAGIC) {
+               argPtr->pdispVal = dataPtr->dispatchPtr;
+               argPtr->pdispVal->lpVtbl->AddRef(argPtr->pdispVal);
+               argPtr->vt = VT_DISPATCH;
+           }
+       }
+    }
+    if (argPtr->vt == VT_EMPTY) {
+       LPOLESTR olestr = NULL;
+       Tcl_DString ds;
+       int len = 0, len_ucs = 0;
+       const char *str = Tcl_GetStringFromObj(objPtr, &len);
+       Tcl_DStringInit(&ds);
+       Tcl_UtfToUniCharDString(str, len, &ds);
+       len_ucs = Tcl_UniCharLen((const Tcl_UniChar *)Tcl_DStringValue(&ds));
+       olestr = (LPOLESTR)Tcl_DStringValue(&ds);
+       argPtr->bstrVal = SysAllocStringLen(olestr, len_ucs);
+       argPtr->vt = VT_BSTR;
+       Tcl_DStringFree(&ds);
+    }
+    return hr;
+}
+
 static DISPPARAMS *
 OleDispParamsCreate(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
 {
-    OlePackageData *pkgPtr = NULL;
-    DISPPARAMS * dp = NULL;
-    int cn = 0;
-
-    pkgPtr = Tcl_GetAssocData(interp, "ole::package", NULL);
-    
-    dp = (DISPPARAMS*)ckalloc(sizeof(DISPPARAMS));
+    DISPPARAMS *dp = (DISPPARAMS*)ckalloc(sizeof(DISPPARAMS));
     if (dp != NULL) {
+       int cn = 0;
+
         dp->cArgs = objc;
         dp->cNamedArgs = 0;
         dp->rgdispidNamedArgs = NULL;
         dp->rgvarg = NULL;
+
         if (objc > 0) {
             dp->rgvarg = (VARIANT*)ckalloc(sizeof(VARIANT) * dp->cArgs);
        }
@@ -162,47 +234,9 @@ OleDispParamsCreate(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
         /* Note: this array is filled backwards */
         for (cn = 0; cn < objc; cn++) {
            Tcl_Obj *objPtr = objv[objc - cn - 1];
-           Tcl_ObjType *typePtr = NULL;
            VARIANT *argPtr = &dp->rgvarg[cn];
 
-            VariantInit(argPtr);
-           if (objPtr->typePtr != NULL) {
-               if (objPtr->typePtr == tclTypes[tclBooleanIndex]) {
-                   int b;
-                   Tcl_GetBooleanFromObj(NULL, objPtr, &b);
-                   argPtr->boolVal = (b ? VARIANT_TRUE : VARIANT_FALSE);
-                   argPtr->vt = VT_BOOL;
-               } else if (objPtr->typePtr == tclTypes[tclIntegerIndex]) {
-                   Tcl_GetLongFromObj(NULL, objPtr, &argPtr->lVal);
-                   argPtr->vt = VT_I4;
-               } else if (objPtr->typePtr == tclTypes[tclDoubleIndex]) {
-                   Tcl_GetDoubleFromObj(NULL, objPtr, &argPtr->dblVal);
-                   argPtr->vt = VT_R8;
-               } else if (objPtr->typePtr == &tclVariantType) {
-                   VariantCopy(argPtr, GET_VARIANTREP(objPtr));
-                   argPtr->vt = VT_VARIANT;
-               } else if (objPtr->typePtr == tclTypes[tclCmdNameIndex]) {
-                   OleObjectData *dataPtr = GET_OLEREP(objPtr);
-                   if (dataPtr && dataPtr->magic == OLEDATAMAGIC) {
-                       argPtr->pdispVal = dataPtr->dispatchPtr;
-                       argPtr->pdispVal->lpVtbl->AddRef(argPtr->pdispVal);
-                       argPtr->vt = VT_DISPATCH;
-                   }
-               }
-           }
-           if (argPtr->vt == VT_EMPTY) {
-               LPOLESTR olestr = NULL;
-               Tcl_DString ds;
-               int len = 0, len_ucs = 0;
-               const char *str = Tcl_GetStringFromObj(objPtr, &len);
-               Tcl_DStringInit(&ds);
-               Tcl_UtfToUniCharDString(str, len, &ds);
-               len_ucs = Tcl_UniCharLen((const Tcl_UniChar *)Tcl_DStringValue(&ds));
-               olestr = (LPOLESTR)Tcl_DStringValue(&ds);
-               argPtr->bstrVal = SysAllocStringLen(olestr, len_ucs);
-               argPtr->vt = VT_BSTR;
-               Tcl_DStringFree(&ds);
-           }
+           OleTclToVariant(objPtr, argPtr);
         }
     }
     return dp;