X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=www%2Fwtcl.c;h=542c67d189201fe3b7ea3cc34dea84142cfee8b1;hb=4938d0c2e8f4e1eec397c2bfbbc7e23fd150c369;hp=bb2c34dfaf6884368520804cc87e5bb62936170a;hpb=6e37e8e91bf35cb14c930e8988085cf78f11029a;p=egate.git diff --git a/www/wtcl.c b/www/wtcl.c index bb2c34d..542c67d 100644 --- a/www/wtcl.c +++ b/www/wtcl.c @@ -41,7 +41,17 @@ * USE OR PERFORMANCE OF THIS SOFTWARE. * * $Log: wtcl.c,v $ - * Revision 1.9 1995/11/07 14:57:00 adam + * Revision 1.12 1996/03/07 12:45:34 adam + * New Tcl calls egw_enc/egw_dec to encode/decode binary URL info. + * + * Revision 1.11 1996/01/24 08:26:56 adam + * All tcl commands prefixed with egw_ (except the html command). + * + * Revision 1.10 1995/11/08 16:14:35 adam + * Many improvements and bug fixes. + * First version that ran on dtbsun. + * + * Revision 1.9 1995/11/07 14:57:00 adam * Work on search in multiple targets. * New wtcl command: wlog. * Optional timeout parameter to zwait. @@ -152,21 +162,10 @@ static int proc_html_invoke (ClientData clientData, Tcl_Interp *interp, int i; for (i = 1; iwcl, argv[i]); + wo_write (p->wcl, argv[i], strlen(argv[i])); return TCL_OK; } -static int proc_htmlr_invoke (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) -{ - struct tcl_info *p = (struct tcl_info*) clientData; - int r; - - r = proc_html_invoke (clientData, interp, argc, argv); - wo_putc (p->wcl, '\n'); - return r; -} - static int proc_wform_invoke (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { @@ -225,6 +224,73 @@ static int proc_wlog_invoke (ClientData clientData, Tcl_Interp *interp, return TCL_OK; } +static int proc_enc (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + int i; + char buf1[4]; + char buf2[2]; + + buf1[0] = '%'; + buf2[1] = '\0'; + for (i = 1; i= 127 || *cp == '/' || *cp == ' ' || + *cp == '&' || *cp == ':' || *cp == '%') + { + sprintf (buf1+1, "%02X", *cp); + Tcl_AppendResult (interp, buf1, NULL); + } + else + { + buf2[0] = *cp; + Tcl_AppendResult (interp, buf2, NULL); + } + cp++; + } + } + return TCL_OK; +} + +static int proc_dec (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + int i; + unsigned val; + char buf[2]; + + buf[1] = '\0'; + for (i = 1; i= 'A') + val = cp[1] - 'A'+10; + else + val = cp[1] - '0'; + + + if (cp[2] >= 'A') + val = val*16 + (cp[2] - 'A'+10); + else + val = val*16 + (cp[2] - '0'); + buf[0] = val; + cp += 3; + } + else + buf[0] = *cp++; + Tcl_AppendResult (interp, buf, NULL); + } + } + return TCL_OK; +} + int Tcl_AppInit (Tcl_Interp *interp) { @@ -257,11 +323,12 @@ 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, "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); - Tcl_CreateCommand (p->interp, "wlog", proc_wlog_invoke, p, NULL); + Tcl_CreateCommand (p->interp, "egw_form", proc_wform_invoke, p, NULL); + Tcl_CreateCommand (p->interp, "egw_abort", proc_wabort_invoke, p, NULL); + Tcl_CreateCommand (p->interp, "egw_flush", proc_wflush_invoke, p, NULL); + Tcl_CreateCommand (p->interp, "egw_log", proc_wlog_invoke, p, NULL); + Tcl_CreateCommand (p->interp, "egw_enc", proc_enc, p, NULL); + Tcl_CreateCommand (p->interp, "egw_dec", proc_dec, p, NULL); sprintf (tmp_str, "%d", wcl->id); Tcl_SetVar (p->interp, "sessionId", tmp_str, TCL_GLOBAL_ONLY); return p; @@ -270,6 +337,8 @@ static void *do_create (WCLIENT wcl, void *args) static void report_error (struct tcl_info *p, int errorLine, const char *pre, const char *msg) { + if (!msg) + msg = ""; gw_log (GW_LOG_WARN, mod, "%s %d %s", pre, errorLine, msg); wo_printf (p->wcl, "\n

\n" "%s %d
\n", pre, errorLine); @@ -399,9 +468,7 @@ static int do_load (char *parms, void *mydata) 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)); + gw_log (GW_LOG_WARN, mod, "Cannot load Tcl state" ); return 0; }