Posted to tcl by colin at Wed May 23 06:02:01 GMT 2012view pretty

# InitScript - interface to TclSetPreInitScript
package provide InitScript 1.0

if {[info commands ::InitScript] ne ""} {
    return
}

package require critcl
::critcl::tsources InitScript.tcl

critcl::ccode {
    #include <stdlib.h>
    #include <tcl.h>
    #include <errno.h>
    #include <stdio.h>
}

critcl::cproc ::InitScript {Tcl_Interp* interp Tcl_Obj* script} ok {
    static char *initscript = NULL;
    int len;
    char *strptr;

    strptr = Tcl_GetStringFromObj(script, &len);
    if (initscript != NULL) {
	free((void*)initscript);
    }
    initscript = calloc(len+1,1);
    if (initscript == NULL) {
	return TCL_ERROR;
    }
    memcpy(initscript, strptr, len);
    strptr = TclSetPreInitScript(initscript);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(strptr,-1));
    return TCL_OK;
}