toxy alpha18 and pddp alpha2 (see notes.txt for toxy, pddp and shared)

svn path=/trunk/externals/miXed/; revision=3094

7 files changed, 302 insertions, 635 deletions

diff --git a/pddp/Makefile b/pddp/Makefile
index b65c310..fc022be 100644
--- a/pddp/Makefile
+++ b/pddp/Makefile
@@ -1,10 +1,2 @@
 ROOT_DIR = ..
-redefault: pddpboot default
-
-pddpboot: $(ROOT_DIR)/bin/pddpboot.tcl \
-	$(ROOT_DIR)/bin/pddpclient.tcl $(ROOT_DIR)/bin/pddpserver.tcl
-
-$(ROOT_DIR)/bin/%.tcl: %.tcl
-	cp $< $@
-
 include $(ROOT_DIR)/Makefile.common
diff --git a/pddp/build_counter b/pddp/build_counter
index ddd868f..627f0ec 100644
--- a/pddp/build_counter
+++ b/pddp/build_counter
@@ -1,7 +1,7 @@
 #define PDDP_VERSION "0.1"
 #define PDDP_RELEASE "alpha"
-#define PDDP_BUILD 1
+#define PDDP_BUILD 2
 
 #if 0
-PDDP_SNAPSHOT = 0.1-alpha1
+PDDP_SNAPSHOT = 0.1-alpha2
 #endif
diff --git a/pddp/notes.txt b/pddp/notes.txt
index e156fe1..168f51e 100644
--- a/pddp/notes.txt
+++ b/pddp/notes.txt
@@ -1,10 +1,25 @@
 TODO for pddp
   * pddplink:
     . standardize server's root directory (use $help_directory from pd.tk?)
-    . nonboxed version
 
 DONE for pddp
 
+alpha2
+  * loading tcl scripts through "package require pddp":
+    . storing them in an immediate subdirectory of the path of pddplink's binary
+    . storing a hand-crafted pkgIndex.tcl there
+    . pddplink's setup appends the path of its binary to tcl's "auto_path"
+  * pddpserver asks for auto-assigning its port first, then starts
+    incrementing from 32768
+  * pddplink's appearance controlled with creation options (an option switch
+    is any symbol starting from '-' followed by a letter)
+  * options currently recognized:
+    . "-box" (standard object box)
+    . "-text" followed by any number of non-option atoms (body text)
+  * nonboxed version (default) has a custom widgetbehavior, which is a thin
+    layer on top of the standard text widgetbehavior (using all rtext routines),
+    so that merging into core Pd, as a new object type, T_LINK, would be easy.
+
 alpha1
   * prototype versions of the external "pddplink" and two pd-gui extensions
     "pddpserver.tcl", "pddpclient.tcl"
