summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog9
-rw-r--r--generic/tkText.c38
-rw-r--r--tests/safe.test6
-rw-r--r--tests/text.test10
-rw-r--r--tests/textWind.test12
-rw-r--r--tests/winDialog.test17
-rw-r--r--tests/winWm.test42
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}