merge trunk

26 files changed, 857 insertions, 341 deletions

diff --git a/ChangeLog b/ChangeLog
index e8cecb8..2166fb8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,32 @@
+2012-05-23  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclZlib.c (ZlibTransformInput): [Bug 3525907]: Ensure that
+	decompressed input is flushed through the transform correctly when the
+	input stream gets to the end. Thanks to Alexandre Ferrieux and Andreas
+	Kupries for their work on this.
+
+2012-05-21  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclFileName.c:	When using Tcl_SetObjLength() calls to grow
+	* generic/tclPathObj.c:	and shrink the objPtr->bytes buffer, care must be
+	taken that the value cannot possibly become pure Unicode.  Calling
+	Tcl_AppendToObj() has the possibility of making such a conversion.  Bug
+	found while valgrinding the trunk.
+
+2012-05-21  Jan Nijtmans  <nijtmans@users.sf.net>
+
+	* win/tclWinDde.c:      TIP #106: Add Encoding Abilities to the [dde]
+	* library/dde/pkgIndex.tcl:   Command. Dde version is now 1.4.0.
+	* tests/winDde.test:
+	* doc/dde.n:
+
+2012-05-20  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclOOBasic.c (TclOO_Class_Constructor): [Bug 2023112]: Cut
+	the amount of hackiness in class constructors, and refactor some of
+	the error message handling from [oo::define] to be saner in the face
+	of odd happenings.
+
 2012-05-17  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): [Bug 3106532]: Corrected
diff --git a/doc/dde.n b/doc/dde.n
index a02c582..60dd058 100644
--- a/doc/dde.n
+++ b/doc/dde.n
@@ -17,9 +17,11 @@ dde \- Execute a Dynamic Data Exchange command
 .sp
 \fBdde servername\fR ?\fB\-force\fR? ?\fB\-handler \fIproc\fR? ?\fB\-\|\-\fR? ?\fItopic\fR?
 .sp
-\fBdde execute\fR ?\fB\-async\fR? \fIservice topic data\fR
+.VS 8.6
+\fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR
 .sp
-\fBdde poke\fR \fIservice topic item data\fR
+\fBdde poke\fR ?\fB\-binary\fR? \fIservice topic item data\fR
+.VE 8.6
 .sp
 \fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR
 .sp
@@ -69,7 +71,7 @@ procedure is called with all the arguments provided by the remote
 call.
 .RE
 .TP
-\fBdde execute\fR ?\fB\-async\fR? \fIservice topic data\fR
+\fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR
 .
 \fBdde execute\fR takes the \fIdata\fR and sends it to the server indicated
 by \fIservice\fR with the topic indicated by \fItopic\fR. Typically,
@@ -80,8 +82,13 @@ script is run in the application.  The \fB\-async\fR option requests
 asynchronous invocation.  The command returns an error message if the
 script did not run, unless the \fB\-async\fR flag was used, in which case
 the command returns immediately with no error.
+.VS 8.6
+The \fB\-binary\fR option treats \fIdata\fR as binary data, otherwise an utf-8
+string is sent.  Combining \fB-binary\fR with the result of
+\fBencoding convertto\fR may be used to send data in arbitrary encodings.
+.VE 8.6
 .TP
-\fBdde poke \fIservice topic item data\fR
+\fBdde poke ?\fB\-binary\fR? \fIservice topic item data\fR
 .
 \fBdde poke\fR passes the \fIdata\fR to the server indicated by
 \fIservice\fR using the \fItopic\fR and \fIitem\fR specified.  Typically,
@@ -90,6 +97,10 @@ specific but can be a command to the server or the name of a file to work
 on.  The \fIitem\fR is also application specific and is often not used, but
 it must always be non-null.  The \fIdata\fR field is given to the remote
 application.
+.VS 8.6
+The \fB\-binary\fR option treats \fIdata\fR as binary data, otherwise an utf-8
+string is sent.
+.VE 8.6
 .TP
 \fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR
 .