diff --git a/pddp/pddpboot.tcl b/pddp/pddpboot.tcl
deleted file mode 100755
index 3cec684..0000000
--- a/pddp/pddpboot.tcl
+++ /dev/null
@@ -1,32 +0,0 @@
-#!/bin/sh
-# \
-exec tclsh "$0" -- "$@"
-
-# Synopsis
-#   test run:
-#     ./pddpboot.tcl [root [port [path]]]
-#   from Pd:
-#     source pddpboot.tcl
-#     ::pddp::srvUse root (or ::pddp::srvStart root [port])
-#     ::pddp::cliOpen path
-#     ... (more "::pddp::cliOpen" calls) ...
-#     ::pddp::srvStop
-
-if {[namespace exists ::pddp]} {  ;# created by pddplink's setup
-    puts stderr "Booting pddp"
-    set ::pddp::testrun 0
-} else {
-    puts stderr "Booting pddp, test run..."
-    namespace eval ::pddp { variable testrun 1 }
-}
-
-puts stderr "current directory: [pwd]"
-
-source pddpclient.tcl
-source pddpserver.tcl
-
-if {[info exists ::pddp::theDir]} {
-    puts stderr "restoring directory: $::pddp::theDir"
-    cd $::pddp::theDir
-    unset ::pddp::theDir
-}
diff --git a/pddp/pddpclient.tcl b/pddp/pddpclient.tcl
deleted file mode 100644
index 7633394..0000000
--- a/pddp/pddpclient.tcl
+++ /dev/null
@@ -1,82 +0,0 @@
-# pddpclient.tcl
-
-# Synopsis
-#   not to be run by itself (see pddpboot.tcl)
-
-if {![namespace exists ::pddp]} {
-    puts stderr "Error: invalid invocation of pddpclient (boot pddp first)"
-    puts stderr "exiting..."
-    exit 1
-}
-
-if {$::pddp::testrun} {  ;# true if sourced from standalone "pddpboot.tcl"
-    puts stderr "Loading pddpclient, test run..."
-    if {$argc > 3} {
-	set path [lindex $argv 3]
-	if {[string length $path]} {
-	    puts stderr "Scheduling \"$path\" for opening"
-	    after idle ::pddp::cliOpen $path
-	}
-	unset path
-    }
-} else {
-    puts stderr "Loading pddpclient"
-}
-
-namespace eval ::pddp {
-    variable theBrowserCommand
-
-    switch -- $::tcl_platform(platform) {
-	unix {
-	    switch -- $tcl_platform(os) {
-		Darwin {
-		    set theBrowserCommand "sh -c open %s"
-		}
-		Linux {
-		    foreach candidate \
-			{firefox mozilla galeon konqueror netscape lynx} {
-			set browser [lindex [auto_execok $candidate] 0]
-			if {[string length $browser]} {
-			    set theBrowserCommand "$browser %s &"
-			    break
-			}
-		    }
-		}
-	    }
-	}
-	windows {
-	    # should not this be just: [auto_execok start]?
-	    set theBrowserCommand \
-		"rundll32 url.dll,FileProtocolHandler file:%s &"
-	}
-    }
-}
-
-proc ::pddp::cliError {err} {
-    puts stderr "Error in pddpclient: $err"
-}
-
-proc ::pddp::cliOpen {path} {
-    if {[string first "://" $path] < 1} {
-	if {[info exists ::pddp::thePort]} {
-	    set path "http://localhost:$::pddp::thePort/$path"
-	} else {
-	    cliError "pddpserver not running"
-	    return
-	}
-    }
-    variable theBrowserCommand
-    if {[string length $theBrowserCommand]} {
-	set command [format $theBrowserCommand $path]
-	puts stderr "pddpclient: open $command"
-	if {[catch {eval [list exec] $command} err]} {
-	    if {[lindex $::errorCode 0] eq "CHILDSTATUS"} {
-		cliError "$err (child status [lindex $::errorCode 2])"
-	    } else {
-		cliError $err
-	    }
-	}
-    } else {
-	cliError "browser unavailable"
-    }
-}
diff --git a/pddp/pddplink.c b/pddp/pddplink.c
index d60a90a..d746bbd 100644
--- a/pddp/pddplink.c
+++ b/pddp/pddplink.c
@@ -2,6 +2,10 @@
  * For information on usage and redistribution, and for a DISCLAIMER OF ALL
  * WARRANTIES, see the file, "LICENSE.txt," in this distribution.  */
 
+/* This is a prototype of an active comment.  It might be replaced with
+   a new core object type, T_LINK (te_type bitfield would have to be
+   extended then). */
+
 #include <stdio.h>
 #include <string.h>
 #include "m_pd.h"
@@ -21,6 +25,10 @@ typedef struct _pddplink
     t_object   x_ob;
     t_glist   *x_glist;
     int        x_isboxed;
+    char      *x_vistext;
+    int        x_vissize;
+    int        x_vislength;
+    int        x_rtextactive;
     t_symbol  *x_dirsym;
     t_symbol  *x_ulink;
     t_atom     x_openargs[2];
@@ -29,6 +37,117 @@ typedef struct _pddplink
 } t_pddplink;
 
 static t_class *pddplink_class;
