merge trunk

generic/tclBasic.c

@@ -3005,6 +3005,9 @@ CallCommandTraces(
  *	This function returns a Tcl_Obj with the full source string for the
  *	command. This insures that traces get a correct NUL-terminated command
  *	string.
+ *	If parameter 'command' is (char*)-1 it returns a pointer to the command's 
+ *	source using TclGetSrcInfoForCmd. As parameter 'numChars' could be used 
+ *	an ENSEMBLE_PSEUDO_COMMAND to advise call of the ensemble command.
  *
  *----------------------------------------------------------------------
  */
@@ -3022,6 +3025,9 @@ GetCommandSource(
     }
     if (command == (char *) -1) {
 	command = TclGetSrcInfoForCmd(iPtr, &numChars);
+	if (!command) {
+	    return Tcl_NewListObj(objc, objv);
+	}
     }
     return Tcl_NewStringObj(command, numChars);
 }
@@ -3533,8 +3539,10 @@ TclEvalObjvInternal(
 				 * for traces. NULL if the string
 				 * representation of the command is unknown is
 				 * to be generated from (objc,objv), -1 if it
-				 * is to be generated from bytecode
-				 * source. This is only needed the traces. */
+				 * is to be generated from bytecode source,
+				 * with length ENSEMBLE_PSEUDO_COMMAND it is 
+				 * to be determined from the ensemble context. 
+				 * This is only needed the traces. */
     int length,			/* Number of bytes in command; if -1, all
 				 * characters up to the first null byte are
 				 * used. */

generic/tclCompile.h

@@ -843,6 +843,14 @@ typedef struct {
 	int identity;
     } i;
 } TclOpCmdClientData;
+
+/*
+ * Special sentinel value for TclEvalObjvInternal's 'length' parameter to
+ * cause it to retrieve command information for an ensemble from the
+ * containing command (parameter 'command' is (char *)-1).
+ */
+
+#define ENSEMBLE_PSEUDO_COMMAND -2
 
 /*
  *----------------------------------------------------------------

generic/tclExecute.c

@@ -7757,6 +7757,8 @@ IllegalExprOperandType(
  *	at pc, information about the closest enclosing command is returned. If
  *	no matching command is found, NULL is returned and *lengthPtr is
  *	unchanged.
+ *	As input parameter '*lengthPtr' could be used an ENSEMBLE_PSEUDO_COMMAND 
+ *	to advise call of the ensemble command.
  *
  * Side effects:
  *	The CmdFrame at *cfPtr is updated.
@@ -7770,10 +7772,38 @@ TclGetSrcInfoForCmd(
     int *lenPtr)
 {
     CmdFrame *cfPtr = iPtr->cmdFramePtr;
-    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
+    const char *command;
+    ByteCode *codePtr;
+    int len;
 
-    return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
-	    codePtr, lenPtr);
+    if (!cfPtr)
+	return NULL;
+    codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
+    if (!codePtr)
+	return NULL;
+    if (!cfPtr->data.tebc.pc)
+	return NULL;
+
+    command = GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
+	    codePtr, &len);
+
+    /*
+     * [sebres]: If ensemble call (sentinel length == ENSEMBLE_PSEUDO_COMMAND), 
+     * shift string ptr to subcommand (string range -> range).
+     */
+
+    if (command && len && (lenPtr && *lenPtr == ENSEMBLE_PSEUDO_COMMAND) && codePtr->objArrayPtr) {
+	Tcl_Obj *objPtr = codePtr->objArrayPtr[0];
+
+	if (len > objPtr->length) {
+	    command += objPtr->length + 1;
+	    len -= objPtr->length + 1;
+	}
+    }
+
+    if (lenPtr != NULL)
+	*lenPtr = len;
+    return command;
 }
 
 void

generic/tclNamesp.c

@@ -25,6 +25,7 @@
  */
 
 #include "tclInt.h"
+#include "tclCompile.h"
 
 /*
  * Thread-local storage used to avoid having a global lock on data that is not
@@ -6229,10 +6230,13 @@ NsEnsembleImplementationCmd(
 
 	/*
 	 * Hand off to the target command.
+	 * [sebres] call from ensemble using ENSEMBLE_PSEUDO_COMMAND to
+	 * retrive subcommand from main ensemble.
 	 */
 
