TCL/TK 与 C 程序的集成

一、 简介

　　比较TCL/TK 提供的快速而又容易的开发图形拥护界面，X 程序显得很烦琐。Tcl/tk 是一种脚本语言，就象其它的一些脚本语言一样，也有很多事情不能够做或很难做。解决途径是联合 C 与 tcl/tk 一起来开发. tcl/tk 系统提供C 程序调用TCL/TK 的解释器来运行TCL/TK脚本。提供的库包括初始化变量的方法，调用不同的脚本和访问变量。利用这些混合变量对它们访问X固有的特性也提供了好处。简单的回调和时间函数允许程序员制定事件，注册一个C函数为TCL/TK的过程的能力成为一个强大的工具。这篇文档覆盖了TCL/TK脚本与C 集成的一些基础知识。　　编译选项部分描述了变量库并包含了建立程序的必要文件。初始化与注册名令部分解释了怎样开始，怎样从TCL/TK脚本中调用C函数，最后一部分访问变量阐述了怎样来从C函数里来读与写TCL/TK变量。

二、编译选项

　　为了能访问TCL/TK 库，必须在你的源代码中要设置一些常规的例程做并编译它。有两个调用库的头文件被声明。
　　＃i nclude <tcl.h>
　　＃i nclude <tk.h>
　　编译混合应用程序需要指出正确的编译目录，正确的库，并设置正确的连接标志。在TCL/TK顶部的设置也是必须要包含的文件。而下面的设置是在使用 g++ 时要设置的。你的系统依赖于编译器和文件的定位可能有不同的变化。
-I/software/tcl-7.4/include
-I/software/tk-4.0/include
-I/software/x11r5_dev/Include
-L/software/tcl-7.4/lib
-L/software/tk-4.0/lib
-L/software/x11r5_dev/lib
-ltk
-ltcl
-lX11

三、初始化与注册命令

　　建立混合 tcl/tk & C 应用程序的中心要围绕几条选择命令。
　　首先就是"Tk_Main" 函数, 它用来控制整个 tcl/tk 解释器程序。这条命令没有返回值，因此，它需在你的"main" 函数中加下划线,你所有程序的一旦初始化，"Tk_Main" 函数带来三个变量。第二个变量是一个字符串型数组，每个字符串都有一个特殊的含义。第一个变量表示在这个数组的元素个数。第三个变量是指向初始化函数的指针。此初始化函数在许多地方都要被执行。字符串数组通过"Tk_Main"来通知tcl/tk解释器应用程序的名称和tcl/tk 命令在脚本中的位置。这个数组实际上是传给解释器的命令行参数。数组的第一项给出应用程序名称，第二项给出了运行的脚本位置。如果脚本没有在相同的执行目录下，则需要完整路径。由于继承原因，tcl/tk 需要字符串在许多函数里可以修改，它也有函数作用范围的问题，避免这些问题最早的办法是传递时动态分配字符串下面的代码碎片显示了调用利用"Hello World" 应用程序和脚本"hello.tcl"来调用 "Tk_Main"。
// prototype for the initialization function
int InitProc( Tcl_Interp *interp );
// declare an array for two strings
char *ppszArg[2];
// allocate strings and set their contents
ppszArg[0] = (char *)malloc( sizeof( char ) * 12 );
ppszArg[1] = (char *)malloc( sizeof( char ) * 12 );
strcpy( ppszArg[0], "Hello World" );
strcpy( ppszArg[1], "./hello.tcl" );
// the following call does not return
Tk_Main( 2, ppszArg, InitProc );

