* USE OR PERFORMANCE OF THIS SOFTWARE.
*
* $Log: wtcl.c,v $
- * Revision 1.5 1995/10/30 17:35:18 adam
+ * Revision 1.6 1995/10/31 10:03:54 adam
+ * Work on queries.
+ * New command implemented - aborts script.
+ *
+ * Revision 1.5 1995/10/30 17:35:18 adam
* New function zwait that waits for a variable change - due to i/o events
* that invoke callback routines.
*
char *fbuf;
int fbuf_size;
int fbuf_ptr;
+ int wabort;
WCLIENT wcl;
};
return p->interp;
}
+static int proc_wabort_invoke (ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ struct tcl_info *p = (struct tcl_info*) clientData;
+
+ p->wabort = 1;
+ return TCL_RETURN;
+}
+
static int proc_html_invoke (ClientData clientData, Tcl_Interp *interp,
int argc, char **argv)
{
Tcl_CreateCommand (p->interp, "html", proc_html_invoke, p, NULL);
Tcl_CreateCommand (p->interp, "htmlr", proc_htmlr_invoke, p, NULL);
Tcl_CreateCommand (p->interp, "form", proc_form_invoke, p, NULL);
+ Tcl_CreateCommand (p->interp, "wabort", proc_wabort_invoke, p, NULL);
sprintf (tmp_str, "%d", wcl->id);
Tcl_SetVar (p->interp, "sessionId", tmp_str, TCL_GLOBAL_ONLY);
return p;
p->fbuf[fbuf_ptr++] = c;
}
p->fbuf[fbuf_ptr] = '\0';
+ p->wabort = 0;
r = Tcl_Eval (p->interp, p->fbuf);
if (r == TCL_ERROR)
report_error (p, p->interp->errorLine + *lineno - 1,
"Error in Tcl script in line",
Tcl_GetVar (p->interp, "errorInfo", 0));
(*lineno) += local_line;
+ if (p->wabort)
+ return TCL_RETURN;
return r;
}