From: Pat Thoyts Date: Tue, 2 Apr 2002 23:39:07 +0000 (+0000) Subject: Added support for multiple interpreters. X-Git-Tag: winsend-0-4 X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=74081d2c1d6b25a47c0877842f2c26866b5837d7;p=winsend Added support for multiple interpreters. Added the appname subcommand to report and set the registered name. Added in some debugging support functions. Wrote some more documentation as a .man format file (see tcllib) Added a second VB script demo. Incremented the version to 0.4 --- diff --git a/.cvsignore b/.cvsignore new file mode 100644 index 0000000..392bc9c --- /dev/null +++ b/.cvsignore @@ -0,0 +1,5 @@ +.cvsignore +Debug +Release +*.ilk +*.dll \ No newline at end of file diff --git a/Makefile b/Makefile index c9cace8..5d525a2 100644 --- a/Makefile +++ b/Makefile @@ -8,7 +8,10 @@ # # @(#)$Id$ -VER =03 +#TCLROOT ="c:/Program Files/Tcl" +TCLROOT =/opt/tcl + +VER =04 DBGX =d DBGFLAGS=-D_DEBUG @@ -16,8 +19,8 @@ CC =gcc -g DLLWRAP =dllwrap DLLTOOL =dlltool RM =rm -f -CFLAGS =-Wall -I/opt/tcl/include -DUSE_TCL_STUBS $(DBGFLAGS) -LDFLAGS =-L/opt/tcl/lib +CFLAGS =-Wall -I$(TCLROOT)/include -DUSE_TCL_STUBS $(DBGFLAGS) +LDFLAGS =-L$(TCLROOT)/lib LIBS =-ltclstub83${DBGX} -lole32 -loleaut32 -ladvapi32 -luuid DLL =winsend${VER}${DBGX}.dll @@ -25,7 +28,7 @@ DEFFILE =winsend.def WRAPFLAGS =--driver-name $(CC) --def $(DEFFILE) -CSRCS =winsend.c WinSendCom.c +CSRCS =winsend.c WinSendCom.c debug.c OBJS =$(CSRCS:.c=.o) $(DLL): $(OBJS) @@ -37,7 +40,9 @@ clean: %.o: %.c $(CC) $(CFLAGS) -c $< -o $@ +winsend.o: WinSendCom.h debug.h WinSendCom.o: WinSendCom.c WinSendCom.h +debug.o: debug.h .PHONY: clean diff --git a/Readme b/Readme index c1465a6..26828fe 100644 --- a/Readme +++ b/Readme @@ -47,11 +47,10 @@ WScript.Echo interp.Send("info tcl") You should see the message printed in your tkcon window and see your Tcl version printed in your DOS box. -The code needs tidying up a bit before I publish the source but this -shouldn't take long. In the meantime see +See http://tclsoap.sourceforge.net/winsend.html and - http://tclsoap.sourceforge.net/winsend03.zip + http://tclsoap.sourceforge.net/winsend.zip for the docs (this document) and code respectively. Pat Thoyts. diff --git a/WinSendCom.c b/WinSendCom.c index e0167e1..53f0bae 100644 --- a/WinSendCom.c +++ b/WinSendCom.c @@ -13,9 +13,10 @@ static const char rcsid[] = #include "WinSendCom.h" -/* ---------------------------------------------------------------------- */ -/* Non-public prototypes. -/* ---------------------------------------------------------------------- */ +/* ---------------------------------------------------------------------- + * Non-public prototypes. + * ---------------------------------------------------------------------- + */ static STDMETHODIMP WinSendCom_QueryInterface(IDispatch *This, REFIID riid, void **ppvObject); @@ -37,9 +38,10 @@ static STDMETHODIMP WinSendCom_Invoke(IDispatch *This, DISPID dispidMember, UINT *puArgErr); static HRESULT Send(WinSendCom* obj, VARIANT vCmd, VARIANT* pvResult); -/* ---------------------------------------------------------------------- */ -/* COM Class Helpers -/* ---------------------------------------------------------------------- */ +/* ---------------------------------------------------------------------- + * COM Class Helpers + * ---------------------------------------------------------------------- + */ /* Description: * Create and initialises a new instance of the WinSend COM class and diff --git a/WinSendCom.h b/WinSendCom.h index efefb8e..d8a4efb 100644 --- a/WinSendCom.h +++ b/WinSendCom.h @@ -18,7 +18,7 @@ typedef struct WinSendCom_t { } WinSendCom; /* - * WinSendCom public methods + * WinSendCom public functions */ HRESULT WinSendCom_CreateInstance(Tcl_Interp *interp, REFIID riid, void **ppv); void WinSendCom_Destroy(LPDISPATCH pdisp); diff --git a/debug.c b/debug.c new file mode 100644 index 0000000..fb64b78 --- /dev/null +++ b/debug.c @@ -0,0 +1,17 @@ +#include "debug.h" +#include + +void +LocalTrace(LPCTSTR format, ...) +{ + int n; + const int max = sizeof(TCHAR) * 512; + TCHAR buffer[512]; + va_list args; + va_start (args, format); + + n = _vsntprintf(buffer, max, format, args); + _ASSERTE(n < max); + OutputDebugString(buffer); + va_end(args); +} diff --git a/debug.h b/debug.h new file mode 100644 index 0000000..0d868ad --- /dev/null +++ b/debug.h @@ -0,0 +1,30 @@ +/* debug.h - Copyright (C) 2002 Pat Thoyts + * + * $Id$ + */ + +#ifndef _Debug_h_INCLUDE +#define _Debug_h_INCLUDE + +#include +#include +#include +#include + +/* Debug related stuff */ +#ifndef _DEBUG + +#define _ASSERTE(x) ((void)0) +#define LTRACE 1 ? ((void)0) : LocalTrace + +#else /* _DEBUG */ + +#define _ASSERTE(x) if (!(x)) _assert(#x, __FILE__, __LINE__) +#define LTRACE LocalTrace + +#endif /* _DEBUG */ + +/* Debug functions. */ +void LocalTrace(LPCTSTR szFormat, ...); + +#endif /* _Debug_h_INCLUDE */ \ No newline at end of file diff --git a/pkgIndex.tcl b/pkgIndex.tcl index 9efa827..ef069c1 100644 --- a/pkgIndex.tcl +++ b/pkgIndex.tcl @@ -9,8 +9,8 @@ # full path name of this file's directory. if {[info exists ::tcl_platform(debug)] && $::tcl_platform(debug)} { - package ifneeded winsend 0.3 [list load [file join $dir winsend03d.dll]] + package ifneeded winsend 0.4 [list load [file join $dir winsend04d.dll]] } else { - package ifneeded winsend 0.3 [list load [file join $dir winsend03.dll]] + package ifneeded winsend 0.4 [list load [file join $dir winsend04.dll]] } diff --git a/test.vbs b/test.vbs index 51ac78d..f602394 100644 --- a/test.vbs +++ b/test.vbs @@ -1,10 +1,3 @@ Dim o -Set o = GetObject("\\.\TclInterp\tkcon.tcl") -WScript.Echo o.Send("puts {Hello, from VB} ; tkcon master wm title .") - -Dim p -Set p = GetObject("\\.\TclInterp\tkcon.tcl #2") -WScript.Echo p.Send("puts {Hello, 2}; tkcon master wm title .") - - - +Set o = GetObject("\\.\TclInterp\tkchat") +WScript.Echo o.Send("puts {Hello, from VB} ; info tcl") diff --git a/test2.vbs b/test2.vbs new file mode 100644 index 0000000..614b8f3 --- /dev/null +++ b/test2.vbs @@ -0,0 +1,21 @@ +' test2.vbs - Copyright (C) 2002 Pat Thoyts +' +' Demo accessing Tcl using the winsend package from the Visual Basic +' Scripting engine via the Windown Scripting Host (WSH). +' +' Run this using 'cscript test2.vbs' or 'wscript test2.vbs' when you +' have a wish session using the winsend appname wish. +' +' $Id$ + +Dim o +Set o = GetObject("\\.\TclInterp\wish") + +cmd = "package require Tk" +cmd = cmd & vbNewline & "toplevel .t" +cmd = cmd & vbNewline & "button .t.b -text OK -command {destroy .t}" +cmd = cmd & vbNewline & "pack .t.b -side top -fill both" +cmd = cmd & vbNewline & "tkwait window .t" +cmd = cmd & vbNewline & "info tcl" + +WScript.Echo o.Send(cmd) diff --git a/winsend.c b/winsend.c index ba58467..8c6aa24 100644 --- a/winsend.c +++ b/winsend.c @@ -19,6 +19,7 @@ static const char rcsid[] = #include #include "WinSendCom.h" +#include "debug.h" #ifndef DECLSPEC_EXPORT #define DECLSPEC_EXPORT __declspec(dllexport) @@ -26,23 +27,36 @@ static const char rcsid[] = /* Should be defined in WTypes.h but mingw 1.0 is missing them */ #ifndef _ROTFLAGS_DEFINED +#define _ROTFLAGS_DEFINED #define ROTFLAGS_REGISTRATIONKEEPSALIVE 0x01 #define ROTFLAGS_ALLOWANYCLIENT 0x02 #endif /* ! _ROTFLAGS_DEFINED */ -#define WINSEND_PACKAGE_VERSION "0.3" +#define WINSEND_PACKAGE_VERSION "0.4" #define WINSEND_PACKAGE_NAME "winsend" #define WINSEND_CLASS_NAME "TclEval" -DWORD g_dwROTCookie; - -static void Winsend_PkgDeleteProc _ANSI_ARGS_((ClientData clientData)); +/* Package information structure. + * This is used to keep interpreter specific details for use when releasing + * the package resources upon interpreter deletion or package removal. + */ +typedef struct WinsendPkg_t { + Tcl_Obj *appname; /* the registered application name */ + DWORD ROT_cookie; /* ROT cookie returned on registration */ + LPUNKNOWN obj; /* Interface for the registration object */ + Tcl_Command token; /* Winsend command token */ +} WinsendPkg; + +static void Winsend_InterpDeleteProc (ClientData clientData, Tcl_Interp *interp); +static void Winsend_PkgDeleteProc (ClientData clientData); static int Winsend_CmdProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int Winsend_CmdInterps(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int Winsend_CmdSend(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +static int Winsend_CmdAppname(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); static int Winsend_CmdTest(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int Winsend_ObjSendCmd(LPDISPATCH pdispInterp, Tcl_Interp *interp, @@ -50,9 +64,10 @@ static int Winsend_ObjSendCmd(LPDISPATCH pdispInterp, Tcl_Interp *interp, static HRESULT BuildMoniker(LPCOLESTR name, LPMONIKER *pmk); static Tcl_Obj* Winsend_Win32ErrorObj(HRESULT hrError); -// ------------------------------------------------------------------------- -// DllMain -// ------------------------------------------------------------------------- +/* ------------------------------------------------------------------------- + * DllMain + * ------------------------------------------------------------------------- + */ EXTERN_C BOOL APIENTRY DllMain(HANDLE hModule, DWORD dwReason, LPVOID lpReserved) @@ -68,30 +83,38 @@ DllMain(HANDLE hModule, DWORD dwReason, LPVOID lpReserved) return TRUE; } -// ------------------------------------------------------------------------- -// Winsend_Init -// ------------------------------------------------------------------------- +/* ------------------------------------------------------------------------- + * Winsend_Init + * ------------------------------------------------------------------------- + */ EXTERN_C int DECLSPEC_EXPORT Winsend_Init(Tcl_Interp* interp) { HRESULT hr = S_OK; int r = TCL_OK; - IUnknown *pUnk = NULL; + WinsendPkg *pkg = NULL; #ifdef USE_TCL_STUBS Tcl_InitStubs(interp, "8.3", 0); #endif - // Initialize COM + pkg = (WinsendPkg*)Tcl_Alloc(sizeof(WinsendPkg)); + if (pkg == NULL) { + Tcl_SetResult(interp, "out of memory", TCL_STATIC); + return TCL_ERROR; + } + memset(pkg, 0, sizeof(WinsendPkg)); + + /* Initialize COM */ hr = CoInitialize(0); if (FAILED(hr)) { Tcl_SetResult(interp, "failed to initialize the " WINSEND_PACKAGE_NAME " package", TCL_STATIC); return TCL_ERROR; } - // Create our registration object. - hr = WinSendCom_CreateInstance(interp, &IID_IUnknown, (void**)&pUnk); + /* Create our registration object. */ + hr = WinSendCom_CreateInstance(interp, &IID_IUnknown, (void**)&pkg->obj); if (SUCCEEDED(hr)) { @@ -123,9 +146,14 @@ Winsend_Init(Tcl_Interp* interp) if (SUCCEEDED(hr)) { hr = pROT->lpVtbl->Register(pROT, - ROTFLAGS_REGISTRATIONKEEPSALIVE - | ROTFLAGS_ALLOWANYCLIENT, - pUnk, pmk, &g_dwROTCookie); + ROTFLAGS_REGISTRATIONKEEPSALIVE, + pkg->obj, + pmk, + &pkg->ROT_cookie); + if (SUCCEEDED(hr)) { + pkg->appname = Tcl_NewUnicodeObj(oleName, -1); + Tcl_IncrRefCount(pkg->appname); + } pmk->lpVtbl->Release(pmk); } @@ -133,32 +161,33 @@ Winsend_Init(Tcl_Interp* interp) * try again. */ if (hr == MK_S_MONIKERALREADYREGISTERED) - pROT->lpVtbl->Revoke(pROT, g_dwROTCookie); + pROT->lpVtbl->Revoke(pROT, pkg->ROT_cookie); } while (hr == MK_S_MONIKERALREADYREGISTERED); pROT->lpVtbl->Release(pROT); } - pUnk->lpVtbl->Release(pUnk); - - // Create our winsend command + /* Create our winsend command */ if (SUCCEEDED(hr)) { - Tcl_CreateObjCommand(interp, "winsend", Winsend_CmdProc, (ClientData)0, (Tcl_CmdDeleteProc*)0); + pkg->token = Tcl_CreateObjCommand(interp, + "winsend", + Winsend_CmdProc, + (ClientData)pkg, + (Tcl_CmdDeleteProc*)NULL); } /* Create an exit procedure to handle unregistering when the * Tcl interpreter terminates. */ - Tcl_CreateExitHandler(Winsend_PkgDeleteProc, NULL); + Tcl_CallWhenDeleted(interp, Winsend_InterpDeleteProc, (ClientData)pkg); + Tcl_CreateExitHandler(Winsend_PkgDeleteProc, (ClientData)pkg); r = Tcl_PkgProvide(interp, WINSEND_PACKAGE_NAME, WINSEND_PACKAGE_VERSION); } if (FAILED(hr)) { - // TODO: better error handling - rip code from w32_exception.h - Tcl_Obj *err = Winsend_Win32ErrorObj(hr); - Tcl_SetObjResult(interp, err); + Tcl_SetObjResult(interp, Winsend_Win32ErrorObj(hr)); r = TCL_ERROR; } else { Tcl_SetResult(interp, "", TCL_STATIC); @@ -167,9 +196,9 @@ Winsend_Init(Tcl_Interp* interp) return r; } -// ------------------------------------------------------------------------- -// Winsend_SafeInit -// ------------------------------------------------------------------------- +/* ------------------------------------------------------------------------- + * Winsend_SafeInit + * ------------------------------------------------------------------------- */ EXTERN_C int DECLSPEC_EXPORT Winsend_SafeInit(Tcl_Interp* interp) @@ -178,33 +207,100 @@ Winsend_SafeInit(Tcl_Interp* interp) return TCL_ERROR; } -// ------------------------------------------------------------------------- -// WinsendExitProc -// ------------------------------------------------------------------------- +/* ------------------------------------------------------------------------- + * Winsend_InterpDeleteProc + * ------------------------------------------------------------------------- + * Description: + * Called when the interpreter is deleted, this procedure clean up the COM + * registration for us. We need to revoke our registered object, and release + * our own object reference. The WinSendCom object should delete itself now. + */ -static void -Winsend_PkgDeleteProc(ClientData clientData) +static void +Winsend_InterpDeleteProc (ClientData clientData, Tcl_Interp *interp) { + WinsendPkg *pkg = (WinsendPkg*)clientData; LPRUNNINGOBJECTTABLE pROT = NULL; - HRESULT hr = GetRunningObjectTable(0, &pROT); - if (SUCCEEDED(hr)) - { - hr = pROT->lpVtbl->Revoke(pROT, g_dwROTCookie); - pROT->lpVtbl->Release(pROT); + HRESULT hr = S_OK; + + LTRACE(_T("Winsend_InterpDeleteProc( {ROT_cookie: 0x%08X, obj: 0x%08X})\n"), + pkg->ROT_cookie, pkg->obj); + + /* Lock the package structure in memory */ + Tcl_Preserve((ClientData)pkg); + + if (pkg->ROT_cookie != 0) { + hr = GetRunningObjectTable(0, &pROT); + if (SUCCEEDED(hr)) + { + hr = pROT->lpVtbl->Revoke(pROT, pkg->ROT_cookie); + pROT->lpVtbl->Release(pROT); + pkg->ROT_cookie = 0; + } + _ASSERTE(SUCCEEDED(hr)); } - //ASSERT + + /* Remove the winsend command and release the interp pointer */ + /* I get assertions from this from within tcl 8.3 - it's not + * really needed anyway + */ + /* if (interp != NULL) { + Tcl_DeleteCommandFromToken(interp, pkg->token); + pkg->token = 0; + }*/ + + /* release the appname object */ + if (pkg->appname != NULL) { + Tcl_DecrRefCount(pkg->appname); + pkg->appname = NULL; + } + + /* Release the registration object */ + pkg->obj->lpVtbl->Release(pkg->obj); + pkg->obj = NULL; + + /* unlock the package data structure. */ + Tcl_Release((ClientData)pkg); } -// ------------------------------------------------------------------------- -// Winsend_CmdProc -// ------------------------------------------------------------------------- +/* ------------------------------------------------------------------------- + * Winsend_PkgDeleteProc + * ------------------------------------------------------------------------- + * Description: + * Called when the package is removed, we clean up any outstanding memory + * and release any handles. + */ +static void +Winsend_PkgDeleteProc(ClientData clientData) +{ + WinsendPkg *pkg = (WinsendPkg*)clientData; + LTRACE(_T("Winsend_PkgDeleteProc( {ROT_cookie: 0x%08X, obj: 0x%08X})\n"), + pkg->ROT_cookie, pkg->obj); + + if (pkg->obj != NULL) { + Winsend_InterpDeleteProc(clientData, NULL); + } + + _ASSERTE(pkg->obj == NULL); + Tcl_Free((char*)pkg); + + CoUninitialize(); +} + +/* ------------------------------------------------------------------------- + * Winsend_CmdProc + * ------------------------------------------------------------------------- + * Description: + * The Tcl winsend proc is first processed here and then passed on depending + * upong the command argument. + */ static int Winsend_CmdProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - enum {WINSEND_INTERPS, WINSEND_SEND, WINSEND_TEST}; - static char* cmds[] = { "interps", "send", "test", NULL }; + enum {WINSEND_INTERPS, WINSEND_SEND, WINSEND_APPNAME, WINSEND_TEST}; + static char* cmds[] = { "interps", "send", "appname", "test", NULL }; int index = 0, r = TCL_OK; if (objc < 2) { @@ -223,6 +319,9 @@ Winsend_CmdProc(ClientData clientData, Tcl_Interp *interp, case WINSEND_SEND: r = Winsend_CmdSend(clientData, interp, objc, objv); break; + case WINSEND_APPNAME: + r = Winsend_CmdAppname(clientData, interp, objc, objv); + break; case WINSEND_TEST: r = Winsend_CmdTest(clientData, interp, objc, objv); break; @@ -231,10 +330,14 @@ Winsend_CmdProc(ClientData clientData, Tcl_Interp *interp, return r; } -// ------------------------------------------------------------------------- -// Winsend_CmdInterps -// ------------------------------------------------------------------------- - +/* ------------------------------------------------------------------------- + * Winsend_CmdInterps + * ------------------------------------------------------------------------- + * Description: + * Iterate over the running object table and identify all the Tcl registered + * objects. We build a list using the tail part of the file moniker and return + * this as the list of registered interpreters. + */ static int Winsend_CmdInterps(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) @@ -274,8 +377,9 @@ Winsend_CmdInterps(ClientData clientData, Tcl_Interp *interp, if (wcsncmp(olestr, oleszStub, wcslen(oleszStub)) == 0) { - LPOLESTR p = olestr + wcslen(oleszStub) + 1; - r = Tcl_ListObjAppendElement(interp, objList, Tcl_NewUnicodeObj(p, -1)); + LPOLESTR p = olestr + wcslen(oleszStub); + if (*p) + r = Tcl_ListObjAppendElement(interp, objList, Tcl_NewUnicodeObj(p + 1, -1)); } hr = CoGetMalloc(1, &pMalloc); @@ -310,10 +414,10 @@ Winsend_CmdInterps(ClientData clientData, Tcl_Interp *interp, return r; } -// ------------------------------------------------------------------------- -// Winsend_CmdSend -// ------------------------------------------------------------------------- - +/* ------------------------------------------------------------------------- + * Winsend_CmdSend + * ------------------------------------------------------------------------- + */ static int Winsend_CmdSend(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) @@ -345,7 +449,6 @@ Winsend_CmdSend(ClientData clientData, Tcl_Interp *interp, IDispatch* pdispInterp = NULL; hr = pROT->lpVtbl->IsRunning(pROT, pmk); hr = pmk->lpVtbl->BindToObject(pmk, pBindCtx, NULL, &IID_IUnknown, (void**)&punkInterp); - //hr = pROT->lpVtbl->GetObject(pROT, pmk, &punkInterp); if (SUCCEEDED(hr)) hr = punkInterp->lpVtbl->QueryInterface(punkInterp, &IID_IDispatch, (void**)&pdispInterp); if (SUCCEEDED(hr)) @@ -370,6 +473,80 @@ Winsend_CmdSend(ClientData clientData, Tcl_Interp *interp, return r; } +/* ------------------------------------------------------------------------- + * Winsend_CmdAppname + * ------------------------------------------------------------------------- + * Description: + * If called with no additional parameters returns the registered application + * name. If a new name is given then we attempt to register the new app name + * If the name is already registered then we cancel the new registration and + * continue using the old appname. + */ +static int +Winsend_CmdAppname(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]) +{ + int r = TCL_OK; + HRESULT hr = S_OK; + WinsendPkg* pkg = (WinsendPkg*)clientData; + + if (objc == 2) { + + Tcl_SetObjResult(interp, Tcl_DuplicateObj(pkg->appname)); + + } else if (objc > 3) { + + Tcl_WrongNumArgs(interp, 2, objv, "?appname?"); + r = TCL_ERROR; + + } else { + + LPRUNNINGOBJECTTABLE pROT = NULL; + hr = GetRunningObjectTable(0, &pROT); + if (SUCCEEDED(hr)) { + LPMONIKER pmk; + LPOLESTR szNewName; + + szNewName = Tcl_GetUnicode(objv[2]); + + /* construct a new moniker */ + hr = BuildMoniker(szNewName, &pmk); + if (SUCCEEDED(hr)) { + DWORD cookie = 0; + + /* register the new name */ + hr = pROT->lpVtbl->Register(pROT, ROTFLAGS_REGISTRATIONKEEPSALIVE, pkg->obj, pmk, &cookie); + if (SUCCEEDED(hr)) { + if (hr == MK_S_MONIKERALREADYREGISTERED) { + pROT->lpVtbl->Revoke(pROT, cookie); + Tcl_SetObjResult(interp, Winsend_Win32ErrorObj(hr)); + r = TCL_ERROR; + } else { + + /* revoke the old name */ + hr = pROT->lpVtbl->Revoke(pROT, pkg->ROT_cookie); + if (SUCCEEDED(hr)) { + + /* update the package structure */ + pkg->ROT_cookie = cookie; + Tcl_SetUnicodeObj(pkg->appname, szNewName, -1); + Tcl_SetObjResult(interp, pkg->appname); + } + } + } + pmk->lpVtbl->Release(pmk); + } + pROT->lpVtbl->Release(pROT); + } + if (FAILED(hr)) + { + Tcl_SetObjResult(interp, Winsend_Win32ErrorObj(hr)); + r = TCL_ERROR; + } + } + return r; +} + /* ------------------------------------------------------------------------- * Winsend_CmdTest * ------------------------------------------------------------------------- @@ -404,15 +581,19 @@ Winsend_CmdTest(ClientData clientData, Tcl_Interp *interp, return r; } -// ------------------------------------------------------------------------- -// Helpers. -// ------------------------------------------------------------------------- +/* ------------------------------------------------------------------------- + * Helpers. + * ------------------------------------------------------------------------- + */ -// ------------------------------------------------------------------------- -// Winsend_ObjSendCmd -// ------------------------------------------------------------------------- -// Description: -// +/* ------------------------------------------------------------------------- + * Winsend_ObjSendCmd + * ------------------------------------------------------------------------- + * Description: + * Perform an interface call to the server object. We convert the Tcl arguments + * into a BSTR using 'concat'. The result should be a BSTR that we can set as the + * interp's result string. + */ static int Winsend_ObjSendCmd(LPDISPATCH pdispInterp, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) @@ -450,7 +631,13 @@ Winsend_ObjSendCmd(LPDISPATCH pdispInterp, Tcl_Interp *interp, return (SUCCEEDED(hr) ? TCL_OK : TCL_ERROR); } -// Construct a Tcl interpreter moniker from an interp name. +/* ------------------------------------------------------------------------- + * BuildMoniker + * ------------------------------------------------------------------------- + * Description: + * Construct a moniker from the given name. This ensures that all our + * monikers have the same prefix. + */ static HRESULT BuildMoniker(LPCOLESTR name, LPMONIKER *pmk) { @@ -475,6 +662,12 @@ BuildMoniker(LPCOLESTR name, LPMONIKER *pmk) return hr; } +/* ------------------------------------------------------------------------- + * Winsend_Win32ErrorObj + * ------------------------------------------------------------------------- + * Description: + * Convert COM or Win32 API errors into Tcl strings. + */ static Tcl_Obj* Winsend_Win32ErrorObj(HRESULT hrError) { diff --git a/winsend.dsp b/winsend.dsp index 36bb995..9d143a8 100644 --- a/winsend.dsp +++ b/winsend.dsp @@ -53,7 +53,7 @@ BSC32=bscmake.exe # ADD BSC32 /nologo LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386 -# ADD LINK32 tclstub83.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386 /out:"winsend03.dll" +# ADD LINK32 tclstub83.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386 /out:"winsend04.dll" !ELSEIF "$(CFG)" == "winsend - Win32 Debug" @@ -68,8 +68,8 @@ LINK32=link.exe # PROP Intermediate_Dir "Debug" # PROP Ignore_Export_Lib 0 # PROP Target_Dir "" -# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "WINSEND_EXPORTS" /YX /FD /GZ /c -# ADD CPP /nologo /MTd /W3 /Gm /GX /ZI /Od /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "WINSEND_EXPORTS" /D "USE_TCL_STUBS" /YX /FD /GZ /c +# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "WINSEND_EXPORTS" /YX /FD /GZ /c +# ADD CPP /nologo /MTd /W3 /Gm /GX /ZI /Od /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "WINSEND_EXPORTS" /D "USE_TCL_STUBS" /YX /FD /GZ /c # ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32 # ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32 # ADD BASE RSC /l 0x809 /d "_DEBUG" @@ -79,7 +79,7 @@ BSC32=bscmake.exe # ADD BSC32 /nologo LINK32=link.exe # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept -# ADD LINK32 tclstub83d.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /out:"winsend03d.dll" /pdbtype:sept +# ADD LINK32 tclstub83d.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /out:"winsend04d.dll" /pdbtype:sept !ENDIF @@ -92,6 +92,10 @@ LINK32=link.exe # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat" # Begin Source File +SOURCE=.\debug.c +# End Source File +# Begin Source File + SOURCE=.\winsend.c # End Source File # Begin Source File @@ -108,6 +112,10 @@ SOURCE=.\WinSendCom.c # PROP Default_Filter "h;hpp;hxx;hm;inl" # Begin Source File +SOURCE=.\debug.h +# End Source File +# Begin Source File + SOURCE=.\WinSendCom.h # End Source File # End Group diff --git a/winsend.html b/winsend.html index e5376fe..0e229d9 100644 --- a/winsend.html +++ b/winsend.html @@ -58,8 +58,8 @@ WScript.Echo interp.Send("info tcl") Tcl version printed in your DOS box.

