作者：陸紹飛
文章摘要:
本文覆蓋了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 庫，必須在你的源代碼中要設置一些常規的常式做並編譯它。有兩個調用庫的頭文件被聲明。
#include
#include
編譯混合應用程序需要指出正確的編譯目錄，正確的庫，並設置正確的連接標誌。在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 ctrudeau@etude.uwaterloo.ca. 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 ctrudeau@etude.uwaterloo.ca. 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 ctrudeau@etude.uwaterloo.ca. 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
#include
#include
#include
#include
#include
#include
#include
#include "../pbx2.h"
#include "../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 memoryn" );
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 scriptn" );
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 itn" );
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)=%dn", 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)=%dn", iChan, iTrunk );
ifmem_p->timesw_out_ctrl[2][iSlot] = iChan;
fprintf( stderr, "TM2_OUT(%d)=%dn", iSlot, iChan );
ifmem_p->spacesw_ctrl[iChan] = 10;
fprintf( stderr, "SS(%d)=10n", iChan );
} // end for -- loop through MFSenders
fprintf( stderr, "nn" );
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)=%dn", 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)=%dn", iChan, iSlot );
ifmem_p->timesw_out_ctrl[2][iTrunk] = iChan;
fprintf( stderr, "TM2_OUT(%d)=%dn", iTrunk, iChan );
ifmem_p->spacesw_ctrl[iChan] = 10;
fprintf( stderr, "SS(%d)=10n", iChan );
} // end for -- loop through MFSenders
// 0 - don update the MFRs as the code should do it
if( !atoi( argv[1] ) )
return( TCL_OK );
fprintf( stderr, "nn" );
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)=%dn", iSlot, iValue );
} // end for -- loop through MFSenders
return( TCL_OK );
} // end cmdDoIt
//------------------------------------------------------------
