Implemnted egw_source and added a "raw" option to the URL.
[egate.git] / www / wtcl.c
index fea3bfd..a3fa1f6 100644 (file)
  * USE OR PERFORMANCE OF THIS SOFTWARE.
  *
  * $Log: wtcl.c,v $
+ * Revision 1.18  1997/01/24 13:13:13  adam
+ * Implemnted egw_source and added a "raw" option to the URL.
+ * Fixed a bug in the buffering system of wproto; the macro wo_putc could
+ * override memory if it was the first HTML generating function called.
+ *
  * Revision 1.17  1996/05/31 08:02:56  adam
  * Bug fix: egw_enc encoded '/' - it shouldn't.
  *
@@ -138,6 +143,8 @@ struct tcl_info {
     WCLIENT wcl;
 };
 
+static int exec_file (const char *fname, struct tcl_info *p);
+
 Tcl_Interp *w_interp_tcl_get (W_Interp w_interp)
 {
     struct tcl_info *p;
@@ -369,6 +376,35 @@ static int proc_prog (ClientData clientData, Tcl_Interp *interp,
     return TCL_OK;
 }
 
+static int proc_source (ClientData clientData, Tcl_Interp *interp,
+                        int argc, char **argv)
+{
+    struct tcl_info *p = (struct tcl_info*) clientData;
+    int r;
+
+    if (argc != 2)
+    {
+        Tcl_AppendResult (p->interp,
+                          "wrong # args: should be egw_source file", NULL);
+        return TCL_ERROR;
+    }
+    r = exec_file (argv[1], p);
+    if (r == -2)
+    {
+        Tcl_AppendResult (p->interp, "egw_source: couldn't source ",
+                         argv[1], NULL);
+        return TCL_ERROR;
+    }
+    else if (r == -1)
+    {
+        Tcl_AppendResult (p->interp, "egw_source: Tcl error in script ",
+                         argv[1], NULL);
+        return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+
 int Tcl_AppInit (Tcl_Interp *interp)
 {
     if (Tcl_Init (interp) == TCL_ERROR)
@@ -408,6 +444,7 @@ static void *do_create (WCLIENT wcl, void *args)
     Tcl_CreateCommand (p->interp, "egw_enc", proc_enc, p, NULL);
     Tcl_CreateCommand (p->interp, "egw_dec", proc_dec, p, NULL);
     Tcl_CreateCommand (p->interp, "egw_prog", proc_prog, p, NULL);
+    Tcl_CreateCommand (p->interp, "egw_source", proc_source, p, NULL);
     sprintf (tmp_str, "%d", wcl->id);
     Tcl_SetVar (p->interp, "sessionId", tmp_str, TCL_GLOBAL_ONLY);
     return p;
@@ -424,8 +461,8 @@ static void report_error (struct tcl_info *p, int errorLine,
     wo_printf (p->wcl, "<xmp>\n%s</xmp>\n<hr>\n", msg);
 }
 
-static int tcl_exec (const char *fname, char *parms,
-                     struct tcl_info *p, FILE *inf, int *lineno)
+static int tcl_exec (const char *fname, struct tcl_info *p, FILE *inf,
+                     int *lineno)
 {
     int c, escape = 0, level = 0;
     int r, fbuf_ptr = 0;
@@ -487,9 +524,8 @@ static int tcl_exec (const char *fname, char *parms,
     return r;
 }
 
-static int do_exec (const char *fname, char *parms, void *mydata)
+static int exec_file (const char *fname, struct tcl_info *p)
 {
-    struct tcl_info *p = mydata;
     int c, escape = 0;
     int lineno = 1;
     FILE *inf = fopen (fname, "r");
@@ -500,7 +536,6 @@ static int do_exec (const char *fname, char *parms, void *mydata)
         gw_log (GW_LOG_WARN|GW_LOG_ERRNO, mod, "open %s", fname);
         return -1;
     }
-    Tcl_SetVar (p->interp, "sessionParms", parms, TCL_GLOBAL_ONLY);
     while ((c = getc(inf)) != EOF)
     {
         if (c == '\\')
@@ -511,7 +546,7 @@ static int do_exec (const char *fname, char *parms, void *mydata)
                 wo_putc (p->wcl, c);
             else
             {
-                int r = tcl_exec (fname, parms, p, inf, &lineno);
+                int r = tcl_exec (fname, p, inf, &lineno);
                 if (r == TCL_RETURN)
                 {
                     fclose (inf);
@@ -537,6 +572,13 @@ static int do_exec (const char *fname, char *parms, void *mydata)
     return 0;
 }
 
+static int do_exec (const char *fname, char *parms, void *mydata)
+{
+    struct tcl_info *p = mydata;
+
+    Tcl_SetVar (p->interp, "sessionParms", parms, TCL_GLOBAL_ONLY);
+    return exec_file (fname, p);
+}
 
 static int do_load (char *parms, void *mydata)
 {