@@ -168,3 +179,6 @@ package require dde
 tk(n), winfo(n), send(n)
 .SH KEYWORDS
 application, dde, name, remote execution
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 5048308..b130169 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -863,7 +863,7 @@ TclpNativeJoinPath(
 
 	if (length > 0 && (start[length-1] != '/')) {
 	    Tcl_AppendToObj(prefix, "/", 1);
-	    length++;
+	    Tcl_GetStringFromObj(prefix, &length);
 	}
 	needsSep = 0;
 
@@ -899,7 +899,7 @@ TclpNativeJoinPath(
 	if ((length > 0) &&
 		(start[length-1] != '/') && (start[length-1] != ':')) {
 	    Tcl_AppendToObj(prefix, "/", 1);
-	    length++;
+	    Tcl_GetStringFromObj(prefix, &length);
 	}
 	needsSep = 0;
 
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 2d31da3..938def2 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -934,8 +934,11 @@ TclChanPostEventObjCmd(
      * We have the channel and the events to post.
      */
 
+#ifdef TCL_THREADS
     if (rcPtr->owner == rcPtr->thread) {
+#endif
         Tcl_NotifyChannel (chan, events);
+#ifdef TCL_THREADS
     } else {
         ReflectEvent* ev = ckalloc (sizeof (ReflectEvent));
         ev->header.proc = ReflectEventRun;
@@ -965,6 +968,7 @@ TclChanPostEventObjCmd(
         Tcl_ThreadQueueEvent (rcPtr->owner, (Tcl_Event*) ev, TCL_QUEUE_TAIL);
         Tcl_ThreadAlert (rcPtr->owner);
     }
+#endif
 
     /*
      * Squash interp results left by the event script.
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 6c9a41b..fd25f2d 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -439,13 +439,6 @@ static const char *msg_dstlost =
  */
 
 /*
- * Number of milliseconds to wait before firing an event to try to flush out
- * information waiting in buffers (fileevent support).
- */
-
-#define FLUSH_DELAY	(5)
-
-/*
  * Helper functions encapsulating some of the thread forwarding to make the
  * control flow in callers easier.
  */
@@ -1230,7 +1223,7 @@ ReflectInput(
  *
  * ReflectOutput --
  *
- *	This function is invoked when data is writen to the channel.
+ *	This function is invoked when data is written to the channel.
  *
  * Results:
  *	The number of bytes actually written.
@@ -2861,7 +2854,7 @@ TimerSetup(
 	return;
     }
 
-    rtPtr->timer = Tcl_CreateTimerHandler(FLUSH_DELAY, TimerRun, rtPtr);
+    rtPtr->timer = Tcl_CreateTimerHandler(0, TimerRun, rtPtr);
 }
 
 /*
diff --git a/generic/tclOO.c b/generic/tclOO.c
index d5cc6e1..26e6d75 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -123,6 +123,16 @@ static const DeclaredClassMethod objMethods[] = {
 };
 
 /*
+ * And for the oo::class constructor...
+ */
+
+static const Tcl_MethodType classConstructor = {
+    TCL_OO_METHOD_VERSION_CURRENT,
+    "oo::class constructor",
+    TclOO_Class_Constructor, NULL, NULL
+};
+
+/*
  * Scripted parts of TclOO. First, the master script (cannot be outside this
  * file).
  */
@@ -135,18 +145,6 @@ static const char *initScript =
 /* " tcloo.tcl OO_LIBRARY oo::library;"; */
 
 /*
- * The body of the constructor for oo::class.
- */
-
-static const char *classConstructorBody =
-"set script [list ::oo::define [self] $definitionScript];"
-"lassign [::oo::UpCatch $script] msg opts;"
-"if {[dict get $opts -code] == 1} {"
-"    dict set opts -errorline 0xDeadBeef"
-"};"
-"return -options $opts $msg;";
-
-/*
  * The scripted part of the definitions of slots.
  */
 
@@ -340,12 +338,12 @@ InitFoundation(
     TclNewLiteralStringObj(fPtr->constructorName, "<constructor>");
     TclNewLiteralStringObj(fPtr->destructorName, "<destructor>");
     TclNewLiteralStringObj(fPtr->clonedName, "<cloned>");
+    TclNewLiteralStringObj(fPtr->defineName, "::oo::define");
     Tcl_IncrRefCount(fPtr->unknownMethodNameObj);
     Tcl_IncrRefCount(fPtr->constructorName);
     Tcl_IncrRefCount(fPtr->destructorName);
     Tcl_IncrRefCount(fPtr->clonedName);
-    Tcl_NRCreateCommand(interp, "::oo::UpCatch", TclOOUpcatchCmd,
-	    TclOONRUpcatch, NULL, NULL);
+    Tcl_IncrRefCount(fPtr->defineName);
     Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition",
 	    TclOOUnknownDefinition, NULL, NULL);
     TclNewLiteralStringObj(namePtr, "::oo::UnknownDefinition");
@@ -418,28 +416,19 @@ InitFoundation(
     bodyPtr = Tcl_NewStringObj(clonedBody, -1);
     TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr,
 	    bodyPtr, NULL);
-    Tcl_DecrRefCount(argsPtr);
+    TclDecrRefCount(argsPtr);
 
     /*
      * Finish setting up the class of classes by marking the 'new' method as
      * private; classes, unlike general objects, must have explicit names. We
      * also need to create the constructor for classes.
-     *
-     * The 0xDeadBeef is a special signal to the errorInfo logger that is used
-     * by constructors that stops it from generating extra error information
-     * that is confusing.
      */
 
     TclNewLiteralStringObj(namePtr, "new");
     Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
 	    namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);
-
-    TclNewLiteralStringObj(argsPtr, "{definitionScript {}}");
-    Tcl_IncrRefCount(argsPtr);
-    bodyPtr = Tcl_NewStringObj(classConstructorBody, -1);
-    fPtr->classCls->constructorPtr = TclOONewProcMethod(interp,
-	    fPtr->classCls, 0, NULL, argsPtr, bodyPtr, NULL);
-    Tcl_DecrRefCount(argsPtr);
+    fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp,
+	    (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);
 
     /*
      * Create non-object commands and plug ourselves into the Tcl [info]
@@ -529,10 +518,11 @@ KillFoundation(
 
     DelRef(fPtr->objectCls->thisPtr);
     DelRef(fPtr->objectCls);
-    Tcl_DecrRefCount(fPtr->unknownMethodNameObj);
-    Tcl_DecrRefCount(fPtr->constructorName);
-    Tcl_DecrRefCount(fPtr->destructorName);
-    Tcl_DecrRefCount(fPtr->clonedName);
+    TclDecrRefCount(fPtr->unknownMethodNameObj);
+    TclDecrRefCount(fPtr->constructorName);
+    TclDecrRefCount(fPtr->destructorName);
+    TclDecrRefCount(fPtr->clonedName);
+    TclDecrRefCount(fPtr->defineName);
     ckfree(fPtr);
 }
 
@@ -789,7 +779,7 @@ ObjectRenamedTrace(
 
     if (flags & TCL_TRACE_RENAME) {
 	if (oPtr->cachedNameObj) {
-	    Tcl_DecrRefCount(oPtr->cachedNameObj);
+	    TclDecrRefCount(oPtr->cachedNameObj);
 	    oPtr->cachedNameObj = NULL;
 	}
 	return;
@@ -1044,7 +1034,7 @@ ReleaseClassContents(
 	Tcl_Obj *filterObj;
 
 	FOREACH(filterObj, clsPtr->filters) {
-	    Tcl_DecrRefCount(filterObj);
+	    TclDecrRefCount(filterObj);
 	}
 	ckfree(clsPtr->filters.list);
 	clsPtr->filters.num = 0;
@@ -1123,7 +1113,7 @@ ObjectNamespaceDeleted(
     }
 
     FOREACH(filterObj, oPtr->filters) {
-	Tcl_DecrRefCount(filterObj);
+	TclDecrRefCount(filterObj);
     }
     if (i) {
 	ckfree(oPtr->filters.list);
@@ -1138,7 +1128,7 @@ ObjectNamespaceDeleted(
     }
 
     FOREACH(variableObj, oPtr->variables) {
-	Tcl_DecrRefCount(variableObj);
+	TclDecrRefCount(variableObj);
     }
     if (i) {
 	ckfree(oPtr->variables.list);
@@ -1149,7 +1139,7 @@ ObjectNamespaceDeleted(
     }
 
     if (oPtr->cachedNameObj) {
-	Tcl_DecrRefCount(oPtr->cachedNameObj);
+	TclDecrRefCount(oPtr->cachedNameObj);
 	oPtr->cachedNameObj = NULL;
     }
 
@@ -1180,7 +1170,7 @@ ObjectNamespaceDeleted(
 	}
 
 	FOREACH(filterObj, clsPtr->filters) {
-	    Tcl_DecrRefCount(filterObj);
+	    TclDecrRefCount(filterObj);
 	}
 	if (i) {
 	    ckfree(clsPtr->filters.list);
@@ -1225,7 +1215,7 @@ ObjectNamespaceDeleted(
 	TclOODelMethodRef(clsPtr->destructorPtr);
 
 	FOREACH(variableObj, clsPtr->variables) {
-	    Tcl_DecrRefCount(variableObj);
+	    TclDecrRefCount(variableObj);
 	}
 	if (i) {
 	    ckfree(clsPtr->variables.list);
@@ -2490,7 +2480,7 @@ TclOOObjectCmdCore(
 	result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr,
 		(Tcl_Class *) startClsPtr, mappedMethodName);
 	if (result != TCL_OK) {
-	    Tcl_DecrRefCount(mappedMethodName);
+	    TclDecrRefCount(mappedMethodName);
 	    if (result == TCL_BREAK) {
 		goto noMapping;
 	    } else if (result == TCL_ERROR) {
@@ -2506,7 +2496,7 @@ TclOOObjectCmdCore(
 	Tcl_IncrRefCount(mappedMethodName);
 	contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
 		flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
-	Tcl_DecrRefCount(mappedMethodName);
+	TclDecrRefCount(mappedMethodName);
 	if (contextPtr == NULL) {
 	    Tcl_AppendResult(interp, "impossible to invoke method \"",
 		    TclGetString(methodNamePtr),
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 329f0a4..5e983fc 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -19,6 +19,8 @@
 static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
 static int		AfterNRDestructor(ClientData data[],
 			    Tcl_Interp *interp, int result);
+static int		DecrRefsPostClassConstructor(ClientData data[],
+			    Tcl_Interp *interp, int result);
 static int		FinalizeConstruction(ClientData data[],
 			    Tcl_Interp *interp, int result);
 static int		FinalizeEval(ClientData data[],
@@ -70,6 +72,74 @@ FinalizeConstruction(
 /*
  * ----------------------------------------------------------------------
  *
+ * TclOO_Class_Constructor --
+ *
+ *	Implementation for oo::class constructor.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Class_Constructor(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
+    Tcl_Obj *invoke[3];
+
+    if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"?definitionScript?");
+	return TCL_ERROR;
+    } else if (objc == Tcl_ObjectContextSkippedArgs(context)) {
+	return TCL_OK;
+    }
+
+    /*
+     * Delegate to [oo::define] to do the work.
+     */
+
+    invoke[0] = oPtr->fPtr->defineName;
+    invoke[1] = TclOOObjectName(interp, oPtr);
+    invoke[2] = objv[objc-1];
+
+    /*
+     * Must add references or errors in configuration script will cause
+     * trouble.
+     */
+
+    Tcl_IncrRefCount(invoke[0]);
+    Tcl_IncrRefCount(invoke[1]);
+    Tcl_IncrRefCount(invoke[2]);
+    TclNRAddCallback(interp, DecrRefsPostClassConstructor,
+	    invoke[0], invoke[1], invoke[2], NULL);
+
+    /*
+     * Tricky point: do not want the extra reported level in the Tcl stack
+     * trace, so use TCL_EVAL_NOERR.
+     */
+
+    return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL);
+}
+
+static int
+DecrRefsPostClassConstructor(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    TclDecrRefCount((Tcl_Obj *) data[0]);
+    TclDecrRefCount((Tcl_Obj *) data[1]);
+    TclDecrRefCount((Tcl_Obj *) data[2]);
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
  * TclOO_Class_Create --
  *
  *	Implementation for oo::class->create method.
@@ -1141,74 +1211,6 @@ TclOOCopyObjectCmd(
 }
 
 /*
- * ----------------------------------------------------------------------
- *
- * TclOOUpcatchCmd --
- *
- *	Implementation of the [oo::UpCatch] command, which is a combination of
- *	[uplevel 1] and [catch] that makes it easier to write transparent
- *	error handling in scripts.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOUpcatchCmd(
-    ClientData ignored,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    return Tcl_NRCallObjProc(interp, TclOONRUpcatch, NULL, objc, objv);
-}
-
-static int
-UpcatchCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    CallFrame *savedFramePtr = data[0];
-    Tcl_Obj *resultObj[2];
-    int rewind = iPtr->execEnvPtr->rewind;
-
-    iPtr->varFramePtr = savedFramePtr;
-    if (rewind || Tcl_LimitExceeded(interp)) {
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"UpCatch\" body line %d)", Tcl_GetErrorLine(interp)));
-	return TCL_ERROR;
-    }
-    resultObj[0] = Tcl_GetObjResult(interp);
-    resultObj[1] = Tcl_GetReturnOptions(interp, result);
-    Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObj));
-    return TCL_OK;
-}
-
-int
-TclOONRUpcatch(
-    ClientData ignored,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Interp *iPtr = (Interp *) interp;
-    CallFrame *savedFramePtr = iPtr->varFramePtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "script");
-	return TCL_ERROR;
-    }
-    if (iPtr->varFramePtr->callerVarPtr != NULL) {
-	iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
-    }
-
-    Tcl_NRAddCallback(interp, UpcatchCallback, savedFramePtr, NULL,NULL,NULL);
-    return TclNREvalObjEx(interp, objv[1], TCL_EVAL_NOERR,
-	    iPtr->cmdFramePtr, 1);
-}
-
-/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 3d72690..69cffb0 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -17,6 +17,13 @@
 #include "tclOOInt.h"
 
 /*
+ * The maximum length of fully-qualified object name to use in an errorinfo
+ * message. Longer than this will be curtailed.
+ */
+
+#define OBJNAME_LENGTH_IN_ERRORINFO_LIMIT 30
+
+/*
  * Some things that make it easier to declare a slot.
  */
 
@@ -40,6 +47,8 @@ struct DeclaredSlot {
 static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
 static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
 			    Tcl_Namespace *const namespacePtr);
+static void		GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
+			    Tcl_Obj *savedNameObj, const char *typeOfSubject);
 static inline Class *	GetClassInOuterContext(Tcl_Interp *interp,
 			    Tcl_Obj *className, const char *errMsg);
 static inline int	InitDefineContext(Tcl_Interp *interp,
@@ -673,6 +682,7 @@ TclOOGetDefineCmdContext(
     Tcl_Interp *interp)
 {
     Interp *iPtr = (Interp *) interp;
+    Tcl_Object object;
 
     if ((iPtr->varFramePtr == NULL)
 	    || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
@@ -682,7 +692,14 @@ TclOOGetDefineCmdContext(
 	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
 	return NULL;
     }
-    return (Tcl_Object) iPtr->varFramePtr->clientData;
+    object = iPtr->varFramePtr->clientData;
+    if (Tcl_ObjectDeleted(object)) {
+	Tcl_AppendResult(interp, "this command cannot be called when the "
+		"object has been deleted", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return NULL;
+    }
+    return object;
 }
 
 /*
@@ -730,6 +747,44 @@ GetClassInOuterContext(
 /*
  * ----------------------------------------------------------------------
  *
+ * GenerateErrorInfo --
+ *	Factored out code to generate part of the error trace messages.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+GenerateErrorInfo(
+    Tcl_Interp *interp,		/* Where to store the error info trace. */
+    Object *oPtr,		/* What object (or class) was being configured
+				 * when the error occurred? */
+    Tcl_Obj *savedNameObj,	/* Name of object saved from before script was
+				 * evaluated, which is needed if the object
+				 * goes away part way through execution. OTOH,
+				 * if the object isn't deleted then its
+				 * current name (post-execution) has to be
+				 * used. This matters, because the object
+				 * could have been renamed... */
+    const char *typeOfSubject)	/* Part of the message, saying whether it was
+				 * an object, class or class-as-object that
+				 * was being configured. */
+{
+    int length;
+    Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
+	    ? savedNameObj : TclOOObjectName(interp, oPtr);
+    const char *objName = Tcl_GetStringFromObj(realNameObj, &length);
+    int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT;
+    int overflow = (length > limit);
+
+    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+	    "\n    (in definition script for %s \"%.*s%s\" line %d)",
+	    typeOfSubject, (overflow ? limit : length), objName,
+	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
  * TclOODefineObjCmd --
  *	Implementation of the "oo::define" command. Works by effectively doing
  *	the same as 'namespace eval', but with extra magic applied so that the
@@ -779,20 +834,15 @@ TclOODefineObjCmd(
 
     AddRef(oPtr);
     if (objc == 3) {
+	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+	Tcl_IncrRefCount(objNameObj);
 	result = TclEvalObjEx(interp, objv[2], 0,
 		((Interp *)interp)->cmdFramePtr, 2);
-
 	if (result == TCL_ERROR) {
-	    int length;
-	    const char *objName = Tcl_GetStringFromObj(objv[1], &length);
-	    int limit = 60;
-	    int overflow = (length > limit);
-
-	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		    "\n    (in definition script for object \"%.*s%s\" line %d)",
-		    (overflow ? limit : length), objName,
-		    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+	    GenerateErrorInfo(interp, oPtr, objNameObj, "class");
 	}
+	TclDecrRefCount(objNameObj);
     } else {
 	Tcl_Obj *objPtr, *obj2Ptr, **objs;
 	Interp *iPtr = (Interp *) interp;
@@ -898,20 +948,15 @@ TclOOObjDefObjCmd(
 
     AddRef(oPtr);
     if (objc == 3) {
+	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+	Tcl_IncrRefCount(objNameObj);
 	result = TclEvalObjEx(interp, objv[2], 0,
 		((Interp *)interp)->cmdFramePtr, 2);
-
 	if (result == TCL_ERROR) {
-	    int length;
-	    const char *objName = Tcl_GetStringFromObj(objv[1], &length);
-	    int limit = 60;
-	    int overflow = (length > limit);
-
-	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		    "\n    (in definition script for object \"%.*s%s\" line %d)",
-		    (overflow ? limit : length), objName,
-		    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+	    GenerateErrorInfo(interp, oPtr, objNameObj, "object");
 	}
+	TclDecrRefCount(objNameObj);
     } else {
 	Tcl_Obj *objPtr, *obj2Ptr, **objs;
 	Interp *iPtr = (Interp *) interp;
@@ -1017,21 +1062,15 @@ TclOODefineSelfObjCmd(
 
     AddRef(oPtr);
     if (objc == 2) {
+	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+	Tcl_IncrRefCount(objNameObj);
 	result = TclEvalObjEx(interp, objv[1], 0,
 		((Interp *)interp)->cmdFramePtr, 2);
-
 	if (result == TCL_ERROR) {
-	    int length;
-	    const char *objName = Tcl_GetStringFromObj(
-		    TclOOObjectName(interp, oPtr), &length);
-	    int limit = 60;
-	    int overflow = (length > limit);
-
-	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		    "\n    (in definition script for object \"%.*s%s\" line %d)",
-		    (overflow ? limit : length), objName,
-		    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+	    GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
 	}
+	TclDecrRefCount(objNameObj);
     } else {
 	Tcl_Obj *objPtr, *obj2Ptr, **objs;
 	Interp *iPtr = (Interp *) interp;
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 7988452..631961f 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -322,6 +322,7 @@ typedef struct Foundation {
 				 * destructor. */
     Tcl_Obj *clonedName;	/* Shared object containing the name of a
 				 * "<cloned>" pseudo-constructor. */
+    Tcl_Obj *defineName;	/* Fully qualified name of oo::define. */
 } Foundation;
 
 /*
@@ -453,6 +454,9 @@ MODULE_SCOPE int	TclOOSelfObjCmd(ClientData clientData,
  * Method implementations (in tclOOBasic.c).
  */
 
+MODULE_SCOPE int	TclOO_Class_Constructor(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
 MODULE_SCOPE int	TclOO_Class_Create(ClientData clientData,
 			    Tcl_Interp *interp, Tcl_ObjectContext context,
 			    int objc, Tcl_Obj *const *objv);
@@ -519,8 +523,6 @@ MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,
 			    Tcl_Obj *const *objv, int skip);
 MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
 			    const DeclaredClassMethod *dcm);
-MODULE_SCOPE int	TclOONRUpcatch(ClientData ignored, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
 MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
 MODULE_SCOPE void	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
 MODULE_SCOPE void	TclOORemoveFromMixinSubs(Class *subPtr,
@@ -532,9 +534,6 @@ MODULE_SCOPE Tcl_Obj *	TclOORenderCallChain(Tcl_Interp *interp,
 MODULE_SCOPE void	TclOOStashContext(Tcl_Obj *objPtr,
 			    CallContext *contextPtr);
 MODULE_SCOPE void	TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
-MODULE_SCOPE int	TclOOUpcatchCmd(ClientData ignored,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
 
 /*
  * Include all the private API, generated from tclOO.decls.
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 4e7edb8..877c3db 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -1204,15 +1204,6 @@ ConstructorErrorHandler(
     const char *objectName, *kindName;
     int objectNameLen;
 
-    if (Tcl_GetErrorLine(interp) == (int) 0xDEADBEEF) {
-	/*
-	 * Horrible hack to deal with certain constructors that must not add
-	 * information to the error trace.
-	 */
-
-	return;
-    }
-
     if (mPtr->declaringObjectPtr != NULL) {
 	declarerPtr = mPtr->declaringObjectPtr;
 	kindName = "object";
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 4f86755..2402128 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -1087,7 +1087,7 @@ TclJoinPath(
 
 	    if (length > 0 && ptr[length -1] != '/') {
 		Tcl_AppendToObj(res, &separator, 1);
-		length++;
+		Tcl_GetStringFromObj(res, &length);
 	    }
 	    Tcl_SetObjLength(res, length + (int) strlen(strElt));
 
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 356772e..3063b59 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -17,6 +17,7 @@
 #include "tclInt.h"
 #ifdef HAVE_ZLIB
 #include <zlib.h>
+#include "tclIO.h"
 
 /*
  * Magic flags used with wbits fields to indicate that we're handling the gzip
@@ -103,6 +104,7 @@ typedef struct {
     GzipHeader outHeader;	/* Header to write to an output stream, when
 				 * compressing a gzip stream. */
     Tcl_TimerToken timer;	/* Timer used for keeping events fresh. */
+    Tcl_DString decompressed;	/* Buffer for decompression results. */
     Tcl_Obj *compDictObj;	/* Byte-array object containing compression
 				 * dictionary (not dictObj!) to use if
 				 * necessary. */
@@ -128,11 +130,10 @@ typedef struct {
 #define DEFAULT_BUFFER_SIZE	4096
 
 /*
- * Time to wait (in milliseconds) before flushing the channel when reading
- * data through the transform.
+ * Time to wait before delivering a timer event.
  */
 
-#define TRANSFORM_FLUSH_DELAY	5
+#define TRANSFORM_TIMEOUT	0
 
 /*
  * Prototypes for private procedures defined later in this file:
@@ -143,7 +144,7 @@ static Tcl_DriverBlockModeProc	ZlibTransformBlockMode;
 static Tcl_DriverCloseProc	ZlibTransformClose;
 static Tcl_DriverGetHandleProc	ZlibTransformGetHandle;
 static Tcl_DriverGetOptionProc	ZlibTransformGetOption;
-static Tcl_DriverHandlerProc	ZlibTransformHandler;
+static Tcl_DriverHandlerProc	ZlibTransformEventHandler;
 static Tcl_DriverInputProc	ZlibTransformInput;
 static Tcl_DriverOutputProc	ZlibTransformOutput;
 static Tcl_DriverSetOptionProc	ZlibTransformSetOption;
@@ -157,6 +158,10 @@ static int		GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
 			    GzipHeader *headerPtr, int *extraSizePtr);
 static int		ZlibPushSubcmd(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+static inline int	ResultCopy(ZlibChannelData *cd, char *buf,
+			    int toRead);
+static int		ResultGenerate(ZlibChannelData *cd, int n, int flush,
+			    int *errorCodePtr);
 static Tcl_Channel	ZlibStackChannelTransform(Tcl_Interp *interp,
 			    int mode, int format, int level,
 			    Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr,
@@ -164,9 +169,8 @@ static Tcl_Channel	ZlibStackChannelTransform(Tcl_Interp *interp,
 static void		ZlibStreamCleanup(ZlibStreamHandle *zshPtr);
 static int		ZlibStreamSubcmd(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-static void		ZlibTransformTimerKill(ZlibChannelData *cd);
+static inline void	ZlibTransformEventTimerKill(ZlibChannelData *cd);
 static void		ZlibTransformTimerRun(ClientData clientData);
-static void		ZlibTransformTimerSetup(ZlibChannelData *cd);
 
 /*
  * Type of zlib-based compressing and decompressing channels.
@@ -186,7 +190,7 @@ static const Tcl_ChannelType zlibChannelType = {
     NULL,			/* close2Proc */
     ZlibTransformBlockMode,
     NULL,			/* flushProc */
-    ZlibTransformHandler,
+    ZlibTransformEventHandler,
     NULL,			/* wideSeekProc */
     NULL,
     NULL
@@ -2595,6 +2599,12 @@ ZlibStreamCmd(
  *----------------------------------------------------------------------
  *	Set of functions to support channel stacking.
  *----------------------------------------------------------------------
+ *
+ * ZlibTransformClose --
+ *
+ *	How to shut down a stacked compressing/decompressing transform.
+ *
+ *----------------------------------------------------------------------
  */
 
 static int
@@ -2609,7 +2619,7 @@ ZlibTransformClose(
      * Delete the support timer.
      */
 
-    ZlibTransformTimerKill(cd);
+    ZlibTransformEventTimerKill(cd);
 
     /*
      * Flush any data waiting to be compressed.
@@ -2654,6 +2664,8 @@ ZlibTransformClose(
      * Release all memory.
      */
 
+    Tcl_DStringFree(&cd->decompressed);
+
     if (cd->inBuffer) {
 	ckfree(cd->inBuffer);
 	cd->inBuffer = NULL;
@@ -2665,6 +2677,16 @@ ZlibTransformClose(
     ckfree(cd);
     return result;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformInput --
+ *
+ *	Reader filter that does decompression.
+ *
+ *----------------------------------------------------------------------
+ */
 
 static int
 ZlibTransformInput(
@@ -2676,84 +2698,144 @@ ZlibTransformInput(
     ZlibChannelData *cd = instanceData;
     Tcl_DriverInputProc *inProc =
 	    Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent));
-    int e, readBytes, flush = Z_NO_FLUSH;
+    int readBytes, gotBytes, copied;
 
     if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
 	return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead,
 		errorCodePtr);
     }
 
-    cd->inStream.next_out = (Bytef *) buf;
-    cd->inStream.avail_out = toRead;
-    if (cd->inStream.next_in == NULL) {
-	goto doReadFirst;
-    }
-    while (1) {
-	e = inflate(&cd->inStream, flush);
-	if (e == Z_NEED_DICT && cd->compDictObj) {
-	    e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
-	    if (e == Z_OK) {
-		continue;
-	    }
-	}
-	if ((e == Z_STREAM_END) || (e==Z_OK && cd->inStream.avail_out==0)) {
-	    return toRead - cd->inStream.avail_out;
-	}
-
+    gotBytes = 0;
+    while (toRead > 0) {
 	/*
-	 * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html
-	 *
-	 * Just indicates that the zlib couldn't consume input/produce output,
-	 * and is fixed by supplying more input.
+	 * Loop until the request is satisfied (or no data available from
+	 * below, possibly EOF).
 	 */
 
-	if ((e != Z_OK) && (e != Z_BUF_ERROR)) {
-	    Tcl_Obj *errObj = Tcl_NewListObj(0, NULL);
+	copied = ResultCopy(cd, buf, toRead);
+	toRead -= copied;
+	buf += copied;
+	gotBytes += copied;
 
-	    Tcl_ListObjAppendElement(NULL, errObj,
-		    Tcl_NewStringObj(cd->inStream.msg, -1));
-	    Tcl_SetChannelError(cd->parent, errObj);
-	    *errorCodePtr = EINVAL;
-	    return -1;
+	if (toRead == 0) {
+	    return gotBytes;
 	}
 
 	/*
-	 * Check if the inflate stopped early.
+	 * The buffer is exhausted, but the caller wants even more. We now
+	 * have to go to the underlying channel, get more bytes and then
+	 * transform them for delivery. We may not get what we want (full EOF
+	 * or temporarily out of data).
+	 *
+	 * Length (cd->decompressed) == 0, toRead > 0 here.
+	 *
+	 * The zlib transform allows us to read at most one character from the
+	 * underlying channel to properly identify Z_STREAM_END without
+	 * reading over the border.
 	 */
 
-	if (cd->inStream.avail_in > 0) {
-	    continue;
-	}
+	readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, 1);
 
 	/*
-	 * Emptied the buffer of data from the underlying channel. Get some
-	 * more.
+	 * Three cases here:
+	 *  1.	Got some data from the underlying channel (readBytes > 0) so
+	 *	it should be fed through the decompression engine.
+	 *  2.	Got an error (readBytes < 0) which we should report up except
+	 *	for the case where we can convert it to a short read.
+	 *  3.	Got an end-of-data from EOF or blocking (readBytes == 0). If
+	 *	it is EOF, try flushing the data out of the decompressor.
 	 */
 
-    doReadFirst:
-	/*
-	 * Hack for Bug 2762041. Disable pre-reading of lots of input, read
-	 * only one character. This way the Z_END_OF_STREAM can be read
-	 * without triggering an EOF in the base channel. The higher input
-	 * loops in DoReadChars() would react to that by stopping, despite the
-	 * transform still having data which could be read.
-	 *
-	 * This is only a hack because other transforms may not be able to
-	 * work around the general problem in this way.
-	 */
-
-	readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, 1);
 	if (readBytes < 0) {
+	    /*
+	     * Report errors to caller. The state of the seek system is
+	     * unchanged!
+	     */
+
+	    if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
+		/*
+		 * EAGAIN is a special situation. If we had some data before
+		 * we report that instead of the request to re-try.
+		 */
+
+		return gotBytes;
+	    }
+
 	    *errorCodePtr = Tcl_GetErrno();
 	    return -1;
 	} else if (readBytes == 0) {
-	    flush = Z_SYNC_FLUSH;
-	}
+	    /*
+	     * Check wether we hit on EOF in 'parent' or not. If not,
+	     * differentiate between blocking and non-blocking modes. In
+	     * non-blocking mode we ran temporarily out of data. Signal this
+	     * to the caller via EWOULDBLOCK and error return (-1). In the
+	     * other cases we simply return what we got and let the caller
+	     * wait for more. On the other hand, if we got an EOF we have to
+	     * convert and flush all waiting partial data.
+	     */
 
-	cd->inStream.next_in = (Bytef *) cd->inBuffer;
-	cd->inStream.avail_in = readBytes;
+	    if (!Tcl_Eof(cd->parent)) {
+		/*
+		 * The state of the seek system is unchanged!
+		 */
+
+		if ((gotBytes == 0) && (cd->flags & ASYNC)) {
+		    *errorCodePtr = EWOULDBLOCK;
+		    return -1;
+		}
+		return gotBytes;
+	    }
+
+	    /*
+	     * (Semi-)Eof in parent.
+	     *
+	     * Now this is a bit different. The partial data waiting is
+	     * converted and returned.
+	     */
+
+	    if (ResultGenerate(cd, 0, Z_SYNC_FLUSH, errorCodePtr) != TCL_OK) {
+		return -1;
+	    }
+
+	    if (Tcl_DStringLength(&cd->decompressed) == 0) {
+		/*
+		 * The drain delivered nothing. Time to deliver what we've
+		 * got.
+		 */
+
+		return gotBytes;
+	    }
+
+	    /*
+	     * Reset eof, force caller to drain result buffer.
+	     */
+
+	    ((Channel *) cd->parent)->state->flags &= ~CHANNEL_EOF;
+	} else /* readBytes > 0 */ {
+	    /*
+	     * Transform the read chunk, which was not empty. Anything we get
+	     * back is a transformation result to be put into our buffers, and
+	     * the next iteration will put it into the result.
+	     */
+
+	    if (ResultGenerate(cd, readBytes, Z_NO_FLUSH,
+		    errorCodePtr) != TCL_OK) {
+		return -1;
+	    }
+	}
     }
+    return gotBytes;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformOutput --
+ *
+ *	Writer filter that does compression.
+ *
+ *----------------------------------------------------------------------
+ */
 
 static int
 ZlibTransformOutput(
@@ -2798,6 +2880,16 @@ ZlibTransformOutput(
 
     return toWrite - cd->outStream.avail_in;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformSetOption --
+ *
+ *	Writing side of [fconfigure] on our channel.
+ *
+ *----------------------------------------------------------------------
+ */
 
 static int
 ZlibTransformSetOption(			/* not used */
@@ -2871,7 +2963,7 @@ ZlibTransformSetOption(			/* not used */
 	    }
 
 	    if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
-		    cd->outStream.next_out - (Bytef*)cd->outBuffer) < 0) {
+		    cd->outStream.next_out - (Bytef *) cd->outBuffer) < 0) {
 		Tcl_AppendResult(interp, "problem flushing channel: ",
 			Tcl_PosixError(interp), NULL);
 		return TCL_ERROR;
@@ -2888,9 +2980,24 @@ ZlibTransformSetOption(			/* not used */
 	}
     }
 
+    /*
+     * Pass all unknown options down, to deeper transforms and/or the base
+     * channel.
+     */
+
     return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp,
 	    optionName, value);
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformGetOption --
+ *
+ *	Reading side of [fconfigure] on our channel.
+ *
+ *----------------------------------------------------------------------
+ */
 
 static int
 ZlibTransformGetOption(
@@ -2989,6 +3096,17 @@ ZlibTransformGetOption(
     }
     return Tcl_BadChannelOption(interp, optionName, chanOptions);
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformWatch, ZlibTransformEventHandler --
+ *
+ *	If we have data pending, trigger a readable event after a short time
+ *	(in order to allow a real event to catch up).
+ *
+ *----------------------------------------------------------------------
+ */
 
 static void
 ZlibTransformWatch(
@@ -3004,63 +3122,28 @@ ZlibTransformWatch(
 
     watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent));
     watchProc(Tcl_GetChannelInstanceData(cd->parent), mask);
-    if (!(mask & TCL_READABLE)
-	    || (cd->inStream.avail_in == (uInt) cd->inAllocated)) {
-	ZlibTransformTimerKill(cd);
-    } else {
-	ZlibTransformTimerSetup(cd);
-    }
-}
-
-static int
-ZlibTransformGetHandle(
-    ClientData instanceData,
-    int direction,
-    ClientData *handlePtr)
-{
-    ZlibChannelData *cd = instanceData;
 
-    return Tcl_GetChannelHandle(cd->parent, direction, handlePtr);
-}
-
-static int
-ZlibTransformBlockMode(
-    ClientData instanceData,
-    int mode)
-{
-    ZlibChannelData *cd = instanceData;
-
-    if (mode == TCL_MODE_NONBLOCKING) {
-	cd->flags |= ASYNC;
-    } else {
-	cd->flags &= ~ASYNC;
+    if (!(mask & TCL_READABLE) || Tcl_DStringLength(&cd->decompressed) == 0) {
+	ZlibTransformEventTimerKill(cd);
+    } else if (cd->timer == NULL) {
+	cd->timer = Tcl_CreateTimerHandler(TRANSFORM_TIMEOUT,
+		ZlibTransformTimerRun, cd);
     }
-    return TCL_OK;
 }
 
 static int
-ZlibTransformHandler(
+ZlibTransformEventHandler(
     ClientData instanceData,
     int interestMask)
 {
     ZlibChannelData *cd = instanceData;
 
-    ZlibTransformTimerKill(cd);
+    ZlibTransformEventTimerKill(cd);
     return interestMask;
 }
 
-static void
-ZlibTransformTimerSetup(
-    ZlibChannelData *cd)
-{
-    if (cd->timer == NULL) {
-	cd->timer = Tcl_CreateTimerHandler(TRANSFORM_FLUSH_DELAY,
-		ZlibTransformTimerRun, cd);
-    }
-}
-
-static void
-ZlibTransformTimerKill(
+static inline void
+ZlibTransformEventTimerKill(
     ZlibChannelData *cd)
 {
     if (cd->timer != NULL) {
@@ -3082,6 +3165,53 @@ ZlibTransformTimerRun(
 /*
  *----------------------------------------------------------------------
  *
+ * ZlibTransformGetHandle --
+ *
+ *	Anything that needs the OS handle is told to get it from what we are
+ *	stacked on top of.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformGetHandle(
+    ClientData instanceData,
+    int direction,
+    ClientData *handlePtr)
+{
+    ZlibChannelData *cd = instanceData;
+
+    return Tcl_GetChannelHandle(cd->parent, direction, handlePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformBlockMode --
+ *
+ *	We need to keep track of the blocking mode; it changes our behavior.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformBlockMode(
+    ClientData instanceData,
+    int mode)
+{
+    ZlibChannelData *cd = instanceData;
+
+    if (mode == TCL_MODE_NONBLOCKING) {
+	cd->flags |= ASYNC;
+    } else {
+	cd->flags &= ~ASYNC;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * ZlibStackChannelTransform --
  *
  *	Stacks either compression or decompression onto a channel.
@@ -3207,6 +3337,8 @@ ZlibStackChannelTransform(
 	}
     }
 
+    Tcl_DStringInit(&cd->decompressed);
+
     chan = Tcl_StackChannel(interp, &zlibChannelType, cd,
 	    Tcl_GetChannelMode(channel), channel);
     if (chan == NULL) {
@@ -3235,6 +3367,162 @@ ZlibStackChannelTransform(
 
 /*
  *----------------------------------------------------------------------
+ *
+ * ResultCopy --
+ *
+ *	Copies the requested number of bytes from the buffer into the
+ *	specified array and removes them from the buffer afterward. Copies
+ *	less if there is not enough data in the buffer.
+ *
+ * Side effects:
+ *	See above.
+ *
+ * Result:
+ *	The number of actually copied bytes, possibly less than 'toRead'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+ResultCopy(
+    ZlibChannelData *cd,	/* The location of the buffer to read from. */
+    char *buf,			/* The buffer to copy into */
+    int toRead)			/* Number of requested bytes */
+{
+    int have = Tcl_DStringLength(&cd->decompressed);
+
+    if (have == 0) {
+	/*
+	 * Nothing to copy in the case of an empty buffer.
+	 */
+
+	return 0;
+    } else if (have > toRead) {
+	/*
+	 * The internal buffer contains more than requested. Copy the
+	 * requested subset to the caller, shift the remaining bytes down, and
+	 * truncate.
+	 */
+
+	char *src = Tcl_DStringValue(&cd->decompressed);
+
+	memcpy(buf, src, toRead);
+	memmove(src, src + toRead, have - toRead);
+
+	Tcl_DStringSetLength(&cd->decompressed, have - toRead);
+	return toRead;
+    } else /* have <= toRead */ {
+	/*
+	 * There is just or not enough in the buffer to fully satisfy the
+	 * caller, so take everything as best effort.
+	 */
+
+	memcpy(buf, Tcl_DStringValue(&cd->decompressed), have);
+	Tcl_DStringSetLength(&cd->decompressed, 0);
+	return have;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultGenerate --
+ *
+ *	Extract uncompressed bytes from the compression engine and store them
+ *	in our working buffer.
+ *
+ * Result:
+ *	TCL_OK/TCL_ERROR (with *errorCodePtr updated with reason).
+ *
+ * Side effects:
+ *	See above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ResultGenerate(
+    ZlibChannelData *cd,
+    int n,
+    int flush,
+    int *errorCodePtr)
+{
+#define MAXBUF	1024
+    unsigned char buf[MAXBUF];
+    int e, written;
+
+    cd->inStream.next_in = (Bytef *) cd->inBuffer;
+    cd->inStream.avail_in = n;
+
+    while (1) {
+	cd->inStream.next_out = (Bytef *) buf;
+	cd->inStream.avail_out = MAXBUF;
+
+	e = inflate(&cd->inStream, flush);
+	if (e == Z_NEED_DICT && cd->compDictObj) {
+	    e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
+	    if (e == Z_OK) {
+		/*
+		 * A repetition of Z_NEED_DICT is just an error.
+		 */
+
+		cd->inStream.next_out = (Bytef *) buf;
+		cd->inStream.avail_out = MAXBUF;
+		e = inflate(&cd->inStream, flush);
+	    }
+	}
+
+	/*
+	 * avail_out is now the left over space in the output.  Therefore
+	 * "MAXBUF - avail_out" is the amount of bytes generated.
+	 */
+
+	written = MAXBUF - cd->inStream.avail_out;
+	if (written) {
+	    Tcl_DStringAppend(&cd->decompressed, (char *) buf, written);
+	}
+
+	/*
+	 * The cases where we're definitely done.
+	 */
+
+	if (((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR))
+		|| (e == Z_STREAM_END)
+		|| (e == Z_OK && cd->inStream.avail_out == 0)) {
+	    return TCL_OK;
+	}
+
+	/*
+	 * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html
+	 *
+	 * Just indicates that the zlib couldn't consume input/produce output,
+	 * and is fixed by supplying more input.
+	 *
+	 * Otherwise, we've got errors and need to report to higher-up.
+	 */
+
+	if ((e != Z_OK) && (e != Z_BUF_ERROR)) {
+	    Tcl_Obj *errObj = Tcl_NewListObj(0, NULL);
+
+	    Tcl_ListObjAppendElement(NULL, errObj,
+		    Tcl_NewStringObj(cd->inStream.msg, -1));
+	    Tcl_SetChannelError(cd->parent, errObj);
+	    *errorCodePtr = EINVAL;
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Check if the inflate stopped early.
+	 */
+
+	if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) {
+	    return TCL_OK;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
  *	Finally, the TclZlibInit function. Used to install the zlib API.
  *----------------------------------------------------------------------
  */
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index ce92028..5b4eae9 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,7 +1,7 @@
 if {![package vsatisfies [package provide Tcl] 8.5]} return
 if {[string compare [info sharedlibextension] .dll]} return
 if {[::tcl::pkgconfig get debug]} {
-    package ifneeded dde 1.3.3 [list load [file join $dir tcldde13g.dll] dde]
+    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
 } else {
-    package ifneeded dde 1.3.3 [list load [file join $dir tcldde13.dll] dde]
+    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde]
 }
diff --git a/tests/all.tcl b/tests/all.tcl
index b436fbe..05d3024 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -10,6 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
+package prefer latest
 package require Tcl 8.5
 package require tcltest 2.2
 namespace import tcltest::*
diff --git a/tests/io.test b/tests/io.test
index e6cea16..386179e 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -2748,13 +2748,13 @@ test io-29.33b {TIP#398, no implicit flush of nonblocking on exit} {exec} {
     set f [open $path(script2) w]
     puts $f {after 2000}
     close $f
-	set t1 [clock seconds]
+	set t1 [clock milliseconds]
 	set ff [open "|[list [interpreter] $path(script2)]" w]
 	catch {unset ::env(TCL_FLUSH_NONBLOCKING_ON_EXIT)}
 	exec [interpreter] $path(script) >@ $ff
-	set t2 [clock seconds]
+	set t2 [clock milliseconds]
 	close $ff
-	expr {($t2-$t1)/2}
+	expr {($t2-$t1)/2000 ? $t2-$t1 : 0}
 } 0
 test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} {
     variable c 0
diff --git a/tests/oo.test b/tests/oo.test
index f3c0bda..00663e9 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1974,7 +1974,7 @@ test oo-18.1 {OO: define command support} {
 } {1 foo {foo
     while executing
 "error foo"
-    (in definition script for object "oo::object" line 1)
+    (in definition script for class "::oo::object" line 1)
     invoked from within
 "oo::define oo::object {error foo}"}}
 test oo-18.2 {OO: define command support} {
@@ -1987,7 +1987,7 @@ test oo-18.3 {OO: define command support} {
 } {1 bar {bar
     while executing
 "error bar"
-    (in definition script for object "::foo" line 1)
+    (in definition script for class "::foo" line 1)
     invoked from within
 "oo::class create foo {error bar}"}}
 test oo-18.3a {OO: define command support} {
@@ -1997,7 +1997,7 @@ test oo-18.3a {OO: define command support} {
 } {1 bar {bar
     while executing
 "error bar"
-    (in definition script for object "::foo" line 2)
+    (in definition script for class "::foo" line 2)
     invoked from within
 "oo::class create foo {
     error bar
@@ -2015,7 +2015,7 @@ test oo-18.3b {OO: define command support} {
     ("eval" body line 1)
     invoked from within
 "eval eval error bar"
-    (in definition script for object "::foo" line 2)
+    (in definition script for class "::foo" line 2)
     invoked from within
 "oo::class create foo {
     eval eval error bar
@@ -2070,6 +2070,106 @@ test oo-18.5 {OO: more error traces from the guts} -setup {
     (class "::cls" method "eval" line 1)
     invoked from within
 "obj eval {error bar}"}}
+test oo-18.6 {class construction reference management and errors} -setup {
+    oo::class create super_abc
+} -body {
+    catch {
+oo::class create abc {
+    superclass super_abc
+    ::rename abc ::def
+    ::error foo
+}
+    } msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    super_abc destroy
+} -result {foo
+    while executing
+"::error foo"
+    (in definition script for class "::def" line 4)
+    invoked from within
+"oo::class create abc {
+    superclass super_abc
+    ::rename abc ::def
+    ::error foo
+}"}
+test oo-18.7 {OO: objdefine command support} -setup {
+    oo::object create ::inst
+} -body {
+    list [catch {oo::objdefine inst {rename ::inst ::INST;error foo}} msg] $msg $errorInfo
+} -cleanup {
+    catch {::inst destroy}
+    catch {::INST destroy}
+} -result {1 foo {foo
+    while executing
+"error foo"
+    (in definition script for object "::INST" line 1)
+    invoked from within
+"oo::objdefine inst {rename ::inst ::INST;error foo}"}}
+test oo-18.8 {OO: define/self command support} -setup {
+    oo::class create master
+    oo::class create ::foo {superclass master}
+} -body {
+    catch {oo::define foo {rename ::foo ::bar; self {error foobar}}} msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    master destroy
+} -result {foobar
+    while executing
+"error foobar"
+    (in definition script for class object "::bar" line 1)
+    invoked from within
+"self {error foobar}"
+    (in definition script for class "::bar" line 1)
+    invoked from within
+"oo::define foo {rename ::foo ::bar; self {error foobar}}"}
+test oo-18.9 {OO: define/self command support} -setup {
+    oo::class create master
+    set c [oo::class create now_this_is_a_very_very_long_class_name_indeed {
+        superclass master
+    }]
+} -body {
+    catch {oo::define $c {error err}} msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    master destroy
+} -result {err
+    while executing
+"error err"
+    (in definition script for class "::now_this_is_a_very_very_long..." line 1)
+    invoked from within
+"oo::define $c {error err}"}
+test oo-18.10 {OO: define/self command support} -setup {
+    oo::class create master
+    oo::class create ::foo {superclass master}
+} -body {
+    catch {oo::define foo {self {rename ::foo {}; error foobar}}} msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    master destroy
+} -result {foobar
+    while executing
+"error foobar"
+    (in definition script for class object "::foo" line 1)
+    invoked from within
+"self {rename ::foo {}; error foobar}"
+    (in definition script for class "::foo" line 1)
+    invoked from within
+"oo::define foo {self {rename ::foo {}; error foobar}}"}
+test oo-18.11 {OO: define/self command support} -setup {
+    oo::class create master
+    oo::class create ::foo {superclass master}
+} -body {
+    catch {oo::define foo {rename ::foo {}; self {error foobar}}} msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    master destroy
+} -result {this command cannot be called when the object has been deleted
+    while executing
+"self {error foobar}"
+    (in definition script for class "::foo" line 1)
+    invoked from within
+"oo::define foo {rename ::foo {}; self {error foobar}}"}
 
 test oo-19.1 {OO: varname method} -setup {
     oo::object create inst
@@ -3189,7 +3289,7 @@ test oo-33.2 {TIP 380: slots - defaulting} -setup {
 } -cleanup {
     rename $s {}
 } -result {{} {a b c destroy unknown}}
-test oo-32.3 {TIP 380: slots - defaulting} -setup {
+test oo-33.3 {TIP 380: slots - defaulting} -setup {
     set s [SampleSlot new]
 } -body {
     oo::objdefine $s forward --default-operation  my -set
diff --git a/tests/socket.test b/tests/socket.test
index f06a548..d88eb65 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -64,7 +64,7 @@ package require tcltest 2
 namespace import -force ::tcltest::*
 
 # Some tests require the Thread package or exec command
-testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}]
+testConstraint thread [expr {0 == [catch {package require Thread 2.6.6}]}]
 testConstraint exec [llength [info commands exec]]
 
 # Produce a random port number in the Dynamic/Private range
diff --git a/tests/winDde.test b/tests/winDde.test
index ca50a96..bc64a24 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -156,6 +156,20 @@ test winDde-3.5 {DDE request locally} {win dde} {
     dde execute TclEval self {set a "foo"}
     dde request -binary TclEval self a
 } "foo\x00"
+# Set variable a to A with diaeresis (unicode C4) by relying on the fact
+# that utf8 is sent (e.g. "c3 84" on the wire)
+test winDde-3.6 {DDE request utf8} {win dde} {
+    set a "not set"
+    dde execute TclEval self "set a \xc4"
+    scan $a %c
+} 196
+# Set variable a to A with diaeresis (unicode C4) using binary execute
+# and compose utf-8 (e.g. "c3 84" ) manualy
+test winDde-3.7 {DDE request binary} {win dde} {
+    set a "not set"
+    dde execute -binary TclEval self "set a \xc3\x84\x00"
+    scan $a %c
+} 196
 
 # -------------------------------------------------------------------------
 
@@ -202,13 +216,13 @@ test winDde-4.4 {DDE eval remotely} {stdio win dde} {
 
 test winDde-5.1 {check for bad arguments} -constraints {win dde} -body {
     dde execute "" "" "" ""
-} -returnCodes error -result {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
+} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
 test winDde-5.2 {check for bad arguments} -constraints {win dde} -body {
     dde execute "" "" ""
 } -returnCodes error -result {cannot execute null data}
 test winDde-5.3 {check for bad arguments} -constraints {win dde} -body {
     dde execute -foo "" "" ""
-} -returnCodes error -result {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
+} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
 test winDde-5.4 {DDE eval bad arguments} -constraints {win dde} -body {
     dde eval "" "foo"
 } -returnCodes error -result {invalid service name ""}
diff --git a/tests/zlib.test b/tests/zlib.test
index 6c0e4f8..5935fbe 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2.1
     namespace import -force ::tcltest::*
 }
@@ -70,7 +70,7 @@ test zlib-7.0 {zlib stream} -constraints zlib -returnCodes error -setup {
     $s ?
 } -cleanup {
     $s close
-} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, put, or reset}
+} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, header, put, or reset}
 test zlib-7.1 {zlib stream} zlib {
     set s [zlib stream compress]
     $s put -finalize abcdeEDCBA
@@ -169,7 +169,25 @@ test zlib-8.4 {transformation and flushing: Bug 3517696} -setup {
     catch {close $fd}
     removeFile $file
 } -result {}
-test zlib-8.5 {transformation and fconfigure} -setup {
+test zlib-8.5 {transformation and flushing and fileevents: Bug 3525907} -setup {
+    foreach {r w} [chan pipe] break
+} -constraints zlib -body {
+    set ::res {}
+    fconfigure $w -buffering none
+    zlib push compress $w
+    puts -nonewline $w qwertyuiop
+    chan configure $w -flush sync
+    after 500 {puts -nonewline $w asdfghjkl;close $w}
+    fconfigure $r -blocking 0 -buffering none
+    zlib push decompress $r
+    fileevent $r readable {set msg [read $r];lappend ::res $msg;if {[eof $r]} {set ::done 1}}
+    after 250 {lappend ::res MIDDLE}
+    vwait ::done
+    set ::res
+} -cleanup {
+    catch {close $r}
+} -result {qwertyuiop MIDDLE asdfghjkl}
+test zlib-8.6 {transformation and fconfigure} -setup {
     set file [makeFile {} test.z]
     set fd [open $file wb]
 } -constraints zlib -body {
@@ -179,7 +197,7 @@ test zlib-8.5 {transformation and fconfigure} -setup {
     catch {close $fd}
     removeFile $file
 } -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
-test zlib-8.6 {transformation and fconfigure} -setup {
+test zlib-8.7 {transformation and fconfigure} -setup {
     set file [makeFile {} test.gz]
     set fd [open $file wb]
 } -constraints zlib -body {
@@ -189,7 +207,7 @@ test zlib-8.6 {transformation and fconfigure} -setup {
     catch {close $fd}
     removeFile $file
 } -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
-test zlib-8.7 {transformtion and fconfigure} -setup {
+test zlib-8.8 {transformtion and fconfigure} -setup {
     lassign [chan pipe] inSide outSide
     set msg [string repeat "am i all that i am at all? i am all that i am!" 400]
     set dict "thatallam i "
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index e48cc2b..12e5a9a 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -545,6 +545,9 @@ TcpCloseProc(
      */
     
     for (fds = &statePtr->fds; fds != NULL; fds = fds->next) {
+	if (fds->fd < 0) {
+	    continue;
+	}
 	Tcl_DeleteFileHandler(fds->fd);
 	if (close(fds->fd) < 0) {
 	    errorCode = errno;
diff --git a/win/Makefile.in b/win/Makefile.in
index 8492b8f..111f455 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -606,23 +606,23 @@ install-binaries: binaries
 	    done
 	@if [ -f $(DDE_DLL_FILE) ]; then \
 	    echo installing $(DDE_DLL_FILE); \
-	    $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
+	    $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
 	    $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
-		$(LIB_INSTALL_DIR)/dde1.3; \
+		$(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
 	    fi
 	@if [ -f $(DDE_LIB_FILE) ]; then \
 	    echo installing $(DDE_LIB_FILE); \
-	    $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
+	    $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
 	    fi
 	@if [ -f $(REG_DLL_FILE) ]; then \
 	    echo installing $(REG_DLL_FILE); \
-	    $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.3; \
+	    $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
 	    $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
-		$(LIB_INSTALL_DIR)/reg1.3; \
+		$(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
 	    fi
 	@if [ -f $(REG_LIB_FILE) ]; then \
 	    echo installing $(REG_LIB_FILE); \
-	    $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.3; \
+	    $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
 	    fi
 
 install-libraries: libraries install-tzdata install-msgs
diff --git a/win/configure b/win/configure
index 5edf012..fed0959 100755
--- a/win/configure
+++ b/win/configure
@@ -1314,9 +1314,9 @@ TCL_MINOR_VERSION=6
 TCL_PATCH_LEVEL="b2"
 VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
 
-TCL_DDE_VERSION=1.3
+TCL_DDE_VERSION=1.4
 TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=3
+TCL_DDE_MINOR_VERSION=4
 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
 
 TCL_REG_VERSION=1.3
diff --git a/win/configure.in b/win/configure.in
index f4e10ee..2377938 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -17,9 +17,9 @@ TCL_MINOR_VERSION=6
 TCL_PATCH_LEVEL="b2"
 VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
 
-TCL_DDE_VERSION=1.3
+TCL_DDE_VERSION=1.4
 TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=3
+TCL_DDE_MINOR_VERSION=4
 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
 
 TCL_REG_VERSION=1.3
diff --git a/win/makefile.bc b/win/makefile.bc
index 338205e..d17c624 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -126,8 +126,8 @@ STUBPREFIX	= $(NAMEPREFIX)stub
 DOTVERSION	= 8.6
 VERSION		= 86
 
-DDEVERSION = 13
-DDEDOTVERSION = 1.3
+DDEVERSION = 14
+DDEDOTVERSION = 1.4
 
 REGVERSION = 13
 REGDOTVERSION = 1.3
diff --git a/win/makefile.vc b/win/makefile.vc
index bc16584..96ae7f6 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -186,7 +186,7 @@ STUBPREFIX      = $(PROJECT)stub
 DOTVERSION      = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
 VERSION         = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
 
-DDEDOTVERSION = 1.3
+DDEDOTVERSION = 1.4
 DDEVERSION = $(DDEDOTVERSION:.=)
 
 REGDOTVERSION = 1.3
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index d508c02..617e4e5 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -88,7 +88,7 @@ static DWORD ddeInstance;	/* The application instance handle given to us
 				 * by DdeInitialize. */
 static int ddeIsServer = 0;
 
-#define TCL_DDE_VERSION		"1.3.3"
+#define TCL_DDE_VERSION		"1.4.0"
 #define TCL_DDE_PACKAGE_NAME	"dde"
 #define TCL_DDE_SERVICE_NAME	TEXT("TclEval")
 #define TCL_DDE_EXECUTE_RESULT	TEXT("$TCLEVAL$EXECUTE$RESULT")
@@ -1184,13 +1184,19 @@ DdeObjCmd(
 	DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST,
     };
     static const char *const ddeExecOptions[] = {
+	"-async", "-binary", NULL
+    };
+    enum DdeExecOptions {
+        DDE_EXEC_ASYNC, DDE_EXEC_BINARY
+    };
+    static const char *const ddeEvalOptions[] = {
 	"-async", NULL
     };
     static const char *const ddeReqOptions[] = {
 	"-binary", NULL
     };
 
-    int index, i, length;
+    int index, i, length, argIndex;
     int async = 0, binary = 0, exact = 0;
     int result = TCL_OK, firstArg = 0;
     HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
@@ -1218,7 +1224,6 @@ DdeObjCmd(
     switch ((enum DdeSubcommands) index) {
     case DDE_SERVERNAME:
 	for (i = 2; i < objc; i++) {
-	    int argIndex;
 	    if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions,
 		    "option", 0, &argIndex) != TCL_OK) {
 		/*
@@ -1265,39 +1270,53 @@ DdeObjCmd(
 	if (objc == 5) {
 	    firstArg = 2;
 	    break;
-	} else if (objc == 6) {
-	    int dummy;
-	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0,
-		    &dummy) == TCL_OK) {
-		async = 1;
-		firstArg = 3;
-		break;
+	} else if (objc >= 6 && objc <= 7) {
+	    firstArg = objc - 3;
+	    for (i = 2; i < firstArg; i++) {
+		if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions,
+			"option", 0, &argIndex) != TCL_OK) {
+		    goto wrongDdeExecuteArgs;
+		}
+		if (argIndex == DDE_EXEC_ASYNC) {
+		    async = 1;
+		} else {
+		    binary = 1;
+		}
 	    }
+	    break;
 	}
 	/* otherwise... */
+    wrongDdeExecuteArgs:
 	Tcl_WrongNumArgs(interp, 2, objv,
-		"?-async? serviceName topicName value");
+		"?-async? ?-binary? serviceName topicName value");
 	return TCL_ERROR;
     case DDE_POKE:
-	if (objc != 6) {
-	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "serviceName topicName item value");
-	    return TCL_ERROR;
+	if (objc == 6) {
+	    firstArg = 2;
+	    break;
+	} else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2],
+		ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
+	    binary = 1;
+	    firstArg = 3;
+	    break;
 	}
-	firstArg = 2;
-	break;
+
+	/*
+	 * Otherwise...
+	 */
+
+	Tcl_WrongNumArgs(interp, 2, objv,
+		"?-binary? serviceName topicName item value");
+	return TCL_ERROR;
     case DDE_REQUEST:
 	if (objc == 5) {
 	    firstArg = 2;
 	    break;
-	} else if (objc == 6) {
-	    int dummy;
-	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
-		    &dummy) == TCL_OK) {
-		binary = 1;
-		firstArg = 3;
-		break;
-	    }
+	} else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2],
+		ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
+	    binary = 1;
+	    firstArg = 3;
+	    break;
 	}
 
 	/*
@@ -1320,11 +1339,9 @@ DdeObjCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args");
 	    return TCL_ERROR;
 	} else {
-	    int dummy;
-
 	    firstArg = 2;
-	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option",
-		    0, &dummy) == TCL_OK) {
+	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option",
+		    0, &argIndex) == TCL_OK) {
 		if (objc < 5) {
 		    goto wrongDdeEvalArgs;
 		}
@@ -1373,10 +1390,18 @@ DdeObjCmd(
 
     case DDE_EXECUTE: {
 	int dataLength;
-	BYTE *dataString = (BYTE *) Tcl_GetStringFromObj(
-		objv[firstArg + 2], &dataLength);
+	BYTE *dataString;
+
+	if (binary) {
+	    dataString = (BYTE *)
+		    Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
+	} else {
+	    dataString = (BYTE *)
+		    Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
+	    dataLength += 1;
+	}
 
-	if (dataLength == 0) {
+	if (dataLength <= (binary ? 0 : sizeof(TCHAR))) {
 	    Tcl_SetObjResult(interp,
 		    Tcl_NewStringObj("cannot execute null data", -1));
 	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
@@ -1394,7 +1419,7 @@ DdeObjCmd(
 	}
 
 	ddeData = DdeCreateDataHandle(ddeInstance, dataString,
-		(DWORD) dataLength+1, 0, 0, CF_TEXT, 0);
+		(DWORD) dataLength, 0, 0, CF_TEXT, 0);
 	if (ddeData != NULL) {
 	    if (async) {
 		DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
@@ -1481,8 +1506,14 @@ DdeObjCmd(
 	    result = TCL_ERROR;
 	    goto cleanup;
 	}
-	dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3],
-		&length);
+	if (binary) {
+	    dataString = (BYTE *)
+		    Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
+	} else {
+	    dataString = (BYTE *)
+		    Tcl_GetStringFromObj(objv[firstArg + 3], &length);
+	    length += 1;
+	}
 
 	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
 	DdeFreeStringHandle(ddeInstance, ddeService);
@@ -1495,7 +1526,7 @@ DdeObjCmd(
 	    ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
 		    CP_WINUNICODE);
 	    if (ddeItem != NULL) {
-		ddeData = DdeClientTransaction(dataString, (DWORD) length+1,
+		ddeData = DdeClientTransaction(dataString, (DWORD) length,
 			hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
 		if (ddeData == NULL) {
 		    SetDdeError(interp);