Extensibility in Tcl
by John Ousterhout

Listing One
set a 43
set b $a
set c [expr $a+10]
puts "The value of c is $c"
puts {Lunch costs $6.95}


Listing Two
foreach i {2 4 6 8 10} {
    puts "$i squared is [expr $i*$i]"
}

Listing Three 
#include <tcl.h>
int Add1Cmd(ClientData dummy, Tcl_Interp *interp, int objc,
        Tcl_Obj *objv[]) {
    int i;
    if (objc != 2) {
        Tcl_SetResult(interp, "wrong number of arguments",TCL_STATIC);
        return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(i+1));
    return TCL_OK;
}

Listing Four 
set factorial 1
loop i 1 7 {
    set factorial [expr $factorial*$i]
}
puts "7 factorial is $factorial"


Listing Five 
#include <tcl.h>
int LoopCmd(ClientData dummy, Tcl_Interp *interp, int objc,
        Tcl_Obj *objv[]) {
    int current, last, code;
    Tcl_Obj *valuePtr;

    if (objc != 5) {
        Tcl_SetResult(interp, "wrong number of arguments",TCL_STATIC);
        return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[2], &current) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[3], &last) != TCL_OK) {
        return TCL_ERROR;
    }
    for ( ; current <= last; current++) {
        valuePtr = Tcl_NewIntObj(current);
        if (Tcl_ObjSetVar2(interp, objv[1], (Tcl_Obj *) NULL,
                valuePtr, TCL_LEAVE_ERR_MSG) == NULL) {
            Tcl_DecrRefCount(valuePtr);
            return TCL_ERROR;
        }
        code = Tcl_EvalObj(interp, objv[4]);
        if (code != TCL_OK) {
            return code;
        }
    }
    return TCL_OK;
}



2