From 5f87593323244e86ce48d4aa8c21ad14f5d91db3 Mon Sep 17 00:00:00 2001
From: vincentdarley <vincentdarley>
Date: Sun, 26 Mar 2006 17:52:39 +0000
Subject: fix for text dump -command callbacks which modify the text widget

---
 ChangeLog             |   9 +++
 generic/tkText.c      | 153 +++++++++++++++++++++++++++++++++++---------------
 generic/tkText.h      |   3 +-
 generic/tkTextBTree.c |  34 ++++++++++-
 tests/text.test       |  15 ++++-
 5 files changed, 167 insertions(+), 47 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 187682c..76e0957 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2006-03-26  Vince Darley <vincentdarley@users.sourceforge.net>
+
+	* generic/tkText.c: 
+	* generic/tkText.h:
+	* generic/tkTextBTree.c:
+	* tests/text.test: Fix for [Bug 1414171] for '$text dump
+	-command <script>' where 'script' actually modifies the
+	widget during the process.
+
 2006-03-25  Daniel Steffen  <das@users.sourceforge.net>
 
 	* macosx/tkMacOSXDraw.c (TkMacOSXSetUpCGContext): 
diff --git a/generic/tkText.c b/generic/tkText.c
index 7b8586f..2172e01 100644
--- a/generic/tkText.c
+++ b/generic/tkText.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkText.c,v 1.65 2006/03/18 15:52:32 vincentdarley Exp $
+ * RCS: @(#) $Id: tkText.c,v 1.66 2006/03/26 17:52:39 vincentdarley Exp $
  */
 
 #include "default.h"
@@ -379,12 +379,12 @@ static void		TextWorldChangedCallback(ClientData instanceData);
 static void		TextWorldChanged(TkText *textPtr, int mask);
 static int		TextDumpCmd(TkText *textPtr, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
-static void		DumpLine(Tcl_Interp *interp, TkText *textPtr, int what,
+static int		DumpLine(Tcl_Interp *interp, TkText *textPtr, int what,
 			    TkTextLine *linePtr, int start, int end,
-			    int lineno, CONST char *command);
+			    int lineno, Tcl_Obj *command);
 static int		DumpSegment(TkText *textPtr, Tcl_Interp *interp,
 			    CONST char *key, CONST char *value,
-			    CONST char *command, CONST TkTextIndex *index,
+			    Tcl_Obj *command, CONST TkTextIndex *index,
 			    int what);
 static int		TextEditUndo(TkText *textPtr);
 static int		TextEditRedo(TkText *textPtr);
@@ -4425,7 +4425,7 @@ TextDumpCmd(textPtr, interp, objc, objv)
     int what = 0;		/* bitfield to select segment types */
     int atEnd;			/* True if dumping up to logical end */
     TkTextLine *linePtr;
-    CONST char *command = NULL;	/* Script callback to apply to segments */
+    Tcl_Obj *command = NULL;	/* Script callback to apply to segments */
 #define TK_DUMP_TEXT	0x1
 #define TK_DUMP_MARK	0x2
 #define TK_DUMP_TAG	0x4
@@ -4477,7 +4477,7 @@ TextDumpCmd(textPtr, interp, objc, objv)
 			"?-command script? index ?index2?", NULL);
 		return TCL_ERROR;
 	    }
-	    command = Tcl_GetString(objv[arg]);
+	    command = objv[arg];
 	    break;
 	default:
 	    Tcl_Panic("unexpected switch fallthrough");
@@ -4495,11 +4495,10 @@ TextDumpCmd(textPtr, interp, objc, objv)
     if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index1) != TCL_OK) {
 	return TCL_ERROR;
     }
