void eval (const char *s)
{
char buf[BUFSIZ];
ACE_OS::strcpy (buf,s);
int st = Tcl_GlobalEval(tcl_interp,buf);
if (st != TCL_OK)
{
int n = ACE_OS::strlen(s);
char* wrk = new char[n + 80];
ACE_OS::sprintf(wrk, "tkerror \"%s\"", s);
Tcl_GlobalEval(tcl_interp, wrk);
delete wrk;
//exit(1);
}
}
static void
IvyDirectMsgCB(IvyClientPtr app,
void *user_data,
int id,
char *msg)
{
filter_struct *filter = (filter_struct *) user_data;
int result, size;
char *script_to_call;
char int_buffer[INTEGER_SPACE];
sprintf(int_buffer, "%d", id);
size = strlen(filter->script) + 1;
size += strlen(int_buffer) + 1;
size += strlen(msg) + 1;
script_to_call = ckalloc(size);
strcpy(script_to_call, filter->script);
strcat(script_to_call, " ");
strcat(script_to_call, int_buffer);
strcat(script_to_call, " \"");
strcat(script_to_call, msg);
strcat(script_to_call, "\"");
Tcl_Preserve(filter->interp);
result = Tcl_GlobalEval(filter->interp, script_to_call);
ckfree(script_to_call);
if (result != TCL_OK) {
Tcl_BackgroundError(filter->interp);
}
Tcl_Release(filter->interp);
}
static void
IvyDieCB(IvyClientPtr app,
void *user_data, /* script a appeler */
int id)
{
filter_struct *filter = (filter_struct *) user_data;
int result, size;
char idstr[INTEGER_SPACE];
char *script_to_call;
sprintf(idstr, "%d", id);
size = strlen(filter->script) + INTEGER_SPACE + 1;
script_to_call = ckalloc(size);
strcpy(script_to_call, filter->script);
strcat(script_to_call, " \"");
strcat(script_to_call, idstr);
strcat(script_to_call, "\"");
Tcl_Preserve(filter->interp);
result = Tcl_GlobalEval(filter->interp, script_to_call);
ckfree(script_to_call);
if (result != TCL_OK) {
Tcl_BackgroundError(filter->interp);
}
Tcl_Release(filter->interp);
}
static int
get_directory_command (ClientData cd, Tcl_Interp *interp, int argc,
char **argv)
{
char **new_args;
char *merge;
int result, i;
/* We can't directly run Tk_GetOpenFile, because it wants some
ClientData that we're best off not knowing. So instead we
re-eval. This is a lot less efficient, but it doesn't really
matter. */
new_args = (char **) ckalloc ((argc + 2) * sizeof (char *));
new_args[0] = "tk_getOpenFile";
new_args[1] = "-choosedir";
new_args[2] = "1";
for (i = 1; i < argc; ++i)
new_args[2 + i] = argv[i];
merge = Tcl_Merge (argc + 2, new_args);
result = Tcl_GlobalEval (interp, merge);
ckfree (merge);
ckfree ((char *) new_args);
return result;
}
static PyObject *
Tkapp_GlobalCall(PyObject *self, PyObject *args)
{
/* Could do the same here as for Tkapp_Call(), but this is not used
much, so I can't be bothered. Unfortunately Tcl doesn't export a
way for the user to do what all its Global* variants do (save and
reset the scope pointer, call the local version, restore the saved
scope pointer). */
char *cmd;
PyObject *res = NULL;
cmd = Merge(args);
if (cmd) {
int err;
ENTER_TCL
err = Tcl_GlobalEval(Tkapp_Interp(self), cmd);
ENTER_OVERLAP
if (err == TCL_ERROR)
res = Tkinter_Error(self);
else
res = PyString_FromString(Tkapp_Result(self));
LEAVE_OVERLAP_TCL
ckfree(cmd);
}
return res;
}
int TCLSH_MAIN(int argc, char **argv){
#ifndef TCL_THREADS
Tcl_Interp *interp;
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
Libsqlite_Init(interp);
if( argc>=2 ){
int i;
Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
for(i=2; i<argc; i++){
Tcl_SetVar(interp, "argv", argv[i],
TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
}
if( Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
if( zInfo==0 ) zInfo = interp->result;
fprintf(stderr,"%s: %s\n", *argv, zInfo);
return TCL_ERROR;
}
}else{
Tcl_GlobalEval(interp, zMainloop);
}
return 0;
#else
Tcl_Main(argc, argv, Libsqlite_Init);
#endif /* TCL_THREADS */
return 0;
}
static void
IvyAppCB(IvyClientPtr app,
void *user_data, /* script a appeler */
IvyApplicationEvent event)
{
static const char *app_event_str[] = {
"Connected", "Disconnected" };
filter_struct *filter = (filter_struct *) user_data;
int result, size, dummy;
char *script_to_call;
Tcl_HashEntry *entry;
entry = Tcl_FindHashEntry(&app_table, IvyGetApplicationName(app));
if (event == IvyApplicationConnected) {
if (!entry) {
entry = Tcl_CreateHashEntry(&app_table, IvyGetApplicationName(app), &dummy);
Tcl_SetHashValue(entry, (ClientData) app);
}
}
size = strlen(filter->script) + INTEGER_SPACE;
if (entry) {
size += strlen(IvyGetApplicationName(app)) + 3;
}
else {
size += 4;
}
script_to_call = ckalloc(size);
strcpy(script_to_call, filter->script);
strcat(script_to_call, " ");
if (entry) {
strcat(script_to_call, " \"");
strcat(script_to_call, IvyGetApplicationName(app));
strcat(script_to_call, "\"");
}
else {
strcat(script_to_call, "???");
}
strcat(script_to_call, " \"");
strcat(script_to_call, app_event_str[event%2]);
strcat(script_to_call, "\"");
Tcl_Preserve(filter->interp);
result = Tcl_GlobalEval(filter->interp, script_to_call);
ckfree(script_to_call);
if (result != TCL_OK) {
Tcl_BackgroundError(filter->interp);
}
Tcl_Release(filter->interp);
if (event == IvyApplicationDisconnected) {
if (entry) {
Tcl_DeleteHashEntry(entry);
}
}
}
static void ThemeChangedProc(ClientData clientData)
{
static char ThemeChangedScript[] = "ttk::ThemeChanged";
StylePackageData *pkgPtr = (StylePackageData *)clientData;
if (Tcl_GlobalEval(pkgPtr->interp, ThemeChangedScript) != TCL_OK) {
Tcl_BackgroundError(pkgPtr->interp);
}
pkgPtr->themeChangePending = 0;
}
static int
ThreadEventProc(
Tcl_Event *evPtr, /* Really ThreadEvent */
int mask)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadEvent *threadEventPtr = (ThreadEvent *)evPtr;
ThreadEventResult *resultPtr = threadEventPtr->resultPtr;
Tcl_Interp *interp = tsdPtr->interp;
int code;
const char *result, *errorCode, *errorInfo;
if (interp == NULL) {
code = TCL_ERROR;
result = "no target interp!";
errorCode = "THREAD";
errorInfo = "";
} else {
Tcl_Preserve((ClientData) interp);
Tcl_ResetResult(interp);
Tcl_CreateThreadExitHandler(ThreadFreeProc,
(ClientData) threadEventPtr->script);
code = Tcl_GlobalEval(interp, threadEventPtr->script);
Tcl_DeleteThreadExitHandler(ThreadFreeProc,
(ClientData) threadEventPtr->script);
if (code != TCL_OK) {
errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
} else {
errorCode = errorInfo = NULL;
}
result = Tcl_GetStringResult(interp);
}
ckfree(threadEventPtr->script);
if (resultPtr) {
Tcl_MutexLock(&threadMutex);
resultPtr->code = code;
resultPtr->result = ckalloc(strlen(result) + 1);
strcpy(resultPtr->result, result);
if (errorCode != NULL) {
resultPtr->errorCode = ckalloc(strlen(errorCode) + 1);
strcpy(resultPtr->errorCode, errorCode);
}
if (errorInfo != NULL) {
resultPtr->errorInfo = ckalloc(strlen(errorInfo) + 1);
strcpy(resultPtr->errorInfo, errorInfo);
}
Tcl_ConditionNotify(&resultPtr->done);
Tcl_MutexUnlock(&threadMutex);
}
if (interp != NULL) {
Tcl_Release((ClientData) interp);
}
return 1;
}
static void expandPercentsEval(Tcl_Interp * interp, /* interpreter context */
register char *before, /* Command with percent expressions */
char *r, /* vgpaneHandle string to substitute for "%r" */
int npts, /* number of coordinates */
point * ppos /* Cordinates to substitute for %t */
)
{
register char *string;
Tcl_DString scripts;
Tcl_DStringInit(&scripts);
while (1) {
/*
* Find everything up to the next % character and append it to the
* result string.
*/
for (string = before; (*string != 0) && (*string != '%'); string++) {
/* Empty loop body. */
}
if (string != before) {
Tcl_DStringAppend(&scripts, before, string - before);
before = string;
}
if (*before == 0) {
break;
}
/*
* There's a percent sequence here. Process it.
*/
switch (before[1]) {
case 'r':
Tcl_DStringAppend(&scripts, r, strlen(r)); /* vgcanvasHandle */
break;
case 't':
dgsprintxy(&scripts, npts, ppos);
break;
default:
Tcl_DStringAppend(&scripts, before + 1, 1);
break;
}
before += 2;
}
if (Tcl_GlobalEval(interp, Tcl_DStringValue(&scripts)) != TCL_OK)
fprintf(stderr, "%s while in binding: %s\n\n",
Tcl_GetStringResult(interp), Tcl_DStringValue(&scripts));
Tcl_DStringFree(&scripts);
}
static OSErr
PrefsHandler(
const AppleEvent *event,
AppleEvent *reply,
long handlerRefcon)
{
Tcl_CmdInfo dummy;
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
if (interp &&
Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)){
if (Tcl_GlobalEval(interp, "::tk::mac::ShowPreferences") != TCL_OK) {
Tcl_BackgroundError(interp);
}
}
return noErr;
}
/*
** For the markup <a href=XXX>, find out if the URL has been visited
** before or not. Return COLOR_Visited or COLOR_Unvisited, as
** appropriate.
**
** This routine may invoke a callback procedure which could delete
** the HTML widget. The calling function should call HtmlLock()
** if it needs the widget structure to be preserved.
*/
static int GetLinkColor(HtmlWidget *htmlPtr, char *zURL){
char *zCmd;
int result;
int isVisited;
if( htmlPtr->tkwin==0 ){
TestPoint(0);
return COLOR_Normal;
}
if( htmlPtr->zIsVisited==0 || htmlPtr->zIsVisited[0]==0 ){
TestPoint(0);
return COLOR_Unvisited;
}
zCmd = HtmlAlloc( strlen(htmlPtr->zIsVisited) + strlen(zURL) + 10 );
if( zCmd==0 ){
TestPoint(0);
return COLOR_Unvisited;
}
sprintf(zCmd,"%s {%s}",htmlPtr->zIsVisited, zURL);
HtmlLock(htmlPtr);
result = Tcl_GlobalEval(htmlPtr->interp,zCmd);
HtmlFree(zCmd);
if( HtmlUnlock(htmlPtr) ){
return COLOR_Unvisited;
}
if( result!=TCL_OK ){
TestPoint(0);
goto errorOut;
}
result = Tcl_GetBoolean(htmlPtr->interp,
Tcl_GetStringResult(htmlPtr->interp), &isVisited);
if( result!=TCL_OK ){
TestPoint(0);
goto errorOut;
}
TestPoint(0);
return isVisited ? COLOR_Visited : COLOR_Unvisited;
errorOut:
Tcl_AddErrorInfo(htmlPtr->interp,
"\n (\"-isvisitedcommand\" command executed by html widget)");
Tcl_BackgroundError(htmlPtr->interp);
TestPoint(0);
return COLOR_Unvisited;
}
static OSErr
PrefsHandler(
const AppleEvent *event,
AppleEvent *reply,
SRefCon handlerRefcon)
{
Tcl_CmdInfo dummy;
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
if (interp &&
Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)){
int code = Tcl_GlobalEval(interp, "::tk::mac::ShowPreferences");
if (code != TCL_OK) {
Tcl_BackgroundException(interp, code);
}
}
return noErr;
}
static int
ReallyKillMe(
Tcl_Event *eventPtr,
int flags)
{
Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp;
Tcl_CmdInfo dummy;
int quit = Tcl_GetCommandInfo(interp, "::tk::mac::Quit", &dummy);
if (Tcl_GlobalEval(interp, quit ? "::tk::mac::Quit" : "exit") != TCL_OK) {
/*
* Should be never reached...
*/
Tcl_BackgroundError(interp);
}
return 1;
}
static OSErr
OappHandler(
const AppleEvent *event,
AppleEvent *reply,
SRefCon handlerRefcon)
{
Tcl_CmdInfo dummy;
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
if (interp &&
Tcl_GetCommandInfo(interp, "::tk::mac::OpenApplication", &dummy)){
int code = Tcl_GlobalEval(interp, "::tk::mac::OpenApplication");
if (code != TCL_OK) {
Tcl_BackgroundError(interp);
}
}
return noErr;
}
static void
ConsoleEventProc(
ClientData clientData,
XEvent *eventPtr)
{
if (eventPtr->type == DestroyNotify) {
ConsoleInfo *info = clientData;
Tcl_Interp *consoleInterp = info->consoleInterp;
if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
Tcl_GlobalEval(consoleInterp, "tk::ConsoleExit");
}
if (--info->refCount <= 0) {
ckfree((char *) info);
}
}
}
int init_security()
{
struct stat sbuf;
char keyfilename[MAXFILENAMELEN];
strcpy(passphrase, "");
keylist=NULL;
get_sdr_home(keyfilename);
#ifdef WIN32
strcat(keyfilename, "\\keys");
#else
strcat(keyfilename, "/keys");
#endif
if (stat(keyfilename, &sbuf)<0) return 0;
if (sbuf.st_size>0) {
announce_error(Tcl_GlobalEval(interp, "enter_passphrase"),
"enter_passphrase");
}
return 0;
}
/*
** Delete all input controls. This happens when the HTML widget
** is cleared.
**
** When the TCL "exit" command is invoked, the order of operations
** here is very touchy.
*/
void HtmlDeleteControls(HtmlWidget *htmlPtr){
HtmlElement *p; /* For looping over all controls */
Tcl_Interp *interp; /* The interpreter */
interp = htmlPtr->interp;
p = htmlPtr->firstInput;
htmlPtr->firstInput = 0;
htmlPtr->lastInput = 0;
htmlPtr->nInput = 0;
if( p==0 || htmlPtr->tkwin==0 ) return;
HtmlLock(htmlPtr);
for(; p; p=p->input.pNext){
if( p->input.pForm && p->input.pForm->form.id>0
&& htmlPtr->zFormCommand && htmlPtr->zFormCommand[0]
&& !Tcl_InterpDeleted(interp) && htmlPtr->clipwin ){
Tcl_DString cmd;
int result;
char zBuf[60];
Tcl_DStringInit(&cmd);
Tcl_DStringAppend(&cmd, htmlPtr->zFormCommand, -1);
sprintf(zBuf," %d flush", p->input.pForm->form.id);
Tcl_DStringAppend(&cmd, zBuf, -1);
result = Tcl_GlobalEval(htmlPtr->interp, Tcl_DStringValue(&cmd));
Tcl_DStringFree(&cmd);
if( !Tcl_InterpDeleted(interp) ){
if( result != TCL_OK ){
Tcl_AddErrorInfo(htmlPtr->interp,
"\n (-formcommand flush callback executed by html widget)");
Tcl_BackgroundError(htmlPtr->interp);
TestPoint(0);
}
Tcl_ResetResult(htmlPtr->interp);
}
p->input.pForm->form.id = 0;
}
if( p->input.tkwin ){
if( htmlPtr->clipwin!=0 ) Tk_DestroyWindow(p->input.tkwin);
p->input.tkwin = 0;
}
p->input.sized = 0;
}
HtmlUnlock(htmlPtr);
}
static OSErr
RappHandler(
const AppleEvent *event,
AppleEvent *reply,
long handlerRefcon)
{
Tcl_CmdInfo dummy;
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
ProcessSerialNumber thePSN = {0, kCurrentProcess};
OSStatus err = ChkErr(SetFrontProcess, &thePSN);
if (interp && Tcl_GetCommandInfo(interp,
"::tk::mac::ReopenApplication", &dummy)) {
if (Tcl_GlobalEval(interp, "::tk::mac::ReopenApplication") != TCL_OK){
Tcl_BackgroundError(interp);
}
}
return err;
}
static PyObject *
Tkapp_GlobalEval(PyObject *self, PyObject *args)
{
char *script;
PyObject *res = NULL;
int err;
if (!PyArg_ParseTuple(args, "s:globaleval", &script))
return NULL;
ENTER_TCL
err = Tcl_GlobalEval(Tkapp_Interp(self), script);
ENTER_OVERLAP
if (err == TCL_ERROR)
res = Tkinter_Error(self);
else
res = PyString_FromString(Tkapp_Result(self));
LEAVE_OVERLAP_TCL
return res;
}
int main(int argc, char **argv){
Tcl_Interp *interp;
int i;
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
Libsqlite_Init(interp);
Tcl_SetVar(interp,"argv0",argv[0],TCL_GLOBAL_ONLY);
Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
for(i=1; i<argc; i++){
Tcl_SetVar(interp, "argv", argv[i],
TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
}
if( Tcl_GlobalEval(interp, zAnalysis)!=TCL_OK ){
const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
if( zInfo==0 ) zInfo = interp->result;
fprintf(stderr,"%s: %s\n", *argv, zInfo);
return TCL_ERROR;
}
return 0;
}
static void
UpdateImage(
TreeDragImage dragImage /* Drag image record. */
)
{
TreeCtrl *tree = dragImage->tree;
Tk_PhotoHandle photoH;
XImage *ximage;
int width = dragImage->bounds[2] - dragImage->bounds[0];
int height = dragImage->bounds[3] - dragImage->bounds[1];
int alpha = 128;
XColor *colorPtr;
if (dragImage->image != NULL) {
Tk_FreeImage(dragImage->image);
dragImage->image = NULL;
}
photoH = Tk_FindPhoto(tree->interp, "::TreeCtrl::ImageDrag");
if (photoH == NULL) {
Tcl_GlobalEval(tree->interp, "image create photo ::TreeCtrl::ImageDrag");
photoH = Tk_FindPhoto(tree->interp, "::TreeCtrl::ImageDrag");
if (photoH == NULL)
return;
}
/* Pixmap -> XImage */
ximage = XGetImage(tree->display, dragImage->pixmap, 0, 0,
(unsigned int)width, (unsigned int)height, AllPlanes, ZPixmap);
if (ximage == NULL)
panic("tkTreeDrag.c:UpdateImage() ximage is NULL");
/* XImage -> Tk_Image */
colorPtr = Tk_GetColor(tree->interp, tree->tkwin, "pink");
Tree_XImage2Photo(tree->interp, photoH, ximage, colorPtr->pixel, alpha);
XDestroyImage(ximage);
dragImage->image = Tk_GetImage(tree->interp, tree->tkwin,
"::TreeCtrl::ImageDrag", NULL, (ClientData) NULL);
}
int pre_processing_c ()
{
int i_img, sup;
//Tk_PhotoHandle img_handle;
//Tk_PhotoImageBlock img_block;
if( verbose ) printf( "Filtering with Highpass");
//Tcl_SetVar(interp, "tbuf", val, TCL_GLOBAL_ONLY);
//Tcl_Eval(interp, ".text delete 2");
//Tcl_Eval(interp, ".text insert 2 $tbuf");
/* read support of unsharp mask */
fpp = fopen ("parameters/unsharp_mask.par", "r");
if ( fpp == 0) { sup = 12;}
else { fscanf (fpp, "%d\n", &sup); fclose (fpp); }
for (i_img=0; i_img<n_img; i_img++)
{
highpass (img_name[i_img], img[i_img], img[i_img], sup, 0, chfield, i_img);
if (display) {
#if 0
img_handle = Tk_FindPhoto( interp, "temp");
Tk_PhotoGetImage (img_handle, &img_block);
tclimg2cimg (interp, img[i_img], &img_block);
sprintf(val, "newimage %d", i_img+1);
Tcl_GlobalEval(interp, val);
#endif
}
}
if(verbose)printf( "...done\n");
//Tcl_SetVar(interp, "tbuf", val, TCL_GLOBAL_ONLY);
//Tcl_Eval(interp, ".text delete 3");
//Tcl_Eval(interp, ".text insert 3 $tbuf");
return TCL_OK;
}
static VARIABLE *matc_tcl( VARIABLE *ptr )
{
VARIABLE *res = NULL;
char *command;
int i,n;
command = var_to_string(ptr);
Tcl_GlobalEval( TCLInterp, command );
FREEMEM( command );
if ( TCLInterp->result && (n=strlen(TCLInterp->result))>0 )
{
res = var_temp_new( TYPE_STRING,1,n );
for( i=0; i<n; i++ ) M( res,0,i ) = TCLInterp->result[i];
}
return res;
}
/*
** If the macro TCLSH is defined and is one, then put in code for the
** "main" routine that will initialize Tcl.
*/
#if defined(TCLSH) && TCLSH==1
static char zMainloop[] =
"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"
;
#define TCLSH_MAIN main /* Needed to fake out mktclapp */
int TCLSH_MAIN(int argc, char **argv){
Tcl_Interp *interp;
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
Sqlite_Init(interp);
#ifdef SQLITE_TEST
{
extern int Sqlitetest1_Init(Tcl_Interp*);
extern int Sqlitetest2_Init(Tcl_Interp*);
extern int Sqlitetest3_Init(Tcl_Interp*);
extern int Sqlitetest4_Init(Tcl_Interp*);
extern int Md5_Init(Tcl_Interp*);
Sqlitetest1_Init(interp);
Sqlitetest2_Init(interp);
Sqlitetest3_Init(interp);
Sqlitetest4_Init(interp);
Md5_Init(interp);
}
#endif
if( argc>=2 ){
int i;
Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
for(i=2; i<argc; i++){
Tcl_SetVar(interp, "argv", argv[i],
TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
}
if( Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
if( zInfo==0 ) zInfo = interp->result;
fprintf(stderr,"%s: %s\n", *argv, zInfo);
return 1;
}
}else{
Tcl_GlobalEval(interp, zMainloop);
}
return 0;
}
static void
IvyMsgCB(IvyClientPtr app,
void *user_data,
int argc,
char **argv)
{
filter_struct *filter = (filter_struct *) user_data;
int result, i, size;
char *script_to_call;
size = strlen(filter->script) + 3;
for (i = 0; i < argc; i++) {
size += strlen(argv[i]) + 3;
}
size ++;
size += strlen(IvyGetApplicationName(app))+4;
script_to_call = ckalloc(size);
strcpy(script_to_call, filter->script);
strcat(script_to_call, " \"");
strcat(script_to_call, IvyGetApplicationName(app));
strcat(script_to_call, "\"");
/* strcat(script_to_call, " {"); */
for (i = 0; i < argc; i++) {
strcat(script_to_call, " \"");
strcat(script_to_call, argv[i]);
strcat(script_to_call, "\"");
}
/* strcat(script_to_call, " }"); */
Tcl_Preserve(filter->interp);
result = Tcl_GlobalEval(filter->interp, script_to_call);
ckfree(script_to_call);
if (result != TCL_OK) {
Tcl_BackgroundError(filter->interp);
}
Tcl_Release(filter->interp);
}
/*-----------------------------------------------------------------------------
* EvalTrapCode --
* Run code as the result of a signal. The symbolic signal name is
* formatted into the command replacing %S with the symbolic signal name.
*
* Parameters:
* o interp - The interpreter to run the signal in. If an error
* occures, then the result will be left in the interp.
* o signalNum - The signal number of the signal that occured.
* Return:
* TCL_OK or TCL_ERROR.
*-----------------------------------------------------------------------------
*/
static int
EvalTrapCode (Tcl_Interp *interp, int signalNum)
{
int result;
Tcl_DString command;
Tcl_Obj *saveObjPtr;
saveObjPtr = TclX_SaveResultErrorInfo (interp);
Tcl_ResetResult (interp);
/*
* Format the signal name into the command. This also allows the signal
* to be reset in the command.
*/
result = FormatTrapCode (interp,
signalNum,
&command);
if (result == TCL_OK)
result = Tcl_GlobalEval (interp,
command.string);
Tcl_DStringFree (&command);
if (result == TCL_ERROR) {
char errorInfo [128];
sprintf (errorInfo, "\n while executing signal trap code for %s%s",
Tcl_SignalId (signalNum), " signal");
Tcl_AddErrorInfo (interp, errorInfo);
return TCL_ERROR;
}
TclX_RestoreResultErrorInfo (interp, saveObjPtr);
return TCL_OK;
}
int oddeven_c ()
{
int i_img, sup=12;
//Tk_PhotoHandle img_handle;
//Tk_PhotoImageBlock img_block;
if( verbose ) printf( "Odd/even");
//Tcl_SetVar(interp, "tbuf", val, TCL_GLOBAL_ONLY);
//Tcl_Eval(interp, ".text delete 2");
//Tcl_Eval(interp, ".text insert 2 $tbuf");
for (i_img=0; i_img<n_img; i_img++)
{
oddeven (img_name[i_img], img[i_img], img[i_img], sup, 0, chfield, i_img);
if (display) {
#if 0
img_handle = Tk_FindPhoto( interp, "temp");
Tk_PhotoGetImage (img_handle, &img_block);
tclimg2cimg (interp, img[i_img], &img_block);
sprintf(val, "newimage %d", i_img+1);
Tcl_GlobalEval(interp, val);
#endif
}
}
if(verbose) printf( "...done\n");
//Tcl_SetVar(interp, "tbuf", val, TCL_GLOBAL_ONLY);
//Tcl_Eval(interp, ".text delete 3");
//Tcl_Eval(interp, ".text insert 3 $tbuf");
return TCL_OK;
}
int
Tk_CreateConsoleWindow(
Tcl_Interp *interp) /* Interpreter to use for prompting. */
{
Tcl_Channel chan;
ConsoleInfo *info;
Tk_Window mainWindow;
Tcl_Command token;
int result = TCL_OK;
int haveConsoleChannel = 1;
/* Init an interp with Tcl and Tk */
Tcl_Interp *consoleInterp = Tcl_CreateInterp();
if (Tcl_Init(consoleInterp) != TCL_OK) {
goto error;
}
if (Tk_Init(consoleInterp) != TCL_OK) {
goto error;
}
/*
* Fetch the instance data from whatever std channel is a
* console channel. If none, create fresh instance data.
*/
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
== &consoleChannelType) {
} else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
== &consoleChannelType) {
} else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
== &consoleChannelType) {
} else {
haveConsoleChannel = 0;
}
if (haveConsoleChannel) {
ChannelData *data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
info = data->info;
if (info->consoleInterp) {
/* New ConsoleInfo for a new console window */
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->refCount = 0;
/* Update any console channels to make use of the new console */
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
}
} else {
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->refCount = 0;
}
info->consoleInterp = consoleInterp;
info->interp = interp;
Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, info);
info->refCount++;
Tcl_CreateThreadExitHandler(DeleteConsoleInterp, consoleInterp);
/*
* Add console commands to the interp
*/
token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd, info,
ConsoleDeleteProc);
info->refCount++;
/*
* We don't have to count the ref held by the [consoleinterp] command
* in the consoleInterp. The ref held by the consoleInterp delete
* handler takes care of us.
*/
Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd,
info, NULL);
mainWindow = Tk_MainWindow(interp);
if (mainWindow) {
Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
ConsoleEventProc, info);
info->refCount++;
}
Tcl_Preserve(consoleInterp);
result = Tcl_GlobalEval(consoleInterp, "source $tk_library/console.tcl");
if (result == TCL_ERROR) {
Tcl_SetReturnOptions(interp,
Tcl_GetReturnOptions(consoleInterp, result));
Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
}
Tcl_Release(consoleInterp);
if (result == TCL_ERROR) {
Tcl_DeleteCommandFromToken(interp, token);
mainWindow = Tk_MainWindow(interp);
if (mainWindow) {
Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
ConsoleEventProc, info);
if (--info->refCount <= 0) {
ckfree((char *) info);
}
}
goto error;
}
return TCL_OK;
error:
Tcl_AddErrorInfo(interp, "\n (creating console window)");
if (!Tcl_InterpDeleted(consoleInterp)) {
Tcl_DeleteInterp(consoleInterp);
}
return TCL_ERROR;
}
int gomp_ReadCoordinatesPDB(const char *Text1, int Append)
/* Brookhaven format file reader */
/*************************************************************************/
{
char inputl[PDB_LINE_LEN]; /* input line */
char tmp_atm[BUFF_LEN];
char tmp_res[BUFF_LEN];
char tmp_seg[BUFF_LEN];
char tmp_res_num[BUFF_LEN];
char tmp_coord[BUFF_LEN];
char tmp_temp[BUFF_LEN];
char tmp_a[BUFF_LEN];
char tmp_b[BUFF_LEN];
char tmp_c[BUFF_LEN];
char tmp_alpha[BUFF_LEN];
char tmp_beta[BUFF_LEN];
char tmp_gamma[BUFF_LEN];
char tmp_sGroup[BUFF_LEN];
char tmp_z[BUFF_LEN];
char OutText[BUFF_LEN];
float TXc,TYc,TZc,TBv;
int TRs1;
int Helix, Sheet, Turn;
int ITemp;
static int i,j,loop;
static int type_warning;
static int PDBatoms;
static int Wstr;
static int RWstr;
int PDBmodels = 0;
int *PDBatomsInModel = NULL;
FILE *pdb_in;
type_warning = 0;
Helix = 0;
Sheet = 0;
Turn = 0;
pdb_in=fopen(Text1,"r");
if(pdb_in == NULL) {
sprintf(OutText,"$Can't open input file : %s",Text1);
gomp_PrintERROR(OutText);
return(1);
}
sprintf(OutText,"********** Reading : %s **********",Text1);
gomp_PrintMessage(OutText);
/* calculate number of models in the PDB file */
if((PDBmodels=ModelsInPdbFile(pdb_in,&PDBatomsInModel)) > 0) {
RWstr = 0;
for(i = 0 ; i < PDBmodels ; i++) {
sprintf(OutText,"%s_%d",Text1,(i+1));
if(!i) {
if(Append)
Wstr = gomp_CreateMolecStruct(OutText , PDBatomsInModel[i] , APPEND);
else
Wstr = gomp_CreateMolecStruct(OutText , PDBatomsInModel[i] , NEW);
if ( Wstr < 0 )
goto end;
} else {
if(gomp_CreateMolecStruct(OutText , PDBatomsInModel[i] , APPEND)<0) {
while ( --i >= 0 )
gomp_DeleteMolecStruct(Wstr+i);
Wstr = -1;
goto end;
}
}
}
} else {
/* calculate number of atoms in the PDB file */
PDBatoms = AtomsInPdbFile(pdb_in);
if(Append)
Wstr = gomp_CreateMolecStruct(Text1 , PDBatoms , APPEND);
else
Wstr = gomp_CreateMolecStruct(Text1 , PDBatoms , NEW);
if ( Wstr < 0 )
goto end;
}
/*
Start reading file
Tags recogniced by this routine are:
ATOM: Atom coordinate records for "standard groups"
HETATM: Atom coordinate records for "non-standard" groups
END: End-of-entry record
*/
loop = 0;
while(fgets(inputl,PDB_LINE_LEN,pdb_in) != NULL) {
/* MODEL */
if((strncmp(inputl,"MODEL",5) == 0)) { /*starts model*/
loop = 0;
}
/* ATOM and HETATM */
if((strncmp(inputl,"ATOM",4) == 0) ||
(strncmp(inputl,"HETATM",6) == 0) ) { /*start atom or hetatm*/
/* check the the atom index */
if(PDBmodels) {
if(loop >= PDBatomsInModel[RWstr]) {
gomp_PrintERROR("atom indexout of allowed range");
free(PDBatomsInModel);
return(1);
}
}
memset(tmp_atm , 0 , (size_t)BUFF_LEN);
strncpy(tmp_atm , (inputl+12) , PDB_ATM_NAME_LEN);
memset(tmp_res , 0 , (size_t)BUFF_LEN);
strncpy(tmp_res , (inputl+17) , PDB_RES_NAME_LEN);
memset(tmp_seg , 0 , (size_t)BUFF_LEN);
strncpy(tmp_seg , (inputl+21) , PDB_SEG_NAME_LEN);
sscanf(tmp_atm,"%s",OutText);
j = gomp_PutAtomAtmName(Wstr , OutText , loop);
sscanf(tmp_res,"%s",OutText);
j = gomp_PutAtomResName(Wstr , OutText , loop);
sscanf(tmp_seg,"%s",OutText);
j = gomp_PutAtomSegName(Wstr , OutText , loop);
/* check first postion 27 to see if it is present If a number length = 5 else 4 */
if(isdigit(*(inputl+26))) {
memset(tmp_res_num , 0 , (size_t)BUFF_LEN);
strncpy(tmp_res_num , (inputl+22) , PDB_RES_NUM_LEN + 1);
sscanf(tmp_res_num,"%d",&TRs1);
} else {
memset(tmp_res_num , 0 , (size_t)BUFF_LEN);
strncpy(tmp_res_num , (inputl+22) , PDB_RES_NUM_LEN);
sscanf(tmp_res_num,"%d",&TRs1);
}
j = gomp_PutAtomResNum1(Wstr , TRs1 , loop);
j = gomp_PutAtomResNum2(Wstr , TRs1 , loop);
memset(tmp_coord , 0 , (size_t)BUFF_LEN);
strncpy(tmp_coord , (inputl+30) , PDB_ATM_COORD_LEN);
sscanf(tmp_coord,"%f",&TXc);
j = gomp_PutAtomXCoord(Wstr , TXc , loop);
memset(tmp_coord , 0 , (size_t)BUFF_LEN);
strncpy(tmp_coord , (inputl+38) , PDB_ATM_COORD_LEN);
sscanf(tmp_coord,"%f",&TYc);
j = gomp_PutAtomYCoord(Wstr , TYc , loop);
memset(tmp_coord , 0 , (size_t)BUFF_LEN);
strncpy(tmp_coord , (inputl+46) , PDB_ATM_COORD_LEN);
sscanf(tmp_coord,"%f",&TZc);
j = gomp_PutAtomZCoord(Wstr , TZc , loop);
memset(tmp_temp , 0 , (size_t)BUFF_LEN);
strncpy(tmp_temp , (inputl+60) , PDB_TEMP_FACTOR);
sscanf(tmp_temp,"%f",&TBv);
j = gomp_PutAtomBValue(Wstr , TBv , loop);
j = gomp_PutAtomCharge(Wstr , 0.0 , loop);
if(inputl[21] == ' ')
gomp_PutAtomSegName(Wstr , "S1",loop);
loop++;
} /*end atom*/
else if(strncmp(inputl,"CRYST1",6) == 0) { /*start CRYST1 record*/
/*
COLUMNS DATA TYPE FIELD DEFINITION
-------------------------------------------------------------
1 - 6 Record name "CRYST1"
7 - 15 Real(9.3) a a (Angstroms).
16 - 24 Real(9.3) b b (Angstroms).
25 - 33 Real(9.3) c c (Angstroms).
34 - 40 Real(7.2) alpha alpha (degrees).
41 - 47 Real(7.2) beta beta (degrees).
48 - 54 Real(7.2) gamma gamma (degrees).
56 - 66 LString sGroup Space group.
67 - 70 Integer z Z value.
*/
memset(tmp_a , 0 , (size_t)BUFF_LEN);
strncpy(tmp_a , (inputl+6) , 9);
memset(tmp_b , 0 , (size_t)BUFF_LEN);
strncpy(tmp_b , (inputl+15) , 9);
memset(tmp_c , 0 , (size_t)BUFF_LEN);
strncpy(tmp_c , (inputl+24) , 9);
sscanf(tmp_a,"%f",&TXc);
(void)gomp_SetCellA(TXc);
sscanf(tmp_b,"%f",&TYc);
(void)gomp_SetCellB(TYc);
sscanf(tmp_c,"%f",&TZc);
(void)gomp_SetCellC(TZc);
memset(tmp_alpha , 0 , (size_t)BUFF_LEN);
strncpy(tmp_alpha , (inputl+33) , 7);
sscanf(tmp_alpha,"%f",&TXc);
(void)gomp_SetCellAlpha(TXc);
memset(tmp_beta , 0 , (size_t)BUFF_LEN);
strncpy(tmp_beta , (inputl+40) , 7);
sscanf(tmp_beta,"%f",&TYc);
(void)gomp_SetCellBeta(TYc);
memset(tmp_gamma , 0 , (size_t)BUFF_LEN);
strncpy(tmp_gamma , (inputl+47) , 7);
sscanf(tmp_gamma,"%f",&TZc);
(void)gomp_SetCellGamma(TZc);
memset(tmp_sGroup , 0 , (size_t)BUFF_LEN);
strncpy(tmp_sGroup , (inputl+55) , 11);
memset(tmp_z , 0 , (size_t)BUFF_LEN);
strncpy(tmp_z , (inputl+66) , 4);
sscanf(tmp_z,"%f",&TBv);
}
/* HELIX */
else if((strncmp(inputl,"HELIX",5) == 0)) {
sprintf(OutText,"lulPlumber::SecondaryStructureSaver %d %d {%s}",Wstr+1,(Sheet+Helix+Turn+1),inputl);
ITemp = Tcl_GlobalEval(gomp_GetTclInterp(), OutText );
if(ITemp != TCL_OK) {
gomp_PrintERROR("can't execute the script 'lulPlumber::SecondaryStructureSaver'");
continue;
}
Helix += 1;
}
/* SHEET */
else if((strncmp(inputl,"SHEET",5) == 0)) {
sprintf(OutText,"lulPlumber::SecondaryStructureSaver %d %d {%s}",Wstr+1,(Sheet+Helix+Turn+1),inputl);
ITemp = Tcl_GlobalEval(gomp_GetTclInterp(), OutText );
if(ITemp != TCL_OK) {
gomp_PrintERROR("can't execute the script 'lulPlumber::SecondaryStructureSaver'");
continue;
}
Sheet += 1;
}
/* TURN */
else if((strncmp(inputl,"TURN",4) == 0)) {
sprintf(OutText,"lulPlumber::SecondaryStructureSaver %d %d {%s}",Wstr+1,(Sheet+Helix+Turn+1),inputl);
ITemp = Tcl_GlobalEval(gomp_GetTclInterp(), OutText );
if(ITemp != TCL_OK) {
gomp_PrintERROR("can't execute the script 'lulPlumber::SecondaryStructureSaver'");
continue;
}
Turn += 1;
}
/* ENDMDL */
if((strncmp(inputl,"ENDMDL",6) == 0)) { /*starts model*/
Wstr++;
RWstr++;
continue;
}
/* END */
if(strncmp(inputl,"END",3) == 0) break; /*the end*/
}
if(!PDBmodels) {
if(loop != PDBatoms) {
gomp_PrintMessage("?ERROR - can't read correct number of atoms from PDB file");
return(1);
}
}
gomp_PrintMessage("********** Done **********");
end:
fclose(pdb_in);
free(PDBatomsInModel);
return(Wstr >= 0 ? 0 : 1);
}