diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tkText.c | 38 | ||||
| -rw-r--r-- | tests/safe.test | 6 | ||||
| -rw-r--r-- | tests/text.test | 10 | ||||
| -rw-r--r-- | tests/textWind.test | 12 | ||||
| -rw-r--r-- | tests/winDialog.test | 17 | ||||
| -rw-r--r-- | tests/winWm.test | 42 |
7 files changed, 78 insertions, 56 deletions
@@ -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} |