-    lineno = TkBTreeLinesTo(textPtr, index1.linePtr);
     arg++;
     atEnd = 0;
     if (objc == arg) {
-	TkTextIndexForwChars(NULL,&index1, 1, &index2, COUNT_INDICES);
+	TkTextIndexForwChars(NULL, &index1, 1, &index2, COUNT_INDICES);
     } else {
 	int length;
 	char *str;
@@ -4515,23 +4514,41 @@ TextDumpCmd(textPtr, interp, objc, objv)
     if (TkTextIndexCmp(&index1, &index2) >= 0) {
 	return TCL_OK;
     }
+    lineno = TkBTreeLinesTo(textPtr, index1.linePtr);
     if (index1.linePtr == index2.linePtr) {
 	DumpLine(interp, textPtr, what, index1.linePtr,
 		index1.byteIndex, index2.byteIndex, lineno, command);
     } else {
-	DumpLine(interp, textPtr, what, index1.linePtr,
+	int textChanged;
+	int lineend = TkBTreeLinesTo(textPtr, index2.linePtr);
+	int endByteIndex = index2.byteIndex;
+	
+	textChanged = DumpLine(interp, textPtr, what, index1.linePtr,
 		index1.byteIndex, 32000000, lineno, command);
-	linePtr = index1.linePtr;
+	if (textChanged) {
+	    linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, 
+				      textPtr, lineno);
+	    textChanged = 0;
+	} else {
+	    linePtr = index1.linePtr;
+	}
 	while ((linePtr = TkBTreeNextLine(textPtr, linePtr)) != NULL) {
 	    lineno++;
-	    if (linePtr == index2.linePtr) {
+	    if (lineno == lineend) {
 		break;
 	    }
-	    DumpLine(interp, textPtr, what, linePtr, 0, 32000000,
+	    textChanged = DumpLine(interp, textPtr, what, linePtr, 0, 32000000,
 		    lineno, command);
+	    if (textChanged) {
+		linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, 
+					  textPtr, lineno);
+		textChanged = 0;
+	    }
+	}
+	if (linePtr != NULL) {
+	    DumpLine(interp, textPtr, what, linePtr, 0,
+		     endByteIndex, lineno, command);
 	}
-	DumpLine(interp, textPtr, what, index2.linePtr, 0,
-		index2.byteIndex, lineno, command);
     }
 
     /*
@@ -4539,6 +4556,10 @@ TextDumpCmd(textPtr, interp, objc, objv)
      */
 
     if (atEnd) {
+	/* Re-get the end index, in case it has changed */
+	if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index2) != TCL_OK) {
+	    return TCL_ERROR;
+	}
 	DumpLine(interp, textPtr, what & ~TK_DUMP_TEXT, index2.linePtr,
 		0, 1, lineno, command);
     }
@@ -4554,14 +4575,17 @@ TextDumpCmd(textPtr, interp, objc, objv)
  *	"start" up to, but not including, "end".
  *
  * Results:
- *	A standard Tcl result.
+ *	Returns 1 if the command callback made any changes to the text
+ *	widget which will have invalidated internal structures such as
+ *	TkTextSegment, TkTextIndex, pointers.  Our caller can then take
+ *	action to recompute such entities.  Returns 0 otherwise.
  *
  * Side effects:
- *	None, but see DumpSegment.
+ *	None, but see DumpSegment which can have arbitrary side-effects
  *
  *----------------------------------------------------------------------
  */
-static void
+static int
 DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command)
     Tcl_Interp *interp;
     TkText *textPtr;
@@ -4569,9 +4593,9 @@ DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command)
     TkTextLine *linePtr;	/* The current line */
     int startByte, endByte;	/* Byte range to dump */
     int lineno;			/* Line number for indices dump */