+static t_class *pddplinkbox_class;
+
+/* Code that might be merged back to g_text.c starts here: */
+
+static void pddplink_getrect(t_gobj *z, t_glist *glist,
+			     int *xp1, int *yp1, int *xp2, int *yp2)
+{
+    t_pddplink *x = (t_pddplink *)z;
+    int width, height;
+    float x1, y1, x2, y2;
+    if (glist->gl_editor && glist->gl_editor->e_rtext)
+    {
+	if (x->x_rtextactive)
+	{
+	    t_rtext *y = glist_findrtext(glist, (t_text *)x);
+	    width = rtext_width(y);
+	    height = rtext_height(y) - 2;
+	}
+	else
+	{
+	    int font = glist_getfont(glist);
+	    width = x->x_vislength * sys_fontwidth(font) + 2;
+	    height = sys_fontheight(font) + 2;
+	}
+    }
+    else width = height = 10;
+    x1 = text_xpix((t_text *)x, glist);
+    y1 = text_ypix((t_text *)x, glist);
+    x2 = x1 + width;
+    y2 = y1 + height;
+    y1 += 1;
+    *xp1 = x1;
+    *yp1 = y1;
+    *xp2 = x2;
+    *yp2 = y2;
+}
+
+static void pddplink_displace(t_gobj *z, t_glist *glist, int dx, int dy)
+{
+    t_text *t = (t_text *)z;
+    t->te_xpix += dx;
+    t->te_ypix += dy;
+    if (glist_isvisible(glist))
+    {
+        t_rtext *y = glist_findrtext(glist, t);
+        rtext_displace(y, dx, dy);
+    }
+}
+
+static void pddplink_select(t_gobj *z, t_glist *glist, int state)
+{
+    t_pddplink *x = (t_pddplink *)z;
+    t_rtext *y = glist_findrtext(glist, (t_text *)x);
+    rtext_select(y, state);
+    if (glist_isvisible(glist) && glist->gl_havewindow)
+    {
+	if (state)
+	    sys_vgui(".x%lx.c itemconfigure %s -fill blue\n",
+		     glist, rtext_gettag(y));
+	else
+	    sys_vgui(".x%lx.c itemconfigure %s -text {%s} -fill magenta\n",
+		     glist, rtext_gettag(y), x->x_vistext);
+    }
+}
+
+static void pddplink_activate(t_gobj *z, t_glist *glist, int state)
+{
+    t_pddplink *x = (t_pddplink *)z;
+    t_rtext *y = glist_findrtext(glist, (t_text *)x);
+    rtext_activate(y, state);
+    x->x_rtextactive = state;
+}
+
+static void pddplink_vis(t_gobj *z, t_glist *glist, int vis)
+{
+    t_pddplink *x = (t_pddplink *)z;
+    if (vis)
+    {
+        if (glist->gl_havewindow)
+        {
+            t_rtext *y = glist_findrtext(glist, (t_text *)x);
+            rtext_draw(y);
+	    sys_vgui(".x%lx.c itemconfigure %s -text {%s} -fill magenta\n",
+		     glist, rtext_gettag(y), x->x_vistext);
+        }
+    }
+    else
+    {
+        if (glist->gl_havewindow)
+	{
+	    t_rtext *y = glist_findrtext(glist, (t_text *)x);
+            rtext_erase(y);
+	}
+    }
+}
+
+static int pddplink_wbclick(t_gobj *z, t_glist *glist, int xpix, int ypix,
+			    int shift, int alt, int dbl, int doit);
+
+static t_widgetbehavior pddplink_widgetbehavior =
+{
+    pddplink_getrect,
+    pddplink_displace,
+    pddplink_select,
+    pddplink_activate,
+    0,
+    pddplink_vis,
+    pddplink_wbclick,
+};
+
+/* Code that might be merged back to g_text.c ends here. */
 
 /* FIXME need access to glob_pdobject... */
 static t_pd *pddplink_pdtarget(t_pddplink *x)
@@ -66,6 +185,98 @@ static void pddplink_click(t_pddplink *x, t_floatarg xpos, t_floatarg ypos,
     x->x_ishit = 0;
 }
 
