further fixes to $text dump -command

3 files changed, 70 insertions, 6 deletions

diff --git a/ChangeLog b/ChangeLog
index b8b2c84..6ae353b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2006-03-26  Vince Darley <vincentdarley@users.sourceforge.net>
+
+	* generic/tkText.c: 
+	* tests/text.test: Fix for elaborations of [Bug 1414171] for 
+	'$text dump -command <script>' where script deletes large
+	portions of the text widget, or even destroys the widget.
+
 2006-03-28  Daniel Steffen  <das@users.sourceforge.net>
 
 	* macosx/Wish.xcode/default.pbxuser:     add '-singleproc 1' cli arg to
diff --git a/generic/tkText.c b/generic/tkText.c
index 2172e01..fb45e66 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.66 2006/03/26 17:52:39 vincentdarley Exp $
+ * RCS: @(#) $Id: tkText.c,v 1.67 2006/03/28 19:26:52 vincentdarley Exp $
  */
 
 #include "default.h"
@@ -4526,6 +4526,7 @@ TextDumpCmd(textPtr, interp, objc, objv)
 	textChanged = DumpLine(interp, textPtr, what, index1.linePtr,
 		index1.byteIndex, 32000000, lineno, command);
 	if (textChanged) {
+	    if (textPtr->flags & DESTROYED) return TCL_OK;
 	    linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, 
 				      textPtr, lineno);
 	    textChanged = 0;
@@ -4540,6 +4541,7 @@ TextDumpCmd(textPtr, interp, objc, objv)
 	    textChanged = DumpLine(interp, textPtr, what, linePtr, 0, 32000000,
 		    lineno, command);
 	    if (textChanged) {
+		if (textPtr->flags & DESTROYED) return TCL_OK;
 		linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, 
 					  textPtr, lineno);
 		textChanged = 0;
@@ -4548,6 +4550,7 @@ TextDumpCmd(textPtr, interp, objc, objv)
 	if (linePtr != NULL) {
 	    DumpLine(interp, textPtr, what, linePtr, 0,
 		     endByteIndex, lineno, command);
+	    if (textPtr->flags & DESTROYED) return TCL_OK;
 	}
     }
 
@@ -4556,6 +4559,7 @@ TextDumpCmd(textPtr, interp, objc, objv)
      */
 
     if (atEnd) {
+	if (textPtr->flags & DESTROYED) return TCL_OK;
 	/* Re-get the end index, in case it has changed */
 	if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index2) != TCL_OK) {
 	    return TCL_ERROR;
@@ -4706,13 +4710,40 @@ DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command)
 	}
 	offset += currentSize;
 	if (lineChanged) {
+	    TkTextSegment * newSegPtr;
 	    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;
+	    if (textPtr->flags & DESTROYED) {
+		return textChanged;
+	    }
+	    linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, 
+				      textPtr, lineno);
+	    newSegPtr = linePtr->segPtr;
+	    if (segPtr == newSegPtr) {
+		segPtr = segPtr->nextPtr;
+	    } else {
+		while ((newOffset < endByte) && (newOffset < offset) 
+		  && (newSegPtr != NULL)) {
+		    newOffset += segPtr->size;
+		    newSegPtr = newSegPtr->nextPtr;
+		    if (segPtr == newSegPtr) break;
+		}
+		if (segPtr != newSegPtr && newOffset == offset 
+		  && currentSize == 0) {
+		    TkTextSegment *searchPtr = newSegPtr;
+		    while (searchPtr != NULL && searchPtr->size == 0) {
+			if (searchPtr == segPtr) {
+			    newSegPtr = searchPtr;
+			    break;
+			}
+			searchPtr = searchPtr->nextPtr;
+		    }
+		}
+		segPtr = newSegPtr;
+		if (segPtr != NULL) {
+		    segPtr = segPtr->nextPtr;
+		}
 	    }
 	} else {
 	    segPtr = segPtr->nextPtr;
diff --git a/tests/text.test b/tests/text.test
index 2cb3342..23b8388 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.42 2006/03/26 17:52:40 vincentdarley Exp $
+# RCS: @(#) $Id: text.test,v 1.43 2006/03/28 19:26:52 vincentdarley Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -3725,6 +3725,32 @@ test text-33.1 {widget dump -command alters tags} {
     set result "ok"
 } {ok}
 
+test text-33.2 {widget dump -command makes massive changes} {
+    .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 delete 1.0 end
+    }
+    .t dump -all -command Dumpy 1.0 end
+    set result "ok"
+} {ok}
+
+test text-33.3 {widget dump -command destroys widget} {
+    .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"
+      destroy .t
+    }
+    .t dump -all -command Dumpy 1.0 end
+    set result "ok"
+} {ok}
+
 deleteWindows
 option clear