Building a custom tclsh

This is the complete source for your own tclsh to start from (generated by the little script in Extending Tcl in C from Tcl):


 #include <tcl.h>
 int AppInit(Tcl_Interp *interp) {
        if(Tcl_Init(interp) == TCL_ERROR) return TCL_ERROR; 
        Tcl_SetVar(interp,"tcl_rcFileName","~/.wishrc",TCL_GLOBAL_ONLY);
        return TCL_OK;
 }
 int main(int argc, char *argv[]) {
        Tcl_Main(argc, argv, AppInit);
        return 0; 
 }

A wish is only slightly more complex, but this contains already an extension - the try command which just prints a string and an int from its arguments:


 #include <tk.h>
 int trycmd(ClientData cd, Tcl_Interp *interp,
            int objc, Tcl_Obj *CONST objv[]) {
            Tcl_Obj *optr;
    char* s; int i; 
    if(objc!=3) {
           Tcl_WrongNumArgs(interp,1,objv,"Usage: try s i");
           return TCL_ERROR;
    }
    if(!(s=Tcl_GetStringFromObj(objv[1],NULL)))
            return TCL_ERROR;
    if(Tcl_GetIntFromObj(interp,objv[2],&i)!=TCL_OK)
            return TCL_ERROR;

    {printf("%c %d\n",*s,*s);}
         optr = Tcl_GetObjResult(interp);
         Tcl_SetIntObj(optr, i);
         return TCL_OK;
    }

 int AppInit(Tcl_Interp *interp) {
        if(Tcl_Init(interp) == TCL_ERROR) return TCL_ERROR;
        if(Tk_Init(interp) == TCL_ERROR) return TCL_ERROR;
        Tcl_CreateObjCommand(interp,"try",trycmd,
            (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
        Tcl_SetVar(interp,"tcl_rcFileName","~/.wishrc",
             TCL_GLOBAL_ONLY);
        return TCL_OK;
 }
 int main(int argc, char *argv[]) {
        Tk_Main(argc, argv, AppInit);
        return 0;
 }

Larry Virden wrote in comp.lang.tcl:

The flow of app development, at least in C or C++, is approximately:

 Conceive
 Create skeleton within source management environment (project, whatever)
 Loop until no compile errors
   Code
   Write Makefile/shell file/enter compilation info into gui
   Compile
 End loop
 Loop until no link errors
   Write Makefile/shell file/enter link info into gui
   Link
 End loop
 Loop until sun burns out
   Run
   Debug/Tweak/Rewrite/Modify
 End loop

For compilation, the makefile generally has something like this:

 file.o: file.h otherfile.h file.c
        $(CC) -c file.c $(INCLUDES) $(CFLAGS)

This creates a file.o file whenever file.h, otherfile.h, or file.c changes. The file.o file is not an executable; it is an "object file"; a semi-compiled edition of the code, readied for merging with other libraries and pieces of executable.

For linking, the makefile generally has something like this:

 LIBS = -ltcl
 file: file.o otherfile.o
        $(CC) $(LDFLAGS) file.o otherfile.o $(LIBS) -o file

Advice: The ordering of the .o files, and the LIBS, are often quite sensitive. If you get messages about 'unresolved references', either during the link step or at the time of execution, then this means that the values used are incomplete or inaccurate. For a custom tcl shell, you'd have at least -ltcl in LIBS.

DKF: When linking, it's best to put all the .o (or .obj) files first, and then put libraries after that, either by putting them directly (only suitable for .a/.lib files) or through the -l option. The order of libraries is important (at least with Unix linkers) because symbols missing from later libraries are not satisfied by earlier ones. Getting the library order right can be a distinctly black art at times!


More from Larry Virden on linking....

The link step is the step where the program is building your executable. The concept is that each .o object module is loaded in order into a final file. A table of unresolved function references (calls to functions not found in the object file) is created. As these files are encountered, the linker may also encounter -L flags. These flags indicate directory names which contain various 'libraries' of general functions. These files tend to have names with patterns like lib*.a or lib*.so . The .a files are archive libraries containing static object files. Each of these .o files are physically read and searched to see if they contain functions with a name that matches an entry in the unresolved function reference table, the entire .o file is also loaded into the final file. The .so files are shared libraries. They are also searched for matches to unresolved references. In this case however, a special alias name for the shared library is loaded into the image, used to tell the OS at run time that it should search its known path (often called the LD_RUN_PATH or LD_LIB_PATH) for the library name. At run time the loading of the object modules is into memory, not into disk.

One problem that can often be encountered is that the shared library is installed into a directory other than the default or standard locations for shared libraries. In that case, one is faced with two choices. One can force each user to modify appropriate environment variables in a way that the right library is found in the right directory at the right time (this can be tricky if different apps require different shared libraries which share the same name) or when running the linker, one can provide -R flags which embed additional directories to search directly into the executable. The downside of this approach is that it is yet another tie of a binary to a fixed directory naming structure.


Can someone address the following issue in the text above?

 From: Joe English
 Newsgroups: comp.lang.tcl
 Subject: Re: regsub & german umlauts
 Date: 25 Mar 2001 19:23:08 GMT
 Organization: Advanced Rotorcraft Technology
 Message-ID: <[email protected]>
 References: <[email protected]>

 Thomas Ziegler wrote:
 >It seems, that calling tcl from C has problems with german
 >umlauts. [...]
 >
 >However, if I call the script above from a short C-programm like
 >
 >#include <stdio.h>
 >#include <tcl.h>
 >main()
 >{
 >   Tcl_Interp *interp = Tcl_CreateInterp();
 >   if(Tcl_Init(interp) == TCL_ERROR) { [...] }
 >   if( Tcl_EvalFile(interp, "test.tcl") != TCL_OK ) { [...] }
 >}
 >
 >I get 'G��¼nter' instead of 'Günter'.
 >
 >Do I need to specify something special to enable the C-interface to
 >accept international character sets?

Yes: you need to call 'Tcl_FindExecutable(argv[0]);' before 'Tcl_CreateInterp();'. Without this, Tcl's encoding system won't be initialized properly.


The examples at the top of this page do not have to confront the Tcl_FindExecutable() issue, because they take the simplest approach and call Tcl_Main() or Tk_Main(). *_Main() takes care of the call to Tcl_FindExecutable(), the call to Tcl_CreateInterp() to create the master interpreter, and setting up the global argv variable. Tk_Main() also starts an event loop. You only have to worry about these matters if neither Tcl_Main() nor Tk_Main() is suitable for your needs.

DGP


2001-03-27 6:10PM, corrected minor spelling error and changed [] to [[]]] in code fragment, so it should look like [] instead of linking to [0]. -EE


Stu 2007-09-29 Tcl provides an easy method to make a custom shell. Simply "borrow" the file tclAppinit.c from the Tcl sources and use the #defines TCL_LOCAL_MAIN_HOOK and TCL_LOCAL_APPINIT.

The result of the following is a tclsh with an added command and the ability to set a global var with a command line option.

File: qtclsh.c:

 /* qtclsh - Pronounced 'Cutie-Klesh' or 'Cutie-Klush' */
 /* Stuart Cassoff */
 /* September 2007 */

 #include <tcl.h>
 #include <stdlib.h>
 #include <stdio.h>
 #include <string.h>

 /* Forward declaration for our command */
 static int Hovercraft_Cmd (ClientData notUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

 /* Pointer to temp storage for our global */
 static char *qGlobal = NULL;


 /*
  * This will be called right at the start of tclAppinit.c's main()
  * so it's almost like main() but we let tclAppinit.c do the all the grunt work.
  */
 int qtclsh_main (int *argc, char ***argv) {
         if (*argc > 2) {

                 /* If our "special" args are specified ... */
                 if ((*(*argv)[1] == '-') && (strcmp((*argv)[1], "-g") == 0)) {

                         /* Copy the next arg */
                         if ((qGlobal = malloc(strlen((*argv)[2])+1)) == NULL) {
                                 perror("qtclsh: couldn't malloc for \"-g\"");
                                 exit(1);
                         }
                         strcpy(qGlobal, (*argv)[2]);

                         /* Fiddle with args to hide our "special" args */
                         (*argv)[2] = (*argv)[0];
                         *argc -= 2;
                         *argv += 2;
                 }
         }
         return 0;
 }


 /*
  * This will be called instead of tclAppinit.c's Tcl_AppInit().
  */
 int qtclsh_init (Tcl_Interp *interp) {
         /* Standard init stuff like in Tcl_AppInit() */
         if (Tcl_Init(interp) == TCL_ERROR) {
                 return TCL_ERROR;
         }
         if (Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY) == NULL) {
                 return TCL_ERROR;
         }

         /* Our stuff */

         /* If global was specified, set it and free previously allocated storage */
         if (qGlobal != NULL) {
                 if (Tcl_SetVar(interp, "qGlobal", qGlobal, TCL_GLOBAL_ONLY) == NULL) {
                         free(qGlobal);
                         return TCL_ERROR;
                 }
                 free(qGlobal);
         }

         /* Create command(s) */
         Tcl_CreateObjCommand(interp, "hovercraft", Hovercraft_Cmd,
                         (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

         return TCL_OK;
 }


 /*
  * Command(s) added to interp.
  */

 static int Hovercraft_Cmd (
         ClientData notUsed,             /* Not used. */
         Tcl_Interp *interp,             /* Current interpreter. */
         int objc,                       /* Number of arguments. */
         Tcl_Obj *const objv[]           /* Argument objects. */
 ) {
         Tcl_SetObjResult(interp,Tcl_NewStringObj("full of eels", -1));
         return TCL_OK;
 }


 /* EOF */

Build (season to taste):

 $ cc -Wall -O2 -DTCL_LOCAL_MAIN_HOOK=qtclsh_main -DTCL_LOCAL_APPINIT=qtclsh_init -I<tcl_includes> -c -o tclAppInit.o tclAppInit.c
 $ cc -Wall -O2 -DTCL_LOCAL_MAIN_HOOK=qtclsh_main -DTCL_LOCAL_APPINIT=qtclsh_init -I<tcl_includes> -c -o qtclsh.o qtclsh.c
 $ cc -L<tcl_libs> -ltcl84 -lm -o qtclsh tclAppInit.o qtclsh.o

Testprog: qtclsh_test.tcl:

 if {[info exists qGlobal]} {
         puts "qGlobal: ($qGlobal)"
 } else {
         puts "qGlobal not set"
 }
 catch {puts "hovercraft: ([hovercraft])"}
 puts "argv0: $argv0"
 puts "argc: $argc"
 puts "argv: $argv"

Test:

 $ ./qtclsh -g herring qtclsh_test.tcl a b c
 qGlobal: (herring)
 hovercraft: (full of eels)
 argv0: qtclsh_test.tcl
 argc: 3
 argv: a b c

 $ ./qtclsh qtclsh_test.tcl a b c
 qGlobal: not set
 hovercraft: (full of eels)
 argv0: qtclsh_test.tcl
 argc: 3
 argv: a b c

 $ tclsh qtclsh_test.tcl a b c
 qGlobal: not set
 argv0: qtclsh_test.tcl
 argc: 3
 argv: a b c