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; }