Presented At:
The Tcl2K Conference |
Instructor:
D. Richard Hipp |
|
Copies of these notes, example source code, $Id: index.html 31689 2011-05-22 09:26:02Z nobu $ |
"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; } |