The package containing binaries and source is available from - -http://tclsoap.sf.net/winsend03.zip

+ +http://tclsoap.sf.net/winsend.zip

Pat Thoyts.

diff --git a/winsend.man b/winsend.man new file mode 100644 index 0000000..09b485e --- /dev/null +++ b/winsend.man @@ -0,0 +1,56 @@ +[manpage_begin winsend n 0.4] +[moddesc {winsend}] +[titledesc {Windows send Command}] +[require Tcl 8.3] +[require winsend [opt 0.4]] +[description] +[para] + +The [cmd winsend] package is an attempt to provide the complete +functionality of the Tk [cmd send] command using the Microsoft Windows +platform. The two key points are inter-process communications between +one interpreter and another, and automatic registration of +interpreters with a central source. With the Tk send command this is +done via the X Windows server. The [cmd winfo interps] command returns +a list of registered interpreters and the [cmd send] command allows +you to execute Tcl commands in the named interpreter. + +[section COMMANDS] + +[list_begin definitions] + +[call [cmd winsend] [arg command] [opt [arg "arguments ..."]]] + +[list_begin definitions] +[lst_item "[cmd interps]"] + Get the list of registered interpreter names for use with send. +[lst_item "[cmd appname] [opt [arg name]]"] + When called with no arguments this returns the registered name of +this interpreter. If a single argument is given, this is used to +re-register the application using the new name. If the registration +fails for some reason, such as the name is already in use, then an +error is returned and the old appname remains in use. +[lst_item "[cmd send]"] + send +[list_end] + +[list_end] + +[section EXAMPLES] + +[para] +[example { +% package require winsend +0.4 +% winsend appname MyApp +MyApp +% winsend send MyApp info tcl +8.3 +}] + +[see_also send(n)] +[section AUTHORS] +Pat Thoyts + +[keywords send appname] +[manpage_end]