C++ object-style Tcl example extension

This piece of C++ code implements a simple Tcl extension. The API as seen from Tcl is:

example::create	Creates a new example object and returns the object handle
handle ping	Ping the object
handle destroy	Destroy the object

#include "tcl.h"

#include <iostream>

class MyObjectData {
    int id;
public:
    MyObjectData(int iid) : id(iid) {}
    void ping() { std::cout << "pong from " << id << std::endl; }
};

extern "C" int example_obj_command(ClientData     clientData, 
                                   Tcl_Interp*    interp,
                                   int            objc,
                                   Tcl_Obj* const objv[]) 
{
    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "method ?argument ...?");
        return TCL_ERROR;
    }
  
    static const char* methods[] = {"ping", "destroy", NULL};
    enum ExObjMethods {EXOBJ_PING, EXOBJ_DESTROY};

    int index = -1;

    if (Tcl_GetIndexFromObj(interp, objv[1], methods, "method", 0,
                            &index) != TCL_OK)
        return TCL_ERROR;

    MyObjectData* p = (MyObjectData*)clientData;

    switch((ExObjMethods)index) {
    case EXOBJ_PING:
        p->ping();
        break;
    case EXOBJ_DESTROY:
        Tcl_DeleteCommand(interp, Tcl_GetString(objv[0]));
        delete p;
        break;
    }
    
    return TCL_OK;
}

extern "C" int example_create(ClientData     clientData, 
                              Tcl_Interp*    interp,
                              int            objc,
                              Tcl_Obj* const objv[]) 
{
    static int obj_count = 0;

    MyObjectData* p = new MyObjectData(obj_count);
    
    char obj_name[13 + TCL_INTEGER_SPACE];
    sprintf(obj_name, "::exampleobj%d", obj_count++);
    
    Tcl_CreateObjCommand(interp, obj_name,
                         (Tcl_ObjCmdProc*)example_obj_command,
                         (ClientData) p, (Tcl_CmdDeleteProc *) NULL);

    Tcl_SetObjResult(interp, Tcl_NewStringObj(obj_name, strlen(obj_name)));
   
    return TCL_OK;
}

extern "C" DLLEXPORT int Example_Init(Tcl_Interp *interp)
{
    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
        return TCL_ERROR;
    }
    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
        return TCL_ERROR;
    }
    if (Tcl_PkgProvide(interp, "example", "0.1") != TCL_OK) {
        return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "example::create",
                         (Tcl_ObjCmdProc*)example_create,
                         (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);

    return TCL_OK;
}

Compile it with this Makefile (Linux only) after adjusting the TCLDIR:

TCLDIR = /activetcl/8.5.0.0
TCLINCDIR = $(TCLDIR)/include
TCLLIBDIR = $(TCLDIR)/lib
TCLLIB = $(TCLLIBDIR)/libtcl8.5.so

all: example.so

example.so : example.o
        g++ -shared -o example.so example.o $(TCLLIB)

example.o : example.c
        g++ -fPIC -I$(TCLINCDIR) example.c -c -o example.o

You can use a pkgIndex.tcl file with this line in it

package ifneeded example 0.1 [list load [file join $dir example.so]]

and

package require example

or simply

load example.so

to load the extension in an interpreter.

cjl adds : the inclusion of the call to Tcl_PkgProvide() within Example_Init() allows for the following to generate a valid pkgIndex.tcl for you:

pkg_mkIndex . *.so

RFox Note that NSCLSpecTcl and NSCLDAQ include a C++ library that encapsulates much of the Tcl API. In that model you create a new command by subclassing either CTCLProcessor (argc/argv) or CTCLObjectProcessor (objc, objv). The encapsulation is by no means complete, but it is a sufficient set to be useful for many people. If desired I could pull that out of those projects and turn it into a separate project/product and open it for additional work.

The same library is used in epicstcl which is known to work on Windows, OS-X and Linux so the code is probably reasonably portable.

C++ object-style Tcl example extension

See Also