+static int pddplink_wbclick(t_gobj *z, t_glist *glist, int xpix, int ypix,
+			    int shift, int alt, int dbl, int doit)
+{
+    if (doit)
+	pddplink_click((t_pddplink *)z, (t_floatarg)xpix, (t_floatarg)ypix,
+		       (t_floatarg)shift, 0, (t_floatarg)alt);
+    return (1);
+}
+
+static int pddplink_isoption(char *name)
+{
+    if (*name == '-')
+    {
+	char c = name[1];
+	return ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
+    }
+    else return (0);
+}
+
+static t_symbol *pddplink_nextsymbol(int ac, t_atom *av, int opt, int *skipp)
+{
+    int ndx;
+    for (ndx = 0; ndx < ac; ndx++, av++)
+    {
+	if (av->a_type == A_SYMBOL &&
+	    (!opt || pddplink_isoption(av->a_w.w_symbol->s_name)))
+	{
+	    *skipp = ++ndx;
+	    return (av->a_w.w_symbol);
+	}
+    }
+    return (0);
+}
+
+static int pddplink_dooptext(char *dst, int maxsize, int ac, t_atom *av)
+{
+    int i, sz, sep, len;
+    char buf[32], *src;
+    for (i = 0, sz = 0, sep = 0; i < ac; i++, av++)
+    {
+	if (sep)
+	{
+	    sz++;
+	    if (sz >= maxsize)
+		break;
+	    else if (dst)
+	    {
+		*dst++ = ' ';
+		*dst = 0;
+	    }
+	}
+	else sep = 1;
+	if (av->a_type == A_SYMBOL)
+	    src = av->a_w.w_symbol->s_name;
+	else if (av->a_type == A_FLOAT)
+	{
+	    src = buf;
+	    sprintf(src, "%g", av->a_w.w_float);
+	}
+	else
+	{
+	    sep = 0;
+	    continue;
+	}
+	len = strlen(src);
+	sz += len;
+	if (sz >= maxsize)
+	    break;
+	else if (dst)
+	{
+	    strcpy(dst, src);
+	    dst += len;
+	}
+    }
+    return (sz);
+}
+
+static char *pddplink_optext(int *sizep, int ac, t_atom *av)
+{
+    char *result;
+    int sz = pddplink_dooptext(0, MAXPDSTRING, ac, av);
+    *sizep = sz + (sz >= MAXPDSTRING ? 4 : 1);
+    result = getbytes(*sizep);
+    pddplink_dooptext(result, sz + 1, ac, av);
+    if (sz >= MAXPDSTRING)
+    {
+	sz = strlen(result);
+	strcpy(result + sz, "...");
+    }
+    return (result);
+}
+
 #ifdef PDDPLINK_DEBUG
 static void pddplink_debug(t_pddplink *x)
 {
@@ -74,36 +285,77 @@ static void pddplink_debug(t_pddplink *x)
 
 static void pddplink_free(t_pddplink *x)
 {
+    if (x->x_vistext)
+	freebytes(x->x_vistext, x->x_vissize);
 }
 
-static void *pddplink_new(t_symbol *s1, t_symbol *s2)
+static void *pddplink_new(t_symbol *s, int ac, t_atom *av)
 {
-    t_pddplink *x = (t_pddplink *)pd_new(pddplink_class);
-    t_symbol *dirsym;
-    x->x_glist = canvas_getcurrent();
-    x->x_isboxed = (s2 == gensym("box"));
-    x->x_dirsym = canvas_getdir(x->x_glist);  /* FIXME */
-    if (!s1 || s1 == &s_)
+    t_pddplink xgen, *x;
+    int skip;
+    xgen.x_isboxed = 0;
+    xgen.x_vistext = 0;
+    xgen.x_vissize = 0;
+    if (xgen.x_ulink = pddplink_nextsymbol(ac, av, 0, &skip))
     {
-	x->x_linktype = PDDPLINK_HTML;
-	x->x_ulink = gensym("index.html");
+	t_symbol *opt;
+	ac -= skip;
+	av += skip;
+	while (opt = pddplink_nextsymbol(ac, av, 1, &skip))
+	{
+	    ac -= skip;
+	    av += skip;
+	    if (opt == gensym("-box"))
+		xgen.x_isboxed = 1;
+	    else if (opt == gensym("-text"))
+	    {
+		t_symbol *nextsym = pddplink_nextsymbol(ac, av, 1, &skip);
+		int natoms = (nextsym ? skip - 1 : ac);
+		if (natoms)
+		    xgen.x_vistext =
+			pddplink_optext(&xgen.x_vissize, natoms, av);
+	    }
+	}
     }
-    else
+    x = (t_pddplink *)
+	pd_new(xgen.x_isboxed ? pddplinkbox_class : pddplink_class);
+    x->x_glist = canvas_getcurrent();
+    x->x_dirsym = canvas_getdir(x->x_glist);  /* FIXME */
+
+    x->x_isboxed = xgen.x_isboxed;
+    x->x_vistext = xgen.x_vistext;
+    x->x_vissize = xgen.x_vissize;
+    x->x_vislength = (x->x_vistext ? strlen(x->x_vistext) : 0);
+    x->x_rtextactive = 0;
+    if (xgen.x_ulink)
     {
-	int len = strlen(s1->s_name);
-	if (len > 3 && !strcmp(s1->s_name + len - 3, ".pd"))
+	int len = strlen(xgen.x_ulink->s_name);
+	if (len > 3 && !strcmp(xgen.x_ulink->s_name + len - 3, ".pd"))
 	    x->x_linktype = PDDPLINK_PD;
 	else
 	    x->x_linktype = PDDPLINK_HTML;
-	x->x_ulink = s1;
+	x->x_ulink = xgen.x_ulink;
+    }
+    else
+    {
+	x->x_linktype = PDDPLINK_HTML;
+	x->x_ulink = gensym("index.html");
     }
     SETSYMBOL(&x->x_openargs[0], x->x_ulink);
     SETSYMBOL(&x->x_openargs[1], x->x_dirsym);
     x->x_ishit = 0;
     if (x->x_isboxed)
-    {
-	inlet_new((t_object *)x, (t_pd *)x, 0, 0);
 	outlet_new((t_object *)x, &s_anything);
+    else
+    {
+	/* do we need to set ((t_text *)x)->te_type = T_TEXT; ? */
+	if (!x->x_vistext)
+	{
+	    x->x_vislength = strlen(x->x_ulink->s_name);
+	    x->x_vissize = x->x_vislength + 1;
+	    x->x_vistext = getbytes(x->x_vissize);
+	    strcpy(x->x_vistext, x->x_ulink->s_name);
+	}
     }
     if (x->x_linktype == PDDPLINK_HTML)
 	sys_vgui("after 0 {::pddp::srvUse %s}\n", x->x_dirsym->s_name);
@@ -115,22 +367,34 @@ void pddplink_setup(void)
     t_symbol *dirsym;
     post("this is pddplink %s, %s %s build...",
 	 PDDP_VERSION, loud_ordinal(PDDP_BUILD), PDDP_RELEASE);
+
     pddplink_class = class_new(gensym("pddplink"),
 			       (t_newmethod)pddplink_new,
 			       (t_method)pddplink_free,
 			       sizeof(t_pddplink),
 			       CLASS_NOINLET | CLASS_PATCHABLE,
-			       A_DEFSYM, A_DEFSYM, 0);
+			       A_GIMME, 0);
     class_addanything(pddplink_class, pddplink_anything);
-    class_addmethod(pddplink_class, (t_method)pddplink_click,
+    class_setwidget(pddplink_class, &pddplink_widgetbehavior);
+
+    pddplinkbox_class = class_new(gensym("pddplink"), 0,
+				  (t_method)pddplink_free,
+				  sizeof(t_pddplink), 0, A_GIMME, 0);
+    class_addanything(pddplinkbox_class, pddplink_anything);
+    class_addmethod(pddplinkbox_class, (t_method)pddplink_click,
 		    gensym("click"),
 		    A_FLOAT, A_FLOAT, A_FLOAT, A_FLOAT, A_FLOAT, 0);
+
 #ifdef PDDPLINK_DEBUG
     class_addmethod(pddplink_class, (t_method)pddplink_debug,
 		    gensym("debug"), 0);
+    class_addmethod(pddplinkbox_class, (t_method)pddplink_debug,
+		    gensym("debug"), 0);
 #endif
+
     dirsym = pddplink_class->c_externdir;  /* FIXME */
-    sys_vgui("namespace eval ::pddp {variable theDir [pwd]}; cd %s\n",
-	     dirsym->s_name);
-    sys_gui("after 0 {source pddpboot.tcl}\n");
+    sys_vgui(
+	"if {[lsearch $auto_path \"%s\"] < 0} {lappend auto_path \"%s\"}\n",
+	dirsym->s_name, dirsym->s_name);
+    sys_gui("after 0 {package require pddp}\n");
 }
diff --git a/pddp/pddpserver.tcl b/pddp/pddpserver.tcl
deleted file mode 100644
index fe17948..0000000
--- a/pddp/pddpserver.tcl
+++ /dev/null
@@ -1,490 +0,0 @@
-# pddpserver.tcl
-
-# Synopsis
-#   not to be run by itself (see pddpboot.tcl)
-
-# based on:
-
-# Simple Sample httpd/1.[01] server
-# Stephen Uhler (c) 1996-1997 Sun Microsystems
-
-# http://cvs.sourceforge.net/viewcvs.py/tclhttpd/tclhttpd/bin/mini/mini1.1.tcl
-
-# modified by krzYszcz (2005):
-#   putting per-server data and all commands in a namespace "::pddp"
-#   supporting sourcing from within Pd, through the "pddpboot.tcl" wrapper
-#   inserting the .pd handler
-#   lots of other changes, too many to list here (run "diff" if curious...)
-
-if {![namespace exists ::pddp]} {
-    puts stderr "Error: invalid invocation of pddpserver (boot pddp first)"
-    puts stderr "exiting..."
-    exit 1
-}
-
-if {$::pddp::testrun} {  ;# true if sourced from standalone "pddpboot.tcl"
-    puts stderr "Loading pddpserver, test run..."
-    proc bgerror {msg} {
-	global errorInfo
-	puts stderr "bgerror: $msg\n$errorInfo"
-    }
-} else {
-    puts stderr "Loading pddpserver"
-    catch {console show}
-}
-
-namespace eval ::pddp {
-    variable thePort 8080
-    variable theState
-    variable theMimeTypes
-    variable theErrors
-    variable theErrorFormat
-
-    # "theState" contains the server state:
-    #  root:      the root of the document directory
-    #  default:   default document name
-    #  listen:    the main listening socket id
-    #  naccepts:  a count of accepted connections so far
-    #  maxtime:   the max time (msec) allowed to complete an http request
-    #  maxused:   the max # of requests for a socket
-    array set theState {
-	root       ""
-	default    index.html
-	listen     ""
-	naccepts   0
-	nrequests  0
-	nerrors    0
-	maxtime	   600000
-	maxused	   25
-	bufsize	   32768
-    }
-
-    set theState(root)  $env(HOME)
-
-    array set theMimeTypes {
-	{}      text/plain
-	.txt    text/plain
-	.html   text/html
-	.gif    image/gif
-	.jpg    image/jpeg
-	.pd     text/html
-    }
-
-    # HTTP/1.[01] error codes (the ones we use)
-    array set theErrors {
-	204 {No Content}
-	400 {Bad Request}
-	404 {Not Found}
-	405 {Method Not Allowed}
-	408 {Request Timeout}
-	411 {Length Required}
-	419 {Expectation Failed}
-	500 {Internal Server Error}
-	503 {Service Unavailable}
-	504 {Service Temporarily Unavailable}
-	505 {HTTP Version Not Supported}
-    }
-
-    # Generic error response
-    set theErrorFormat {
-	<title>Error: %1$s</title>
-	Got the error: <b>%2$s</b><br>
-	while trying to obtain <b>%3$s</b>
-    }
-}
-
-proc ::pddp::srvUse {{root {}} {port 8080}} {
-    variable theState
-    if {[string length $theState(listen)]} {
-	if {[string length $root] && ![string equal $root $theState(root)]} {
-	    srvLog $theState(listen) Warning "Redirection attempt for $root"
-	}
-    } else {
-	srvStart $root $port
-    }
-}
-
-# Start the server by listening for connections on the desired port.
-
-proc ::pddp::srvStart {{root {}} {port 8080}} {
-    variable thePort
-    variable theState
-
-    puts stderr "Starting pddp server on [info hostname]"
-    if {[string length $root]} {
-	set theState(root) $root
-    }
-    # we do not handle multiple pddpservers, LATER rethink
-    srvStop
-    array set theState [list naccepts 0 nrequests 0 nerrors 0]
-
-    for { set thePort $port } {$thePort < 32767 } {incr thePort } {
-	if {[catch {set theState(listen) \
-			[socket -server ::pddp::srvAccept $thePort]} res]} {
-	    if {$thePort == 0} {
-		# FIXME this is a critical error
-		set thePort 8080
-	    }
-        } else { break }
-    }
-    if {$thePort == 32767} {
-	srvLog none Error "Could not find port available for listening"
-    } else {
-	if {$thePort == 0} {
-	    set thePort [lindex [fconfigure $theState(listen) -sockname] 2]
-	}
-	srvLog $theState(listen) Port $thePort
-	srvLog $theState(listen) Root directory \"$root\"
-    }
-    after 120 update  ;# FIXME might be needed on windows they say, test there
-    return $thePort
-}
-
-proc ::pddp::srvStop {} {
-    variable thePort
-    variable theState
-    if {[string length $theState(listen)]} {
-	if {[catch {close $theState(listen)} res]} {
-	    srvLog $theState(listen) Warning [list $res while closing socket]
-	} else {
-	    srvLog $theState(listen) Closed.
-	}
-	set theState(listen) ""
-	update
-    }
-}
-
-# Accept a new connection from the server and set up a handler
-# to read the request from the client.
-
-proc ::pddp::srvAccept {sock ipaddr port} {
-    variable theState
-    variable theSockData$sock
-    # reject remote requests, LATER revisit
-    if {[string equal $ipaddr "127.0.0.1"]} {
-	incr theState(naccepts)
-	srvReset $sock $theState(maxused)
-	srvLog $sock Connect $ipaddr $port
-    } else {
-	srvLog $sock Warning "rejecting remote connection request from $ipaddr"
-	srvSockDone $sock 1
-    }
-}
-
-# Initialize or reset the socket state
-
-proc ::pddp::srvReset {sock nlft} {
-    variable theState
-    upvar 0 ::pddp::theSockData$sock sockData
-    array set sockData [list state start linemode 1 version 0 nleft $nlft]
-    set sockData(cancel) \
-	[after $theState(maxtime) [list srvTimeout $sock]]
-    fconfigure $sock -blocking 0 -buffersize $theState(bufsize) \
-	-translation {auto crlf}
-    fileevent $sock readable [list ::pddp::srvRead $sock]
-}
-
-# Read data from a client request
-# 1) read the request line
-# 2) read the mime headers
-# 3) read the additional data (if post && content-length not satisfied)
-
-proc ::pddp::srvRead {sock} {
-    variable theState
-    upvar 0 ::pddp::theSockData$sock sockData
-
-    # Use line mode to read the request and the mime headers
-
-    if {$sockData(linemode)} {
-	set readCount [gets $sock line]
-	set state [string compare $readCount 0],$sockData(state)
-	switch -glob -- $state {
-	    1,start {
-		if {[regexp {(HEAD|POST|GET) ([^?]+)\??([^ ]*) HTTP/1.([01])} \
-			 $line x sockData(proto) sockData(url) \
-			 sockData(query) sockData(version)]} {
-		    set sockData(state) mime
-		    incr theState(nrequests)
-		    srvLog $sock Request $sockData(nleft) $line
-		} else {
-		    srvError $sock 400 $line
-		}
-	    }
-	    0,start {
-		srvLog $sock Warning "Initial blank line fetching request"
-	    }
-	    1,mime {
-		if {[regexp {([^:]+):[ 	]*(.*)}  $line {} key value]} {
-		    set key [string tolower $key]
-		    set sockData(key) $key
-		    if {[info exists sockData(mime,$key)]} {
-			append sockData(mime,$key) ", $value"
-		    } else {
-			set sockData(mime,$key) $value
-		    }
-		} elseif {[regexp {^[ 	]+(.+)} $line {} value] && \
-			      [info exists sockData(key)]} {
-		    append sockData(mime,$sockData($key)) " " $value
-		} else {
-		    srvError $sock 400 $line
-		}
-	    }
-	    0,mime {
-	        if {$sockData(proto) == "POST" && \
-	        	[info exists sockData(mime,content-length)]} {
-		    set sockData(linemode) 0
-	            set sockData(count) $sockData(mime,content-length)
-	            if {$sockData(version) && \
-			    [info exists sockData(mime,expect)]} {
-			if {$sockData(mime,expect) == "100-continue"} {
-			    puts $sock "100 Continue HTTP/1.1\n"
-			    flush $sock
-			} else {
-			    srvError $sock 419 $sockData(mime,expect)
-			}
-		    }
-		    fconfigure $sock -translation {binary crlf}
-	        } elseif {$sockData(proto) != "POST"}  {
-		    srvRespond $sock
-	        } else {
-		    srvError $sock 411 "Confusing mime headers"
-	        }
-	    }
-	    -1,* {
-	    	if {[eof $sock]} {
-		    srvLog $sock Error "Broken connection fetching request"
-		    srvSockDone $sock 1
-	    	} else {
-	    	    puts stderr "Partial read, retrying"
-	    	}
-	    }
-	    default {
-		srvError $sock 404 "Invalid http state: $state,[eof $sock]"
-	    }
-	}
-
-    # Use counted mode to get the post data
-
-    } elseif {![eof $sock]} {
-        append sockData(postdata) [read $sock $sockData(count)]
-        set sockData(count) [expr {$sockData(mime,content-length) - \
-				       [string length $sockData(postdata)]}]
-        if {$sockData(count) == 0} {
-	    srvRespond $sock
-	}
-    } else {
-	srvLog $sock Error "Broken connection reading POST data"
-	srvSockDone $sock 1
-    }
-}
-
-# Done with the socket, either close it, or set up for next fetch
-#  sock:     The socket I'm done with
-#  doclose:  If true, close the socket, otherwise set up for reuse
-
-proc ::pddp::srvSockDone {sock doclose} {
-    variable theState
-    upvar 0 ::pddp::theSockData$sock sockData
-
-    after cancel $sockData(cancel)
-    set nleft [incr sockData(nleft) -1]
-    unset sockData
-    if {$doclose} {
-	close $sock
-    } else {
-	srvReset $sock $nleft
-    }
-    return ""
-}
-
-# A timeout happened
-
-proc ::pddp::srvTimeout {sock} {
-    srvError $sock 408
-}
-
-# FIXME test if "path" has its patch window already open...
-proc ::pddp::srvPdHandler {sock path} {
-    set dir [file dirname $path]
-    set tail [file tail $path]
-    if {[catch {pd [concat pd open $tail $dir \;]}]} {
-	srvError $sock 504
-    } else {
-	srvError $sock 204
-	# FIXME raise; focus (test on windows)
-    }
-}
-
-# Handle file system queries.  This is a place holder for a more
-# generic dispatch mechanism.
-
-proc ::pddp::srvRespond {sock} {
-    variable theState
-    variable theUrlCache
-    upvar 0 ::pddp::theSockData$sock sockData
-
-    regsub {(^http://[^/]+)?} $sockData(url) {} url
-    if {[info exists theUrlCache($url)]} {
-    	set mypath $theUrlCache($url)
-    } else {
-	set mypath [srvUrl2File $theState(root) $url]
-	if {[file isdirectory $mypath]} {
-	    append mypath / $theState(default)
-	}
-	set theUrlCache($url) $mypath
-    }
-    if {[string length $mypath] == 0} {
-	srvError $sock 400
-    } elseif {![file readable $mypath]} {
-	if {[string equal [file tail $mypath] "favicon.ico"]} {
-	    srvError $sock 204  ;# FIXME design something
-	} else {
-	    srvError $sock 404 $mypath
-	}
-    } else {
-	set ext [file extension $mypath]
-
-	if {[string equal $ext ".pd"]} {
-	    srvPdHandler $sock $mypath
-	    return
-	}
-
-	puts $sock "HTTP/1.$sockData(version) 200 Data follows"
-	puts $sock "Date: [srvGetDate [clock seconds]]"
-	puts $sock "Last-Modified: [srvGetDate [file mtime $mypath]]"
-	puts $sock "Content-Type: [srvContentType $ext]"
-	puts $sock "Content-Length: [file size $mypath]"
-
-	## Should also close socket if recvd connection close header
-	set doclose [expr {$sockData(nleft) == 0}]
-
-	if {$doclose} {
-	    puts $sock "Connection close:"
-	} elseif {$sockData(version) == 0 && \
-		      [info exists sockData(mime,connection)]} {
-	    if {$sockData(mime,connection) == "Keep-Alive"} {
-	        set doclose 0
-	        puts $sock "Connection: Keep-Alive"
-	    }
-	}
-	puts $sock ""
-	flush $sock
-
-	if {$sockData(proto) != "HEAD"} {
-	    set in [open $mypath]
-	    fconfigure $sock -translation binary
-	    fconfigure $in -translation binary
-	    fcopy $in $sock -command \
-		[list ::pddp::srvCopyDone $in $sock $doclose]
-	} else {
-	    srvSockDone $sock $doclose
-	}
-    }
-}
-
-# Callback when file is done being output to client
-#  in:       The fd for the file being copied
-#  sock:     The client socket
-#  doclose:  close the socket if true
-#  bytes:    The # of bytes copied
-#  error:    The error message (if any)
-
-proc ::pddp::srvCopyDone {in sock doclose bytes {error {}}} {
-    close $in
-    srvLog $sock Done $bytes bytes
-    srvSockDone $sock $doclose
-}
-
-# Convert the file suffix into a mime type.
-
-proc ::pddp::srvContentType {ext} {
-    variable theMimeTypes
-    set type text/plain
-    catch {set type $theMimeTypes($ext)}
-    return $type
-}
-
-# Respond with an error reply
-# sock:  The socket handle to the client
-# code:  The httpd error code
-# args:  Additional information for error logging
-
-proc ::pddp::srvError {sock code args} {
-    variable theState
-    variable theErrors
-    variable theErrorFormat
-    upvar 0 ::pddp::theSockData$sock sockData
-
-    append sockData(url) ""
-    incr theState(nerrors)
-    set message [format $theErrorFormat $code $theErrors($code) $sockData(url)]
-    append head "HTTP/1.$sockData(version) $code $theErrors($code)"  \n
-    append head "Date: [srvGetDate [clock seconds]]"  \n
-    append head "Connection: close"  \n
-    append head "Content-Length: [string length $message]"  \n
-
-    # Because there is an error condition, the socket may be "dead"
-
-    catch {
-	fconfigure $sock  -translation crlf
-	puts -nonewline $sock $head\n$message
-	flush $sock
-    } reason
-    srvSockDone $sock 1
-    if {$code < 300} {set status Status} else {set status Error}
-    srvLog $sock $status $code $theErrors($code) $args $reason
-}
-
-# Generate a date string in HTTP format.
-
-proc ::pddp::srvGetDate {seconds} {
-    return [clock format $seconds -format {%a, %d %b %Y %T %Z}]
-}
-
-# Log an Httpd transaction.
-# This should be replaced as needed.
-
-proc ::pddp::srvLog {sock args} {
-    puts stderr "pddp log ($sock): $args"
-}
-
-# Convert a url into a pathname. (UNIX version only)
-# This is probably not right, and belongs somewhere else.
-# - Remove leading http://... if any
-# - Collapse all /./ and /../ constructs
-# - expand %xx sequences -> disallow "/"'s  and "."'s due to expansions
-
-proc ::pddp::srvUrl2File {root url} {
-    regsub -all {//+} $url / url		;# collapse multiple /'s
-    while {[regsub -all {/\./} $url / url]} {}	;# collapse /./
-    while {[regsub -all {/\.\.(/|$)} $url /\x81\\1 url]} {} ;# mark /../
-    while {[regsub "/\[^/\x81]+/\x81/" $url / url]} {} ;# collapse /../
-    if {![regexp "\x81|%2\[eEfF]" $url]} {	;# invalid /../, / or . ?
-	return $root[srvCgiMap $url]
-    } else {
-	return ""
-    }
-}
-
-# Decode url-encoded strings.
-
-proc ::pddp::srvCgiMap {data} {
-    regsub -all {([][$\\])} $data {\\\1} data
-    regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data  {[format %c 0x\1]} data
-    return [subst $data]
-}
-
-if {$::pddp::testrun} {  ;# true if tested as a standalone script
-    if {$argc > 1} {
-	set root [lindex $argv 1]
-	set port [lindex $argv 2]
-	if {![string is integer -strict $port]} {
-	    set port 8080
-	}
-    } else {
-	set root $env(HOME)
-	set port 8080
-    }
-    ::pddp::srvStart $root $port
-    vwait forever
-}