#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.59 for tclole 0.3.
+# Generated by GNU Autoconf 2.59 for tclole 0.4.
#
# Copyright (C) 2003 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# Identity of this package.
PACKAGE_NAME='tclole'
PACKAGE_TARNAME='tclole'
-PACKAGE_VERSION='0.3'
-PACKAGE_STRING='tclole 0.3'
+PACKAGE_VERSION='0.4'
+PACKAGE_STRING='tclole 0.4'
PACKAGE_BUGREPORT=''
# Factoring default headers for most tests.
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures tclole 0.3 to adapt to many kinds of systems.
+\`configure' configures tclole 0.4 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of tclole 0.3:";;
+ short | recursive ) echo "Configuration of tclole 0.4:";;
esac
cat <<\_ACEOF
test -n "$ac_init_help" && exit 0
if $ac_init_version; then
cat <<\_ACEOF
-tclole configure 0.3
+tclole configure 0.4
generated by GNU Autoconf 2.59
Copyright (C) 2003 Free Software Foundation, Inc.
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by tclole $as_me 0.3, which was
+It was created by tclole $as_me 0.4, which was
generated by GNU Autoconf 2.59. Invocation command line was
$ $0 $@
} >&5
cat >&5 <<_CSEOF
-This file was extended by tclole $as_me 0.3, which was
+This file was extended by tclole $as_me 0.4, which was
generated by GNU Autoconf 2.59. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_version="\\
-tclole config.status 0.3
+tclole config.status 0.4
configured by $0, generated by GNU Autoconf 2.59,
with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
IDispatchVtbl *lpVtbl;
ISupportErrorInfoVtbl *lpVtbl2;
long refcount;
+ unsigned long maxid;
Tcl_Interp *interp;
Tcl_Obj *cmdObj;
+ Tcl_HashTable table;
} OleInterpCom;
static void OleInterpComDestroy(OleInterpCom *this);
UINT cNames, LCID lcid, DISPID *rgDispid)
{
OleInterpCom *this = (OleInterpCom *)This;
- Tcl_CmdInfo info;
HRESULT hr = E_POINTER;
if (rgDispid) {
+ int isnew = 0;
+ Tcl_HashEntry *entryPtr = NULL;
Tcl_DString ds;
Tcl_DStringInit(&ds);
Tcl_UniCharToUtfDString(rgszNames[0],
Tcl_UniCharLen(rgszNames[0]), &ds);
- if (!Tcl_GetCommandInfo(this->interp, Tcl_DStringValue(&ds), &info)) {
- return DISP_E_UNKNOWNNAME;
- }
- *rgDispid = info.isNativeObjectProc
- ? (DISPID)info.objProc : (DISPID)info.proc;
+ entryPtr = Tcl_CreateHashEntry(&this->table, Tcl_DStringValue(&ds), &isnew);
+ if (isnew) {
+ *rgDispid = this->maxid++;
+ Tcl_SetHashValue(entryPtr, *rgDispid);
+ } else {
+ *rgDispid = (DISPID)Tcl_GetHashValue(entryPtr);
+ }
Tcl_DStringFree(&ds);
hr = S_OK;
}
- return E_NOTIMPL;
+ return hr;
+}
+
+/*
+ * Evaluate some script in our interpreter without disrupting the current interpreter
+ * error state. Any error information is returned to the caller and the
+ * interp left as it was.
+ */
+
+static HRESULT
+EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, EXCEPINFO *eiPtr)
+{
+ HRESULT hr = S_OK;
+ Tcl_DString errorInfo, errorCode;
+ Tcl_SavedResult state;
+ int r = TCL_OK;
+
+ Tcl_DStringInit(&errorInfo);
+ Tcl_DStringInit(&errorCode);
+
+ /*
+ * Record the state of the interpreter
+ */
+
+ Tcl_SaveResult(interp, &state);
+ Tcl_DStringAppend(&errorInfo,
+ Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1);
+ Tcl_DStringAppend(&errorCode,
+ Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY), -1);
+
+ /*
+ * Evaluate the command and handle any error.
+ */
+
+ r = Tcl_EvalObjv(interp, objc, objv, TCL_EVAL_GLOBAL);
+ if (r == TCL_ERROR) {
+ if (eiPtr) {
+ Tcl_DString ds;
+ Tcl_Obj *resObj = Tcl_GetObjResult(interp);
+ Tcl_DStringInit(&ds);
+ Tcl_UtfToUniCharDString(Tcl_GetString(objv[0]), -1, &ds);
+ ZeroMemory(eiPtr, sizeof(EXCEPINFO));
+ eiPtr->bstrSource = SysAllocString((Tcl_UniChar *)Tcl_DStringValue(&ds));
+ eiPtr->bstrDescription = SysAllocString(Tcl_GetUnicode(resObj));
+ Tcl_DStringFree(&ds);
+ eiPtr->scode = E_FAIL;
+ hr = DISP_E_EXCEPTION;
+ } else {
+ hr = E_FAIL;
+ }
+ }
+
+ /*
+ * Restore the state of the interpreter
+ */
+
+ Tcl_SetVar(interp, "errorInfo",
+ Tcl_DStringValue(&errorInfo), TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "errorCode",
+ Tcl_DStringValue(&errorCode), TCL_GLOBAL_ONLY);
+ Tcl_RestoreResult(interp, &state);
+
+ /*
+ * Clean up references.
+ */
+
+ Tcl_DStringFree(&errorInfo);
+ Tcl_DStringFree(&errorCode);
+
+ return r;
}
static STDMETHODIMP
VARIANT *varPtr, EXCEPINFO *eiPtr, UINT *argerrPtr)
{
OleInterpCom *this = (OleInterpCom *)This;
+ Tcl_HashEntry *entryPtr = NULL;
HRESULT hr = S_OK;
Tcl_Obj **objv;
- unsigned int n;
- int objc;
+ unsigned int n, objc = 0;
if (memcmp(riid, &IID_NULL, sizeof(IID)) != 0) {
return E_FAIL;
if (dpPtr->cNamedArgs != 0) {
return E_FAIL;
}
- objc = dpPtr->cArgs;
- objv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * objc);
+
+ objv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * (dpPtr->cArgs + 2));
+ objv[objc] = this->cmdObj;
+ Tcl_IncrRefCount(objv[objc++]);
+ objv[objc] = Tcl_NewIntObj(dispidMember);
+ Tcl_IncrRefCount(objv[objc++]);
+
for (n = 0; SUCCEEDED(hr) && n < dpPtr->cArgs; ++n) {
- hr = OleVariantObj(this->interp, &dpPtr->rgvarg[objc-n-1], &objv[n]);
+ hr = OleVariantObj(this->interp, &dpPtr->rgvarg[dpPtr->cArgs - n - 1], &objv[objc]);
if (SUCCEEDED(hr)) {
- Tcl_IncrRefCount(objv[n]);
+ Tcl_IncrRefCount(objv[objc]);
}
+ ++objc;
}
- if (FAILED(hr)) {
- // cleanup the objv
- return E_INVALIDARG;
+ if (SUCCEEDED(hr)) {
+ hr = EvalObjv(this->interp, objc, objv, eiPtr);
}
- if (Ole_BackgroundEvalObjv(this->interp, objc, objv, TCL_EVAL_GLOBAL) != TCL_OK) {
- // handle errors.
+ for (n = 0; n < objc; ++n) {
+ Tcl_DecrRefCount(objv[n]);
}
- return S_OK;
+ return hr;
}
static STDMETHODIMP
static void
OleInterpComDestroy(OleInterpCom *this)
{
+ Tcl_DeleteHashTable(&this->table);
Tcl_DecrRefCount(this->cmdObj);
Tcl_Release(this->interp);
CoTaskMemFree(this);
comPtr->lpVtbl = &vtbl;
comPtr->lpVtbl2 = &vtbl2;
comPtr->refcount = 0;
+ comPtr->maxid = 1;
comPtr->interp = interp;
comPtr->cmdObj = Tcl_DuplicateObj(cmdObj);
Tcl_IncrRefCount(comPtr->cmdObj);
Tcl_Preserve(comPtr->interp);
+ Tcl_InitHashTable(&comPtr->table, TCL_STRING_KEYS);
hr = comPtr->lpVtbl->QueryInterface((IDispatch *)comPtr,
riid, unkPtrPtr);
if (FAILED(hr)) {
HRESULT hr;
DISPID dispid;
LPWSTR name;
+ int narg = 1, optindex = 0;
WORD mode = DISPATCH_PROPERTYGET | DISPATCH_METHOD;
+ enum {OLEINVOKE_GET, OLEINVOKE_PUT, OLEINVOKE_SET, OLEINVOKE_METHOD, OLEINVOKE_BREAK};
+ const char *optionNames[] = {
+ "-get", "-put", "-set", "-method", "--", NULL
+ };
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?arg ...?");
return TCL_ERROR;
}
- name = Tcl_GetUnicode(objv[1]);
+ for (narg = 1; narg < objc; ++narg) {
+ if (Tcl_GetIndexFromObj(interp, objv[narg], optionNames, "option", 0, &optindex) != TCL_OK) {
+ break;
+ }
+ if (optindex == OLEINVOKE_BREAK) {
+ ++narg;
+ break;
+ }
+ switch (optindex) {
+ case OLEINVOKE_GET: mode = DISPATCH_PROPERTYGET; break;
+ case OLEINVOKE_SET: mode = DISPATCH_PROPERTYPUTREF; break;
+ case OLEINVOKE_PUT: mode = DISPATCH_PROPERTYPUT; break;
+ case OLEINVOKE_METHOD: mode = DISPATCH_METHOD; break;
+ }
+ }
+
+ name = Tcl_GetUnicode(objv[narg]);
if (dataPtr->typeinfoPtr) {
hr = dataPtr->typeinfoPtr->lpVtbl->GetIDsOfNames(dataPtr->typeinfoPtr,
&name, 1, (MEMBERID *)&dispid);
ZeroMemory(&ei, sizeof(ei));
ZeroMemory(&v, sizeof(v));
VariantInit(&v);
- dp = OleDispParamsCreate(interp, objc-2, objv+2);
+ dp = OleDispParamsCreate(interp, objc-(narg+1), objv+(narg+1));
if ((mode & DISPATCH_PROPERTYPUT) || (mode & DISPATCH_PROPERTYPUTREF)) {
static DISPID putid = DISPID_PROPERTYPUT;
projects / tclole / commitdiff