generic/tkText.c: Applied suggested patch from #1536735

tests/text.test:  Update test for above patch.
tests/textWind.test:  Corrected test to catch all messages
tests/safe.test: Silence spurious win32 failure awaiting TIP150
tests/winDialog.test: Updated test for file name length check.
test/winWm.test: Corrected test expectation for menu wrapping.

7 files changed, 78 insertions, 56 deletions

diff --git a/ChangeLog b/ChangeLog
index 3733f9d..bcc6e16 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2006-10-17  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* generic/tkText.c: Applied suggested patch from #1536735
+	* tests/text.test:  Update test for above patch.
+	* tests/textWind.test:  Corrected test to catch all messages
+	* tests/safe.test: Silence spurious win32 failure awaiting TIP150
+	* tests/winDialog.test: Updated test for file name length check.
+	* test/winWm.test: Corrected test expectation for menu wrapping.
+
 2006-10-16  Andreas Kupries <andreask@activestate.com>
 
 	*** 8.5a5 TAGGED FOR RELEASE ***
diff --git a/generic/tkText.c b/generic/tkText.c
index 93b8925..ca1626d 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.70 2006/09/10 17:06:32 das Exp $
+ * RCS: @(#) $Id: tkText.c,v 1.71 2006/10/17 10:21:49 patthoyts Exp $
  */
 
 #include "default.h"
@@ -2956,6 +2956,8 @@ DeleteIndexRange(sharedTextPtr, textPtr, indexPtr1, indexPtr2, viewUpdate)
      * are present on the newline that isn't going to be deleted after all
      * (this simulates deleting the newline and then adding a "clean" one back
      * again).
+     * Note that index1 and index2 might now be equal again which means that
+     * no text will be deleted but tags might be removed.
      */
 
     line1 = TkBTreeLinesTo(textPtr, index1.linePtr);
@@ -3087,27 +3089,29 @@ DeleteIndexRange(sharedTextPtr, textPtr, indexPtr1, indexPtr2, viewUpdate)
     }
 
     /*
-     * Push the deletion on the undo stack
+     * Push the deletion on the undo stack if something was actually deleted
      */
 