-    CONST char *command;	/* Script to apply to the segment */
+    Tcl_Obj *command;   	/* Script to apply to the segment */
 {
-    int offset;
+    int offset = 0;
     TkTextSegment *segPtr;
     TkTextIndex index;
     /*
@@ -4583,13 +4607,16 @@ DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command)
      * window
      */
 
-    for (offset = 0, segPtr = linePtr->segPtr ;
-	    (offset < endByte) && (segPtr != NULL) ;
-	    offset += segPtr->size, segPtr = segPtr->nextPtr) {
+    int textChanged = 0;
+    
+    segPtr = linePtr->segPtr;
+    while ((offset < endByte) && (segPtr != NULL)) {
+	int lineChanged = 0;
+	int currentSize = segPtr->size;
+	
 	if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) &&
 		(offset + segPtr->size > startByte)) {
-	    char savedChar;		/* Last char used in the seg */
-	    int last = segPtr->size;	/* Index of savedChar */
+	    int last = segPtr->size;	/* Index of last char in seg */
 	    int first = 0;		/* Index of first char in seg */
 
 	    if (offset + segPtr->size > endByte) {
@@ -4598,14 +4625,30 @@ DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command)
 	    if (startByte > offset) {
 		first = startByte - offset;
 	    }
-	    savedChar = segPtr->body.chars[last];
-	    segPtr->body.chars[last] = '\0';
-
-	    TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, lineno,
-		    offset + first, &index);
-	    DumpSegment(textPtr, interp, "text", segPtr->body.chars + first,
-		    command, &index, what);
-	    segPtr->body.chars[last] = savedChar;
+	    if (last != segPtr->size) {
+		/*
+		 * To avoid modifying the string in place we copy over
+		 * just the segment that we want.  Since DumpSegment can
+		 * modify the text, we could not confidently revert the
+		 * modification here.
+		 */
+		int length = last - first;
+		
+		char *range = (char*) ckalloc((length + 1) * sizeof(char));
+		memcpy(range, segPtr->body.chars + first, length * sizeof(char));
+		range[length] = '\0';
+
+		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, lineno,
+			offset + first, &index);
+		lineChanged = DumpSegment(textPtr, interp, "text", range,
+			command, &index, what);
+		ckfree(range);
+	    } else {
+		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, lineno,
+			offset + first, &index);
+		lineChanged = DumpSegment(textPtr, interp, "text", segPtr->body.chars + first,
+			command, &index, what);
+	    }
 	} else if ((offset >= startByte)) {
 	    if ((what & TK_DUMP_MARK) && (segPtr->typePtr->name[0] == 'm')) {
 		char *name;
@@ -4621,19 +4664,19 @@ DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command)
 		}
 		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
 			lineno, offset, &index);
-		DumpSegment(textPtr, interp, "mark", name, command, &index, what);
+		lineChanged = DumpSegment(textPtr, interp, "mark", name, command, &index, what);
 	    } else if ((what & TK_DUMP_TAG) &&
 		    (segPtr->typePtr == &tkTextToggleOnType)) {
 		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
 			lineno, offset, &index);
-		DumpSegment(textPtr, interp, "tagon",
+		lineChanged = DumpSegment(textPtr, interp, "tagon",
 			segPtr->body.toggle.tagPtr->name, command, &index,
 			what);
 	    } else if ((what & TK_DUMP_TAG) &&
 		    (segPtr->typePtr == &tkTextToggleOffType)) {
 		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
 			lineno, offset, &index);
-		DumpSegment(textPtr, interp, "tagoff",
+		lineChanged = DumpSegment(textPtr, interp, "tagoff",
 			segPtr->body.toggle.tagPtr->name, command, &index,
 			what);
 	    } else if ((what & TK_DUMP_IMG) &&
@@ -4643,7 +4686,7 @@ DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command)
 
 		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
 			lineno, offset, &index);
-		DumpSegment(textPtr, interp, "image", name, command, &index,
+		lineChanged = DumpSegment(textPtr, interp, "image", name, command, &index,
 			what);
 	    } else if ((what & TK_DUMP_WIN) &&
 		    (segPtr->typePtr->name[0] == 'w')) {
@@ -4657,11 +4700,25 @@ DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command)
 		}
 		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
 			lineno, offset, &index);
-		DumpSegment(textPtr, interp, "window", pathname, command,
+		lineChanged = DumpSegment(textPtr, interp, "window", pathname, command,
 			&index, what);
 	    }
 	}
+	offset += currentSize;
+	if (lineChanged) {
+	    int newOffset = 0;
+	    textChanged = 1;
+	    /* Our indices are no longer valid */
+	    linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr, lineno);
+	    segPtr = linePtr->segPtr;
+	    while ((newOffset < endByte) && (newOffset < offset) && (segPtr != NULL)) {
+	        segPtr = segPtr->nextPtr;
+	    }
+	} else {
+	    segPtr = segPtr->nextPtr;
+	}
     }
