many small improvements in toxy, plustot added

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

8 files changed, 670 insertions, 73 deletions

diff --git a/shared/getridof.baddeps b/shared/getridof.baddeps
index 37c56d5..9483b3b 100644
--- a/shared/getridof.baddeps
+++ b/shared/getridof.baddeps
@@ -1,7 +1,9 @@
 This is the list of all dependencies among miXed/shared objects.
 Some are inevitable, but others can, and should be removed.
 
+unstable/fragile -> common/loud
 unstable/fringe -> unstable/forky
+toxy/plusbob -> common/loud
 toxy/scriptlet -> common/loud, common/grow, common/props
 sickle/sic -> common/loud
 sickle/arsic -> common/loud, common/vefl, sickle/sic, unstable/fragile
diff --git a/shared/toxy/Makefile.sources b/shared/toxy/Makefile.sources
index 5f34f42..0613017 100644
--- a/shared/toxy/Makefile.sources
+++ b/shared/toxy/Makefile.sources
@@ -1,2 +1,3 @@
 OTHER_SOURCES = \
-scriptlet.c
+scriptlet.c \
+plusbob.c
diff --git a/shared/toxy/plusbob.c b/shared/toxy/plusbob.c
new file mode 100644
index 0000000..fb587cc
--- /dev/null
+++ b/shared/toxy/plusbob.c
@@ -0,0 +1,371 @@
+/* Copyright (c) 2003 krzYszcz and others.
+ * For information on usage and redistribution, and for a DISCLAIMER OF ALL
+ * WARRANTIES, see the file, "LICENSE.txt," in this distribution.  */
+
+#include <string.h>
+#include "m_pd.h"
+#include "common/loud.h"
+#include "plusbob.h"
+
+//#define PLUSBOB_DEBUG
+
+/* LATER let there be a choice of using either fake-symbols, or gpointers.
+   The gpointer layout would be such:  gs_un points to a plusbob-like
+   structure (without the bob_tag field), a unique integer code has to be
+   reserved for gs_which, the fields gp_un and gp_valid are ignored.
+   Using bob_refcount instead of gs_refcount is likely to simplify code. */
+
+/* Currently, objects of all +bob types are tagged with the same name: */
+static char plustag_name[] = "+bob";
+
+static void plustag_init(t_symbol *tag)
+{
+    tag->s_name = plustag_name;
+    tag->s_thing = 0;
+    tag->s_next = 0;
+}
+
+/* silent if caller is empty */
+int plustag_isvalid(t_symbol *tag, t_pd *caller)
+{
+    if (tag->s_name == plustag_name)
+	return (1);
+    else if (caller)
+    {
+	if (strcmp(tag->s_name, plustag_name))
+	    loud_error((caller == PLUSBOB_OWNER ? 0 : caller),
+ "does not understand '%s' (check object connections)", tag->s_name);
+	else
+	    loud_error((caller == PLUSBOB_OWNER ? 0 : caller), "confused...");
+    }
+    return (0);
+}
+
+/* +bob is an object tossed around, a bobbing object.  Currently, this is
+   a wrapping for Tcl_Interp, Tcl_Obj, or a tcl variable, but the +bob
+   interface is abstract enough to be suitable for other types of objects.
+   The t_plusbob is kind of a virtual base. */
+
+struct _plustype
+{
+    t_plustype   *tp_base;  /* empty, if directly derived from t_plusbob */
+    t_symbol     *tp_name;
+    size_t        tp_size;
+    /* constructor is to be called explicitly, from derived constructors,
+       or from a public wrapper. */
+    t_plustypefn  tp_deletefn;  /* destructor */
+    t_plustypefn  tp_preservefn;
+    t_plustypefn  tp_releasefn;
+    t_plustypefn  tp_attachfn;
+};
+
+static t_plustype *plustype_default = 0;
+
+t_plustype *plustype_new(t_plustype *base, t_symbol *name, size_t sz,
+			 t_plustypefn deletefn,
+			 t_plustypefn preservefn, t_plustypefn releasefn,
+			 t_plustypefn attachfn)
+{
+    t_plustype *tp = getbytes(sizeof(*tp));
+    tp->tp_base = base;
+    tp->tp_name = name;
+    tp->tp_size = sz;
+    tp->tp_deletefn = deletefn;
+    tp->tp_preservefn = preservefn;
+    tp->tp_releasefn = releasefn;
+    tp->tp_attachfn = attachfn;
+    return (tp);
+}
+
+static void plusbob_doattach(t_plusbob *bob, t_plusbob *parent)
+{
+    if (bob->bob_parent = parent)
+    {
+	/* become the youngest child: */
+	bob->bob_prev = 0;
+	if (bob->bob_next = parent->bob_children)
+	{
+	    if (parent->bob_children->bob_prev)
+		bug("plusbob_doattach 1");
+	    parent->bob_children->bob_prev = bob;
+	}
+	parent->bob_children = bob;
+    }
+    else bug("plusbob_doattach 2");
+}
+
+static void plusbob_dodetach(t_plusbob *bob)
+{
+    if (bob->bob_parent)
+    {
+	if (bob->bob_prev)
+	{
+	    if (bob == bob->bob_parent->bob_children)
+		bug("plusbob_dodetach 1");
+	    bob->bob_prev->bob_next = bob->bob_next;
+	}
+	if (bob->bob_next)
+	    bob->bob_next->bob_prev = bob->bob_prev;
+	if (bob == bob->bob_parent->bob_children)
+	    bob->bob_parent->bob_children = bob->bob_next;
+    }
+    else bug("plusbob_dodetach 2");
+}
+
+/* To be called from derived constructors.
+   Preserving is caller's responsibility. */
+t_plusbob *plusbob_create(t_plustype *tp, t_plusbob *parent)
+{
+    t_plusbob *bob;
+    if (!tp)
+    {
+	if (!plustype_default)
+	    plustype_default = plustype_new(0, 0, sizeof(t_plusbob),
+					    0, 0, 0, 0);
+	tp = plustype_default;
+    }
+    if (bob = getbytes(tp->tp_size))
+    {
+	plustag_init(&bob->bob_tag);
+	bob->bob_type = tp;
+	while (tp->tp_base) tp = tp->tp_base;
+	bob->bob_root = tp;
+	bob->bob_owner = 0;
+	bob->bob_refcount = 0;
+	bob->bob_dorefcount = 1;
+	bob->bob_children = 0;
+	if (parent)
+	    plusbob_doattach(bob, parent);
+	else
+	    bob->bob_parent = 0;
+    }
+    return (bob);
+}
+
+/* Should never be called, but from plusbob_release().
+   Calling from a derived destructor is illegal. */
+static void plusbob_free(t_plusbob *bob)
+{
+    t_plustype *tp;
+    if (bob->bob_parent)
+	plusbob_dodetach(bob);
+    for (tp = bob->bob_type; tp; tp = tp->tp_base)
+	if (tp->tp_deletefn) (*tp->tp_deletefn)(bob);
+    freebytes(bob, (bob->bob_type ? bob->bob_type->tp_size : sizeof(*bob)));
+}
+
+void plusbob_preserve(t_plusbob *bob)
+{
+    if (bob->bob_dorefcount)
+    {
+	t_plustype *tp;
+	for (tp = bob->bob_type; tp; tp = tp->tp_base)
+	    if (tp->tp_preservefn) (*tp->tp_preservefn)(bob);
+	bob->bob_refcount++;
+    }
+}
+
+void plusbob_release(t_plusbob *bob)
+{
+    if (bob->bob_dorefcount)
+    {
+	t_plustype *tp;
+	for (tp = bob->bob_type; tp; tp = tp->tp_base)
+	    if (tp->tp_releasefn) (*tp->tp_releasefn)(bob);
+	if (--bob->bob_refcount <= 0)
+	{
+	    if (bob->bob_refcount == 0)
+		plusbob_free(bob);
+	    else
+		bug("plusbob_release");
+	}
+    }
+}
+
+t_plusbob *plusbob_getparent(t_plusbob *bob)
+{
+    return (bob->bob_parent);
+}
+
+/* To be called for redirection only.  Bobs created as orphans are a special
+   case, and cannot be attached later on.  Likewise, changing non-orphan bobs
+   to orphans is illegal. */
+void plusbob_attach(t_plusbob *bob, t_plusbob *newparent)
+{
+    if (bob->bob_parent && newparent)
+    {
+	t_plustype *tp;
+	plusbob_dodetach(bob);
+	plusbob_doattach(bob, newparent);
+	for (tp = bob->bob_type; tp; tp = tp->tp_base)
+	    if (tp->tp_attachfn) (*tp->tp_attachfn)(bob);
+    }
+    else if (newparent)
+	bug("plusbob_attach 1");
+    else
+	bug("plusbob_attach 2");
+}
+
+t_plusbob *plusbob_getnext(t_plusbob *bob)
+{
+    return (bob->bob_next);
+}
+
+t_plusbob *plusbob_getchildren(t_plusbob *bob)
+{
+    return (bob->bob_children);
+}
+
+/* Redirect all bobs to a replacement parent.
+   Assuming replacement exists. */
+void plusbob_detachchildren(t_plusbob *bob, t_plusbob *newparent)
+{
+    while (bob->bob_children)
+	plusbob_attach(bob->bob_children, newparent);
+}
+
+void plusbob_detachownedchildren(t_plusbob *bob, t_plusbob *newparent,
+				 t_pd *owner)
+{
+    t_plusbob *child = bob->bob_children, *next;
+    while (child)
+    {
+	next = child->bob_next;
+	if (child->bob_owner == owner)
+	    plusbob_attach(child, newparent);
+	child = next;
+    }
+}
+
+void plusbob_setowner(t_plusbob *bob, t_pd *owner)
+{
+    bob->bob_owner = owner;
+}
+
+t_pd *plusbob_getowner(t_plusbob *bob)
+{
+    return (bob->bob_owner);
+}
+
+void outlet_plusbob(t_outlet *o, t_plusbob *bob)
+{
+    outlet_symbol(o, (t_symbol *)bob);
+}
+
+/* silent if caller is empty */
+int plustag_validtype(t_symbol *tag, t_symbol *tname, t_pd *caller)
+{
+    if (tag->s_name == plustag_name)
+    {
+	if (((t_plusbob *)tag)->bob_type->tp_name == tname)
+	    return (1);
+	else if (caller)
+	{
+	    t_symbol *s = ((t_plusbob *)tag)->bob_type->tp_name;
+	    loud_error((caller == PLUSBOB_OWNER ?
+			((t_plusbob *)tag)->bob_owner : caller),
+		       "invalid type '%s' ('%s' expected)",
+		       (s ? s->s_name : "<unknown>"),
+		       (tname ? tname->s_name : "<unknown>"));
+	}
+    }
+    else if (plustag_isvalid(tag, caller))  /* print the error there */
+	bug("plustag_validtype");
+    return (0);
+}
+
+/* silent if caller is empty */
+int plustag_validroot(t_symbol *tag, t_symbol *rname, t_pd *caller)
+{
+    if (tag->s_name == plustag_name)
+    {
+	if (((t_plusbob *)tag)->bob_root->tp_name == rname)
+	    return (1);
+	else if (caller)
+	{
+	    t_symbol *s = ((t_plusbob *)tag)->bob_root->tp_name;
+	    loud_error((caller == PLUSBOB_OWNER ?
+			((t_plusbob *)tag)->bob_owner : caller),
+		       "invalid base type '%s' ('%s' expected)",
+		       (s ? s->s_name : "<unknown>"),
+		       (rname ? rname->s_name : "<unknown>"));
+	}
+    }
+    else if (plustag_isvalid(tag, caller))  /* print the error there */
+	bug("plustag_validroot");
+    return (0);
+}
+
+t_symbol *plustag_typename(t_symbol *tag, int validate, t_pd *caller)
+{
+    if (!validate || tag->s_name == plustag_name)
+	return (((t_plusbob *)tag)->bob_type->tp_name);
+    else if (plustag_isvalid(tag, caller))  /* print the error there */
+	bug("plustag_typename");
+    return (0);
+}
+
+t_symbol *plustag_rootname(t_symbol *tag, int validate, t_pd *caller)
+{
+    if (!validate || tag->s_name == plustag_name)
+	return (((t_plusbob *)tag)->bob_root->tp_name);
+    else if (plustag_isvalid(tag, caller))  /* print the error there */
+	bug("plustag_rootname");
+    return (0);
+}
+
+/* Plusenv (aka +env) is the base for an `environment' +bob.  Environment
+   encapsulates data common for a collection of +bobs.  This is the standard
+   way of grouping +bobs, according to a parent/children relationship. */
+
+static t_plustype *plusenv_type = 0;
+static t_plusbob *plusenv_parent = 0;  /* the parent of all environments */
+
+/* To be called from derived constructors (or, LATER, plusenv's provider). */
+t_plusenv *plusenv_create(t_plustype *tp, t_plusbob *parent, t_symbol *id)
+{
+    t_plusenv *env = 0;
+    if (env = (t_plusenv *)plusbob_create(tp, parent))
+    {
+	if (!id)
+	    /* LATER design a public interface for bob_dorefcount */
+	    ((t_plusbob *)env)->bob_dorefcount = 0;
+	env->env_id = id;  /* LATER rethink */
+    }
+    return (env);
+}
+
+t_plusenv *plusenv_find(t_symbol *id, t_plusenv *defenv)
+{
+    if (plusenv_parent && id)
+    {
+	t_plusbob *bob;
+	for (bob = plusenv_parent->bob_children; bob; bob = bob->bob_next)
+	    if (((t_plusenv *)bob)->env_id == id)
+		break;
+	return ((t_plusenv *)bob);
+    }
+    else return (defenv);
+}
+
+t_symbol *plusenv_getid(t_plusenv *env)
+{
+    return (env->env_id);
+}
+
+/* Type ignored, LATER rethink. */
+t_plusbob *plusenv_getparent(t_plustype *tp)
+{
+    if (!plusenv_parent) plusenv_parent = plusbob_create(0, 0);
+    return (plusenv_parent);
+}
+
+t_plustype *plusenv_setup(void)
+{
+    if (!plusenv_type)
+    {
+	plusenv_type = plustype_new(0, gensym("+env"),
+				    sizeof(t_plusenv), 0, 0, 0, 0);
+    }
+    return (plusenv_type);
+}
diff --git a/shared/toxy/plusbob.h b/shared/toxy/plusbob.h
new file mode 100644
index 0000000..bdfe356
--- /dev/null
+++ b/shared/toxy/plusbob.h
@@ -0,0 +1,71 @@
+/* Copyright (c) 2003 krzYszcz and others.
+ * For information on usage and redistribution, and for a DISCLAIMER OF ALL
+ * WARRANTIES, see the file, "LICENSE.txt," in this distribution.  */
+
+#ifndef __PLUSBOB_H__
+#define __PLUSBOB_H__
+
+EXTERN_STRUCT _plustype;
+#define t_plustype  struct _plustype
+EXTERN_STRUCT _plusbob;
+#define t_plusbob  struct _plusbob
+EXTERN_STRUCT _plusenv;
+#define t_plusenv  struct _plusenv
+
+struct _plusbob
+{
+    t_symbol     bob_tag;   /* common value for all bob types */
+    t_plustype  *bob_type;  /* our type */
+    t_plustype  *bob_root;  /* our base type directly derived from t_plusbob */
+    t_pd        *bob_owner;
+    int          bob_refcount;
+    int          bob_dorefcount;
+    t_plusbob   *bob_children;  /* empty, unless we are a parent */
+    /* each bob has exactly one parent, unless being a special, `orphan' case */
+    t_plusbob   *bob_parent;
+    t_plusbob   *bob_prev;      /* younger brother */
+    t_plusbob   *bob_next;      /* older sister */
+};
+
+struct _plusenv
+{
+    t_plusbob  env_bob;
+    t_symbol  *env_id;  /* LATER use local symbol namespace */
+};
+
+#define PLUSBOB_OWNER  ((t_pd *)-1)
+
+typedef void (*t_plustypefn)(void *);
+
+int plustag_isvalid(t_symbol *s, t_pd *caller);
+
+t_plustype *plustype_new(t_plustype *base, t_symbol *name, size_t sz,
+			 t_plustypefn deletefn,
+			 t_plustypefn preservefn, t_plustypefn releasefn,
+			 t_plustypefn attachfn);
+
+t_plusbob *plusbob_create(t_plustype *tp, t_plusbob *parent);
+void plusbob_preserve(t_plusbob *bob);
+void plusbob_release(t_plusbob *bob);
+t_plusbob *plusbob_getparent(t_plusbob *bob);
+void plusbob_attach(t_plusbob *bob, t_plusbob *newparent);
+t_plusbob *plusbob_getnext(t_plusbob *bob);
+t_plusbob *plusbob_getchildren(t_plusbob *bob);
+void plusbob_detachchildren(t_plusbob *bob, t_plusbob *newparent);
+void plusbob_detachownedchildren(t_plusbob *bob, t_plusbob *newparent,
+				 t_pd *owner);
+void plusbob_setowner(t_plusbob *bob, t_pd *owner);
+t_pd *plusbob_getowner(t_plusbob *bob);
+void outlet_plusbob(t_outlet *o, t_plusbob *bob);
+int plustag_validtype(t_symbol *tag, t_symbol *tname, t_pd *caller);
+int plustag_validroot(t_symbol *tag, t_symbol *rname, t_pd *caller);
+t_symbol *plustag_typename(t_symbol *tag, int validate, t_pd *caller);
+t_symbol *plustag_rootname(t_symbol *tag, int validate, t_pd *caller);
+
+t_plusenv *plusenv_create(t_plustype *tp, t_plusbob *parent, t_symbol *id);
+t_plusenv *plusenv_find(t_symbol *id, t_plusenv *defenv);
+t_symbol *plusenv_getid(t_plusenv *env);
+t_plusbob *plusenv_getparent(t_plustype *tp);
+t_plustype *plusenv_setup(void);
+
+#endif
diff --git a/shared/toxy/scriptlet.c b/shared/toxy/scriptlet.c
index e2f9883..635c106 100644
--- a/shared/toxy/scriptlet.c
+++ b/shared/toxy/scriptlet.c
@@ -28,14 +28,15 @@ enum { SCRIPTLET_CVOK, SCRIPTLET_CVUNKNOWN, SCRIPTLET_CVMISSING };
 
 struct _scriptlet
 {
-    t_pd               *s_owner;
-    t_glist            *s_glist;     /* containing glist (possibly null) */
-    t_symbol           *s_rptarget;  /* reply target */
-    t_symbol           *s_cbtarget;  /* callback target */
-    t_symbol           *s_item;
-    t_scriptlet_cvfn    s_cvfn;
-    t_canvas           *s_cv;
-    int                 s_cvstate;
+    t_pd             *s_owner;
+    t_glist          *s_glist;     /* containing glist (empty allowed) */
+    t_symbol         *s_rptarget;  /* reply target */
+    t_symbol         *s_cbtarget;  /* callback target */
+    t_symbol         *s_item;
+    t_scriptlet_cvfn  s_cvfn;      /* if empty, passing resolveall is a bug */
+    t_canvas         *s_cv;        /* as returned by cvfn */
+    int               s_cvstate;
+    int     s_locked;  /* append lock, for filtering, when reading from file */
     int     s_size;
     char   *s_buffer;
     char    s_bufini[SCRIPTLET_INISIZE];
@@ -83,7 +84,7 @@ static int scriptlet_ready(t_scriptlet *sp)
 
 static int scriptlet_doappend(t_scriptlet *sp, char *buf)
 {
-    if (buf)
+    if (buf && !sp->s_locked)
     {
 	int nprefix = sp->s_head - sp->s_buffer;
 	int nused = sp->s_tail - sp->s_buffer;
@@ -192,38 +193,68 @@ static char *scriptlet_dedot(t_scriptlet *sp, char *ibuf, char *obuf,
 	    len = 1;
 	}
 	break;
-    case '~':
+    case '~':  /* FIXME, the dot-tilde stuff is purely experimental. */
 	if (resolveall)
 	{
 	    t_canvas *cv;
 	    if (cv = scriptlet_canvasvalidate(sp, visedonly))
 	    {
-		/* FIXME */
-		if (!strcmp(&ibuf[1], "x1"))
+		if (!strncmp(&ibuf[1], "tag", 3))
+		{
+		    t_rtext *rt;
+		    if (cv->gl_owner && glist_isvisible(cv->gl_owner) &&
+			cv->gl_owner->gl_editor &&
+			(rt = glist_findrtext(cv->gl_owner, (t_object *)cv)))
+			sprintf(obuf, "%s", rtext_gettag(rt));
+		    else
+			obuf[0] = 0;
+		    len = 4;
+		}
+		else if (!strncmp(&ibuf[1], "owner", 5))
+		{
+		    if (cv->gl_owner && glist_isvisible(cv->gl_owner))
+			sprintf(obuf, ".x%x", (int)cv->gl_owner);
+		    else
+			obuf[0] = 0;
+		    len = 6;
+		}
+		else if (!strncmp(&ibuf[1], "root", 4))
+		{
+		    sprintf(obuf, ".x%x", (int)canvas_getrootfor(cv));
+		    len = 5;
+		}
+		/* LATER find out when gl_<coords> are updated,
+		   think how to better sync them to Tk. */
+		else if (!strncmp(&ibuf[1], "x1", 2))
 		{
 		    sprintf(obuf, "%d", cv->gl_screenx1);
 		    len = 3;
 		}
-		else if (!strcmp(&ibuf[1], "x2"))
+		else if (!strncmp(&ibuf[1], "x2", 2))
 		{
 		    sprintf(obuf, "%d", cv->gl_screenx2);
 		    len = 3;
 		}
-		else if (!strcmp(&ibuf[1], "y1"))
+		else if (!strncmp(&ibuf[1], "y1", 2))
 		{
 		    sprintf(obuf, "%d", cv->gl_screeny1);
 		    len = 3;
 		}
-		else if (!strcmp(&ibuf[1], "y2"))
+		else if (!strncmp(&ibuf[1], "y2", 2))
 		{
 		    sprintf(obuf, "%d", cv->gl_screeny2);
 		    len = 3;
 		}
-		else if (!strcmp(&ibuf[1], "edit"))
+		else if (!strncmp(&ibuf[1], "edit", 4))
 		{
 		    sprintf(obuf, "%d", cv->gl_edit);
 		    len = 5;
 		}
+		else if (!strncmp(&ibuf[1], "gop", 3))
+		{
+		    sprintf(obuf, "%d", glist_isgraph(cv));
+		    len = 4;
+		}
 		else loud_error(sp->s_owner, "bad field '%s'", &ibuf[1]);
 	    }
 	}
@@ -249,19 +280,17 @@ static char *scriptlet_dedot(t_scriptlet *sp, char *ibuf, char *obuf,
 	{
 	    if (ibuf[1] == ':')
 	    {
-		sprintf(obuf, "{::toxy::callback ");
+		sprintf(obuf, "{pd [concat ");
 		len = 2;
 	    }
 	    else if (ibuf[1] == '|')
 	    {
-		sprintf(obuf, "{::toxy::callback %s ",
-			sp->s_rptarget->s_name);
+		sprintf(obuf, "{pd [concat %s ", sp->s_rptarget->s_name);
 		len = 2;
 	    }
 	    else
 	    {
-		sprintf(obuf, "{::toxy::callback %s _cb ",
-			sp->s_cbtarget->s_name);
+		sprintf(obuf, "{pd [concat %s _cb ", sp->s_cbtarget->s_name);
 		len = 1;
 	    }
 	}
@@ -269,7 +298,7 @@ static char *scriptlet_dedot(t_scriptlet *sp, char *ibuf, char *obuf,
     case '>':
 	if (resolveall)
 	{
-	    sprintf(obuf, "}");
+	    sprintf(obuf, "\\;]}");
 	    len = 1;
 	}
 	break;
@@ -285,6 +314,7 @@ int scriptlet_isempty(t_scriptlet *sp)
 void scriptlet_reset(t_scriptlet *sp)
 {
     sp->s_cvstate = SCRIPTLET_CVUNKNOWN;
+    sp->s_locked = 0;
     sp->s_separator = 0;
     strcpy(sp->s_buffer, "namespace eval ::toxy {\
  proc query {} {set ::toxy::reply [\n");
@@ -400,7 +430,7 @@ void scriptlet_qpush(t_scriptlet *sp)
     }
 }
 
-/* Non-expanding -- LATER think if this is likely to cause any confusion.
+/* Non-substituting -- LATER think if this is likely to cause any confusion.
    Especially, consider the widget_vis() vs. widget_update() case. */
 void scriptlet_vpush(t_scriptlet *sp, char *varname)
 {
@@ -496,53 +526,86 @@ char *scriptlet_nextword(char *buf)
     return (0);
 }
 
-static int scriptlet_doread(t_scriptlet *sp, FILE *fp, char *rc,
-			    t_scriptlet_cmntfn cmntfn)
+static int scriptlet_doread(t_scriptlet *sp, t_pd *caller, FILE *fp,
+			    char *rc, char *builtin, t_scriptlet_cmntfn cmntfn)
 {
     t_scriptlet *outsp = sp, *newsp;
     char buf[MAXPDSTRING];
-    scriptlet_reset(outsp);
-    while (!feof(fp))
+    if (!caller) caller = sp->s_owner;
+    while ((fp && !feof(fp) && fgets(buf, MAXPDSTRING - 1, fp))
+	   || builtin)
     {
-	if (fgets(buf, MAXPDSTRING - 1, fp))
+	char *ptr;
+	if (builtin)
 	{
-	    char *ptr = buf;
-	    while (*ptr == ' ' || *ptr == '\t') ptr++;
-	    if (*ptr == '#')
+	    int i;
+	    for (i = 0, ptr = buf; i < MAXPDSTRING - 1; i++, ptr++)
 	    {
-		if (cmntfn)
+		if ((*ptr = (*builtin ? *builtin : '\n')) == '\n')
 		{
-		    char sel = *++ptr;
-		    if (sel && sel != '\n')
+		    ptr[1] = 0;
+		    if (*builtin) builtin++;
+		    if (!*builtin) builtin = 0;
+		    break;
+		}
+		else builtin++;
+	    }
+	}
+	ptr = buf;
+	while (*ptr == ' ' || *ptr == '\t') ptr++;
+	if (*ptr == '#')
+	{
+	    if (cmntfn)
+	    {
+		char sel = *++ptr;
+		if (sel && sel != '\n')
+		{
+		    ptr++;
+		    while (*ptr == ' ' || *ptr == '\t') ptr++;
+		    if (*ptr == '\n')
+			*ptr = 0;
+		    if (*ptr)
+		    {
+			char *ep = ptr + strlen(ptr) - 1;
+			while (*ep == ' ' || *ep == '\t' || *ep == '\n')
+			    ep--;
+			ep[1] = 0;
+		    }
+		    newsp = cmntfn(caller, rc, sel, ptr);
+		    if (newsp == SCRIPTLET_UNLOCK)
+			outsp->s_locked = 0;
+		    else if (newsp == SCRIPTLET_LOCK)
+			outsp->s_locked = 1;
+		    else if (newsp != outsp)
 		    {
-			ptr++;
-			while (*ptr == ' ' || *ptr == '\t') ptr++;
-			if (*ptr == '\n')
-			    *ptr = 0;
-			if (*ptr)
-			{
-			    char *ep = ptr + strlen(ptr) - 1;
-			    while (*ep == ' ' || *ep == '\t' || *ep == '\n')
-				ep--;
-			    ep[1] = 0;
-			}
-			newsp = cmntfn(sp->s_owner, rc, sel, ptr);
-			if (newsp && newsp != outsp)
-			    scriptlet_reset(outsp = newsp);
+			outsp->s_locked = 0;
+			scriptlet_reset(outsp = newsp);
 		    }
 		}
 	    }
-	    else if (*ptr && *ptr != '\n')
-		scriptlet_doappend(outsp, buf);
 	}
-	else break;
+	else if (*ptr && *ptr != '\n')
+	    scriptlet_doappend(outsp, buf);
     }
+    outsp->s_locked = 0;
     return (SCRIPTLET_OK);
 }
 
-int scriptlet_rcload(t_scriptlet *sp, char *rc, char *ext,
-		     t_scriptlet_cmntfn cmntfn)
+/* Load particular section(s) from buffer (skip up to an unlocking comment,
+   keep appending up to a locking comment, repeat). */
+int scriptlet_rcparse(t_scriptlet *sp, t_pd *caller, char *rc, char *contents,
+		      t_scriptlet_cmntfn cmntfn)
 {
+    int result;
+    sp->s_locked = 1;  /* see scriptlet_doread() above for unlocking scheme */
+    result = scriptlet_doread(sp, caller, 0, rc, contents, cmntfn);
+    return (result);
+}
+
+int scriptlet_rcload(t_scriptlet *sp, t_pd *caller, char *rc, char *ext,
+		     char *builtin, t_scriptlet_cmntfn cmntfn)
+{
+    int result;
     char filename[MAXPDSTRING], buf[MAXPDSTRING], *nameptr, *dir;
     int fd;
     if (sp->s_glist)
@@ -551,32 +614,41 @@ int scriptlet_rcload(t_scriptlet *sp, char *rc, char *ext,
 	dir = "";
     if ((fd = open_via_path(dir, rc, ext, buf, &nameptr, MAXPDSTRING, 0)) < 0)
     {
-    	return (SCRIPTLET_NOFILE);
+	result = SCRIPTLET_NOFILE;
     }
     else
     {
 	FILE *fp;
     	close(fd);
-	strcpy(filename, buf);
-	strcat(filename, "/");
-	strcat(filename, nameptr);
-	sys_bashfilename(filename, filename);
+	if (nameptr != buf)
+	{
+	    strcpy(filename, buf);
+	    strcat(filename, "/");
+	    strcat(filename, nameptr);
+	    sys_bashfilename(filename, filename);
+	}
+	else sys_bashfilename(nameptr, filename);
 	if (fp = fopen(filename, "r"))
 	{
-	    int result = scriptlet_doread(sp, fp, rc, cmntfn);
+	    result = scriptlet_doread(sp, caller, fp, rc, 0, cmntfn);
 	    fclose(fp);
-	    return (result);
 	}
 	else
 	{
 	    bug("scriptlet_rcload");
-	    return (SCRIPTLET_NOFILE);
+	    result = SCRIPTLET_NOFILE;
 	}
     }
+    if (result != SCRIPTLET_OK)
+    {
+	scriptlet_doread(sp, caller, 0, rc, builtin, cmntfn);
+    }
+    return (result);
 }
 
 int scriptlet_read(t_scriptlet *sp, t_symbol *fn)
 {
+    int result;
     FILE *fp;
     char buf[MAXPDSTRING];
     post("loading scriptlet file \"%s\"", fn->s_name);
@@ -587,15 +659,16 @@ int scriptlet_read(t_scriptlet *sp, t_symbol *fn)
     sys_bashfilename(buf, buf);
     if (fp = fopen(buf, "r"))
     {
-	int result = scriptlet_doread(sp, fp, 0, 0);
+	scriptlet_reset(sp);
+	result = scriptlet_doread(sp, 0, fp, 0, 0, 0);
 	fclose(fp);
-	return (result);
     }
     else
     {
 	loud_error(sp->s_owner, "error while loading file \"%s\"", fn->s_name);
-    	return (SCRIPTLET_NOFILE);
+    	result = SCRIPTLET_NOFILE;
     }
+    return (result);
 }
 
 int scriptlet_write(t_scriptlet *sp, t_symbol *fn)
@@ -640,11 +713,22 @@ char *scriptlet_getbuffer(t_scriptlet *sp, int *sizep)
     return (sp->s_buffer);
 }
 
+void scriptlet_setowner(t_scriptlet *sp, t_pd *owner)
+{
+    sp->s_owner = owner;
+}
+
 void scriptlet_clone(t_scriptlet *to, t_scriptlet *from)
 {
     scriptlet_reset(to);
     to->s_separator = ' ';
-    /* LATER use from's buffer with refcount */
+    /* LATER add a flag to optionally use from's buffer with refcount */
+    scriptlet_doappend(to, from->s_head);
+}
+
+void scriptlet_append(t_scriptlet *to, t_scriptlet *from)
+{
+    to->s_separator = ' ';
     scriptlet_doappend(to, from->s_head);
 }
 
@@ -658,8 +742,11 @@ void scriptlet_free(t_scriptlet *sp)
     }
 }
 
+/* The parameter 'gl' (null accepted) is necessary, because the 's_glist'
+   field, if implicitly set, would be dangerous (after a glist is gone)
+   and confusing (current directory used for i/o of a global scriptlet). */
 t_scriptlet *scriptlet_new(t_pd *owner, t_symbol *rptarget, t_symbol *cbtarget,
-			   t_symbol *item, t_scriptlet_cvfn cvfn)
+			   t_symbol *item, t_glist *gl, t_scriptlet_cvfn cvfn)
 {
     t_scriptlet *sp = getbytes(sizeof(*sp));
     if (sp)
@@ -667,12 +754,10 @@ t_scriptlet *scriptlet_new(t_pd *owner, t_symbol *rptarget, t_symbol *cbtarget,
 	static int configured = 0;
 	if (!configured)
 	{
-	    sys_gui("namespace eval ::toxy {\
- proc callback {args} {pd $args \\;}}\n");
 	    sys_gui("image create bitmap ::toxy::img::empty -data {}\n");
 	}
 	sp->s_owner = owner;
-	sp->s_glist = canvas_getcurrent();
+	sp->s_glist = gl;
 	sp->s_rptarget = rptarget;
 	sp->s_cbtarget = cbtarget;
 	sp->s_item = item;
diff --git a/shared/toxy/scriptlet.h b/shared/toxy/scriptlet.h
index 336d729..b284797 100644
--- a/shared/toxy/scriptlet.h
+++ b/shared/toxy/scriptlet.h
@@ -7,6 +7,8 @@
 
 enum { SCRIPTLET_OK = 0, SCRIPTLET_NOFILE, SCRIPTLET_BADFILE,
        SCRIPTLET_IGNORED };
+#define SCRIPTLET_UNLOCK  ((t_scriptlet *)0)
+#define SCRIPTLET_LOCK    ((t_scriptlet *)1)
 
 EXTERN_STRUCT _scriptlet;
 #define t_scriptlet  struct _scriptlet
@@ -30,15 +32,19 @@ void scriptlet_vpush(t_scriptlet *sp, char *varname);
 int scriptlet_evaluate(t_scriptlet *insp, t_scriptlet *outsp,
 		       int visedonly, int ac, t_atom *av, t_props *argprops);
 char *scriptlet_nextword(char *buf);
-int scriptlet_rcload(t_scriptlet *sp, char *rc, char *ext,
-		     t_scriptlet_cmntfn cmntfn);
+int scriptlet_rcparse(t_scriptlet *sp, t_pd *caller, char *rc, char *contents,
+		      t_scriptlet_cmntfn cmntfn);
+int scriptlet_rcload(t_scriptlet *sp, t_pd *caller, char *rc, char *ext,
+		     char *builtin, t_scriptlet_cmntfn cmntfn);
 int scriptlet_read(t_scriptlet *sp, t_symbol *fn);
 int scriptlet_write(t_scriptlet *sp, t_symbol *fn);
 char *scriptlet_getcontents(t_scriptlet *sp, int *lenp);
 char *scriptlet_getbuffer(t_scriptlet *sp, int *sizep);
+void scriptlet_setowner(t_scriptlet *sp, t_pd *owner);
 void scriptlet_clone(t_scriptlet *to, t_scriptlet *from);
+void scriptlet_append(t_scriptlet *to, t_scriptlet *from);
 void scriptlet_free(t_scriptlet *sp);
 t_scriptlet *scriptlet_new(t_pd *owner, t_symbol *rptarget, t_symbol *cbtarget,
-			   t_symbol *item, t_scriptlet_cvfn cvfn);
+			   t_symbol *item, t_glist *gl, t_scriptlet_cvfn cvfn);
 
 #endif
diff --git a/shared/unstable/fragile.c b/shared/unstable/fragile.c
index 2c9e8e3..b86fba8 100644
--- a/shared/unstable/fragile.c
+++ b/shared/unstable/fragile.c
@@ -6,6 +6,7 @@
 
 #include <string.h>
 #include "m_pd.h"
+#include "common/loud.h"
 #include "unstable/pd_imp.h"
 #include "unstable/fragile.h"
 
@@ -68,6 +69,61 @@ t_outconnect *fragile_outlet_connections(t_outlet *o)
     return (o ? o->o_connections : 0);
 }
 
+t_outconnect *fragile_outlet_nextconnection(t_outconnect *last,
+					    t_object **destp, int *innop)
+{
+    t_inlet *dummy;
+    return (obj_nexttraverseoutlet(last, destp, &dummy, innop));
+}
+
+/* silent, if caller is empty */
+t_object *fragile_outlet_destination(t_outlet *op,
+				     int ntypes, t_symbol **types,
+				     t_pd *caller, char *errand)
+{
+    t_object *booty = 0;
+    t_symbol *badtype = 0;
+    int count = 0;
+    t_outconnect *tobooty = fragile_outlet_connections(op);
+    while (tobooty)
+    {
+	t_object *ob;
+	int inno;
+	count++;
+	tobooty = fragile_outlet_nextconnection(tobooty, &ob, &inno);
+	if (ob && inno == 0)
+	{
+	    /* LATER ask for class_getname()'s symbol version */
+	    t_symbol **tp, *dsttype = gensym(class_getname(*(t_pd *)ob));
+	    int i;
+	    for (i = 0, tp = types; i < ntypes; i++, tp++)
+	    {
+		if (*tp == dsttype)
+		{
+		    booty = ob;
+		    break;
+		}
+		else badtype = dsttype;
+	    }
+	}
+    }
+    if (booty)
+    {
+	if (count > 1 && caller)
+	    loud_warning(caller, "multiple targets");
+    }
+    else if (caller)
+    {
+	if (badtype)
+	    loud_error(caller, "bad target type '%s'", badtype->s_name);
+	else
+	    loud_error(caller, "no target");
+	if (errand)
+	    loud_errand(caller, errand);
+    }
+    return (booty);
+}
+
 /* These are local to m_obj.c. */
 union inletunion
 {
diff --git a/shared/unstable/fragile.h b/shared/unstable/fragile.h
index 984fb0a..ad26384 100644
--- a/shared/unstable/fragile.h
+++ b/shared/unstable/fragile.h
@@ -9,6 +9,11 @@ int fragile_class_count(void);
 void fragile_class_printnames(char *msg, int firstndx, int lastndx);
 t_glist *fragile_garray_glist(void *arr);
 t_outconnect *fragile_outlet_connections(t_outlet *o);
+t_outconnect *fragile_outlet_nextconnection(t_outconnect *last,
+					    t_object **destp, int *innop);
+t_object *fragile_outlet_destination(t_outlet *op,
+				     int ntypes, t_symbol **types,
+				     t_pd *caller, char *errand);
 t_sample *fragile_inlet_signalscalar(t_inlet *i);
 
 #endif