diff --git a/src/mysterx/array.cxx b/src/mysterx/array.cxx
index 39b589dc5b..29f1ebe3bf 100644
--- a/src/mysterx/array.cxx
+++ b/src/mysterx/array.cxx
@@ -22,16 +22,14 @@
#include "mysterx.h"
Scheme_Object *safeArrayElementToSchemeObject(SAFEARRAY *theArray,
- long *allIndices) {
+ long *allIndices) {
HRESULT hr;
VARTYPE vt;
char errBuff[128];
hr = SafeArrayGetVartype(theArray,&vt);
- if (hr != S_OK) {
- codedComError("Can't get array type",hr);
- }
+ if (hr != S_OK) codedComError("Can't get array type",hr);
switch(vt) {
@@ -136,9 +134,9 @@ Scheme_Object *safeArrayElementToSchemeObject(SAFEARRAY *theArray,
return variantToSchemeObject(&variant);
default :
-
sprintf(errBuff,
- "Can't make Scheme value from array element with type 0x%X",vt);
+ "Can't make Scheme value from array element with type 0x%X",
+ vt);
scheme_signal_error(errBuff);
}
@@ -146,8 +144,11 @@ Scheme_Object *safeArrayElementToSchemeObject(SAFEARRAY *theArray,
return NULL;
}
-Scheme_Object *buildVectorFromArray(SAFEARRAY *theArray,long currDim,
- long *allIndices,long *currNdx, long offset) {
+Scheme_Object *buildVectorFromArray(SAFEARRAY *theArray,
+ long currDim,
+ long *allIndices,
+ long *currNdx,
+ long offset) {
Scheme_Object *vec, *v;
long low,high,vecSize;
long i,j;
@@ -161,8 +162,8 @@ Scheme_Object *buildVectorFromArray(SAFEARRAY *theArray,long currDim,
if (currDim > 1) {
for (i = 0,j = low; i < vecSize; i++,j++) {
currNdx[offset] = j;
- v = buildVectorFromArray(theArray,currDim - 1,
- allIndices,currNdx, offset - 1);
+ v = buildVectorFromArray(theArray, currDim - 1,
+ allIndices, currNdx, offset - 1);
SCHEME_VEC_ELS(vec)[i] = v;
}
}
@@ -183,12 +184,9 @@ Scheme_Object *safeArrayToSchemeVector(SAFEARRAY *theArray) {
Scheme_Object *retval;
numDims = SafeArrayGetDim(theArray);
-
indices = (long *)scheme_malloc_atomic(numDims * sizeof(long));
-
retval = buildVectorFromArray(theArray,numDims,
- indices,indices, numDims - 1);
-
+ indices, indices, numDims - 1);
return retval;
}
@@ -208,7 +206,7 @@ int getSchemeVectorDims(Scheme_Object *vec) {
}
void setArrayEltCounts(Scheme_Object *vec,
- SAFEARRAYBOUND *rayBounds,long numDims) {
+ SAFEARRAYBOUND *rayBounds,long numDims) {
Scheme_Object *currObj;
long i;
@@ -227,9 +225,7 @@ BOOL isRegularVector(Scheme_Object *vec) {
int len,currLen,zeroLen;
int i;
- if (SCHEME_VECTORP(vec) == FALSE) {
- return TRUE;
- }
+ if (SCHEME_VECTORP(vec) == FALSE) return TRUE;
len = SCHEME_VEC_SIZE(vec);
elts = SCHEME_VEC_ELS(vec);
@@ -239,33 +235,18 @@ BOOL isRegularVector(Scheme_Object *vec) {
elt = elts[0];
zeroIsVec = SCHEME_VECTORP(elt);
- if (zeroIsVec) {
- zeroLen = SCHEME_VEC_SIZE(elt);
- }
+ if (zeroIsVec) zeroLen = SCHEME_VEC_SIZE(elt);
- if (isRegularVector(elt) == FALSE) {
- return FALSE;
- }
+ if (isRegularVector(elt) == FALSE) return FALSE;
for (i = 1; i < len; i++) {
elt = elts[i];
-
isVec = SCHEME_VECTORP(elt);
-
- if (isVec != zeroIsVec) {
- return FALSE;
- }
-
+ if (isVec != zeroIsVec) return FALSE;
if (isVec) {
currLen = SCHEME_VEC_SIZE(elt);
-
- if (currLen != zeroLen) {
- return FALSE;
- }
-
- if (isRegularVector(elt) == FALSE) {
- return FALSE;
- }
+ if (currLen != zeroLen) return FALSE;
+ if (isRegularVector(elt) == FALSE) return FALSE;
}
}
@@ -278,143 +259,62 @@ void* variantDataPointer(VARTYPE vt,VARIANTARG *pVariantArg)
char errBuff[256];
switch (vt) {
-
- case VT_NULL :
- return NULL;
-
- case VT_I1 :
- return &pVariantArg->cVal;
-
- case VT_I1 | VT_BYREF :
- return &pVariantArg->pcVal;
-
- case VT_UI1 :
- return &pVariantArg->bVal;
-
- case VT_UI1 | VT_BYREF :
- return &pVariantArg->pbVal;
-
- case VT_I2 :
- return &(pVariantArg->iVal);
-
- case VT_I2 | VT_BYREF :
- return &pVariantArg->piVal;
-
- case VT_UI2 :
- return &pVariantArg->uiVal;
-
- case VT_UI2 | VT_BYREF :
- return &pVariantArg->puiVal;
-
- case VT_I4 :
- return &pVariantArg->lVal;
-
- case VT_I4 | VT_BYREF :
- return &pVariantArg->plVal;
-
- case VT_UI4 :
- return &pVariantArg->ulVal;
-
- case VT_UI4 | VT_BYREF :
- return &pVariantArg->pulVal;
-
- case VT_INT :
- return &pVariantArg->intVal;
-
- case VT_INT | VT_BYREF :
- return &pVariantArg->pintVal;
-
- case VT_UINT :
- return &pVariantArg->uintVal;
-
- case VT_UINT | VT_BYREF :
- return &pVariantArg->puintVal;
-
- // VT_USERDEFINED in the typeDesc indicates an ENUM,
- // but VT_USERDEFINED is illegal to use in the DISPPARAMS.
- // The right thing to do is pass it as an INT. Note that
- // we have to bash out the variant tag.
- // ** NOTE THAT VT_USERDEFINED | VT_BYREF IS NOT
- // ** A REFERENCE TO AN INT
- case VT_USERDEFINED:
- return &pVariantArg->vt;
-
- case VT_R4 :
- return &pVariantArg->fltVal;
-
- case VT_R4 | VT_BYREF :
- return &pVariantArg->pfltVal;
-
- case VT_R8 :
- return &pVariantArg->dblVal;
-
- case VT_R8 | VT_BYREF :
- return &pVariantArg->pdblVal;
-
- case VT_BSTR :
- return &pVariantArg->bstrVal;
-
- case VT_BSTR | VT_BYREF :
- return &pVariantArg->pbstrVal;
-
- case VT_CY :
- return &pVariantArg->cyVal;
-
- case VT_CY | VT_BYREF :
- return &pVariantArg->pcyVal;
-
- case VT_DATE :
- return &pVariantArg->date;
-
- case VT_DATE | VT_BYREF :
- return &pVariantArg->pdate;
-
- case VT_BOOL :
- return &pVariantArg->boolVal;
-
- case VT_BOOL | VT_BYREF :
- return &pVariantArg->pboolVal;
-
- case VT_ERROR :
- return &pVariantArg->scode;
-
- case VT_ERROR | VT_BYREF :
- return &pVariantArg->pscode;
-
- case VT_DISPATCH :
- return &pVariantArg->pdispVal;
-
- case VT_DISPATCH | VT_BYREF :
- return &pVariantArg->ppdispVal;
-
- // VT_USERDEFINED | VT_BYREF indicates that we should pass
- // the IUnknown pointer of a COM object.
- // VT_USERDEFINED | VT_BYREF is illegal in the DISPPARAMS, so
- // we bash it out to VT_UNKNOWN.
-
- case VT_USERDEFINED | VT_BYREF :
- return &pVariantArg->punkVal;
-
- case VT_VARIANT | VT_BYREF :
- return &pVariantArg->pvarVal;
-
- case VT_UNKNOWN :
- return &pVariantArg->punkVal;
-
- case VT_UNKNOWN | VT_BYREF :
- return &pVariantArg->ppunkVal;
-
- case VT_VARIANT :
- return pVariantArg;
-
- case VT_PTR:
- scheme_signal_error ("unable to marshal VT_PTR");
+ case VT_NULL : return NULL;
+ case VT_I1 : return &pVariantArg->cVal;
+ case VT_I1 | VT_BYREF : return &pVariantArg->pcVal;
+ case VT_UI1 : return &pVariantArg->bVal;
+ case VT_UI1 | VT_BYREF : return &pVariantArg->pbVal;
+ case VT_I2 : return &(pVariantArg->iVal);
+ case VT_I2 | VT_BYREF : return &pVariantArg->piVal;
+ case VT_UI2 : return &pVariantArg->uiVal;
+ case VT_UI2 | VT_BYREF : return &pVariantArg->puiVal;
+ case VT_I4 : return &pVariantArg->lVal;
+ case VT_I4 | VT_BYREF : return &pVariantArg->plVal;
+ case VT_UI4 : return &pVariantArg->ulVal;
+ case VT_UI4 | VT_BYREF : return &pVariantArg->pulVal;
+ case VT_INT : return &pVariantArg->intVal;
+ case VT_INT | VT_BYREF : return &pVariantArg->pintVal;
+ case VT_UINT : return &pVariantArg->uintVal;
+ case VT_UINT | VT_BYREF : return &pVariantArg->puintVal;
+ // VT_USERDEFINED in the typeDesc indicates an ENUM, but
+ // VT_USERDEFINED is illegal to use in the DISPPARAMS. The right
+ // thing to do is pass it as an INT. Note that we have to bash out
+ // the variant tag.
+ // ** NOTE THAT VT_USERDEFINED | VT_BYREF IS NOT
+ // ** A REFERENCE TO AN INT
+ case VT_USERDEFINED : return &pVariantArg->vt;
+ case VT_R4 : return &pVariantArg->fltVal;
+ case VT_R4 | VT_BYREF : return &pVariantArg->pfltVal;
+ case VT_R8 : return &pVariantArg->dblVal;
+ case VT_R8 | VT_BYREF : return &pVariantArg->pdblVal;
+ case VT_BSTR : return &pVariantArg->bstrVal;
+ case VT_BSTR | VT_BYREF : return &pVariantArg->pbstrVal;
+ case VT_CY : return &pVariantArg->cyVal;
+ case VT_CY | VT_BYREF : return &pVariantArg->pcyVal;
+ case VT_DATE : return &pVariantArg->date;
+ case VT_DATE | VT_BYREF : return &pVariantArg->pdate;
+ case VT_BOOL : return &pVariantArg->boolVal;
+ case VT_BOOL | VT_BYREF : return &pVariantArg->pboolVal;
+ case VT_ERROR : return &pVariantArg->scode;
+ case VT_ERROR | VT_BYREF : return &pVariantArg->pscode;
+ case VT_DISPATCH : return &pVariantArg->pdispVal;
+ case VT_DISPATCH | VT_BYREF : return &pVariantArg->ppdispVal;
+ // VT_USERDEFINED | VT_BYREF indicates that we should pass the
+ // IUnknown pointer of a COM object.
+ // VT_USERDEFINED | VT_BYREF is illegal in the DISPPARAMS, so we
+ // bash it out to VT_UNKNOWN.
+ case VT_USERDEFINED | VT_BYREF : return &pVariantArg->punkVal;
+ case VT_VARIANT | VT_BYREF : return &pVariantArg->pvarVal;
+ case VT_UNKNOWN : return &pVariantArg->punkVal;
+ case VT_UNKNOWN | VT_BYREF : return &pVariantArg->ppunkVal;
+ case VT_VARIANT : return pVariantArg;
+ case VT_PTR :
+ scheme_signal_error("unable to marshal VT_PTR");
break;
-
default :
- sprintf (errBuff, "Unable to marshal Scheme value into VARIANT: 0x%X",
- pVariantArg->vt);
- scheme_signal_error (errBuff);
+ sprintf(errBuff, "Unable to marshal Scheme value into VARIANT: 0x%X",
+ pVariantArg->vt);
+ scheme_signal_error(errBuff);
}
// Make the compiler happy
@@ -423,59 +323,30 @@ void* variantDataPointer(VARTYPE vt,VARIANTARG *pVariantArg)
VARTYPE schemeValueToCOMType(Scheme_Object* val)
{
- if (SCHEME_CHARP (val))
- return VT_UI1;
-
- else if (SCHEME_EXACT_INTEGERP (val))
- return VT_I4;
-
+ if (SCHEME_CHARP(val)) return VT_UI1;
+ else if (SCHEME_EXACT_INTEGERP(val)) return VT_I4;
#ifdef MZ_USE_SINGLE_FLOATS
- else if (SCHEME_FLTP (val))
- return VT_R4;
+ else if (SCHEME_FLTP(val)) return VT_R4;
#endif
-
- else if (SCHEME_DBLP (val))
- return VT_R8;
-
- else if (SCHEME_STRSYMP (val))
- return VT_BSTR;
-
- else if (MX_CYP (val))
- return VT_CY;
-
- else if (MX_DATEP (val))
- return VT_DATE;
-
- else if (val == scheme_false)
- return VT_BOOL;
-
- else if (val == scheme_true)
- return VT_BOOL;
-
- else if (MX_SCODEP (val))
- return VT_ERROR;
-
- else if (MX_COM_OBJP (val))
- return VT_DISPATCH;
-
- else if (MX_IUNKNOWNP (val))
- return VT_UNKNOWN;
-
- else if (SCHEME_VECTORP (val))
- getSchemeVectorType(val);
-
- else if (scheme_apply (mx_marshal_raw_scheme_objects, 0, NULL) == scheme_false)
- scheme_signal_error ("Unable to inject Scheme value %V into VARIANT", val);
-
- else
- return VT_INT;
-
- return VT_VARIANT; // If all else fails.
+ else if (SCHEME_DBLP(val)) return VT_R8;
+ else if (SCHEME_STRSYMP(val)) return VT_BSTR;
+ else if (MX_CYP(val)) return VT_CY;
+ else if (MX_DATEP(val)) return VT_DATE;
+ else if (val == scheme_false) return VT_BOOL;
+ else if (val == scheme_true) return VT_BOOL;
+ else if (MX_SCODEP(val)) return VT_ERROR;
+ else if (MX_COM_OBJP(val)) return VT_DISPATCH;
+ else if (MX_IUNKNOWNP(val)) return VT_UNKNOWN;
+ else if (SCHEME_VECTORP(val)) getSchemeVectorType(val);
+ else if (scheme_apply(mx_marshal_raw_scheme_objects, 0, NULL) == scheme_false)
+ scheme_signal_error("Unable to inject Scheme value %V into VARIANT", val);
+ else return VT_INT;
+ return VT_VARIANT; // If all else fails. (Eli: Looks like this is redundant)
}
-void doSetArrayElts(Scheme_Object *vec,VARTYPE elementType,SAFEARRAY *theArray,
- long *allIndices,long *currNdx, long offset) {
+void doSetArrayElts(Scheme_Object *vec, VARTYPE elementType, SAFEARRAY *theArray,
+ long *allIndices, long *currNdx, long offset) {
VARIANT variant;
Scheme_Object *elt;
int len;
@@ -487,46 +358,50 @@ void doSetArrayElts(Scheme_Object *vec,VARTYPE elementType,SAFEARRAY *theArray,
for (i = 0; i < len; i++) {
elt = SCHEME_VEC_ELS(vec)[i];
currNdx[offset] = i;
- doSetArrayElts(elt,elementType,theArray,allIndices,currNdx, offset - 1);
+ doSetArrayElts(elt, elementType, theArray, allIndices,
+ currNdx, offset - 1);
}
- }
- else {
+ } else {
for (i = 0; i < len; i++) {
elt = SCHEME_VEC_ELS(vec)[i];
currNdx[offset] = i;
marshalSchemeValueToVariant(elt,&variant);
- // I don't think this will ever happen (at least when calling this function from the scheme side).
+ // I don't think this will ever happen (at least when calling
+ // this function from the scheme side).
if (variant.vt != elementType) {
char errBuff[100];
- sprintf (errBuff, "Unable to put an element of COM type 0x%x into an array of COM type 0x%x", variant.vt, elementType);
- scheme_signal_error (errBuff);
+ sprintf(errBuff,
+ "Unable to put an element of COM type 0x%x into an array of COM type 0x%x",
+ variant.vt, elementType);
+ scheme_signal_error(errBuff);
}
- SafeArrayPutElement(theArray,allIndices,variantDataPointer(elementType,&variant));
+ SafeArrayPutElement(theArray, allIndices,
+ variantDataPointer(elementType,&variant));
}
}
}
-void setArrayElts(Scheme_Object *vec,VARTYPE elementType,SAFEARRAY *theArray,long numDims) {
+void setArrayElts(Scheme_Object *vec, VARTYPE elementType, SAFEARRAY *theArray,
+ long numDims) {
long indices[MAXARRAYDIMS];
memset(indices,0,sizeof(indices));
-
doSetArrayElts(vec,elementType,theArray,indices,indices, numDims - 1);
}
-// This doesn't work if we have an integer in a double array (or want a double array but have an integer vector).
-// But it should work if we have doubles and integers (and return a VT_R8 array). Try to subtype it.
+// This doesn't work if we have an integer in a double array (or want
+// a double array but have an integer vector). But it should work if
+// we have doubles and integers (and return a VT_R8 array). Try to
+// subtype it.
VARTYPE getSchemeVectorType(Scheme_Object *vec) {
VARTYPE type;
int i, size = SCHEME_VEC_SIZE(vec);
type = schemeValueToCOMType(SCHEME_VEC_ELS(vec)[0]);
if (VT_VARIANT == type) return type;
-
for (i = 1; i < size; ++i)
if (type != schemeValueToCOMType(SCHEME_VEC_ELS(vec)[i]))
return VT_VARIANT;
-
return type;
}
@@ -536,36 +411,20 @@ SAFEARRAY *schemeVectorToSafeArray(Scheme_Object *vec, VARTYPE *vt) {
int numDims;
int i;
- if (SCHEME_VECTORP(vec) == FALSE) {
+ if (SCHEME_VECTORP(vec) == FALSE)
scheme_signal_error("Can't convert non-vector to SAFEARRAY");
- }
-
- if (isRegularVector(vec) == FALSE) {
+ if (isRegularVector(vec) == FALSE)
scheme_signal_error("Can't convert irregular vector to SAFEARRAY");
- }
-
numDims = getSchemeVectorDims(vec);
-
- if (numDims > MAXARRAYDIMS) {
+ if (numDims > MAXARRAYDIMS)
scheme_signal_error("Too many array dimensions");
- }
-
rayBounds = (SAFEARRAYBOUND *)malloc(numDims * sizeof(SAFEARRAYBOUND));
-
- for (i = 0; i < numDims; i++) {
- rayBounds[i].lLbound = 0L;
- }
-
+ for (i = 0; i < numDims; i++) rayBounds[i].lLbound = 0L;
setArrayEltCounts(vec,rayBounds,numDims);
-
*vt = getSchemeVectorType(vec);
-
theArray = SafeArrayCreate(*vt,numDims,rayBounds);
-
setArrayElts(vec,*vt,theArray,numDims);
-
return theArray;
-
}
#endif // MYSTERX_3M
diff --git a/src/mysterx/mysterx.cxx b/src/mysterx/mysterx.cxx
index f5bbb9be22..cdd45133a0 100644
--- a/src/mysterx/mysterx.cxx
+++ b/src/mysterx/mysterx.cxx
@@ -84,8 +84,9 @@ Scheme_Object *scheme_date_type;
MYSSINK_TABLE myssink_table;
-static char *objectAttributes[] = { "InprocServer", "InprocServer32",
- "LocalServer", "LocalServer32", NULL };
+static char *objectAttributes[] = {
+ "InprocServer", "InprocServer32", "LocalServer", "LocalServer32",
+ NULL };
static char *controlAttributes[] = { "Control", NULL };
static MX_PRIM mxPrims[] = {
@@ -404,15 +405,16 @@ static MX_PRIM mxPrims[] = {
};
#if !defined(SCHEME_NONNEGATIVE)
-#define SCHEME_NONNEGATIVE(thing) (SCHEME_INTP (thing) && SCHEME_INT_VAL (thing) >= 0)
+#define SCHEME_NONNEGATIVE(thing) \
+ (SCHEME_INTP(thing) && SCHEME_INT_VAL(thing) >= 0)
#endif
-BOOL isEmptyClsId (CLSID clsId)
+BOOL isEmptyClsId(CLSID clsId)
{
- return memcmp (&clsId, &emptyClsId, sizeof (CLSID)) == 0;
+ return memcmp(&clsId, &emptyClsId, sizeof(CLSID)) == 0;
}
-void scheme_release_typedesc (void *p, void *)
+void scheme_release_typedesc(void *p, void *)
{
MX_TYPEDESC *pTypeDesc;
ITypeInfo *pITypeInfo, *pITypeInfoImpl;
@@ -423,7 +425,7 @@ void scheme_release_typedesc (void *p, void *)
pTypeDesc = (MX_TYPEDESC *)p;
- if (MX_MANAGED_OBJ_RELEASED (pTypeDesc)) {
+ if (MX_MANAGED_OBJ_RELEASED(pTypeDesc)) {
return;
}
@@ -432,13 +434,13 @@ void scheme_release_typedesc (void *p, void *)
pInterface = pTypeDesc->pInterface;
if (pTypeDesc->descKind == funcDesc) {
- pITypeInfo->ReleaseFuncDesc (pTypeDesc->funcdescs.pFuncDesc);
+ pITypeInfo->ReleaseFuncDesc(pTypeDesc->funcdescs.pFuncDesc);
if (pITypeInfoImpl) {
- pITypeInfoImpl->ReleaseFuncDesc (pTypeDesc->funcdescs.pFuncDescImpl);
+ pITypeInfoImpl->ReleaseFuncDesc(pTypeDesc->funcdescs.pFuncDescImpl);
}
}
else if (pTypeDesc->descKind == varDesc) {
- pITypeInfo->ReleaseVarDesc (pTypeDesc->pVarDesc);
+ pITypeInfo->ReleaseVarDesc(pTypeDesc->pVarDesc);
}
pITypeInfo->Release();
@@ -450,10 +452,10 @@ void scheme_release_typedesc (void *p, void *)
pInterface->Release();
}
- MX_MANAGED_OBJ_RELEASED (pTypeDesc) = TRUE;
+ MX_MANAGED_OBJ_RELEASED(pTypeDesc) = TRUE;
}
-void scheme_release_com_object (void *comObject, void *pIDispatch)
+void scheme_release_com_object(void *comObject, void *pIDispatch)
{
ITypeInfo *pITypeInfo;
ITypeInfo *pEventTypeInfo;
@@ -462,9 +464,7 @@ void scheme_release_com_object (void *comObject, void *pIDispatch)
MX_COM_Object *obj = (MX_COM_Object *)comObject;
MX_TYPE_TBL_ENTRY *p;
- if (MX_MANAGED_OBJ_RELEASED (comObject)) {
- return;
- }
+ if (MX_MANAGED_OBJ_RELEASED(comObject)) return;
/* Release typedescs first, because they seem to become
invalid after the object is released. */
@@ -484,154 +484,121 @@ void scheme_release_com_object (void *comObject, void *pIDispatch)
// when COM object GC'd, release associated interfaces
- pITypeInfo = MX_COM_OBJ_TYPEINFO (comObject);
+ pITypeInfo = MX_COM_OBJ_TYPEINFO(comObject);
- pEventTypeInfo = MX_COM_OBJ_EVENTTYPEINFO (comObject);
- pIConnectionPoint = MX_COM_OBJ_CONNECTIONPOINT (comObject);
- pISink = MX_COM_OBJ_EVENTSINK (comObject);
+ pEventTypeInfo = MX_COM_OBJ_EVENTTYPEINFO(comObject);
+ pIConnectionPoint = MX_COM_OBJ_CONNECTIONPOINT(comObject);
+ pISink = MX_COM_OBJ_EVENTSINK(comObject);
- if (pITypeInfo) {
- pITypeInfo->Release();
- }
+ if (pITypeInfo) pITypeInfo->Release();
+ if (pEventTypeInfo) pEventTypeInfo->Release();
+ if (pIConnectionPoint) pIConnectionPoint->Release();
+ if (pISink) pISink->Release();
+ if (pIDispatch) ((IDispatch *)pIDispatch)->Release();
- if (pEventTypeInfo) {
- pEventTypeInfo->Release();
- }
-
- if (pIConnectionPoint) {
- pIConnectionPoint->Release();
- }
-
- if (pISink) {
- pISink->Release();
- }
-
- if (pIDispatch) {
- ((IDispatch *)pIDispatch)->Release();
- }
-
- MX_MANAGED_OBJ_RELEASED (comObject) = TRUE;
+ MX_MANAGED_OBJ_RELEASED(comObject) = TRUE;
}
-void mx_register_object (Scheme_Object *obj, IUnknown *pIUnknown,
- void (*release_fun) (void *p, void *data))
+void mx_register_object(Scheme_Object *obj, IUnknown *pIUnknown,
+ void (*release_fun)(void *p, void *data))
{
Scheme_Object *cust;
- if (pIUnknown == NULL) {
- // nothing to do
- return;
- }
+ if (pIUnknown == NULL) return; // nothing to do
- // scheme_register_finalizer (obj, release_fun, pIUnknown, NULL, NULL);
+ // scheme_register_finalizer(obj, release_fun, pIUnknown, NULL, NULL);
- cust = scheme_get_param (scheme_current_config(),
- MZCONFIG_CUSTODIAN);
- scheme_add_managed ((Scheme_Custodian *)cust,
- (Scheme_Object *)obj,
- (Scheme_Close_Custodian_Client *)release_fun,
- pIUnknown, 1);
+ cust = scheme_get_param(scheme_current_config(), MZCONFIG_CUSTODIAN);
+ scheme_add_managed((Scheme_Custodian *)cust,
+ (Scheme_Object *)obj,
+ (Scheme_Close_Custodian_Client *)release_fun,
+ pIUnknown, 1);
}
-Scheme_Object *mx_com_add_ref (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_add_ref(int argc, Scheme_Object **argv)
{
IDispatch *pIDispatch;
Scheme_Object *v;
- v = GUARANTEE_COM_OBJ ("com-add-ref", 0);
- pIDispatch = MX_COM_OBJ_VAL (v);
+ v = GUARANTEE_COM_OBJ("com-add-ref", 0);
+ pIDispatch = MX_COM_OBJ_VAL(v);
pIDispatch->AddRef();
return scheme_void;
}
-Scheme_Object *mx_com_ref_count (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_ref_count(int argc, Scheme_Object **argv)
{
IDispatch *pIDispatch;
unsigned long n;
Scheme_Object *v;
- v = GUARANTEE_COM_OBJ ("com-ref-count", 0);
- pIDispatch = MX_COM_OBJ_VAL (v);
+ v = GUARANTEE_COM_OBJ("com-ref-count", 0);
+ pIDispatch = MX_COM_OBJ_VAL(v);
n = pIDispatch->AddRef();
n--;
pIDispatch->Release();
- return scheme_make_integer_value_from_unsigned (n);
+ return scheme_make_integer_value_from_unsigned(n);
}
-void mx_register_com_object (Scheme_Object *obj, IDispatch *pIDispatch)
+void mx_register_com_object(Scheme_Object *obj, IDispatch *pIDispatch)
{
- mx_register_object (obj, pIDispatch, scheme_release_com_object);
+ mx_register_object(obj, pIDispatch, scheme_release_com_object);
}
-Scheme_Object *mx_com_register_object (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_register_object(int argc, Scheme_Object **argv)
{
- GUARANTEE_COM_OBJ ("com-register-com-object", 0);
-
- mx_register_com_object (argv[0], MX_COM_OBJ_VAL (argv[0]));
-
+ GUARANTEE_COM_OBJ("com-register-com-object", 0);
+ mx_register_com_object(argv[0], MX_COM_OBJ_VAL(argv[0]));
return scheme_void;
}
-void scheme_release_simple_com_object (void *comObject, void *pIUnknown)
+void scheme_release_simple_com_object(void *comObject, void *pIUnknown)
{
-
- if (MX_MANAGED_OBJ_RELEASED (comObject)) {
- return;
- }
-
- if (pIUnknown) {
- ((IUnknown *)pIUnknown)->Release();
- }
-
- MX_MANAGED_OBJ_RELEASED (comObject) = TRUE;
+ if (MX_MANAGED_OBJ_RELEASED(comObject)) return;
+ if (pIUnknown) ((IUnknown *)pIUnknown)->Release();
+ MX_MANAGED_OBJ_RELEASED(comObject) = TRUE;
}
-void mx_register_simple_com_object (Scheme_Object *obj, IUnknown *pIUnknown)
+void mx_register_simple_com_object(Scheme_Object *obj, IUnknown *pIUnknown)
{
- mx_register_object (obj, pIUnknown, scheme_release_simple_com_object);
+ mx_register_object(obj, pIUnknown, scheme_release_simple_com_object);
}
-void scheme_release_browser (void *wb, void *hwndDestroy)
+void scheme_release_browser(void *wb, void *hwndDestroy)
{
MX_Browser_Object *b;
- if (MX_MANAGED_OBJ_RELEASED (wb)) {
+ if (MX_MANAGED_OBJ_RELEASED(wb)) {
return;
}
b = (MX_Browser_Object *)wb;
- if (b->pIWebBrowser2) {
- b->pIWebBrowser2->Release();
- }
+ if (b->pIWebBrowser2) b->pIWebBrowser2->Release();
- if (((MX_Browser_Object *)wb)->pISink) {
- b->pISink->Release();
- }
+ if (((MX_Browser_Object *)wb)->pISink) b->pISink->Release();
- if (b->pIEventQueue) {
- b->pIEventQueue->Release();
- }
+ if (b->pIEventQueue) b->pIEventQueue->Release();
if (hwndDestroy) {
*b->destroy = TRUE;
// dummy msg to force GetMessage() to return
- PostMessage (b->hwnd, WM_NULL, 0, 0);
+ PostMessage(b->hwnd, WM_NULL, 0, 0);
}
browserCount--;
- MX_MANAGED_OBJ_RELEASED (wb) = TRUE;
+ MX_MANAGED_OBJ_RELEASED(wb) = TRUE;
}
-void scheme_release_document (void *doc, void *)
+void scheme_release_document(void *doc, void *)
{
- if (MX_MANAGED_OBJ_RELEASED (doc)) {
+ if (MX_MANAGED_OBJ_RELEASED(doc)) {
return;
}
@@ -639,20 +606,20 @@ void scheme_release_document (void *doc, void *)
((MX_Document_Object *)doc)->pIHTMLDocument2->Release();
}
- MX_MANAGED_OBJ_RELEASED (doc) = TRUE;
+ MX_MANAGED_OBJ_RELEASED(doc) = TRUE;
}
-Scheme_Object *mx_com_release_object (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_release_object(int argc, Scheme_Object **argv)
{
- GUARANTEE_COM_OBJ ("com-release-object", 0);
+ GUARANTEE_COM_OBJ("com-release-object", 0);
- scheme_release_com_object ((void *)argv[0], MX_COM_OBJ_VAL (argv[0]));
+ scheme_release_com_object((void *)argv[0], MX_COM_OBJ_VAL(argv[0]));
return scheme_void;
}
static
-const char * inv_kind_string (INVOKEKIND invKind)
+const char *inv_kind_string(INVOKEKIND invKind)
{
return
invKind == INVOKE_FUNC ? "method"
@@ -663,7 +630,7 @@ const char * inv_kind_string (INVOKEKIND invKind)
}
static
-const char * mx_fun_string (INVOKEKIND invKind)
+const char *mx_fun_string(INVOKEKIND invKind)
{
return
invKind == INVOKE_FUNC ? "com-invoke"
@@ -673,8 +640,7 @@ const char * mx_fun_string (INVOKEKIND invKind)
}
static
-unsigned short getHashValue (INVOKEKIND invKind,
- LPCTSTR name)
+unsigned short getHashValue(INVOKEKIND invKind, LPCTSTR name)
{
LPCTSTR p;
unsigned short hashVal;
@@ -683,16 +649,17 @@ unsigned short getHashValue (INVOKEKIND invKind,
p = name;
while (*p) {
- hashVal ^= (hashVal << 5) + (hashVal >> 2) + (unsigned short) (*p);
+ hashVal ^= (hashVal << 5) + (hashVal >> 2) + (unsigned short)(*p);
p++;
}
return hashVal % TYPE_TBL_SIZE;
}
-void addTypeToTable (MX_COM_Object *obj, LPCTSTR name,
- INVOKEKIND invKind,
- MX_TYPEDESC *pTypeDesc)
+void addTypeToTable(MX_COM_Object *obj,
+ LPCTSTR name,
+ INVOKEKIND invKind,
+ MX_TYPEDESC *pTypeDesc)
{
unsigned short hashVal;
MX_TYPE_TBL_ENTRY *pEntry, *p;
@@ -703,7 +670,7 @@ void addTypeToTable (MX_COM_Object *obj, LPCTSTR name,
pTypeDesc->pITypeInfo->AddRef();
- pEntry = (MX_TYPE_TBL_ENTRY *)scheme_malloc_tagged (sizeof (MX_TYPE_TBL_ENTRY));
+ pEntry = (MX_TYPE_TBL_ENTRY *)scheme_malloc_tagged(sizeof(MX_TYPE_TBL_ENTRY));
pEntry->so.type = mx_tbl_entry_type;
pEntry->pTypeDesc = pTypeDesc;
pEntry->pIDispatch = obj->pIDispatch;
@@ -711,7 +678,7 @@ void addTypeToTable (MX_COM_Object *obj, LPCTSTR name,
pEntry->name = name;
pEntry->next = NULL;
- hashVal = getHashValue (invKind, name);
+ hashVal = getHashValue(invKind, name);
if (!obj->types) {
Scheme_Hash_Table *ht;
@@ -719,15 +686,16 @@ void addTypeToTable (MX_COM_Object *obj, LPCTSTR name,
obj->types = ht;
}
- p = (MX_TYPE_TBL_ENTRY *)scheme_hash_get(obj->types, scheme_make_integer(hashVal));
-
+ p = (MX_TYPE_TBL_ENTRY *)scheme_hash_get(obj->types,
+ scheme_make_integer(hashVal));
+
pEntry->next = p;
- scheme_hash_set(obj->types, scheme_make_integer(hashVal), (Scheme_Object *)pEntry);
+ scheme_hash_set(obj->types, scheme_make_integer(hashVal),
+ (Scheme_Object *)pEntry);
}
-MX_TYPEDESC * lookupTypeDesc (MX_COM_Object *obj, LPCTSTR name,
- INVOKEKIND invKind)
+MX_TYPEDESC *lookupTypeDesc(MX_COM_Object *obj, LPCTSTR name, INVOKEKIND invKind)
{
unsigned short hashVal;
MX_TYPE_TBL_ENTRY *p;
@@ -735,55 +703,51 @@ MX_TYPEDESC * lookupTypeDesc (MX_COM_Object *obj, LPCTSTR name,
if (!obj->types)
return NULL;
- hashVal = getHashValue (invKind, name);
+ hashVal = getHashValue(invKind, name);
- p = (MX_TYPE_TBL_ENTRY *)scheme_hash_get(obj->types, scheme_make_integer(hashVal));
+ p = (MX_TYPE_TBL_ENTRY *)scheme_hash_get(obj->types,
+ scheme_make_integer(hashVal));
while (p) {
- if (p->invKind == invKind &&
- lstrcmp (p->name, name) == 0)
- return p->pTypeDesc;
-
- p = p->next;
- }
+ if (p->invKind == invKind && lstrcmp(p->name, name) == 0)
+ return p->pTypeDesc;
+ p = p->next;
+ }
return NULL;
}
-void codedComError (const char *s, HRESULT hr)
+void codedComError(const char *s, HRESULT hr)
{
char buff[1024];
char finalBuff[2048];
- if (FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM,
- 0, hr, 0, buff, sizeof (buff), NULL) > 0)
- sprintf (finalBuff, "%s, code = %X: %s", s, hr, buff);
+ if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, hr, 0, buff, sizeof(buff),
+ NULL) > 0)
+ sprintf(finalBuff, "%s, code = %X: %s", s, hr, buff);
else
- sprintf (finalBuff, "%s, code = %X", s, hr);
+ sprintf(finalBuff, "%s, code = %X", s, hr);
- scheme_signal_error (finalBuff);
+ scheme_signal_error(finalBuff);
}
-Scheme_Object *mx_version (int argc, Scheme_Object **argv)
+Scheme_Object *mx_version(int argc, Scheme_Object **argv)
{
- return scheme_make_utf8_string (MX_VERSION);
+ return scheme_make_utf8_string(MX_VERSION);
}
-Scheme_Object *do_cocreate_instance (CLSID clsId,
- LPCTSTR name,
- LPCTSTR location,
- LPCTSTR machine)
+Scheme_Object *do_cocreate_instance(CLSID clsId, LPCTSTR name, LPCTSTR location,
+ LPCTSTR machine)
{
HRESULT hr;
IDispatch *pIDispatch;
MX_COM_Object *com_object;
- if (lstrcmpi (location, TEXT ("local")) == 0) {
- hr = CoCreateInstance (clsId, NULL,
- CLSCTX_LOCAL_SERVER | CLSCTX_INPROC_SERVER,
- IID_IDispatch, (void **)&pIDispatch);
- }
- else if (lstrcmpi (location, TEXT ("remote")) == 0) {
+ if (lstrcmpi(location, TEXT("local")) == 0) {
+ hr = CoCreateInstance(clsId, NULL,
+ CLSCTX_LOCAL_SERVER | CLSCTX_INPROC_SERVER,
+ IID_IDispatch, (void **)&pIDispatch);
+ } else if (lstrcmpi(location, TEXT("remote")) == 0) {
COSERVERINFO csi;
MULTI_QI mqi;
OLECHAR machineBuff[1024];
@@ -791,21 +755,19 @@ Scheme_Object *do_cocreate_instance (CLSID clsId,
if (machine) {
unsigned int len;
unsigned int count;
-
+
csi.dwReserved1 = 0;
csi.dwReserved2 = 0;
csi.pAuthInfo = NULL;
- len = (unsigned int)lstrlen (machine);
- count = MultiByteToWideChar (CP_ACP, (DWORD)0,
- machine, len,
- machineBuff,
- sizeray (machineBuff) - 1);
+ len = (unsigned int)lstrlen(machine);
+ count = MultiByteToWideChar(CP_ACP, (DWORD)0, machine, len, machineBuff,
+ sizeray(machineBuff) - 1);
machineBuff[len] = '\0';
if (count < len) {
- scheme_signal_error ("cocreate-instance-from-{coclass, progid}: "
- "Unable to translate machine name to Unicode");
+ scheme_signal_error("cocreate-instance-from-{coclass, progid}: "
+ "Unable to translate machine name to Unicode");
}
csi.pwszName = machineBuff;
@@ -816,34 +778,33 @@ Scheme_Object *do_cocreate_instance (CLSID clsId,
mqi.pItf = NULL;
mqi.hr = 0;
- hr = CoCreateInstanceEx (clsId, NULL,
- CLSCTX_REMOTE_SERVER,
- machine ? &csi : NULL,
- 1, &mqi);
+ hr = CoCreateInstanceEx(clsId, NULL, CLSCTX_REMOTE_SERVER,
+ machine ? &csi : NULL, 1, &mqi);
- pIDispatch = (IDispatch *) (mqi.pItf);
+ pIDispatch = (IDispatch *)(mqi.pItf);
if (mqi.hr != S_OK || pIDispatch == NULL) {
- codedComError ("cocreate-instance-from-{coclass, progid}: "
- "Unable to obtain IDispatch interface for remote server",
- hr);
+ codedComError("cocreate-instance-from-{coclass, progid}: "
+ "Unable to obtain IDispatch interface for remote server",
+ hr);
}
- }
- else {
- scheme_signal_error ("cocreate-instance-from-{coclass, progid}: "
- "Expected 'local, 'remote, or machine name for 2nd argument, "
- "got '%s", location);
+ } else {
+ scheme_signal_error("cocreate-instance-from-{coclass, progid}: "
+ "Expected 'local, 'remote, or machine name for 2nd "
+ "argument, got '%s", location);
}
if (hr != ERROR_SUCCESS) {
char errBuff[2048];
- sprintf (errBuff, "cocreate-instance-from-{coclass, progid}: Unable to create instance of %s",
- name);
- codedComError (errBuff, hr);
+ sprintf(errBuff,
+ "cocreate-instance-from-{coclass, progid}: "
+ "Unable to create instance of %s",
+ name);
+ codedComError(errBuff, hr);
}
- com_object = (MX_COM_Object *)scheme_malloc_tagged (sizeof (MX_COM_Object));
+ com_object = (MX_COM_Object *)scheme_malloc_tagged(sizeof(MX_COM_Object));
com_object->so.type = mx_com_object_type;
com_object->pIDispatch = pIDispatch;
@@ -856,104 +817,104 @@ Scheme_Object *do_cocreate_instance (CLSID clsId,
com_object->released = FALSE;
com_object->types = NULL;
- mx_register_com_object ((Scheme_Object *)com_object, pIDispatch);
+ mx_register_com_object((Scheme_Object *)com_object, pIDispatch);
return (Scheme_Object *)com_object;
}
static
-void bindCocreateLocation (int argc, Scheme_Object **argv,
- LPCTSTR * pLocation, LPCTSTR * pMachine,
- char *f)
+void bindCocreateLocation(int argc, Scheme_Object **argv,
+ LPCTSTR * pLocation, LPCTSTR * pMachine,
+ char *f)
{
if (argc == 2) {
- if (SCHEME_SYMBOLP (argv[1])) {
+ if (SCHEME_SYMBOLP(argv[1])) {
LPCTSTR t;
- t = schemeSymbolToText (argv[1]);
+ t = schemeSymbolToText(argv[1]);
*pLocation = t;
*pMachine = NULL;
- } else if (SCHEME_CHAR_STRINGP (argv[1])) {
+ } else if (SCHEME_CHAR_STRINGP(argv[1])) {
LPCTSTR t;
- t = TEXT ("remote");
+ t = TEXT("remote");
*pLocation = t;
- t = schemeCharStringToText (argv[1]);
+ t = schemeCharStringToText(argv[1]);
*pMachine = t;
} else
- scheme_wrong_type (f, "symbol or string", 0, argc, argv);
+ scheme_wrong_type(f, "symbol or string", 0, argc, argv);
} else {
- *pLocation = TEXT ("local");
+ *pLocation = TEXT("local");
*pMachine = NULL;
}
}
-Scheme_Object *mx_cocreate_instance_from_coclass (int argc, Scheme_Object **argv)
+Scheme_Object *mx_cocreate_instance_from_coclass(int argc, Scheme_Object **argv)
{
LPCTSTR coclass;
LPCTSTR location;
LPCTSTR machine;
- GUARANTEE_STRSYM ("cocreate-instance-from-coclass", 0);
+ GUARANTEE_STRSYM("cocreate-instance-from-coclass", 0);
- bindCocreateLocation (argc, argv, &location, &machine,
- "cocreate-instance-from-coclass");
+ bindCocreateLocation(argc, argv, &location, &machine,
+ "cocreate-instance-from-coclass");
- coclass = schemeToText (argv[0]);
+ coclass = schemeToText(argv[0]);
- return do_cocreate_instance (getCLSIDFromCoClass (coclass), coclass, location, machine);
+ return do_cocreate_instance(getCLSIDFromCoClass(coclass), coclass, location,
+ machine);
}
-CLSID schemeProgIdToCLSID (Scheme_Object *obj, const char * fname)
+CLSID schemeProgIdToCLSID(Scheme_Object *obj, const char * fname)
{
CLSID clsId;
BSTR wideProgId;
HRESULT hr;
- wideProgId = schemeToBSTR (obj);
+ wideProgId = schemeToBSTR(obj);
- hr = CLSIDFromProgID (wideProgId, &clsId);
+ hr = CLSIDFromProgID(wideProgId, &clsId);
- SysFreeString (wideProgId);
+ SysFreeString(wideProgId);
- if (FAILED (hr)) {
+ if (FAILED(hr)) {
char errBuff[2048];
- sprintf (errBuff, "%s: Error retrieving CLSID from ProgID %s",
- fname, schemeToMultiByte (obj));
- codedComError (errBuff, hr);
+ sprintf(errBuff, "%s: Error retrieving CLSID from ProgID %s",
+ fname, schemeToMultiByte(obj));
+ codedComError(errBuff, hr);
}
return clsId;
}
-Scheme_Object *mx_cocreate_instance_from_progid (int argc,
- Scheme_Object **argv)
+Scheme_Object *mx_cocreate_instance_from_progid(int argc, Scheme_Object **argv)
{
LPCTSTR location;
LPCTSTR machine;
- GUARANTEE_STRSYM ("cocreate-instance-from-progid", 0);
+ GUARANTEE_STRSYM("cocreate-instance-from-progid", 0);
- bindCocreateLocation (argc, argv, &location, &machine,
- "cocreate-instance-from-progid");
+ bindCocreateLocation(argc, argv, &location, &machine,
+ "cocreate-instance-from-progid");
- return do_cocreate_instance (schemeProgIdToCLSID (argv[0], "cocreate-instance-from-progid"),
- schemeToText (argv[0]),
+ return do_cocreate_instance(schemeProgIdToCLSID(argv[0], "cocreate-instance-from-progid"),
+ schemeToText(argv[0]),
location, machine);
}
-Scheme_Object *mx_set_coclass (int argc, Scheme_Object **argv)
+Scheme_Object *mx_set_coclass(int argc, Scheme_Object **argv)
{
CLSID clsId;
- GUARANTEE_COM_OBJ ("set-coclass!", 0);
- GUARANTEE_STRSYM ("set-coclass!", 1);
+ GUARANTEE_COM_OBJ("set-coclass!", 0);
+ GUARANTEE_STRSYM("set-coclass!", 1);
- clsId = getCLSIDFromCoClass (schemeToText (argv[1]));
- MX_COM_OBJ_CLSID (argv[0]) = clsId;
+ clsId = getCLSIDFromCoClass(schemeToText(argv[1]));
+ MX_COM_OBJ_CLSID(argv[0]) = clsId;
return scheme_void;
}
-Scheme_Object *mx_coclass (int argc, Scheme_Object **argv)
+Scheme_Object *mx_coclass(int argc, Scheme_Object **argv)
{
HRESULT hr;
HKEY hkey, hsubkey;
@@ -970,135 +931,94 @@ Scheme_Object *mx_coclass (int argc, Scheme_Object **argv)
int count;
Scheme_Object *retval, *v;
- v = GUARANTEE_COM_OBJ ("coclass", 0);
- clsId = MX_COM_OBJ_CLSID (v);
+ v = GUARANTEE_COM_OBJ("coclass", 0);
+ clsId = MX_COM_OBJ_CLSID(v);
- if (isEmptyClsId (clsId))
- scheme_signal_error ("coclass: No coclass for object");
+ if (isEmptyClsId(clsId))
+ scheme_signal_error("coclass: No coclass for object");
// use CLSID to rummage through Registry to find coclass
- result = RegOpenKeyEx (HKEY_CLASSES_ROOT,
- "CLSID",
- (DWORD)0,
- KEY_READ,
- &hkey);
-
+ result = RegOpenKeyEx(HKEY_CLASSES_ROOT, "CLSID", (DWORD)0, KEY_READ, &hkey);
if (result != ERROR_SUCCESS)
- scheme_signal_error ("Error while searching Windows registry");
+ scheme_signal_error("Error while searching Windows registry");
// enumerate subkeys until we find the one we want
-
// really, should call RegQueryInfoKey to find size needed for buffers
-
keyIndex = 0;
-
retval = NULL;
-
while (1) {
-
// get next subkey
-
- clsIdBufferSize = sizeof (clsIdBuffer);
-
- result = RegEnumKeyEx (hkey, keyIndex++,
- clsIdBuffer,
- &clsIdBufferSize,
- 0, NULL, NULL,
- &fileTime);
-
- if (result == ERROR_NO_MORE_ITEMS)
- break;
-
+ clsIdBufferSize = sizeof(clsIdBuffer);
+ result = RegEnumKeyEx(hkey, keyIndex++, clsIdBuffer, &clsIdBufferSize,
+ 0, NULL, NULL, &fileTime);
+ if (result == ERROR_NO_MORE_ITEMS) break;
if (result != ERROR_SUCCESS)
- scheme_signal_error ("Error enumerating subkeys in Windows registry");
-
- if (strlen (clsIdBuffer) != CLSIDLEN) // not a CLSID -- bogus entry
+ scheme_signal_error("Error enumerating subkeys in Windows registry");
+ if (strlen(clsIdBuffer) != CLSIDLEN) // not a CLSID -- bogus entry
continue;
-
-
- count = MultiByteToWideChar (CP_ACP, (DWORD)0,
- clsIdBuffer, (unsigned int)strlen (clsIdBuffer),
- oleClsIdBuffer, sizeray (oleClsIdBuffer));
-
+ count = MultiByteToWideChar(CP_ACP, (DWORD)0,
+ clsIdBuffer, (unsigned int)strlen(clsIdBuffer),
+ oleClsIdBuffer, sizeray(oleClsIdBuffer));
if (count == 0)
- scheme_signal_error ("Error translating CLSID to Unicode");
-
+ scheme_signal_error("Error translating CLSID to Unicode");
oleClsIdBuffer[CLSIDLEN] = '\0';
-
- hr = CLSIDFromString (oleClsIdBuffer, ®istryClsId);
-
+ hr = CLSIDFromString(oleClsIdBuffer, ®istryClsId);
if (hr != NOERROR)
- scheme_signal_error ("coclass: Error obtaining coclass CLSID");
-
+ scheme_signal_error("coclass: Error obtaining coclass CLSID");
if (registryClsId != clsId)
continue;
-
// open subkey
-
- result = RegOpenKeyEx (hkey, clsIdBuffer,
- (DWORD)0,
- KEY_READ, &hsubkey);
-
+ result = RegOpenKeyEx(hkey, clsIdBuffer, (DWORD)0, KEY_READ, &hsubkey);
if (result != ERROR_SUCCESS)
- scheme_signal_error ("coclass: Error obtaining coclass value");
-
- dataBufferSize = sizeof (dataBuffer);
-
- RegQueryValueEx (hsubkey, "", 0, &dataType, dataBuffer, &dataBufferSize);
-
- RegCloseKey (hsubkey);
-
+ scheme_signal_error("coclass: Error obtaining coclass value");
+ dataBufferSize = sizeof(dataBuffer);
+ RegQueryValueEx(hsubkey, "", 0, &dataType, dataBuffer, &dataBufferSize);
+ RegCloseKey(hsubkey);
if (dataType == REG_SZ) {
- retval = multiByteToSchemeCharString ((char *)dataBuffer);
- break;
- }
+ retval = multiByteToSchemeCharString((char*)dataBuffer);
+ break;
+ }
}
- RegCloseKey (hkey);
+ RegCloseKey(hkey);
if (retval == NULL)
- scheme_signal_error ("coclass: object's coclass not found in Registry");
+ scheme_signal_error("coclass: object's coclass not found in Registry");
return retval;
}
-Scheme_Object * mx_progid (int argc, Scheme_Object **argv)
+Scheme_Object* mx_progid(int argc, Scheme_Object **argv)
{
Scheme_Object *v;
HRESULT hr;
LPOLESTR wideProgId;
CLSID clsId;
- v = GUARANTEE_COM_OBJ ("progid", 0);
- clsId = MX_COM_OBJ_CLSID (v);
-
- if (isEmptyClsId (clsId))
- scheme_signal_error ("progid: No coclass for object");
-
- hr = ProgIDFromCLSID (clsId, &wideProgId);
-
- if (FAILED (hr))
- scheme_signal_error ("progid: Error finding coclass");
-
- return LPOLESTRToSchemeString (wideProgId);
+ v = GUARANTEE_COM_OBJ("progid", 0);
+ clsId = MX_COM_OBJ_CLSID(v);
+ if (isEmptyClsId(clsId))
+ scheme_signal_error("progid: No coclass for object");
+ hr = ProgIDFromCLSID(clsId, &wideProgId);
+ if (FAILED(hr))
+ scheme_signal_error("progid: Error finding coclass");
+ return LPOLESTRToSchemeString(wideProgId);
}
-Scheme_Object *mx_set_coclass_from_progid (int argc, Scheme_Object **argv)
+Scheme_Object *mx_set_coclass_from_progid(int argc, Scheme_Object **argv)
{
CLSID cid;
- GUARANTEE_COM_OBJ ("set-coclass-from-progid!", 0);
- GUARANTEE_STRSYM ("set-coclass-from-progid!", 1);
-
- cid = schemeProgIdToCLSID (argv[1], "set-coclass-from-progid!");
- MX_COM_OBJ_CLSID (argv[0]) = cid;
-
+ GUARANTEE_COM_OBJ("set-coclass-from-progid!", 0);
+ GUARANTEE_STRSYM("set-coclass-from-progid!", 1);
+ cid = schemeProgIdToCLSID(argv[1], "set-coclass-from-progid!");
+ MX_COM_OBJ_CLSID(argv[0]) = cid;
return scheme_void;
}
-ITypeInfo *typeInfoFromComObject (MX_COM_Object *obj)
+ITypeInfo *typeInfoFromComObject(MX_COM_Object *obj)
{
HRESULT hr;
ITypeInfo *pITypeInfo;
@@ -1106,51 +1026,38 @@ ITypeInfo *typeInfoFromComObject (MX_COM_Object *obj)
unsigned int count;
pITypeInfo = obj->pITypeInfo;
-
- if (pITypeInfo)
- return pITypeInfo;
-
+ if (pITypeInfo) return pITypeInfo;
pIDispatch = obj->pIDispatch;
-
- pIDispatch->GetTypeInfoCount (&count);
-
+ pIDispatch->GetTypeInfoCount(&count);
if (count == 0)
- scheme_signal_error ("COM object does not expose type information");
-
- hr = pIDispatch->GetTypeInfo (0, LOCALE_SYSTEM_DEFAULT, &pITypeInfo);
-
- if (FAILED (hr) || pITypeInfo == NULL)
- codedComError ("Error getting COM type information", hr);
-
+ scheme_signal_error("COM object does not expose type information");
+ hr = pIDispatch->GetTypeInfo(0, LOCALE_SYSTEM_DEFAULT, &pITypeInfo);
+ if (FAILED(hr) || pITypeInfo == NULL)
+ codedComError("Error getting COM type information", hr);
obj->pITypeInfo = pITypeInfo;
-
return pITypeInfo;
}
-Scheme_Object *mx_com_get_object_type (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_get_object_type(int argc, Scheme_Object **argv)
{
ITypeInfo *pITypeInfo;
MX_COM_Type *retval;
MX_COM_Object *obj;
- GUARANTEE_COM_OBJ ("com-object-type", 0);
+ GUARANTEE_COM_OBJ("com-object-type", 0);
obj = (MX_COM_Object *)argv[0];
- pITypeInfo = typeInfoFromComObject (obj);
-
- retval = (MX_COM_Type *)scheme_malloc_tagged (sizeof (MX_COM_Type));
-
+ pITypeInfo = typeInfoFromComObject(obj);
+ retval = (MX_COM_Type *)scheme_malloc_tagged(sizeof(MX_COM_Type));
retval->so.type = mx_com_type_type;
retval->released = FALSE;
retval->pITypeInfo = pITypeInfo;
retval->clsId = obj->clsId;
-
- mx_register_simple_com_object ((Scheme_Object *)retval, pITypeInfo);
-
+ mx_register_simple_com_object((Scheme_Object *)retval, pITypeInfo);
return (Scheme_Object *)retval;
}
-BOOL typeInfoEq (ITypeInfo *pITypeInfo1, ITypeInfo *pITypeInfo2)
+BOOL typeInfoEq(ITypeInfo *pITypeInfo1, ITypeInfo *pITypeInfo2)
{
HRESULT hr;
TYPEATTR *pTypeAttr1, *pTypeAttr2;
@@ -1158,41 +1065,31 @@ BOOL typeInfoEq (ITypeInfo *pITypeInfo1, ITypeInfo *pITypeInfo2)
// intensional equality
- if (pITypeInfo1 == pITypeInfo2)
- return TRUE;
-
- hr = pITypeInfo1->GetTypeAttr (&pTypeAttr1);
-
- if (FAILED (hr) || pTypeAttr1 == NULL)
- codedComError ("Error getting type attributes", hr);
-
- hr = pITypeInfo2->GetTypeAttr (&pTypeAttr2);
-
- if (FAILED (hr) || pTypeAttr2 == NULL)
- codedComError ("Error getting type attributes", hr);
-
+ if (pITypeInfo1 == pITypeInfo2) return TRUE;
+ hr = pITypeInfo1->GetTypeAttr(&pTypeAttr1);
+ if (FAILED(hr) || pTypeAttr1 == NULL)
+ codedComError("Error getting type attributes", hr);
+ hr = pITypeInfo2->GetTypeAttr(&pTypeAttr2);
+ if (FAILED(hr) || pTypeAttr2 == NULL)
+ codedComError("Error getting type attributes", hr);
retval = (pTypeAttr1->guid == pTypeAttr2->guid);
-
- pITypeInfo1->ReleaseTypeAttr (pTypeAttr1);
- pITypeInfo2->ReleaseTypeAttr (pTypeAttr2);
-
+ pITypeInfo1->ReleaseTypeAttr(pTypeAttr1);
+ pITypeInfo2->ReleaseTypeAttr(pTypeAttr2);
return retval;
}
-Scheme_Object *mx_com_is_a (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_is_a(int argc, Scheme_Object **argv)
{
ITypeInfo *pITypeInfo1, *pITypeInfo2;
- GUARANTEE_COM_OBJ ("com-is-a?", 0);
- GUARANTEE_COM_TYPE ("com-is-a?", 1);
-
- pITypeInfo1 = typeInfoFromComObject ((MX_COM_Object *)argv[0]);
- pITypeInfo2 = MX_COM_TYPE_VAL ((MX_COM_Type *)argv[1]);
-
- return typeInfoEq (pITypeInfo1, pITypeInfo2) ? scheme_true : scheme_false;
+ GUARANTEE_COM_OBJ("com-is-a?", 0);
+ GUARANTEE_COM_TYPE("com-is-a?", 1);
+ pITypeInfo1 = typeInfoFromComObject((MX_COM_Object *)argv[0]);
+ pITypeInfo2 = MX_COM_TYPE_VAL((MX_COM_Type *)argv[1]);
+ return typeInfoEq(pITypeInfo1, pITypeInfo2) ? scheme_true : scheme_false;
}
-Scheme_Object *mx_com_help (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_help(int argc, Scheme_Object **argv)
{
HRESULT hr;
ITypeInfo *pITypeInfo;
@@ -1200,72 +1097,59 @@ Scheme_Object *mx_com_help (int argc, Scheme_Object **argv)
char buff[MAX_PATH];
unsigned int len, slen;
- GUARANTEE_COM_OBJ_OR_TYPE ("com-help", 0);
+ GUARANTEE_COM_OBJ_OR_TYPE("com-help", 0);
- if (argc == 2)
- GUARANTEE_STRSYM ("com-help", 1);
+ if (argc == 2) GUARANTEE_STRSYM("com-help", 1);
pITypeInfo =
- MX_COM_TYPEP (argv[0])
- ? MX_COM_TYPE_VAL (argv[0])
- : (MX_COM_OBJ_VAL (argv[0]) == NULL)
- ? (scheme_signal_error ("com-help: NULL COM object"), (ITypeInfo *) NULL)
- : typeInfoFromComObject ((MX_COM_Object *)argv[0]);
+ MX_COM_TYPEP(argv[0])
+ ? MX_COM_TYPE_VAL(argv[0])
+ : (MX_COM_OBJ_VAL(argv[0]) == NULL)
+ ? (scheme_signal_error("com-help: NULL COM object"), (ITypeInfo*)NULL)
+ : typeInfoFromComObject((MX_COM_Object *)argv[0]);
- hr = pITypeInfo->GetDocumentation (MEMBERID_NIL, NULL, NULL, NULL,
- &helpFileName);
+ hr = pITypeInfo->GetDocumentation(MEMBERID_NIL, NULL, NULL, NULL,
+ &helpFileName);
- if (FAILED (hr))
- codedComError ("Can't get help", hr);
+ if (FAILED(hr)) codedComError("Can't get help", hr);
- else if (helpFileName == NULL || wcscmp (helpFileName, L"") == 0)
- scheme_signal_error ("No help available");
+ else if (helpFileName == NULL || wcscmp(helpFileName, L"") == 0)
+ scheme_signal_error("No help available");
- slen = SysStringLen (helpFileName);
- WideCharToMultiByte (CP_ACP, (DWORD)0, helpFileName, slen,
- buff, sizeof (buff) - 1,
- NULL, NULL);
-
- SysFreeString (helpFileName);
-
- buff[sizeof (buff)-1] = '\0';
-
- len = (unsigned int) strlen (buff);
-
- if (stricmp (buff + len - 4, ".CHM") == 0) {
- HWND hwnd;
- if (argc >= 2) {
- LPCTSTR t;
- t = schemeToText (argv[1]);
- hwnd = HtmlHelp (NULL, buff,
- HH_DISPLAY_INDEX, PtrToInt (t));
- } else
- hwnd = HtmlHelp (NULL, buff, HH_DISPLAY_TOPIC, 0);
-
- if (hwnd)
- SetForegroundWindow (hwnd);
- }
- else if (stricmp (buff + len - 4, ".HLP") == 0) {
+ slen = SysStringLen(helpFileName);
+ WideCharToMultiByte(CP_ACP, (DWORD)0, helpFileName, slen,
+ buff, sizeof(buff) - 1, NULL, NULL);
+ SysFreeString(helpFileName);
+ buff[sizeof(buff)-1] = '\0';
+ len = (unsigned int) strlen(buff);
+ if (stricmp(buff + len - 4, ".CHM") == 0) {
+ HWND hwnd;
if (argc >= 2) {
LPCTSTR t;
- t = schemeToText (argv[1]);
- WinHelp (NULL, buff, HELP_KEY, PtrToInt (t));
+ t = schemeToText(argv[1]);
+ hwnd = HtmlHelp(NULL, buff, HH_DISPLAY_INDEX, PtrToInt(t));
} else
- WinHelp (NULL, buff, HELP_FINDER, 0);
- }
- else
- scheme_signal_error ("Unknown help file type: %s", buff);
-
+ hwnd = HtmlHelp(NULL, buff, HH_DISPLAY_TOPIC, 0);
+ if (hwnd) SetForegroundWindow(hwnd);
+ } else if (stricmp(buff + len - 4, ".HLP") == 0) {
+ if (argc >= 2) {
+ LPCTSTR t;
+ t = schemeToText(argv[1]);
+ WinHelp(NULL, buff, HELP_KEY, PtrToInt(t));
+ } else
+ WinHelp(NULL, buff, HELP_FINDER, 0);
+ } else
+ scheme_signal_error("Unknown help file type: %s", buff);
return scheme_void;
}
-void signalCodedEventSinkError (char *s, HRESULT hr)
+void signalCodedEventSinkError(char *s, HRESULT hr)
{
- ReleaseSemaphore (eventSinkMutex, 1, NULL);
- codedComError (s, hr);
+ ReleaseSemaphore(eventSinkMutex, 1, NULL);
+ codedComError(s, hr);
}
-void connectComObjectToEventSink (MX_COM_Object *obj)
+void connectComObjectToEventSink(MX_COM_Object *obj)
{
HRESULT hr;
IUnknown *pIUnknown;
@@ -1277,75 +1161,70 @@ void connectComObjectToEventSink (MX_COM_Object *obj)
DWORD cookie;
TYPEATTR *pTypeAttr;
- if (obj->pIConnectionPoint)
- return;
-
- WaitForSingleObject (eventSinkMutex, INFINITE);
-
+ if (obj->pIConnectionPoint) return;
+ WaitForSingleObject(eventSinkMutex, INFINITE);
pIDispatch = obj->pIDispatch;
-
- hr = pIDispatch->QueryInterface (IID_IConnectionPointContainer, (void **)&pIConnectionPointContainer);
-
- if (FAILED (hr) || pIConnectionPointContainer == NULL)
- signalCodedEventSinkError ("cocreate-instance-from-{coclass, progid}: "
- "Unable to get COM object connection point "
- "container", hr);
-
- pITypeInfo = eventTypeInfoFromComObject (obj);
-
+ hr = pIDispatch->QueryInterface(IID_IConnectionPointContainer,
+ (void **)&pIConnectionPointContainer);
+ if (FAILED(hr) || pIConnectionPointContainer == NULL)
+ signalCodedEventSinkError("cocreate-instance-from-{coclass, progid}: "
+ "Unable to get COM object connection point "
+ "container", hr);
+ pITypeInfo = eventTypeInfoFromComObject(obj);
if (pITypeInfo == NULL) {
- ReleaseSemaphore (eventSinkMutex, 1, NULL);
- scheme_signal_error ("cocreate-instance-from-{coclass, progid}: "
- "Unable to get type information for events");
+ ReleaseSemaphore(eventSinkMutex, 1, NULL);
+ scheme_signal_error("cocreate-instance-from-{coclass, progid}: "
+ "Unable to get type information for events");
}
- hr = pITypeInfo->GetTypeAttr (&pTypeAttr);
+ hr = pITypeInfo->GetTypeAttr(&pTypeAttr);
+ if (FAILED(hr) || pTypeAttr == NULL)
+ signalCodedEventSinkError("cocreate-instance-from-{coclass, progid}: "
+ "Unable to get type attributes for events", hr);
- if (FAILED (hr) || pTypeAttr == NULL)
- signalCodedEventSinkError ("cocreate-instance-from-{coclass, progid}: "
- "Unable to get type attributes for events", hr);
+ hr = pIConnectionPointContainer->FindConnectionPoint(pTypeAttr->guid,
+ &pIConnectionPoint);
- hr = pIConnectionPointContainer->FindConnectionPoint (pTypeAttr->guid, &pIConnectionPoint);
-
- pITypeInfo->ReleaseTypeAttr (pTypeAttr);
+ pITypeInfo->ReleaseTypeAttr(pTypeAttr);
pIConnectionPointContainer->Release();
- if (FAILED (hr) || pIConnectionPoint == NULL)
- signalCodedEventSinkError ("cocreate-instance-from-{coclass, progid}: "
- "Unable to find COM object connection point", hr);
+ if (FAILED(hr) || pIConnectionPoint == NULL)
+ signalCodedEventSinkError("cocreate-instance-from-{coclass, progid}: "
+ "Unable to find COM object connection point", hr);
- hr = CoCreateInstance (CLSID_Sink, NULL, CLSCTX_LOCAL_SERVER | CLSCTX_INPROC_SERVER,
- IID_IUnknown, (void **)&pIUnknown);
+ hr = CoCreateInstance(CLSID_Sink, NULL,
+ CLSCTX_LOCAL_SERVER | CLSCTX_INPROC_SERVER,
+ IID_IUnknown, (void **)&pIUnknown);
- if (FAILED (hr) || pIUnknown == NULL)
- signalCodedEventSinkError ("cocreate-instance-from-{coclass, progid}: "
- "Unable to create sink object", hr);
+ if (FAILED(hr) || pIUnknown == NULL)
+ signalCodedEventSinkError("cocreate-instance-from-{coclass, progid}: "
+ "Unable to create sink object", hr);
- hr = pIUnknown->QueryInterface (IID_ISink, (void **)&pISink);
+ hr = pIUnknown->QueryInterface(IID_ISink, (void **)&pISink);
- if (FAILED (hr) || pISink == NULL)
- signalCodedEventSinkError ("cocreate-instance-from-{coclass, progid}: "
- "Unable to find sink interface", hr);
+ if (FAILED(hr) || pISink == NULL)
+ signalCodedEventSinkError("cocreate-instance-from-{coclass, progid}: "
+ "Unable to find sink interface", hr);
- pISink->set_myssink_table (&myssink_table);
+ pISink->set_myssink_table(&myssink_table);
- hr = pIConnectionPoint->Advise (pIUnknown, &cookie);
+ hr = pIConnectionPoint->Advise(pIUnknown, &cookie);
pIUnknown->Release();
- if (FAILED (hr))
- signalCodedEventSinkError ("cocreate-instance-from-{coclass, progid}: "
- "Unable to connect sink to connection point", hr);
+ if (FAILED(hr))
+ signalCodedEventSinkError("cocreate-instance-from-{coclass, progid}: "
+ "Unable to connect sink to connection point", hr);
obj->pEventTypeInfo = pITypeInfo;
obj->pIConnectionPoint = pIConnectionPoint;
obj->connectionCookie = cookie;
obj->pISink = pISink;
- ReleaseSemaphore (eventSinkMutex, 1, NULL);
+ ReleaseSemaphore(eventSinkMutex, 1, NULL);
}
-FUNCDESC *getFuncDescForEvent (LPOLESTR name, ITypeInfo *pITypeInfo)
+FUNCDESC *getFuncDescForEvent(LPOLESTR name, ITypeInfo *pITypeInfo)
{
HRESULT hr;
TYPEATTR *pTypeAttr;
@@ -1355,43 +1234,35 @@ FUNCDESC *getFuncDescForEvent (LPOLESTR name, ITypeInfo *pITypeInfo)
unsigned short numFuncDescs;
int i;
- hr = pITypeInfo->GetTypeAttr (&pTypeAttr);
+ hr = pITypeInfo->GetTypeAttr(&pTypeAttr);
- if (FAILED (hr) || pTypeAttr == NULL)
- codedComError ("Unable to get type attributes for events", hr);
+ if (FAILED(hr) || pTypeAttr == NULL)
+ codedComError("Unable to get type attributes for events", hr);
numFuncDescs = pTypeAttr->cFuncs;
- pITypeInfo->ReleaseTypeAttr (pTypeAttr);
+ pITypeInfo->ReleaseTypeAttr(pTypeAttr);
for (i = 0; i < numFuncDescs; i++) {
-
- hr = pITypeInfo->GetFuncDesc (i, &pFuncDesc);
-
- if (FAILED (hr))
- codedComError ("Error getting event method type description", hr);
-
+ hr = pITypeInfo->GetFuncDesc(i, &pFuncDesc);
+ if (FAILED(hr))
+ codedComError("Error getting event method type description", hr);
// rely on name of event
-
- hr = pITypeInfo->GetNames (pFuncDesc->memid, &bstr, 1, &bstrCount);
-
- if (FAILED (hr))
- codedComError ("Error getting event method name", hr);
-
- if (wcscmp (name, bstr) == 0) {
- SysFreeString (bstr);
+ hr = pITypeInfo->GetNames(pFuncDesc->memid, &bstr, 1, &bstrCount);
+ if (FAILED(hr))
+ codedComError("Error getting event method name", hr);
+ if (wcscmp(name, bstr) == 0) {
+ SysFreeString(bstr);
return pFuncDesc;
}
-
- SysFreeString (bstr);
-
- pITypeInfo->ReleaseFuncDesc (pFuncDesc);
+ SysFreeString(bstr);
+ pITypeInfo->ReleaseFuncDesc(pFuncDesc);
}
return NULL;
}
-Scheme_Object *mx_com_register_event_handler (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_register_event_handler(int argc, Scheme_Object **argv)
{
ITypeInfo *pITypeInfo;
ISink *pISink;
@@ -1403,29 +1274,30 @@ Scheme_Object *mx_com_register_event_handler (int argc, Scheme_Object **argv)
GUARANTEE_STRSYM ("com-register-event-handler", 1);
GUARANTEE_PROCEDURE ("com-register-event-handler", 2);
- connectComObjectToEventSink ((MX_COM_Object *)argv[0]);
+ connectComObjectToEventSink((MX_COM_Object *)argv[0]);
- pITypeInfo = MX_COM_OBJ_EVENTTYPEINFO (argv[0]);
- pISink = MX_COM_OBJ_EVENTSINK (argv[0]);
+ pITypeInfo = MX_COM_OBJ_EVENTTYPEINFO(argv[0]);
+ pISink = MX_COM_OBJ_EVENTSINK(argv[0]);
- unicodeName = schemeToBSTR (argv[1]);
+ unicodeName = schemeToBSTR(argv[1]);
- pFuncDesc = getFuncDescForEvent (unicodeName, pITypeInfo);
+ pFuncDesc = getFuncDescForEvent(unicodeName, pITypeInfo);
- SysFreeString (unicodeName);
+ SysFreeString(unicodeName);
if (pFuncDesc == NULL)
- scheme_signal_error ("Can't find event %s in type description", schemeToText (argv[1]));
+ scheme_signal_error("Can't find event %s in type description",
+ schemeToText(argv[1]));
h = GC_HANDLER_BOX(argv[2]);
- pISink->register_handler (pFuncDesc->memid, h);
+ pISink->register_handler(pFuncDesc->memid, h);
- pITypeInfo->ReleaseFuncDesc (pFuncDesc);
+ pITypeInfo->ReleaseFuncDesc(pFuncDesc);
return scheme_void;
}
-Scheme_Object *mx_com_unregister_event_handler (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_unregister_event_handler(int argc, Scheme_Object **argv)
{
ITypeInfo *pITypeInfo;
ISink *pISink;
@@ -1433,37 +1305,27 @@ Scheme_Object *mx_com_unregister_event_handler (int argc, Scheme_Object **argv)
BSTR unicodeName;
Scheme_Object *v;
- GUARANTEE_STRSYM ("com-unregister-event-handler", 1);
-
- v = GUARANTEE_COM_OBJ ("com-unregister-event-handler", 0);
- pITypeInfo = MX_COM_OBJ_EVENTTYPEINFO (v);
-
+ GUARANTEE_STRSYM("com-unregister-event-handler", 1);
+ v = GUARANTEE_COM_OBJ("com-unregister-event-handler", 0);
+ pITypeInfo = MX_COM_OBJ_EVENTTYPEINFO(v);
if (pITypeInfo == NULL)
- scheme_signal_error ("No event type information for object");
-
- pISink = MX_COM_OBJ_EVENTSINK (argv[0]);
-
- if (pISink == NULL) // no events registered
- return scheme_void;
-
- unicodeName = schemeToBSTR (argv[1]);
-
- pFuncDesc = getFuncDescForEvent (unicodeName, pITypeInfo);
-
- SysFreeString (unicodeName);
-
+ scheme_signal_error("No event type information for object");
+ pISink = MX_COM_OBJ_EVENTSINK(argv[0]);
+ if (pISink == NULL) return scheme_void; // no events registered
+ unicodeName = schemeToBSTR(argv[1]);
+ pFuncDesc = getFuncDescForEvent(unicodeName, pITypeInfo);
+ SysFreeString(unicodeName);
if (pFuncDesc == NULL)
- scheme_signal_error ("Can't find event %s in type description", schemeToText (argv[1]));
-
- pISink->unregister_handler (pFuncDesc->memid);
-
- pITypeInfo->ReleaseFuncDesc (pFuncDesc);
+ scheme_signal_error("Can't find event %s in type description",
+ schemeToText(argv[1]));
+ pISink->unregister_handler(pFuncDesc->memid);
+ pITypeInfo->ReleaseFuncDesc(pFuncDesc);
return scheme_void;
}
-MX_TYPEDESC *doTypeDescFromTypeInfo (BSTR name, INVOKEKIND invKind,
- ITypeInfo *pITypeInfo) {
+MX_TYPEDESC *doTypeDescFromTypeInfo(BSTR name, INVOKEKIND invKind,
+ ITypeInfo *pITypeInfo) {
HRESULT hr;
TYPEATTR *pTypeAttr;
FUNCDESC *pFuncDesc;
@@ -1478,10 +1340,10 @@ MX_TYPEDESC *doTypeDescFromTypeInfo (BSTR name, INVOKEKIND invKind,
unsigned short dispFuncs, implFuncs;
int i;
- hr = pITypeInfo->GetTypeAttr (&pTypeAttr);
+ hr = pITypeInfo->GetTypeAttr(&pTypeAttr);
- if (FAILED (hr))
- codedComError ("Error getting attributes for type library", hr);
+ if (FAILED(hr))
+ codedComError("Error getting attributes for type library", hr);
foundDesc = FALSE;
@@ -1489,32 +1351,29 @@ MX_TYPEDESC *doTypeDescFromTypeInfo (BSTR name, INVOKEKIND invKind,
dispFuncs = pTypeAttr->cFuncs;
for (i = 7; i < dispFuncs; i++) {
- hr = pITypeInfo->GetFuncDesc (i, &pFuncDesc);
+ hr = pITypeInfo->GetFuncDesc(i, &pFuncDesc);
- if (FAILED (hr))
- codedComError ("Error getting type description", hr);
+ if (FAILED(hr))
+ codedComError("Error getting type description", hr);
- pITypeInfo->GetNames (pFuncDesc->memid, &bstr, 1, &nameCount);
+ pITypeInfo->GetNames(pFuncDesc->memid, &bstr, 1, &nameCount);
// see if this FUNCDESC is the one we want
- if (wcscmp (bstr, name) == 0 &&
- (invKind == INVOKE_EVENT || pFuncDesc->invkind == invKind)) {
-
+ if (wcscmp(bstr, name) == 0 &&
+ (invKind == INVOKE_EVENT || pFuncDesc->invkind == invKind)) {
foundDesc = TRUE;
descKind = funcDesc;
- SysFreeString (bstr);
+ SysFreeString(bstr);
memID = pFuncDesc->memid;
funcDescIndex = i;
-
break;
}
// if not, throw it back
- SysFreeString (bstr);
- pITypeInfo->ReleaseFuncDesc (pFuncDesc);
-
+ SysFreeString(bstr);
+ pITypeInfo->ReleaseFuncDesc(pFuncDesc);
}
if (invKind == INVOKE_PROPERTYGET ||
@@ -1522,31 +1381,26 @@ MX_TYPEDESC *doTypeDescFromTypeInfo (BSTR name, INVOKEKIND invKind,
invKind == INVOKE_PROPERTYPUTREF) {
for (i = 0; i < pTypeAttr->cVars; i++) {
- hr = pITypeInfo->GetVarDesc (i, &pVarDesc);
- if (FAILED (hr)) {
- codedComError ("Error getting type description", hr);
- }
+ hr = pITypeInfo->GetVarDesc(i, &pVarDesc);
+ if (FAILED(hr))
+ codedComError("Error getting type description", hr);
// see if this VARDESC is the one we want
- pITypeInfo->GetNames (pVarDesc->memid, &bstr, 1, &nameCount);
+ pITypeInfo->GetNames(pVarDesc->memid, &bstr, 1, &nameCount);
- if (wcscmp (bstr, name)) {
- foundDesc = TRUE;
- descKind = varDesc;
- memID = pVarDesc->memid;
-
- break;
+ if (wcscmp(bstr, name)) {
+ foundDesc = TRUE;
+ descKind = varDesc;
+ memID = pVarDesc->memid;
+ break;
}
-
// if not, throw it back
-
- pITypeInfo->ReleaseVarDesc (pVarDesc);
-
+ pITypeInfo->ReleaseVarDesc(pVarDesc);
}
}
- pITypeInfo->ReleaseTypeAttr (pTypeAttr);
+ pITypeInfo->ReleaseTypeAttr(pTypeAttr);
if (foundDesc == FALSE) {
ITypeInfo *pITypeInfoImpl;
@@ -1555,36 +1409,35 @@ MX_TYPEDESC *doTypeDescFromTypeInfo (BSTR name, INVOKEKIND invKind,
// search in inherited interfaces
for (i = 0; i < pTypeAttr->cImplTypes; i++) {
- hr = pITypeInfo->GetRefTypeOfImplType (i, &refType);
+ hr = pITypeInfo->GetRefTypeOfImplType(i, &refType);
- if (FAILED (hr))
- scheme_signal_error ("Can't get implementation type library handle");
+ if (FAILED(hr))
+ scheme_signal_error("Can't get implementation type library handle");
- hr = pITypeInfo->GetRefTypeInfo (refType, &pITypeInfoImpl);
+ hr = pITypeInfo->GetRefTypeInfo(refType, &pITypeInfoImpl);
- if (FAILED (hr))
- scheme_signal_error ("Can't get implementation type library");
+ if (FAILED(hr))
+ scheme_signal_error("Can't get implementation type library");
- hr = pITypeInfoImpl->GetTypeAttr (&pTypeAttrImpl);
+ hr = pITypeInfoImpl->GetTypeAttr(&pTypeAttrImpl);
- if (FAILED (hr))
- scheme_signal_error ("Can't get implementation type library attributes");
+ if (FAILED(hr))
+ scheme_signal_error("Can't get implementation type library attributes");
// recursion, to ascend the inheritance graph
- pTypeDesc = doTypeDescFromTypeInfo (name, invKind, pITypeInfoImpl);
+ pTypeDesc = doTypeDescFromTypeInfo(name, invKind, pITypeInfoImpl);
// release interfaces
- pITypeInfoImpl->ReleaseTypeAttr (pTypeAttrImpl);
+ pITypeInfoImpl->ReleaseTypeAttr(pTypeAttrImpl);
pITypeInfoImpl->Release();
- if (pTypeDesc)
- return pTypeDesc;
+ if (pTypeDesc) return pTypeDesc;
}
return NULL;
}
- pTypeDesc = (MX_TYPEDESC *)scheme_malloc_tagged (sizeof (MX_TYPEDESC));
+ pTypeDesc = (MX_TYPEDESC *)scheme_malloc_tagged(sizeof(MX_TYPEDESC));
pTypeDesc->so.type = mx_com_typedesc_type;
pTypeDesc->released = FALSE;
@@ -1603,38 +1456,36 @@ MX_TYPEDESC *doTypeDescFromTypeInfo (BSTR name, INVOKEKIND invKind,
ITypeInfo *pITypeInfoImpl;
pTypeDesc->funcdescs.pFuncDesc = pFuncDesc;
- hr = pITypeInfo->GetRefTypeOfImplType (-1, &refType);
+ hr = pITypeInfo->GetRefTypeOfImplType(-1, &refType);
if (hr == S_OK) {
- hr = pITypeInfo->GetRefTypeInfo (refType, &pITypeInfoImpl);
+ hr = pITypeInfo->GetRefTypeInfo(refType, &pITypeInfoImpl);
if (hr == S_OK) {
- TYPEATTR *pTypeAttrImpl;
- FUNCDESC *pFuncDescImpl;
- hr = pITypeInfoImpl->GetTypeAttr (&pTypeAttrImpl);
- if (hr == S_OK) {
- implFuncs = pTypeAttrImpl->cFuncs;
- // assumption: impl TypeInfo has FuncDescs in same order
- // as the Dispatch TypeInfo
- // but dispFuncs has IDispatch methods
- funcDescIndex -= dispFuncs - implFuncs;
- hr = pITypeInfoImpl->GetFuncDesc (funcDescIndex, &pFuncDescImpl);
- if (hr == S_OK) {
- if (pFuncDescImpl->funckind == FUNC_VIRTUAL ||
- pFuncDescImpl->funckind == FUNC_PUREVIRTUAL) {
- pTypeDesc->implGuid = pTypeAttrImpl->guid;
- pTypeDesc->funOffset = pFuncDescImpl->oVft/4;
- pTypeDesc->pITypeInfoImpl = pITypeInfoImpl;
- pITypeInfoImpl->AddRef();
- pTypeDesc->funcdescs.pFuncDescImpl = pFuncDescImpl;
- }
- else {
- pITypeInfoImpl->ReleaseFuncDesc (pFuncDescImpl);
- }
- }
- pITypeInfoImpl->ReleaseTypeAttr (pTypeAttrImpl);
- }
- else {
- pITypeInfoImpl->Release();
- }
+ TYPEATTR *pTypeAttrImpl;
+ FUNCDESC *pFuncDescImpl;
+ hr = pITypeInfoImpl->GetTypeAttr(&pTypeAttrImpl);
+ if (hr == S_OK) {
+ implFuncs = pTypeAttrImpl->cFuncs;
+ // assumption: impl TypeInfo has FuncDescs in same order
+ // as the Dispatch TypeInfo
+ // but dispFuncs has IDispatch methods
+ funcDescIndex -= dispFuncs - implFuncs;
+ hr = pITypeInfoImpl->GetFuncDesc(funcDescIndex, &pFuncDescImpl);
+ if (hr == S_OK) {
+ if (pFuncDescImpl->funckind == FUNC_VIRTUAL ||
+ pFuncDescImpl->funckind == FUNC_PUREVIRTUAL) {
+ pTypeDesc->implGuid = pTypeAttrImpl->guid;
+ pTypeDesc->funOffset = pFuncDescImpl->oVft/4;
+ pTypeDesc->pITypeInfoImpl = pITypeInfoImpl;
+ pITypeInfoImpl->AddRef();
+ pTypeDesc->funcdescs.pFuncDescImpl = pFuncDescImpl;
+ } else {
+ pITypeInfoImpl->ReleaseFuncDesc(pFuncDescImpl);
+ }
+ }
+ pITypeInfoImpl->ReleaseTypeAttr(pTypeAttrImpl);
+ } else {
+ pITypeInfoImpl->Release();
+ }
}
}
}
@@ -1647,22 +1498,21 @@ MX_TYPEDESC *doTypeDescFromTypeInfo (BSTR name, INVOKEKIND invKind,
}
static
-MX_TYPEDESC *typeDescFromTypeInfo (LPCTSTR name,
- INVOKEKIND invKind,
- ITypeInfo *pITypeInfo)
+MX_TYPEDESC *typeDescFromTypeInfo(LPCTSTR name, INVOKEKIND invKind,
+ ITypeInfo *pITypeInfo)
{
BSTR unicodeName;
MX_TYPEDESC *retval;
- unicodeName = textToBSTR (name, strlen (name));
- retval = doTypeDescFromTypeInfo (unicodeName, invKind, pITypeInfo);
+ unicodeName = textToBSTR(name, strlen(name));
+ retval = doTypeDescFromTypeInfo(unicodeName, invKind, pITypeInfo);
- SysFreeString (unicodeName);
+ SysFreeString(unicodeName);
return retval;
}
-MX_TYPEDESC *getMethodType (MX_COM_Object *obj, LPCTSTR name, INVOKEKIND invKind)
+MX_TYPEDESC *getMethodType(MX_COM_Object *obj, LPCTSTR name, INVOKEKIND invKind)
{
IDispatch *pIDispatch;
MX_TYPEDESC *pTypeDesc;
@@ -1675,30 +1525,30 @@ MX_TYPEDESC *getMethodType (MX_COM_Object *obj, LPCTSTR name, INVOKEKIND invKind
// check in hash table to see if we already have the type information
- pTypeDesc = lookupTypeDesc (obj, name, invKind);
+ pTypeDesc = lookupTypeDesc(obj, name, invKind);
if (pTypeDesc)
return pTypeDesc;
if (invKind == INVOKE_EVENT) {
- pITypeInfo = eventTypeInfoFromComObject (obj);
-
- if (pITypeInfo == NULL)
- scheme_signal_error ("Can't find event type information");
- } else
- pITypeInfo = typeInfoFromComObject (obj);
+ pITypeInfo = eventTypeInfoFromComObject(obj);
- pTypeDesc = typeDescFromTypeInfo (name, invKind, pITypeInfo);
+ if (pITypeInfo == NULL)
+ scheme_signal_error("Can't find event type information");
+ } else
+ pITypeInfo = typeInfoFromComObject(obj);
+
+ pTypeDesc = typeDescFromTypeInfo(name, invKind, pITypeInfo);
// pTypeDesc may be NULL
if (pTypeDesc != NULL)
- addTypeToTable (obj, name, invKind, pTypeDesc);
+ addTypeToTable(obj, name, invKind, pTypeDesc);
return pTypeDesc;
}
-static int dispatchCmp (const char * s1, const char * * s2)
+static int dispatchCmp(const char * s1, const char * * s2)
{
- return lstrcmp (s1, *s2);
+ return lstrcmp(s1, *s2);
}
static char *dnames[] = { // must be in alpha order
@@ -1711,19 +1561,18 @@ static char *dnames[] = { // must be in alpha order
"Release",
};
-typedef int (*COMP_PROC) (const void *, const void *);
+typedef int (*COMP_PROC)(const void *, const void *);
-BOOL isDispatchName (const char *s)
+BOOL isDispatchName(const char *s)
{
- return bsearch (s, dnames, sizeray (dnames), sizeof (dnames[0]),
- (COMP_PROC)dispatchCmp)
- ? TRUE
- : FALSE;
+ return bsearch(s, dnames, sizeray(dnames), sizeof(dnames[0]),
+ (COMP_PROC)dispatchCmp
+ ) ? TRUE : FALSE;
}
-Scheme_Object *getTypeNames (ITypeInfo *pITypeInfo,
- TYPEATTR *pTypeAttr, Scheme_Object *retval,
- INVOKEKIND invKind)
+Scheme_Object *getTypeNames(ITypeInfo *pITypeInfo,
+ TYPEATTR *pTypeAttr, Scheme_Object *retval,
+ INVOKEKIND invKind)
{
ITypeInfo *pITypeInfoImpl;
TYPEATTR *pTypeAttrImpl;
@@ -1737,26 +1586,26 @@ Scheme_Object *getTypeNames (ITypeInfo *pITypeInfo,
for (i = 0; i < pTypeAttr->cImplTypes; i++) {
HRESULT hr;
- hr = pITypeInfo->GetRefTypeOfImplType (i, &refType);
+ hr = pITypeInfo->GetRefTypeOfImplType(i, &refType);
- if (FAILED (hr))
- scheme_signal_error ("Can't get implementation type library handle");
+ if (FAILED(hr))
+ scheme_signal_error("Can't get implementation type library handle");
- hr = pITypeInfo->GetRefTypeInfo (refType, &pITypeInfoImpl);
+ hr = pITypeInfo->GetRefTypeInfo(refType, &pITypeInfoImpl);
- if (FAILED (hr))
- scheme_signal_error ("Can't get implementation type library");
+ if (FAILED(hr))
+ scheme_signal_error("Can't get implementation type library");
- hr = pITypeInfoImpl->GetTypeAttr (&pTypeAttrImpl);
+ hr = pITypeInfoImpl->GetTypeAttr(&pTypeAttrImpl);
- if (FAILED (hr))
- scheme_signal_error ("Can't get implementation type library attributes");
+ if (FAILED(hr))
+ scheme_signal_error("Can't get implementation type library attributes");
// recursion, to ascend the inheritance graph
- retval = getTypeNames (pITypeInfoImpl, pTypeAttrImpl, retval, invKind);
+ retval = getTypeNames(pITypeInfoImpl, pTypeAttrImpl, retval, invKind);
// release interfaces
- pITypeInfoImpl->ReleaseTypeAttr (pTypeAttrImpl);
+ pITypeInfoImpl->ReleaseTypeAttr(pTypeAttrImpl);
pITypeInfoImpl->Release();
}
@@ -1764,66 +1613,66 @@ Scheme_Object *getTypeNames (ITypeInfo *pITypeInfo,
// or in list of variables
for (i = 0; i < pTypeAttr->cFuncs; i++) {
- char buff[256];
- unsigned int len;
+ char buff[256];
+ unsigned int len;
- pITypeInfo->GetFuncDesc (i, &pFuncDesc);
- if (pFuncDesc->invkind == invKind) {
- pITypeInfo->GetNames (pFuncDesc->memid, &bstr, 1, &count);
+ pITypeInfo->GetFuncDesc(i, &pFuncDesc);
+ if (pFuncDesc->invkind == invKind) {
+ pITypeInfo->GetNames(pFuncDesc->memid, &bstr, 1, &count);
- if (invKind == INVOKE_FUNC) {
- len = SysStringLen (bstr);
- WideCharToMultiByte (CP_ACP, (DWORD)0, bstr, len,
- buff, sizeof (buff) - 1,
- NULL, NULL);
- buff[len] = '\0';
- }
-
- // don't consider names inherited from IDispatch
- if (invKind != INVOKE_FUNC || !isDispatchName (buff))
- retval = scheme_make_pair (BSTRToSchemeString (bstr), retval);
- SysFreeString (bstr);
- }
- pITypeInfo->ReleaseFuncDesc (pFuncDesc);
+ if (invKind == INVOKE_FUNC) {
+ len = SysStringLen(bstr);
+ WideCharToMultiByte(CP_ACP, (DWORD)0, bstr, len,
+ buff, sizeof(buff) - 1, NULL, NULL);
+ buff[len] = '\0';
}
+ // don't consider names inherited from IDispatch
+ if (invKind != INVOKE_FUNC || !isDispatchName(buff))
+ retval = scheme_make_pair(BSTRToSchemeString(bstr), retval);
+ SysFreeString(bstr);
+ }
+ pITypeInfo->ReleaseFuncDesc(pFuncDesc);
+ }
+
if (invKind == INVOKE_FUNC) // done, if not a property
- return retval;
+ return retval;
for (i = 0; i < pTypeAttr->cVars; i++) {
- pITypeInfo->GetVarDesc (i, &pVarDesc);
- pITypeInfo->GetNames (pVarDesc->memid, &bstr, 1, &count);
- retval = scheme_make_pair (BSTRToSchemeString (bstr), retval);
- SysFreeString (bstr);
- pITypeInfo->ReleaseVarDesc (pVarDesc);
- }
+ pITypeInfo->GetVarDesc(i, &pVarDesc);
+ pITypeInfo->GetNames(pVarDesc->memid, &bstr, 1, &count);
+ retval = scheme_make_pair(BSTRToSchemeString(bstr), retval);
+ SysFreeString(bstr);
+ pITypeInfo->ReleaseVarDesc(pVarDesc);
+ }
return retval;
}
-Scheme_Object *mx_do_get_methods (int argc, Scheme_Object **argv, INVOKEKIND invKind)
+Scheme_Object *mx_do_get_methods(int argc, Scheme_Object **argv,
+ INVOKEKIND invKind)
{
ITypeInfo *pITypeInfo;
HRESULT hr;
TYPEATTR *pTypeAttr;
Scheme_Object *retval, *n;
- GUARANTEE_COM_OBJ_OR_TYPE ("com-{methods, {get, set}-properties}", 0);
+ GUARANTEE_COM_OBJ_OR_TYPE("com-{methods, {get, set}-properties}", 0);
- if (MX_COM_TYPEP (argv[0]))
- pITypeInfo = MX_COM_TYPE_VAL (argv[0]);
- else if (MX_COM_OBJ_VAL (argv[0]) == NULL) {
- scheme_signal_error ("com-{methods, {get, set}-properties}: NULL COM object");
+ if (MX_COM_TYPEP(argv[0]))
+ pITypeInfo = MX_COM_TYPE_VAL(argv[0]);
+ else if (MX_COM_OBJ_VAL(argv[0]) == NULL) {
+ scheme_signal_error("com-{methods, {get, set}-properties}: NULL COM object");
return NULL;
} else {
- pITypeInfo = typeInfoFromComObject ((MX_COM_Object *)argv[0]);
+ pITypeInfo = typeInfoFromComObject((MX_COM_Object *)argv[0]);
}
- hr = pITypeInfo->GetTypeAttr (&pTypeAttr);
+ hr = pITypeInfo->GetTypeAttr(&pTypeAttr);
- if (FAILED (hr) || pTypeAttr == NULL) {
- codedComError ("Error getting type attributes", hr);
+ if (FAILED(hr) || pTypeAttr == NULL) {
+ codedComError("Error getting type attributes", hr);
}
n = scheme_null;
@@ -1835,22 +1684,22 @@ Scheme_Object *mx_do_get_methods (int argc, Scheme_Object **argv, INVOKEKIND inv
}
-Scheme_Object *mx_com_methods (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_methods(int argc, Scheme_Object **argv)
{
- return mx_do_get_methods (argc, argv, INVOKE_FUNC);
+ return mx_do_get_methods(argc, argv, INVOKE_FUNC);
}
-Scheme_Object *mx_com_get_properties (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_get_properties(int argc, Scheme_Object **argv)
{
- return mx_do_get_methods (argc, argv, INVOKE_PROPERTYGET);
+ return mx_do_get_methods(argc, argv, INVOKE_PROPERTYGET);
}
-Scheme_Object *mx_com_set_properties (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_set_properties(int argc, Scheme_Object **argv)
{
- return mx_do_get_methods (argc, argv, INVOKE_PROPERTYPUT);
+ return mx_do_get_methods(argc, argv, INVOKE_PROPERTYPUT);
}
-ITypeInfo *coclassTypeInfoFromTypeInfo (ITypeInfo *pITypeInfo, CLSID clsId)
+ITypeInfo *coclassTypeInfoFromTypeInfo(ITypeInfo *pITypeInfo, CLSID clsId)
{
HRESULT hr;
ITypeLib *pITypeLib;
@@ -1866,20 +1715,19 @@ ITypeInfo *coclassTypeInfoFromTypeInfo (ITypeInfo *pITypeInfo, CLSID clsId)
UINT coclassNdx;
UINT i, j;
- hr = pITypeInfo->GetContainingTypeLib (&pITypeLib, &ndx);
+ hr = pITypeInfo->GetContainingTypeLib(&pITypeLib, &ndx);
- if (FAILED (hr))
- scheme_signal_error ("Can't get dispatch type library");
+ if (FAILED(hr)) scheme_signal_error("Can't get dispatch type library");
// first try using explicit clsId
- if (!isEmptyClsId (clsId)) {
- hr = pITypeLib->GetTypeInfoOfGuid (clsId, &pCoclassTypeInfo);
+ if (!isEmptyClsId(clsId)) {
+ hr = pITypeLib->GetTypeInfoOfGuid(clsId, &pCoclassTypeInfo);
pITypeLib->Release();
- if (FAILED (hr) || pCoclassTypeInfo == NULL) {
- codedComError ("Error getting type info for coclass", hr);
+ if (FAILED(hr) || pCoclassTypeInfo == NULL) {
+ codedComError("Error getting type info for coclass", hr);
return NULL;
}
@@ -1897,57 +1745,57 @@ ITypeInfo *coclassTypeInfoFromTypeInfo (ITypeInfo *pITypeInfo, CLSID clsId)
for (i = 0; i < typeInfoCount; i++) {
- pITypeLib->GetTypeInfoType (i, &typeKind);
+ pITypeLib->GetTypeInfoType(i, &typeKind);
if (typeKind == TKIND_COCLASS) {
- hr = pITypeLib->GetTypeInfo (i, &pCoclassTypeInfo);
+ hr = pITypeLib->GetTypeInfo(i, &pCoclassTypeInfo);
- if (FAILED (hr) || pCoclassTypeInfo == NULL) {
- pITypeLib->Release();
- codedComError ("Error getting type info for coclass", hr);
+ if (FAILED(hr) || pCoclassTypeInfo == NULL) {
+ pITypeLib->Release();
+ codedComError("Error getting type info for coclass", hr);
}
- hr = pCoclassTypeInfo->GetTypeAttr (&pTypeAttr);
+ hr = pCoclassTypeInfo->GetTypeAttr(&pTypeAttr);
- if (FAILED (hr) || pTypeAttr == NULL) {
- pCoclassTypeInfo->Release();
- pITypeLib->Release();
- codedComError ("Error getting coclass type attributes", hr);
+ if (FAILED(hr) || pTypeAttr == NULL) {
+ pCoclassTypeInfo->Release();
+ pITypeLib->Release();
+ codedComError("Error getting coclass type attributes", hr);
}
typeCount = pTypeAttr->cImplTypes;
- pCoclassTypeInfo->ReleaseTypeAttr (pTypeAttr);
+ pCoclassTypeInfo->ReleaseTypeAttr(pTypeAttr);
for (j = 0; j < typeCount; j++) {
- hr = pCoclassTypeInfo->GetRefTypeOfImplType (j, &hRefType);
+ hr = pCoclassTypeInfo->GetRefTypeOfImplType(j, &hRefType);
- if (FAILED (hr)) {
- pCoclassTypeInfo->Release();
- pITypeLib->Release();
- codedComError ("Error retrieving type info handle", hr);
- }
+ if (FAILED(hr)) {
+ pCoclassTypeInfo->Release();
+ pITypeLib->Release();
+ codedComError("Error retrieving type info handle", hr);
+ }
- hr = pCoclassTypeInfo->GetRefTypeInfo (hRefType, &pCandidateTypeInfo);
+ hr = pCoclassTypeInfo->GetRefTypeInfo(hRefType, &pCandidateTypeInfo);
- if (FAILED (hr) || pCandidateTypeInfo == NULL) {
- pCoclassTypeInfo->Release();
- pITypeLib->Release();
- codedComError ("Error retrieving candidate type info", hr);
- }
+ if (FAILED(hr) || pCandidateTypeInfo == NULL) {
+ pCoclassTypeInfo->Release();
+ pITypeLib->Release();
+ codedComError("Error retrieving candidate type info", hr);
+ }
- if (typeInfoEq (pCandidateTypeInfo, pITypeInfo)) {
- coclassNdx = i;
- if (++coclassCount >= 2) {
- pCandidateTypeInfo->Release();
- pCoclassTypeInfo->Release();
- pITypeLib->Release();
- scheme_signal_error ("Ambiguous coclass for object");
- }
- }
+ if (typeInfoEq(pCandidateTypeInfo, pITypeInfo)) {
+ coclassNdx = i;
+ if (++coclassCount >= 2) {
+ pCandidateTypeInfo->Release();
+ pCoclassTypeInfo->Release();
+ pITypeLib->Release();
+ scheme_signal_error("Ambiguous coclass for object");
+ }
+ }
- pCandidateTypeInfo->Release();
+ pCandidateTypeInfo->Release();
}
@@ -1961,17 +1809,17 @@ ITypeInfo *coclassTypeInfoFromTypeInfo (ITypeInfo *pITypeInfo, CLSID clsId)
return NULL;
}
- hr = pITypeLib->GetTypeInfo (coclassNdx, &pCoclassTypeInfo);
+ hr = pITypeLib->GetTypeInfo(coclassNdx, &pCoclassTypeInfo);
pITypeLib->Release();
- if (FAILED (hr) || pCoclassTypeInfo == NULL)
- codedComError ("Error getting type info for coclass", hr);
+ if (FAILED(hr) || pCoclassTypeInfo == NULL)
+ codedComError("Error getting type info for coclass", hr);
return pCoclassTypeInfo;
}
-ITypeInfo *eventTypeInfoFromCoclassTypeInfo (ITypeInfo *pCoclassTypeInfo)
+ITypeInfo *eventTypeInfoFromCoclassTypeInfo(ITypeInfo *pCoclassTypeInfo)
{
HRESULT hr;
ITypeInfo *pEventTypeInfo;
@@ -1982,28 +1830,28 @@ ITypeInfo *eventTypeInfoFromCoclassTypeInfo (ITypeInfo *pCoclassTypeInfo)
int typeFlags;
UINT i;
- hr = pCoclassTypeInfo->GetTypeAttr (&pTypeAttr);
+ hr = pCoclassTypeInfo->GetTypeAttr(&pTypeAttr);
- if (FAILED (hr) || pTypeAttr == NULL)
- codedComError ("Error getting type attributes", hr);
+ if (FAILED(hr) || pTypeAttr == NULL)
+ codedComError("Error getting type attributes", hr);
typeCount = pTypeAttr->cImplTypes;
- pCoclassTypeInfo->ReleaseTypeAttr (pTypeAttr);
+ pCoclassTypeInfo->ReleaseTypeAttr(pTypeAttr);
eventTypeInfoNdx = -1;
for (i = 0; i < typeCount; i++) {
- hr = pCoclassTypeInfo->GetImplTypeFlags (i, &typeFlags);
+ hr = pCoclassTypeInfo->GetImplTypeFlags(i, &typeFlags);
- if (FAILED (hr))
- codedComError ("Error retrieving type flags", hr);
+ if (FAILED(hr))
+ codedComError("Error retrieving type flags", hr);
// look for [source, default]
if ((typeFlags & IMPLTYPEFLAG_FSOURCE) &&
- (typeFlags & IMPLTYPEFLAG_FDEFAULT)) {
+ (typeFlags & IMPLTYPEFLAG_FDEFAULT)) {
eventTypeInfoNdx = i;
break;
}
@@ -2012,20 +1860,20 @@ ITypeInfo *eventTypeInfoFromCoclassTypeInfo (ITypeInfo *pCoclassTypeInfo)
if (eventTypeInfoNdx == -1)
return NULL;
- hr = pCoclassTypeInfo->GetRefTypeOfImplType (eventTypeInfoNdx, &hRefType);
+ hr = pCoclassTypeInfo->GetRefTypeOfImplType(eventTypeInfoNdx, &hRefType);
- if (FAILED (hr))
- codedComError ("Error retrieving type info handle", hr);
+ if (FAILED(hr))
+ codedComError("Error retrieving type info handle", hr);
- hr = pCoclassTypeInfo->GetRefTypeInfo (hRefType, &pEventTypeInfo);
+ hr = pCoclassTypeInfo->GetRefTypeInfo(hRefType, &pEventTypeInfo);
- if (FAILED (hr))
- codedComError ("Error retrieving event type info", hr);
+ if (FAILED(hr))
+ codedComError("Error retrieving event type info", hr);
return pEventTypeInfo;
}
-ITypeInfo *eventTypeInfoFromComObject (MX_COM_Object *obj)
+ITypeInfo *eventTypeInfoFromComObject(MX_COM_Object *obj)
{
HRESULT hr;
IDispatch *pIDispatch;
@@ -2041,76 +1889,75 @@ ITypeInfo *eventTypeInfoFromComObject (MX_COM_Object *obj)
/* preferred mechanism for finding coclass ITypeInfo */
- hr = pIDispatch->QueryInterface (IID_IProvideClassInfo,
- (void **)&pIProvideClassInfo);
+ hr = pIDispatch->QueryInterface(IID_IProvideClassInfo,
+ (void **)&pIProvideClassInfo);
- if (SUCCEEDED (hr) && pIProvideClassInfo != NULL) {
+ if (SUCCEEDED(hr) && pIProvideClassInfo != NULL) {
- hr = pIProvideClassInfo->GetClassInfo (&pCoclassTypeInfo);
+ hr = pIProvideClassInfo->GetClassInfo(&pCoclassTypeInfo);
- if (FAILED (hr) || pCoclassTypeInfo == NULL)
- scheme_signal_error ("Error getting coclass type information");
+ if (FAILED(hr) || pCoclassTypeInfo == NULL)
+ scheme_signal_error("Error getting coclass type information");
}
else if (hr == E_NOINTERFACE) {
ITypeInfo *pDispatchTypeInfo;
/* alternate mechanism */
- hr = pIDispatch->GetTypeInfo (0, LOCALE_SYSTEM_DEFAULT, &pDispatchTypeInfo);
+ hr = pIDispatch->GetTypeInfo(0, LOCALE_SYSTEM_DEFAULT, &pDispatchTypeInfo);
- if (FAILED (hr))
- codedComError ("Can't get dispatch type information", hr);
+ if (FAILED(hr))
+ codedComError("Can't get dispatch type information", hr);
- pCoclassTypeInfo = coclassTypeInfoFromTypeInfo (pDispatchTypeInfo,
- obj->clsId);
+ pCoclassTypeInfo = coclassTypeInfoFromTypeInfo(pDispatchTypeInfo,
+ obj->clsId);
pDispatchTypeInfo->Release();
if (pCoclassTypeInfo == NULL)
- scheme_signal_error ("Error getting coclass type information");
+ scheme_signal_error("Error getting coclass type information");
}
else
- codedComError ("Error getting COM event type information", hr);
+ codedComError("Error getting COM event type information", hr);
// have type info for coclass
// event type info is one of the "implemented" interfaces
- pEventTypeInfo = eventTypeInfoFromCoclassTypeInfo (pCoclassTypeInfo);
+ pEventTypeInfo = eventTypeInfoFromCoclassTypeInfo(pCoclassTypeInfo);
pCoclassTypeInfo->Release();
if (pEventTypeInfo == NULL)
- scheme_signal_error ("Error retrieving event type info");
+ scheme_signal_error("Error retrieving event type info");
obj->pEventTypeInfo = pEventTypeInfo;
return pEventTypeInfo;
}
-ITypeInfo *eventTypeInfoFromComType (MX_COM_Type *obj)
+ITypeInfo *eventTypeInfoFromComType(MX_COM_Type *obj)
{
ITypeInfo *pCoclassTypeInfo, *pEventTypeInfo;
- pCoclassTypeInfo = coclassTypeInfoFromTypeInfo (obj->pITypeInfo,
- obj->clsId);
+ pCoclassTypeInfo = coclassTypeInfoFromTypeInfo(obj->pITypeInfo, obj->clsId);
if (pCoclassTypeInfo == NULL)
- scheme_signal_error ("Error getting coclass type information");
+ scheme_signal_error("Error getting coclass type information");
// have type info for coclass
// event type info is one of the "implemented" interfaces
- pEventTypeInfo = eventTypeInfoFromCoclassTypeInfo (pCoclassTypeInfo);
+ pEventTypeInfo = eventTypeInfoFromCoclassTypeInfo(pCoclassTypeInfo);
pCoclassTypeInfo->Release();
if (pEventTypeInfo == NULL)
- scheme_signal_error ("Error retrieving event type info");
+ scheme_signal_error("Error retrieving event type info");
return pEventTypeInfo;
}
-Scheme_Object *mx_com_events (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_events(int argc, Scheme_Object **argv)
{
HRESULT hr;
ITypeInfo *pEventTypeInfo;
@@ -2121,42 +1968,42 @@ Scheme_Object *mx_com_events (int argc, Scheme_Object **argv)
BSTR bstr;
UINT i;
- GUARANTEE_COM_OBJ_OR_TYPE ("com-events", 0);
+ GUARANTEE_COM_OBJ_OR_TYPE("com-events", 0);
pEventTypeInfo =
- MX_COM_TYPEP (argv[0])
- ? eventTypeInfoFromComType ((MX_COM_Type *)argv[0])
- : (MX_COM_OBJ_VAL (argv[0]) == NULL)
- ? (scheme_signal_error ("com-events: NULL COM object"), (ITypeInfo *) NULL)
- : eventTypeInfoFromComObject ((MX_COM_Object *)argv[0]);
+ MX_COM_TYPEP(argv[0])
+ ? eventTypeInfoFromComType((MX_COM_Type *)argv[0])
+ : (MX_COM_OBJ_VAL(argv[0]) == NULL)
+ ? (scheme_signal_error("com-events: NULL COM object"), (ITypeInfo *)NULL)
+ : eventTypeInfoFromComObject((MX_COM_Object *)argv[0]);
// query for outbound interface info
if (pEventTypeInfo == NULL)
- scheme_signal_error ("Can't find event type information");
+ scheme_signal_error("Can't find event type information");
- hr = pEventTypeInfo->GetTypeAttr (&pEventTypeAttr);
+ hr = pEventTypeInfo->GetTypeAttr(&pEventTypeAttr);
- if (FAILED (hr) || pEventTypeAttr == NULL)
- codedComError ("Error retrieving event type attributes", hr);
+ if (FAILED(hr) || pEventTypeAttr == NULL)
+ codedComError("Error retrieving event type attributes", hr);
retval = scheme_null;
for (i = 0; i < pEventTypeAttr->cFuncs; i++) {
- pEventTypeInfo->GetFuncDesc (i, &pFuncDesc);
- pEventTypeInfo->GetNames (pFuncDesc->memid, &bstr, 1, &nameCount);
- retval = scheme_make_pair (BSTRToSchemeString (bstr), retval);
- SysFreeString (bstr);
+ pEventTypeInfo->GetFuncDesc(i, &pFuncDesc);
+ pEventTypeInfo->GetNames(pFuncDesc->memid, &bstr, 1, &nameCount);
+ retval = scheme_make_pair(BSTRToSchemeString(bstr), retval);
+ SysFreeString(bstr);
}
- pEventTypeInfo->ReleaseFuncDesc (pFuncDesc);
- pEventTypeInfo->ReleaseTypeAttr (pEventTypeAttr);
+ pEventTypeInfo->ReleaseFuncDesc(pFuncDesc);
+ pEventTypeInfo->ReleaseTypeAttr(pEventTypeAttr);
return retval;
}
-XFORM_NONGCING VARTYPE getVarTypeFromElemDesc (ELEMDESC * pElemDesc)
+XFORM_NONGCING VARTYPE getVarTypeFromElemDesc(ELEMDESC * pElemDesc)
{
#ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
@@ -2174,16 +2021,16 @@ END_XFORM_SKIP;
static char buff[256];
-Scheme_Object *elemDescToSchemeType (ELEMDESC *pElemDesc, BOOL ignoreByRef, BOOL isOpt)
+Scheme_Object *elemDescToSchemeType(ELEMDESC *pElemDesc, BOOL ignoreByRef,
+ BOOL isOpt)
{
char *s;
BOOL isBox;
VARTYPE vt;
- vt = getVarTypeFromElemDesc (pElemDesc);
+ vt = getVarTypeFromElemDesc(pElemDesc);
- if (ignoreByRef)
- vt &= ~VT_BYREF;
+ if (ignoreByRef) vt &= ~VT_BYREF;
isBox = FALSE;
@@ -2420,42 +2267,35 @@ Scheme_Object *elemDescToSchemeType (ELEMDESC *pElemDesc, BOOL ignoreByRef, BOOL
s = "void";
break;
- default :
-
- {
- char defaultBuff[32];
- sprintf (defaultBuff, "COM-0x%X", vt);
- return scheme_intern_symbol (defaultBuff);
- }
+ default : {
+ char defaultBuff[32];
+ sprintf(defaultBuff, "COM-0x%X", vt);
+ return scheme_intern_symbol(defaultBuff);
+ }
}
if (isBox) {
- if (isOpt)
- sprintf (buff, "%s-box-opt", s);
- else
- sprintf (buff, "%s-box", s);
+ if (isOpt) sprintf(buff, "%s-box-opt", s);
+ else sprintf(buff, "%s-box", s);
}
else {
- if (isOpt)
- sprintf (buff, "%s-opt", s);
- else
- strcpy (buff, s);
+ if (isOpt) sprintf(buff, "%s-opt", s);
+ else strcpy(buff, s);
}
- return scheme_intern_exact_symbol (buff, (unsigned int)strlen (buff));
+ return scheme_intern_exact_symbol(buff, (unsigned int)strlen(buff));
}
-Scheme_Object * mx_make_function_type (Scheme_Object *paramTypes,
- Scheme_Object *returnType)
+Scheme_Object *mx_make_function_type(Scheme_Object *paramTypes,
+ Scheme_Object *returnType)
{
return
- scheme_append (paramTypes,
- scheme_make_pair (scheme_intern_symbol ("->"),
- scheme_make_pair (returnType,
- scheme_null)));
+ scheme_append(paramTypes,
+ scheme_make_pair(scheme_intern_symbol("->"),
+ scheme_make_pair(returnType, scheme_null)));
}
-BOOL isDefaultParam (FUNCDESC *pFuncDesc, short int i)
+BOOL isDefaultParam(FUNCDESC *pFuncDesc, short int i)
{
unsigned short flags;
@@ -2466,7 +2306,7 @@ BOOL isDefaultParam (FUNCDESC *pFuncDesc, short int i)
return ((flags & PARAMFLAG_FOPT) && (flags & PARAMFLAG_FHASDEFAULT));
}
-BOOL isOptionalParam (FUNCDESC *pFuncDesc, short int i)
+BOOL isOptionalParam(FUNCDESC *pFuncDesc, short int i)
{
unsigned short flags;
@@ -2477,7 +2317,7 @@ BOOL isOptionalParam (FUNCDESC *pFuncDesc, short int i)
return (flags & PARAMFLAG_FOPT);
}
-short getOptParamCount (FUNCDESC *pFuncDesc, short hi)
+short getOptParamCount(FUNCDESC *pFuncDesc, short hi)
{
short i;
short numOptParams;
@@ -2485,26 +2325,25 @@ short getOptParamCount (FUNCDESC *pFuncDesc, short hi)
numOptParams = 0;
for (i = hi; i >= 0; i--) {
- if (isOptionalParam (pFuncDesc, i))
+ if (isOptionalParam(pFuncDesc, i))
numOptParams++;
}
return numOptParams;
}
-XFORM_NONGCING BOOL isLastParamRetval (short int numParams,
- INVOKEKIND invKind, FUNCDESC *pFuncDesc)
+XFORM_NONGCING BOOL isLastParamRetval(short int numParams,
+ INVOKEKIND invKind, FUNCDESC *pFuncDesc)
{
return (numParams > 0 &&
- (invKind == INVOKE_PROPERTYGET || invKind == INVOKE_FUNC)
- &&
- (pFuncDesc->lprgelemdescParam[numParams-1].paramdesc.wParamFlags
- & PARAMFLAG_FRETVAL));
+ (invKind == INVOKE_PROPERTYGET || invKind == INVOKE_FUNC)
+ &&
+ (pFuncDesc->lprgelemdescParam[numParams-1].paramdesc.wParamFlags
+ & PARAMFLAG_FRETVAL));
}
-
-Scheme_Object *mx_do_get_method_type (int argc, Scheme_Object **argv,
- INVOKEKIND invKind)
+Scheme_Object *mx_do_get_method_type(int argc, Scheme_Object **argv,
+ INVOKEKIND invKind)
{
MX_TYPEDESC *pTypeDesc;
ITypeInfo* pITypeInfo;
@@ -2519,33 +2358,30 @@ Scheme_Object *mx_do_get_method_type (int argc, Scheme_Object **argv,
BOOL lastParamIsRetval;
int i;
- GUARANTEE_COM_OBJ_OR_TYPE ("com-method-type", 0);
+ GUARANTEE_COM_OBJ_OR_TYPE("com-method-type", 0);
+ if (MX_COM_OBJ_VAL(argv[0]) == NULL)
+ scheme_signal_error("NULL COM object");
- if (MX_COM_OBJ_VAL (argv[0]) == NULL)
- scheme_signal_error ("NULL COM object");
+ v = GUARANTEE_STRSYM("com-method-type", 1);
+ name = schemeToMultiByte(v);
- v = GUARANTEE_STRSYM ("com-method-type", 1);
- name = schemeToMultiByte (v);
+ if (invKind == INVOKE_FUNC && isDispatchName(name))
+ scheme_signal_error("com-method-type: IDispatch methods not available");
- if (invKind == INVOKE_FUNC && isDispatchName (name))
- scheme_signal_error ("com-method-type: IDispatch methods not available");
-
- if (MX_COM_OBJP (argv[0]))
- pTypeDesc = getMethodType ((MX_COM_Object *)argv[0], name, invKind);
+ if (MX_COM_OBJP(argv[0]))
+ pTypeDesc = getMethodType((MX_COM_Object *)argv[0], name, invKind);
else {
- pITypeInfo =
- invKind == INVOKE_EVENT
- ? eventTypeInfoFromComType ((MX_COM_Type *)argv[0])
- : MX_COM_TYPE_VAL (argv[0]);
- pTypeDesc = typeDescFromTypeInfo (name, invKind, pITypeInfo);
- }
+ pITypeInfo =
+ invKind == INVOKE_EVENT
+ ? eventTypeInfoFromComType((MX_COM_Type *)argv[0])
+ : MX_COM_TYPE_VAL(argv[0]);
+ pTypeDesc = typeDescFromTypeInfo(name, invKind, pITypeInfo);
+ }
// pTypeDesc may be NULL if there is no type info.
-
- if (pTypeDesc == NULL)
- return scheme_false;
+ if (pTypeDesc == NULL) return scheme_false;
if (pTypeDesc->descKind == funcDesc) {
pFuncDesc = pTypeDesc->funcdescs.pFuncDesc;
@@ -2554,33 +2390,34 @@ Scheme_Object *mx_do_get_method_type (int argc, Scheme_Object **argv,
numActualParams = pFuncDesc->cParams;
- if (pFuncDesc->cParamsOpt == -1) { // all args > pFuncDesc->cParams - 1 get packaged into SAFEARRAY
+ if (pFuncDesc->cParamsOpt == -1) {
+ // all args > pFuncDesc->cParams - 1 get packaged into SAFEARRAY
// this branch is untested
lastParamIsRetval = FALSE;
- paramTypes = scheme_make_pair (scheme_intern_symbol ("..."), paramTypes);
+ paramTypes = scheme_make_pair(scheme_intern_symbol("..."), paramTypes);
for (i = numActualParams - 1; i >= 0; i--) {
- s = elemDescToSchemeType (&pFuncDesc->lprgelemdescParam[i], FALSE, FALSE);
- paramTypes = scheme_make_pair (s, paramTypes);
+ s = elemDescToSchemeType(&pFuncDesc->lprgelemdescParam[i], FALSE, FALSE);
+ paramTypes = scheme_make_pair(s, paramTypes);
}
- }
- else {
+ } else {
lastParamIsRetval =
- isLastParamRetval (numActualParams, invKind, pFuncDesc);
+ isLastParamRetval(numActualParams, invKind, pFuncDesc);
hiBound = numActualParams - (lastParamIsRetval ? 2 : 1);
// parameters that are optional with a default value in IDL are not
// counted in pFuncDesc->cParamsOpt, so look for default bit flag
- numOptParams = getOptParamCount (pFuncDesc, hiBound);
+ numOptParams = getOptParamCount(pFuncDesc, hiBound);
firstOptArg = hiBound - numOptParams + 1;
for (i = hiBound; i >= 0; i--) {
- s = elemDescToSchemeType (&pFuncDesc->lprgelemdescParam[i], FALSE, i >= firstOptArg);
- paramTypes = scheme_make_pair (s, paramTypes);
+ s = elemDescToSchemeType(&pFuncDesc->lprgelemdescParam[i], FALSE,
+ i >= firstOptArg);
+ paramTypes = scheme_make_pair(s, paramTypes);
}
}
}
@@ -2592,76 +2429,67 @@ Scheme_Object *mx_do_get_method_type (int argc, Scheme_Object **argv,
pVarDesc = pTypeDesc->pVarDesc;
paramTypes = scheme_null;
numActualParams = 0;
- }
- else if (invKind == INVOKE_PROPERTYPUT) {
+ } else if (invKind == INVOKE_PROPERTYPUT) {
pVarDesc = pTypeDesc->pVarDesc;
- paramTypes =
- scheme_make_pair (elemDescToSchemeType (&pVarDesc->elemdescVar, FALSE, FALSE),
- scheme_null);
+ paramTypes = scheme_make_pair(elemDescToSchemeType(&pVarDesc->elemdescVar,
+ FALSE, FALSE),
+ scheme_null);
numActualParams = 1;
}
switch (invKind) {
case INVOKE_FUNC :
-
// if final parameter is marked as retval, use its type
-
returnType = lastParamIsRetval
- ? elemDescToSchemeType (&pFuncDesc->lprgelemdescParam[numActualParams-1], TRUE, FALSE)
- : elemDescToSchemeType (&pFuncDesc->elemdescFunc, TRUE, FALSE);
-
+ ? elemDescToSchemeType(&pFuncDesc->lprgelemdescParam[numActualParams-1],
+ TRUE, FALSE)
+ : elemDescToSchemeType(&pFuncDesc->elemdescFunc, TRUE, FALSE);
break;
case INVOKE_EVENT :
case INVOKE_PROPERTYPUT :
-
- returnType = scheme_intern_symbol ("void");
-
+ returnType = scheme_intern_symbol("void");
break;
case INVOKE_PROPERTYGET :
-
// pTypeDesc->descKind may be either funcDesc or varDesc
-
if (pTypeDesc->descKind == funcDesc)
-
- returnType = (lastParamIsRetval == FALSE || pFuncDesc->cParams == 0)
- ? elemDescToSchemeType (&pFuncDesc->elemdescFunc, TRUE, FALSE)
- : elemDescToSchemeType (&pFuncDesc->lprgelemdescParam[numActualParams-1], TRUE, FALSE);
-
+ returnType = (lastParamIsRetval == FALSE || pFuncDesc->cParams == 0)
+ ? elemDescToSchemeType(&pFuncDesc->elemdescFunc, TRUE, FALSE)
+ : elemDescToSchemeType(&pFuncDesc->lprgelemdescParam[numActualParams-1],
+ TRUE, FALSE);
else // pTypeDesc->descKind == varDesc
- returnType = elemDescToSchemeType (&pVarDesc->elemdescVar, TRUE, FALSE);
-
+ returnType = elemDescToSchemeType(&pVarDesc->elemdescVar, TRUE, FALSE);
break;
}
- return mx_make_function_type (paramTypes, returnType);
+ return mx_make_function_type(paramTypes, returnType);
}
-Scheme_Object *mx_com_method_type (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_method_type(int argc, Scheme_Object **argv)
{
- return mx_do_get_method_type (argc, argv, INVOKE_FUNC);
+ return mx_do_get_method_type(argc, argv, INVOKE_FUNC);
}
-Scheme_Object *mx_com_get_property_type (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_get_property_type(int argc, Scheme_Object **argv)
{
- return mx_do_get_method_type (argc, argv, INVOKE_PROPERTYGET);
+ return mx_do_get_method_type(argc, argv, INVOKE_PROPERTYGET);
}
-Scheme_Object *mx_com_set_property_type (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_set_property_type(int argc, Scheme_Object **argv)
{
- return mx_do_get_method_type (argc, argv, INVOKE_PROPERTYPUT);
+ return mx_do_get_method_type(argc, argv, INVOKE_PROPERTYPUT);
}
-Scheme_Object *mx_com_event_type (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_event_type(int argc, Scheme_Object **argv)
{
- return mx_do_get_method_type (argc, argv, (INVOKEKIND)INVOKE_EVENT);
+ return mx_do_get_method_type(argc, argv, (INVOKEKIND)INVOKE_EVENT);
}
-BOOL schemeValueFitsVarType (Scheme_Object *val, VARTYPE vt)
+BOOL schemeValueFitsVarType(Scheme_Object *val, VARTYPE vt)
{
long int longInt;
unsigned long uLongInt;
@@ -2669,79 +2497,63 @@ BOOL schemeValueFitsVarType (Scheme_Object *val, VARTYPE vt)
switch (vt) {
case VT_NULL :
-
- return SCHEME_VOIDP (val);
+ return SCHEME_VOIDP(val);
case VT_I1 :
case VT_UI1 :
-
- return SCHEME_CHARP (val);
+ return SCHEME_CHARP(val);
case VT_I2 :
-
- return SCHEME_INTP (val) &&
- scheme_get_int_val (val, &longInt) &&
+ return SCHEME_INTP(val) &&
+ scheme_get_int_val(val, &longInt) &&
longInt <= SHRT_MAX && longInt >= SHRT_MIN;
case VT_UI2 :
-
- return SCHEME_INTP (val) &&
- scheme_get_unsigned_int_val (val, &uLongInt) &&
+ return SCHEME_INTP(val) &&
+ scheme_get_unsigned_int_val(val, &uLongInt) &&
uLongInt <= USHRT_MAX;
case VT_I4 :
case VT_INT :
-
- return SCHEME_EXACT_INTEGERP (val) &&
- scheme_get_int_val (val, &longInt);
+ return SCHEME_EXACT_INTEGERP(val) &&
+ scheme_get_int_val(val, &longInt);
case VT_UI4 :
case VT_UINT :
-
- return SCHEME_EXACT_INTEGERP (val) &&
- scheme_get_unsigned_int_val (val, &uLongInt);
+ return SCHEME_EXACT_INTEGERP(val) &&
+ scheme_get_unsigned_int_val(val, &uLongInt);
case VT_R4 :
-
- return SCHEME_FLTP (val) ||
- (SCHEME_DBLP (val) &&
- SCHEME_DBL_VAL (val) >= FLT_MIN &&
- SCHEME_DBL_VAL (val) <= FLT_MAX);
+ return (SCHEME_FLTP(val) ||
+ (SCHEME_DBLP(val) &&
+ SCHEME_DBL_VAL(val) >= FLT_MIN &&
+ SCHEME_DBL_VAL(val) <= FLT_MAX));
case VT_R8 :
-
- return SCHEME_DBLP (val);
+ return SCHEME_DBLP(val);
case VT_BSTR :
-
- return SCHEME_STRSYMP (val);
+ return SCHEME_STRSYMP(val);
case VT_CY :
-
- return MX_CYP (val);
+ return MX_CYP(val);
case VT_DATE :
-
- return MX_DATEP (val);
+ return MX_DATEP(val);
case VT_BOOL :
-
return TRUE; // ain't Scheme great
case VT_ERROR :
-
- return MX_SCODEP (val);
+ return MX_SCODEP(val);
case VT_UNKNOWN :
-
- return MX_IUNKNOWNP (val);
+ return MX_IUNKNOWNP(val);
case VT_DISPATCH :
-
- return MX_COM_OBJP (val);
+ return MX_COM_OBJP(val);
case VT_VARIANT : // we can package anything into a VARIANTARG
-
return TRUE;
case VT_USERDEFINED :
@@ -2755,41 +2567,41 @@ BOOL schemeValueFitsVarType (Scheme_Object *val, VARTYPE vt)
}
-BOOL subArrayFitsVarType (Scheme_Object *val,
- unsigned short numDims, SAFEARRAYBOUND *bounds,
- VARTYPE vt)
+BOOL subArrayFitsVarType(Scheme_Object *val,
+ unsigned short numDims, SAFEARRAYBOUND *bounds,
+ VARTYPE vt)
{
Scheme_Object **els;
unsigned long len;
- if (SCHEME_VECTORP (val) == FALSE)
+ if (SCHEME_VECTORP(val) == FALSE)
return FALSE;
- len = SCHEME_VEC_SIZE (val);
+ len = SCHEME_VEC_SIZE(val);
if (len != bounds->cElements)
return FALSE;
- els = SCHEME_VEC_ELS (val);
+ els = SCHEME_VEC_ELS(val);
if (numDims == 1) { // innermost vector
for (unsigned long i = 0; i < len; i++) {
- if (schemeValueFitsVarType (els[i], vt) == FALSE)
- return FALSE;
+ if (schemeValueFitsVarType(els[i], vt) == FALSE)
+ return FALSE;
}
- }
- else {
+ } else {
for (unsigned long i = 0; i < len; i++) {
// recursion, the programmer's best friend
- if (subArrayFitsVarType (els[i], numDims - 1, bounds XFORM_OK_PLUS 1, vt) == FALSE)
- return FALSE;
+ if (subArrayFitsVarType(els[i], numDims - 1, bounds XFORM_OK_PLUS 1, vt)
+ == FALSE)
+ return FALSE;
}
}
return TRUE;
}
-BOOL schemeValueFitsElemDesc (Scheme_Object *val, ELEMDESC *pElemDesc)
+BOOL schemeValueFitsElemDesc(Scheme_Object *val, ELEMDESC *pElemDesc)
{
unsigned short flags;
@@ -2801,16 +2613,16 @@ BOOL schemeValueFitsElemDesc (Scheme_Object *val, ELEMDESC *pElemDesc)
return TRUE;
if (flags & PARAMFLAG_FHASDEFAULT)
- return schemeValueFitsVarType (val, pElemDesc->paramdesc.pparamdescex->varDefaultValue.vt);
+ return schemeValueFitsVarType(val, pElemDesc->paramdesc.pparamdescex->varDefaultValue.vt);
}
// if array, check we have a vector of proper dimension and contained types
if (pElemDesc->tdesc.vt & VT_ARRAY) {
- return subArrayFitsVarType (val,
- pElemDesc->tdesc.lpadesc->cDims,
- pElemDesc->tdesc.lpadesc->rgbounds,
- pElemDesc->tdesc.lpadesc->tdescElem.vt);
+ return subArrayFitsVarType(val,
+ pElemDesc->tdesc.lpadesc->cDims,
+ pElemDesc->tdesc.lpadesc->rgbounds,
+ pElemDesc->tdesc.lpadesc->tdescElem.vt);
}
@@ -2818,63 +2630,53 @@ BOOL schemeValueFitsElemDesc (Scheme_Object *val, ELEMDESC *pElemDesc)
// if box, check the contained value
if (pElemDesc->tdesc.vt == VT_PTR) {
- // A VT_PTR to a VT_USERDEFINED isn't a box, it's
- // an IUnknown.
- return
- (pElemDesc->tdesc.lptdesc->vt == VT_VARIANT) ? TRUE
- : (pElemDesc->tdesc.lptdesc->vt == VT_USERDEFINED) ? (MX_COM_OBJP (val) || MX_IUNKNOWNP (val))
- : (SCHEME_BOXP (val)
- && schemeValueFitsVarType (SCHEME_BOX_VAL (val), pElemDesc->tdesc.lptdesc->vt));
- }
+ // A VT_PTR to a VT_USERDEFINED isn't a box, it's an IUnknown.
+ return
+ (pElemDesc->tdesc.lptdesc->vt == VT_VARIANT) ? TRUE
+ : (pElemDesc->tdesc.lptdesc->vt == VT_USERDEFINED)
+ ? (MX_COM_OBJP(val) || MX_IUNKNOWNP(val))
+ : (SCHEME_BOXP(val)
+ && schemeValueFitsVarType(SCHEME_BOX_VAL(val),
+ pElemDesc->tdesc.lptdesc->vt));
+ }
// not array or box or default value
- return schemeValueFitsVarType (val, pElemDesc->tdesc.vt);
+ return schemeValueFitsVarType(val, pElemDesc->tdesc.vt);
}
-VARIANT_BOOL schemeValToBool (Scheme_Object *val)
+VARIANT_BOOL schemeValToBool(Scheme_Object *val)
{
- return SCHEME_FALSEP (val) ? 0 : 0xFFFF;
+ return SCHEME_FALSEP(val) ? 0 : 0xFFFF;
}
-VARTYPE schemeValueToVarType (Scheme_Object *obj)
+VARTYPE schemeValueToVarType(Scheme_Object *obj)
{
// test for global constants
- if (SCHEME_FALSEP (obj))
- return VT_BOOL;
-
- if (SCHEME_VOIDP (obj))
- return VT_NULL;
+ if (SCHEME_FALSEP(obj)) return VT_BOOL;
+ if (SCHEME_VOIDP(obj)) return VT_NULL;
// handle fixnums
- if (SCHEME_INTP (obj))
- return VT_I4;
+ if (SCHEME_INTP(obj)) return VT_I4;
// otherwise, dispatch on value type
-
switch (obj->type) {
- case scheme_char_type :
- return VT_UI1;
- case scheme_integer_type :
- return VT_I4;
- case scheme_float_type :
- return VT_R4;
- case scheme_double_type :
- return VT_R8;
+ case scheme_char_type : return VT_UI1;
+ case scheme_integer_type : return VT_I4;
+ case scheme_float_type : return VT_R4;
+ case scheme_double_type : return VT_R8;
case scheme_symbol_type :
case scheme_char_string_type :
- case scheme_byte_string_type :
- return VT_BSTR;
- case scheme_vector_type : // may need to specify elt type
- return VT_ARRAY;
+ case scheme_byte_string_type : return VT_BSTR;
+ case scheme_vector_type : return VT_ARRAY; // may need to specify elt type
}
- scheme_signal_error ("Unable to coerce value to VARIANT");
+ scheme_signal_error("Unable to coerce value to VARIANT");
return 0; // keep compiler happy
}
-XFORM_NONGCING void *allocParamMemory (size_t n)
+XFORM_NONGCING void *allocParamMemory(size_t n)
{
#ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
@@ -2884,7 +2686,7 @@ START_XFORM_SKIP;
// do we need a semaphore here?
- retval = malloc (n);
+ retval = malloc(n);
return retval;
#ifdef MZ_PRECISE_GC
@@ -2892,49 +2694,49 @@ END_XFORM_SKIP;
#endif
}
-void marshalSchemeValueToVariant (Scheme_Object *val, VARIANTARG *pVariantArg)
+void marshalSchemeValueToVariant(Scheme_Object *val, VARIANTARG *pVariantArg)
{
// called when COM type spec allows any VARIANT
// or when COM type spec is unknown
- if (SCHEME_CHARP (val)) {
+ if (SCHEME_CHARP(val)) {
pVariantArg->vt = VT_UI1;
- pVariantArg->bVal = SCHEME_CHAR_VAL (val);
+ pVariantArg->bVal = SCHEME_CHAR_VAL(val);
}
- else if (SCHEME_EXACT_INTEGERP (val)) {
+ else if (SCHEME_EXACT_INTEGERP(val)) {
pVariantArg->vt = VT_I4;
- scheme_get_int_val (val, &pVariantArg->lVal);
+ scheme_get_int_val(val, &pVariantArg->lVal);
}
#ifdef MZ_USE_SINGLE_FLOATS
- else if (SCHEME_FLTP (val)) {
+ else if (SCHEME_FLTP(val)) {
pVariantArg->vt = VT_R4;
- pVariantArg->fltVal = SCHEME_FLT_VAL (val);
+ pVariantArg->fltVal = SCHEME_FLT_VAL(val);
}
#endif
- else if (SCHEME_DBLP (val)) {
+ else if(SCHEME_DBLP(val)) {
pVariantArg->vt = VT_R8;
- pVariantArg->dblVal = SCHEME_DBL_VAL (val);
+ pVariantArg->dblVal = SCHEME_DBL_VAL(val);
}
- else if (SCHEME_STRSYMP (val)) {
+ else if (SCHEME_STRSYMP(val)) {
BSTR bs;
pVariantArg->vt = VT_BSTR;
- bs = schemeToBSTR (val);
+ bs = schemeToBSTR(val);
pVariantArg->bstrVal = bs;
}
- else if (MX_CYP (val)) {
+ else if (MX_CYP(val)) {
pVariantArg->vt = VT_CY;
- pVariantArg->cyVal = MX_CY_VAL (val);
+ pVariantArg->cyVal = MX_CY_VAL(val);
}
- else if (MX_DATEP (val)) {
+ else if (MX_DATEP(val)) {
pVariantArg->vt = VT_DATE;
- pVariantArg->date = MX_DATE_VAL (val);
+ pVariantArg->date = MX_DATE_VAL(val);
}
else if (val == scheme_false) {
@@ -2947,46 +2749,46 @@ void marshalSchemeValueToVariant (Scheme_Object *val, VARIANTARG *pVariantArg)
pVariantArg->boolVal = -1;
}
- else if (MX_SCODEP (val)) {
+ else if (MX_SCODEP(val)) {
pVariantArg->vt = VT_ERROR;
- pVariantArg->scode = MX_SCODE_VAL (val);
+ pVariantArg->scode = MX_SCODE_VAL(val);
}
- else if (MX_COM_OBJP (val)) {
- pVariantArg->pdispVal = MX_COM_OBJ_VAL (val);
+ else if (MX_COM_OBJP(val)) {
+ pVariantArg->pdispVal = MX_COM_OBJ_VAL(val);
pVariantArg->vt = VT_DISPATCH;
}
- else if (MX_IUNKNOWNP (val)) {
+ else if (MX_IUNKNOWNP(val)) {
pVariantArg->vt = VT_UNKNOWN;
- pVariantArg->punkVal = MX_IUNKNOWN_VAL (val);
+ pVariantArg->punkVal = MX_IUNKNOWN_VAL(val);
}
- else if (SCHEME_VECTORP (val)) {
+ else if (SCHEME_VECTORP(val)) {
SAFEARRAY *sa;
VARTYPE vt;
- sa = schemeVectorToSafeArray (val, &vt);
+ sa = schemeVectorToSafeArray(val, &vt);
pVariantArg->vt = vt | VT_ARRAY;
pVariantArg->parray = sa;
}
- else if (scheme_apply (mx_marshal_raw_scheme_objects, 0, NULL) == scheme_false)
- scheme_signal_error ("Unable to inject Scheme value %V into VARIANT", val);
+ else if (scheme_apply(mx_marshal_raw_scheme_objects, 0, NULL) == scheme_false)
+ scheme_signal_error("Unable to inject Scheme value %V into VARIANT", val);
else {
- pVariantArg->vt = VT_INT;
- pVariantArg->intVal = PtrToInt (val);
- }
+ pVariantArg->vt = VT_INT;
+ pVariantArg->intVal = PtrToInt(val);
+ }
return;
}
-void marshalSchemeValue (Scheme_Object *val, VARIANTARG *pVariantArg)
+void marshalSchemeValue(Scheme_Object *val, VARIANTARG *pVariantArg)
{
char errBuff[128];
if (pVariantArg->vt & VT_ARRAY) {
SAFEARRAY *sa;
VARTYPE vt;
- sa = schemeVectorToSafeArray (val, &vt);
+ sa = schemeVectorToSafeArray(val, &vt);
pVariantArg->parray = sa;
if (pVariantArg->vt != vt) {
char buff[256];
@@ -3001,76 +2803,76 @@ void marshalSchemeValue (Scheme_Object *val, VARIANTARG *pVariantArg)
break;
case VT_I1 :
- pVariantArg->cVal = SCHEME_CHAR_VAL (val);
+ pVariantArg->cVal = SCHEME_CHAR_VAL(val);
break;
case VT_I1 | VT_BYREF :
pVariantArg->pcVal =
- (char *)allocParamMemory (sizeof (char));
- *pVariantArg->pcVal = SCHEME_CHAR_VAL (SCHEME_BOX_VAL (val));
+ (char *)allocParamMemory(sizeof(char));
+ *pVariantArg->pcVal = SCHEME_CHAR_VAL(SCHEME_BOX_VAL(val));
break;
case VT_UI1 :
- pVariantArg->bVal = SCHEME_CHAR_VAL (val);
+ pVariantArg->bVal = SCHEME_CHAR_VAL(val);
break;
case VT_UI1 | VT_BYREF :
- pVariantArg->pbVal = (unsigned char *)allocParamMemory (sizeof (unsigned char));
- *pVariantArg->pbVal = (unsigned char)SCHEME_CHAR_VAL (SCHEME_BOX_VAL (val));
+ pVariantArg->pbVal = (unsigned char *)allocParamMemory(sizeof(unsigned char));
+ *pVariantArg->pbVal = (unsigned char)SCHEME_CHAR_VAL(SCHEME_BOX_VAL(val));
break;
case VT_I2 :
- pVariantArg->iVal = (short)SCHEME_INT_VAL (val);
+ pVariantArg->iVal = (short)SCHEME_INT_VAL(val);
break;
case VT_I2 | VT_BYREF :
- pVariantArg->piVal = (short *)allocParamMemory (sizeof (short));
- *pVariantArg->piVal = (short)SCHEME_INT_VAL (SCHEME_BOX_VAL (val));
+ pVariantArg->piVal = (short *)allocParamMemory(sizeof(short));
+ *pVariantArg->piVal = (short)SCHEME_INT_VAL(SCHEME_BOX_VAL(val));
break;
case VT_UI2 :
- pVariantArg->uiVal = (unsigned short)SCHEME_INT_VAL (val);
+ pVariantArg->uiVal = (unsigned short)SCHEME_INT_VAL(val);
break;
case VT_UI2 | VT_BYREF :
- pVariantArg->puiVal = (unsigned short *)allocParamMemory (sizeof (unsigned short));
- *pVariantArg->puiVal = (unsigned short)SCHEME_INT_VAL (SCHEME_BOX_VAL (val));
+ pVariantArg->puiVal = (unsigned short *)allocParamMemory(sizeof(unsigned short));
+ *pVariantArg->puiVal = (unsigned short)SCHEME_INT_VAL(SCHEME_BOX_VAL(val));
break;
case VT_I4 :
- pVariantArg->lVal = SCHEME_INT_VAL (val);
+ pVariantArg->lVal = SCHEME_INT_VAL(val);
break;
case VT_I4 | VT_BYREF :
- pVariantArg->plVal = (long *)allocParamMemory (sizeof (long));
- *pVariantArg->plVal = (long)SCHEME_INT_VAL (SCHEME_BOX_VAL (val));
+ pVariantArg->plVal = (long *)allocParamMemory(sizeof(long));
+ *pVariantArg->plVal = (long)SCHEME_INT_VAL(SCHEME_BOX_VAL(val));
break;
case VT_UI4 :
- pVariantArg->ulVal = SCHEME_INT_VAL (val);
+ pVariantArg->ulVal = SCHEME_INT_VAL(val);
break;
case VT_UI4 | VT_BYREF :
- pVariantArg->pulVal = (unsigned long *)allocParamMemory (sizeof (unsigned long));
- *pVariantArg->pulVal = (unsigned long)SCHEME_INT_VAL (SCHEME_BOX_VAL (val));
+ pVariantArg->pulVal = (unsigned long *)allocParamMemory(sizeof(unsigned long));
+ *pVariantArg->pulVal = (unsigned long)SCHEME_INT_VAL(SCHEME_BOX_VAL(val));
break;
case VT_INT :
- pVariantArg->intVal = SCHEME_INT_VAL (val);
+ pVariantArg->intVal = SCHEME_INT_VAL(val);
break;
case VT_INT | VT_BYREF :
- pVariantArg->pintVal = (int *)allocParamMemory (sizeof (long));
- *pVariantArg->pintVal = (int)SCHEME_INT_VAL (SCHEME_BOX_VAL (val));
+ pVariantArg->pintVal = (int *)allocParamMemory(sizeof(long));
+ *pVariantArg->pintVal = (int)SCHEME_INT_VAL(SCHEME_BOX_VAL(val));
break;
case VT_UINT :
- pVariantArg->uintVal = SCHEME_INT_VAL (val);
+ pVariantArg->uintVal = SCHEME_INT_VAL(val);
break;
case VT_UINT | VT_BYREF :
- pVariantArg->puintVal = (unsigned int *)allocParamMemory (sizeof (long));
- *pVariantArg->puintVal = (unsigned int)SCHEME_INT_VAL (SCHEME_BOX_VAL (val));
+ pVariantArg->puintVal = (unsigned int *)allocParamMemory(sizeof(long));
+ *pVariantArg->puintVal = (unsigned int)SCHEME_INT_VAL(SCHEME_BOX_VAL(val));
break;
// VT_USERDEFINED in the typeDesc indicates an ENUM,
@@ -3081,31 +2883,31 @@ void marshalSchemeValue (Scheme_Object *val, VARIANTARG *pVariantArg)
// ** A REFERENCE TO AN INT
case VT_USERDEFINED:
pVariantArg->vt = VT_INT;
- pVariantArg->intVal = SCHEME_INT_VAL (val);
+ pVariantArg->intVal = SCHEME_INT_VAL(val);
break;
case VT_R4 :
- pVariantArg->fltVal = (float)SCHEME_DBL_VAL (val);
+ pVariantArg->fltVal = (float)SCHEME_DBL_VAL(val);
break;
case VT_R4 | VT_BYREF :
- pVariantArg->pfltVal = (float *)allocParamMemory (sizeof (float));
- *pVariantArg->pfltVal = (float)SCHEME_DBL_VAL (SCHEME_BOX_VAL (val));
+ pVariantArg->pfltVal = (float *)allocParamMemory(sizeof(float));
+ *pVariantArg->pfltVal = (float)SCHEME_DBL_VAL(SCHEME_BOX_VAL(val));
break;
case VT_R8 :
- pVariantArg->dblVal = SCHEME_DBL_VAL (val);
+ pVariantArg->dblVal = SCHEME_DBL_VAL(val);
break;
case VT_R8 | VT_BYREF :
- pVariantArg->pdblVal = (double *)allocParamMemory (sizeof (double));
- *pVariantArg->pdblVal = (double)SCHEME_DBL_VAL (SCHEME_BOX_VAL (val));
+ pVariantArg->pdblVal = (double *)allocParamMemory(sizeof(double));
+ *pVariantArg->pdblVal = (double)SCHEME_DBL_VAL(SCHEME_BOX_VAL(val));
break;
case VT_BSTR :
{
BSTR bs;
- bs = schemeToBSTR (val);
+ bs = schemeToBSTR(val);
pVariantArg->bstrVal = bs;
}
break;
@@ -3113,34 +2915,34 @@ void marshalSchemeValue (Scheme_Object *val, VARIANTARG *pVariantArg)
case VT_BSTR | VT_BYREF :
{
BSTR bs;
- pVariantArg->pbstrVal = (BSTR *)allocParamMemory (sizeof (BSTR));
- bs = schemeToBSTR (val);
+ pVariantArg->pbstrVal = (BSTR *)allocParamMemory(sizeof(BSTR));
+ bs = schemeToBSTR(val);
*pVariantArg->pbstrVal = bs;
}
break;
case VT_CY :
- pVariantArg->cyVal = MX_CY_VAL (val);
+ pVariantArg->cyVal = MX_CY_VAL(val);
break;
case VT_CY | VT_BYREF :
- pVariantArg->pcyVal = (CY *)allocParamMemory (sizeof (CY));
- *pVariantArg->pcyVal = (CY)MX_CY_VAL (val);
+ pVariantArg->pcyVal = (CY *)allocParamMemory(sizeof(CY));
+ *pVariantArg->pcyVal = (CY)MX_CY_VAL(val);
break;
case VT_DATE :
- pVariantArg->date = MX_DATE_VAL (val);
+ pVariantArg->date = MX_DATE_VAL(val);
break;
case VT_DATE | VT_BYREF :
- pVariantArg->pdate = (DATE *)allocParamMemory (sizeof (DATE));
- *pVariantArg->pdate = (DATE)MX_DATE_VAL (val);
+ pVariantArg->pdate = (DATE *)allocParamMemory(sizeof(DATE));
+ *pVariantArg->pdate = (DATE)MX_DATE_VAL(val);
break;
case VT_BOOL :
{
BOOL b;
- b = schemeValToBool (val);
+ b = schemeValToBool(val);
pVariantArg->boolVal = b;
}
break;
@@ -3148,28 +2950,28 @@ void marshalSchemeValue (Scheme_Object *val, VARIANTARG *pVariantArg)
case VT_BOOL | VT_BYREF :
{
BOOL b;
- pVariantArg->pboolVal = (VARIANT_BOOL *)allocParamMemory (sizeof (VARIANT_BOOL));
- b = schemeValToBool (val);
+ pVariantArg->pboolVal = (VARIANT_BOOL *)allocParamMemory(sizeof(VARIANT_BOOL));
+ b = schemeValToBool(val);
*pVariantArg->pboolVal = b;
}
break;
case VT_ERROR :
- pVariantArg->scode = MX_SCODE_VAL (val);
+ pVariantArg->scode = MX_SCODE_VAL(val);
break;
case VT_ERROR | VT_BYREF :
- pVariantArg->pscode = (SCODE *)allocParamMemory (sizeof (SCODE));
- *pVariantArg->pscode = MX_SCODE_VAL (SCHEME_BOX_VAL (val));
+ pVariantArg->pscode = (SCODE *)allocParamMemory(sizeof(SCODE));
+ *pVariantArg->pscode = MX_SCODE_VAL(SCHEME_BOX_VAL(val));
break;
case VT_DISPATCH :
- pVariantArg->pdispVal = MX_COM_OBJ_VAL (val);
+ pVariantArg->pdispVal = MX_COM_OBJ_VAL(val);
break;
case VT_DISPATCH | VT_BYREF :
- pVariantArg->ppdispVal = (IDispatch **)allocParamMemory (sizeof (IDispatch *));
- *pVariantArg->ppdispVal = MX_COM_OBJ_VAL (SCHEME_BOX_VAL (val));
+ pVariantArg->ppdispVal = (IDispatch **)allocParamMemory(sizeof(IDispatch *));
+ *pVariantArg->ppdispVal = MX_COM_OBJ_VAL(SCHEME_BOX_VAL(val));
break;
// VT_USERDEFINED | VT_BYREF indicates that we should pass
@@ -3180,59 +2982,59 @@ void marshalSchemeValue (Scheme_Object *val, VARIANTARG *pVariantArg)
case VT_USERDEFINED | VT_BYREF :
pVariantArg->vt = VT_UNKNOWN;
- if (MX_COM_OBJP (val))
- // shouldn't fail
- MX_COM_OBJ_VAL (val)->QueryInterface (IID_IUnknown, (void **)&pVariantArg->punkVal);
-
- else if (MX_IUNKNOWNP (val))
- pVariantArg->punkVal = MX_COM_OBJ_VAL (val);
+ if (MX_COM_OBJP(val))
+ // shouldn't fail
+ MX_COM_OBJ_VAL(val)->QueryInterface(IID_IUnknown,
+ (void **)&pVariantArg->punkVal);
+ else if (MX_IUNKNOWNP(val))
+ pVariantArg->punkVal = MX_COM_OBJ_VAL(val);
// should never happen
else
- scheme_signal_error ("Attempt to marshal non-com object into VT_USERDEFINED");
+ scheme_signal_error("Attempt to marshal non-com object "
+ "into VT_USERDEFINED");
break;
case VT_VARIANT | VT_BYREF :
// pass boxed value of almost-arbitrary type
{
VARTYPE vt;
- pVariantArg->pvarVal = (VARIANTARG *) allocParamMemory (sizeof (VARIANTARG));
- vt = schemeValueToVarType (val);
+ pVariantArg->pvarVal = (VARIANTARG *)allocParamMemory(sizeof(VARIANTARG));
+ vt = schemeValueToVarType(val);
pVariantArg->pvarVal->vt = vt;
- marshalSchemeValue (val, pVariantArg->pvarVal);
+ marshalSchemeValue(val, pVariantArg->pvarVal);
}
break;
case VT_UNKNOWN :
- pVariantArg->punkVal = MX_IUNKNOWN_VAL (val);
+ pVariantArg->punkVal = MX_IUNKNOWN_VAL(val);
break;
case VT_UNKNOWN | VT_BYREF :
- pVariantArg->ppunkVal = (IUnknown **)allocParamMemory (sizeof (IUnknown *));
- *pVariantArg->ppunkVal = MX_IUNKNOWN_VAL (SCHEME_BOX_VAL (val));
+ pVariantArg->ppunkVal = (IUnknown **)allocParamMemory(sizeof(IUnknown *));
+ *pVariantArg->ppunkVal = MX_IUNKNOWN_VAL(SCHEME_BOX_VAL(val));
break;
case VT_VARIANT :
- marshalSchemeValueToVariant (val, pVariantArg);
+ marshalSchemeValueToVariant(val, pVariantArg);
break;
case VT_PTR:
- scheme_signal_error ("unable to marshal VT_PTR");
+ scheme_signal_error("unable to marshal VT_PTR");
break;
default :
- sprintf (errBuff, "Unable to marshal Scheme value into VARIANT: 0x%X",
- pVariantArg->vt);
- scheme_signal_error (errBuff);
-
+ sprintf(errBuff, "Unable to marshal Scheme value into VARIANT: 0x%X",
+ pVariantArg->vt);
+ scheme_signal_error(errBuff);
}
}
-Scheme_Object *variantToSchemeObject (VARIANTARG *pVariantArg)
+Scheme_Object *variantToSchemeObject(VARIANTARG *pVariantArg)
{
char errBuff[128];
if (pVariantArg->vt & VT_ARRAY)
- return safeArrayToSchemeVector (pVariantArg->parray);
+ return safeArrayToSchemeVector(pVariantArg->parray);
switch (pVariantArg->vt) {
@@ -3241,70 +3043,70 @@ Scheme_Object *variantToSchemeObject (VARIANTARG *pVariantArg)
return scheme_void;
case VT_I1 :
- return scheme_make_char (pVariantArg->cVal);
+ return scheme_make_char(pVariantArg->cVal);
case VT_I2 :
- return scheme_make_integer_value (pVariantArg->iVal);
+ return scheme_make_integer_value(pVariantArg->iVal);
case VT_I4 :
- return scheme_make_integer (pVariantArg->lVal);
+ return scheme_make_integer(pVariantArg->lVal);
case VT_I8 :
- return scheme_make_integer_value_from_long_long (pVariantArg->llVal);
+ return scheme_make_integer_value_from_long_long(pVariantArg->llVal);
case VT_UI1 :
- return scheme_make_char ((char) (pVariantArg->bVal));
+ return scheme_make_char((char)(pVariantArg->bVal));
case VT_UI2 :
- return scheme_make_integer (pVariantArg->uiVal);
+ return scheme_make_integer(pVariantArg->uiVal);
case VT_UI4 :
- return scheme_make_integer_value_from_unsigned (pVariantArg->ulVal);
+ return scheme_make_integer_value_from_unsigned(pVariantArg->ulVal);
case VT_UI8 :
- return scheme_make_integer_value_from_unsigned_long_long (pVariantArg->ullVal);
+ return scheme_make_integer_value_from_unsigned_long_long(pVariantArg->ullVal);
case VT_INT :
- return scheme_make_integer (pVariantArg->intVal);
+ return scheme_make_integer(pVariantArg->intVal);
case VT_UINT :
- return scheme_make_integer_value_from_unsigned (pVariantArg->uintVal);
+ return scheme_make_integer_value_from_unsigned(pVariantArg->uintVal);
case VT_R4 :
#ifdef MZ_USE_SINGLE_FLOATS
- return scheme_make_float (pVariantArg->fltVal);
+ return scheme_make_float(pVariantArg->fltVal);
#else
- return scheme_make_double ((double) (pVariantArg->fltVal));
+ return scheme_make_double((double)(pVariantArg->fltVal));
#endif
case VT_R8 :
- return scheme_make_double (pVariantArg->dblVal);
+ return scheme_make_double(pVariantArg->dblVal);
case VT_BSTR :
- return unmarshalBSTR (pVariantArg->bstrVal);
+ return unmarshalBSTR(pVariantArg->bstrVal);
case VT_CY :
- return mx_make_cy (&pVariantArg->cyVal);
+ return mx_make_cy(&pVariantArg->cyVal);
case VT_DATE :
- return mx_make_date (&pVariantArg->date);
+ return mx_make_date(&pVariantArg->date);
case VT_BOOL :
- return mx_make_bool (pVariantArg->boolVal);
+ return mx_make_bool(pVariantArg->boolVal);
case VT_ERROR :
- return mx_make_scode (pVariantArg->scode);
+ return mx_make_scode(pVariantArg->scode);
case VT_DISPATCH :
- return mx_make_idispatch (pVariantArg->pdispVal);
+ return mx_make_idispatch(pVariantArg->pdispVal);
case VT_UNKNOWN :
- return mx_make_iunknown (pVariantArg->punkVal);
+ return mx_make_iunknown(pVariantArg->punkVal);
default :
- sprintf (errBuff, "Can't make Scheme value from VARIANT 0x%X",
- pVariantArg->vt);
- scheme_signal_error (errBuff);
+ sprintf(errBuff, "Can't make Scheme value from VARIANT 0x%X",
+ pVariantArg->vt);
+ scheme_signal_error(errBuff);
}
@@ -3323,75 +3125,57 @@ Scheme_Object *variantArgToSchemeObject(VARIANTARG *pVariantArg) {
switch(pVariantArg->vt) {
case VT_NULL :
-
return scheme_make_void();
case VT_I1 :
-
return scheme_make_char(pVariantArg->cVal);
case VT_I1 | VT_BYREF :
-
return scheme_box(scheme_make_char(*pVariantArg->pcVal));
case VT_UI1 :
-
return scheme_make_char((char)(pVariantArg->bVal));
case VT_UI1 | VT_BYREF :
-
return scheme_box(scheme_make_char((char)(*pVariantArg->pbVal)));
case VT_UI2 :
-
return scheme_make_char((char)(pVariantArg->bVal));
case VT_UI2 | VT_BYREF :
-
return scheme_box(scheme_make_char((char)(*pVariantArg->pbVal)));
case VT_I2 :
-
return scheme_make_integer(pVariantArg->iVal);
case VT_I2 | VT_BYREF :
-
return scheme_box(scheme_make_integer(*pVariantArg->piVal));
case VT_I4 :
-
return scheme_make_integer_value(pVariantArg->lVal);
case VT_I4 | VT_BYREF :
-
return scheme_box(scheme_make_integer_value(*pVariantArg->plVal));
case VT_UI4 :
-
return scheme_make_integer_value_from_unsigned(pVariantArg->ulVal);
case VT_UI4 | VT_BYREF :
-
return scheme_box(scheme_make_integer_value_from_unsigned(*pVariantArg->pulVal));
case VT_INT :
-
return scheme_make_integer_value(pVariantArg->intVal);
case VT_INT | VT_BYREF :
-
return scheme_box(scheme_make_integer_value(*pVariantArg->pintVal));
case VT_UINT :
-
return scheme_make_integer_value_from_unsigned(pVariantArg->uintVal);
case VT_UINT | VT_BYREF :
-
return scheme_box(scheme_make_integer_value_from_unsigned(*pVariantArg->puintVal));
case VT_R4 :
-
#ifdef MZ_USE_SINGLE_FLOATS
return scheme_make_float(pVariantArg->fltVal);
#else
@@ -3399,7 +3183,6 @@ Scheme_Object *variantArgToSchemeObject(VARIANTARG *pVariantArg) {
#endif
case VT_R4 | VT_BYREF :
-
#ifdef MZ_USE_SINGLE_FLOATS
return scheme_box(scheme_make_float(*pVariantArg->pfltVal));
#else
@@ -3407,82 +3190,64 @@ Scheme_Object *variantArgToSchemeObject(VARIANTARG *pVariantArg) {
#endif
case VT_R8 :
-
return scheme_make_double(pVariantArg->dblVal);
case VT_R8 | VT_BYREF :
-
return scheme_box(scheme_make_double(*pVariantArg->pdblVal));
case VT_BSTR :
-
- return unmarshalBSTR (pVariantArg->bstrVal);
+ return unmarshalBSTR(pVariantArg->bstrVal);
case VT_BSTR | VT_BYREF :
-
- return scheme_box (unmarshalBSTR (*pVariantArg->pbstrVal));
+ return scheme_box(unmarshalBSTR(*pVariantArg->pbstrVal));
case VT_CY :
-
return mx_make_cy(&pVariantArg->cyVal);
case VT_CY | VT_BYREF :
-
return scheme_box(mx_make_cy(pVariantArg->pcyVal));
case VT_DATE :
-
return mx_make_date(&pVariantArg->date);
case VT_DATE | VT_BYREF :
-
return scheme_box(mx_make_date(pVariantArg->pdate));
case VT_BOOL :
-
return mx_make_bool(pVariantArg->boolVal);
case VT_BOOL | VT_BYREF :
-
return scheme_box(mx_make_bool(*pVariantArg->pboolVal));
case VT_ERROR :
-
return mx_make_scode(pVariantArg->scode);
case VT_ERROR | VT_BYREF :
-
return scheme_box(mx_make_scode(*pVariantArg->pscode));
case VT_DISPATCH :
-
// event sources typically don't call AddRef()
pVariantArg->pdispVal->AddRef();
return mx_make_idispatch(pVariantArg->pdispVal);
case VT_DISPATCH | VT_BYREF :
-
(*pVariantArg->ppdispVal)->AddRef();
return scheme_box(mx_make_idispatch(*pVariantArg->ppdispVal));
case VT_UNKNOWN :
-
pVariantArg->punkVal->AddRef();
return mx_make_iunknown(pVariantArg->punkVal);
case VT_UNKNOWN | VT_BYREF:
-
(*pVariantArg->ppunkVal)->AddRef();
return scheme_box(mx_make_iunknown(*pVariantArg->ppunkVal));
case VT_VARIANT | VT_BYREF:
-
return scheme_box(variantArgToSchemeObject(pVariantArg->pvarVal));
default :
-
- wsprintf(errBuff,"Can't make Scheme value from VARIANT 0x%X",
- pVariantArg->vt);
+ wsprintf(errBuff, "Can't make Scheme value from VARIANT 0x%X",
+ pVariantArg->vt);
scheme_signal_error(errBuff);
}
@@ -3491,7 +3256,7 @@ Scheme_Object *variantArgToSchemeObject(VARIANTARG *pVariantArg) {
static void handlerUpdateError(char *s) {
scheme_signal_error("Handler updated box with value other than "
- "expected type: %s",s);
+ "expected type: %s",s);
}
static BOOL isShortInt(Scheme_Object *o) {
@@ -3588,8 +3353,8 @@ void unmarshalArgSchemeObject(Scheme_Object *obj,VARIANTARG *pVariantArg) {
BSTR bstr2;
- if (SCHEME_STRSYMP (val) == FALSE)
- handlerUpdateError ("string or symbol");
+ if (SCHEME_STRSYMP(val) == FALSE)
+ handlerUpdateError("string or symbol");
bstr2 = schemeToBSTR(val);
wcscpy(*(pVariantArg->pbstrVal),bstr2);
@@ -3678,195 +3443,196 @@ void unmarshalArgSchemeObject(Scheme_Object *obj,VARIANTARG *pVariantArg) {
// we need this for direct calls, where the return value
// is created by passing as a C pointer, which is stored in a VARIANTARG
-Scheme_Object *retvalVariantToSchemeObject (VARIANTARG *pVariantArg)
+Scheme_Object *retvalVariantToSchemeObject(VARIANTARG *pVariantArg)
{
switch (pVariantArg->vt) {
case VT_HRESULT :
case VT_VOID :
return scheme_void;
case VT_BYREF|VT_UI1 :
- return scheme_make_char (*pVariantArg->pcVal);
+ return scheme_make_char(*pVariantArg->pcVal);
case VT_BYREF|VT_I2 :
- return scheme_make_integer (*pVariantArg->piVal);
+ return scheme_make_integer(*pVariantArg->piVal);
case VT_BYREF|VT_I4 :
- return scheme_make_integer_value (*pVariantArg->plVal);
+ return scheme_make_integer_value(*pVariantArg->plVal);
case VT_BYREF|VT_I8 :
return
- scheme_make_integer_value_from_long_long (*pVariantArg->pllVal);
+ scheme_make_integer_value_from_long_long(*pVariantArg->pllVal);
case VT_BYREF|VT_R4 :
#ifdef MZ_USE_SINGLE_FLOATS
- return scheme_make_float (*pVariantArg->pfltVal);
+ return scheme_make_float(*pVariantArg->pfltVal);
#else
- return scheme_make_double ((double) (*pVariantArg->pfltVal));
+ return scheme_make_double((double)(*pVariantArg->pfltVal));
#endif
case VT_BYREF|VT_R8 :
- return scheme_make_double (*pVariantArg->pdblVal);
+ return scheme_make_double(*pVariantArg->pdblVal);
case VT_BYREF|VT_BOOL :
- return mx_make_bool (*pVariantArg->pboolVal);
+ return mx_make_bool(*pVariantArg->pboolVal);
case VT_BYREF|VT_ERROR :
- return mx_make_scode (*pVariantArg->pscode);
+ return mx_make_scode(*pVariantArg->pscode);
case VT_BYREF|VT_CY :
- return mx_make_cy (pVariantArg->pcyVal);
+ return mx_make_cy(pVariantArg->pcyVal);
case VT_BYREF|VT_DATE :
- return mx_make_date (pVariantArg->pdate);
+ return mx_make_date(pVariantArg->pdate);
case VT_BYREF|VT_BSTR :
- return unmarshalBSTR (*pVariantArg->pbstrVal);
+ return unmarshalBSTR(*pVariantArg->pbstrVal);
case VT_BYREF|VT_UNKNOWN :
- return mx_make_iunknown (*pVariantArg->ppunkVal);
+ return mx_make_iunknown(*pVariantArg->ppunkVal);
case VT_BYREF|VT_PTR :
case VT_BYREF|VT_DISPATCH :
- return mx_make_idispatch (*pVariantArg->ppdispVal);
+ return mx_make_idispatch(*pVariantArg->ppdispVal);
case VT_BYREF|VT_SAFEARRAY :
case VT_BYREF|VT_ARRAY :
- return safeArrayToSchemeVector (*pVariantArg->pparray);
+ return safeArrayToSchemeVector(*pVariantArg->pparray);
case VT_BYREF|VT_VARIANT :
- return variantToSchemeObject (pVariantArg->pvarVal);
+ return variantToSchemeObject(pVariantArg->pvarVal);
case VT_BYREF|VT_I1 :
- return scheme_make_char (*pVariantArg->pcVal);
+ return scheme_make_char(*pVariantArg->pcVal);
case VT_BYREF|VT_UI2 :
- return scheme_make_integer_value_from_unsigned (*pVariantArg->puiVal);
+ return scheme_make_integer_value_from_unsigned(*pVariantArg->puiVal);
case VT_BYREF|VT_UI4 :
- return scheme_make_integer_value_from_unsigned (*pVariantArg->pulVal);
+ return scheme_make_integer_value_from_unsigned(*pVariantArg->pulVal);
case VT_BYREF|VT_UI8 :
return
- scheme_make_integer_value_from_unsigned_long_long (*pVariantArg->pullVal);
+ scheme_make_integer_value_from_unsigned_long_long(*pVariantArg->pullVal);
case VT_BYREF|VT_INT :
- return scheme_make_integer_value (*pVariantArg->pintVal);
+ return scheme_make_integer_value(*pVariantArg->pintVal);
case VT_BYREF|VT_UINT :
- return scheme_make_integer_value_from_unsigned (*pVariantArg->puintVal);
+ return scheme_make_integer_value_from_unsigned(*pVariantArg->puintVal);
default :
- {char buff[128];
- sprintf (buff, "Can't create return value for VARIANT 0x%X", pVariantArg->vt);
- scheme_signal_error (buff); }
+ {
+ char buff[128];
+ sprintf(buff, "Can't create return value for VARIANT 0x%X",
+ pVariantArg->vt);
+ scheme_signal_error(buff);
+ }
}
return NULL;
}
-void unmarshalVariant (Scheme_Object *val, VARIANTARG *pVariantArg)
+void unmarshalVariant(Scheme_Object *val, VARIANTARG *pVariantArg)
{
Scheme_Object *v;
switch (pVariantArg->vt) {
case VT_I1 | VT_BYREF :
- v = scheme_make_char (*pVariantArg->pcVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->pcVal);
+ v = scheme_make_char(*pVariantArg->pcVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->pcVal);
break;
case VT_UI1 | VT_BYREF :
- v = scheme_make_char ((char) (*pVariantArg->pbVal));
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->pbVal);
+ v = scheme_make_char((char)(*pVariantArg->pbVal));
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->pbVal);
break;
case VT_I2 | VT_BYREF :
- v = scheme_make_integer (*pVariantArg->piVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->piVal);
+ v = scheme_make_integer(*pVariantArg->piVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->piVal);
break;
case VT_UI2 | VT_BYREF :
- v = scheme_make_integer_value_from_unsigned (*pVariantArg->puiVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->puiVal);
+ v = scheme_make_integer_value_from_unsigned(*pVariantArg->puiVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->puiVal);
break;
case VT_I4 | VT_BYREF :
- v = scheme_make_integer_value (*pVariantArg->plVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->plVal);
+ v = scheme_make_integer_value(*pVariantArg->plVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->plVal);
break;
case VT_UI4 | VT_BYREF :
- v = scheme_make_integer_value_from_unsigned (*pVariantArg->pulVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->pulVal);
+ v = scheme_make_integer_value_from_unsigned(*pVariantArg->pulVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->pulVal);
break;
case VT_INT | VT_BYREF :
- v = scheme_make_integer_value (*pVariantArg->pintVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->pintVal);
+ v = scheme_make_integer_value(*pVariantArg->pintVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->pintVal);
break;
case VT_UINT | VT_BYREF :
- v = scheme_make_integer_value_from_unsigned (*pVariantArg->puintVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->puintVal);
+ v = scheme_make_integer_value_from_unsigned(*pVariantArg->puintVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->puintVal);
break;
case VT_R4 | VT_BYREF :
- v = scheme_make_float (*pVariantArg->pfltVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->pfltVal);
+ v = scheme_make_float(*pVariantArg->pfltVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->pfltVal);
break;
case VT_R8 | VT_BYREF :
- v = scheme_make_double (*pVariantArg->pdblVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->pdblVal);
+ v = scheme_make_double(*pVariantArg->pdblVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->pdblVal);
break;
case VT_CY | VT_BYREF :
- v = mx_make_cy (pVariantArg->pcyVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->pcyVal);
+ v = mx_make_cy(pVariantArg->pcyVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->pcyVal);
break;
case VT_DATE | VT_BYREF :
- v = mx_make_date (pVariantArg->pdate);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->pdate);
+ v = mx_make_date(pVariantArg->pdate);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->pdate);
break;
case VT_BOOL | VT_BYREF :
- v = mx_make_bool (*pVariantArg->pboolVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->pboolVal);
+ v = mx_make_bool(*pVariantArg->pboolVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->pboolVal);
break;
case VT_ERROR | VT_BYREF :
- v = mx_make_scode (*pVariantArg->pscode);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->pscode);
+ v = mx_make_scode(*pVariantArg->pscode);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->pscode);
break;
case VT_DISPATCH | VT_BYREF :
- v = mx_make_idispatch (*pVariantArg->ppdispVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->ppdispVal);
+ v = mx_make_idispatch(*pVariantArg->ppdispVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->ppdispVal);
break;
case VT_UNKNOWN | VT_BYREF :
- v = mx_make_iunknown (*pVariantArg->ppunkVal);
- SCHEME_BOX_VAL (val) = v;
- free (pVariantArg->ppunkVal);
+ v = mx_make_iunknown(*pVariantArg->ppunkVal);
+ SCHEME_BOX_VAL(val) = v;
+ free(pVariantArg->ppunkVal);
break;
case VT_VARIANT | VT_BYREF :
- free (pVariantArg->pvarVal);
+ free(pVariantArg->pvarVal);
break;
case VT_BSTR :
// Don't try to update symbols!
- if (!SCHEME_SYMBOLP (val))
- updateSchemeFromBSTR (val, pVariantArg->bstrVal);
- SysFreeString (pVariantArg->bstrVal);
+ if (!SCHEME_SYMBOLP(val))
+ updateSchemeFromBSTR(val, pVariantArg->bstrVal);
+ SysFreeString(pVariantArg->bstrVal);
break;
case VT_BSTR | VT_BYREF :
- v = unmarshalBSTR (*pVariantArg->pbstrVal);
- SCHEME_BOX_VAL (val) = v;
- SysFreeString (*pVariantArg->pbstrVal);
- free (pVariantArg->pbstrVal);
+ v = unmarshalBSTR(*pVariantArg->pbstrVal);
+ SCHEME_BOX_VAL(val) = v;
+ SysFreeString(*pVariantArg->pbstrVal);
+ free(pVariantArg->pbstrVal);
break;
default :
-
- ;
-
// no unmarshaling or cleanup needed
+ ;
}
}
@@ -3874,9 +3640,9 @@ void unmarshalVariant (Scheme_Object *val, VARIANTARG *pVariantArg)
// Build the DISPPARAMS by filling out the fields
// according to the Scheme type of object.
// No optional or named args, no type checking.
-short int buildMethodArgumentsUsingDefaults (INVOKEKIND invKind,
- int argc, Scheme_Object **argv,
- DISPPARAMS *methodArguments)
+short int buildMethodArgumentsUsingDefaults(INVOKEKIND invKind,
+ int argc, Scheme_Object **argv,
+ DISPPARAMS *methodArguments)
{
short int numParamsPassed;
BOOL lastParamIsRetval;
@@ -3917,7 +3683,7 @@ short int buildMethodArgumentsUsingDefaults (INVOKEKIND invKind,
if (numParamsPassed > 0) {
VARIANTARG *va;
- va = (VARIANTARG *)malloc (numParamsPassed * sizeof (VARIANTARG));
+ va = (VARIANTARG *)malloc(numParamsPassed * sizeof(VARIANTARG));
methodArguments->rgvarg = va;
}
@@ -3932,7 +3698,7 @@ short int buildMethodArgumentsUsingDefaults (INVOKEKIND invKind,
#ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
#endif
- VariantInit (&methodArguments->rgvarg[j]);
+ VariantInit(&methodArguments->rgvarg[j]);
#ifdef MZ_PRECISE_GC
END_XFORM_SKIP;
#endif
@@ -3942,13 +3708,13 @@ END_XFORM_SKIP;
methodArguments->rgvarg[j].lVal = DISP_E_PARAMNOTFOUND;
}
else
- marshalSchemeValueToVariant (argv[k], &methodArguments->rgvarg[j]);
+ marshalSchemeValueToVariant(argv[k], &methodArguments->rgvarg[j]);
}
return numParamsPassed;
}
-short int getLcidParamIndex (FUNCDESC *pFuncDesc, short int numParams)
+short int getLcidParamIndex(FUNCDESC *pFuncDesc, short int numParams)
{
ELEMDESC *pElemDescs;
int i;
@@ -3969,11 +3735,11 @@ static Scheme_Object **drop_two(int argc, Scheme_Object **argv)
return a;
}
-void checkArgTypesAndCounts (FUNCDESC *pFuncDesc,
- BOOL direct,
- INVOKEKIND invKind,
- int argc, Scheme_Object **argv,
- MX_ARGS_COUNT *argsCount)
+void checkArgTypesAndCounts(FUNCDESC *pFuncDesc,
+ BOOL direct,
+ INVOKEKIND invKind,
+ int argc, Scheme_Object **argv,
+ MX_ARGS_COUNT *argsCount)
{
char errBuff[256];
short int numParamsPassed;
@@ -3984,16 +3750,16 @@ void checkArgTypesAndCounts (FUNCDESC *pFuncDesc,
numParamsPassed = pFuncDesc->cParams;
argsCount->retvalInParams =
- isLastParamRetval (numParamsPassed, invKind, pFuncDesc);
+ isLastParamRetval(numParamsPassed, invKind, pFuncDesc);
if (argsCount->retvalInParams)
numParamsPassed--;
- numOptParams = getOptParamCount (pFuncDesc, numParamsPassed - 1);
+ numOptParams = getOptParamCount(pFuncDesc, numParamsPassed - 1);
lcidIndex = NO_LCID;
if (direct) {
- lcidIndex = getLcidParamIndex (pFuncDesc, numParamsPassed);
+ lcidIndex = getLcidParamIndex(pFuncDesc, numParamsPassed);
if (lcidIndex != NO_LCID)
numParamsPassed--;
}
@@ -4006,28 +3772,30 @@ void checkArgTypesAndCounts (FUNCDESC *pFuncDesc,
// this branch is untested
- // optional parameters with default values not counted in pFuncDesc->cParamsOpt
+ // optional parameters with default values not counted in
+ // pFuncDesc->cParamsOpt
if (argc < numParamsPassed + 2 - 1) {
- sprintf (errBuff, "%s (%s \"%s\")",
- mx_fun_string (invKind),
- inv_kind_string (invKind),
- schemeToText (argv[1]));
- scheme_wrong_count (errBuff, numParamsPassed-1, -1, argc-2, drop_two(argc, argv));
+ sprintf(errBuff, "%s (%s \"%s\")",
+ mx_fun_string(invKind),
+ inv_kind_string(invKind),
+ schemeToText(argv[1]));
+ scheme_wrong_count(errBuff, numParamsPassed-1, -1, argc-2,
+ drop_two(argc, argv));
}
- }
- else {
+ } else {
// optional parameters with default values
// not counted in pFuncDesc->cParamsOpt
if (argc < numParamsPassed - numOptParams + 2 || // too few
- argc > numParamsPassed + 2) { // too many
- sprintf (errBuff, "%s (%s \"%s\")",
- mx_fun_string (invKind),
- inv_kind_string (invKind),
- schemeToText (argv[1]));
- scheme_wrong_count (errBuff, numParamsPassed-numOptParams, numParamsPassed, argc-2, drop_two(argc, argv));
+ argc > numParamsPassed + 2) { // too many
+ sprintf(errBuff, "%s (%s \"%s\")",
+ mx_fun_string(invKind),
+ inv_kind_string(invKind),
+ schemeToText(argv[1]));
+ scheme_wrong_count(errBuff, numParamsPassed-numOptParams,
+ numParamsPassed, argc-2, drop_two(argc, argv));
}
}
@@ -4041,22 +3809,21 @@ void checkArgTypesAndCounts (FUNCDESC *pFuncDesc,
if (direct && k == lcidIndex) // skip an entry
k++;
- if (schemeValueFitsElemDesc (argv[j], &pFuncDesc->lprgelemdescParam[k]) == FALSE) {
+ if (schemeValueFitsElemDesc(argv[j], &pFuncDesc->lprgelemdescParam[k]) == FALSE) {
Scheme_Object *sym;
- sprintf (errBuff, "%s (%s \"%s\")", mx_fun_string (invKind),
- inv_kind_string (invKind), schemeToText (argv[1]));
- sym = elemDescToSchemeType (&(pFuncDesc->lprgelemdescParam[k]), FALSE, FALSE);
- scheme_wrong_type (errBuff,
- scheme_symbol_val (sym),
- j, argc, argv);
+ sprintf(errBuff, "%s (%s \"%s\")", mx_fun_string(invKind),
+ inv_kind_string(invKind), schemeToText(argv[1]));
+ sym = elemDescToSchemeType(&(pFuncDesc->lprgelemdescParam[k]),
+ FALSE, FALSE);
+ scheme_wrong_type(errBuff, scheme_symbol_val(sym), j, argc, argv);
}
}
}
-short int buildMethodArgumentsUsingFuncDesc (FUNCDESC *pFuncDesc,
- INVOKEKIND invKind,
- int argc, Scheme_Object **argv,
- DISPPARAMS *methodArguments)
+short int buildMethodArgumentsUsingFuncDesc(FUNCDESC *pFuncDesc,
+ INVOKEKIND invKind,
+ int argc, Scheme_Object **argv,
+ DISPPARAMS *methodArguments)
{
MX_ARGS_COUNT argsCount;
short int numParamsPassed;
@@ -4064,8 +3831,8 @@ short int buildMethodArgumentsUsingFuncDesc (FUNCDESC *pFuncDesc,
static DISPID dispidPropPut = DISPID_PROPERTYPUT;
int i, j, k;
- checkArgTypesAndCounts (pFuncDesc, FALSE, // indirect
- invKind, argc, argv, &argsCount);
+ checkArgTypesAndCounts(pFuncDesc, FALSE, // indirect
+ invKind, argc, argv, &argsCount);
numParamsPassed = argsCount.numParamsPassed;
numOptParams = argsCount.numOptParams;
@@ -4097,7 +3864,7 @@ short int buildMethodArgumentsUsingFuncDesc (FUNCDESC *pFuncDesc,
if (numParamsPassed > 0) {
VARIANTARG *va;
- va = (VARIANTARG *)malloc (numParamsPassed * sizeof (VARIANTARG));
+ va = (VARIANTARG *)malloc(numParamsPassed * sizeof(VARIANTARG));
methodArguments->rgvarg = va;
}
@@ -4112,7 +3879,7 @@ short int buildMethodArgumentsUsingFuncDesc (FUNCDESC *pFuncDesc,
#ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
#endif
- VariantInit (&methodArguments->rgvarg[j]);
+ VariantInit(&methodArguments->rgvarg[j]);
#ifdef MZ_PRECISE_GC
END_XFORM_SKIP;
#endif
@@ -4123,8 +3890,8 @@ END_XFORM_SKIP;
}
else {
methodArguments->rgvarg[j].vt =
- getVarTypeFromElemDesc (&pFuncDesc->lprgelemdescParam[i]);
- marshalSchemeValue (argv[k], &methodArguments->rgvarg[j]);
+ getVarTypeFromElemDesc(&pFuncDesc->lprgelemdescParam[i]);
+ marshalSchemeValue(argv[k], &methodArguments->rgvarg[j]);
}
}
@@ -4133,22 +3900,22 @@ END_XFORM_SKIP;
if (numOptParams > 0) {
for (i = argc - 2, j = numParamsPassed - 1 - (argc - 2); j >= 0; i++, j--) {
- if (isDefaultParam (pFuncDesc, i)){
- VARIANTARG va1;
- LPPARAMDESCEX ex;
- ex = pFuncDesc->lprgelemdescParam[i].paramdesc.pparamdescex;
- va1 = ex->varDefaultValue;
- methodArguments->rgvarg[j] = va1;
+ if (isDefaultParam(pFuncDesc, i)){
+ VARIANTARG va1;
+ LPPARAMDESCEX ex;
+ ex = pFuncDesc->lprgelemdescParam[i].paramdesc.pparamdescex;
+ va1 = ex->varDefaultValue;
+ methodArguments->rgvarg[j] = va1;
} else {
#ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
#endif
- VariantInit (&methodArguments->rgvarg[j]);
+ VariantInit(&methodArguments->rgvarg[j]);
#ifdef MZ_PRECISE_GC
END_XFORM_SKIP;
#endif
- methodArguments->rgvarg[j].vt = VT_ERROR;
- methodArguments->rgvarg[j].lVal = DISP_E_PARAMNOTFOUND;
+ methodArguments->rgvarg[j].vt = VT_ERROR;
+ methodArguments->rgvarg[j].lVal = DISP_E_PARAMNOTFOUND;
}
}
}
@@ -4156,10 +3923,10 @@ END_XFORM_SKIP;
return numParamsPassed;
}
-short int buildMethodArgumentsUsingVarDesc (VARDESC *pVarDesc,
- INVOKEKIND invKind,
- int argc, Scheme_Object **argv,
- DISPPARAMS *methodArguments)
+short int buildMethodArgumentsUsingVarDesc(VARDESC *pVarDesc,
+ INVOKEKIND invKind,
+ int argc, Scheme_Object **argv,
+ DISPPARAMS *methodArguments)
{
char errBuff[256];
short int numParamsPassed;
@@ -4173,13 +3940,12 @@ short int buildMethodArgumentsUsingVarDesc (VARDESC *pVarDesc,
: 0;
if (argc != numParamsPassed + 2) {
- sprintf (errBuff, "%s (%s \"%s\")",
- mx_fun_string (invKind),
- inv_kind_string (invKind),
- schemeToText (argv[1]));
- scheme_wrong_count (errBuff,
- numParamsPassed + 2, numParamsPassed + 2,
- argc, argv);
+ sprintf(errBuff, "%s (%s \"%s\")",
+ mx_fun_string(invKind),
+ inv_kind_string(invKind),
+ schemeToText(argv[1]));
+ scheme_wrong_count(errBuff, numParamsPassed + 2, numParamsPassed + 2,
+ argc, argv);
}
switch (invKind) {
@@ -4188,13 +3954,11 @@ short int buildMethodArgumentsUsingVarDesc (VARDESC *pVarDesc,
// check that value is of expected type
- if (schemeValueFitsElemDesc (argv[2],
- &pVarDesc->elemdescVar) == FALSE) {
- sprintf (errBuff, "%s (%s \"%s\")", mx_fun_string (invKind),
- inv_kind_string (invKind), schemeToText (argv[1]));
- v = elemDescToSchemeType (&(pVarDesc->elemdescVar), FALSE, FALSE);
- scheme_wrong_type (errBuff,
- scheme_symbol_val (v), 2, argc, argv);
+ if (schemeValueFitsElemDesc(argv[2], &pVarDesc->elemdescVar) == FALSE) {
+ sprintf(errBuff, "%s (%s \"%s\")", mx_fun_string(invKind),
+ inv_kind_string(invKind), schemeToText(argv[1]));
+ v = elemDescToSchemeType(&(pVarDesc->elemdescVar), FALSE, FALSE);
+ scheme_wrong_type(errBuff, scheme_symbol_val(v), 2, argc, argv);
}
methodArguments->rgdispidNamedArgs = &dispidPropPut;
@@ -4214,7 +3978,7 @@ short int buildMethodArgumentsUsingVarDesc (VARDESC *pVarDesc,
if (numParamsPassed > 0) {
VARIANTARG *va;
- va = (VARIANTARG *)malloc (numParamsPassed * sizeof (VARIANTARG));
+ va = (VARIANTARG *)malloc(numParamsPassed * sizeof(VARIANTARG));
methodArguments->rgvarg = va;
}
@@ -4228,119 +3992,120 @@ short int buildMethodArgumentsUsingVarDesc (VARDESC *pVarDesc,
#ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
#endif
- VariantInit (&methodArguments->rgvarg[j]);
+ VariantInit(&methodArguments->rgvarg[j]);
#ifdef MZ_PRECISE_GC
END_XFORM_SKIP;
#endif
methodArguments->rgvarg[j].vt =
- getVarTypeFromElemDesc (&pVarDesc->elemdescVar);
- marshalSchemeValue (argv[k], &methodArguments->rgvarg[j]);
+ getVarTypeFromElemDesc(&pVarDesc->elemdescVar);
+ marshalSchemeValue(argv[k], &methodArguments->rgvarg[j]);
}
return numParamsPassed;
}
-short int buildMethodArguments (MX_TYPEDESC *pTypeDesc,
- INVOKEKIND invKind,
- int argc, Scheme_Object **argv,
- DISPPARAMS *methodArguments)
+short int buildMethodArguments(MX_TYPEDESC *pTypeDesc,
+ INVOKEKIND invKind,
+ int argc, Scheme_Object **argv,
+ DISPPARAMS *methodArguments)
{
return (pTypeDesc == NULL)
- ? buildMethodArgumentsUsingDefaults (invKind, argc, argv,
- methodArguments)
+ ? buildMethodArgumentsUsingDefaults(invKind, argc, argv,
+ methodArguments)
: (pTypeDesc->descKind == funcDesc)
- ? buildMethodArgumentsUsingFuncDesc (pTypeDesc->funcdescs.pFuncDesc,
- invKind, argc, argv,
- methodArguments)
- : buildMethodArgumentsUsingVarDesc (pTypeDesc->pVarDesc,
+ ? buildMethodArgumentsUsingFuncDesc(pTypeDesc->funcdescs.pFuncDesc,
+ invKind, argc, argv,
+ methodArguments)
+ : buildMethodArgumentsUsingVarDesc(pTypeDesc->pVarDesc,
invKind, argc, argv,
methodArguments);
}
-void allocateDirectRetval (VARIANT *va)
+void allocateDirectRetval(VARIANT *va)
{
switch (va->vt) {
case VT_BYREF|VT_UI1 :
- va->pbVal = (BYTE *)allocParamMemory (sizeof (BYTE));
+ va->pbVal = (BYTE *)allocParamMemory(sizeof(BYTE));
break;
case VT_BYREF|VT_I2 :
- va->piVal = (SHORT *)allocParamMemory (sizeof (SHORT));
+ va->piVal = (SHORT *)allocParamMemory(sizeof(SHORT));
break;
case VT_BYREF|VT_I4 :
- va->plVal = (LONG *)allocParamMemory (sizeof (LONG));
+ va->plVal = (LONG *)allocParamMemory(sizeof(LONG));
break;
case VT_BYREF|VT_I8 :
- va->pllVal = (LONGLONG *)allocParamMemory (sizeof (LONGLONG));
+ va->pllVal = (LONGLONG *)allocParamMemory(sizeof(LONGLONG));
break;
case VT_BYREF|VT_R4 :
- va->pfltVal = (FLOAT *)allocParamMemory (sizeof (FLOAT));
+ va->pfltVal = (FLOAT *)allocParamMemory(sizeof(FLOAT));
break;
case VT_BYREF|VT_R8 :
- va->pdblVal = (DOUBLE *)allocParamMemory (sizeof (DOUBLE));
+ va->pdblVal = (DOUBLE *)allocParamMemory(sizeof(DOUBLE));
break;
case VT_BYREF|VT_BOOL :
- va->pboolVal = (VARIANT_BOOL *)allocParamMemory (sizeof (VARIANT_BOOL));
+ va->pboolVal = (VARIANT_BOOL *)allocParamMemory(sizeof(VARIANT_BOOL));
break;
case VT_BYREF|VT_ERROR :
- va->pscode = (SCODE *)allocParamMemory (sizeof (SCODE));
+ va->pscode = (SCODE *)allocParamMemory(sizeof(SCODE));
break;
case VT_BYREF|VT_CY :
- va->pcyVal = (CY *)allocParamMemory (sizeof (CY));
+ va->pcyVal = (CY *)allocParamMemory(sizeof(CY));
break;
case VT_BYREF|VT_DATE :
- va->pdate = (DATE *)allocParamMemory (sizeof (DATE));
+ va->pdate = (DATE *)allocParamMemory(sizeof(DATE));
break;
case VT_BYREF|VT_BSTR :
- va->pbstrVal = (BSTR *)allocParamMemory (sizeof (BSTR));
+ va->pbstrVal = (BSTR *)allocParamMemory(sizeof(BSTR));
break;
case VT_BYREF|VT_UNKNOWN :
- va->ppunkVal = (IUnknown **)allocParamMemory (sizeof (IUnknown *));
+ va->ppunkVal = (IUnknown **)allocParamMemory(sizeof(IUnknown *));
break;
case VT_BYREF|VT_PTR :
case VT_BYREF|VT_DISPATCH :
- va->ppdispVal = (IDispatch **)allocParamMemory (sizeof (IDispatch *));
+ va->ppdispVal = (IDispatch **)allocParamMemory(sizeof(IDispatch *));
break;
case VT_BYREF|VT_ARRAY :
case VT_BYREF|VT_SAFEARRAY :
- va->pparray = (SAFEARRAY **)allocParamMemory (sizeof (SAFEARRAY *));
+ va->pparray = (SAFEARRAY **)allocParamMemory(sizeof(SAFEARRAY *));
break;
case VT_BYREF|VT_VARIANT :
- va->pvarVal = (VARIANT *)allocParamMemory (sizeof (VARIANT));
+ va->pvarVal = (VARIANT *)allocParamMemory(sizeof(VARIANT));
break;
case VT_BYREF|VT_I1 :
- va->pcVal = (CHAR *)allocParamMemory (sizeof (CHAR));
+ va->pcVal = (CHAR *)allocParamMemory(sizeof(CHAR));
break;
case VT_BYREF|VT_UI2 :
- va->puiVal = (USHORT *)allocParamMemory (sizeof (USHORT));
+ va->puiVal = (USHORT *)allocParamMemory(sizeof(USHORT));
break;
case VT_BYREF|VT_UI4 :
- va->pulVal = (ULONG *)allocParamMemory (sizeof (ULONG));
+ va->pulVal = (ULONG *)allocParamMemory(sizeof(ULONG));
break;
case VT_BYREF|VT_UI8 :
- va->pullVal = (ULONGLONG *)allocParamMemory (sizeof (ULONGLONG));
+ va->pullVal = (ULONGLONG *)allocParamMemory(sizeof(ULONGLONG));
break;
case VT_BYREF|VT_INT :
- va->pintVal = (INT *)allocParamMemory (sizeof (INT));
+ va->pintVal = (INT *)allocParamMemory(sizeof(INT));
break;
case VT_BYREF|VT_UINT :
- va->puintVal = (UINT *)allocParamMemory (sizeof (UINT));
+ va->puintVal = (UINT *)allocParamMemory(sizeof(UINT));
break;
default :
- {char buff[128];
- sprintf (buff, "Can't allocate return value for VARIANT 0x%X", va->vt);
- scheme_signal_error (buff); }
+ { char buff[128];
+ sprintf(buff, "Can't allocate return value for VARIANT 0x%X", va->vt);
+ scheme_signal_error(buff);
+ }
}
}
static VARIANT argVas[MAXDIRECTARGS];
static VARIANT optArgVas[MAXDIRECTARGS];
-static Scheme_Object *mx_make_direct_call (int argc, Scheme_Object **argv,
- INVOKEKIND invKind,
- IDispatch *pIDispatch,
- const char * name,
- MX_TYPEDESC *pTypeDesc)
+static Scheme_Object *mx_make_direct_call(int argc, Scheme_Object **argv,
+ INVOKEKIND invKind,
+ IDispatch *pIDispatch,
+ const char * name,
+ MX_TYPEDESC *pTypeDesc)
{
HRESULT hr;
Scheme_Object *retval;
@@ -4356,108 +4121,104 @@ static Scheme_Object *mx_make_direct_call (int argc, Scheme_Object **argv,
int i, j;
pFuncDesc = pTypeDesc->funcdescs.pFuncDescImpl;
- checkArgTypesAndCounts (pFuncDesc, TRUE, // direct
- invKind, argc, argv, &argsCount);
+ checkArgTypesAndCounts(pFuncDesc, TRUE, // direct
+ invKind, argc, argv, &argsCount);
numParamsPassed = argsCount.numParamsPassed;
numOptParams = argsCount.numOptParams;
lcidIndex = argsCount.lcidIndex;
if (pTypeDesc->pInterface == NULL) {
- COMPTR *vtbl;
+ COMPTR *vtbl;
- hr = pIDispatch->QueryInterface (pTypeDesc->implGuid, (void **)&pInterface);
+ hr = pIDispatch->QueryInterface(pTypeDesc->implGuid, (void **)&pInterface);
- if (FAILED (hr) || pInterface == NULL) {
- sprintf (buff, "Failed to get direct interface for call to `%s'", name);
- codedComError (buff, hr);
- }
- vtbl = ((COMPTR * *)pInterface)[0];
- pTypeDesc->pInterface = pInterface;
- pTypeDesc->funPtr = funPtr = vtbl[pTypeDesc->funOffset];
- }
- else {
- pInterface = pTypeDesc->pInterface;
- funPtr = pTypeDesc->funPtr;
- }
+ if (FAILED(hr) || pInterface == NULL) {
+ sprintf(buff, "Failed to get direct interface for call to `%s'", name);
+ codedComError(buff, hr);
+ }
+ vtbl = ((COMPTR * *)pInterface)[0];
+ pTypeDesc->pInterface = pInterface;
+ pTypeDesc->funPtr = funPtr = vtbl[pTypeDesc->funOffset];
+ } else {
+ pInterface = pTypeDesc->pInterface;
+ funPtr = pTypeDesc->funPtr;
+ }
// push return value ptr
#ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
#endif
- VariantInit (&retvalVa);
+ VariantInit(&retvalVa);
#ifdef MZ_PRECISE_GC
END_XFORM_SKIP;
#endif
- retvalVa.vt = getVarTypeFromElemDesc (argsCount.retvalInParams
- ? &pFuncDesc->lprgelemdescParam[pFuncDesc->cParams-1]
- : &pFuncDesc->elemdescFunc);
+ retvalVa.vt =
+ getVarTypeFromElemDesc(argsCount.retvalInParams
+ ? &pFuncDesc->lprgelemdescParam[pFuncDesc->cParams-1]
+ : &pFuncDesc->elemdescFunc);
if (invKind != INVOKE_PROPERTYPUT &&
retvalVa.vt != VT_VOID &&
retvalVa.vt != VT_HRESULT) {
- retvalVa.vt |= VT_BYREF;
- allocateDirectRetval (&retvalVa);
- pushOneArg (retvalVa, buff);
- }
+ retvalVa.vt |= VT_BYREF;
+ allocateDirectRetval(&retvalVa);
+ pushOneArg(retvalVa, buff);
+ }
// these must be macros, not functions, so that stack is maintained
#ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
#endif
- pushOptArgs (pFuncDesc, numParamsPassed, numOptParams, optArgVas, vaPtr, va,
- argc, i, j, lcidIndex, buff);
+ pushOptArgs(pFuncDesc, numParamsPassed, numOptParams, optArgVas, vaPtr, va,
+ argc, i, j, lcidIndex, buff);
- pushSuppliedArgs (pFuncDesc, numParamsPassed, argc, argv, argVas, vaPtr, va,
- i, j, lcidIndex, buff);
+ pushSuppliedArgs(pFuncDesc, numParamsPassed, argc, argv, argVas, vaPtr, va,
+ i, j, lcidIndex, buff);
#ifdef MZ_PRECISE_GC
END_XFORM_SKIP;
#endif
// push the "this" pointer before calling
-
__asm {
push pInterface;
call funPtr;
mov hr, eax;
}
- if (FAILED (hr)) {
- char buff[128];
- sprintf (buff, "COM method `%s' failed", name);
- codedComError (buff, hr);
- }
+ if (FAILED(hr)) {
+ char buff[128];
+ sprintf(buff, "COM method `%s' failed", name);
+ codedComError(buff, hr);
+ }
// unmarshal boxed values, cleanup
i = argc - 1;
j = argc - 3;
- if (lcidIndex != NO_LCID && lcidIndex <= j + 1)
- j++;
+ if (lcidIndex != NO_LCID && lcidIndex <= j + 1) j++;
vaPtr = argVas XFORM_OK_PLUS j;
for ( ; j >= 0; i--, j--, vaPtr = vaPtr XFORM_OK_MINUS 1) {
- if (j == lcidIndex)
- i++;
- else
- unmarshalVariant (argv[i], vaPtr);
- }
+ if (j == lcidIndex) i++;
+ else unmarshalVariant(argv[i], vaPtr);
+ }
if (invKind == INVOKE_PROPERTYPUT)
- return scheme_void;
+ return scheme_void;
- retval = retvalVariantToSchemeObject (&retvalVa);
+ retval = retvalVariantToSchemeObject(&retvalVa);
// all pointers are 32 bits, choose arbitrary one
if (retvalVa.vt != VT_VOID)
- free (retvalVa.pullVal);
+ free(retvalVa.pullVal);
return retval;
}
-static Scheme_Object *mx_make_call (int argc, Scheme_Object **argv,
- INVOKEKIND invKind)
+static Scheme_Object *mx_make_call(int argc, Scheme_Object **argv,
+ INVOKEKIND invKind)
{
Scheme_Object *retval, *v;
MX_TYPEDESC *pTypeDesc;
@@ -4473,23 +4234,22 @@ static Scheme_Object *mx_make_call (int argc, Scheme_Object **argv,
HRESULT hr;
char buff[256];
- pIDispatch = MX_COM_OBJ_VAL (GUARANTEE_COM_OBJ (mx_fun_string (invKind), 0));
+ pIDispatch = MX_COM_OBJ_VAL(GUARANTEE_COM_OBJ(mx_fun_string(invKind), 0));
- if (pIDispatch == NULL)
- scheme_signal_error ("NULL COM object");
+ if (pIDispatch == NULL) scheme_signal_error("NULL COM object");
- v = GUARANTEE_STRSYM (mx_fun_string (invKind), 1);
- name = schemeToText (v);
+ v = GUARANTEE_STRSYM(mx_fun_string(invKind), 1);
+ name = schemeToText(v);
- if (invKind == INVOKE_FUNC && isDispatchName (name)) {
- sprintf (buff, "%s: IDispatch methods may not be called",
- mx_fun_string (invKind));
- scheme_signal_error (buff);
+ if (invKind == INVOKE_FUNC && isDispatchName(name)) {
+ sprintf(buff, "%s: IDispatch methods may not be called",
+ mx_fun_string(invKind));
+ scheme_signal_error(buff);
}
// check arity, types of method arguments
- pTypeDesc = getMethodType ((MX_COM_Object *)argv[0], name, invKind);
+ pTypeDesc = getMethodType((MX_COM_Object *)argv[0], name, invKind);
// try direct call via function pointer
// otherwise, use COM Automation
@@ -4497,12 +4257,11 @@ static Scheme_Object *mx_make_call (int argc, Scheme_Object **argv,
if (pTypeDesc &&
(pTypeDesc->funOffset != NO_FUNPTR) &&
/* assignment */
- (retval = mx_make_direct_call (argc, argv, invKind,
- pIDispatch, name, pTypeDesc)))
+ (retval = mx_make_direct_call(argc, argv, invKind,
+ pIDispatch, name, pTypeDesc)))
return retval;
- if (pTypeDesc)
- dispid = pTypeDesc->memID;
+ if (pTypeDesc) dispid = pTypeDesc->memID;
else {
// If there is no pTypeDesc, then we have to wing it.
@@ -4514,65 +4273,59 @@ static Scheme_Object *mx_make_call (int argc, Scheme_Object **argv,
unsigned int len;
unsigned int count;
LPOLESTR namearray;
- len = (unsigned int)strlen (name);
- count = MultiByteToWideChar (CP_ACP, (DWORD)0, name, len,
- namebuf, sizeray (namebuf)-1);
+ len = (unsigned int)strlen(name);
+ count = MultiByteToWideChar(CP_ACP, (DWORD)0, name, len,
+ namebuf, sizeray(namebuf)-1);
namebuf[len] = '\0';
if (count < len) {
- sprintf (buff, "%s: Unable to translate name \"%s\" to Unicode",
- mx_fun_string (invKind), name);
- scheme_signal_error (buff);
+ sprintf(buff, "%s: Unable to translate name \"%s\" to Unicode",
+ mx_fun_string(invKind), name);
+ scheme_signal_error(buff);
}
namearray = (LPOLESTR)&namebuf;
- hr = pIDispatch->GetIDsOfNames (IID_NULL, &namearray, 1,
- LOCALE_SYSTEM_DEFAULT, &dispid);
+ hr = pIDispatch->GetIDsOfNames(IID_NULL, &namearray, 1,
+ LOCALE_SYSTEM_DEFAULT, &dispid);
- if (FAILED (hr)) {
+ if (FAILED(hr)) {
const char *funString;
- funString = mx_fun_string (invKind);
+ funString = mx_fun_string(invKind);
switch (hr) {
case E_OUTOFMEMORY :
- sprintf (buff, "%s: out of memory", funString);
- scheme_signal_error (buff);
+ sprintf(buff, "%s: out of memory", funString);
+ scheme_signal_error(buff);
case DISP_E_UNKNOWNNAME :
- sprintf (buff, "%s: unknown name \"%s\"", funString, name);
- scheme_signal_error (buff);
+ sprintf(buff, "%s: unknown name \"%s\"", funString, name);
+ scheme_signal_error(buff);
case DISP_E_UNKNOWNLCID :
- sprintf (buff, "%s: unknown LCID", funString);
- scheme_signal_error (buff);
+ sprintf(buff, "%s: unknown LCID", funString);
+ scheme_signal_error(buff);
default :
- codedComError (funString, hr);
+ codedComError(funString, hr);
}
}
}
// Build the method arguments even if pTypeDesc is NULL.
- numParamsPassed = buildMethodArguments (pTypeDesc,
- invKind,
- argc, argv,
- &methodArguments);
+ numParamsPassed = buildMethodArguments(pTypeDesc, invKind, argc, argv,
+ &methodArguments);
if (invKind != INVOKE_PROPERTYPUT) {
#ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
#endif
- VariantInit (&methodResult);
+ VariantInit(&methodResult);
#ifdef MZ_PRECISE_GC
END_XFORM_SKIP;
#endif
}
// invoke requested method
-
- hr = pIDispatch->Invoke (dispid, IID_NULL, LOCALE_SYSTEM_DEFAULT,
- invKind,
- &methodArguments,
- (invKind == INVOKE_PROPERTYPUT) ?
- NULL : &methodResult,
- &exnInfo,
- &errorIndex);
+ hr = pIDispatch->Invoke(dispid, IID_NULL, LOCALE_SYSTEM_DEFAULT,
+ invKind, &methodArguments,
+ (invKind == INVOKE_PROPERTYPUT) ? NULL : &methodResult,
+ &exnInfo, &errorIndex);
if (hr == DISP_E_EXCEPTION) {
char errBuff[2048];
@@ -4586,72 +4339,64 @@ END_XFORM_SKIP;
if (hasDescription) {
unsigned int len;
- len = SysStringLen (exnInfo.bstrDescription);
- WideCharToMultiByte (CP_ACP, (DWORD)0,
- exnInfo.bstrDescription, len,
- description, sizeof (description)-1,
- NULL, NULL);
+ len = SysStringLen(exnInfo.bstrDescription);
+ WideCharToMultiByte(CP_ACP, (DWORD)0, exnInfo.bstrDescription, len,
+ description, sizeof(description)-1, NULL, NULL);
description[len] = '\0';
}
if (hasErrorCode) {
- sprintf (errBuff,
- "COM object exception, error code 0x%X%s%s",
- exnInfo.wCode,
- hasDescription ? "\nDescription: " : "" ,
- hasDescription ? description : "");
- scheme_signal_error (errBuff);
- }
- else {
- sprintf (errBuff,
- "COM object exception%s%s",
- hasDescription ? "\nDescription: " : "" ,
- hasDescription ? description : "");
- codedComError (errBuff, exnInfo.scode);
+ sprintf(errBuff, "COM object exception, error code 0x%X%s%s",
+ exnInfo.wCode,
+ hasDescription ? "\nDescription: " : "" ,
+ hasDescription ? description : "");
+ scheme_signal_error(errBuff);
+ } else {
+ sprintf(errBuff, "COM object exception%s%s",
+ hasDescription ? "\nDescription: " : "" ,
+ hasDescription ? description : "");
+ codedComError(errBuff, exnInfo.scode);
}
}
- if (FAILED (hr)) {
+ if (FAILED(hr)) {
char buff[2048];
- sprintf (buff, "\"%s\" (%s) failed",
- schemeToText (argv[1]), inv_kind_string (invKind));
- codedComError (buff, hr);
+ sprintf(buff, "\"%s\" (%s) failed",
+ schemeToText(argv[1]), inv_kind_string(invKind));
+ codedComError(buff, hr);
}
// unmarshal data passed by reference, cleanup
-
for (i = 2, j = numParamsPassed - 1; i < argc; i++, j--) {
- unmarshalVariant (argv[i], &methodArguments.rgvarg[j]);
+ unmarshalVariant(argv[i], &methodArguments.rgvarg[j]);
}
-
if (numParamsPassed > 0)
- free (methodArguments.rgvarg);
+ free(methodArguments.rgvarg);
if (invKind == INVOKE_PROPERTYPUT)
return scheme_void;
// unmarshal return value
- return variantToSchemeObject (&methodResult);
-
+ return variantToSchemeObject(&methodResult);
}
-Scheme_Object *mx_com_invoke (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_invoke(int argc, Scheme_Object **argv)
{
- return mx_make_call (argc, argv, INVOKE_FUNC);
+ return mx_make_call(argc, argv, INVOKE_FUNC);
}
-Scheme_Object *mx_com_get_property (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_get_property(int argc, Scheme_Object **argv)
{
- return mx_make_call (argc, argv, INVOKE_PROPERTYGET);
+ return mx_make_call(argc, argv, INVOKE_PROPERTYGET);
}
-Scheme_Object *mx_com_set_property (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_set_property(int argc, Scheme_Object **argv)
{
- return mx_make_call (argc, argv, INVOKE_PROPERTYPUT);
+ return mx_make_call(argc, argv, INVOKE_PROPERTYPUT);
}
-Scheme_Object *mx_all_clsid (int argc, Scheme_Object **argv, char **attributes)
+Scheme_Object *mx_all_clsid(int argc, Scheme_Object **argv, char **attributes)
{
LONG result;
Scheme_Object *retval;
@@ -4668,14 +4413,9 @@ Scheme_Object *mx_all_clsid (int argc, Scheme_Object **argv, char **attributes)
retval = scheme_null;
- result = RegOpenKeyEx (HKEY_CLASSES_ROOT,
- "CLSID",
- (DWORD)0,
- KEY_READ,
- &hkey);
+ result = RegOpenKeyEx(HKEY_CLASSES_ROOT, "CLSID", (DWORD)0, KEY_READ, &hkey);
- if (result != ERROR_SUCCESS)
- return retval;
+ if (result != ERROR_SUCCESS) return retval;
// enumerate subkeys until we find the one we want
@@ -4684,33 +4424,24 @@ Scheme_Object *mx_all_clsid (int argc, Scheme_Object **argv, char **attributes)
while (1) {
// get next subkey
-
- clsidBufferSize = sizeray (clsidBuffer);
-
- result = RegEnumKeyEx (hkey, keyIndex++,
- clsidBuffer,
- &clsidBufferSize,
- 0, NULL, NULL,
- &fileTime);
-
+ clsidBufferSize = sizeray(clsidBuffer);
+ result = RegEnumKeyEx(hkey, keyIndex++, clsidBuffer, &clsidBufferSize,
+ 0, NULL, NULL, &fileTime);
if (result == ERROR_NO_MORE_ITEMS)
break;
- if (strlen (clsidBuffer) != CLSIDLEN) // not a CLSID -- bogus entry
+ if (strlen(clsidBuffer) != CLSIDLEN) // not a CLSID -- bogus entry
continue;
// open subkey
-
- result = RegOpenKeyEx (hkey, clsidBuffer,
- (DWORD)0,
- KEY_READ, &hsubkey);
+ result = RegOpenKeyEx(hkey, clsidBuffer, (DWORD)0, KEY_READ, &hsubkey);
if (result != ERROR_SUCCESS)
- scheme_signal_error ("Error while searching Windows registry");
+ scheme_signal_error("Error while searching Windows registry");
- dataBufferSize = sizeof (dataBuffer);
+ dataBufferSize = sizeof(dataBuffer);
- RegQueryValueEx (hsubkey, "", 0, &dataType, dataBuffer, &dataBufferSize);
+ RegQueryValueEx(hsubkey, "", 0, &dataType, dataBuffer, &dataBufferSize);
if (dataType == REG_SZ) {
int subkeyIndex;
@@ -4723,64 +4454,63 @@ Scheme_Object *mx_all_clsid (int argc, Scheme_Object **argv, char **attributes)
while (loopFlag) {
- subkeyBufferSize = sizeray (subkeyBuffer);
+ subkeyBufferSize = sizeray(subkeyBuffer);
- result = RegEnumKeyEx (hsubkey, subkeyIndex++,
- subkeyBuffer,
- &subkeyBufferSize,
- 0, NULL, NULL,
- &fileTime);
+ result = RegEnumKeyEx(hsubkey, subkeyIndex++,
+ subkeyBuffer,
+ &subkeyBufferSize,
+ 0, NULL, NULL,
+ &fileTime);
- if (result == ERROR_NO_MORE_ITEMS)
- break;
+ if (result == ERROR_NO_MORE_ITEMS) break;
- p = attributes;
+ p = attributes;
- while (*p) {
- if (stricmp (subkeyBuffer, *p) == 0) {
- retval = scheme_make_pair (multiByteToSchemeCharString ((char *)dataBuffer),
- retval);
- loopFlag = FALSE;
- break; // *p loop
- }
- p = p XFORM_OK_PLUS 1;
- }
+ while (*p) {
+ if (stricmp(subkeyBuffer, *p) == 0) {
+ retval = scheme_make_pair(multiByteToSchemeCharString((char *)dataBuffer),
+ retval);
+ loopFlag = FALSE;
+ break; // *p loop
+ }
+ p = p XFORM_OK_PLUS 1;
+ }
}
}
- RegCloseKey (hsubkey);
+ RegCloseKey(hsubkey);
}
- RegCloseKey (hkey);
+ RegCloseKey(hkey);
return retval;
}
-Scheme_Object *mx_all_controls (int argc, Scheme_Object **argv)
+Scheme_Object *mx_all_controls(int argc, Scheme_Object **argv)
{
- return mx_all_clsid (argc, argv, controlAttributes);
+ return mx_all_clsid(argc, argv, controlAttributes);
}
-Scheme_Object *mx_all_coclasses (int argc, Scheme_Object **argv)
+Scheme_Object *mx_all_coclasses(int argc, Scheme_Object **argv)
{
- return mx_all_clsid (argc, argv, objectAttributes);
+ return mx_all_clsid(argc, argv, objectAttributes);
}
-Scheme_Object *mx_com_object_eq (int argc, Scheme_Object **argv)
+Scheme_Object *mx_com_object_eq(int argc, Scheme_Object **argv)
{
IUnknown *pIUnknown1, *pIUnknown2;
IDispatch *pIDispatch1, *pIDispatch2;
Scheme_Object *retval, *v;
- v = GUARANTEE_COM_OBJ ("com-object-eq?", 0);
- pIDispatch1 = MX_COM_OBJ_VAL (v);
- v = GUARANTEE_COM_OBJ ("com-object-eq?", 1);
- pIDispatch2 = MX_COM_OBJ_VAL (v);
+ v = GUARANTEE_COM_OBJ("com-object-eq?", 0);
+ pIDispatch1 = MX_COM_OBJ_VAL(v);
+ v = GUARANTEE_COM_OBJ("com-object-eq?", 1);
+ pIDispatch2 = MX_COM_OBJ_VAL(v);
// these should never fail
- pIDispatch1->QueryInterface (IID_IUnknown, (void **)&pIUnknown1);
- pIDispatch2->QueryInterface (IID_IUnknown, (void **)&pIUnknown2);
+ pIDispatch1->QueryInterface(IID_IUnknown, (void **)&pIUnknown1);
+ pIDispatch2->QueryInterface(IID_IUnknown, (void **)&pIUnknown2);
retval = (pIUnknown1 == pIUnknown2) ? scheme_true : scheme_false;
@@ -4790,29 +4520,27 @@ Scheme_Object *mx_com_object_eq (int argc, Scheme_Object **argv)
return retval;
}
-Scheme_Object *mx_document_title (int argc, Scheme_Object **argv)
+Scheme_Object *mx_document_title(int argc, Scheme_Object **argv)
{
HRESULT hr;
IHTMLDocument2 *pDocument;
BSTR bstr;
Scheme_Object *retval, *v;
- v = GUARANTEE_DOCUMENT ("document-title", 0);
- pDocument = MX_DOCUMENT_VAL (v);
+ v = GUARANTEE_DOCUMENT("document-title", 0);
+ pDocument = MX_DOCUMENT_VAL(v);
- hr = pDocument->get_title (&bstr);
+ hr = pDocument->get_title(&bstr);
- if (FAILED (hr))
- scheme_signal_error ("document-title: Can't get title");
+ if (FAILED(hr)) scheme_signal_error("document-title: Can't get title");
- retval = BSTRToSchemeString (bstr);
-
- SysFreeString (bstr);
+ retval = BSTRToSchemeString(bstr);
+ SysFreeString(bstr);
return retval;
}
-Scheme_Object *mx_document_objects (int argc, Scheme_Object **argv)
+Scheme_Object *mx_document_objects(int argc, Scheme_Object **argv)
{
HRESULT hr;
IHTMLDocument2 *pDocument;
@@ -4824,27 +4552,27 @@ Scheme_Object *mx_document_objects (int argc, Scheme_Object **argv)
IDispatch *pObjectDispatch;
MX_COM_Object *com_object;
- v = GUARANTEE_DOCUMENT ("document-objects", 0);
- pDocument = MX_DOCUMENT_VAL (v);
+ v = GUARANTEE_DOCUMENT("document-objects", 0);
+ pDocument = MX_DOCUMENT_VAL(v);
- hr = pDocument->get_body (&pBody);
+ hr = pDocument->get_body(&pBody);
- if (FAILED (hr) || pBody == NULL)
- codedComError ("document-objects: Can't find document BODY", hr);
+ if (FAILED(hr) || pBody == NULL)
+ codedComError("document-objects: Can't find document BODY", hr);
- pObjectsCollection = getBodyElementsWithTag (pBody, TEXT ("OBJECT"));
+ pObjectsCollection = getBodyElementsWithTag(pBody, TEXT("OBJECT"));
pBody->Release();
- pObjectsCollection->get_length (&numObjects);
+ pObjectsCollection->get_length(&numObjects);
retval = scheme_null;
for (i = numObjects - 1; i >= 0; i--) {
- pObjectDispatch = getObjectInCollection (pObjectsCollection, i);
+ pObjectDispatch = getObjectInCollection(pObjectsCollection, i);
- com_object = (MX_COM_Object *)scheme_malloc_tagged (sizeof (MX_COM_Object));
+ com_object = (MX_COM_Object *)scheme_malloc_tagged(sizeof(MX_COM_Object));
com_object->so.type = mx_com_object_type;
com_object->pIDispatch = pObjectDispatch;
@@ -4856,9 +4584,9 @@ Scheme_Object *mx_document_objects (int argc, Scheme_Object **argv)
com_object->connectionCookie = (DWORD)0;
com_object->released = FALSE;
- mx_register_com_object ((Scheme_Object *)com_object, pObjectDispatch);
+ mx_register_com_object((Scheme_Object *)com_object, pObjectDispatch);
- retval = scheme_make_pair ((Scheme_Object *)com_object, retval);
+ retval = scheme_make_pair((Scheme_Object *)com_object, retval);
}
pObjectsCollection->Release();
@@ -4866,11 +4594,11 @@ Scheme_Object *mx_document_objects (int argc, Scheme_Object **argv)
return retval;
}
-MX_Element *make_mx_element (IHTMLElement *pIHTMLElement)
+MX_Element *make_mx_element(IHTMLElement *pIHTMLElement)
{
MX_Element *elt;
- elt = (MX_Element *)scheme_malloc_tagged (sizeof (MX_Element));
+ elt = (MX_Element *)scheme_malloc_tagged(sizeof(MX_Element));
elt->so.type = mx_element_type;
elt->released = FALSE;
@@ -4883,12 +4611,12 @@ MX_Element *make_mx_element (IHTMLElement *pIHTMLElement)
if (pIHTMLElement->AddRef() > 2)
pIHTMLElement->Release();
- mx_register_simple_com_object ((Scheme_Object *)elt, pIHTMLElement);
+ mx_register_simple_com_object((Scheme_Object *)elt, pIHTMLElement);
return elt;
}
-Scheme_Object *mx_elements_with_tag (int argc, Scheme_Object **argv)
+Scheme_Object *mx_elements_with_tag(int argc, Scheme_Object **argv)
{
HRESULT hr;
IHTMLDocument2 *pDocument;
@@ -4901,46 +4629,45 @@ Scheme_Object *mx_elements_with_tag (int argc, Scheme_Object **argv)
int i;
LPCTSTR txt;
- GUARANTEE_STRSYM ("elements-with-tag", 1);
+ GUARANTEE_STRSYM("elements-with-tag", 1);
- v = GUARANTEE_DOCUMENT ("elements-with-tag", 0);
- pDocument = MX_DOCUMENT_VAL (v);
+ v = GUARANTEE_DOCUMENT("elements-with-tag", 0);
+ pDocument = MX_DOCUMENT_VAL(v);
- pDocument->get_body (&pBody);
+ pDocument->get_body(&pBody);
if (pBody == NULL)
- scheme_signal_error ("elements-with-tag: Can't find document BODY");
+ scheme_signal_error("elements-with-tag: Can't find document BODY");
- txt = schemeToText (argv[1]);
- if (stricmp (txt, "BODY") == 0) {
+ txt = schemeToText(argv[1]);
+ if (stricmp(txt, "BODY") == 0) {
MX_Element *elem;
- elem = make_mx_element (pBody);
- return scheme_make_pair ((Scheme_Object *)elem,
- scheme_null);
+ elem = make_mx_element(pBody);
+ return scheme_make_pair((Scheme_Object *)elem, scheme_null);
}
- pCollection = getBodyElementsWithTag (pBody, schemeToText (argv[1]));
+ pCollection = getBodyElementsWithTag(pBody, schemeToText(argv[1]));
pBody->Release();
- pCollection->get_length (&numObjects);
+ pCollection->get_length(&numObjects);
retval = scheme_null;
for (i = numObjects - 1; i >= 0; i--) {
- pDispatch = getElementInCollection (pCollection, i);
+ pDispatch = getElementInCollection(pCollection, i);
- hr = pDispatch->QueryInterface (IID_IHTMLElement, (void **)&pIHTMLElement);
+ hr = pDispatch->QueryInterface(IID_IHTMLElement, (void **)&pIHTMLElement);
- if (FAILED (hr) || pIHTMLElement == NULL)
- codedComError ("elements-with-tag: Can't get IHTMLElement interface", hr);
+ if (FAILED(hr) || pIHTMLElement == NULL)
+ codedComError("elements-with-tag: Can't get IHTMLElement interface", hr);
- elt = make_mx_element (pIHTMLElement);
+ elt = make_mx_element(pIHTMLElement);
- mx_register_simple_com_object ((Scheme_Object *)elt, pIHTMLElement);
+ mx_register_simple_com_object((Scheme_Object *)elt, pIHTMLElement);
- retval = scheme_make_pair ((Scheme_Object *)elt, retval);
+ retval = scheme_make_pair((Scheme_Object *)elt, retval);
}
pCollection->Release();
@@ -4948,7 +4675,7 @@ Scheme_Object *mx_elements_with_tag (int argc, Scheme_Object **argv)
return retval;
}
-CLSID getCLSIDFromCoClass (LPCTSTR name)
+CLSID getCLSIDFromCoClass(LPCTSTR name)
{
HKEY hkey, hsubkey;
LONG result;
@@ -4967,20 +4694,13 @@ CLSID getCLSIDFromCoClass (LPCTSTR name)
char **p;
// dummy entry
-
clsId = emptyClsId;
// get HKEY to Interfaces listing in Registry
-
- result = RegOpenKeyEx (HKEY_CLASSES_ROOT,
- "CLSID",
- (DWORD)0,
- KEY_READ,
- &hkey);
-
+ result = RegOpenKeyEx(HKEY_CLASSES_ROOT, "CLSID", (DWORD)0, KEY_READ, &hkey);
if (result != ERROR_SUCCESS)
- scheme_signal_error ("Error while searching Windows registry");
+ scheme_signal_error("Error while searching Windows registry");
// enumerate subkeys until we find the one we want
@@ -4991,38 +4711,33 @@ CLSID getCLSIDFromCoClass (LPCTSTR name)
while (1) {
// get next subkey
-
- clsIdBufferSize = sizeof (clsIdBuffer);
-
- result = RegEnumKeyEx (hkey, keyIndex++,
- clsIdBuffer,
- &clsIdBufferSize,
- 0, NULL, NULL,
- &fileTime);
+ clsIdBufferSize = sizeof(clsIdBuffer);
+ result = RegEnumKeyEx(hkey, keyIndex++,
+ clsIdBuffer,
+ &clsIdBufferSize,
+ 0, NULL, NULL,
+ &fileTime);
if (result == ERROR_NO_MORE_ITEMS)
break;
if (result != ERROR_SUCCESS)
- scheme_signal_error ("Error enumerating subkeys in Windows registry");
+ scheme_signal_error("Error enumerating subkeys in Windows registry");
- if (strlen (clsIdBuffer) != CLSIDLEN) // not a CLSID -- bogus entry
+ if (strlen(clsIdBuffer) != CLSIDLEN) // not a CLSID -- bogus entry
continue;
// open subkey
- result = RegOpenKeyEx (hkey, clsIdBuffer,
- (DWORD)0,
- KEY_READ, &hsubkey);
+ result = RegOpenKeyEx(hkey, clsIdBuffer, (DWORD)0, KEY_READ, &hsubkey);
- if (result != ERROR_SUCCESS)
- return clsId;
+ if (result != ERROR_SUCCESS) return clsId;
- dataBufferSize = sizeof (dataBuffer);
+ dataBufferSize = sizeof(dataBuffer);
- RegQueryValueEx (hsubkey, "", 0, &dataType, dataBuffer, &dataBufferSize);
+ RegQueryValueEx(hsubkey, "", 0, &dataType, dataBuffer, &dataBufferSize);
- if (dataType == REG_SZ && lstrcmp (name, (char *)dataBuffer) == 0) {
+ if (dataType == REG_SZ && lstrcmp(name, (char *)dataBuffer) == 0) {
int subkeyIndex;
TCHAR subkeyBuffer[256];
DWORD subkeyBufferSize;
@@ -5035,56 +4750,52 @@ CLSID getCLSIDFromCoClass (LPCTSTR name)
while (loopFlag) {
- subkeyBufferSize = sizeray (subkeyBuffer);
+ subkeyBufferSize = sizeray(subkeyBuffer);
- result = RegEnumKeyEx (hsubkey, subkeyIndex++,
- subkeyBuffer,
- &subkeyBufferSize,
- 0, NULL, NULL,
- &fileTime);
+ result = RegEnumKeyEx(hsubkey, subkeyIndex++, subkeyBuffer,
+ &subkeyBufferSize, 0, NULL, NULL, &fileTime);
- if (result == ERROR_NO_MORE_ITEMS)
- break;
+ if (result == ERROR_NO_MORE_ITEMS)
+ break;
- if (result != ERROR_SUCCESS)
- scheme_signal_error ("Error enumerating subkeys in Windows registry");
+ if (result != ERROR_SUCCESS)
+ scheme_signal_error("Error enumerating subkeys in Windows registry");
- p = objectAttributes;
+ p = objectAttributes;
- while (*p) {
- if (stricmp (subkeyBuffer, *p) == 0) {
- len = (unsigned int) strlen (clsIdBuffer);
- count = MultiByteToWideChar (CP_ACP, (DWORD)0,
- clsIdBuffer, len,
- oleClsIdBuffer,
- sizeray (oleClsIdBuffer) - 1);
- oleClsIdBuffer[len] = '\0';
+ while (*p) {
+ if (stricmp(subkeyBuffer, *p) == 0) {
+ len = (unsigned int) strlen(clsIdBuffer);
+ count = MultiByteToWideChar(CP_ACP, (DWORD)0,
+ clsIdBuffer, len,
+ oleClsIdBuffer,
+ sizeray(oleClsIdBuffer) - 1);
+ oleClsIdBuffer[len] = '\0';
- if (count == 0)
- scheme_signal_error ("Error translating CLSID to Unicode", name);
+ if (count == 0)
+ scheme_signal_error("Error translating CLSID to Unicode", name);
- CLSIDFromString (oleClsIdBuffer, &clsId);
- loopFlag = FALSE;
- break; // *p loop
- }
- p = p XFORM_OK_PLUS 1;
- }
+ CLSIDFromString(oleClsIdBuffer, &clsId);
+ loopFlag = FALSE;
+ break; // *p loop
+ }
+ p = p XFORM_OK_PLUS 1;
+ }
}
}
- RegCloseKey (hsubkey);
+ RegCloseKey(hsubkey);
}
- RegCloseKey (hkey);
+ RegCloseKey(hkey);
- if (isEmptyClsId (clsId))
- scheme_signal_error ("Coclass %s not found", name);
+ if (isEmptyClsId(clsId)) scheme_signal_error("Coclass %s not found", name);
return clsId;
}
-Scheme_Object *mx_find_element (int argc, Scheme_Object **argv)
+Scheme_Object *mx_find_element(int argc, Scheme_Object **argv)
{
IHTMLElement *pIHTMLElement;
int index;
@@ -5093,25 +4804,25 @@ Scheme_Object *mx_find_element (int argc, Scheme_Object **argv)
GUARANTEE_STRSYM ("find-element", 1);
GUARANTEE_STRSYM ("find-element", 2);
- if (argc > 3)
- GUARANTEE_NONNEGATIVE ("find-element", 3);
+ if (argc > 3) GUARANTEE_NONNEGATIVE("find-element", 3);
- index = (argc > 3) ? SCHEME_INT_VAL (argv[3]) : 0;
+ index = (argc > 3) ? SCHEME_INT_VAL(argv[3]) : 0;
- pIHTMLElement = findBodyElement (MX_DOCUMENT_VAL (argv[0]),
- schemeToText (argv[1]),
- schemeToText (argv[2]),
- index);
+ pIHTMLElement = findBodyElement(MX_DOCUMENT_VAL(argv[0]),
+ schemeToText(argv[1]),
+ schemeToText(argv[2]),
+ index);
if (pIHTMLElement == NULL)
- scheme_signal_error ("find-element: HTML element with tag = %s, id = %s not found",
- schemeToText (argv[1]),
- schemeToText (argv[2]));
+ scheme_signal_error("find-element: HTML element with "
+ "tag = %s, id = %s not found",
+ schemeToText(argv[1]),
+ schemeToText(argv[2]));
- return (Scheme_Object *) make_mx_element (pIHTMLElement);
+ return (Scheme_Object *)make_mx_element(pIHTMLElement);
}
-Scheme_Object *mx_find_element_by_id_or_name (int argc, Scheme_Object **argv)
+Scheme_Object *mx_find_element_by_id_or_name(int argc, Scheme_Object **argv)
{
HRESULT hr;
IHTMLElement *pIHTMLElement;
@@ -5122,55 +4833,54 @@ Scheme_Object *mx_find_element_by_id_or_name (int argc, Scheme_Object **argv)
IDispatch *pEltDispatch;
Scheme_Object *v;
- if (argc > 2)
- GUARANTEE_NONNEGATIVE ("find-element-by-id-or-name", 2);
+ if (argc > 2) GUARANTEE_NONNEGATIVE("find-element-by-id-or-name", 2);
+ v = GUARANTEE_DOCUMENT("find-element-by-id-or-name", 0);
+ pIHTMLDocument2 = MX_DOCUMENT_VAL(v);
- v = GUARANTEE_DOCUMENT ("find-element-by-id-or-name", 0);
- pIHTMLDocument2 = MX_DOCUMENT_VAL (v);
+ hr = pIHTMLDocument2->get_all(&pIHTMLElementCollection);
- hr = pIHTMLDocument2->get_all (&pIHTMLElementCollection);
-
- if (FAILED (hr) || pIHTMLElementCollection == NULL) {
- scheme_signal_error ("find-element-by-id-or-name: "
- "Couldn't retrieve element collection "
- "from HTML document");
+ if (FAILED(hr) || pIHTMLElementCollection == NULL) {
+ scheme_signal_error("find-element-by-id-or-name: "
+ "Couldn't retrieve element collection "
+ "from HTML document");
}
- v = GUARANTEE_STRSYM ("find-element-by-id-or-name", 1);
- bstr = schemeToBSTR (v);
+ v = GUARANTEE_STRSYM("find-element-by-id-or-name", 1);
+ bstr = schemeToBSTR(v);
name.vt = VT_BSTR;
name.bstrVal = bstr;
index.vt = VT_I4;
- index.lVal = (argc > 2) ? SCHEME_INT_VAL (argv[2]) : 0;
+ index.lVal = (argc > 2) ? SCHEME_INT_VAL(argv[2]) : 0;
- pIHTMLElementCollection->item (name, index, &pEltDispatch);
+ pIHTMLElementCollection->item(name, index, &pEltDispatch);
- SysFreeString (bstr);
+ SysFreeString(bstr);
pIHTMLElementCollection->Release();
if (pEltDispatch == NULL)
- scheme_signal_error ("find-element-by-id-or-name: "
- "Couldn't find element with id = %s", schemeToText (argv[1]));
+ scheme_signal_error("find-element-by-id-or-name: "
+ "Couldn't find element with id = %s",
+ schemeToText(argv[1]));
- hr = pEltDispatch->QueryInterface (IID_IHTMLElement, (void **)&pIHTMLElement);
+ hr = pEltDispatch->QueryInterface(IID_IHTMLElement, (void **)&pIHTMLElement);
- if (FAILED (hr) || pIHTMLElement == NULL)
- scheme_signal_error ("find-element-by-id-or-name: "
- "Couldn't retrieve element interface "
- "for element with id = %s",
- schemeToText (argv[1]));
+ if (FAILED(hr) || pIHTMLElement == NULL)
+ scheme_signal_error("find-element-by-id-or-name: "
+ "Couldn't retrieve element interface "
+ "for element with id = %s",
+ schemeToText(argv[1]));
- return (Scheme_Object *) make_mx_element (pIHTMLElement);
+ return (Scheme_Object *)make_mx_element(pIHTMLElement);
}
// for coclass->html, progid->html
-Scheme_Object *mx_clsid_to_html (CLSID clsId,
+Scheme_Object *mx_clsid_to_html(CLSID clsId,
const char *controlName,
- const char *fname,
- int argc, Scheme_Object **argv )
+ const char *fname,
+ int argc, Scheme_Object **argv )
{
LPOLESTR clsIdString;
char widthBuff[25];
@@ -5179,8 +4889,8 @@ Scheme_Object *mx_clsid_to_html (CLSID clsId,
char *format;
int len;
- GUARANTEE_INTEGER (fname, 1);
- GUARANTEE_INTEGER (fname, 2);
+ GUARANTEE_INTEGER(fname, 1);
+ GUARANTEE_INTEGER(fname, 2);
format = "%u";
@@ -5188,135 +4898,135 @@ Scheme_Object *mx_clsid_to_html (CLSID clsId,
Scheme_Object *v;
const char * symString;
- v = GUARANTEE_STRSYM (fname, 3);
- symString = schemeToMultiByte (v);
+ v = GUARANTEE_STRSYM(fname, 3);
+ symString = schemeToMultiByte(v);
- if (stricmp (symString, "percent") == 0)
- format = "%u%%";
+ if (stricmp(symString, "percent") == 0)
+ format = "%u%%";
+ else if (stricmp(symString, "pixels"))
+ scheme_signal_error("%s: Invalid size specifier '%s: "
+ "must be either 'pixels or 'percent",
+ fname, symString);
+ }
- else if (stricmp (symString, "pixels"))
- scheme_signal_error ("%s: Invalid size specifier '%s: "
- "must be either 'pixels or 'percent",
- fname, symString);
+ sprintf(widthBuff, format, SCHEME_INT_VAL(argv[1]));
+ sprintf(heightBuff, format, SCHEME_INT_VAL(argv[2]));
- }
+ StringFromCLSID(clsId, &clsIdString);
- sprintf (widthBuff, format, SCHEME_INT_VAL (argv[1]));
- sprintf (heightBuff, format, SCHEME_INT_VAL (argv[2]));
-
- StringFromCLSID (clsId, &clsIdString);
-
- len = wcslen (clsIdString);
+ len = wcslen(clsIdString);
*(clsIdString XFORM_OK_PLUS len - 1) = L'\0';
if (clsIdString == NULL)
- scheme_signal_error ("%s: Can't convert control CLSID to string", fname);
+ scheme_signal_error("%s: Can't convert control CLSID to string", fname);
- sprintf (buff,
- "",
- controlName,
- widthBuff, heightBuff,
- clsIdString + 1);
+ sprintf(buff,
+ "",
+ controlName,
+ widthBuff, heightBuff,
+ clsIdString + 1);
- return multiByteToSchemeCharString (buff);
+ return multiByteToSchemeCharString(buff);
}
-Scheme_Object * mx_coclass_to_html (int argc, Scheme_Object **argv)
+Scheme_Object * mx_coclass_to_html(int argc, Scheme_Object **argv)
{
LPCTSTR controlName;
CLSID clsId;
Scheme_Object *v;
- v = GUARANTEE_STRSYM ("coclass->html", 0);
- controlName = schemeToText (v);
- clsId = getCLSIDFromCoClass (controlName);
+ v = GUARANTEE_STRSYM("coclass->html", 0);
+ controlName = schemeToText(v);
+ clsId = getCLSIDFromCoClass(controlName);
- if (isEmptyClsId (clsId))
- scheme_signal_error ("coclass->html: Coclass \"%s\" not found",
- schemeToMultiByte (argv[0]));
+ if (isEmptyClsId(clsId))
+ scheme_signal_error("coclass->html: Coclass \"%s\" not found",
+ schemeToMultiByte(argv[0]));
- return mx_clsid_to_html (clsId, controlName, "coclass->html", argc, argv);
+ return mx_clsid_to_html(clsId, controlName, "coclass->html", argc, argv);
}
-Scheme_Object *mx_progid_to_html (int argc, Scheme_Object **argv)
+Scheme_Object *mx_progid_to_html(int argc, Scheme_Object **argv)
{
HRESULT hr;
BSTR wideProgId;
CLSID clsId;
Scheme_Object *v;
- v = GUARANTEE_STRSYM ("progid->html", 0);
- wideProgId = schemeToBSTR (v);
+ v = GUARANTEE_STRSYM("progid->html", 0);
+ wideProgId = schemeToBSTR(v);
- hr = CLSIDFromProgID (wideProgId, &clsId);
+ hr = CLSIDFromProgID(wideProgId, &clsId);
- SysFreeString (wideProgId);
+ SysFreeString(wideProgId);
- if (FAILED (hr))
- scheme_signal_error ("progid->html: ProgID \"%s\" not found", schemeToText (argv[0]));
+ if (FAILED(hr))
+ scheme_signal_error("progid->html: ProgID \"%s\" not found",
+ schemeToText(argv[0]));
- return mx_clsid_to_html (clsId, schemeToText (argv[0]), "progid->html", argc, argv);
+ return mx_clsid_to_html(clsId, schemeToText(argv[0]), "progid->html",
+ argc, argv);
}
-Scheme_Object *mx_stuff_html (int argc, Scheme_Object **argv,
- WCHAR *oleWhere, char *scheme_name) {
+Scheme_Object *mx_stuff_html(int argc, Scheme_Object **argv,
+ WCHAR *oleWhere, char *scheme_name)
+{
IHTMLDocument2 *pDocument;
IHTMLElement *pBody;
BSTR where, html;
Scheme_Object *v;
- v = GUARANTEE_DOCUMENT (scheme_name, 0);
- pDocument = MX_DOCUMENT_VAL (v);
+ v = GUARANTEE_DOCUMENT(scheme_name, 0);
+ pDocument = MX_DOCUMENT_VAL(v);
- v = GUARANTEE_STRSYM (scheme_name, 1);
- html = schemeToBSTR (v);
- pDocument->get_body (&pBody);
+ v = GUARANTEE_STRSYM(scheme_name, 1);
+ html = schemeToBSTR(v);
+ pDocument->get_body(&pBody);
if (pBody == NULL)
- scheme_signal_error ("Can't find document BODY");
+ scheme_signal_error("Can't find document BODY");
- where = SysAllocString (oleWhere);
+ where = SysAllocString(oleWhere);
- pBody->insertAdjacentHTML (where, html);
+ pBody->insertAdjacentHTML(where, html);
- SysFreeString (where);
- SysFreeString (html);
+ SysFreeString(where);
+ SysFreeString(html);
return scheme_void;
-
}
-Scheme_Object *mx_insert_html (int argc, Scheme_Object **argv)
+Scheme_Object *mx_insert_html(int argc, Scheme_Object **argv)
{
- return mx_stuff_html (argc, argv, L"AfterBegin", "doc-insert-html");
+ return mx_stuff_html(argc, argv, L"AfterBegin", "doc-insert-html");
}
-Scheme_Object *mx_append_html (int argc, Scheme_Object **argv)
+Scheme_Object *mx_append_html(int argc, Scheme_Object **argv)
{
- return mx_stuff_html (argc, argv, L"BeforeEnd", "doc-append-html");
+ return mx_stuff_html(argc, argv, L"BeforeEnd", "doc-append-html");
}
-Scheme_Object *mx_replace_html (int argc, Scheme_Object **argv)
+Scheme_Object *mx_replace_html(int argc, Scheme_Object **argv)
{
IHTMLDocument2 *pDocument;
IHTMLElement *pBody;
BSTR html;
Scheme_Object *v;
- v = GUARANTEE_DOCUMENT ("replace-html", 0);
- pDocument = MX_DOCUMENT_VAL (v);
- v = GUARANTEE_STRSYM ("replace-html", 1);
- html = schemeToBSTR (v);
+ v = GUARANTEE_DOCUMENT("replace-html", 0);
+ pDocument = MX_DOCUMENT_VAL(v);
+ v = GUARANTEE_STRSYM("replace-html", 1);
+ html = schemeToBSTR(v);
- pDocument->get_body (&pBody);
+ pDocument->get_body(&pBody);
if (pBody == NULL)
- scheme_signal_error ("Can't find document body");
+ scheme_signal_error("Can't find document body");
- pBody->put_innerHTML (html);
+ pBody->put_innerHTML(html);
- SysFreeString (html);
+ SysFreeString(html);
return scheme_void;
}
@@ -5326,45 +5036,45 @@ Scheme_Object *mx_replace_html (int argc, Scheme_Object **argv)
blocking on Win events doesn't seem to work
any longer
-static BOOL win_event_available (void *)
+static BOOL win_event_available(void *)
{
MSG msg;
- return (PeekMessage (&msg, NULL, 0x400, 0x400, PM_NOREMOVE) ||
- PeekMessage (&msg, NULL, 0x113, 0x113, PM_NOREMOVE));
+ return (PeekMessage(&msg, NULL, 0x400, 0x400, PM_NOREMOVE) ||
+ PeekMessage(&msg, NULL, 0x113, 0x113, PM_NOREMOVE));
}
-static void win_event_sem_fun (MX_Document_Object *doc, void *fds)
+static void win_event_sem_fun(MX_Document_Object *doc, void *fds)
{
static HANDLE dummySem;
if (!dummySem) {
- dummySem = CreateSemaphore (NULL, 0, 1, NULL);
+ dummySem = CreateSemaphore(NULL, 0, 1, NULL);
if (!dummySem) {
- scheme_signal_error ("Error creating Windows event semaphore");
+ scheme_signal_error("Error creating Windows event semaphore");
}
}
- scheme_add_fd_eventmask (fds, QS_ALLINPUT);
- scheme_add_fd_handle (dummySem, fds, TRUE);
+ scheme_add_fd_eventmask(fds, QS_ALLINPUT);
+ scheme_add_fd_handle(dummySem, fds, TRUE);
}
*/
-Scheme_Object *mx_process_win_events (int argc, Scheme_Object **argv)
+Scheme_Object *mx_process_win_events(int argc, Scheme_Object **argv)
{
MSG msg;
/* this used to work, sort of
- scheme_block_until ((int (*) (Scheme_Object *))win_event_available,
- (void (*) (Scheme_Object *, void *))win_event_sem_fun,
- NULL, 0.0F);
+ scheme_block_until((int(*)(Scheme_Object *))win_event_available,
+ (void(*)(Scheme_Object *, void *))win_event_sem_fun,
+ NULL, 0.0F);
*/
- while (PeekMessage (&msg, NULL, 0x400, 0x400, PM_REMOVE) ||
- PeekMessage (&msg, NULL, 0x113, 0x113, PM_REMOVE)) {
- TranslateMessage (&msg);
- DispatchMessage (&msg);
+ while (PeekMessage(&msg, NULL, 0x400, 0x400, PM_REMOVE) ||
+ PeekMessage(&msg, NULL, 0x113, 0x113, PM_REMOVE)) {
+ TranslateMessage(&msg);
+ DispatchMessage(&msg);
}
return scheme_void;
@@ -5447,7 +5157,7 @@ static void mx_sink_unmarshal_scheme(void *obj, VARIANTARG *p)
GC_BOX_DONE(_obj);
}
-void initMysSinkTable (void)
+void initMysSinkTable(void)
{
myssink_table.psink_release_handler = mx_sink_release_handler;
myssink_table.psink_release_arg = mx_sink_release_handler;
@@ -5457,18 +5167,17 @@ void initMysSinkTable (void)
myssink_table.pmake_scode = mx_sink_make_scode;
}
-void mx_exit_closer (Scheme_Object *obj,
- Scheme_Close_Custodian_Client *fun, void *data)
+void mx_exit_closer(Scheme_Object *obj,
+ Scheme_Close_Custodian_Client *fun, void *data)
{
- if ((fun == (Scheme_Close_Custodian_Client *)
- scheme_release_com_object) ||
- (fun == (Scheme_Close_Custodian_Client *)
- scheme_release_simple_com_object)) {
- (*fun) (obj, data);
+ if ((fun == (Scheme_Close_Custodian_Client *)scheme_release_com_object)
+ ||
+ (fun == (Scheme_Close_Custodian_Client *)scheme_release_simple_com_object)) {
+ (*fun)(obj, data);
}
}
-void mx_cleanup (void)
+void mx_cleanup(void)
{
/* looks like CoUninitialize() gets called automatically */
}
@@ -5478,9 +5187,9 @@ void *mx_wrap_handler(Scheme_Object *h)
return GC_HANDLER_BOX(h);
}
-Scheme_Object *scheme_module_name (void)
+Scheme_Object *scheme_module_name(void)
{
- return scheme_intern_symbol (MXMAIN);
+ return scheme_intern_symbol(MXMAIN);
}
#ifdef MZ_PRECISE_GC
@@ -5489,7 +5198,7 @@ START_XFORM_SKIP;
END_XFORM_SKIP;
#endif
-Scheme_Object *scheme_initialize (Scheme_Env *env)
+Scheme_Object *scheme_initialize(Scheme_Env *env)
{
HRESULT hr;
Scheme_Object *mx_fun;
@@ -5497,87 +5206,90 @@ Scheme_Object *scheme_initialize (Scheme_Env *env)
Scheme_Object *mx_name;
Scheme_Object * arglist[1];
- scheme_register_extension_global (&mx_omit_obj, sizeof (mx_omit_obj));
- scheme_register_extension_global (&scheme_date_type, sizeof (scheme_date_type));
+ scheme_register_extension_global(&mx_omit_obj, sizeof(mx_omit_obj));
+ scheme_register_extension_global(&scheme_date_type, sizeof(scheme_date_type));
// globals in mysterx.cxx
- mx_name = scheme_intern_symbol (MXMAIN);
- scheme_date_type = scheme_builtin_value ("struct:date");
+ mx_name = scheme_intern_symbol(MXMAIN);
+ scheme_date_type = scheme_builtin_value("struct:date");
- mx_com_object_type = scheme_make_type ("");
- mx_com_type_type = scheme_make_type ("");
- mx_browser_type = scheme_make_type ("");
- mx_document_type = scheme_make_type ("");
- mx_element_type = scheme_make_type ("");
- mx_event_type = scheme_make_type ("");
- mx_com_cy_type = scheme_make_type ("");
- mx_com_date_type = scheme_make_type ("");
- mx_com_scode_type = scheme_make_type ("");
- mx_com_iunknown_type = scheme_make_type ("");
- mx_com_omit_type = scheme_make_type ("");
- mx_com_typedesc_type = scheme_make_type ("");
+ mx_com_object_type = scheme_make_type("");
+ mx_com_type_type = scheme_make_type("");
+ mx_browser_type = scheme_make_type("");
+ mx_document_type = scheme_make_type("");
+ mx_element_type = scheme_make_type("");
+ mx_event_type = scheme_make_type("");
+ mx_com_cy_type = scheme_make_type("");
+ mx_com_date_type = scheme_make_type("");
+ mx_com_scode_type = scheme_make_type("");
+ mx_com_iunknown_type = scheme_make_type("");
+ mx_com_omit_type = scheme_make_type("");
+ mx_com_typedesc_type = scheme_make_type("");
- mx_tbl_entry_type = scheme_make_type ("");
+ mx_tbl_entry_type = scheme_make_type("");
#ifdef MZ_PRECISE_GC
register_traversers();
#endif
-
- hr = CoInitialize (NULL);
+ hr = CoInitialize(NULL);
// S_OK means success, S_FALSE means COM already loaded
- if (FAILED (hr) && hr != S_FALSE) {
+ if (FAILED(hr) && hr != S_FALSE) {
return scheme_false;
}
arglist[0] = scheme_false;
- scheme_register_extension_global (&mx_unmarshal_strings_as_symbols, sizeof mx_unmarshal_strings_as_symbols);
- scheme_register_extension_global (&mx_marshal_raw_scheme_objects, sizeof mx_marshal_raw_scheme_objects);
+ scheme_register_extension_global(&mx_unmarshal_strings_as_symbols,
+ sizeof mx_unmarshal_strings_as_symbols);
+ scheme_register_extension_global(&mx_marshal_raw_scheme_objects,
+ sizeof mx_marshal_raw_scheme_objects);
- mx_unmarshal_strings_as_symbols = scheme_apply (scheme_builtin_value ("make-parameter"), 1, arglist);
- mx_marshal_raw_scheme_objects = scheme_apply (scheme_builtin_value ("make-parameter"), 1, arglist);
+ mx_unmarshal_strings_as_symbols =
+ scheme_apply(scheme_builtin_value("make-parameter"), 1, arglist);
+ mx_marshal_raw_scheme_objects =
+ scheme_apply(scheme_builtin_value("make-parameter"), 1, arglist);
// export prims + omit value
- env = scheme_primitive_module (mx_name, env);
+ env = scheme_primitive_module(mx_name, env);
- for (i = 0; i < sizeray (mxPrims); i++) {
- mx_fun = scheme_make_prim_w_arity (mxPrims[i].c_fun,
- mxPrims[i].name,
- mxPrims[i].minargs,
- mxPrims[i].maxargs);
- scheme_add_global (mxPrims[i].name, mx_fun, env);
+ for (i = 0; i < sizeray(mxPrims); i++) {
+ mx_fun = scheme_make_prim_w_arity(mxPrims[i].c_fun,
+ mxPrims[i].name,
+ mxPrims[i].minargs,
+ mxPrims[i].maxargs);
+ scheme_add_global(mxPrims[i].name, mx_fun, env);
}
- mx_omit_obj = (Scheme_Object *)scheme_malloc_atomic_tagged (sizeof (MX_OMIT));
+ mx_omit_obj = (Scheme_Object *)scheme_malloc_atomic_tagged(sizeof(MX_OMIT));
mx_omit_obj->type = mx_com_omit_type;
- scheme_add_global ("com-omit", mx_omit_obj, env);
+ scheme_add_global("com-omit", mx_omit_obj, env);
- scheme_finish_primitive_module (env);
+ scheme_finish_primitive_module(env);
initEventNames();
initMysSinkTable();
- if (0 && isatty (fileno (stdin))) {
- fprintf (stderr,
- "MysterX extension for PLT Scheme, "
- "Copyright (c) 1999-2003 PLT (Paul Steckler)\n");
+ if (0 && isatty(fileno(stdin))) {
+ fprintf(stderr,
+ "MysterX extension for PLT Scheme, "
+ "Copyright (c) 1999-2003 PLT (Paul Steckler)\n");
}
- scheme_add_atexit_closer (mx_exit_closer);
- atexit (mx_cleanup);
+ scheme_add_atexit_closer(mx_exit_closer);
+ atexit(mx_cleanup);
return scheme_void;
}
-Scheme_Object * scheme_reload (Scheme_Env *env)
+Scheme_Object *scheme_reload(Scheme_Env *env)
{
- return scheme_initialize (env);
+ return scheme_initialize(env);
}
// for some reason, couldn't put ATL stuff in browser.cxx
@@ -5587,7 +5299,7 @@ Scheme_Object * scheme_reload (Scheme_Env *env)
START_XFORM_SKIP;
#endif
-void browserHwndMsgLoop (LPVOID p)
+void browserHwndMsgLoop(LPVOID p)
{
HRESULT hr;
MSG msg;
@@ -5611,33 +5323,33 @@ void browserHwndMsgLoop (LPVOID p)
# else
# define ATLWINDOWTITLE "AtlAxWin80"
# endif
- hwnd = CreateWindow (ATLWINDOWTITLE,
- "myspage.DHTMLPage.1",
- WS_VISIBLE | hasScrollBars |
- (pBrowserWindowInit->browserWindow.style & ~ (WS_HSCROLL|WS_VSCROLL)),
- pBrowserWindowInit->browserWindow.x, pBrowserWindowInit->browserWindow.y,
- pBrowserWindowInit->browserWindow.width, pBrowserWindowInit->browserWindow.height,
- NULL, NULL, hInstance, NULL);
+ hwnd = CreateWindow(ATLWINDOWTITLE,
+ "myspage.DHTMLPage.1",
+ WS_VISIBLE | hasScrollBars |
+ (pBrowserWindowInit->browserWindow.style & ~ (WS_HSCROLL|WS_VSCROLL)),
+ pBrowserWindowInit->browserWindow.x, pBrowserWindowInit->browserWindow.y,
+ pBrowserWindowInit->browserWindow.width, pBrowserWindowInit->browserWindow.height,
+ NULL, NULL, hInstance, NULL);
# undef ATLWINDOWTITLE
if (hwnd == NULL) {
- ReleaseSemaphore (createHwndSem, 1, NULL);
+ ReleaseSemaphore(createHwndSem, 1, NULL);
return;
}
- ShowWindow (hwnd, SW_SHOW);
- SetForegroundWindow (hwnd);
+ ShowWindow(hwnd, SW_SHOW);
+ SetForegroundWindow(hwnd);
browserHwnd = hwnd;
if (hasScrollBars)
// clear spurious low bit to avoid trouble
- SetWindowLong (hwnd, GWL_STYLE,
- GetWindowLong (hwnd, GWL_STYLE) & ~1L);
+ SetWindowLong(hwnd, GWL_STYLE,
+ GetWindowLong(hwnd, GWL_STYLE) & ~1L);
- SetClassLong (hwnd, GCL_HICON, HandleToLong (hIcon));
+ SetClassLong(hwnd, GCL_HICON, HandleToLong(hIcon));
- SetWindowText (hwnd, pBrowserWindowInit->browserWindow.label);
+ SetWindowText(hwnd, pBrowserWindowInit->browserWindow.label);
pIUnknown = NULL;
@@ -5646,29 +5358,29 @@ void browserHwndMsgLoop (LPVOID p)
while (IsWindow (hwnd)) {
if (pIUnknown == NULL) {
- AtlAxGetControl (hwnd, &pIUnknown);
+ AtlAxGetControl(hwnd, &pIUnknown);
if (pIUnknown) {
- hr = CoMarshalInterThreadInterfaceInStream (IID_IUnknown, pIUnknown,
- pBrowserWindowInit->ppIStream);
+ hr = CoMarshalInterThreadInterfaceInStream(IID_IUnknown, pIUnknown,
+ pBrowserWindowInit->ppIStream);
- if (FAILED (hr)) {
- DestroyWindow (hwnd);
- ReleaseSemaphore (createHwndSem, 1, NULL);
- codedComError ("Can't marshal document interface", hr);
- }
+ if (FAILED(hr)) {
+ DestroyWindow(hwnd);
+ ReleaseSemaphore(createHwndSem, 1, NULL);
+ codedComError("Can't marshal document interface", hr);
+ }
- ReleaseSemaphore (createHwndSem, 1, NULL);
+ ReleaseSemaphore(createHwndSem, 1, NULL);
}
}
- while (IsWindow (hwnd) && GetMessage (&msg, NULL, 0, 0)) {
- TranslateMessage (&msg);
- DispatchMessage (&msg);
+ while (IsWindow(hwnd) && GetMessage(&msg, NULL, 0, 0)) {
+ TranslateMessage(&msg);
+ DispatchMessage(&msg);
if (*destroy) {
- *destroy = FALSE;
- DestroyWindow (hwnd);
+ *destroy = FALSE;
+ DestroyWindow(hwnd);
}
}
@@ -5678,26 +5390,24 @@ void browserHwndMsgLoop (LPVOID p)
free(destroy);
}
-BOOL APIENTRY DllMain (HANDLE hModule, DWORD reason, LPVOID lpReserved)
+BOOL APIENTRY DllMain(HANDLE hModule, DWORD reason, LPVOID lpReserved)
{
if (reason == DLL_PROCESS_ATTACH) {
hInstance = (HINSTANCE)hModule;
- browserHwndMutex = CreateSemaphore (NULL, 1, 1, NULL);
- createHwndSem = CreateSemaphore (NULL, 0, 1, NULL);
- eventSinkMutex = CreateSemaphore (NULL, 1, 1, NULL);
+ browserHwndMutex = CreateSemaphore(NULL, 1, 1, NULL);
+ createHwndSem = CreateSemaphore(NULL, 0, 1, NULL);
+ eventSinkMutex = CreateSemaphore(NULL, 1, 1, NULL);
- hIcon = (HICON)LoadImage (hInstance,
- MAKEINTRESOURCE (MYSTERX_ICON),
- IMAGE_ICON, 0, 0, 0);
+ hIcon = (HICON)LoadImage(hInstance, MAKEINTRESOURCE(MYSTERX_ICON),
+ IMAGE_ICON, 0, 0, 0);
- _Module.Init (NULL, hInstance, &LIBID_ATLLib);
+ _Module.Init(NULL, hInstance, &LIBID_ATLLib);
AtlAxWinInit();
- }
- else if (reason == DLL_PROCESS_DETACH)
+ } else if (reason == DLL_PROCESS_DETACH)
_Module.Term();
return TRUE;
@@ -5720,64 +5430,70 @@ END_XFORM_SKIP;
// This doesn't appear to be necessary.
//
-// raw_interfaces_only high_property_prefixes ("_get", "_put", "_putref")
+// raw_interfaces_only high_property_prefixes("_get", "_put", "_putref")
//
using namespace mscorlib;
ICorRuntimeHost * pCLR = NULL;
-Scheme_Object *
-initialize_dotnet_runtime (int argc, Scheme_Object **argv)
+Scheme_Object* initialize_dotnet_runtime(int argc, Scheme_Object **argv)
{
- HRESULT hr;
- _AppDomain *pDefaultDomain = NULL;
- IUnknown *pAppDomainPunk = NULL;
- IDispatch *pAppDomainDispatch = NULL;
+ HRESULT hr;
+ _AppDomain *pDefaultDomain = NULL;
+ IUnknown *pAppDomainPunk = NULL;
+ IDispatch *pAppDomainDispatch = NULL;
- hr = CorBindToRuntimeEx (NULL, // latest version
- // workspace mode
- L"wks",
- // We'll only be running one domain.
- STARTUP_LOADER_OPTIMIZATION_SINGLE_DOMAIN,
- CLSID_CorRuntimeHost,
- IID_ICorRuntimeHost,
- (void **) &pCLR);
+ hr = CorBindToRuntimeEx(NULL, // latest version
+ // workspace mode
+ L"wks",
+ // We'll only be running one domain.
+ STARTUP_LOADER_OPTIMIZATION_SINGLE_DOMAIN,
+ CLSID_CorRuntimeHost,
+ IID_ICorRuntimeHost,
+ (void **) &pCLR);
- if (FAILED (hr))
- scheme_signal_error ("%%%%initialize-dotnet-runtime: CorBindToRuntimeEx() failed.");
+ if (FAILED(hr))
+ scheme_signal_error("%%%%initialize-dotnet-runtime: "
+ "CorBindToRuntimeEx() failed.");
- hr = pCLR->Start();
- if (FAILED (hr))
- scheme_signal_error ("%%%%initialize-dotnet-runtime: CLR failed to start.");
+ hr = pCLR->Start();
+ if (FAILED(hr))
+ scheme_signal_error("%%%%initialize-dotnet-runtime: "
+ "CLR failed to start.");
- hr = pCLR->GetDefaultDomain (&pAppDomainPunk);
- if (FAILED (hr) || pAppDomainPunk == NULL)
- scheme_signal_error ("%%%%initialize-dotnet-runtime: GetDefaultDomain() failed.");
+ hr = pCLR->GetDefaultDomain(&pAppDomainPunk);
+ if (FAILED(hr) || pAppDomainPunk == NULL)
+ scheme_signal_error("%%%%initialize-dotnet-runtime: "
+ "GetDefaultDomain() failed.");
- hr = pAppDomainPunk->QueryInterface (__uuidof (_AppDomain),
- (void **) &pDefaultDomain);
- if (FAILED (hr) || pDefaultDomain == NULL)
- scheme_signal_error ("%%%%initialize-dotnet-runtime: QueryInterface for _AppDomain failed.");
- pDefaultDomain->Release();
+ hr = pAppDomainPunk->QueryInterface(__uuidof(_AppDomain),
+ (void **) &pDefaultDomain);
+ if (FAILED(hr) || pDefaultDomain == NULL)
+ scheme_signal_error("%%%%initialize-dotnet-runtime: "
+ "QueryInterface for _AppDomain failed.");
+ pDefaultDomain->Release();
- hr = pAppDomainPunk->QueryInterface (IID_IDispatch, (void **) &pAppDomainDispatch);
- if (FAILED (hr) || pAppDomainDispatch == NULL)
- scheme_signal_error ("%%%%initialize-dotnet-runtime: QueryInterface for IDispatch failed.");
+ hr = pAppDomainPunk->QueryInterface(IID_IDispatch,
+ (void **) &pAppDomainDispatch);
+ if (FAILED(hr) || pAppDomainDispatch == NULL)
+ scheme_signal_error("%%%%initialize-dotnet-runtime: "
+ "QueryInterface for IDispatch failed.");
- Scheme_Object * arglist[1] = {scheme_true};
+ Scheme_Object * arglist[1] = {scheme_true};
- scheme_apply (mx_unmarshal_strings_as_symbols, 1, arglist);
- scheme_apply (mx_marshal_raw_scheme_objects, 1, arglist);
+ scheme_apply(mx_unmarshal_strings_as_symbols, 1, arglist);
+ scheme_apply(mx_marshal_raw_scheme_objects, 1, arglist);
- return mx_make_idispatch (pAppDomainDispatch);
+ return mx_make_idispatch(pAppDomainDispatch);
}
/// END OF JRM HACK
#else
Scheme_Object *
-initialize_dotnet_runtime (int argc, Scheme_Object **argv)
+initialize_dotnet_runtime(int argc, Scheme_Object **argv)
{
- scheme_signal_error ("%%%%initialize-dotnet-runtime: Support for .NET is not available in this image.");
+ scheme_signal_error("%%%%initialize-dotnet-runtime: "
+ "Support for .NET is not available in this image.");
return scheme_false;
}
#endif
diff --git a/src/mysterx/mysterx.h b/src/mysterx/mysterx.h
index 1989b92d4f..6393cd7d45 100644
--- a/src/mysterx/mysterx.h
+++ b/src/mysterx/mysterx.h
@@ -706,8 +706,8 @@ extern unsigned long browserCount;
else { \
vaPtr->vt = getVarTypeFromElemDesc(&pFuncDesc->lprgelemdescParam[j]); \
if (vaPtr->vt == VT_VARIANT) { \
- marshalSchemeValueToVariant(argv[i],vaPtr); \
- va = *vaPtr; \
+ marshalSchemeValueToVariant(argv[i],vaPtr); \
+ va = *vaPtr; \
pushVariant(va); \
continue; \
} \
@@ -740,15 +740,15 @@ extern unsigned long browserCount;
for ( ; j > 0; i--,j--,vaPtr--) { \
VariantInit(vaPtr); \
if (isDefaultParam(pFuncDesc,i)) { \
- vaPtr = &(pFuncDesc->lprgelemdescParam[i].paramdesc.pparamdescex->varDefaultValue); \
+ vaPtr = &(pFuncDesc->lprgelemdescParam[i].paramdesc.pparamdescex->varDefaultValue); \
} \
else if (i == lcidIndex) { \
vaPtr->vt = VT_UI4; \
vaPtr->ulVal = LOCALE_SYSTEM_DEFAULT; \
} \
else { \
- vaPtr->vt = VT_ERROR; \
- vaPtr->lVal = DISP_E_PARAMNOTFOUND; \
+ vaPtr->vt = VT_ERROR; \
+ vaPtr->lVal = DISP_E_PARAMNOTFOUND; \
va = *vaPtr; \
pushVariant(va); \
continue; \