-    if (sharedTextPtr->undo) {
-	Tcl_Obj *get;
-
-	if (sharedTextPtr->autoSeparators
+    if (TkTextIndexCmp(&index1, &index2) < 0) {
+	if (sharedTextPtr->undo) {
+	    Tcl_Obj *get;
+	    
+	    if (sharedTextPtr->autoSeparators
 		&& (sharedTextPtr->lastEditMode != TK_TEXT_EDIT_DELETE)) {
-	    TkUndoInsertUndoSeparator(sharedTextPtr->undoStack);
+		TkUndoInsertUndoSeparator(sharedTextPtr->undoStack);
+	    }
+	    
+	    sharedTextPtr->lastEditMode = TK_TEXT_EDIT_DELETE;
+	    
+	    get = TextGetText(textPtr, &index1, &index2, 0);
+	    TextPushUndoAction(textPtr, get, 0, &index1, &index2);
 	}
-
-	sharedTextPtr->lastEditMode = TK_TEXT_EDIT_DELETE;
-
-	get = TextGetText(textPtr, &index1, &index2, 0);
-	TextPushUndoAction(textPtr, get, 0, &index1, &index2);
+	UpdateDirtyFlag(sharedTextPtr);
+	
+	sharedTextPtr->stateEpoch++;
+	
+	TkBTreeDeleteIndexRange(sharedTextPtr->tree, &index1, &index2);
     }
-    UpdateDirtyFlag(sharedTextPtr);
-
-    sharedTextPtr->stateEpoch++;
-
-    TkBTreeDeleteIndexRange(sharedTextPtr->tree, &index1, &index2);
 
     resetViewCount = 0;
     for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
diff --git a/tests/safe.test b/tests/safe.test
index fded018..bbfd095 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: safe.test,v 1.15 2004/12/06 22:54:12 dgp Exp $
+# RCS: @(#) $Id: safe.test,v 1.16 2006/10/17 10:21:50 patthoyts Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -34,8 +34,8 @@ tcltest::loadTestedCommands
 
 # The set of hidden commands is platform dependent:
 
-if {"$tcl_platform(platform)" == "windows"} {
-    set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
+if {[string equal $tcl_platform(platform) "windows"]} {
+    set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
 } else {
     set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source toplevel wm}
 }
diff --git a/tests/text.test b/tests/text.test
index b4e3954..e115d43 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.45 2006/08/18 10:49:34 dkf Exp $
+# RCS: @(#) $Id: text.test,v 1.46 2006/10/17 10:21:50 patthoyts Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -3068,10 +3068,12 @@ test text-25.13 {-maxundo configuration option} {
 test text-25.15 {bug fix 1536735 - undo with empty text} {
     catch {destroy .t}
     text .t -undo 1
+    set r [.t edit modified]
     .t delete 1.0
-    .t edit undo
-    .t edit modified
-} {0}
+    lappend r [.t edit modified]
+    lappend r [catch {.t edit undo}]
+    lappend r [.t edit modified]
+} {0 0 1 0}
 
 test text-26.1 {bug fix - 624372, ControlUtfProc long lines} {
     destroy .t
diff --git a/tests/textWind.test b/tests/textWind.test
index 1044cfe..b6739c2 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textWind.test,v 1.21 2006/04/05 20:57:08 hobbs Exp $
+# RCS: @(#) $Id: textWind.test,v 1.22 2006/10/17 10:21:50 patthoyts Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -446,11 +446,13 @@ test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} {textf
     .t delete 1.0 end
     .t insert 1.0 "Some sample text"
     catch {destroy .t.f}
-    .t window create 1.5 -create {
-	frame .t.f
-	frame .t.f.f -width 10 -height 20 -bg $color
-    }
     set msg {}
+    after idle {
+        .t window create 1.5 -create {
+            frame .t.f
+            frame .t.f.f -width 10 -height 20 -bg $color
+        }
+    }
     set count 0
     while {([llength $msg] < 2) && ($count < 100)} {
 	update ; incr count; .t bbox 1.5 ; after 10
diff --git a/tests/winDialog.test b/tests/winDialog.test
index c89ff27..38f125b 100644
--- a/tests/winDialog.test
+++ b/tests/winDialog.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # Copyright (c) 1998-1999 ActiveState Corporation.
 #
-# RCS: @(#) $Id: winDialog.test,v 1.12 2004/12/20 10:34:20 vincentdarley Exp $
+# RCS: @(#) $Id: winDialog.test,v 1.13 2006/10/17 10:21:50 patthoyts Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -171,18 +171,17 @@ test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} {
 #		if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 
     list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg
 } {1 {user "12x" doesn't exist}}
-set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
-append a $a
-append a $a
-append a $a
-append a $a
 test winDialog-5.16 {GetFileName: initial file: long name} {nt testwinevent} {
-    start {set x [tk_getSaveFile -initialfile $a -title Long]}
+    start {
+        set dialogresult [catch {
+            tk_getSaveFile -initialfile [string repeat a 1024] -title Long
+        } x]
+    }
     then {
 	Click 1
     }
-    string totitle $x
-} [string totitle [string range [file join [pwd] $a] 0 257]]
+    list $dialogresult [string match "invalid filename *" $x]
+} {1 1}
 test winDialog-5.17 {GetFileName: parent} {nt} {
 #	    case FILE_PARENT: 
 
diff --git a/tests/winWm.test b/tests/winWm.test
index 95b71cb..e3b0d84 100644
--- a/tests/winWm.test
+++ b/tests/winWm.test
@@ -9,7 +9,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: winWm.test,v 1.16 2005/02/17 00:06:08 mdejong Exp $
+# RCS: @(#) $Id: winWm.test,v 1.17 2006/10/17 10:21:50 patthoyts Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -22,14 +22,14 @@ frame .t.f -width 100 -height 50
 pack .t.f
 menu .t.m
 .t.m add command -label "thisisreallylong"
-.t conf -menu .t.m
-wm geom .t -0-0
+.t configure -menu .t.m
+wm geometry .t -0-0
 update
 set menuheight [winfo y .t]
 .t.m add command -label "thisisreallylong"
-wm geom .t -0-0
+wm geometry .t -0-0
 update
-set menuheight [expr $menuheight - [winfo y .t]]
+set menuheight [expr {$menuheight - [winfo y .t]}]
 destroy .t
 
 test winWm-1.1 {TkWmMapWindow} win {
@@ -58,7 +58,7 @@ test winWm-1.3 {TkWmMapWindow} win {
     update
     toplevel .t2
     update
-    set result [expr [winfo x .t] != [winfo x .t2]]
+    set result [expr {[winfo x .t] != [winfo x .t2]}]
     destroy .t .t2
     set result
 } 1
@@ -163,7 +163,7 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win {
     update
     pack .t.b
     update
-    set x [expr $x == [winfo x .t.b]]
+    set x [expr {$x == [winfo x .t.b]}]
     destroy .t
     set x
 } 1
@@ -171,30 +171,35 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win {
 test winWm-4.1 {ConfigureTopLevel: menu resizing} win {
     set result {}
     toplevel .t
-    frame .t.f -width 150 -height 50 -bg red
+    frame .t.f -width 150 -height 50 -background red
     pack .t.f
     wm geometry .t -0-0
     update
     set y [winfo y .t]
     menu .t.m
     .t.m add command -label foo
-    .t conf -menu .t.m
+    .t configure -menu .t.m
     update
-    set result [expr $y - [winfo y .t]]
+    set result [expr {$y - [winfo y .t]}]
     destroy .t
     set result
-} [expr $menuheight + 1]
+} [expr {$menuheight + 1}]
 
+# This test works on 8.0p2 but has not worked on anything since 8.2.
+# It would be very strange to have a windows application increase the size
+# of the clientarea when a menu wraps so I believe this test to be wrong.
+# Original result was {50 50 50} new result may depend on the default menu
+# font
 test winWm-5.1 {UpdateGeometryInfo: menu resizing} win {
     set result {}
     toplevel .t
-    frame .t.f -width 150 -height 50 -bg red
+    frame .t.f -width 150 -height 50 -background red
     pack .t.f
     update
     set result [winfo height .t]
     menu .t.m
     .t.m add command -label foo
-    .t conf -menu .t.m
+    .t configure -menu .t.m
     update
     lappend result [winfo height .t]
     .t.m add command -label "thisisreallylong"
@@ -202,25 +207,26 @@ test winWm-5.1 {UpdateGeometryInfo: menu resizing} win {
     update
     lappend result [winfo height .t]
     destroy .t
+    
     set result
-} {50 50 50}
+} {50 50 31}
 test winWm-5.2 {UpdateGeometryInfo: menu resizing} win {
     set result {}
     toplevel .t
-    frame .t.f -width 150 -height 50 -bg red
+    frame .t.f -width 150 -height 50 -background red
     pack .t.f
-    wm geom .t -0-0
+    wm geometry .t -0-0
     update
     set y [winfo rooty .t]
     lappend result [winfo height .t]
     menu .t.m
-    .t conf -menu .t.m
+    .t configure -menu .t.m
     .t.m add command -label foo
     .t.m add command -label "thisisreallylong"
     .t.m add command -label "thisisreallylong"
     update
     lappend result [winfo height .t]
-    lappend result [expr $y - [winfo rooty .t]]
+    lappend result [expr {$y - [winfo rooty .t]}]
     destroy .t
     set result
 } {50 50 0}