int announce_error(int code, char *command)
{
if (code != TCL_OK) {
char buf[128];
#ifdef WIN32
DWORD dwMBResponse;
char *szFmt="Sdr failed with the following error:\n\n%s %s\n\nPlease report to [email protected].\n\nContinue running application?", *szErrMsg;
DWORD dwErrMsgLen = strlen(command) + strlen(interp->result) + strlen(szFmt);
szErrMsg = (char*)malloc(dwErrMsgLen);
sprintf(szErrMsg, szFmt, command, interp->result);
dwMBResponse = MessageBox(NULL, szErrMsg, "SDR Error", MB_ICONERROR|MB_YESNO);
free(szErrMsg);
if (dwMBResponse == IDNO) {
exit(-1);
}
#else
fprintf(stderr, "sdr:%s %s\n", command, interp->result);
#endif
Tcl_VarEval(interp, "puts $errorInfo", NULL);
strncpy(buf, interp->result, sizeof(buf) - 1);
buf[sizeof(buf) - 1] = 0; /* Let's not overrun */
Tcl_VarEval(interp, "tkerror {", buf, "}", NULL);
}
return (code);
}
void seqed_shutdown(Tcl_Interp *interp,
SeqedResult *result)
{
Tcl_CmdInfo info;
tkSeqed *se;
char *tmp;
#ifdef DEBUG
printf("seqed shutdown \n");
#endif
Tcl_GetCommandInfo(interp, result->seqed_win, &info);
se = (tkSeqed*)info.clientData;
if (se->renzDisplayed) {
free_lines();
free_r_enzyme(se->r_enzyme, se->num_enzymes);
}
/* destroy toplevel seqed window */
Tcl_VarEval(interp, "winfo toplevel ", result->seqed_win, NULL);
Tcl_VarEval(interp, "destroy ", Tcl_GetStringResult(interp), NULL);
tmp = get_default_string(interp, tk_utils_defs, w("RASTER.RESULTS.WIN"));
if (TCL_OK != Tcl_VarEval(interp, "seq_result_list_update ",
tmp, NULL)){
verror(ERR_WARN, "seqed shutdown", "%s \n", Tcl_GetStringResult(interp));
}
xfree(result);
}
/*
* Remove a result from the csplot window
*/
void csmatch_remove(GapIO *io, char *cs_plot,
mobj_repeat *reg_dat,
HTablePtr T[]) {
int c;
/* Delete from the canvas and hash table */
DeleteRepeats(GetInterp(), reg_dat, cs_plot, T);
/*
* Remove from the registration lists.
* Loop through all contigs for time being.
*/
for (c = 1; c <= NumContigs(io); c++)
contig_deregister(io, c, reg_dat->reg_func, reg_dat);
/*
* Pop down configuration window if visible
*/
if (TCL_OK != Tcl_VarEval(GetInterp(), "cs_config_quit ", cs_plot, " ",
reg_dat->tagname, NULL)) {
puts(GetInterpResult());
}
/* Inform contig selector next button */
Tcl_VarEval(GetInterp(), "CSLastUsedFree ", CPtr2Tcl(reg_dat), NULL);
/* Free memory */
if (reg_dat->match)
xfree(reg_dat->match);
if (reg_dat->params)
xfree(reg_dat->params);
xfree(reg_dat);
}
//-------------------------------------------------------------------------
void Prg_ASCEND::slv_iterate(slv_system_t, SlvClientToken clt)
{
//fprintf(stderr, "Prg_ASCEND::slv_iterate called\n");
Hqp_SqpSolver *sqp = (Hqp_SqpSolver *)clt;
Prg_ASCEND *prg = (Prg_ASCEND *)sqp->prg();
// todo: assert prg != NULL && prg->name() == "ASCEND"
// currently call Tcl command hqp_solve
// todo: replace with calls to sqp->{qp_update, qp_solve, step}()
extern Tcl_Interp *theInterp;
char *tcl_channel = "stdout";
sqp->set_max_iters(sqp->iter() + 1); // allow one iteration
if (Tcl_VarEval(theInterp, "hqp_solve ", tcl_channel, NULL) == TCL_OK) {
prg->_slv_status.converged = TRUE;
prg->_slv_status.ready_to_solve = FALSE;
}
else if (strcmp(theInterp->result, "iters") != 0) {
prg->_slv_status.ok = FALSE;
prg->_slv_status.ready_to_solve = FALSE;
Tcl_VarEval(theInterp, "puts ", tcl_channel,
" \"HQP Error: ", theInterp->result, "\"", NULL);
}
prg->_slv_status.iteration = sqp->iter();
}
void nip_string_search_shutdown(Tcl_Interp *interp,
seq_result *result,
char *raster_win,
int seq_num)
{
in_string_search *input = result->input;
stick *data = result->data;
out_raster *output = result->output;
char *tmp;
seq_reg_key_name info;
static char buf[80];
int raster_id;
RasterResult *raster_result;
/* determine raster_id and raster_result structure */
Tcl_VarEval(interp, "GetRasterId ", raster_win, NULL);
raster_id = atoi(Tcl_GetStringResult(interp));
raster_result = raster_id_to_result(raster_id);
/* find key name BEFORE deregister */
info.job = SEQ_KEY_NAME;
info.line = buf;
seq_result_notify(result->id, (seq_reg_data *)&info, 0);
seq_deregister(seq_num, nip_string_search_callback,
(seq_result *)result);
/*
* only bother replotting the raster if there are still results in the
* raster
*/
if (raster_result && raster_result->num_results > 1) {
ReplotAllCurrentZoom(interp, raster_win);
tmp = get_default_string(interp, tk_utils_defs,
w("RASTER.RESULTS.WIN"));
if (TCL_OK != Tcl_VarEval(interp, "seq_result_list_update ",
tmp, NULL)){
puts(Tcl_GetStringResult(interp));
}
if (TCL_OK != Tcl_VarEval(interp, "RemoveRasterResultKey ", raster_win,
" {", info.line, "}", NULL))
verror(ERR_WARN, "string_search", "shutdown %s \n", Tcl_GetStringResult(interp));
}
xfree(data->ap_array[0].p_array);
xfree(data->ap_array);
xfree(data);
free(input->params);
free(input->string);
xfree(result->input);
xfree(output->configure[0]);
xfree(output->configure);
xfree(result->output);
xfree(result);
if (raster_result)
DeleteResultFromRaster(raster_result);
}
static void tout_update_stream(int fd, const char *buf, int header,
const char *tag) {
char * win;
char tag_list[1024];
if (!win_init) {
#ifdef _WIN32
/* WINNT will not have stdout/err defined unless running in console mode
* so use a message box
*/
if( fileno(stdout) == -1 || fileno(stderr) == -1 ){
MessageBox(NULL,buf,"Error",MB_OK|MB_ICONERROR|MB_TASKMODAL);
return;
}
#endif
fprintf(fd == 1 ? stdout : stderr, "%s", buf);
fflush(fd == 1 ? stdout : stderr);
return;
}
win = fd == 1 ? stdout_win : stderr_win;
/* Add to the redirection streams */
if (fd == 1 && stdout_fp) {
fprintf(stdout_fp, "%s", buf);
fflush(stdout_fp);
} else if (fd == 2 && stderr_fp) {
fprintf(stderr_fp, "%s", buf);
fflush(stderr_fp);
}
if (info_win) {
Tcl_DStringAppend(&message, buf, strlen(buf));
}
if (tag) {
sprintf(tag_list, "{%s%s %s}",
cur_tag, header ? "_h" : "_t",
tag);
} else {
sprintf(tag_list, "%s%s", cur_tag, header ? "_h" : "_t");
}
/* Add to the text widget */
if (win_init) {
Tcl_SetVar(_interp, "TEMP", buf, 0);
Tcl_VarEval(_interp, win, " insert end ", "\"$TEMP\" ",
tag_list, NULL);
if (fd == 1 ? stdout_scroll : stderr_scroll) {
/* scroll to bottom of output window */
Tcl_VarEval(_interp, win, " see end", NULL);
}
}
}
void deleteTraceDisplay(edview *xx, DisplayContext *dc) {
char buf[1024];
tman_dc *edc;
int i, num = -1;
int mini_trace;
if (!dc)
return;
for (i = 0; i < MAXCONTEXTS; i++) {
if (context_list[i] >= 0 && &contexts[context_list[i]] == dc) {
num = i;
break;
}
}
mini_trace = dc->mini_trace;
/* Remove num and shuffle remaining items down */
if ((edc = find_edc(dc)) && !mini_trace)
tman_unhighlight(edc);
dc->used = 0;
strcpy(buf, dc->path);
/*
* This order is important. If we destroy the widget before removing
* it from the context list then it will be destroyed twice, as there is
* a <Destroy> binding on the widget would call (eventually) this code
* again.
*/
if (num < MAXCONTEXTS-1) {
memmove(&context_list[num], &context_list[num+1],
sizeof(int) * (MAXCONTEXTS-1 - num));
}
context_list[MAXCONTEXTS-1] = -1;
if (mini_trace) {
/* Mini traces are just a dnatrace widget */
Tcl_VarEval(EDINTERP(xx->ed), "destroy ", buf, NULL);
} else {
/*
* Full traces are a complex of windows, of with dc->path is a child.
* So we destroy the parent instead.
*/
Tcl_VarEval(EDINTERP(xx->ed), "dnatrace_remove ", buf, NULL);
}
}
void SeqRasterPlotFunc(Tk_Raster *raster,
char *raster_win,
int job,
int x0, int y0,
int x1, int y1)
{
switch (job) {
case RASTER_INIT:
{
int num_elements;
seq_result **data;
seq_result *result;
int num_funcs;
out_raster *output;
RasterResult *raster_result;
int raster_id;
num_elements = seq_num_results();
if (num_elements == 0)
return;
data = (seq_result **)xmalloc(num_elements * sizeof(seq_result *));
if (-1 == search_reg_data(comparison2, (void **)data, &num_funcs)){
xfree(data);
return;
}
if (num_funcs == 0) {
xfree(data);
return;
}
result = data[0];
output = result->output;
Tcl_VarEval(output->interp, "GetRasterId ", raster_win, NULL);
raster_id = atoi(Tcl_GetStringResult(output->interp));
if (NULL == (raster_result = raster_id_to_result(raster_id))) {
xfree(data);
return;
}
remove_all_raster_cursors(output->interp, raster, raster_result);
xfree(data);
break;
}
case RASTER_REPLOT_ALL:
SeqReplotResults(raster, raster_win, 1, 0, x0, y0, x1, y1);
break;
case RASTER_REPLOT_SLIVER:
SeqReplotResults(raster, raster_win, 0, 0, x0, y0, x1, y1);
break;
case RASTER_REPLOT_ZOOM:
/* NOTE: this is different in nip4 */
SeqReplotResults(raster, raster_win, 0, 1, x0, y0, x1, y1);
break;
}
}
int tcl_parse_jump(char *from, char *rest, Hook *hook)
{
Tcl_Obj *tcl_result;
int i;
#ifdef DEBUG
debug("(tcl_parse_jump) %s %s %s\n",
nullstr(hook->self),nullstr(from),nullstr(rest));
#endif /* DEBUG */
if (from)
nickcpy(CurrentNick,from);
else
*CurrentNick = 0;
Tcl_SetVar(energymech_tcl,"_from",from,0);
Tcl_SetVar(energymech_tcl,"_rest",rest,0);
i = 0;
if (Tcl_VarEval(energymech_tcl,hook->self," $_from $_rest",NULL) == TCL_OK)
{
tcl_result = Tcl_GetObjResult(energymech_tcl);
Tcl_GetIntFromObj(energymech_tcl,tcl_result,&i);
}
#ifdef DEBUG
if (energymech_tcl->result && *energymech_tcl->result)
debug("(tcl_parse_jump) result = %s\n",nullstr(energymech_tcl->result));
#endif /* DEBUG */
return(i);
}
//-----------------------------------------------------------------------
extern "C" int If_SetInt(const char *name, int val)
{
if (!theInterp)
return IF_ERROR;
#if 0
// unfortunately Tcl_EvalObjv was not available under Tcl 8.0
Tcl_Obj *objv[2];
objv[0] = Tcl_NewStringObj((char *)name, -1);
objv[1] = Tcl_NewIntObj(val);
int retcode;
retcode = Tcl_EvalObjv(theInterp, 2, objv, 0);
Tcl_DecrRefCount(objv[0]);
Tcl_DecrRefCount(objv[1]);
if (retcode != TCL_OK)
return IF_ERROR;
#else
char valstr[50];
sprintf(valstr, "%d", val);
if (Tcl_VarEval(theInterp, (char *)name, " ", valstr, NULL) != TCL_OK)
return IF_ERROR;
#endif
Tcl_ResetResult(theInterp); // reset result as val was accepted
return IF_OK;
}
/* Trigger (execute) a Tcl proc
*
* Note: This is INLINE code for check_tcl_bind().
*/
static inline int trigger_bind(const char *proc, const char *param,
char *mask)
{
int x;
Tcl_SetVar(interp, "lastbind", (char *) mask, TCL_GLOBAL_ONLY);
x = Tcl_VarEval(interp, proc, param, NULL);
if (x == TCL_ERROR) {
/* FIXME: we really should be able to log longer errors */
if (strlen(interp->result) > 400)
interp->result[400] = 0;
putlog(LOG_MISC, "*", "Tcl error [%s]: %s", proc, interp->result);
return BIND_EXECUTED;
}
/* FIXME: This is an ugly hack. It is not documented as a
* 'feature' because it will eventually go away.
*/
if (!strcmp(interp->result, "break"))
return BIND_QUIT;
return (atoi(interp->result) > 0) ? BIND_EXEC_LOG : BIND_EXECUTED;
}
void nip_stop_codons_shutdown(Tcl_Interp *interp,
seq_result *s_result,
element *e,
int seq_num)
{
in_s_codon *input = s_result->input;
seq_reg_key_name info;
static char buf[80];
#ifdef DEBUG
printf("nip_stop_codons_shutdown\n");
#endif
/* find key name BEFORE deregister */
info.job = SEQ_KEY_NAME;
info.line = buf;
seq_result_notify(s_result->id, (seq_reg_data *)&info, 0);
seq_deregister(seq_num, nip_stop_codons_callback, (seq_result *)s_result);
Tcl_VarEval(e->c->interp, "result_list_update ", e->c->win, NULL);
if (e->num_results > 0) {
e->replot_func(e);
}
free(input->params);
xfree(s_result->input);
xfree(s_result);
}
int Viewimage_Init(Tcl_Interp *interp) {
/* initialize the stub table interface */
if (Tcl_InitStubs(interp,"8.1",0)==NULL) {
return TCL_ERROR;
}
if (Tk_InitStubs(interp,"8.1",0)==NULL) {
return TCL_ERROR;
}
if (Tcl_PkgRequire(interp,"Tk","8.1",0)==NULL) {
return TCL_ERROR;
}
if (Tcl_PkgRequire(interp,"mvthimage","1.0",0)==NULL) {
return TCL_ERROR;
}
/* initialize the new, alternative image context handling code */
MvthImageState_Init(interp);
/* Initialize the Tcl script for viewing images in a Tk window.*/
char buff[1024];
snprintf(buff,sizeof(buff),"%s/viewimage.tcl",TCLSCRIPTDIR);
fprintf(stdout,"viewimage.tcl should be located at: %s\n",buff);
Tcl_EvalFile(interp,buff);
Tcl_VarEval(interp,
"puts stdout {viewimage Copyright (C) 2009 Sam Bromley};",
"puts stdout {This software comes with ABSOLUTELY NO WARRANTY.};",
"puts stdout {This is free software, and you are welcome to};",
"puts stdout {redistribute it under certain conditions.};",
"puts stdout {For details, see the GNU Lesser Public License V.3 <http://www.gnu.org/licenses>.};",
NULL);
Tcl_VarEval(interp,
"proc miexpand {w} {"
"foreach {wo ho do bo} [mi size $w] break;"
"set c [::viewimage::canvasNameFromImg $w];"
"set wi [winfo width $c];"
"set hi [winfo height $c];"
"set wi [expr {$wi-3}];"
"set hi [expr {$hi-3}];"
"if {$wi<=0} {set wi 10};"
"if {$hi<=0} {set hi 10};"
"mi size $w [list $wi $hi $bo];"
"xblitimage $w;"
"}",NULL);
/* Declare that we provide the buriedtargets package */
Tcl_PkgProvide(interp,"viewimage","1.0");
return TCL_OK;
}
static int tcl_setchan(ClientData cd, Tcl_Interp *irp,
int argc, char *argv[])
{
int idx, chan;
module_entry *me;
BADARGS(3, 3, " idx channel");
idx = findidx(atoi(argv[1]));
if (idx < 0 || (dcc[idx].type != &DCC_CHAT &&
dcc[idx].type != &DCC_SCRIPT)) {
Tcl_AppendResult(irp, "invalid idx", NULL);
return TCL_ERROR;
}
if (argv[2][0] < '0' || argv[2][0] > '9') {
if (!strcmp(argv[2], "-1") || !egg_strcasecmp(argv[2], "off"))
chan = -1;
else {
Tcl_SetVar(irp, "chan", argv[2], 0);
if (Tcl_VarEval(irp, "assoc ", "$chan", NULL) != TCL_OK ||
!interp->result[0]) {
Tcl_AppendResult(irp, "channel name is invalid", NULL);
return TCL_ERROR;
}
chan = atoi(interp->result);
}
} else
chan = atoi(argv[2]);
if ((chan < -1) || (chan > 199999)) {
Tcl_AppendResult(irp, "channel out of range; must be -1 through 199999",
NULL);
return TCL_ERROR;
}
if (dcc[idx].type == &DCC_SCRIPT)
dcc[idx].u.script->u.chat->channel = chan;
else {
int oldchan = dcc[idx].u.chat->channel;
if (dcc[idx].u.chat->channel >= 0) {
if ((chan >= GLOBAL_CHANS) && (oldchan < GLOBAL_CHANS))
botnet_send_part_idx(idx, "*script*");
check_tcl_chpt(botnetnick, dcc[idx].nick, dcc[idx].sock,
dcc[idx].u.chat->channel);
}
dcc[idx].u.chat->channel = chan;
if (chan < GLOBAL_CHANS)
botnet_send_join_idx(idx, oldchan);
check_tcl_chjn(botnetnick, dcc[idx].nick, chan, geticon(idx),
dcc[idx].sock, dcc[idx].host);
}
/* Console autosave. */
if ((me = module_find("console", 1, 1))) {
Function *func = me->funcs;
(func[CONSOLE_DOSTORE]) (idx);
}
return TCL_OK;
}
void funcparams(char *params) {
if (win_init) {
Tcl_VarEval(_interp, "tout_tag_params ",
stdout_win,
" ", cur_tag,
" {", params, "}", NULL);
}
}
/*
* Pop up a configuration window for adjusting a plot.
*
* NOTE: This is ghastly. We write the mobj_repeat pointer as a text string
* using the %p printf format. This is then passed into Tcl, which faithfully
* passes it around not knowing what it means until it gets back into C
* at the tk_matchresult_configure function, whereupon it is converted back.
* NB: This relies on mobj_repeat never been reallocated.
*/
void csmatch_configure(GapIO *io, char *cs_plot, mobj_repeat *r) {
char *tclptr;
tclptr = CPtr2Tcl(r);
if (TCL_OK != Tcl_VarEval(GetInterp(), "cs_config ", cs_plot, " ",
tclptr, NULL)) {
puts(GetInterpResult());
}
}
/*
* Displays the Tcl stack frame - doesn't work always unfortunately.
*/
void dump_tcl_stack(void) {
/* We use VarEval as it can take a non writable string, unlike Eval */
Tcl_VarEval( GetInterp(),
"for {set i [info level]} {$i > 0} {incr i -1} {"
" puts \"Level $i: [info level $i]\""
"}",
NULL);
}
void check_tcl_listen(const char *cmd, int idx)
{
char s[11];
int x;
egg_snprintf(s, sizeof s, "%d", idx);
Tcl_SetVar(interp, "_n", (char *) s, 0);
x = Tcl_VarEval(interp, cmd, " $_n", NULL);
if (x == TCL_ERROR)
putlog(LOG_MISC, "*", "error on listen: %s", interp->result);
}
//-----------------------------------------------------------------------
extern "C" int If_SetString(const char *name, const char *val)
{
if (!theInterp)
return IF_ERROR;
if (Tcl_VarEval(theInterp, (char *)name, " {", (char *)val, "}",
NULL) != TCL_OK)
return IF_ERROR;
return IF_OK;
}
/*
* ============================================================================
* Manipulation of entire sets of results.
* ============================================================================
*/
void DeleteRepeats(Tcl_Interp *interp, mobj_repeat *r, char *csplot_name,
HTablePtr T[]) {
int i;
/* Loop through each item removing from the hash table */
for (i = r->num_match-1; i >= 0; i--) {
HashDelete(T, r->match[i].inum);
}
/* Remove from canvas */
Tcl_VarEval(interp, csplot_name, " delete ", r->tagname, NULL);
}
void dcc_tcl(struct network *net, struct trigger *trig, struct irc_data *data, struct dcc_session *dcc, const char *dccbuf)
{
int ret;
ret = Tcl_VarEval(dcc->net->tclinterp, troll_makearg(dccbuf,trig->mask), NULL);
if (ret == TCL_ERROR)
{
irc_printf(dcc->sock, "TCL Error: %s", dcc->net->tclinterp->result);
}
return;
}
/*
* draw a vertical ruler
*/
void display_ruler_v(Tcl_Interp *interp,
CanvasPtr *canvas,
ruler_s *ruler,
double wy1,
double wy2)
{
char cmd[1024];
Tcl_VarEval(interp, ruler->window, " delete all", NULL);
sprintf(cmd, "%s create line %d %f %d %f\n", ruler->window, ruler->offset,
wy1, ruler->offset, wy2);
Tcl_Eval(interp, cmd);
display_ruler_ticks_v(interp, canvas, ruler, wy1, wy2);
}
static void dns_tcl_iporhostres(IP ip, char *hostn, int ok, void *other)
{
devent_tclinfo_t *tclinfo = (devent_tclinfo_t *) other;
Context;
if (Tcl_VarEval(interp, tclinfo->proc, " ", iptostr(my_htonl(ip)), " ",
hostn, ok ? " 1" : " 0", tclinfo->paras, NULL) == TCL_ERROR)
putlog(LOG_MISC, "*", DCC_TCLERROR, tclinfo->proc, interp->result);
/* Free the memory. It will be unused after this event call. */
nfree(tclinfo->proc);
if (tclinfo->paras)
nfree(tclinfo->paras);
nfree(tclinfo);
}
void t_timer_tcl_handler(struct network *net, struct t_timer *timer)
{
int ret;
ret = Tcl_VarEval(net->tclinterp,
timer->command,
NULL);
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",net->tclinterp->result);
}
return;
}
/*
* Add a consensus trace to the trace display.
*/
void cons_edc_trace(EdStruct *xx, int start, int end, int strand, int match,
int exception) {
Read *r;
char *pname;
char buf[1024];
Tcl_Interp *interp = EDINTERP(xx->ed);
int exists;
tman_dc *ed;
DisplayContext *dc;
static int cons_counter = 0;
Tcl_CmdInfo info;
int pos;
/* Produce the read structure */
if (NULL == (r = cons_trace(xx, start, end, strand, match, exception))) {
bell();
return;
}
/* Create a trace display */
pname = get_default_string(interp, gap_defs, "TRACE_DISPLAY.WIN");
Tcl_VarEval(interp, "trace_create ",
Tk_PathName(EDTKWIN(xx->ed)), pname, " ",
Tk_PathName(EDTKWIN(xx->ed)),
" consensus", NULL);
pname = interp->result;
/* Fill out the tman_dc and DisplayContext structures */
sprintf(buf, "Cons %d", cons_counter++);
dc = getTDisplay(xx, buf, 0, 0, &exists);
strcpy(dc->path, pname);
ed = find_free_edc();
ed->dc = dc;
ed->pos = start-1;
ed->xx = xx;
ed->seq = 0;
ed->type = TRACE_TYPE_CON;
/* Add the Read to the trace widget */
Tcl_GetCommandInfo(interp, interp->result, &info);
trace_memory_load((DNATrace *)info.clientData, r);
dc->tracePtr = (DNATrace *)info.clientData;
/* Adjust position */
Tcl_Eval(interp, "update idletasks");
pos = positionInContig(xx, xx->cursorSeq, xx->cursorPos) - start;
repositionSeq(xx, dc, pos);
}
//
// This procedure is used when paradyn create a process after
// reading a configuration file (using option -f).
//
void
ParadynTkGUI::ProcessCmd(pdstring *args)
{
pdstring command;
command = pdstring("paradyn process ") + (*args);
if (Tcl_VarEval(interp,command.c_str(),0)==TCL_ERROR) {
pdstring msg = pdstring("Tcl interpreter failed in routine ProcessCmd: ");
msg += pdstring(Tcl_GetStringResult(interp));
msg += pdstring("Was processing: ");
msg += command;
uiMgr->showError(83, P_strdup(msg.c_str()));
}
delete args;
}
int ui_create_interface()
{
int i;
/*
* Set the geometry of the main window, if requested.
*/
if (geometry != NULL) {
Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
}
for(i=0;i<MAX_TCL_MODULE;i++)
{
announce_error(Tcl_VarEval(interp, modvar[i], 0), (char *)modname[i]);
}
return 0;
}
/*
* Removes the template and reading display (and unplots etc).
*/
static void cs_shutdown(GapIO *io, obj_cs *cs) {
int i;
reg_quit rq;
/*
for (i = 1; i <= NumContigs(io); i++) {
contig_deregister(io, i, cs_callback, (void *)cs);
}
*/
rq.job = REG_QUIT;
rq.lock = REG_LOCK_WRITE;
type_notify(io, REG_TYPE_FIJ, (reg_data *)&rq, 1);
type_notify(io, REG_TYPE_READPAIR, (reg_data *)&rq, 1);
type_notify(io, REG_TYPE_REPEAT, (reg_data *)&rq, 1);
type_notify(io, REG_TYPE_CHECKASS, (reg_data *)&rq, 1);
type_notify(io, REG_TYPE_OLIGO, (reg_data *)&rq, 1);
/*
* need to deregister AFTER done type_notify requests because they need
* the cs data structure which is deleted during deregistration
*/
for (i = 1; i <= NumContigs(io); i++) {
contig_deregister(io, i, cs_callback, (void *)cs);
}
if (TCL_ERROR == Tcl_VarEval(GetInterp(), "DeleteContigSelector ",
cs->frame, NULL)) {
printf("cs_shutdown %s\n", GetInterpResult());
}
free_win_list(cs->win_list, cs->num_wins);
xfree(cs->line_colour);
xfree(cs->canvas);
xfree(cs->world->visible);
xfree(cs->world->total);
xfree(cs->world);
if (cs->cursor.colour) free(cs->cursor.colour);
if (cs->tick->colour) free(cs->tick->colour);
freeZoom(&cs->zoom);
xfree(cs);
}
/*
* Hides all match objects in a repeat style metaobject without removing
* them. Reveal later using csmatch_reveal().
*/
void csmatch_hide(Tcl_Interp *interp, char *cs_plot, mobj_repeat *r,
HTablePtr T[]) {
int i;
for (i = 0; i < r->num_match; i++)
r->match[i].flags |= OBJ_FLAG_HIDDEN;
DeleteRepeats(interp, r, cs_plot, T);
PlotRepeats(r->io, r);
/*
* We also need to shut down the configure window as this doesn't work
* with everything hidden.
*/
Tcl_VarEval(interp, "cs_config_quit ", cs_plot, " ", r->tagname, NULL);
r->all_hidden = 1;
update_results(r->io);
}
/*
* Must be called for each and every start message in order to free the
* DString allocated.
* "parent" is a tk window path for the dialogue. Specify NULL to indicate
* a bail-out state (where we free the DString but decide not to bring up
* a message box afterall.
*/
void end_message(const char *parent)
{
int argc = 1;
char *argv[1], *merged;
argv[0] = Tcl_DStringValue(&message);
if (NULL == (merged = Tcl_Merge(argc, argv))) {
info_win = 0;
Tcl_DStringFree(&message);
return;
}
/* display message box */
if (parent && _interp) {
Tcl_VarEval(_interp, "messagebox ", parent, " ", merged, NULL);
}
info_win = 0;
Tcl_DStringFree(&message);
Tcl_Free(merged);
}
