X-Git-Url: http://jsfdemo.indexdata.com/?a=blobdiff_plain;f=www%2Fwtcl.c;h=9ed644cb1ccedc080c231df6b21a753927040489;hb=94e0e8ff10cdb5142f983cd76156310461f9eb89;hp=5255b66c475ae21eae6da0e68f2d8fb1ef3af645;hpb=c1c09b4242df9a16cd11477deea2e35f8ff57fec;p=egate.git diff --git a/www/wtcl.c b/www/wtcl.c index 5255b66..9ed644c 100644 --- a/www/wtcl.c +++ b/www/wtcl.c @@ -41,7 +41,22 @@ * USE OR PERFORMANCE OF THIS SOFTWARE. * * $Log: wtcl.c,v $ - * Revision 1.4 1995/10/27 17:30:16 adam + * Revision 1.8 1995/11/06 17:44:23 adam + * State reestablised when shell restarts. History of previous + * result sets. + * + * Revision 1.7 1995/10/31 16:56:25 adam + * Record presentation. + * + * 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. + * + * Revision 1.4 1995/10/27 17:30:16 adam * First search request/response that works. * * Revision 1.3 1995/10/27 15:12:14 adam @@ -67,11 +82,15 @@ static void *do_create (WCLIENT wcl, void *args); static int do_exec (const char *fname, char *parms, void *mydata); +static int do_load (char *parms, void *mydata); +static int do_save (char *parms, void *mydata); static struct w_interp_type w_interp_t = { "tcl", do_create, - do_exec + do_exec, + do_load, + do_save }; W_Interp_Type w_interp_tcl = &w_interp_t; @@ -84,6 +103,7 @@ struct tcl_info { char *fbuf; int fbuf_size; int fbuf_ptr; + int wabort; WCLIENT wcl; }; @@ -100,6 +120,26 @@ 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; + if (argc > 1) + Tcl_AppendResult (interp, argv[1], NULL); + return TCL_RETURN; +} + +static int proc_wflush_invoke (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + struct tcl_info *p = (struct tcl_info*) clientData; + + wo_flush (p->wcl); + return TCL_OK; +} + static int proc_html_invoke (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { @@ -122,14 +162,17 @@ static int proc_htmlr_invoke (ClientData clientData, Tcl_Interp *interp, return r; } -static int proc_form_invoke (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) +static int proc_wform_invoke (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) { struct tcl_info *p = (struct tcl_info*) clientData; int i; if (argc == 2) { - Tcl_AppendResult (p->interp, wgetval (p->wcl, argv[1]), NULL); + for (i = 0; *p->wcl->wf_data[i].name; i++) + if (!strcmp (argv[1], p->wcl->wf_data[i].name) && + *p->wcl->wf_data[i].value) + Tcl_AppendElement (p->interp, p->wcl->wf_data[i].value); return TCL_OK; } for (i = 0; *p->wcl->wf_data[i].name; i++) @@ -174,7 +217,9 @@ static void *do_create (WCLIENT wcl, void *args) Tcl_AppInit (p->interp); 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, "wform", proc_wform_invoke, p, NULL); + Tcl_CreateCommand (p->interp, "wabort", proc_wabort_invoke, p, NULL); + Tcl_CreateCommand (p->interp, "wflush", proc_wflush_invoke, p, NULL); sprintf (tmp_str, "%d", wcl->id); Tcl_SetVar (p->interp, "sessionId", tmp_str, TCL_GLOBAL_ONLY); return p; @@ -216,7 +261,7 @@ static int tcl_exec (const char *fname, char *parms, { report_error (p, *lineno, "Error in Tcl script starting at line", "Unexpected EOF (missing right brace)"); - return -1; + return TCL_ERROR; } if (c == '\\') escape = 1; @@ -240,13 +285,16 @@ 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; - return 0; + if (p->wabort) + return TCL_RETURN; + return r; } static int do_exec (const char *fname, char *parms, void *mydata) @@ -273,7 +321,13 @@ static int do_exec (const char *fname, char *parms, void *mydata) wo_putc (p->wcl, c); else { - if (tcl_exec (fname, parms, p, inf, &lineno)) + int r = tcl_exec (fname, parms, p, inf, &lineno); + if (r == TCL_RETURN) + { + fclose (inf); + return 0; + } + else if (r == TCL_ERROR) { fclose (inf); return -2; @@ -292,3 +346,39 @@ static int do_exec (const char *fname, char *parms, void *mydata) fclose (inf); return 0; } + + +static int do_load (char *parms, void *mydata) +{ + struct tcl_info *p = mydata; + char fname[80]; + int r; + + sprintf (fname, "tcl.state.%d", p->wcl->id); + r = Tcl_EvalFile (p->interp, fname); + if (r == TCL_ERROR) + report_error (p, p->interp->errorLine, + "Error in Tcl loadState in line", + Tcl_GetVar (p->interp, "errorInfo", 0)); + return 0; +} + +static int do_save (char *parms, void *mydata) +{ + struct tcl_info *p = mydata; + struct Tcl_CmdInfo cinfo; + + if (Tcl_GetCommandInfo(p->interp, "saveState", &cinfo)) + { + int r; + + gw_log (GW_LOG_DEBUG, mod, "saveState"); + r = Tcl_Eval (p->interp, "saveState\n"); + if (r == TCL_ERROR) + report_error (p, p->interp->errorLine, + "Error in Tcl saveState in line", + Tcl_GetVar (p->interp, "errorInfo", 0)); + } + return 0; +} +