164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
-
-
-
-
-
-
+
+
+
+
+
+
+
|
}
/*
** Tcl context information used by TH1. This structure definition has been
** copied from and should be kept in sync with the one in "main.c".
*/
struct TclContext {
int argc;
char **argv;
void *library;
tcl_FindExecutableProc *xFindExecutable;
tcl_CreateInterpProc *xCreateInterp;
Tcl_Interp *interp;
int argc; /* Number of original arguments. */
char **argv; /* Full copy of the original arguments. */
void *library; /* The Tcl library module handle. */
tcl_FindExecutableProc *xFindExecutable; /* Tcl_FindExecutable() pointer. */
tcl_CreateInterpProc *xCreateInterp; /* Tcl_CreateInterp() pointer. */
Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */
char *setup; /* The optional Tcl setup script. */
};
/*
** Syntax:
**
** tclEval arg ?arg ...?
*/
|
580
581
582
583
584
585
586
587
588
589
590
591
592
593
|
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
|
+
|
void *pContext
){
struct TclContext *tclContext = (struct TclContext *)pContext;
int argc;
char **argv;
char *argv0 = 0;
Tcl_Interp *tclInterp;
char *setup;
if ( !tclContext ){
Th_ErrorMessage(interp,
"Invalid Tcl context", (const char *)"", 0);
return TH_ERROR;
}
if ( tclContext->interp ){
|
628
629
630
631
632
633
634
635
636
637
638
639
640
641
|
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
|
+
+
+
+
+
+
+
+
+
|
tclContext->interp = tclInterp = 0;
return TH_ERROR;
}
/* Add the TH1 integration commands to Tcl. */
Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);
/* If necessary, evaluate the custom Tcl setup script. */
setup = tclContext->setup;
if( setup && Tcl_Eval(tclInterp, setup)!=TCL_OK ){
Th_ErrorMessage(interp,
"Tcl setup script error:", Tcl_GetStringResult(tclInterp), -1);
Tcl_DeleteInterp(tclInterp);
tclContext->interp = tclInterp = 0;
return TH_ERROR;
}
return TH_OK;
}
/*
** Register the Tcl language commands with interpreter interp.
** Usually this is called soon after interpreter creation.
*/
|