+    return textChanged;
 }
 
 /*
@@ -4673,10 +4730,14 @@ DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command)
  *	make a script callback with that information as arguments.
  *
  * Results:
- *	None
+ *	Returns 1 if the command callback made any changes to the text
+ *	widget which will have invalidated internal structures such as
+ *	TkTextSegment, TkTextIndex, pointers.  Our caller can then take
+ *	action to recompute such entities.  Returns 0 otherwise.
  *
  * Side effects:
  *	Either evals the callback or appends elements to the result string.
+ *	The callback can have arbitrary side-effects.
  *
  *----------------------------------------------------------------------
  */
@@ -4687,7 +4748,7 @@ DumpSegment(textPtr, interp, key, value, command, index, what)
     Tcl_Interp *interp;
     CONST char *key;		/* Segment type key */
     CONST char *value;		/* Segment value */
-    CONST char *command;	/* Script callback */
+    Tcl_Obj *command;   	/* Script callback */
     CONST TkTextIndex *index;	/* index with line/byte position info */
     int what;			/* Look for TK_DUMP_INDEX bit */
 {
@@ -4698,20 +4759,24 @@ DumpSegment(textPtr, interp, key, value, command, index, what)
 	Tcl_AppendElement(interp, key);
 	Tcl_AppendElement(interp, value);
 	Tcl_AppendElement(interp, buffer);
-	return TCL_OK;
+	return 0;
     } else {
 	CONST char *argv[4];
 	char *list;
-	int result;
-
+	int oldStateEpoch = TkBTreeEpoch(textPtr->sharedTextPtr->tree);
+	
 	argv[0] = key;
 	argv[1] = value;
 	argv[2] = buffer;
 	argv[3] = NULL;
 	list = Tcl_Merge(3, argv);
-	result = Tcl_VarEval(interp, command, " ", list, NULL);
+	Tcl_VarEval(interp, Tcl_GetString(command), " ", list, NULL);
 	ckfree(list);
-	return result;
+	if (TkBTreeEpoch(textPtr->sharedTextPtr->tree) != oldStateEpoch) {
+	    return 1;
+	} else {
+	    return 0;
+	}
     }
 }
 