-	result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
-		TCL_EVAL_INVOKE);
+	result = TclEvalObjvInternal(interp, objc-2+prefixObjc, tempObjv,
+		/* call from TEBC, TclGetSrcInfoForCmd sentinel */(char *) -1, 
+		ENSEMBLE_PSEUDO_COMMAND, TCL_EVAL_INVOKE);
 
 	/*
 	 * Clean up.

generic/tclParse.c

@@ -14,6 +14,7 @@
  */
 
 #include "tclInt.h"
+#include "tclParse.h"
 
 /*
  * The following table provides parsing information about each possible 8-bit
@@ -41,18 +42,7 @@
  * TYPE_BRACE -		Character is a curly brace (either left or right).
  */
 
-#define TYPE_NORMAL		0
-#define TYPE_SPACE		0x1
-#define TYPE_COMMAND_END	0x2
-#define TYPE_SUBS		0x4
-#define TYPE_QUOTE		0x8
-#define TYPE_CLOSE_PAREN	0x10
-#define TYPE_CLOSE_BRACK	0x20
-#define TYPE_BRACE		0x40
-
-#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
-
-static const char charTypeTable[] = {
+const char charTypeTable[] = {
     /*
      * Negative character values, from -128 to -1:
      */

generic/tclParse.h

@@ -0,0 +1,17 @@
+/*
+ * Minimal set of shared macro definitions and declarations so that multiple
+ * source files can make use of the parsing table in tclParse.c
+ */
+
+#define TYPE_NORMAL		0
+#define TYPE_SPACE		0x1
+#define TYPE_COMMAND_END	0x2
+#define TYPE_SUBS		0x4
+#define TYPE_QUOTE		0x8
+#define TYPE_CLOSE_PAREN	0x10
+#define TYPE_CLOSE_BRACK	0x20
+#define TYPE_BRACE		0x40
+
+#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
+
+MODULE_SCOPE const char charTypeTable[];

generic/tclUtil.c

@@ -13,6 +13,7 @@
  */
 
 #include "tclInt.h"
+#include "tclParse.h"
 #include <float.h>
 #include <math.h>
 
@@ -964,6 +965,7 @@ TclScanElement(
     }
 
     while (length) {
+      if (CHAR_TYPE(*p) != TYPE_NORMAL) {
 	switch (*p) {
 	case '{':
 #if COMPAT
@@ -1040,6 +1042,7 @@ TclScanElement(
 	    /* TODO: Panic on improper encoding? */
 	    break;
 	}
+      }
 	length -= (length > 0);
 	p++;
     }

unix/Makefile.in

@@ -928,6 +928,7 @@ COMPILEHDR=$(GENERIC_DIR)/tclCompile.h
 FSHDR=$(GENERIC_DIR)/tclFileSystem.h
 IOHDR=$(GENERIC_DIR)/tclIO.h
 MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
+PARSEHDR=$(GENERIC_DIR)/tclParse.h
 
 regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
 		$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
@@ -1090,7 +1091,7 @@ tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c
 tclNotify.o: $(GENERIC_DIR)/tclNotify.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c
 
-tclParse.o: $(GENERIC_DIR)/tclParse.c
+tclParse.o: $(GENERIC_DIR)/tclParse.c $(PARSEHDR)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclParse.c
 
 tclPanic.o: $(GENERIC_DIR)/tclPanic.c
@@ -1162,7 +1163,7 @@ tclStubInit.o: $(GENERIC_DIR)/tclStubInit.c
 tclTrace.o: $(GENERIC_DIR)/tclTrace.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTrace.c
 
-tclUtil.o: $(GENERIC_DIR)/tclUtil.c
+tclUtil.o: $(GENERIC_DIR)/tclUtil.c $(PARSEHDR)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtil.c
 
 tclUtf.o: $(GENERIC_DIR)/tclUtf.c $(GENERIC_DIR)/tclUniData.c

win/tclWinPort.h

@@ -29,6 +29,12 @@ typedef DWORD DWORD_PTR;
 typedef DWORD_PTR * PDWORD_PTR;
 #endif
 
+/* Compatibility to older visual studio / windows platform SDK */
+#if !defined(MAXULONG_PTR)
+typedef DWORD DWORD_PTR;
+typedef DWORD_PTR * PDWORD_PTR;
+#endif
+
 /*
  * Ask for the winsock function typedefs, also.
  */