Suppose we have a package called foo, the core files for that package are :
#include "tclDvmFoo.h"
EXTERN EXPORT(int,Tcldvmfoo_Init) _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void InitHashTable _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void CreateCommands _ANSI_ARGS_((Tcl_Interp *interp, Commands cmd[], int cmdsize));
static Commands cmd[] =
{
}
#ifdef __WIN32__
BOOL APIENTRY
DllEntryPoint(hInst, reason, reserved)
HINSTANCE hInst; /* Library instance handle. */
DWORD reason; /* Reason this function is being called. */
LPVOID reserved; /* Not used. */
{
return TRUE;
}
#endif
EXPORT(int,Tcldvmfoo_Init)(interp)
Tcl_Interp *interp;
{
if (Tcl_PkgRequire(interp, "DvmBar", "1.0", 1) == NULL) {
sprintf (interp->result, "Error loading tclDvmBar package");
return TCL_ERROR;
}
CreateCommands (interp, cmd, sizeof(cmd));
InitHashTable (interp);
return Tcl_PkgProvide(interp, "DvmFoo", "1.0");
}
We will leave the cmd[] array empty for the moment.
typedef struct Foo {
int x;
int y;
} Foo;
#define FooGetX(foo) foo->x
#define FooGetY(foo) foo->y
#define FooSetX(foo, v) foo->x = v
#define FooSetY(foo, v) foo->y = v
#define FOO_PREFIX "dvmFoo___"
or
#define FOO_PREFIX "dvmBarFoo"
#define GetFoo(s) (!strncmp(s, FOO_PREFIX, 9)?GetBuf(s):NULL)
#define RemoveFoo(s) RemoveBuf(s)
#define PutFoo(interp, buf) PutBuf(interp, FOO_PREFIX, buf)
Foo *
FooNew()
{
Foo *new = (Foo *)malloc(sizeof(Foo));
return new;
}
int
FooAdd(foo)
Foo *foo;
{
return foo->x + foo->y;
}
void
FooFree(foo)
Foo *foo;
{
free((char *)foo);
}
These should be pretty straight forward.
int
FooNewCmd (clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char *argv[];
{
Foo *foo;
ReturnErrorIf1 (argc != 1,
"wrong # args: should be %s", argv[0]);
foo = FooNew();
PutFoo(interp, foo);
return TCL_OK;
}
int
FooAddCmd (clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char *argv[];
{
Foo *foo;
int result;
ReturnErrorIf1 (argc != 2,
"wrong # args: should be %s foo", argv[0]);
foo = GetFoo(argv[1]);
ReturnErrorIf2 (foo == NULL,
"%s: no such foo %s", argv[0], argv[1]);
result = FooAdd(foo);
sprintf(interp->result, "%d", result);
return TCL_OK;
}
int
FooFreeCmd (clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char *argv[];
{
Foo *foo;
ReturnErrorIf1 (argc != 2,
"wrong # args: should be %s foo", argv[0]);
foo = RemoveFoo(argv[1]);
ReturnErrorIf2 (foo == NULL,
"%s: no such foo %s", argv[0], argv[1]);
FooFree(foo);
return TCL_OK;
}
ReturnErrorIfn is a convinient that checks the condition, and if true
print the error message into interp->result and return TCL_ERROR. It
can be used only in tcl hooks, and assume that the Tcl_Interp variable
is called interp.
After we create the new Foo, we add it to an internal hash table by calling PutFoo. We can later retrieve it (in FooAddCmd) by calling GetFoo. When we want to free the structure, we call RemoveFoo, which is the same as GetFoo, but also remove it from the hash table.
In dvmfoo.h
Foo *FooNew();
void FooFree(Foo *foo);
int FooAdd(Foo *foo);
In tclDvmFoo.h
int FooNewCmd _ANSI_ARGS_((ClientData cd, Tcl_Interp * interp, int argc, char *argv[]));
int FooAddCmd _ANSI_ARGS_((ClientData cd, Tcl_Interp * interp, int argc, char *argv[]));
int FooFreeCmd _ANSI_ARGS_((ClientData cd, Tcl_Interp * interp, int argc, char *argv[]));
static Commands cmd[] =
{
{ "foo_new", FooNewCmd, NULL, NULL, },
{ "foo_free", FooFreeCmd, NULL, NULL, },
{ "foo_add", FooAddCmd, NULL, NULL, },
}
Last Updated :