diff --git a/generic/tkText.h b/generic/tkText.h
index 1357055..464ff5e 100644
--- a/generic/tkText.h
+++ b/generic/tkText.h
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkText.h,v 1.29 2005/11/27 02:36:14 das Exp $
+ * RCS: @(#) $Id: tkText.h,v 1.30 2006/03/26 17:52:40 vincentdarley Exp $
  */
 
 #ifndef _TKTEXT
@@ -979,6 +979,7 @@ MODULE_SCOPE void	TkBTreeRemoveClient(TkTextBTree tree,
 MODULE_SCOPE void	TkBTreeDestroy(TkTextBTree tree);
 MODULE_SCOPE void	TkBTreeDeleteIndexRange(TkTextBTree tree,
 			    TkTextIndex *index1Ptr, TkTextIndex *index2Ptr);
+MODULE_SCOPE int	TkBTreeEpoch(TkTextBTree tree);
 MODULE_SCOPE TkTextLine *TkBTreeFindLine(TkTextBTree tree,
 			    CONST TkText *textPtr, int line);
 MODULE_SCOPE TkTextLine *TkBTreeFindPixelLine(TkTextBTree tree,
diff --git a/generic/tkTextBTree.c b/generic/tkTextBTree.c
index 153c780..908a557 100644
--- a/generic/tkTextBTree.c
+++ b/generic/tkTextBTree.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkTextBTree.c,v 1.20 2005/11/17 16:21:56 dkf Exp $
+ * RCS: @(#) $Id: tkTextBTree.c,v 1.21 2006/03/26 17:52:40 vincentdarley Exp $
  */
 
 #include "tkInt.h"
@@ -108,6 +108,8 @@ typedef struct BTree {
     int clients;		/* Number of clients of this B-tree. */
     int pixelReferences;	/* Number of clients of this B-tree which care
 				 * about pixel heights. */
+    int stateEpoch;             /* Updated each time any aspect of the B-tree
+                                 * changes. */
     TkSharedText *sharedTextPtr;/* Used to find tagTable in consistency
 				 * checking code, and to access list of all
 				 * B-tree clients. */
@@ -323,6 +325,7 @@ TkBTreeCreate(sharedTextPtr)
     treePtr->sharedTextPtr = sharedTextPtr;
     treePtr->rootPtr = rootPtr;
     treePtr->clients = 0;
+    treePtr->stateEpoch = 0;
     treePtr->pixelReferences = 0;
     treePtr->startEndCount = 0;
     treePtr->startEnd = NULL;
@@ -491,6 +494,31 @@ TkBTreeDestroy(tree)
 /*
  *----------------------------------------------------------------------
  *
+ * TkBTreeEpoch --
+ *
+ *	Return the epoch for the B-tree.  This number is incremented
+ *	any time anything changes in the tree.
+ *
+ * Results:
+ *	The epoch number.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeEpoch(tree)
+    TkTextBTree tree;		/* Tree to get epoch for */
+{
+    BTree *treePtr = (BTree *) tree;
+    return treePtr->stateEpoch;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TkBTreeRemoveClient --
  *
  *	Remove a client widget from its B-tree, cleaning up the pixel arrays
@@ -1012,6 +1040,7 @@ TkBTreeInsertChars(tree, indexPtr, string)
     int pixels[PIXEL_CLIENTS];
 
     BTree *treePtr = (BTree*)tree;
+    treePtr->stateEpoch++;
     prevPtr = SplitSeg(indexPtr);
     linePtr = indexPtr->linePtr;
     curPtr = prevPtr;
@@ -1306,6 +1335,7 @@ TkBTreeDeleteIndexRange(tree, index1Ptr, index2Ptr)
     int changeToLineCount = 0;
     int ref;
     BTree *treePtr = (BTree*)tree;
+    treePtr->stateEpoch++;
 
     /*
      * Tricky point: split at index2Ptr first; otherwise the split at
@@ -2006,6 +2036,7 @@ TkBTreeLinkSegment(segPtr, indexPtr)
     if (tkBTreeDebug) {
 	TkBTreeCheck(indexPtr->tree);
     }
+    ((BTree*)indexPtr->tree)->stateEpoch++;
 }
 
 /*
@@ -2201,6 +2232,7 @@ TkBTreeTag(index1Ptr, index2Ptr, tagPtr, add)
 	if (cleanupLinePtr != index2Ptr->linePtr) {
 	    CleanupLine(index2Ptr->linePtr);
 	}
+	((BTree*)index1Ptr->tree)->stateEpoch++;
     }
 
     if (tkBTreeDebug) {
diff --git a/tests/text.test b/tests/text.test
index a12d97e..2cb3342 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: text.test,v 1.41 2005/12/02 17:23:44 dgp Exp $
+# RCS: @(#) $Id: text.test,v 1.42 2006/03/26 17:52:40 vincentdarley Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -3712,6 +3712,19 @@ test text-32.1 {peer widget -start, -end and selection} {
     set res
 } {{10.0 20.0} {6.0 16.0} {6.0 11.0} {1.0 6.0} {1.0 2.0} {} {10.0 20.0}}
 
+test text-33.1 {widget dump -command alters tags} {
+    .t delete 1.0 end
+    .t insert end "abc\n" a "---" {} "def" b "   \n" {} "ghi\n" c
+    .t tag configure b -background red
+
+    proc Dumpy {key value index} {
+      #puts "KK: $key, $value"
+      .t tag add $value [list $index linestart] [list $index lineend]
+    }
+    .t dump -all -command Dumpy 1.0 end
+    set result "ok"
+} {ok}
+
 deleteWindows
 option clear
 
-- 
cgit v0.12