初始化函数
　　"Tk_Main" 的调用控制了你的程序在tcl/tk中的整个调用，但是在底部初始化之后和tcl/tk 脚本运行之前，能够执行用户自定义的函数。上面的例子中展示了这个类型的函数: "InitProc". 用户定义的初始化函数必须要返回一个整数类型并产生一个指向解释器的参数Tcl_Interp *。在初始化函数里面建立实际解释器调用"Tk_Init"。"Tk_Init"函数设置一个指向解释器的参数,这正是传递到初始化函数的指针。下面的代码仅只是初始化函数，更多的则是在后面列出。
int InitProc( Tcl_Interp *interp )
{
int iRet;
// Initialize tk first
iRet = Tk_Init( interp );
if( iRet != TCL_OK)
{
fprintf( stderr, "Unable to Initialize TK!/n" );
return( iRet );
} // end if
return( TCL_OK );
} // end InitProc

C函数作为 tcl/tk 过程
　　现在你要熟悉在tcl/tk 脚本中的过程调用。当设计混合应用程序中有tcl/tk的过程调用C函数是可能的。完成它需要调用"Tcl_CreateCommand" 函数。这是在初始化函数里的常用做法。在tcl/tk 过程中调用函数就象调用其它的过程一样。在tcl/tk 脚本中存在就不必声明这个过程。函数注册有一个特定原型的过程。它们必须要返回一个整数类型，并设置4个变量，第一个是tcl/tk库文件类型 "ClientData"。第二个变量是指向解释器的指针。最后的两个变量类似于在C "main"函数中的 "argc" 和 "argv" 这两个变量被用于传递参数给tcl/tk 过程。参数"argc" 包含了传递给tcl/tk过程的参数个数"argv" 是字符串数组，每个字符串包含了一个参数。
　　int Myfunc( ClientData Data, Tcl_Interp *pInterp, int argc, char *argv[] );
　　当一个函数被注册作为tcl/tk 过程使用时需一个指针与之联系，指针通过"ClientData"来传递进来。"ClientData"的概念允许程序员联系数据结构和对象，调用能引用这个对象的过程。这个结构不经常需要。象早先提到的注册过程需要调用"Tcl_CreateCommand" 函数。这个函数有5个参数。第一个参数是指向解释器的指针，第二个参数是在tcl/tk 中的过程名，第三个参数是一个指向函数的指针，它在当tcl/tk过程被执行时调用。最后两个参数是 "ClientData" 项, 一个指针删除例程。它允许C函数在程序退出为了清空联系对象的结构时被调用。象指向删除函数的指针"ClientData"不经常调用。下面是 tcl/tk 过程调用"hey_there" 来调用上面声明的"Myfunc"进行注册的例子。
Tcl_CreateCommand( interp, "hey_there", Myfunc, (ClientData)NULL,
(Tcl_CmdDeleteProc *)NULL );

变量访问
　　在执行tcl/tk过程时能调用C函数并允许你从C中获得tcl/tk的帮助，为了从tcl/tk 中获得C的帮助，这有一系列函数，其中包含了从tcl/tk变量中处理获得的信息和设置的信息。

Tcl_GetVar
　　"Tcl_GetVar" 函数返回一个指向tcl/tk变量的字符串指针。这个函数有三个参数：指向解释器的指针，tcl/tk 变量的名称，一个标志flag。这个变量在执行脚本联系到解释器的当前范围被访问。如果在当前范没有局部变量则访问全局变量。如没有匹配的全局变量存在则返回一个错误。 Flags参数允许你指定TCL_GLOBAL_ONLY, 为了使这个函数仅仅访问此变量名的全局变量，下面是tcl/tk 脚本中被访问的一部分代码。
set say_hello_to "World"
下面的代码是在C里访问tcl/tk变量"say_hello_to".
char sHelloTo[30];
// after this call sHelloTo should contain "World"
strncpy( sHelloTo, Tcl_GetVar( pInterp, "say_hello_to", 0 ), 29 );

Tcl_SetVar
　　"Tcl_SetVar"函数允许程序员修改tcl/tk变量的值。此函数有四个参数：第一个是解释器指针，第二个是要修改值的tcl/tk变量名称，第三个是要修改的新值，最后一个是tcl/tk标志flags。"Tcl_SetVar" 的标志flags跟"Tcl_GetVar"的相同。当设置期间遇到出错时"Tcl_SetVar"函数返回NULL值。如果变量不存在，则此函数将在解释器指针引用的脚本内建立一个新的变量。下面的代码将设置tcl/tk变量"say_hello_to"的值为"World"。
Tcl_SetVar( pInterp, "say_hello_to", "World", 0 );

