X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=www%2Fwtcl.c;fp=www%2Fwtcl.c;h=f8273cbdab1c6d7aec7317146c8003b51433f2a9;hb=4a4288c5b72d694c1ca2c1c08926d1e10f01cc48;hp=bd63995dcd6051a11a68a8f990e58dc4d81e4eeb;hpb=fb42e8909c46dfe29d2b8d8852e0ebf297eb2963;p=egate.git

diff --git a/www/wtcl.c b/www/wtcl.c
index bd63995..f8273cb 100644
--- a/www/wtcl.c
+++ b/www/wtcl.c
@@ -41,7 +41,11 @@
  * 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.
  *
@@ -88,6 +92,7 @@ struct tcl_info {
     char  *fbuf;
     int    fbuf_size;
     int    fbuf_ptr;
+    int    wabort;
     WCLIENT wcl;
 };
 
@@ -104,6 +109,15 @@ Tcl_Interp *w_interp_tcl_get (W_Interp w_interp)
     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)
 {
@@ -179,6 +193,7 @@ static void *do_create (WCLIENT wcl, void *args)
     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;
@@ -244,12 +259,15 @@ static int tcl_exec (const char *fname, char *parms,
         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;
 }