Presented At:
The Tcl2K Conference |
Instructor:
D. Richard Hipp |
Copies of these notes, example source code, $Id$ |
"Use C for the things C is good at and use Tcl/Tk for the things Tcl/Tk is good at."
C is good at:
|
Tcl/Tk is good at:
|
Mainstream Tcl Programming Model: |
Embedded Tcl Programming Model: | |
|
| |
|
| |
|
| |
Most of the Tcl2K conference is about |
This tutorial is about |
#include <tcl.h> | Always include <tcl.h> | |||
int main(int argc, char **argv){ Tcl_Interp *interp; |
||||
interp = Tcl_CreateInterp(); | Create a new Tcl interpreter | |||
Tcl_Eval(interp, "puts {Hello, World!}"); | Execute a Tcl command. | |||
return 0; } |
Unix:
$ gcc hello.c -ltcl -lm -ldl
$ ./a.out
Hello, World!
Windows using Cygwin:
C:> gcc hello.c -ltcl80 -lm
C:> a.exe
Hello, World!
Windows using Mingw32:
C:> gcc -mno-cygwin hello.c -ltcl82 -lm
Also works with VC++ |
Build it yourself using these steps:
Specify the *.a file directly:
$ gcc -I../tcl8.2.2/generic hello.c \ ../tcl8.2.2/unix/libtcl8.2.a -lm -ldl $ strip a.out $ ./a.out Hello, World!
Or, tell the C compiler where to look for *.a files:
$ gcc -I../tcl8.2.2/generic hello.c \ -L../tcl8.2.2/unix -ltcl -lm -ldl $ strip a.out $ ./a.out Hello, World!
The -I../tcl8.2.2 argument tells the compiler where to find <tcl.h>. |
http://sourceware.cygnus.com/cygwin/
http://www.cygnus.com/cygwin/index.html
Build it like this:
#include <tcl.h> int main(int argc, char **argv){ Tcl_Interp *interp; interp = Tcl_CreateInterp(); |
||||
/* Your application code goes here */ | Insert C code here to do whatever it is your program is suppose to do | |||
return 0; } |
#include <tcl.h> int main(int argc, char **argv){ Tcl_Interp *interp; char *z; char zLine[2000]; interp = Tcl_CreateInterp(); |
||||
while( fgets(zLine,sizeof(zLine),stdin) ){ | Get one line of input | |||
Tcl_Eval(interp, zLine); | Execute the input as Tcl. | |||
z = Tcl_GetStringResult(interp); if( z[0] ){ printf("PX\n", z); } |
Print result if not empty | |||
} return 0; } |
What if user types more than 2000 characters? |
Use TCL to handle input. Allows input lines of unlimited length.
#include <tcl.h> /* Tcl code to implement the ** input loop */ static char zLoop[] = "while {![eof stdin]} {\n" |
||||
" set line [gets stdin]\n" | Get one line of input | |||
" set result [eval $line]\n" | Execute input as Tcl | |||
" if {$result!=\"\"} {puts $result}\n" | Print result | |||
"}\n" ; int main(int argc, char **argv){ Tcl_Interp *interp; interp = Tcl_CreateInterp(); |
||||
Tcl_Eval(interp, zLoop); | Run the Tcl input loop | |||
return 0; } |
But what about commands that span multiple lines of input? |
The file "input.tcl"
set line {} while {![eof stdin]} { |
||||
if {$line!=""} { puts -nonewline "> " } else { puts -nonewline "% " } flush stdout |
Prompt for user input. The prompt is normally "%" but changes to ">" if the current line is a continuation. | |||
append line [gets stdin] if {[info complete $line]} { |
||||
if {[catch {uplevel #0 $line} result]} { | If the command is complete, execute it. | |||
puts stderr "Error: $result" } elseif {$result!=""} { puts $result } set line {} |
||||
} else { append line \n } |
If the command is incomplete, append a newline and get another line of text. | |||
} |
The file "input.c"
#include <tcl.h> int main(int argc, char **argv){ Tcl_Interp *interp; interp = Tcl_CreateInterp(); |
||||
Tcl_Eval(interp, "source input.tcl"); | Read and execute the input loop | |||
return 0; } |
But now the program is not standalone! |
static char zInputLoop[] = "set line {}\n" "while {![eof stdin]} {\n" " if {$line!=\"\"} {\n" " puts -nonewline \"> \"\n" " } else {\n" " puts -nonewline \"% \"\n" " }\n" " flush stdout\n" " append line [gets stdin]\n" " if {[info complete $line]} {\n" " if {[catch {uplevel #0 $line} result]} {\n" " puts stderr \"Error: $result\"\n" " } elseif {$result!=\"\"} {\n" " puts $result\n" " }\n" " set line {}\n" " } else {\n" " append line \\n\n" " }\n" "}\n" ; |
#include <tcl.h> |
||||
static char zInputLoop[] = /* Actual code omitted */ ; |
Copy and paste the converted Tcl script here | |||
int main(int argc, char **argv){ Tcl_Interp *interp; interp = Tcl_CreateInterp(); |
||||
Tcl_Eval(interp, zInputLoop); | Execute the Tcl code | |||
return 0; } |
sed -e 's/\\/\\\\/g' \ | Convert \ into \\ | |||
-e 's/"/\\"/g' \ | Convert " into \" | |||
-e 's/^/ "/' \ | Add " to start of each line | |||
-e 's/$/\\n"/' input.tcl | Add \n" to end of each line | |||
while {![eof stdin]} { set line [gets stdin] |
||||
regsub -all {\} $line {&&} line | Convert \ into \\ | |||
regsub -all {"} $line {\"} line | Convert " into \" | |||
puts "\"$line\\n\"" | Add " in front and \n" at the end | |||
} |
You may want to save space by removing comments and extra whitespace from scripts.
static char zInputLoop[] = "set line {}\n" "while {![eof stdin]} {\n" "if {$line!=\"\"} {\n" "puts -nonewline \"> \"\n" "} else {\n" "puts -nonewline \"% \"\n" "}\n" "flush stdout\n" "append line [gets stdin]\n" "if {[info complete $line]} {\n" "if {[catch {uplevel #0 $line} result]} {\n" "puts stderr \"Error: $result\"\n" "} elseif {$result!=\"\"} {\n" "puts $result\n" "}\n" "set line {}\n" "} else {\n" "append line \\n\n" "}\n" "}\n" ; |
sed -e 's/\\/\\\\/g' \ -e 's/"/\\"/g' \ |
||||
-e '/^ *#/d' \ | Delete lines that begin with # | |||
-e '/^ *$/d' \ | Delete blank lines | |||
-e 's/^ */ "/' \ | Delete leading spaces | |||
-e 's/$/\\n"/' input.tcl while {![eof stdin]} { set line [gets stdin] |
||||
set line [string trimleft $line] | Remove leading space | |||
if {$line==""} continue | Delete blank lines | |||
if {[string index $line 0]=="#"} { continue } |
Delete lines starting with # | |||
regsub -all {\} $line {&&} line regsub -all {"} $line {\"} line puts "\"$line\\n\"" } |
image create bitmap smiley -data { | ||||
#define smile_width 15 #define smile_height 15 |
These lines begin with # but are not comment | |||
static unsigned char smile_bits[] = { 0xc0, 0x01, 0x30, 0x06, 0x0c, 0x18, 0x04, 0x10, 0x22, 0x22, 0x52, 0x25, 0x01, 0x40, 0x01, 0x40, 0x01, 0x40, 0x12, 0x24, 0xe2, 0x23, 0x04, 0x10, 0x0c, 0x18, 0x30, 0x06, 0xc0, 0x01}; } text .t pack .t .t insert end [string trim { |
||||
She walks in beauty, like the night Of cloudless climes and starry skies; And all that's best of dark and bright Meet in her aspect and her eyes; |
Indentation is deleted on lines 2 and 4 | |||
}] |
Problems like these are rare |
set line {} while {![eof stdin]} { if {$line!=""} { puts -nonewline "> " } else { puts -nonewline "% " } flush stdout append line [gets stdin] if {[info complete $line]} { |
||||
if {[lindex $line 0]=="continue"} { break; |
Break out of the loop if the command is "continue" | |||
} elseif {[catch {uplevel #0 $line} result]} { puts stderr "Error: $result" } elseif {$result!=""} { puts $result } set line {} } else { append line \n } } |
#include <tcl.h> static char zInputLoop[] = /* Tcl Input loop as a C string */ ; int main(int argc, char **argv){ Tcl_Interp *interp; interp = Tcl_CreateInterp(); |
||||
/* Application C code */ | Do some computation | |||
Tcl_Eval(interp, zInputLoop); | Stop for some Tcl input | |||
/* More application C code */ | Do more computation | |||
Tcl_Eval(interp, zInputLoop); | Stop for more Tcl input | |||
/* Finish up the application */ | Finish the computation | |||
return 0; } |
#include <tcl.h> static char zInputLoop[] = /* Tcl Input loop as a C string */ ; |
||||
int main(int argc, char **argv){ #ifdef TESTING Tcl_Interp *interp; |
Create interpreter only if TESTING is defined | |||
interp = Tcl_CreateInterp(); #endif /* Application C code */ |
||||
#ifdef TESTING Tcl_Eval(interp, zInputLoop); #endif |
Accept command-line input only if TESTING is defined | |||
/* More application C code */ #ifdef TESTING Tcl_Eval(interp, zInputLoop); #endif /* Finish up the application */ return 0; } |
#include <tcl.h> int NewCmd( |
||||
void *clientData, Tcl_Interp *interp, int argc, char **argv |
The Tcl command is implemented as a C function with four arguments. | |||
){ printf("Hello, World!\n"); |
||||
return TCL_OK; | Returns TCL_OK or TCL_ERROR | |||
} static char zInputLoop[] = /* Tcl code omitted... */ ; int main(int argc, char **argv){ Tcl_Interp *interp; interp = Tcl_CreateInterp(); |
||||
Tcl_CreateCommand(interp, "helloworld", NewCmd, 0, 0); |
Tell the interpreter which C function to call when the "helloworld" Tcl command is executed | |||
Tcl_Eval(interp, zInputLoop); return 0; } |
Examples of where the delete proc is used in standard Tcl/Tk:
button .b -text Hello pack .b |
||||
rename .b {} | Deleting the .b command causes the button to be destroyed | |||
|
||||
image create photo smiley \ -file smiley.gif |
||||
rename smiley {} | Deleting the smiley command destroys the image and reclaims the memory used to hold the image |
The argc and argv parameters work just like in main()
helloworld one {two three} four | argc = 4 argv[0] = "helloworld" argv[1] = "one" argv[2] = "two three" argv[3] = "four" argv[4] = NULL |
In a program with many new Tcl commands implemented in C, it becomes tedious to type the same four parameters over and over again. So we define a short-cut.
#define TCLARGS \ void *clientData, \ Tcl_Interp *interp, \ int argc, \ char *argv |
Define TCLARGS once in a header file | |||
|
||||
int NewCmd(TCLARGS){ | Use the TCLARGS macro to define new C functions that implement Tcl commands. | |||
/* implementation... */ } |
For brevity, we will use the TCLARGS macro during the rest of this talk. |
int NewCmd(TCLARGS){ | Note that the C function returns an "int" | |||
return TCL_OK; | Return value is TCL_OK or TCL_ERROR | |||
} |
int NewCmd(TCLARGS){ | ||||
Tcl_SetResult(interp,"Hello!",TCL_STATIC); | Set the result to "Hello!" | |||
return TCL_OK; } |
int NewObjCmd( void *clientData, Tcl_Interp *interp, int objc, |
||||
Tcl_Obj *const* objv | 4th parameter is an array Tcl_Objs, not an array of strings | |||
){ /* Implementation... */ return TCL_OK; } static char zInputLoop[] = /* Tcl code omitted... */ ; int main(int argc, char **argv){ Tcl_Interp *interp; interp = Tcl_CreateInterp(); |
||||
Tcl_CreateObjCommand(interp, "newcmd", NewObjCmd, 0, 0); |
Use a different function to register the command | |||
Tcl_Eval(interp, zInputLoop); return 0; } |
Memory allocation functions
Tcl_Alloc |
Tcl_Free |
Tcl_Realloc |
Functions useful in the implementation of new Tcl commands
Tcl_AppendElement Tcl_AppendResult Tcl_GetBoolean |
Tcl_GetDouble Tcl_GetInt Tcl_GetStringResult |
Tcl_ResetResult Tcl_SetResult |
Functions for controlling the Tcl interpreter
Tcl_CreateCommand Tcl_CreateInterp |
Tcl_CreateObjCommand Tcl_DeleteCommand |
Tcl_DeleteInterp Tcl_Exit |
I/O functions
Tcl_Close Tcl_Eof Tcl_Flush Tcl_GetChannel Tcl_GetChannelMode Tcl_GetChannelName |
Tcl_Gets Tcl_OpenCommandChannel Tcl_OpenFileChannel Tcl_OpenTcpClient Tcl_OpenTcpServer Tcl_Read |
Tcl_Seek Tcl_Tell Tcl_Ungets Tcl_Write Tcl_WriteChars |
Names and meanings of system error codes
Tcl_ErrnoId Tcl_ErrnoMsg |
Tcl_GetErrno Tcl_SetErrno |
Tcl_SignalId Tcl_SignalMsg |
General Operating System Calls
Tcl_Access Tcl_Chdir Tcl_GetCwd |
Tcl_GetHostName Tcl_GetNameOfExecutable Tcl_Sleep |
Tcl_Stat |
String Manipulation And Comparison
Tcl_Concat Tcl_Merge |
Tcl_SplitList Tcl_StringCaseMatch |
Tcl_StringMatch |
Dynamically Resizable Strings
Tcl_DStringAppend Tcl_DStringAppendElement Tcl_DStringEndSublist Tcl_DStringInit Tcl_DStringLength |
Tcl_DStringResult Tcl_DStringSetLength Tcl_DStringStartSublist Tcl_DStringValue |
Event Handlers
Tcl_CancelIdleCall Tcl_CreateChannelHandler Tcl_CreateTimerHandler Tcl_DeleteChannelHandler |
Tcl_DeleteTimerHandler Tcl_DoOneEvent Tcl_DoWhenIdle |
Functions For Reading And Writing Tcl Variables
Tcl_GetVar Tcl_GetVar2 Tcl_LinkVar Tcl_SetVar Tcl_SetVar2 |
Tcl_TraceVar Tcl_TraceVar2 Tcl_UnlinkVar Tcl_UnsetVar Tcl_UnsetVar2 |
Tcl_UntraceVar Tcl_UntraceVar2 Tcl_UpdateLinkedVar |
Functions For Executing Tcl Code
Tcl_Eval Tcl_EvalFile |
Tcl_EvalObj Tcl_GlobalEval |
Tcl_GlobalEvalObj Tcl_VarEval |
Functions For Dealing With Unicode
Tcl_NumUtfChars Tcl_UniCharAtIndex Tcl_UniCharIsAlnum Tcl_UniCharIsAlpha Tcl_UniCharIsControl Tcl_UniCharIsDigit Tcl_UniCharIsGraph Tcl_UniCharIsLower Tcl_UniCharIsPrint Tcl_UniCharIsPunct Tcl_UniCharIsSpace Tcl_UniCharIsUpper Tcl_UniCharIsWordChar Tcl_UniCharLen Tcl_UniCharNcmp Tcl_UniCharToLower Tcl_UniCharToTitle |
Tcl_UniCharToUpper Tcl_UniCharToUtf Tcl_UniCharToUtfDString Tcl_UtfAtIndex Tcl_UtfBackslash Tcl_UtfCharComplete Tcl_UtfFindFirst Tcl_UtfFindLast Tcl_UtfNcasecmp Tcl_UtfNcmp Tcl_UtfNext Tcl_UtfPrev Tcl_UtfToLower Tcl_UtfToTitle Tcl_UtfToUniChar Tcl_UtfToUniCharDString Tcl_UtfToUpper |
Functions For Dealing With Tcl_Objs
Too numerous to list...
Invoke the Tcl_Init() function to locate and read the Tcl initialization scripts. |
#include <tcl.h> static char zInputLoop[] = /* Tcl code omitted... */ ; int main(int argc, char **argv){ Tcl_Interp *interp; interp = Tcl_CreateInterp(); |
||||
Tcl_Init(interp); | Locate and read the initialization scripts | |||
/* Call Tcl_CreateCommand()? */ Tcl_Eval(interp, zInputLoop); return 0; } |
But Tcl_Init() can fail. We need to check its return value... |
#include <tcl.h> static char zInputLoop[] = /* Tcl code omitted... */ ; int main(int argc, char **argv){ Tcl_Interp *interp; interp = Tcl_CreateInterp(); |
||||
if( Tcl_Init(interp)!=TCL_OK ){ fprintf(stderr,"Tcl_Init() failed: PX", Tcl_GetStringResult(interp)); } |
Print error message if Tcl_Init() fails | |||
/* Call Tcl_CreateCommand()? */ Tcl_Eval(interp, zInputLoop); return 0; } |
But now the program is not standalone. |
set errors {} set dirs {} if {[info exists tcl_library]} { lappend dirs $tcl_library } else { if {[info exists env(TCL_LIBRARY)]} { lappend dirs $env(TCL_LIBRARY) } lappend dirs $tclDefaultLibrary unset tclDefaultLibrary set dirs [concat $dirs $tcl_libPath] } foreach i $dirs { set tcl_library $i set tclfile [file join $i init.tcl] if {[file exists $tclfile]} { if {![catch {uplevel #0 [list source $tclfile]} msg]} { return } else { append errors "$tclfile: $msg\n$errorInfo\n" } } } error "Can't find a usable init.tcl ..." |
Commands defined in the initialization scripts are loaded on demand. |
Manually execute all initialization scripts
This approach is not recommended |
Redefining the builtin source command
static char zInitTcl[] = "..."; static char zParrayTcl[] = "..."; |
Scripts init.tcl and parray.tcl | |||
int NewSourceCmd(TCLARGS){ |
||||
if( !strcmp(argv[1],"/builtin/init.tcl") ) return Tcl_Eval(interp, zInitTcl); if( !strcmp(argv[1],"/builtin/parray.tcl") ) return Tcl_Eval(interp, zParrayTcl); |
Call Tcl_Eval() on builtin strings if the names match | |||
return Tcl_EvalFile(interp, argv[1]); | Call Tcl_EvalFile() if no match | |||
} int main(int argc, char **argv){ Tcl_Interp *interp; |
||||
setenv("TCL_LIBRARY","/builtin"); | Causes tclInit to look for init.tcl in /builtin | |||
interp = Tcl_CreateInterp(); | ||||
Tcl_CreateCommand(interp, "source", NewSourceCmd, 0, 0); |
Redefine source | |||
Tcl_Init(interp); Tcl_Eval(interp, zInputLoop); return 0; } |
Use the Tcl*InsertProc() functions
#include <tclInt.h> | Rather than <tcl.h>! | |||
static int BltinFileStat(char *path,struct stat *buf){ char *zData; int nData; |
||||
zData = FindBuiltinFile(path, 0, &nData); | Check if path is a builtin | |||
if( zData==0 ){ return -1; } |
Fail if path is not a builtin | |||
memset(buf, 0, sizeof(*buf)); buf->st_mode = 0400; buf->st_size = nData; |
||||
return 0; | Success if it is builtin | |||
} int main(int argc, char **argv){ Tcl_Interp *interp; |
||||
TclStatInsertProc(BltinFileStat); | Register new stat function | |||
interp = Tcl_CreateInterp(); Tcl_Init(interp); Tcl_Eval(interp, zInputLoop); return 0; } |
#include <tclInt.h> | Rather than <tcl.h>! | |||
/* BltinFileStat() not shown... */ static int BltinFileAccess(char *path, int mode){ char *zData; |
||||
if( mode & 3 ) return -1; | All builtins are read-only | |||
zData = FindBuiltinFile(path, 0, &nData); | Check if path is a builtin | |||
if( zData==0 ) return -1; | Fail if path is not a builtin | |||
return 0; | Success if it is builtin | |||
} int main(int argc, char **argv){ Tcl_Interp *interp; |
||||
TclStatInsertProc(BltinFileStat); TclAccessInsertProc(BltinFileAccess); |
Register new stat and access functions | |||
interp = Tcl_CreateInterp(); Tcl_Init(interp); Tcl_Eval(interp, zInputLoop); return 0; } |
static Tcl_Channel BuiltinFileOpen( Tcl_Interp *interp, /* The TCL interpreter doing the open */ char *zFilename, /* Name of the file to open */ char *modeString, /* Mode string for the open (ignored) */ int permissions /* Permissions for a newly created file (ignored) */ ){ char *zData; BuiltinFileStruct *p; int nData; char zName[50]; Tcl_Channel chan; static int count = 1; zData = FindBuiltinFile(zFilename, 1, &nData); if( zData==0 ) return NULL; p = (BuiltinFileStruct*)Tcl_Alloc( sizeof(BuiltinFileStruct) ); if( p==0 ) return NULL; p->zData = zData; p->nData = nData; p->cursor = 0; sprintf(zName,"etbi_bffffc7c_8049b04",((int)BuiltinFileOpen)>>12,count++); chan = Tcl_CreateChannel(&builtinChannelType, zName, (ClientData)p, TCL_READABLE); return chan; } |
static Tcl_ChannelType builtinChannelType = { "builtin", /* Type name. */ NULL, /* Always non-blocking.*/ BuiltinFileClose, /* Close proc. */ BuiltinFileInput, /* Input proc. */ BuiltinFileOutput, /* Output proc. */ BuiltinFileSeek, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ BuiltinFileWatch, /* Watch for events on console. */ BuiltinFileHandle, /* Get a handle from the device. */ }; |
For additional information see:
button .b -text Hello -command exit pack .b |
Create a Tk interface | |||
|
||||
bind . <Destroy> { if {![winfo exists .]} exit } |
Close the application when the main window is destroyed | |||
|
||||
while 1 {vwait forever} | The event loop |
#include <tk.h> |
||||
static char zHello[] = | The application code | |||
"button .b " "-text {Hello, World} " "-command exit\n" "pack .b\n"; |
||||
static char zEventLoop[] = | The event loop | |||
"bind . <Destroy> {\n" " if {![winfo exists .]} exit\n" "}\n" "while 1 {vwait forever}\n"; int main(int argc, char **argv){ Tcl_Interp *interp; interp = Tcl_CreateInterp(); |
||||
Tcl_Init(interp); Tk_Init(interp); |
We really should check the return values of the init functions... | |||
Tcl_Eval(interp, zHello); | ||||
Tcl_Eval(interp, zEventLoop); | The event loop never returns | |||
/*NOTREACHED*/ } |
Unix:
$ gcc hello.c -ltk -L/usr/X11R6/lib \ -lX11 -ltcl -lm -ldl $ ./a.out
Windows using Cygwin:
C:> gcc hello.c -mwindows -ltk80 -ltcl80 -lm C:> a.exe
Windows using Mingw32:
C:> gcc -mno-cygwin hello.c -mwindows \ -ltk82 -ltcl82 -lm C:> a.exe
To make a Tcl application standalone you have to convert the following initialization scripts to C strings and compile them into the executable:
auto.tcl history.tcl init.tcl |
ldAout.tcl package.tcl |
parray.tcl safe.tcl |
tclIndex word.tcl |
To make a Tk application standalone requires these additional initialization scripts from the Tk Library:
bgerror.tcl button.tcl clrpick.tcl comdlg.tcl console.tcl dialog.tcl |
entry.tcl focus.tcl listbox.tcl menu.tcl msgbox.tcl optMenu.tcl |
palette.tcl safetk.tcl scale.tcl scrlbar.tcl tclIndex tearoff.tcl |
text.tcl tk.tcl tkfbox.tcl xmfbox.tcl |
Total of about 13K lines and 400K bytes of text or 9K lines and 250K bytes if you strip comments and leading spaces
Several tools are available. The chart below shows which tools help achieve which objectives.
Features The Tool Helps To Achieve | |||
Tool Name | Mix C and Tcl | Standalone | Hide Source |
SWIG | |||
TclPro Wrapper | |||
FreeWrap | |||
Wrap | |||
mktclapp |
|
|
|
cc -o mktclapp mktclapp.c
button .b -text {Hello, World!} -command exit pack .b
wish xmktclapp.tcl
|
|
cc hw.c -ltk -L/usr/X11R6/lib -lX11 -ltcl -lm -ldl
gcc hw.c -mwindows -ltk80 -ltcl80 -lm
gcc -mno-cygwin hw.c -mwindows -ltk82 -ltcl82 -lm
Put the new C code in a new source file named "add.c"
#include "hw.h" | Generated by mktclapp | |||
int ET_COMMAND_add(ET_TCLARGS){ | ET_TCLARGS is a macro defined in hw.h | |||
int a, b; char zResult[30]; a = atoi(argv[1]); b = atoi(argv[2]); sprintf(zResult, "-1073742724", a+b); Tcl_SetResult(interp, zResult, TCL_VOLATILE); return TCL_OK; } |
|
cc add.c hw.c -ltk -L/usr/X11R6/lib -ltcl -lm -ldl
Don't have to worry with Tcl_CreateCommand() - Mktclapp takes care of that automatically. |
Modify add.c to insure the add command is called with exactly two integer arguments
#include "hw.h" int ET_COMMAND_add(ET_TCLARGS){ int a, b; char zResult[30]; |
||||
if( argc!=3 ){ Tcl_AppendResult(interp, "wrong # args: should be: \"", argv[0], " VALUE VALUE\"", 0); return TCL_ERROR; } |
Report an error if there are not exactly 2 arguments | |||
if( Tcl_GetInt(interp, argv[1], &a)!=TCL_OK ){ return TCL_ERROR; } |
Report an error if the first argument is not an integer | |||
if( Tcl_GetInt(interp, argv[2], &b)!=TCL_OK ){ return TCL_ERROR; } |
Do the same for the second argument | |||
sprintf(zResult, "-1073742724", a+b); Tcl_SetResult(interp, zResult, TCL_VOLATILE); return TCL_OK; } |
In the file objadd.c put this code:
#include "hw.h" | ||||
int ET_OBJCOMMAND_add2(ET_OBJARGS){ int a, b; |
Use "ET_OBJCOMMAND" instead of "ET_COMMAND" and "ET_OBJARGS" instead of "ET_TCLARGS" | |||
if( objc!=3 ){ Tcl_WrongNumArgs(interp, 1, objv, "number number"); return TCL_ERROR; } |
A special routine for "wrong # args" error | |||
if( Tcl_GetIntFromObj(interp, objv[1], &a) ){ | Instead of Tcl_GetInt | |||
return TCL_ERROR; } if( Tcl_GetIntFromObj(interp, objv[2], &b) ){ return TCL_ERROR; } |
||||
Tcl_SetIntObj(Tcl_GetObjResult(interp), a+b); | Result stored as integer, not a string | |||
return TCL_OK; } |
time {add 123456 654321} 10000 26 microseconds per iteration time {add2 123456 654321} 10000 4 microseconds per iteration
In many real-world problems, the Tcl_Obj interface has no noticeable speed advantage over the string interface. |
|
|
|
Two underscores (__) are replaced by two colons (::) in command names, thus giving the ability to define new commands in a namespace
#include <hw.h> | ||||
int ET_COMMAND_adder__add(ET_TCLARGS){ int a, b; |
Creates the Tcl command called "adder::add" | |||
char *zResult[30]; if( argc!=3 ){ Tcl_AppendResult(interp, "wrong # args: should be: \"", argv[0], " VALUE VALUE\"", 0); return TCL_ERROR; } if( Tcl_GetInt(interp, argv[1], &a)!=TCL_OK ){ return TCL_ERROR; } if( Tcl_GetInt(interp, argv[1], &b)!=TCL_OK ){ return TCL_ERROR; } sprintf(zResult, "-1073742724", a+b); Tcl_SetResult(interp, zResult, TCL_VOLATILE); return TCL_OK; } |
int main(int argc, char **argv){ /* Application specific initialization */ |
||||
Et_Init(argc, argv); | Never returns! | |||
/*NOTREACHED*/ return 0; } |
The "Autofork" feature is disabled if you supply your own main() |
#include <tcl.h> int counter = 0; int main(int argc, char **argv){ Et_Init(argc, argv); /*NOTREACHED*/ return 0; } int Et_AppInit(Tcl_Interp *interp){ |
||||
if( Blt_Init(Interp) ){ return TCL_ERROR; } |
Example: Initialize an extension | |||
Tcl_LinkVar(interp, "counter", &counter, TCL_LINK_INT); |
Or link a C variable to a Tcl variable | |||
return TCL_OK; | Return TCL_OK if successful | |||
} |
#include <tcl.h> |
||||
void Et_CustomMainLoop(Tcl_Interp *interp){ | Replaces the default event loop | |||
return; | Ex: Return without handling any events. | |||
} int main(int argc, char **argv){ |
||||
Et_Init(argc, argv); | This now returns after initializing Tcl | |||
/* Application code here */ return 0; } |
#include <tcl.h> void Et_CustomMainLoop(Tcl_Interp *interp){ |
||||
for(;;){ Tcl_DoOneEvent(TCL_ALL_EVENTS|TCL_DONT_WAIT); /* Other processing... */ } |
Intermix processing and event handling | |||
} int main(int argc, char **argv){ |
||||
Et_Init(argc, argv); | Never returns | |||
/*NOTREACHED*/ return 0; } |
|
|
Example: A C function that pops up an error message dialog box
#include "appinit.h" void ErrMsg(char *zMsg){ Tcl_SetVar(Et_Interp, "zMsg", zMsg, TCL_GLOBAL_ONLY); Tcl_GlobalEval(Et_Interp, "tk_messageBox -icon error -msg $zMsg -type ok"); Tcl_UnsetVar(Et_Interp, "zMsg", TCL_GLOBAL_ONLY); } |
The same C function implemented using Et_EvalF() instead of Tcl_GlobalEval()
#include "appinit.h" void ErrMsg(char *zMsg){ Et_EvalF(Et_Interp, "tk_messageBox -icon error -msg {PX} -type ok", zMsg); } |
ErrMsg("Syntax error near \"}\"");
tk_messageBox -icon error -msg \ {Syntax error near "}"} -type ok
Use the "" format to generate a quoted string
#include "appinit.h" void ErrMsg(char *zMsg){ Et_EvalF(Et_Interp, "tk_messageBox -icon error -msg \"%\" -type ok", zMsg); } |
tk_messageBox -icon error -msg \ "Syntax error near \"\}\"" -type ok
mktclapp -header >appinit.h
mktclapp -f appinit.mta >appinit.c
mktclapp -helpto get a list of available options
# Configuration file generated by xmktclapp # Hand editing is not recommended # |
Comments begin with one # | |||
## Autofork No ## CFile:add.c 1 ## CFile:objadd.c 1 ## CmdLine Console ## ConfigFile hw.mta ## Data:check.gif 1 ## MainScript hw.tcl ## Mode Tcl/Tk ## NoSource No ## OutputFile hw.c ## Shroud No ## Standalone Yes ## TclFile:hw.tcl 1 ## TclLib /usr/lib/tcl8.0 ## TkLib /usr/lib/tk8.0 |
Lines beginning with two #s are used by xmktclapp.tcl and ignored by mktclapp | |||
-console -main-script "hw.tcl" -tcl-library "/usr/lib/tcl8.0" -tk-library "/usr/lib/tk8.0" "add.c" "objadd.c" -i "check.gif" -strip-tcl "hw.tcl" |
All other lines are read by mktclapp and ignored by xmktclapp.tcl |