集成C & tcl/tk 应用程序的例子
　　这个应用程序展示了集成C和TCL/TK所需要的基础。此应用程序展示了一系列的登录框和按钮。当信息从登录框输入和按钮被按下时，其他的空域也被相应的更新。这有许多分享内存设备的接口，是调用大型应用程序的方法。这个接口需要头文件在下面没有包含进来，因此不修改而编译此应用程序是不可能的。但就阅读来说这并不是一个坏的示例。
The Makefile
The script file: pr1
The C file: proof.c
#!/.software/local/.admin/bins/bin/wish -f
#============================================================
# xmail
# by Christopher Trudeau, Copyright 1997
#
# This tcl/tk script displays a desktop clock which goes inverse video when
# new mail arrives. A pull down menu allows the user to launch remote login
# sessions on servers specified in the "hosts" variable. The sessions have
# the appropriate "xhost" and "DISPLAY" values.
#
# Comments and criticism on this program are greatly appreciated. Feel free to
# send me a note at [e-mail]. This material is copyright
# but non-commercial institutes have permission to reproduce the program in
# its entirety, all other uses require explicit written permission of the
# author.
#============================================================
#------------------------------------------------------------
# Global Settings
#-----------------------------------------------------------
# fill in the following list for hosts that you wish to access, spaces or tabs
# separating the names of the hosts; eg:
#
# set hosts "ampere etude watt.uwaterloo.ca"
set hosts "ampere watt ohm morse novice"
#------------------------------------------------------------
# Procedures
#-------------------------------------------------------------
# proc prRefreshDisplay - called periodically to refresh the displayed time and
# status of the mail box
proc prRefreshDisplay {} {
global last
# get the time
set i [exec date]
set i [ string range $i 11 15 ]
# get the mailbox status
catch {[exec frm -q -s new]} mail
if { [string first "no" $mail] == -1 } {
# "You have new mail." results in white on black
.lTime configure -fg white -bg black -text $i
# if first time set, do the double beep thing
if { $last == 0 } {
bell
after 120
bell
}
set last 1
} else {
# "You have no new mail." results in black on white
.lTime configure -fg black -bg white -text $i
set last 0
}
after 15000 prRefreshDisplay
}
#------------------------------------------------------------
# Main Code
#------------------------------------------------------------
# create the main window and place it if specified
wm title . "xmail"
set args [lindex $argv 0]
string trim $args -if
{ $args == "geometry" } {
wm geometry . [lindex $argv 1]
}
# figure out what terminal name we are at
set userName [exec whoami]
set termName [exec who ]
set temp [string first $userName $termName]
set termName [string range $termName $temp end]
set temp [string first ( $termName]
set temp2 [string first ) $termName]
set termName [string range $termName $temp $temp2]
set termName [string trim $termName "()"]
# initialize variables and widgets
set last 0
set font "-*-*-medium-r-normal--*-120-*-*-*-*-*-*"
set font2 "-*-*-medium-r-normal--*-100-*-*-*-*-*-*"
label .lTime -font $font
# create the menu button
menubutton .mMenu -relief raised -font $font2 -text ">" -menu .mMenu.m
menu .mMenu.m -tearoff 0
.mMenu.m add cascade -label "xterms" -menu .mMenu.m.xterms
#create the sub menu "xterms"
menu .mMenu.m.xterms -tearoff 0
.mMenu.m.xterms add command -label "local" -command {exec xterm -title local &}
set count 0
set hostN [lindex $hosts $count]
while { $hostN != "" } {
catch { exec xhost $hostN }
set cmd "exec rsh $hostN xterm -display $termName:0 -title $hostN &"
.mMenu.m.xterms add command -label $hostN -command $cmd
incr count 1
set hostN [lindex $hosts $count]
}
.mMenu.m add separator
.mMenu.m add command -label "Exit" -command exit
pack .lTime .mMenu -side left
prRefreshDisplay
#-----------------------------------------------------------
CC = gcc
DEPEND = makedepend
TCL_DIR = /software/tcl-7.4
TK_DIR = /software/tk-4.0
INCS = -I$(TCL_DIR)/include -I$(TK_DIR)/include -I/software/x11r5_dev/Include
LIBS = -L/software/x11r5_dev/lib -L$(TCL_DIR)/lib -L$(TK_DIR)/lib
CCFLAGS= $(INCS) $(LIBS) -g -Wall
LFLAGS = -ltk -ltcl -lX11 -lsocket -lm
ALLDEFINES = -DDEBUG
.SUFFIXES: .c .o .cpp
.c.o:
$(CC) $(CCFLAGS) $(ALLDEFINES) -c $<
.cpp.o:
g++ -g -Wall $(ALLDEFINES) -c $*.cpp
PROOF_C = proof.c
PROOF_O = proof.o
all: proof
proof: $(PROOF_O)
$(CC) $(CCFLAGS) $(ALLDEFINES) -o $@ $(PROOF_O) $(LFLAGS)
clean:
rm -f *.o proof core
depend::
$(DEPEND) -s "# DO NOT DELETE" -- $(ALLDEFINES) -- $(PROOF_C)
# DO NOT DELETE THIS LINE
proof.o: /usr/include/stdio.h /usr/include/sys/feature_tests.h
proof.o: /usr/include/stdlib.h /usr/include/string.h /usr/include/tcl.h
proof.o: /usr/include/tk.h /usr/include/stddef.h /usr/include/sys/types.h
proof.o: /usr/include/sys/isa_defs.h /usr/include/sys/machtypes.h
proof.o: /usr/include/unistd.h /usr/include/sys/unistd.h ../pbx2.h
proof.o: /usr/include/sys/ipc.h /usr/include/sys/msg.h /usr/include/sys/shm.h
proof.o: /usr/include/sys/time.h /usr/include/errno.h
proof.o: /usr/include/sys/errno.h /usr/include/signal.h
proof.o: /usr/include/sys/signal.h ../he2.h
#!/.software/local/.admin/bins/bin/wish -f
#============================================================
# pr1
# by Christopher Trudeau, Copyright 1997
#
# This tcl/tk script is used in conjunction with proof.c to test the hardware
# emulator for the SX4 project.
#
# Comments and criticism on this program are greatly appreciated. Feel free to
# send me a note at [e-mail]. This material is copyright
# but non-commercial institutes have permission to reproduce the program in
# its entirety, all other uses require explicit written permission of the
# author.
#============================================================
wm title . "Proof"
#============================================================
# main window declarations
#============================================================
# create the frames for each row of entry fields
for {set i 0} {$i < 16} {incr i 1} {
frame .f($i)
pack .f($i)
}
button .bDoAll -relief raised -text "Do All" -command {cmdDoIt 1}
button .bDoit -relief raised -text "Do It" -command {cmdDoIt 0}
button .bExit -relief raised -text "Death" -command exit
pack .bDoAll .bDoit .bExit -in .f(15) -side left
# create the MF Sender rows
for {set i 6} {$i < 8} {incr i 1} {
label .lMFS($i) -text "MFS $i"
entry .eMFS($i) -width 4 -textvariable entryMFS($i)
label .lMFSTrunk($i) -text " Trunk:"
entry .eMFSTrunk($i) -width 4 -textvariable entryMFSTrunk($i)
label .lMFSChan($i) -text " Chan:"
entry .eMFSChan($i) -width 4 -textvariable entryMFSChan($i)
pack .lMFS($i) .eMFS($i) .lMFSTrunk($i) .eMFSTrunk($i) .lMFSChan($i) /
.eMFSChan($i) -in .f([expr {$i - 6}]) -side left
}
# create the trunk rows
for {set i 8} {$i < 16} {incr i 1} {
label .lTrunk($i) -text "Trunk $i"
entry .eTrunk($i) -width 4 -textvariable entryTrunk($i)
label .lTrunkCard($i) -text " Card:"
entry .eTrunkCard($i) -width 4 -textvariable entryTrunkCard($i)
label .lTrunkChan($i) -text " Chan:"
entry .eTrunkChan($i) -width 4 -textvariable entryTrunkChan($i)
set j [expr {$i - 6}]
pack .lTrunk($i) .eTrunk($i) .lTrunkCard($i) .eTrunkCard($i) /
.lTrunkChan($i) .eTrunkChan($i) -in .f($j) -side left
}
# create the MF Receiver rows
for {set i 16} {$i < 20} {incr i 1} {
label .lMFR($i) -text "MFR $i"
entry .eMFR($i) -width 4 -textvariable entryMFR($i)
set j [expr {$i - 5}]
pack .lMFR($i) .eMFR($i) -in .f($j) -side left
}
#----------------------------------------------------------
//-----------------------------------------------------------
// proof.c
// by Christopher Trudeau, copyright 1997
//
// This file contains the c code to attach to the tcl/tk script 'pr1' and
// to execute CU like operations on the trunk equipment.
//
// Comments and criticism on this program are greatly appreciated. Feel free
// to send me a note at [e-mail]. This material is
// copyright but non-commercial institutes have permission to reproduce the
// program in its entirety, all other uses require explicit written
// permission of the author.
//
//------------------------------------------------------------
// Include Files
＃i nclude <stdio.h>
＃i nclude <stdlib.h>
＃i nclude <string.h>
＃i nclude <tcl.h>
＃i nclude <tk.h>
＃i nclude <sys/types.h>
＃i nclude <unistd.h>
＃i nclude "../pbx2.h"
＃i nclude "../he2.h"
//----------------------------------------------------------
// Global Variables
struct ifmem_t *ifmem_p; // pointer to shared hardware memory
//-----------------------------------------------------------
// Function Prototypes
int InitProc(Tcl_Interp* interp);
int cmdDoIt( ClientData clientData, Tcl_Interp *pInterp, int argc,
char *argv[] );
//-----------------------------------------------------------
int main()
{
char *ppszArg[2];
int iMemId;
printf( "Starting proof.../n" );
// get pointer to shared interface memory
iMemId = shmget( IFMEM_KEY, sizeof( struct ifmem_t ), 0644);
ifmem_p = (struct ifmem_t *)shmat( iMemId, 0, 0);
if( (int)ifmem_p == -1 )
{
printf( "Error: unable to access shared interface memory/n" );
exit( 0 );
} // end if -- failed to get interface memory
// initialize arguments for Tk_Main
ppszArg[0] = (char *)malloc( sizeof( char ) * 8 );
ppszArg[1] = (char *)malloc( sizeof( char ) * 65 );
strcpy( ppszArg[0], "proof" );
strcpy( ppszArg[1], "/home3/ctrudeau/s/tcl/proof/pr1" );
printf( "Executing tcl/tk script/n" );
Tk_Main( 2, ppszArg, InitProc );
return( 0 );
} // end main
//-----------------------------------------------------------
int InitProc( Tcl_Interp *interp )
{
int iRet;
// Initialize tk first
iRet = Tk_Init( interp );
if( iRet != TCL_OK)
{
printf( "Unable to Initialize TK!/n" );
return( iRet );
} // end if
// register any new tcl/tk commands
Tcl_CreateCommand( interp, "cmdDoIt", cmdDoIt, (ClientData)NULL,
(Tcl_CmdDeleteProc *)NULL );
return( TCL_OK );
} // end InitProc
//-----------------------------------------------------------
// cmdDoIt
//
// This function is called as a command from tcl/tk. It is issued when the
// user pushes the "Do it" button. Each of the entry fields is checked
// for their contents and the interface memory is updated accordingly.
// The update to i/f mem is used to make connections between various cards
// and to put values into those cards (digits, loop back bits, etc)
//
int cmdDoIt( ClientData clientData, Tcl_Interp *pInterp, int argc,
char *argv[] )
{
int iSlot, iValue, iTrunk, iChan;
char sText[64];
fprintf( stderr, "****** Doing it/n" );
for( iTrunk=FIRST_TRUNK; iTrunk<=LAST_TRUNK; iTrunk++ )
{
sprintf( sText, "entryTrunk(%d)", iTrunk );
iValue = atoi( Tcl_GetVar( pInterp, sText, 0 ) );
ifmem_p->serv_shelf[iTrunk] = iValue;
fprintf( stderr, "card(2)(%d)=%d/n", iTrunk, iValue );
sprintf( sText, "entryTrunkCard(%d)", iTrunk );
iSlot = atoi( Tcl_GetVar( pInterp, sText, 0 ) );
sprintf( sText, "entryTrunkChan(%d)", iTrunk );
iChan = atoi( Tcl_GetVar( pInterp, sText, 0 ) );
if( iSlot == 0 || iSlot > 30 )
continue;
if( iChan == 0 || iChan > 30 )
continue;
ifmem_p->timesw_in_ctrl[2][iChan] = iTrunk;
fprintf( stderr, "TM2_IN(%d)=%d/n", iChan, iTrunk );
ifmem_p->timesw_out_ctrl[2][iSlot] = iChan;
fprintf( stderr, "TM2_OUT(%d)=%d/n", iSlot, iChan );
ifmem_p->spacesw_ctrl[iChan] = 10;
fprintf( stderr, "SS(%d)=10/n", iChan );
} // end for -- loop through MFSenders
fprintf( stderr, "/n/n" );
for( iSlot=FIRST_MFSEND; iSlot<=LAST_MFSEND; iSlot++ )
{
sprintf( sText, "entryMFS(%d)", iSlot );
iValue = atoi( Tcl_GetVar( pInterp, sText, 0 ) );
ifmem_p->serv_shelf[iSlot] = iValue;
fprintf( stderr, "card(2)(%d)=%d/n", iSlot, iValue );
sprintf( sText, "entryMFSTrunk(%d)", iSlot );
iTrunk = atoi( Tcl_GetVar( pInterp, sText, 0 ) );
sprintf( sText, "entryMFSChan(%d)", iSlot );
iChan = atoi( Tcl_GetVar( pInterp, sText, 0 ) );
if( iTrunk < FIRST_TRUNK || iTrunk > LAST_TRUNK )
continue;
if( iChan == 0 || iChan > 30 )
continue;
ifmem_p->timesw_in_ctrl[2][iChan] = iSlot;
fprintf( stderr, "TM2_IN(%d)=%d/n", iChan, iSlot );
ifmem_p->timesw_out_ctrl[2][iTrunk] = iChan;
fprintf( stderr, "TM2_OUT(%d)=%d/n", iTrunk, iChan );
ifmem_p->spacesw_ctrl[iChan] = 10;
fprintf( stderr, "SS(%d)=10/n", iChan );
} // end for -- loop through MFSenders
// 0 - don't update the MFRs as the code should do it
if( !atoi( argv[1] ) )
return( TCL_OK );
fprintf( stderr, "/n/n" );
for( iSlot=FIRST_MFRCV; iSlot<=LAST_MFRCV; iSlot++ )
{
sprintf( sText, "entryMFR(%d)", iSlot );
iValue = atoi( Tcl_GetVar( pInterp, sText, 0 ) );
ifmem_p->serv_shelf[iSlot] = iValue;
fprintf( stderr, "card(2)(%d)=%d/n", iSlot, iValue );
} // end for -- loop through MFSenders
return( TCL_OK );
} // end cmdDoIt
//------------------------------------------------------------