diff options
Diffstat (limited to 'tk8.6/tests/text.test')
| -rw-r--r-- | tk8.6/tests/text.test | 7391 |
1 files changed, 7391 insertions, 0 deletions
diff --git a/tk8.6/tests/text.test b/tk8.6/tests/text.test new file mode 100644 index 0000000..57d9e4e --- /dev/null +++ b/tk8.6/tests/text.test @@ -0,0 +1,7391 @@ +# This file is a Tcl script to test the code in the file tkText.c. +# This file is organized in the standard fashion for Tcl tests. +# +# Copyright (c) 1992-1994 The Regents of the University of California. +# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. + +package require tcltest 2.2 +eval tcltest::configure $argv +tcltest::loadTestedCommands +namespace import -force tcltest::test + +# The statements below reset the main window; it's needed if the window +# manager is mwm to make mwm forget about a previous minimum size setting. +wm geometry . {} +wm withdraw . +wm minsize . 1 1 +wm positionfrom . user +wm deiconify . + +test text-1.1 {configuration option: "autoseparators"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -autoseparators yes + .t cget -autoseparators +} -cleanup { + destroy .t +} -result {1} +test text-1.1b {configuration option: "autoseparators", default} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t cget -autoseparators +} -cleanup { + destroy .t +} -result {1} +test text-1.2 {configuration option: "autoseparators"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -autoseparators nah +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.3 {configuration option: "background"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -background #ff00ff + .t cget -background +} -cleanup { + destroy .t +} -result {#ff00ff} +test text-1.4 {configuration option: "background"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -background <gorp> +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.5 {configuration option: "bd"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -bd 4 + .t cget -bd +} -cleanup { + destroy .t +} -result {4} +test text-1.6 {configuration option: "bd"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -bd foo +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.7 {configuration option: "bg"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -bg blue + .t cget -bg +} -cleanup { + destroy .t +} -result {blue} +test text-1.8 {configuration option: "bg"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -bg #xx +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.9 {configuration option: "blockcursor"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -blockcursor 0 + .t cget -blockcursor +} -cleanup { + destroy .t +} -result {0} +test text-1.10 {configuration option: "blockcursor"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -blockcursor xx +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.11 {configuration option: "borderwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -borderwidth 7 + .t cget -borderwidth +} -cleanup { + destroy .t +} -result {7} +test text-1.12 {configuration option: "borderwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -borderwidth ++ +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.13 {configuration option: "cursor"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -cursor watch + .t cget -cursor +} -cleanup { + destroy .t +} -result {watch} +test text-1.14 {configuration option: "cursor"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -cursor lousy +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.15 {configuration option: "exportselection"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -exportselection no + .t cget -exportselection +} -cleanup { + destroy .t +} -result {0} +test text-1.16 {configuration option: "exportselection"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -exportselection maybe +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.17 {configuration option: "fg"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -fg red + .t cget -fg +} -cleanup { + destroy .t +} -result {red} +test text-1.18 {configuration option: "fg"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -fg stupid +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.19 {configuration option: "font"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -font fixed + .t cget -font +} -cleanup { + destroy .t +} -result {fixed} +test text-1.20 {configuration option: "font"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -font {} +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.21 {configuration option: "foreground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -foreground #012 + .t cget -foreground +} -cleanup { + destroy .t +} -result {#012} +test text-1.22 {configuration option: "foreground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -foreground bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.23 {configuration option: "height"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -height 5 + .t cget -height +} -cleanup { + destroy .t +} -result {5} +test text-1.24 {configuration option: "height"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -height bad +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.25 {configuration option: "highlightbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -highlightbackground #123 + .t cget -highlightbackground +} -cleanup { + destroy .t +} -result {#123} +test text-1.26 {configuration option: "highlightbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -highlightbackground bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.27 {configuration option: "highlightcolor"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -highlightcolor #234 + .t cget -highlightcolor +} -cleanup { + destroy .t +} -result {#234} +test text-1.28 {configuration option: "highlightcolor"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -highlightcolor bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.29 {configuration option: "highlightthickness"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -highlightthickness -2 + .t cget -highlightthickness +} -cleanup { + destroy .t +} -result {0} +test text-1.30 {configuration option: "highlightthickness"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -highlightthickness bad +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.31 {configuration option: "inactiveselectbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -inactiveselectbackground #ffff01234567 + .t cget -inactiveselectbackground +} -cleanup { + destroy .t +} -result {#ffff01234567} +test text-1.32 {configuration option: "inactiveselectbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -inactiveselectbackground bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.33 {configuration option: "insertbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertbackground green + .t cget -insertbackground +} -cleanup { + destroy .t +} -result {green} +test text-1.34 {configuration option: "insertbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertbackground <bogus> +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.35 {configuration option: "insertborderwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertborderwidth 45 + .t cget -insertborderwidth +} -cleanup { + destroy .t +} -result {45} +test text-1.36 {configuration option: "insertborderwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertborderwidth bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.37 {configuration option: "insertofftime"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertofftime 100 + .t cget -insertofftime +} -cleanup { + destroy .t +} -result {100} +test text-1.38 {configuration option: "insertofftime"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertofftime 2.4 +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.39 {configuration option: "insertontime"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertontime 47 + .t cget -insertontime +} -cleanup { + destroy .t +} -result {47} +test text-1.40 {configuration option: "insertontime"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertontime e1 +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.41 {configuration option: "insertwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertwidth 2.3 + .t cget -insertwidth +} -cleanup { + destroy .t +} -result {2} +test text-1.42 {configuration option: "insertwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertwidth 47d +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.43 {configuration option: "maxundo"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -maxundo 5 + .t cget -maxundo +} -cleanup { + destroy .t +} -result {5} +test text-1.43b {configuration option: "maxundo", default} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t cget -maxundo +} -cleanup { + destroy .t +} -result {0} +test text-1.44 {configuration option: "maxundo"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -maxundo noway +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.45 {configuration option: "padx"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -padx 3.4 + .t cget -padx +} -cleanup { + destroy .t +} -result {3} +test text-1.46 {configuration option: "padx"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -padx 2.4. +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.47 {configuration option: "pady"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -pady 82 + .t cget -pady +} -cleanup { + destroy .t +} -result {82} +test text-1.48 {configuration option: "pady"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -pady bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.49 {configuration option: "relief"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -relief raised + .t cget -relief +} -cleanup { + destroy .t +} -result {raised} +test text-1.50 {configuration option: "relief"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -relief bumpy +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.51 {configuration option: "selectbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -selectbackground #ffff01234567 + .t cget -selectbackground +} -cleanup { + destroy .t +} -result {#ffff01234567} +test text-1.52 {configuration option: "selectbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -selectbackground bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.53 {configuration option: "selectborderwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -selectborderwidth 21 + .t cget -selectborderwidth +} -cleanup { + destroy .t +} -result {21} +test text-1.54 {configuration option: "selectborderwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -selectborderwidth 3x +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.55 {configuration option: "selectforeground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -selectforeground yellow + .t cget -selectforeground +} -cleanup { + destroy .t +} -result {yellow} +test text-1.56 {configuration option: "selectforeground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -selectforeground #12345 +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.57 {configuration option: "spacing1"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing1 20 + .t cget -spacing1 +} -cleanup { + destroy .t +} -result {20} +test text-1.58 {configuration option: "spacing1"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing1 1.3x +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.59 {configuration option: "spacing1"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing1 -5 + .t cget -spacing1 +} -cleanup { + destroy .t +} -result {0} +test text-1.60 {configuration option: "spacing1"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing1 bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.61 {configuration option: "spacing2"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing2 5 + .t cget -spacing2 +} -cleanup { + destroy .t +} -result {5} +test text-1.62 {configuration option: "spacing2"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing2 bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.63 {configuration option: "spacing2"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing2 -1 + .t cget -spacing2 +} -cleanup { + destroy .t +} -result {0} +test text-1.64 {configuration option: "spacing2"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing2 bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.65 {configuration option: "spacing3"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing3 20 + .t cget -spacing3 +} -cleanup { + destroy .t +} -result {20} +test text-1.66 {configuration option: "spacing3"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing3 bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.67 {configuration option: "spacing3"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing3 -10 + .t cget -spacing3 +} -cleanup { + destroy .t +} -result {0} +test text-1.68 {configuration option: "spacing3"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing3 bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.69 {configuration option: "state"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -state d + .t cget -state +} -cleanup { + destroy .t +} -result {disabled} +test text-1.70 {configuration option: "state"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -state foo +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.71 {configuration option: "tabs"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -tabs {1i 2i 3i 4i} + .t cget -tabs +} -cleanup { + destroy .t +} -result {1i 2i 3i 4i} +test text-1.72 {configuration option: "tabs"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -tabs bad_tabs +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.73 {configuration option: "tabstyle"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -tabstyle wordprocessor + .t cget -tabstyle +} -cleanup { + destroy .t +} -result {wordprocessor} +test text-1.74 {configuration option: "tabstyle"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -tabstyle garbage +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.75 {configuration option: "undo"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -undo 1 + .t cget -undo +} -cleanup { + destroy .t +} -result {1} +test text-1.75b {configuration option: "undo", default} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t cget -undo +} -cleanup { + destroy .t +} -result {0} +test text-1.76 {configuration option: "undo"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -undo eh +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.77 {configuration option: "width"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -width 73 + .t cget -width +} -cleanup { + destroy .t +} -result {73} +test text-1.78 {configuration option: "width"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -width 2.4 +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.79 {configuration option: "wrap"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -wrap w + .t cget -wrap +} -cleanup { + destroy .t +} -result {word} +test text-1.80 {configuration option: "wrap"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -wrap bad_wrap +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.81 {text options} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -takefocus "any old thing" + .t cget -takefocus +} -cleanup { + destroy .t +} -result {any old thing} +test text-1.82 {text options} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -xscrollcommand "x scroll command" + .t configure -xscrollcommand +} -cleanup { + destroy .t +} -result {-xscrollcommand xScrollCommand ScrollCommand {} {x scroll command}} +test text-1.83 {text options} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -yscrollcommand "test command" + .t configure -yscrollcommand +} -cleanup { + destroy .t +} -result {-yscrollcommand yScrollCommand ScrollCommand {} {test command}} +test text-1.83.1 {configuration option: "insertunfocussed"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertunfocussed none + .t cget -insertunfocussed +} -cleanup { + destroy .t +} -result none +test text-1.84 {configuration option: "insertunfocussed"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertunfocussed hollow + .t cget -insertunfocussed +} -cleanup { + destroy .t +} -result hollow +test text-1.85 {configuration option: "insertunfocussed"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertunfocussed solid + .t cget -insertunfocussed +} -cleanup { + destroy .t +} -result solid +test text-1.86 {configuration option: "insertunfocussed"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -returnCodes error -body { + .t configure -insertunfocussed gorp +} -cleanup { + destroy .t +} -result {bad insertunfocussed "gorp": must be hollow, none, or solid} + + +test text-2.1 {Tk_TextCmd procedure} -body { + text +} -returnCodes {error} -result {wrong # args: should be "text pathName ?-option value ...?"} +test text-2.2 {Tk_TextCmd procedure} -body { + text foobar +} -returnCodes {error} -result {bad window path name "foobar"} +test text-2.3 {Tk_TextCmd procedure} -body { + text .t -gorp nofun +} -cleanup { + destroy .t +} -returnCodes {error} -result {unknown option "-gorp"} +test text-2.4 {Tk_TextCmd procedure} -body { + catch {text .t -gorp nofun} + winfo exists .t +} -cleanup { + destroy .t +} -result 0 +test text-2.5 {Tk_TextCmd procedure} -body { + text .t -bd 2 -fg red +} -cleanup { + destroy .t +} -returnCodes ok -result {.t} +test text-2.6 {Tk_TextCmd procedure} -body { + text .t -bd 2 -fg red + list [lindex [.t config -bd] 4] [lindex [.t config -fg] 4] +} -cleanup { + destroy .t +} -result {2 red} +test text-2.7 {Tk_TextCmd procedure} -constraints { + win +} -body { + catch {destroy .t} + text .t + .t tag cget sel -relief +} -cleanup { + destroy .t +} -result {flat} +test text-2.8 {Tk_TextCmd procedure} -constraints { + aqua +} -body { + catch {destroy .t} + text .t + .t tag cget sel -relief +} -cleanup { + destroy .t +} -result {flat} +test text-2.9 {Tk_TextCmd procedure} -constraints { + unix notAqua +} -body { + catch {destroy .t} + text .t + .t tag cget sel -relief +} -cleanup { + destroy .t +} -result {raised} +test text-2.10 {Tk_TextCmd procedure} -body { + list [text .t] [winfo class .t] +} -cleanup { + destroy .t +} -result {.t Text} + + +test text-3.1 {TextWidgetCmd procedure, basics} -setup { + text .t +} -body { + .t +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t option ?arg ...?"} +test text-3.2 {TextWidgetCmd procedure} -setup { + text .t +} -body { + .t gorp 1.0 z 1.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad option "gorp": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingsync, replace, scan, search, see, sync, tag, window, xview, or yview} + +test text-4.1 {TextWidgetCmd procedure, "bbox" option} -setup { + text .t +} -body { + .t bbox +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t bbox index"} +test text-4.2 {TextWidgetCmd procedure, "bbox" option} -setup { + text .t +} -body { + .t bbox a b +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t bbox index"} +test text-4.3 {TextWidgetCmd procedure, "bbox" option} -setup { + text .t +} -body { + .t bbox bad_mark +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "bad_mark"} + +test text-5.1 {TextWidgetCmd procedure, "cget" option} -setup { + text .t +} -body { + .t cget +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t cget option"} +test text-5.2 {TextWidgetCmd procedure, "cget" option} -setup { + text .t +} -body { + .t cget a b +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t cget option"} +test text-5.3 {TextWidgetCmd procedure, "cget" option} -setup { + text .t +} -body { + .t cget -gorp +} -cleanup { + destroy .t +} -returnCodes {error} -result {unknown option "-gorp"} +test text-5.4 {TextWidgetCmd procedure, "cget" option} -setup { + text .t +} -body { + .t configure -bd 17 + .t cget -bd +} -cleanup { + destroy .t +} -result {17} + + +test text-6.1 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t compare a b +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t compare index1 op index2"} +test text-6.2 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t compare a b c d +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t compare index1 op index2"} +test text-6.3 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t compare @x == 1.0 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@x"} +test text-6.4 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t compare 1.0 < @y +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@y"} +test text-6.5 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + list [.t compare 1.1 < 1.0] [.t compare 1.1 < 1.1] [.t compare 1.1 < 1.2] +} -cleanup { + destroy .t +} -result {0 0 1} +test text-6.6 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + list [.t compare 1.1 <= 1.0] [.t compare 1.1 <= 1.1] [.t compare 1.1 <= 1.2] +} -cleanup { + destroy .t +} -result {0 1 1} +test text-6.7 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + list [.t compare 1.1 == 1.0] [.t compare 1.1 == 1.1] [.t compare 1.1 == 1.2] +} -cleanup { + destroy .t +} -result {0 1 0} +test text-6.8 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + list [.t compare 1.1 >= 1.0] [.t compare 1.1 >= 1.1] [.t compare 1.1 >= 1.2] +} -cleanup { + destroy .t +} -result {1 1 0} +test text-6.9 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + list [.t compare 1.1 > 1.0] [.t compare 1.1 > 1.1] [.t compare 1.1 > 1.2] +} -cleanup { + destroy .t +} -result {1 0 0} +test text-6.10 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + list [.t com 1.1 != 1.0] [.t compare 1.1 != 1.1] [.t compare 1.1 != 1.2] +} -cleanup { + destroy .t +} -result {1 0 1} +test text-6.11 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t compare 1.0 <x 1.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad comparison operator "<x": must be <, <=, ==, >=, >, or !=} +test text-6.12 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t compare 1.0 >> 1.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=} +test text-6.13 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t compare 1.0 z 1.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad comparison operator "z": must be <, <=, ==, >=, >, or !=} +test text-6.14 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t co 1.0 z 1.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingsync, replace, scan, search, see, sync, tag, window, xview, or yview} +# "configure" option is already covered above + +test text-7.1 {TextWidgetCmd procedure, "debug" option} -setup { + text .t +} -body { + .t debug 0 1 +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t debug boolean"} +test text-7.2 {TextWidgetCmd procedure, "debug" option} -setup { + text .t +} -body { + .t de 0 1 +} -cleanup { + destroy .t +} -returnCodes {error} -result {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingsync, replace, scan, search, see, sync, tag, window, xview, or yview} +test text-7.3 {TextWidgetCmd procedure, "debug" option} -setup { + text .t +} -body { + .t debug true + .t deb +} -cleanup { + destroy .t +} -result {1} +test text-7.4 {TextWidgetCmd procedure, "debug" option} -setup { + text .t +} -body { + .t debug false + .t debug +} -cleanup { + destroy .t +} -result {0} + + +test text-8.1 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t delete +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t delete index1 ?index2 ...?"} +test text-8.2 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t delete a b c +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "a"} +test text-8.3 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t delete @x 2.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@x"} +test text-8.4 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345" + .t delete 2.3 @y +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@y"} +test text-8.5 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t configure -state disabled + .t delete 2.3 + .t g 2.0 2.end +} -cleanup { + destroy .t +} -result {abcdefghijklm} +test text-8.6 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t delete 2.3 + .t get 2.0 2.end +} -cleanup { + destroy .t +} -result {abcefghijklm} +test text-8.7 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t delete 2.1 2.3 + .t get 2.0 2.end +} -cleanup { + destroy .t +} -result {adefghijklm} +test text-8.8 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345" + # All indices are checked before we actually delete anything + .t delete 2.1 2.3 foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "foo"} +test text-8.9 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345" +# All indices are checked before we actually delete anything + catch {.t delete 2.1 2.3 foo} + .t get 2.0 2.end +} -cleanup { + destroy .t +} -result {abcdefghijklm} +test text-8.10 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + # auto-forward one byte if the last "pair" is just one + .t delete 1.0 end + .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.1 2.3 2.3 + .t get 1.0 end-1c +} -cleanup { + destroy .t +} -result {foo +aefghijklm} +test text-8.11 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + # all indices will be ordered before deletion + .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.3 2.7 2.9 2.4 + .t get 1.0 end-1c +} -cleanup { + destroy .t +} -result {foo +dfgjklm} +test text-8.12 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + # and check again with even pairs + .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.2 2.7 2.9 2.4 2.5 + .t get 1.0 end-1c +} -cleanup { + destroy .t +} -result {foo +cdfgjklm} +test text-8.13 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + # we should get the longest range on equal start indices + .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.2 2.0 2.5 2.0 2.3 2.8 2.7 + .t get 1.0 end-1c +} -cleanup { + destroy .t +} -result {foo +fghijklm} +test text-8.14 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + # we should get the longest range on equal start indices + .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.2 1.2 2.6 2.0 2.5 + .t get 1.0 end-1c +} -cleanup { + destroy .t +} -result {foghijklm} +test text-8.15 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + # we should get the longest range on equal start indices + .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.2 2.0 2.5 1.1 2.3 2.8 2.7 + .t get 1.0 end-1c +} -cleanup { + destroy .t +} -result {ffghijklm} +test text-8.16 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + # we should get the watch for overlapping ranges - they should + # essentially be merged into one span. + .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.6 2.2 2.8 + .t get 1.0 end-1c +} -cleanup { + destroy .t +} -result {foo +ijklm} +test text-8.17 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + # we should get the watch for overlapping ranges - they should + # essentially be merged into one span. + .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.6 2.2 2.4 + .t get 1.0 end-1c +} -cleanup { + destroy .t +} -result {foo +ghijklm} +test text-8.18 {TextWidgetCmd procedure, "replace" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345" + .t replace 1.3 2.3 +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t replace index1 index2 chars ?tagList chars tagList ...?"} +test text-8.19 {TextWidgetCmd procedure, "replace" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345" + .t replace 3.1 2.3 foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {index "2.3" before "3.1" in the text} +test text-8.20 {TextWidgetCmd procedure, "replace" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t replace 2.1 2.3 foo +} -cleanup { + destroy .t +} -returnCodes ok -result {} +test text-8.21 {TextWidgetCmd procedure, "replace" option with undo} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + set prevtext [.t get 1.0 end-1c] + .t configure -undo 0 + .t configure -undo 1 + # Ensure it is treated as a single undo action + .t replace 2.1 2.3 foo + .t edit undo + string equal [.t get 1.0 end-1c] $prevtext +} -cleanup { + destroy .t +} -result {1} +test text-8.22 {TextWidgetCmd procedure, "replace" option with undo} -setup { + text .t + set res {} +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t configure -undo 0 + .t configure -undo 1 + .t replace 2.1 2.3 foo + # Ensure we can override a text widget and intercept undo + # actions. If in the future a different mechanism is available + # to do this, then we should be able to change this test. The + # behaviour tested for here is not, strictly speaking, documented. + rename .t test.t + proc .t {args} { lappend ::res $args ; uplevel 1 test.t $args } + .t edit undo + return $res +} -cleanup { + rename .t {} + rename test.t .t + destroy .t +} -result {{edit undo} {delete 2.1 2.4} {mark set insert 2.1} {see insert} {insert 2.1 ef} {mark set insert 2.3} {see insert}} +test text-8.23 {TextWidgetCmd procedure, "replace" option with undo} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + set prevtext [.t get 1.0 end-1c] + .t configure -undo 0 + .t configure -undo 1 + # Ensure that undo (even composite undo like 'replace') + # works when the widget shows nothing useful. + .t replace 2.1 2.3 foo + .t configure -start 1 -end 1 + .t edit undo + .t configure -start {} -end {} + .t configure -undo 0 + string equal [.t get 1.0 end-1c] $prevtext +} -cleanup { + destroy .t +} -result {1} +test text-8.24 {TextWidgetCmd procedure, "replace" option with peers, undo} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + set prevtext [.t get 1.0 end-1c] + .t configure -undo 0 + .t configure -undo 1 + .t peer create .tt -undo 1 +# Ensure that undo (even composite undo like 'replace') +# works when the the event took place in one peer, which +# is then deleted, before the undo takes place in another peer. + .tt replace 2.1 2.3 foo + .tt configure -start 1 -end 1 + destroy .tt + .t edit undo + .t configure -start {} -end {} + .t configure -undo 0 + string equal [.t get 1.0 end-1c] $prevtext +} -cleanup { + destroy .t +} -result {1} +test text-8.25 {TextWidgetCmd procedure, "replace" option with peers, undo} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + set prevtext [.t get 1.0 end-1c] + .t configure -undo 0 + .t configure -undo 1 + .t peer create .tt -undo 1 +# Ensure that undo (even composite undo like 'replace') +# works when the the event took place in one peer, which +# is then deleted, before the undo takes place in another peer +# which isn't showing everything. + .tt replace 2.1 2.3 foo + set res [.tt get 2.1 2.4] + .tt configure -start 1 -end 1 + destroy .tt + .t configure -start 3 -end 4 +# msg will actually be set to a silently ignored error message here, +# (that the .tt command doesn't exist), but that is not important. + lappend res [catch {.t edit undo}] + .t configure -undo 0 + .t configure -start {} -end {} + lappend res [string equal [.t get 1.0 end-1c] $prevtext] +} -cleanup { + destroy .t +} -result {foo 0 1} +test text-8.26 {TextWidgetCmd procedure, "replace" option crash} -setup { + text .tt +} -body { + .tt insert 0.0 foo\n + .tt replace end-1l end bar +} -cleanup { + destroy .tt +} -result {} +test text-8.27 {TextWidgetCmd procedure, "replace" option crash} -setup { + text .tt +} -body { + .tt insert 0.0 \na + for {set i 0} {$i < 2} {incr i} { + .tt replace 2.0 3.0 b + } +} -cleanup { + destroy .tt +} -result {} + + +test text-9.1 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t get +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t get ?-displaychars? ?--? index1 ?index2 ...?"} +test text-9.2 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t get a b c +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "a"} +test text-9.3 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t get @q 3.1 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@q"} +test text-9.4 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t get 3.1 @r +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@r"} +test text-9.5 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t get 5.7 5.3 +} -cleanup { + destroy .t +} -result {} +test text-9.6 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t get 5.3 5.5 +} -cleanup { + destroy .t +} -result { G} +test text-9.7 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t get 5.3 end +} -cleanup { + destroy .t +} -result { GIrl .#@? x_yz +!@#$% +Line 7 +} +test text-9.8 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t get 5.2 5.7 +} -cleanup { + destroy .t +} -result {y GIr} +test text-9.9 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t get 5.2 +} -cleanup { + destroy .t +} -result {y} +test text-9.10 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t get 5.2 5.4 +} -cleanup { + destroy .t +} -result {y } +test text-9.11 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t get 5.2 5.4 5.4 +} -cleanup { + destroy .t +} -result {{y } G} +test text-9.12 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t get 5.2 5.4 5.4 5.5 +} -cleanup { + destroy .t +} -result {{y } G} +test text-9.13 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t get 5.2 5.4 5.5 "5.5+5c" +} -cleanup { + destroy .t +} -result {{y } {Irl .}} +test text-9.14 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t get 5.2 5.4 5.4 5.5 end-3c +} -cleanup { + destroy .t +} -result {{y } G { }} +test text-9.15 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t get 5.2 5.4 5.4 5.5 end-3c end +} -cleanup { + destroy .t +} -result {{y } G { 7 +}} +test text-9.16 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t get 5.2 5.3 5.4 5.3 +} -cleanup { + destroy .t +} -result {y} +test text-9.17 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t index "5.2 +3 indices" +} -cleanup { + destroy .t +} -result {5.5} +test text-9.18 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t index "5.2 +3chars" +} -cleanup { + destroy .t +} -result {5.5} +test text-9.19 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t index "5.2 +3displayindices" +} -cleanup { + destroy .t +} -result {5.5} +test text-9.20 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t get 5.2 5.4 5.5 foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "foo"} +test text-9.21 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t get 5.2 5.4 5.4 5.5 end-3c end +} -cleanup { + destroy .t +} -result {{y } G { 7 +}} +test text-9.22 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t get -displaychars 5.2 5.4 5.4 5.5 end-3c end +} -cleanup { + destroy .t +} -result {{} G { 7 +}} +test text-9.23 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + list [.t index "5.1 +4indices"] [.t index "5.1+4d indices"] +} -cleanup { + destroy .t +} -result {5.5 5.7} +test text-9.24 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + list [.t index "5.1 +4a chars"] [.t index "5.1+4d chars"] +} -cleanup { + destroy .t +} -result {5.5 5.7} +test text-9.25 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + list [.t index "5.5 -4indices"] [.t index "5.7-4d indices"] +} -cleanup { + destroy .t +} -result {5.1 5.1} +test text-9.26 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + list [.t index "5.5 -4a chars"] [.t index "5.7-4d chars"] +} -cleanup { + destroy .t +} -result {5.1 5.1} +test text-9.27 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t window create 5.4 + list [.t index "5.1 +4indices"] [.t index "5.1+4d indices"] +} -cleanup { + destroy .t +} -result {5.5 5.7} +test text-9.28 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t window create 5.4 + list [.t index "5.1 +4a chars"] [.t index "5.1+4d chars"] +} -cleanup { + destroy .t +} -result {5.6 5.8} +test text-9.29 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t window create 5.4 + list [.t index "5.5 -4indices"] [.t index "5.7-4d indices"] +} -cleanup { + destroy .t +} -result {5.1 5.1} +test text-9.30 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t window create 5.4 + list [.t index "5.6 -4a chars"] [.t index "5.8-4d chars"] +} -cleanup { + destroy .t +} -result {5.1 5.1} +test text-9.31 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t window create 5.4 + .t delete 5.4 + .t tag add elide 5.5 5.6 + .t get -displaychars 5.2 5.8 +} -cleanup { + destroy .t +} -result {Grl} + + +test text-10.1 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t count +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t count ?-option value ...? index1 index2"} +test text-10.2 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t count blah 1.0 2.0 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad option "blah" must be -chars, -displaychars, -displayindices, -displaylines, -indices, -lines, -update, -xpixels, or -ypixels} +test text-10.3 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t count a b +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "a"} +test text-10.4 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t count @q 3.1 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@q"} +test text-10.5 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t count 3.1 @r +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@r"} +test text-10.6 {TextWidgetCmd procedure, "count" option} -setup { + text .t + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { + .t count 5.7 5.3 +} -cleanup { + destroy .t +} -result {-4} +test text-10.7 {TextWidgetCmd procedure, "count" option} -setup { + text .t + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { + .t count 5.3 5.5 +} -cleanup { + destroy .t +} -result {2} +test text-10.8 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t count 5.3 end +} -cleanup { + destroy .t +} -result {29} +test text-10.9 {TextWidgetCmd procedure, "count" option} -setup { + text .t + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { + .t count 5.2 5.7 +} -cleanup { + destroy .t +} -result {5} +test text-10.10 {TextWidgetCmd procedure, "count" option} -setup { + text .t + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { + .t count 5.2 5.3 +} -cleanup { + destroy .t +} -result {1} +test text-10.11 {TextWidgetCmd procedure, "count" option} -setup { + text .t + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { + .t count 5.2 5.4 +} -cleanup { + destroy .t +} -result {2} +test text-10.12 {TextWidgetCmd procedure, "count" option} -setup { + text .t + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { + .t count 5.2 foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "foo"} +test text-10.13 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t count -displayindices 2.0 3.0 +} -cleanup { + destroy .t +} -result {2} +test text-10.14 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t count -displayindices 2.2 3.0 +} -cleanup { + destroy .t +} -result {0} +test text-10.15 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 + .t count -displayindices 2.0 4.2 +} -cleanup { + destroy .t +} -result {5} +test text-10.16 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displayindices 2.0 3.0 +} -cleanup { + destroy .t +} -result {3} +test text-10.17 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displayindices 2.2 3.0 +} -cleanup { + destroy .t +} -result {1} +test text-10.18 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 + .t mark set a 2.2 +# Creating this window here means that the elidden text +# now starts at 2.3, but 'a' is automatically moved to 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displayindices a 3.0 +} -cleanup { + destroy .t +} -result {0} +test text-10.19 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displayindices 2.0 4.2 +} -cleanup { + destroy .t +} -result {6} +test text-10.20 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displaychars 2.0 3.0 +} -cleanup { + destroy .t +} -result {2} +test text-10.21 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displaychars 2.2 3.0 +} -cleanup { + destroy .t +} -result {1} +test text-10.22 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 + .t mark set a 2.2 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3, but 'a' is automatically moved to 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displaychars a 3.0 +} -cleanup { + destroy .t +} -result {0} +test text-10.23 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displaychars 2.0 4.2 +} -cleanup { + destroy .t +} -result {5} +test text-10.24 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displaychars 2.0 4.2 + list [.t count -indices 2.2 3.0] [.t count 2.2 3.0] +} -cleanup { + destroy .t +} -result {10 10} +test text-10.25 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 + .t mark set a 2.2 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3, but 'a' is automatically moved to 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + list [.t count -indices a 3.0] [.t count a 3.0] +} -cleanup { + destroy .t +} -result {9 9} +test text-10.26 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displaychars 2.0 4.2 + .t count -indices 2.0 4.2 +} -cleanup { + destroy .t +} -result {21} +test text-10.27 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displaychars 2.0 4.2 + .t count -chars 2.2 3.0 +} -cleanup { + destroy .t +} -result {10} +test text-10.28 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 + .t mark set a 2.2 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3, but 'a' is automatically moved to 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -chars a 3.0 +} -cleanup { + destroy .t +} -result {9} +test text-10.29 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displaychars 2.0 4.2 + .t count -chars 2.0 4.2 +} -cleanup { + destroy .t +} -result {19} +test text-10.30 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] + .t count -lines 1.0 end +} -cleanup { + destroy .t +} -result {3} +test text-10.31 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] + .t count -lines end 1.0 +} -cleanup { + destroy .t +} -result {-3} +test text-10.32 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] + .t count -lines 1.0 2.0 3.0 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad option "1.0" must be -chars, -displaychars, -displayindices, -displaylines, -indices, -lines, -update, -xpixels, or -ypixels} +test text-10.33 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] + .t count -lines end end +} -cleanup { + destroy .t +} -result {0} +test text-10.34 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] + .t count -lines 1.5 2.5 +} -cleanup { + destroy .t +} -result {1} +test text-10.35 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] + .t count -lines 2.5 "2.5 lineend" +} -cleanup { + destroy .t +} -result {0} +test text-10.36 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] + .t count -lines 2.7 "1.0 lineend" +} -cleanup { + destroy .t +} -result {-1} +test text-10.37 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] + .t configure -wrap none + .t count -displaylines 1.0 end +} -cleanup { + destroy .t +} -result {3} +test text-10.38 {TextWidgetCmd procedure, "count" option} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t -expand 1 -fill both +} -body { + .t configure -width 20 -height 10 + update + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] + .t count -lines -chars -indices -displaylines 1.0 end +} -cleanup { + destroy .t +} -result {3 903 903 45} +test text-10.39 {TextWidgetCmd procedure, "count" option} -setup { + text .t + pack .t + update + set res {} +} -body { + .t insert end "Line 1 - This is Line 1\n" + .t insert end "Line 2 - This is Line 2\n" + .t insert end "Line 3 - This is Line 3\n" + .t insert end "Line 4 - This is Line 4\n" + .t insert end "Line 5 - This is Line 5\n" + lappend res [.t count -displaylines 1.19 3.24] [.t count -displaylines 1.0 end] + .t tag add hidden 2.9 3.17 + .t tag configure hidden -elide true + lappend res [.t count -displaylines 1.19 3.24] [.t count -displaylines 1.0 end] +} -cleanup { + destroy .t +} -result {2 6 1 5} +test text-9.2.45 {TextWidgetCmd procedure, "count" option} -setup { + text .t + pack .t + update + set res {} +} -body { + for {set i 1} {$i < 5} {incr i} { + .t insert end "Line $i+++Line $i---Line $i///Line $i - This is Line [format %c [expr 64+$i]]\n" + } + .t tag configure hidden -elide true + .t tag add hidden 2.15 3.10 + .t configure -wrap none + set res [.t count -displaylines 2.0 3.0] +} -cleanup { + destroy .t +} -result {0} +test text-9.2.46 {TextWidgetCmd procedure, "count" option} -setup { + toplevel .mytop + pack [text .mytop.t -font TkFixedFont -bd 0 -padx 0 -wrap char] + set spec [font measure TkFixedFont "Line 1+++Line 1---Li"] ; # 20 chars + append spec x300+0+0 + wm geometry .mytop $spec + .mytop.t delete 1.0 end + update + set res {} +} -body { + for {set i 1} {$i < 5} {incr i} { + # 0 1 2 3 4 + # 012345 678901234 567890123 456789012 34567890123456789 + .mytop.t insert end "Line $i+++Line $i---Line $i///Line $i - This is Line [format %c [expr 64+$i]]\n" + } + .mytop.t tag configure hidden -elide true + .mytop.t tag add hidden 2.30 3.10 + lappend res [.mytop.t count -displaylines 2.0 3.0] + lappend res [.mytop.t count -displaylines 2.0 3.50] +} -cleanup { + destroy .mytop +} -result {1 3} +test text-9.2.47 {TextWidgetCmd procedure, "count" option} -setup { + text .t + pack .t + update + set res {} +} -body { + for {set i 1} {$i < 25} {incr i} { + .t insert end "Line $i\n" + } + .t tag configure hidden -elide true + .t tag add hidden 5.7 11.0 + update + # next line to be fully sure that asynchronous line heights calculation is + # up-to-date otherwise this test may fail (depending on the computer + # performance), especially when the . toplevel has small height + .t sync + set y1 [lindex [.t yview] 1] + .t count -displaylines 5.0 11.0 + set y2 [lindex [.t yview] 1] + .t count -displaylines 5.0 12.0 + set y3 [lindex [.t yview] 1] + list [expr {$y1 == $y2}] [expr {$y1 == $y3}] +} -cleanup { + destroy .t +} -result {1 1} + + +test text-11.1 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t -expand 1 -fill both +} -body { + .t insert end "hello" + .t configure -wrap none + list [.t count -displaychars 1.0 1.0] \ + [.t count -displaychars 1.0 1.1] \ + [.t count -displaychars 1.0 1.2] \ + [.t count -displaychars 1.0 1.3] \ + [.t count -displaychars 1.0 1.4] \ + [.t count -displaychars 1.0 1.5] \ + [.t count -displaychars 1.0 1.6] \ + [.t count -displaychars 1.0 2.6] \ +} -cleanup { + destroy .t +} -result {0 1 2 3 4 5 5 6} +test text-11.2 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t -expand 1 -fill both +} -body { + .t insert end "hello" + .t tag configure elide1 -elide 0 + .t tag add elide1 1.2 1.4 + .t count -displaychars 1.0 1.5 +} -cleanup { + destroy .t +} -result {5} +test text-11.3 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 +} -body { + .t insert end "hello" +# Newer tags are higher priority + .t tag configure elide1 -elide 0 + .t tag configure elide2 -elide 1 + .t tag add elide1 1.2 1.4 + .t tag add elide2 1.2 1.4 + .t count -displaychars 1.0 1.5 +} -cleanup { + destroy .t +} -result {3} +test text-11.4 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + set res {} +} -body { + .t insert end "hello" +# Newer tags are higher priority + .t tag configure elide1 -elide 0 + .t tag configure elide2 -elide 1 + .t tag add elide1 1.2 1.4 + .t tag add elide2 1.2 1.4 + .t tag add elide1 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] + .t delete 1.0 end + .t insert end "hello" + .t tag add elide1 1.2 1.4 + .t tag add elide2 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] +} -cleanup { + destroy .t +} -result {3 3} +test text-11.5 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + set res {} +} -body { + .t insert end "hello" +# Newer tags are higher priority + .t tag configure elide1 -elide 0 + .t tag configure elide2 -elide 1 + .t tag configure elide3 -elide 0 + .t tag add elide1 1.2 1.4 + .t tag add elide2 1.2 1.4 + .t tag add elide3 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] + .t delete 1.0 end + .t insert end "hello" + .t tag add elide3 1.2 1.4 + .t tag add elide3 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] +} -cleanup { + destroy .t +} -result {5 5} +test text-11.6 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + set res {} +} -body { + .t insert end "hello" +# Newer tags are higher priority + .t tag configure elide1 -elide 0 + .t tag configure elide2 -elide 1 + .t tag configure elide3 -elide 0 + .t tag configure elide4 -elide 1 + .t tag add elide2 1.2 1.4 + .t tag add elide3 1.2 1.4 + .t tag add elide4 1.2 1.4 + .t tag add elide1 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] + .t delete 1.0 end + .t insert end "hello" + .t tag add elide1 1.2 1.4 + .t tag add elide4 1.2 1.4 + .t tag add elide2 1.2 1.4 + .t tag add elide3 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] +} -cleanup { + destroy .t +} -result {3 3} +test text-11.7 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + set res {} +} -body { +# Newer tags are higher priority + .t tag configure elide1 -elide 0 + .t tag configure elide2 -elide 1 + .t tag configure elide3 -elide 0 + .t insert end "hello" + .t tag add elide2 1.2 1.4 + .t tag add elide3 1.2 1.4 + .t tag add elide1 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] + .t delete 1.0 end + .t insert end "hello" + .t tag add elide1 1.2 1.4 + .t tag add elide2 1.2 1.4 + .t tag add elide3 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] +} -cleanup { + destroy .t +} -result {5 5} +test text-11.8 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t -expand 1 -fill both + set res {} +} -body { + .t insert end "hello" +# Newer tags are higher priority + .t tag configure elide1 -elide 0 + .t tag configure elide2 -elide 1 + .t tag add elide2 1.0 1.5 + .t tag add elide1 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] + lappend res [.t count -displaychars 1.1 1.5] + lappend res [.t count -displaychars 1.2 1.5] + lappend res [.t count -displaychars 1.3 1.5] + .t delete 1.0 end + .t insert end "hello" + .t tag add elide1 1.0 1.5 + .t tag add elide2 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] + lappend res [.t count -displaychars 1.1 1.5] + lappend res [.t count -displaychars 1.2 1.5] + lappend res [.t count -displaychars 1.3 1.5] +} -cleanup { + destroy .t +} -result {0 0 0 0 3 2 1 1} +test text-11.9 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t -expand 1 -fill both + set res {} +} -body { + .t tag configure WELCOME -elide 1 + .t tag configure SYSTEM -elide 0 + .t tag configure TRAFFIC -elide 1 + .t insert end "\n" {SYSTEM TRAFFIC} + .t insert end "\n" WELCOME + lappend res [.t count -displaychars 1.0 end] + lappend res [.t count -displaychars 1.0 end-1c] + lappend res [.t count -displaychars 1.0 1.2] + lappend res [.t count -displaychars 2.0 end] + lappend res [.t count -displaychars 2.0 end-1c] + lappend res [.t index "1.0 +1 indices"] + lappend res [.t index "1.0 +1 display indices"] + lappend res [.t index "1.0 +1 display chars"] + lappend res [.t index end] + lappend res [.t index "end -1 indices"] + lappend res [.t index "end -1 display indices"] + lappend res [.t index "end -1 display chars"] + lappend res [.t index "end -2 indices"] + lappend res [.t index "end -2 display indices"] + lappend res [.t index "end -2 display chars"] +} -cleanup { + destroy .t +} -result {1 0 0 1 0 2.0 4.0 4.0 4.0 3.0 3.0 3.0 2.0 1.0 1.0} + +test text-11a.1 {TextWidgetCmd procedure, "pendingsync" option} -setup { + destroy .yt +} -body { + text .yt + list [catch {.yt pendingsync mytext} msg] $msg +} -cleanup { + destroy .yt +} -result {1 {wrong # args: should be ".yt pendingsync"}} +test text-11a.2 {TextWidgetCmd procedure, "pendingsync" option} -setup { + destroy .top.yt .top +} -body { + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 300} {incr i} { + append content [string repeat "$i " 15] \n + } + .top.yt insert 1.0 $content + # wait for end of line metrics calculation to get correct $fraction1 + # as a reference + while {[.top.yt pendingsync]} {update} + .top.yt yview moveto 1 + set fraction1 [lindex [.top.yt yview] 0] + set res [expr {$fraction1 > 0}] + .top.yt delete 1.0 end + .top.yt insert 1.0 $content + # ensure the test is relevant + lappend res [.top.yt pendingsync] + # asynchronously wait for completion of line metrics calculation + while {[.top.yt pendingsync]} {update} + .top.yt yview moveto $fraction1 + set fraction2 [lindex [.top.yt yview] 0] + lappend res [expr {$fraction1 == $fraction2}] +} -cleanup { + destroy .top.yt .top +} -result {1 1 1} + +test text-11a.11 {TextWidgetCmd procedure, "sync" option} -setup { + destroy .yt +} -body { + text .yt + list [catch {.yt sync mytext} msg] $msg +} -cleanup { + destroy .yt +} -result {1 {wrong # args: should be ".yt sync ?-command command?"}} +test text-11a.12 {TextWidgetCmd procedure, "sync" option} -setup { + destroy .top.yt .top +} -body { + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 30} {incr i} { + append content [string repeat "$i " 15] \n + } + .top.yt insert 1.0 $content + # wait for end of line metrics calculation to get correct $fraction1 + # as a reference + .top.yt sync + .top.yt yview moveto 1 + set fraction1 [lindex [.top.yt yview] 0] + set res [expr {$fraction1 > 0}] + # first case: do not wait for completion of line metrics calculation + .top.yt delete 1.0 end + .top.yt insert 1.0 $content + .top.yt yview moveto $fraction1 + set fraction2 [lindex [.top.yt yview] 0] + lappend res [expr {$fraction1 == $fraction2}] + # second case: wait for completion of line metrics calculation + .top.yt delete 1.0 end + .top.yt insert 1.0 $content + .top.yt sync + .top.yt yview moveto $fraction1 + set fraction2 [lindex [.top.yt yview] 0] + lappend res [expr {$fraction1 == $fraction2}] +} -cleanup { + destroy .top.yt .top +} -result {1 0 1} + +test text-11a.21 {TextWidgetCmd procedure, "sync" option with -command} -setup { + destroy .yt +} -body { + text .yt + list [catch {.yt sync -comx foo} msg] $msg +} -cleanup { + destroy .yt +} -result {1 {wrong option "-comx": should be "-command"}} +test text-11a.22 {TextWidgetCmd procedure, "sync" option with -command} -setup { + destroy .top.yt .top +} -body { + set res {} + set ::x 0 + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 30} {incr i} { + append content [string repeat "$i " 15] \n + } + .top.yt insert 1.0 $content + # first case: line metrics calculation still running when launching 'sync -command' + lappend res [.top.yt pendingsync] + .top.yt sync -command [list set ::x 1] + lappend res $::x + # now finish line metrics calculations + while {[.top.yt pendingsync]} {update} + lappend res [.top.yt pendingsync] $::x + # second case: line metrics calculation completed when launching 'sync -command' + .top.yt sync -command [list set ::x 2] + lappend res $::x + vwait ::x + lappend res $::x +} -cleanup { + destroy .top.yt .top +} -result {1 0 0 1 1 2} + +test text-11a.31 {"<<WidgetViewSync>>" event} -setup { + destroy .top.yt .top +} -body { + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 300} {incr i} { + append content [string repeat "$i " 15] \n + } + .top.yt insert 1.0 $content + update + bind .top.yt <<WidgetViewSync>> { if {%d} {set yud(%W) 1} } + # wait for end of line metrics calculation to get correct $fraction1 + # as a reference + if {[.top.yt pendingsync]} {vwait yud(.top.yt)} + .top.yt yview moveto 1 + set fraction1 [lindex [.top.yt yview] 0] + set res [expr {$fraction1 > 0}] + .top.yt delete 1.0 end + .top.yt insert 1.0 $content + # synchronously wait for completion of line metrics calculation + # and ensure the test is relevant + set waited 0 + if {[.top.yt pendingsync]} {set waited 1 ; vwait yud(.top.yt)} + lappend res $waited + .top.yt yview moveto $fraction1 + set fraction2 [lindex [.top.yt yview] 0] + lappend res [expr {$fraction1 == $fraction2}] +} -cleanup { + destroy .top.yt .top +} -result {1 1 1} + +test text-11a.41 {"sync" "pendingsync" and <<WidgetViewSync>>} -setup { + destroy .top.yt .top +} -body { + set res {} + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 300} {incr i} { + append content [string repeat "$i " 50] \n + } + bind .top.yt <<WidgetViewSync>> {lappend res Sync:%d} + .top.yt insert 1.0 $content + vwait res ; # event dealt with by the event loop, with %d==0 i.e. we're out of sync + # ensure the test is relevant + lappend res "Pending:[.top.yt pendingsync]" + # - <<WidgetViewSync>> fires when sync returns if there was pending syncs + # - there is no more any pending sync after running 'sync' + .top.yt sync + vwait res ; # event dealt with by the event loop, with %d==1 i.e. we're in sync again + lappend res "Pending:[.top.yt pendingsync]" + set res +} -cleanup { + destroy .top.yt .top +} -result {Sync:0 Pending:1 Sync:1 Pending:0} + +test text-11a.51 {<<WidgetViewSync>> calls TkSendVirtualEvent(), + NOT Tk_HandleEvent(). + Bug [b362182e45704dd7bbd6aed91e48122035ea3d16]} -setup { + destroy .top.t .top +} -body { + set res {} + toplevel .top + pack [text .top.t] + for {set i 1} {$i < 10000} {incr i} { + .top.t insert end "Hello world!\n" + } + bind .top.t <<WidgetViewSync>> {destroy .top.t} + .top.t tag add mytag 1.5 8000.8 ; # shall not crash + update + set res "Still doing fine!" +} -cleanup { + destroy .top.t .top +} -result {Still doing fine!} + +test text-12.1 {TextWidgetCmd procedure, "index" option} -setup { + text .t +} -body { + .t index +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t index index"} +test text-12.2 {TextWidgetCmd procedure, "index" option} -setup { + text .t +} -body { + .t ind a b +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t index index"} +test text-12.3 {TextWidgetCmd procedure, "index" option} -setup { + text .t +} -body { + .t in a b +} -cleanup { + destroy .t +} -returnCodes {error} -result {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingsync, replace, scan, search, see, sync, tag, window, xview, or yview} +test text-12.4 {TextWidgetCmd procedure, "index" option} -setup { + text .t +} -body { + .t index @xyz +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@xyz"} +test text-12.5 {TextWidgetCmd procedure, "index" option} -setup { + [text .t] insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { + .t index 1.2 +} -cleanup { + destroy .t +} -result 1.2 + + +test text-13.1 {TextWidgetCmd procedure, "insert" option} -setup { + [text .t] insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { + .t insert 1.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t insert index chars ?tagList chars tagList ...?"} +test text-13.2 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t config -state disabled + .t insert 1.2 xyzzy + .t get 1.0 1.end +} -cleanup { + destroy .t +} -result {Line 1} +test text-13.3 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t insert 1.2 xyzzy + .t get 1.0 1.end +} -cleanup { + destroy .t +} -result {Lixyzzyne 1} +test text-13.4 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t delete 1.0 end + .t insert 1.0 "Sample text" x + .t tag ranges x +} -cleanup { + destroy .t +} -result {1.0 1.11} +test text-13.5 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "Sample text" x + .t insert 1.2 "XYZ" y + list [.t tag ranges x] [.t tag ranges y] +} -cleanup { + destroy .t +} -result {{1.0 1.2 1.5 1.14} {1.2 1.5}} +test text-13.6 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "Sample text" {x y z} + list [.t tag ranges x] [.t tag ranges y] [.t tag ranges z] +} -cleanup { + destroy .t +} -result {{1.0 1.11} {1.0 1.11} {1.0 1.11}} +test text-13.7 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "Sample text" {x y z} + .t insert 1.3 "A" {a b z} + list [.t tag ranges a] [.t tag ranges b] [.t tag ranges x] [.t tag ranges y] [.t tag ranges z] +} -cleanup { + destroy .t +} -result {{1.3 1.4} {1.3 1.4} {1.0 1.3 1.4 1.12} {1.0 1.3 1.4 1.12} {1.0 1.12}} +test text-13.8 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "Sample text" "a \{b" +} -cleanup { + destroy .t +} -returnCodes {error} -result {unmatched open brace in list} +test text-13.9 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "First" bold " " {} second "x y z" " third" + list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges x] \ + [.t tag ranges y] [.t tag ranges z] +} -cleanup { + destroy .t +} -result {{First second third} {1.0 1.5} {1.6 1.12} {1.6 1.12} {1.6 1.12}} +test text-13.10 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "First" bold " second" silly + list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly] +} -cleanup { + destroy .t +} -result {{First second} {1.0 1.5} {1.5 1.12}} + +# Edit, mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere. + +test text-14.1 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -state foobar +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad state "foobar": must be disabled or normal} +test text-14.2 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -spacing1 -2 -spacing2 1 -spacing3 1 + list [.t cget -spacing1] [.t cget -spacing2] [.t cget -spacing3] +} -cleanup { + destroy .t +} -result {0 1 1} +test text-14.3 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -spacing1 1 -spacing2 -1 -spacing3 1 + list [.t cget -spacing1] [.t cget -spacing2] [.t cget -spacing3] +} -cleanup { + destroy .t +} -result {1 0 1} +test text-14.4 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -spacing1 1 -spacing2 1 -spacing3 -3 + list [.t cget -spacing1] [.t cget -spacing2] [.t cget -spacing3] +} -cleanup { + destroy .t +} -result {1 1 0} +test text-14.5 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -tabs {30 foo} +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad tab alignment "foo": must be left, right, center, or numeric} +test text-14.6 {ConfigureText procedure} -setup { + text .t +} -body { + catch {.t configure -tabs {30 foo}} + .t configure -tabs {10 20 30} + return $errorInfo +} -cleanup { + destroy .t +} -result {bad tab alignment "foo": must be left, right, center, or numeric + (while processing -tabs option) + invoked from within +".t configure -tabs {30 foo}"} +test text-14.7 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -tabs {10 20 30} + .t configure -tabs {} + .t cget -tabs +} -cleanup { + destroy .t +} -result {} +test text-14.8 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -wrap bogus +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad wrap "bogus": must be char, none, or word} +test text-14.9 {ConfigureText procedure} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 +} -body { + .t configure -selectborderwidth 17 -selectforeground #332211 \ + -selectbackground #abc + list [lindex [.t tag config sel -borderwidth] 4] \ + [lindex [.t tag config sel -foreground] 4] \ + [lindex [.t tag config sel -background] 4] +} -cleanup { + destroy .t +} -result {17 #332211 #abc} +test text-14.10 {ConfigureText procedure} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 +} -body { + .t configure -selectborderwidth {} + .t tag cget sel -borderwidth +} -cleanup { + destroy .t +} -result {} +test text-14.11 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -selectborderwidth foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad screen distance "foo"} +test text-14.12 {ConfigureText procedure} -body { + text .t + entry .t.e + .t.e insert end abcdefg + .t.e select from 0 + .t.e select to 2 + text .t2 -exportselection 1 + selection get +} -cleanup { + destroy .t .t2 +} -result {ab} +test text-14.13 {ConfigureText procedure} -body { + text .t + entry .t.e + .t.e insert end abcdefg + .t.e select from 0 + .t.e select to 2 + text .t2 -exportselection 0 + .t2 insert insert 1234657890 + .t2 tag add sel 1.0 1.4 + selection get +} -cleanup { + destroy .t .t2 +} -result {ab} +test text-14.14 {ConfigureText procedure} -body { + text .t + entry .t.e + .t.e insert end abcdefg + .t.e select from 0 + .t.e select to 1 + text .t2 -exportselection 1 + .t2 insert insert 1234657890 + .t2 tag add sel 1.0 1.4 + selection get +} -cleanup { + destroy .t .t2 +} -result {1234} +test text-14.15 {ConfigureText procedure} -body { + text .t + entry .t.e + .t.e insert end abcdefg + .t.e select from 0 + .t.e select to 1 + text .t2 -exportselection 0 + .t2 insert insert 1234657890 + .t2 tag add sel 1.0 1.4 + .t2 configure -exportselection 1 + selection get +} -cleanup { + destroy .t2 .t +} -result {1234} +test text-14.16 {ConfigureText procedure} -body { + text .t + entry .t.e + .t.e insert end abcdefg + .t.e select from 0 + text .t2 -exportselection 1 + .t2 insert insert 1234657890 + .t2 tag add sel 1.0 1.4 + selection get + .t2 configure -exportselection 0 + selection get +} -cleanup { + destroy .t .t2 +} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test text-14.17 {ConfigureText procedure} -body { + text .t + entry .t.e + .t.e insert end abcdefg + .t.e select from 0 + text .t2 -exportselection 1 + .t2 insert insert 1234657890 + .t2 tag add sel 1.0 1.4 + set result [selection get] + .t2 configure -exportselection 0 + catch {selection get} + return $result +} -cleanup { + destroy .t .t2 +} -result {1234} +test text-14.18 {ConfigureText procedure} -constraints fonts -setup { + toplevel .top + text .top.t -font {Courier -12} -borderwidth 2 -highlightthickness 2 +} -body { + .top.t configure -width 20 -height 10 + pack .top.t + update + set geom [wm geometry .top] + set x [string range $geom 0 [string first + $geom]] +} -cleanup { + destroy .top +} -result {150x140+} +# This test was failing Windows because the title bar on .t was a certain +# minimum size and it was interfering with the size requested by the -setgrid. +# The "overrideredirect" gets rid of the titlebar so the toplevel can shrink +# to the appropriate size. +test text-14.19 {ConfigureText procedure} -setup { + toplevel .top + text .top.t -font {Courier -12} -borderwidth 2 -highlightthickness 2 +} -body { + .top.t configure -width 20 -height 10 -setgrid 1 + wm overrideredirect .top 1 + pack .top.t + wm geometry .top +0+0 + update + wm geometry .top +} -cleanup { + destroy .top +} -result {20x10+0+0} +# This test was failing on Windows because the title bar on .t was a certain +# minimum size and it was interfering with the size requested by the -setgrid. +# The "overrideredirect" gets rid of the titlebar so the toplevel can shrink +# to the appropriate size. +test text-14.20 {ConfigureText procedure} -setup { + toplevel .top + text .top.t -font {Courier -12} -borderwidth 2 -highlightthickness 2 +} -body { + .top.t configure -width 20 -height 10 -setgrid 1 + wm overrideredirect .top 1 + pack .top.t + wm geometry .top +0+0 + update + set result [wm geometry .top] + wm geometry .top 15x8 + update + lappend result [wm geometry .top] + .top.t configure -wrap word + update + lappend result [wm geometry .top] +} -cleanup { + destroy .top +} -result {20x10+0+0 15x8+0+0 15x8+0+0} + + +test text-15.1 {TextWorldChanged procedure, spacing options} -constraints { + fonts +} -body { + text .t -width 20 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + set result [winfo reqheight .t] + .t configure -spacing1 2 + lappend result [winfo reqheight .t] + .t configure -spacing3 1 + lappend result [winfo reqheight .t] + .t configure -spacing1 0 + lappend result [winfo reqheight .t] +} -cleanup { + destroy .t +} -result {140 160 170 150} + + +test text-16.1 {TextEventProc procedure} -body { + text .tx1 -bg #543210 + rename .tx1 .tx2 + set x {} + lappend x [winfo exists .tx1] + lappend x [.tx2 cget -bg] + destroy .tx1 + lappend x [info command .tx*] [winfo exists .tx1] [winfo exists .tx2] +} -cleanup { + destroy .txt1 +} -result {1 #543210 {} 0 0} + + +test text-17.1 {TextCmdDeletedProc procedure} -body { + text .tx1 + rename .tx1 {} + list [info command .tx*] [winfo exists .tx1] +} -cleanup { + destroy .txt1 +} -result {{} 0} +test text-17.2 {TextCmdDeletedProc procedure, disabling -setgrid} -constraints { + fonts +} -body { + toplevel .top + text .top.t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} \ + -setgrid 1 -width 20 -height 10 + pack .top.t + update + set geom [wm geometry .top] + set x [string range $geom 0 [string first + $geom]] + rename .top.t {} + update + set geom [wm geometry .top] + lappend x [string range $geom 0 [string first + $geom]] + return $x +} -cleanup { + destroy .top +} -result {20x10+ 150x140+} + + +test text-18.1 {InsertChars procedure} -body { + text .t + .t insert 2.0 abcd\n + .t get 1.0 end +} -cleanup { + destroy .t +} -result {abcd + +} +test text-18.2 {InsertChars procedure} -body { + text .t + .t insert 1.0 abcd\n + .t insert end 123\n + .t get 1.0 end +} -cleanup { + destroy .t +} -result {abcd +123 + +} +test text-18.3 {InsertChars procedure} -body { + text .t + .t insert 1.0 abcd\n + .t insert 10.0 123 + .t get 1.0 end +} -cleanup { + destroy .t +} -result {abcd +123 +} +test text-18.4 {InsertChars procedure, inserting on top visible line} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t +} -body { + .t configure -width 20 -height 4 -wrap word + .t insert insert "Now is the time for all great men to come to the " + .t insert insert "aid of their party.\n" + .t insert insert "Now is the time for all great men.\n" + .t see end + update + .t insert 1.0 "Short\n" + .t index @0,0 +} -cleanup { + destroy .t +} -result {2.56} +test text-18.5 {InsertChars procedure, inserting on top visible line} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t +} -body { + .t configure -width 20 -height 4 -wrap word + .t insert insert "Now is the time for all great men to come to the " + .t insert insert "aid of their party.\n" + .t insert insert "Now is the time for all great men.\n" + .t see end + update + .t insert 1.55 "Short\n" + .t index @0,0 +} -cleanup { + destroy .t +} -result {2.0} +test text-18.6 {InsertChars procedure, inserting on top visible line} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t +} -body { + .t configure -width 20 -height 4 -wrap word + .t insert insert "Now is the time for all great men to come to the " + .t insert insert "aid of their party.\n" + .t insert insert "Now is the time for all great men.\n" + .t see end + update + .t insert 1.56 "Short\n" + .t index @0,0 +} -cleanup { + destroy .t +} -result {1.56} +test text-18.7 {InsertChars procedure, inserting on top visible line} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t +} -body { + .t configure -width 20 -height 4 -wrap word + .t insert insert "Now is the time for all great men to come to the " + .t insert insert "aid of their party.\n" + .t insert insert "Now is the time for all great men.\n" + .t see end + update + .t insert 1.57 "Short\n" + .t index @0,0 +} -cleanup { + destroy .t +} -result {1.56} + + +test text-19.1 {DeleteChars procedure} -body { + text .t + .t get 1.0 end +} -cleanup { + destroy .t +} -result { +} +test text-19.2 {DeleteChars procedure} -body { + text .t + .t delete foobar +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "foobar"} +test text-19.3 {DeleteChars procedure} -body { + text .t + .t delete 1.0 lousy +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "lousy"} +test text-19.4 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" + .t delete 2.1 + .t get 1.0 end +} -cleanup { + destroy .t +} -result {Line 1 +acde +12345 +Line 4 +} +test text-19.5 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" + .t delete 2.3 + .t get 1.0 end +} -cleanup { + destroy .t +} -result {Line 1 +abce +12345 +Line 4 +} +test text-19.6 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" + .t delete 2.end + .t get 1.0 end +} -cleanup { + destroy .t +} -result {Line 1 +abcde12345 +Line 4 +} +test text-19.7 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" + .t tag add sel 4.2 end + .t delete 4.2 end + list [.t tag ranges sel] [.t get 1.0 end] +} -cleanup { + destroy .t +} -result {{} {Line 1 +abcde +12345 +Li +}} +test text-19.8 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" + .t tag add sel 1.0 end + .t delete 4.0 end + list [.t tag ranges sel] [.t get 1.0 end] +} -cleanup { + destroy .t +} -result {{1.0 3.5} {Line 1 +abcde +12345 +}} +test text-19.9 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" + .t delete 2.2 2.2 + .t get 1.0 end +} -cleanup { + destroy .t +} -result {Line 1 +abcde +12345 +Line 4 +} +test text-19.10 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" + .t delete 2.3 2.1 + .t get 1.0 end +} -cleanup { + destroy .t +} -result {Line 1 +abcde +12345 +Line 4 +} +test text-19.11 {DeleteChars procedure} -body { + toplevel .top + text .top.t -width 20 -height 5 + pack .top.t + wm geometry .top +0+0 + .top.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns" + update + .top.t delete 1.0 3.0 + list [.top.t index @0,0] [.top.t get @0,0] +} -cleanup { + destroy .top +} -result {1.0 x} +test text-19.12 {DeleteChars procedure} -body { + toplevel .top + text .top.t -width 20 -height 5 + pack .top.t + wm geometry .top +0+0 + .top.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns" + .top.t yview 3.0 + update + .top.t delete 2.0 4.0 + list [.top.t index @0,0] [.top.t get @0,0] +} -cleanup { + destroy .top +} -result {2.0 y} +test text-19.13 {DeleteChars procedure, updates affecting topIndex} -setup { + toplevel .top + text .top.t -width 1 -height 10 -wrap char + pack .top.t -side left + wm geometry .top +0+0 + update +} -body { + .top.t insert end "abcde\n12345\nqrstuv" + .top.t yview 2.1 + .top.t delete 1.4 2.3 + .top.t index @0,0 +} -cleanup { + destroy .top +} -result {1.2} +test text-19.14 {DeleteChars procedure, updates affecting topIndex} -setup { + toplevel .top + text .top.t -width 1 -height 10 -wrap char + pack .top.t -side left + wm geometry .top +0+0 + update +} -body { + .top.t insert end "abcde\n12345\nqrstuv" + .top.t yview 2.1 + .top.t delete 2.3 2.4 + .top.t index @0,0 +} -cleanup { + destroy .top +} -result {2.0} +test text-19.15 {DeleteChars procedure, updates affecting topIndex} -setup { + toplevel .top + text .top.t -width 1 -height 10 -wrap char + pack .top.t -side left + wm geometry .top +0+0 + update +} -body { + .top.t insert end "abcde\n12345\nqrstuv" + .top.t yview 1.3 + .top.t delete 1.0 1.2 + .top.t index @0,0 +} -cleanup { + destroy .top +} -result {1.1} +test text-19.16 {DeleteChars procedure, updates affecting topIndex} -setup { + toplevel .top + text .top.t -width 6 -height 10 -wrap word + frame .top.f -width 200 -height 20 -relief raised -bd 2 + pack .top.f .top.t -side left + wm geometry .top +0+0 + update +} -body { + .top.t insert end "abc def\n01 2a345 678 9101112\nLine 3\nLine 4\nLine 5\n6\n7\n8\n" + .top.t yview 2.4 + .top.t delete 2.5 + set x [.top.t index @0,0] + .top.t delete 2.5 + list $x [.top.t index @0,0] +} -cleanup { + destroy .top +} -result {2.3 2.0} + + +test text-20.1 {TextFetchSelection procedure} -setup { + text .t -width 20 -height 10 + pack .t -expand 1 -fill both + update +} -body { + foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} { + .t insert end $i.0$i.1$i.2$i.3$i.4\n + } + .t tag add sel 1.3 3.4 + selection get +} -cleanup { + destroy .t +} -result {a.1a.2a.3a.4 +b.0b.1b.2b.3b.4 +c.0c} +test text-20.2 {TextFetchSelection procedure} -setup { + text .t -width 20 -height 10 + pack .t -expand 1 -fill both + update +} -body { + foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} { + .t insert end $i.0$i.1$i.2$i.3$i.4\n + } + .t tag add x 1.2 + .t tag add x 1.4 + .t tag add x 2.0 + .t tag add x 2.3 + .t tag remove sel 1.0 end + .t tag add sel 1.0 3.4 + selection get +} -cleanup { + destroy .t +} -result {a.0a.1a.2a.3a.4 +b.0b.1b.2b.3b.4 +c.0c} +test text-20.3 {TextFetchSelection procedure} -setup { + text .t -width 20 -height 10 + pack .t -expand 1 -fill both + update +} -body { + foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} { + .t insert end $i.0$i.1$i.2$i.3$i.4\n + } + .t tag remove sel 1.0 end + .t tag add sel 13.3 + selection get +} -cleanup { + destroy .t +} -result {m} +test text-20.4 {TextFetchSelection procedure} -setup { + text .t -width 20 -height 10 + pack .t -expand 1 -fill both + update +} -body { + foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} { + .t insert end $i.0$i.1$i.2$i.3$i.4\n + } + .t tag remove x 1.0 end + .t tag add sel 1.0 3.4 + .t tag remove sel 1.0 end + .t tag add sel 1.2 1.5 + .t tag add sel 2.4 3.1 + .t tag add sel 10.0 10.end + .t tag add sel 13.3 + selection get +} -cleanup { + destroy .t +} -result {0a..1b.2b.3b.4 +cj.0j.1j.2j.3j.4m} +test text-20.5 {TextFetchSelection procedure, long selections} -setup { + text .t -width 20 -height 10 + pack .t -expand 1 -fill both + update + set x "" +} -body { + for {set i 1} {$i < 200} {incr i} { + append x "This is line $i, padded to just about 53 characters.\n" + } + .t insert end $x + .t tag add sel 1.0 end + expr {[selection get] eq "$x\n"} +} -cleanup { + destroy .t +} -result {1} + + +test text-21.1 {TkTextLostSelection procedure} -constraints {x11} -setup { + text .t + .t insert 1.0 "Line 1" + entry .t.e + .t.e insert end "abcdefg" + text .t2 + .t2 insert 1.0 "abc\ndef\nghijk\n1234" +} -body { + .t2 tag add sel 1.2 3.3 + .t.e select from 0 + .t.e select to 1 + .t2 tag ranges sel +} -cleanup { + destroy .t .t2 +} -result {} +test text-21.2 {TkTextLostSelection procedure} -constraints aquaOrWin32 -setup { + text .t + .t insert 1.0 "Line 1" + entry .t.e + .t.e insert end "abcdefg" + text .t2 + .t2 insert 1.0 "abc\ndef\nghijk\n1234" +} -body { + .t2 tag add sel 1.2 3.3 + .t.e select from 0 + .t.e select to 1 + .t2 tag ranges sel +} -cleanup { + destroy .t .t2 +} -result {1.2 3.3} +test text-21.3 {TkTextLostSelection procedure} -body { + text .t + .t insert 1.0 "abcdef\nghijk\n1234" + .t tag add sel 1.0 1.3 + selection get + selection clear + selection get +} -cleanup { + destroy .t +} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test text-21.4 {TkTextLostSelection procedure} -body { + text .t + .t insert 1.0 "abcdef\nghijk\n1234" + .t tag add sel 1.0 1.3 + set x [selection get] + selection clear + catch {selection get} + .t tag add sel 1.0 1.3 + lappend x [selection get] +} -cleanup { + destroy .t +} -result {abc abc} + + +test text-22.1 {TextSearchCmd procedure, argument parsing} -body { + text .t + .t search - +} -cleanup { + destroy .t +} -returnCodes error -result {ambiguous switch "-": must be --, -all, -backwards, -count, -elide, -exact, -forwards, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits} +test text-22.2 {TextSearchCmd procedure, -backwards option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -backwards xyz 1.4 +} -cleanup { + destroy .t +} -result {1.1} +test text-22.3 {TextSearchCmd procedure, -all option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -all xyz 1.4 +} -cleanup { + destroy .t +} -result {1.5 3.0 3.5 1.1} +test text-22.4 {TextSearchCmd procedure, -forwards option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -forwards xyz 1.4 +} -cleanup { + destroy .t +} -result {1.5} +test text-22.5 {TextSearchCmd procedure, -exact option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -f -exact x. 1.0 +} -cleanup { + destroy .t +} -result {1.9} +test text-22.6 {TextSearchCmd procedure, -regexp option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -b -regexp x.z 1.4 +} -cleanup { + destroy .t +} -result {1.1} +test text-22.7 {TextSearchCmd procedure, -count option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + set length unmodified + list [.t search -count length x. 1.4] $length +} -cleanup { + destroy .t +} -result {1.9 2} +test text-22.8 {TextSearchCmd procedure, -count option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -count +} -cleanup { + destroy .t +} -returnCodes {error} -result {no value given for "-count" option} +test text-22.9 {TextSearchCmd procedure, -nocase option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + list [.t search -nocase BaR 1.1] [.t search BaR 1.1] +} -cleanup { + destroy .t +} -result {2.13 2.23} +test text-22.10 {TextSearchCmd procedure, -n ambiguous option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -n BaR 1.1 +} -cleanup { + destroy .t +} -returnCodes error -result {ambiguous switch "-n": must be --, -all, -backwards, -count, -elide, -exact, -forwards, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits} +test text-22.11 {TextSearchCmd procedure, -nocase option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -noc BaR 1.1 +} -cleanup { + destroy .t +} -result {2.13} +test text-22.12 {TextSearchCmd procedure, -nolinestop option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -nolinestop BaR 1.1 +} -cleanup { + destroy .t +} -returnCodes {error} -result {the "-nolinestop" option requires the "-regexp" option to be present} +test text-22.13 {TextSearchCmd procedure, -nolinestop option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + set msg "" + list [.t search -nolinestop -regexp -count msg e.*o 1.1] $msg +} -cleanup { + destroy .t +} -result {1.14 32} +test text-22.14 {TextSearchCmd procedure, -- option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -- -forward 1.0 +} -cleanup { + destroy .t +} -result {2.4} +test text-22.15 {TextSearchCmd procedure, argument parsing} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search abc +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"} +test text-22.16 {TextSearchCmd procedure, argument parsing} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search abc d e f +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"} +test text-22.17 {TextSearchCmd procedure, check index} -body { + text .t + .t search abc gorp +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "gorp"} +test text-22.18 {TextSearchCmd procedure, startIndex == "end"} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search non-existent end +} -cleanup { + destroy .t +} -result {} +test text-22.19 {TextSearchCmd procedure, startIndex == "end"} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search non-existent end +} -cleanup { + destroy .t +} -result {} +test text-22.20 {TextSearchCmd procedure, bad stopIndex} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search abc 1.0 lousy +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "lousy"} +test text-22.21 {TextSearchCmd procedure, pattern case conversion} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + list [.t search -nocase BAR 1.1] [.t search BAR 1.1] +} -cleanup { + destroy .t +} -result {2.13 {}} +test text-22.22 {TextSearchCmd procedure, bad regular expression pattern} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -regexp a( 1.0 +} -cleanup { + destroy .t +} -returnCodes {error} -result {couldn't compile regular expression pattern: parentheses () not balanced} +test text-22.23 {TextSearchCmd procedure, skip dummy last line} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -backwards BaR end 1.0 +} -cleanup { + destroy .t +} -result {2.23} +test text-22.24 {TextSearchCmd procedure, skip dummy last line} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -backwards \n end 1.0 +} -cleanup { + destroy .t +} -result {3.9} +test text-22.25 {TextSearchCmd procedure, skip dummy last line} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search \n end +} -cleanup { + destroy .t +} -result {1.15} +test text-22.26 {TextSearchCmd procedure, skip dummy last line} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -back \n 1.0 +} -cleanup { + destroy .t +} -result {3.9} +test text-22.27 {TextSearchCmd procedure, extract line contents} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t tag add foo 1.2 + .t tag add x 1.3 + .t mark set silly 1.2 + .t search xyz 3.6 +} -cleanup { + destroy .t +} -result {1.1} +test text-22.28 {TextSearchCmd procedure, stripping newlines} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search the\n 1.0 +} -cleanup { + destroy .t +} -result {1.12} +test text-22.29 {TextSearchCmd procedure, handling newlines} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -regexp the\n 1.0 +} -cleanup { + destroy .t +} -result {1.12} +test text-22.30 {TextSearchCmd procedure, stripping newlines} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -regexp {the$} 1.0 +} -cleanup { + destroy .t +} -result {1.12} +test text-22.31 {TextSearchCmd procedure, handling newlines} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -regexp \n 1.0 +} -cleanup { + destroy .t +} -result {1.15} +test text-22.32 {TextSearchCmd procedure, line case conversion} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + list [.t search -nocase bar 2.18] [.t search bar 2.18] +} -cleanup { + destroy .t +} -result {2.23 2.13} +test text-22.33 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -backwards xyz 1.6 +} -cleanup { + destroy .t +} -result {1.5} +test text-22.34 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -backwards xyz 1.5 +} -cleanup { + destroy .t +} -result {1.1} +test text-22.35 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search xyz 1.5 +} -cleanup { + destroy .t +} -result {1.5} +test text-22.36 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search xyz 1.6 +} -cleanup { + destroy .t +} -result {3.0} +test text-22.37 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search {} 1.end +} -cleanup { + destroy .t +} -result {1.15} +test text-22.38 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search f 1.end +} -cleanup { + destroy .t +} -result {2.0} +test text-22.39 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search {} end +} -cleanup { + destroy .t +} -result {1.0} +test text-22.40 {TextSearchCmd procedure, regexp finds empty lines} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" +# Test for fix of bug #1643 + .t insert end "\n" + tk::TextSetCursor .t 4.0 + .t search -forward -regexp {^$} insert end +} -cleanup { + destroy .t +} -result {4.0} +test text-22.41 {TextSearchCmd procedure, firstChar and lastChar} -setup { + toplevel .top + text .top.t -width 30 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .top.t +} -body { + .top.t insert 1.0 "This is a line\nand this is another" + .top.t insert end "\nand this is yet another" + frame .top.f -width 20 -height 20 -bd 2 -relief raised + .top.t window create 2.5 -window .top.f + .top.t search his 2.6 +} -cleanup { + destroy .top +} -result {2.6} +test text-22.42 {TextSearchCmd procedure, firstChar and lastChar} -setup { + toplevel .top + text .top.t -width 30 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .top.t +} -body { + .top.t insert 1.0 "This is a line\nand this is another" + .top.t insert end "\nand this is yet another" + frame .top.f -width 20 -height 20 -bd 2 -relief raised + .top.t window create 2.5 -window .top.f + .top.t search this 2.6 +} -cleanup { + destroy .top +} -result {3.4} +test text-22.43 {TextSearchCmd procedure, firstChar and lastChar} -setup { + toplevel .top + text .top.t -width 30 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .top.t +} -body { + .top.t insert 1.0 "This is a line\nand this is another" + .top.t insert end "\nand this is yet another" + frame .top.f -width 20 -height 20 -bd 2 -relief raised + .top.t window create 2.5 -window .top.f + .top.t search is 2.6 +} -cleanup { + destroy .top +} -result {2.7} +test text-22.44 {TextSearchCmd procedure, firstChar and lastChar} -setup { + toplevel .top + text .top.t -width 30 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .top.t +} -body { + .top.t insert 1.0 "This is a line\nand this is another" + .top.t insert end "\nand this is yet another" + frame .top.f -width 20 -height 20 -bd 2 -relief raised + .top.t window create 2.5 -window .top.f + .top.t search his 2.7 +} -cleanup { + destroy .top +} -result {3.5} +test text-22.45 {TextSearchCmd procedure, firstChar and lastChar} -setup { + toplevel .top + text .top.t -width 30 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .top.t +} -body { + .top.t insert 1.0 "This is a line\nand this is another" + .top.t insert end "\nand this is yet another" + frame .top.f -width 20 -height 20 -bd 2 -relief raised + .top.t window create 2.5 -window .top.f + .top.t search -backwards "his is another" 2.6 +} -cleanup { + destroy .top +} -result {2.6} +test text-22.46 {TextSearchCmd procedure, firstChar and lastChar} -setup { + toplevel .top + text .top.t -width 30 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .top.t +} -body { + .top.t insert 1.0 "This is a line\nand this is another" + .top.t insert end "\nand this is yet another" + frame .top.f -width 20 -height 20 -bd 2 -relief raised + .top.t window create 2.5 -window .top.f + .top.t search -backwards "his is" 2.6 +} -cleanup { + destroy .top +} -result {1.1} +test text-22.47 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -backwards forw 2.5 +} -cleanup { + destroy .t +} -result {2.5} +test text-22.48 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search forw 2.5 +} -cleanup { + destroy .t +} -result {2.5} +test text-22.49 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + catch {destroy .t} + text .t2 + list [.t2 search a 1.0] [.t2 search -backward a 1.0] +} -cleanup { + destroy .t .t2 +} -result {{} {}} +test text-22.50 {TextSearchCmd procedure, regexp match length} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + set length unchanged + list [.t search -regexp -count length x(.)(.*)z 1.1] $length +} -cleanup { + destroy .t +} -result {1.1 7} +test text-22.51 {TextSearchCmd procedure, regexp match length} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + set length unchanged + list [.t search -regexp -backward -count length fo* 2.5] $length +} -cleanup { + destroy .t +} -result {2.0 3} +test text-22.52 {TextSearchCmd procedure, checking stopIndex} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + list [.t search bar 2.1 2.13] [.t search bar 2.1 2.14] \ + [.t search bar 2.12 2.14] [.t search bar 2.14 2.14] +} -cleanup { + destroy .t +} -result {{} 2.13 2.13 {}} +test text-22.53 {TextSearchCmd procedure, checking stopIndex} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + list [.t search -backwards bar 2.20 2.13] \ + [.t search -backwards bar 2.20 2.14] \ + [.t search -backwards bar 2.14 2.13] \ + [.t search -backwards bar 2.13 2.13] +} -cleanup { + destroy .t +} -result {2.13 {} 2.13 {}} +test text-22.54 {TextSearchCmd procedure, checking stopIndex} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + list [.t search -backwards -strict bar 2.20 2.13] \ + [.t search -backwards -strict bar 2.20 2.14] \ + [.t search -backwards -strict bar 2.14 2.13] \ + [.t search -backwards -strict bar 2.13 2.13] +} -cleanup { + destroy .t +} -result {2.13 {} {} {}} +test text-22.55 {TextSearchCmd procedure, embedded windows and index/count} -setup { + text .t + frame .t.f1 -width 20 -height 20 -relief raised -bd 2 + frame .t.f2 -width 20 -height 20 -relief raised -bd 2 + frame .t.f3 -width 20 -height 20 -relief raised -bd 2 + frame .t.f4 -width 20 -height 20 -relief raised -bd 2 + set result "" +} -body { + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t window create 2.10 -window .t.f3 + .t window create 2.8 -window .t.f2 + .t window create 2.8 -window .t.f1 + .t window create 2.1 -window .t.f4 + lappend result [.t search -count x forward 1.0] $x + lappend result [.t search -count x wa 1.0] $x + return $result +} -cleanup { + destroy .t +} -result {2.6 10 2.11 2} +test text-22.56 {TextSearchCmd procedure, error setting variable} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + set a 44 + .t search -count a(2) xyz 1.0 +} -cleanup { + destroy .t +} -returnCodes {error} -result {can't set "a(2)": variable isn't array} +test text-22.57 {TextSearchCmd procedure, wrap-around} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -backwards xyz 1.1 +} -cleanup { + destroy .t +} -result {3.5} +test text-22.58 {TextSearchCmd procedure, wrap-around} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -backwards xyz 1.1 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.59 {TextSearchCmd procedure, wrap-around} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search xyz 3.6 +} -cleanup { + destroy .t +} -result {1.1} +test text-22.60 {TextSearchCmd procedure, wrap-around} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search xyz 3.6 end +} -cleanup { + destroy .t +} -result {} +test text-22.61 {TextSearchCmd procedure, no match} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search non_existent 3.5 +} -cleanup { + destroy .t +} -result {} +test text-22.62 {TextSearchCmd procedure, no match} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -regexp non_existent 3.5 +} -cleanup { + destroy .t +} -result {} +test text-22.63 {TextSearchCmd procedure, special cases} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -back x 1.1 +} -cleanup { + destroy .t +} -result {1.0} +test text-22.64 {TextSearchCmd procedure, special cases} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -back x 1.0 +} -cleanup { + destroy .t +} -result {3.8} +test text-22.65 {TextSearchCmd procedure, special cases} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search \n {end-2c} +} -cleanup { + destroy .t +} -result {3.9} +test text-22.66 {TextSearchCmd procedure, special cases} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search \n end +} -cleanup { + destroy .t +} -result {1.15} +test text-22.67 {TextSearchCmd procedure, special cases} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search x 1.0 +} -cleanup { + destroy .t +} -result {1.0} +test text-22.68 {TextSearchCmd, freeing copy of pattern} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" +# This test doesn't return a result, but it will generate +# a core leak if the pattern copy isn't properly freed. +# (actually in Tk 8.5 objectification means there is no +# longer a copy of the pattern, but we leave this test in +# anyway). + set p abcdefg1234567890 + set p $p$p$p$p$p$p$p$p + set p $p$p$p$p$p + .t search -nocase $p 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.69 {TextSearchCmd, unicode} -body { + text .t + .t insert end "foo\u30c9\u30cabar" + .t search \u30c9\u30ca 1.0 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.70 {TextSearchCmd, unicode} -body { + text .t + .t insert end "foo\u30c9\u30cabar" + list [.t search -count n \u30c9\u30ca 1.0] $n +} -cleanup { + destroy .t +} -result {1.3 2} +test text-22.71 {TextSearchCmd, unicode with non-text segments} -body { + text .t + button .b1 -text baz + .t insert end "foo\u30c9" + .t window create end -window .b1 + .t insert end "\u30cabar" + list [.t search -count n \u30c9\u30ca 1.0] $n +} -cleanup { + destroy .t .b1 +} -result {1.3 3} +test text-22.72 {TextSearchCmd, hidden text does not affect match index} -body { + pack [text .t] + .t insert end "12345H7890" + .t search 7 1.0 +} -cleanup { + destroy .t +} -result {1.6} +test text-22.73 {TextSearchCmd, hidden text does not affect match index} -body { + pack [text .t] + .t insert end "12345H7890" + .t tag configure hidden -elide true + .t tag add hidden 1.5 + .t search 7 1.0 +} -cleanup { + destroy .t +} -result {1.6} +test text-22.74 {TextSearchCmd, hidden text does not affect match index} -body { + pack [text .t] + .t insert end "foobar\nbarbaz\nbazboo" + .t search boo 1.0 +} -cleanup { + destroy .t +} -result {3.3} +test text-22.75 {TextSearchCmd, hidden text does not affect match index} -body { + pack [text .t] + .t insert end "foobar\nbarbaz\nbazboo" + .t tag configure hidden -elide true + .t tag add hidden 2.0 3.0 + .t search boo 1.0 +} -cleanup { + destroy .t +} -result {3.3} +test text-22.76 {TextSearchCmd, -regexp -nocase searches} -body { + pack [text .t] + .t insert end "word1 word2" + .t search -nocase -regexp {\mword.} 1.0 end +} -cleanup { + destroy .t +} -result {1.0} +test text-22.77 {TextSearchCmd, -regexp -nocase searches} -body { + pack [text .t] + .t insert end "word1 word2" + .t search -nocase -regexp {word.\M} 1.0 end +} -cleanup { + destroy .t +} -result {1.0} +test text-22.78 {TextSearchCmd, -regexp -nocase searches} -body { + pack [text .t] + .t insert end "word1 word2" + .t search -nocase -regexp {word.\W} 1.0 end +} -cleanup { + destroy .t +} -result {1.0} +test text-22.79 {TextSearchCmd, hidden text and start index} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search bar 1.3 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.80 {TextSearchCmd, hidden text shouldn't influence start index} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.0 1.2 + .t search bar 1.3 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.81 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + list [.t search -count foo foar 1.3] $foo +} -cleanup { + destroy .t +} -result {1.0 6} +test text-22.82 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + list \ + [.t search -strict -count foo foar 1.3] \ + [.t search -strict -count foo foar 2.3] $foo +} -cleanup { + destroy .t +} -result {{} 1.0 6} +test text-22.83 {TextSearchCmd, hidden text and start index} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -regexp bar 1.3 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.84 {TextSearchCmd, hidden text shouldn't influence start index} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.0 1.2 + .t search -regexp bar 1.3 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.85 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + list [.t search -regexp -count foo foar 1.3] $foo +} -cleanup { + destroy .t +} -result {1.0 6} +test text-22.86 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + list [.t search -count foo foar 1.3] $foo +} -cleanup { + destroy .t +} -result {1.0 6} +test text-22.87 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + .t search -strict -count foo foar 1.3 +} -cleanup { + destroy .t +} -result {} +test text-22.88 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + .t tag add hidden 2.2 2.4 + list [.t search -regexp -all -count foo foar 1.3] $foo +} -cleanup { + destroy .t +} -result {{2.0 3.0 1.0} {6 4 6}} +test text-22.89 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + .t tag add hidden 2.2 2.4 + list [.t search -all -count foo foar 1.3] $foo +} -cleanup { + destroy .t +} -result {{2.0 3.0 1.0} {6 4 6}} +test text-22.90 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + .t tag add hidden 2.2 2.4 + list [.t search -strict -all -count foo foar 1.3] $foo +} -cleanup { + destroy .t +} -result {{2.0 3.0} {6 4}} +test text-22.91 {TextSearchCmd, single line with -all} -body { + pack [text .t] + .t insert end " X\n X\n X\n X\n X\n X\n" + .t search -all -regexp { +| *\n} 1.0 end +} -cleanup { + destroy .t +} -result {1.0 1.2 2.0 2.2 3.0 3.2 4.0 4.2 5.0 5.2 6.0 6.2 7.0} +test text-22.92 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -count foo foobar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 10} +test text-22.93 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -count foo bar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.3 7} +test text-22.94 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -count foo \nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.6 4} +test text-22.95 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -count foo bar\nfoobar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.3 14} +test text-22.96 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -count foo bar\nfoobar\nfoobanearly 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.97 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -regexp -count foo foobar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 10} +test text-22.98 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -regexp -count foo bar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.3 7} +test text-22.99 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -regexp -count foo \nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.6 4} +test text-22.100 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -regexp -count foo bar\nfoobar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.3 14} +test text-22.101 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -regexp -count foo bar\nfoobar\nfoobanearly 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.102 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfaoobar\nfoobar" + .t search -regexp -count foo bar\nfoo 1.0 +} -cleanup { + destroy .t +} -result {2.4} +test text-22.103 {TextSearchCmd, multiline matching end of window} -body { + pack [text .t] + .t insert end "foobar\nfaoobar\nfoobar" + .t search -regexp -count foo bar\nfoobar\n\n 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.104 {TextSearchCmd, multiline matching end of window} -body { + pack [text .t] + .t search "\n\n" 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.105 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -count foo foobar\nfoo end] $foo +} -cleanup { + destroy .t +} -result {2.0 10} +test text-22.106 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -count foo bar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {2.3 7} +test text-22.107 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -count foo \nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {2.6 4} +test text-22.108 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -count foo bar\nfoobar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.3 14} +test text-22.109 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -backwards -count foo bar\nfoobar\nfoobanearly 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.110 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -regexp -count foo foobar\nfoo end] $foo +} -cleanup { + destroy .t +} -result {2.0 10} +test text-22.111 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -regexp -count foo foobar\nfo end] $foo +} -cleanup { + destroy .t +} -result {2.0 9} +test text-22.112 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -regexp -count foo bar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {2.3 7} +test text-22.113 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -regexp -count foo \nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {2.6 4} +test text-22.114 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -regexp -count foo bar\nfoobar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.3 14} +test text-22.115 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -backwards -regexp -count foo bar\nfoobar\nfoobanearly 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.116 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfaoobar\nfoobar" + .t search -backwards -regexp -count foo bar\nfoo 1.0 +} -cleanup { + destroy .t +} -result {2.4} +test text-22.117 {TextSearchCmd, multiline matching end of window} -body { + pack [text .t] + .t insert end "foobar\nfaoobar\nfoobar" + .t search -backwards -regexp -count foo bar\nfoobar\n\n 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.118 {TextSearchCmd, multiline matching end of window} -body { + pack [text .t] + .t search -backwards "\n\n" 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.119 {TextSearchCmd, multiline regexp matching} -body { + pack [text .t] + .t insert 1.0 { Tcl_Obj *objPtr)); +static Tcl_Obj* FSNormalizeAbsolutePath + _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} + set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" + append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" + append markExpr "\[ \n\t\r\]*\\()" + .t search -forwards -regexp $markExpr 1.41 end +} -cleanup { + destroy .t +} -result {} +test text-22.120 {TextSearchCmd, multiline regexp matching} -body { +# Practical example which used to crash Tk, but only after the +# search is complete. This is memory corruption caused by +# a bug in Tcl's handling of string objects. +# (Tcl bug 635200) + pack [text .t] + .t insert 1.0 {static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); +static Tcl_Obj* FSNormalizeAbsolutePath + _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} + set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" + append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" + append markExpr "\[ \n\t\r\]*\\()" + .t search -forwards -regexp $markExpr 1.41 end +} -cleanup { + destroy .t +} -result {} +test text-22.121 {TextSearchCmd, multiline regexp matching} -body { + pack [text .t] + .t insert 1.0 { +static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); +static Tcl_Obj* FSNormalizeAbsolutePath + _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} + set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" + append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" + append markExpr "\[ \n\t\r\]*\\()" + .t search -backwards -all -regexp $markExpr end +} -cleanup { + destroy .t +} -result {2.0} +test text-22.122 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -all -regexp -count foo bar\nfoo 1.0 +} -cleanup { + destroy .t +} -result {1.3 2.3} +test text-22.123 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -all -backwards -regexp -count foo bar\nfoo 1.0 +} -cleanup { + destroy .t +} -result {2.3 1.3} +test text-22.124 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -- "blah" 3.3 1.3 +} -cleanup { + destroy .t +} -result {} +test text-22.125 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -backwards -- "blah" 1.3 3.3 +} -cleanup { + destroy .t +} -result {} +test text-22.126 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "if (stringPtr->uallocated > 0) \{x" + .t search -backwards -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0 +} -cleanup { + destroy .t +} -result {1.31} +test text-22.127 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "if (stringPtr->uallocated > 0) \{x" + .t search -regexp -- "\[\]\")\}\[(\{\]" 1.30 "1.0 lineend" +} -cleanup { + destroy .t +} -result {1.31} +test text-22.128 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "if (stringPtr->uallocated > 0) \{x" + .t search -backwards -all -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0 +} -cleanup { + destroy .t +} -result {1.31 1.29 1.3} +test text-22.129 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "if (stringPtr->uallocated > 0) \{x" + .t search -all -regexp -- "\[\]\")\}\[(\{\]" 1.0 "1.0 lineend" +} -cleanup { + destroy .t +} -result {1.3 1.29 1.31} +test text-22.130 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "if (stringPtr->uallocated > 0) \{x" + .t search -backwards -- "\{" "1.32" 1.0 +} -cleanup { + destroy .t +} -result {1.31} +test text-22.131 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "if (stringPtr->uallocated > 0) \{x" + .t search -- "\{" 1.30 "1.0 lineend" +} -cleanup { + destroy .t +} -result {1.31} +test text-22.132 {TextSearchCmd, multiline regexp matching} -body { + pack [text .t] + .t insert 1.0 { + +void +Tcl_SetObjLength(objPtr, length) + register Tcl_Obj *objPtr; /* Pointer to object. This object must + * not currently be shared. */ + register int length; /* Number of bytes desired for string + * representation of object, not including + * terminating null byte. */ +\{ + char *new; +} + set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" + append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" + append markExpr "\[ \n\t\r\]*\\()" + .t search -all -regexp -- $markExpr 1.0 +} -cleanup { + destroy .t +} -result {4.0} +test text-22.133 {TextSearchCmd, multiline regexp matching} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + set markExpr {^[a-z]+} +# This should not match, and should not wrap + .t search -regexp -- $markExpr end end +} -cleanup { + destroy .t +} -result {} +test text-22.134 {TextSearchCmd, multiline regexp matching} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + set markExpr {^[a-z]+} +# This should not match, and should not wrap + .t search -regexp -- $markExpr end+10c end +} -cleanup { + destroy .t +} -result {} +test text-22.135 {TextSearchCmd, multiline regexp matching} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + set markExpr {^[a-z]+} +# This should not match, and should not wrap + .t search -regexp -backwards -- $markExpr 1.0 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.136 {TextSearchCmd, regexp linestop} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + .t search -regexp -- {i.*x} 1.0 +} -cleanup { + destroy .t +} -result {2.6} +test text-22.137 {TextSearchCmd, multiline regexp nolinestop matching} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + .t search -regexp -nolinestop -- {i.*x} 1.0 +} -cleanup { + destroy .t +} -result {1.1} +test text-22.138 {TextSearchCmd, regexp linestop} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + .t search -regexp -all -overlap -- {i.*x} 1.0 +} -cleanup { + destroy .t +} -result {2.6} +test text-22.139 {TextSearchCmd, regexp linestop} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + .t search -regexp -all -- {i.*x} 1.0 +} -cleanup { + destroy .t +} -result {2.6} +test text-22.140 {TextSearchCmd, multiline regexp nolinestop matching} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + list [.t search -regexp -all -overlap -count c -nolinestop -- {i.*x} 1.0] $c +} -cleanup { + destroy .t +} -result {{1.1 2.6} {26 10}} +test text-22.141 {TextSearchCmd, multiline regexp nolinestop matching} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + list [.t search -regexp -all -count c -nolinestop -- {i.*x} 1.0] $c +} -cleanup { + destroy .t +} -result {1.1 26} +test text-22.142 {TextSearchCmd, stop at end of line} -body { + pack [text .t] + .t insert 1.0 " \t\n last line of text" + .t search -regexp -nolinestop -- {[^ \t]} 1.0 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.143 {TextSearchCmd, overlapping all matches} -body { + pack [text .t] + .t insert 1.0 "abcde abcde" + list [.t search -regexp -all -overlap -count c -- {\w+} 1.0] $c +} -cleanup { + destroy .t +} -result {{1.0 1.6} {5 5}} +test text-22.144 {TextSearchCmd, non-overlapping all matches} -body { + pack [text .t] + .t insert 1.0 "abcde abcde" + list [.t search -regexp -all -count c -- {\w+} 1.0] $c +} -cleanup { + destroy .t +} -result {{1.0 1.6} {5 5}} +test text-22.145 {TextSearchCmd, stop at end of line} -body { + pack [text .t] + .t insert 1.0 "abcde abcde" + list [.t search -backwards -regexp -all -count c -- {\w+} 1.0] $c +} -cleanup { + destroy .t +} -result {{1.6 1.0} {5 5}} +test text-22.146 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t search -backwards -regexp -count c -- {Z\w+} 1.21 1.5] $c +} -cleanup { + destroy .t +} -result {1.8 8} +test text-22.147 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t search -backwards -all -overlap -regexp -count c -- {Z\w+} 1.21 1.5] $c +} -cleanup { + destroy .t +} -result {1.8 8} +test text-22.148 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t search -backwards -all -regexp -count c -- {Z\w+} 1.21 1.5] $c +} -cleanup { + destroy .t +} -result {1.8 8} +test text-22.149 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t search -backwards -overlap -all -regexp -count c -- {Z\w+} 1.21 1.1] $c +} -cleanup { + destroy .t +} -result {1.4 12} +test text-22.150 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t search -backwards -overlap -all -regexp -count c -- {Z[^Z]+Z} 1.21 1.1] $c +} -cleanup { + destroy .t +} -result {{1.8 1.4} {5 5}} +test text-22.151 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t search -backwards -all -regexp -count c -- {Z\w+} 1.21 1.1] $c +} -cleanup { + destroy .t +} -result {1.4 12} +test text-22.152 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + .t insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t search -backwards -all -overlap -regexp -count c -- {Z\w+} 2.21 1.5] $c +} -cleanup { + destroy .t +} -result {{2.4 1.8} {12 8}} +test text-22.153 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + .t insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t search -backwards -all -regexp -count c -- {Z\w+} 2.21 1.5] $c +} -cleanup { + destroy .t +} -result {{2.4 1.8} {12 8}} +test text-22.154 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + .t insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t search -backwards -overlap -all -regexp -count c -- {Z\w+} 2.21 1.1] $c +} -cleanup { + destroy .t +} -result {{2.4 1.4} {12 12}} +test text-22.155 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + .t insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t search -backwards -all -regexp -count c -- {Z\w+} 2.21 1.1] $c +} -cleanup { + destroy .t +} -result {{2.4 1.4} {12 12}} +test text-22.156 {TextSearchCmd, search -all example} -body { + pack [text .t] + .t insert 1.0 { + +See the package: supersearch for more information. + + +See the package: incrementalSearch for more information. + +package: Brws . + + +See the package: marks for more information. + +} + set pat {package: ([a-zA-Z0-9][-a-zA-Z0-9._+#/]*)} + list [.t search -nolinestop -regexp -nocase -all -forwards \ + -count c -- $pat 1.0 end] $c +} -cleanup { + destroy .t +} -result {{3.8 6.8 8.0 11.8} {20 26 13 14}} +test text-22.157 {TextSearchCmd, backwards search overlaps} -body { + pack [text .t] + .t insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t search -backwards -regexp {fooba+rfoo} end +} -cleanup { + destroy .t +} -result {1.6} +test text-22.158 {TextSearchCmd, backwards search overlaps} -body { + pack [text .t] + .t insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t search -backwards -overlap -all -regexp {fooba+rfoo} end +} -cleanup { + destroy .t +} -result {1.6 1.0} +test text-22.159 {TextSearchCmd, backwards search overlaps} -body { + pack [text .t] + .t insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t search -backwards -all -regexp {fooba+rfoo} end +} -cleanup { + destroy .t +} -result {1.6} +test text-22.160 {TextSearchCmd, forwards search overlaps} -body { + pack [text .t] + .t insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t search -all -overlap -regexp {fooba+rfoo} end +} -cleanup { + destroy .t +} -result {1.0 1.6} +test text-22.161 {TextSearchCmd, forwards search overlaps} -body { + pack [text .t] + .t insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t search -all -regexp {fooba+rfoo} end +} -cleanup { + destroy .t +} -result {1.0} +test text-22.162 {TextSearchCmd, forward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "abababab" + .t search -exact -overlap -all {abab} 1.0 +} -cleanup { + destroy .t +} -result {1.0 1.2 1.4} +test text-22.163 {TextSearchCmd, forward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "abababab" + .t search -exact -all {abab} 1.0 +} -cleanup { + destroy .t +} -result {1.0 1.4} +test text-22.164 {TextSearchCmd, backward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "ababababab" + .t search -exact -overlap -backwards -all {abab} end +} -cleanup { + destroy .t +} -result {1.6 1.4 1.2 1.0} +test text-22.165 {TextSearchCmd, backward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "ababababab" + .t search -exact -backwards -all {abab} end +} -cleanup { + destroy .t +} -result {1.6 1.2} +test text-22.166 {TextSearchCmd, backward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "abababababab" + .t search -exact -backwards -all {abab} end +} -cleanup { + destroy .t +} -result {1.8 1.4 1.0} +test text-22.167 {TextSearchCmd, forward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t search -exact -overlap -all "foo\nbar\nfoo" 1.0 +} -cleanup { + destroy .t +} -result {1.0 3.0 5.0} +test text-22.168 {TextSearchCmd, forward exact search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t search -exact -all "foo\nbar\nfoo" 1.0 +} -cleanup { + destroy .t +} -result {1.0 5.0} +test text-22.169 {TextSearchCmd, backward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t search -exact -overlap -backward -all "foo\nbar\nfoo" end +} -cleanup { + destroy .t +} -result {5.0 3.0 1.0} +test text-22.170 {TextSearchCmd, backward exact search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t search -exact -backward -all "foo\nbar\nfoo" end +} -cleanup { + destroy .t +} -result {5.0 1.0} +test text-22.171 {TextSearchCmd, backward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t search -regexp -backward -overlap -all "foo\nbar\nfoo" end +} -cleanup { + destroy .t +} -result {5.0 3.0 1.0} +test text-22.172 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t search -regexp -backward -all "foo\nbar\nfoo" end +} -cleanup { + destroy .t +} -result {5.0 1.0} +test text-22.173 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -- {(\$)?[\w:_]+} 1.9 +} -cleanup { + destroy .t +} -result {1.7} +test text-22.174 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.5 +} -cleanup { + destroy .t +} -result {1.7} +test text-22.175 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.7 +} -cleanup { + destroy .t +} -result {1.7} +test text-22.176 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.8 +} -cleanup { + destroy .t +} -result {1.8} +test text-22.177 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -all -- {(\$)?[\w:_]+} 1.9 1.3 +} -cleanup { + destroy .t +} -result {1.7 1.3} +test text-22.178 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -all -- {(\$)?[\w:_]+} 1.9 1.13 +} -cleanup { + destroy .t +} -result {} +test text-22.179 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -all -- {(\$)?[\w:_]+} 2.0 1.3 +} -cleanup { + destroy .t +} -result {1.12 1.7 1.3} +test text-22.180 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -all -- {(\$)?[\w:_]+} 1.3 +} -cleanup { + destroy .t +} -result {1.1 1.12 1.7 1.3} +test text-22.181 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\n" + .t search -regexp -backward -all -- {(\w+\n)+} end +} -cleanup { + destroy .t +} -result {1.0} +test text-22.182 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\n" + .t search -regexp -backward -all -- {(\w+\n)+} end 1.5 +} -cleanup { + destroy .t +} -result {2.0} +test text-22.183 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + .t search -regexp -backward -all -- {(\w+\n\w)+} end 1.5 +} -cleanup { + destroy .t +} -result {2.0} +test text-22.184 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -all -count foo -- {(\w+\n)+} 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 20} +test text-22.185 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + set res {} + lappend res \ + [list [.t search -regexp -all -count foo -- {(\w+\n)+} 1.0] $foo] \ + [list [.t search -regexp -all -count foo -- {(\w+)+} 1.0] $foo] +} -cleanup { + destroy .t +} -result {{1.0 20} {{1.0 2.0 3.0 4.0} {5 5 5 1}}} +test text-22.186 {TextSearchCmd, regexp search greedy} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -all -nolinestop -count foo -- {.*} 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 20} +test text-22.187 {TextSearchCmd, regexp search greedy} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -all -count foo -- {.*} 1.0] $foo +} -cleanup { + destroy .t +} -result {{1.0 2.0 3.0 4.0} {5 5 5 1}} +test text-22.188 {TextSearchCmd, regexp search greedy multi-line} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -count foo -- {(\w+\n\w)+} 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 19} +test text-22.189 {TextSearchCmd, regexp search greedy multi-line} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -backwards -count foo -- {(\w+\n\w)+} end] $foo +} -cleanup { + destroy .t +} -result {1.0 19} +test text-22.190 {TextSearchCmd, regexp search greedy multi-line} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -all -backwards -count foo -- {(\w+\n\w)+} end] $foo +} -cleanup { + destroy .t +} -result {1.0 19} +test text-22.191 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + .t search -regexp -backward -all -- {(\w+\n\w)+} end 1.5 +} -cleanup { + destroy .t +} -result {2.0} +test text-22.192 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + .t search -regexp -backward -all -- {(\w+\n\w)+} end 1.3 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.193 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -forward -count foo -- {(\w+\n\w)+} 1.3] $foo +} -cleanup { + destroy .t +} -result {1.3 16} +test text-22.194 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -forward -all -count foo -- {(\w+\n\w)+} 1.3] $foo +# This result is somewhat debatable -- the two results do overlap, +# but only because the search has totally wrapped around back to +# the start. +} -cleanup { + destroy .t +} -result {{1.3 1.0} {16 19}} +test text-22.195 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -forward -all -count foo -- {(\w+\n\w)+} 1.0 1.3] $foo +} -cleanup { + destroy .t +} -result {1.0 19} +test text-22.196 {TextSearchCmd, regexp search multi-line} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\naaaa\nbbbb\n" + list [.t search -regexp -forward -all -count foo -- {(a+\n(b+\n))+} 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 20} +test text-22.197 {TextSearchCmd, regexp search complex cases} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\naaaa\nbbbb\n" + list [.t search -regexp -forward -all -count foo \ + -- {(a+\n(b+\n))+} 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 20} +test text-22.198 {TextSearchCmd, regexp search multi-line} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" + set foo {} + list [.t search -regexp -forward -all -count foo \ + -- {(b+\nc+\nb+)\na+} 1.0] $foo +} -cleanup { + destroy .t +} -result {2.0 19} +test text-22.199 {TextSearchCmd, regexp search multi-line} -constraints { + knownBug +} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" + set foo {} + list [.t search -regexp -forward -all -count foo \ + -- {(a+|b+\nc+\nb+)\na+} 1.0] $foo +} -cleanup { + destroy .t +} -result {2.0 19} +test text-22.200 {TextSearchCmd, regexp search multi-line} -constraints { + knownBug +} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" + set foo {} + list [.t search -regexp -forward -all -count foo \ + -- {(a+|b+\nc+\nb+)+\na+} 1.0] $foo +} -cleanup { + destroy .t +} -result {2.0 19} +test text-22.201 {TextSearchCmd, regexp search multi-line} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" + set foo {} + list [.t search -regexp -forward -all -count foo \ + -- {((a+|b+\nc+\nb+)+\n)+a+} 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 24} +test text-22.202 {TextSearchCmd, regexp search multi-line} -constraints { + knownBug +} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\nbbbb\nbbbb\nbbbb\n" + list [.t search -regexp -backward -all -count foo \ + -- {b+\n|a+\n(b+\n)+} end] $foo +} -cleanup { + destroy .t +} -result {1.0 25} +test text-22.203 {TextSearchCmd, regexp search multi-line} -constraints { + knownBug +} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\nbbbb\nbbbb\nbbbb\n" + .t search -regexp -backward -- {b+\n|a+\n(b+\n)+} end +# Should match at 1.0 for a true greedy match +} -cleanup { + destroy .t +} -result {1.0} +test text-22.204 {TextSearchCmd, regexp search multi-line} -body { + pack [text .t] + .t insert 1.0 "line0\nline1\nline1\nline1\nline1\nline2\nline2\nline2\nline3\n" + .t search -nolinestop -regexp -nocase -forwards -- {^(.*)\n(\1\n)+} 1.0 end +# Matches at 6.0 currently +} -cleanup { + destroy .t +} -result {2.0} +test text-22.205 {TextSearchCmd, regexp search multi-line} -setup { + pack [text .t] + set res {} +} -body { + .t insert 1.0 "\naaaxxx\nyyy\n" + lappend res [.t search -count c -regexp -- {x*\ny*} 2.0] $c + lappend res [.t search -count c -regexp -- {x*\ny*} 2.1] $c + return $res +} -cleanup { + destroy .t +} -result {2.3 7 2.3 7} +test text-22.206 {TextSearchCmd, regexp search multi-line} -setup { + pack [text .t] + set res {} +} -body { + .t insert 1.0 "\naaa\n\n\n\n\nxxx\n" + lappend res [.t search -count c -regexp -- {\n+} 2.0] $c + lappend res [.t search -count c -regexp -- {\n+} 2.1] $c + return $res +} -cleanup { + destroy .t +} -result {2.3 5 2.3 5} +test text-22.207 {TextSearchCmd, regexp search multi-line} -setup { + pack [text .t] + set res {} +} -body { + .t insert 1.0 "\naaa\n\n\t \n\t\t\t \n\nxxx\n" + lappend res [.t search -count c -regexp -- {(\n+(\t+ *)*)+} 2.0] $c + return $res +} -cleanup { + destroy .t +} -result {2.3 13} +test text-22.208 {TextSearchCmd, empty search range} -body { + pack [text .t] + .t insert 1.0 "a\na\na\n" + .t search -- a 2.0 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.209 {TextSearchCmd, empty search range} -body { + pack [text .t] + .t insert 1.0 "a\na\na\n" + .t search -backwards -- a 1.0 2.0 +} -cleanup { + destroy .t +} -result {} +test text-22.210 {TextSearchCmd, empty search range} -body { + pack [text .t] + .t insert 1.0 "a\na\na\n" + .t search -- a 1.0 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.211 {TextSearchCmd, empty search range} -body { + pack [text .t] + .t insert 1.0 "a\na\na\n" + .t search -backwards -- a 2.0 2.0 +} -cleanup { + destroy .t +} -result {} +test text-22.212 {TextSearchCmd, elide up to match} -setup { + pack [text .t] + set res {} +} -body { + .t insert 1.0 "a\nb\nc" + .t tag configure e -elide 1 + lappend res [.t search -regexp a 1.0] + lappend res [.t search -regexp b 1.0] + lappend res [.t search -regexp c 1.0] + .t tag add e 1.0 2.0 + lappend res [.t search -regexp a 1.0] + lappend res [.t search -regexp b 1.0] + lappend res [.t search -regexp c 1.0] + lappend res [.t search -elide -regexp a 1.0] + lappend res [.t search -elide -regexp b 1.0] + lappend res [.t search -elide -regexp c 1.0] +} -cleanup { + destroy .t +} -result {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-22.213 {TextSearchCmd, elide up to match, backwards} -setup { + pack [text .t] + set res {} +} -body { + .t insert 1.0 "a\nb\nc" + .t tag configure e -elide 1 + lappend res [.t search -backward -regexp a 1.0] + lappend res [.t search -backward -regexp b 1.0] + lappend res [.t search -backward -regexp c 1.0] + .t tag add e 1.0 2.0 + lappend res [.t search -backward -regexp a 1.0] + lappend res [.t search -backward -regexp b 1.0] + lappend res [.t search -backward -regexp c 1.0] + lappend res [.t search -backward -elide -regexp a 1.0] + lappend res [.t search -backward -elide -regexp b 1.0] + lappend res [.t search -backward -elide -regexp c 1.0] +} -cleanup { + destroy .t +} -result {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-22.214 {TextSearchCmd, elide up to match} -setup { + pack [text .t] + set res {} +} -body { + .t insert 1.0 "a\nb\nc" + .t tag configure e -elide 1 + lappend res [.t search a 1.0] + lappend res [.t search b 1.0] + lappend res [.t search c 1.0] + .t tag add e 1.0 2.0 + lappend res [.t search a 1.0] + lappend res [.t search b 1.0] + lappend res [.t search c 1.0] + lappend res [.t search -elide a 1.0] + lappend res [.t search -elide b 1.0] + lappend res [.t search -elide c 1.0] +} -cleanup { + destroy .t +} -result {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-22.215 {TextSearchCmd, elide up to match, backwards} -setup { + pack [text .t] + set res {} +} -body { + .t insert 1.0 "a\nb\nc" + .t tag configure e -elide 1 + lappend res [.t search -backward a 1.0] + lappend res [.t search -backward b 1.0] + lappend res [.t search -backward c 1.0] + .t tag add e 1.0 2.0 + lappend res [.t search -backward a 1.0] + lappend res [.t search -backward b 1.0] + lappend res [.t search -backward c 1.0] + lappend res [.t search -backward -elide a 1.0] + lappend res [.t search -backward -elide b 1.0] + lappend res [.t search -backward -elide c 1.0] +} -cleanup { + destroy .t +} -result {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-22.216 {TextSearchCmd, elide up to match} -setup { + pack [text .t] + set res {} +} -body { + .t insert 1.0 "aa\nbb\ncc" + .t tag configure e -elide 1 + lappend res [.t search ab 1.0] + lappend res [.t search bc 1.0] + .t tag add e 1.1 2.1 + lappend res [.t search ab 1.0] + lappend res [.t search b 1.0] + .t tag remove e 1.0 end + .t tag add e 2.1 3.1 + lappend res [.t search bc 1.0] + lappend res [.t search c 1.0] + .t tag remove e 1.0 end + .t tag add e 2.1 3.0 + lappend res [.t search bc 1.0] + lappend res [.t search c 1.0] +} -cleanup { + destroy .t +} -result {{} {} 1.0 2.1 2.0 3.1 2.0 3.0} +test text-22.217 {TextSearchCmd, elide up to match} -setup { + pack [text .t] + set res {} +} -body { + .t insert 1.0 "aa\nbb\ncc" + .t tag configure e -elide 1 + lappend res [.t search -regexp ab 1.0] + lappend res [.t search -regexp bc 1.0] + .t tag add e 1.1 2.1 + lappend res [.t search -regexp ab 1.0] + lappend res [.t search -regexp b 1.0] + .t tag remove e 1.0 end + .t tag add e 2.1 3.1 + lappend res [.t search -regexp bc 1.0] + lappend res [.t search -regexp c 1.0] + .t tag remove e 1.0 end + .t tag add e 2.1 3.0 + lappend res [.t search -regexp bc 1.0] + lappend res [.t search -regexp c 1.0] +} -cleanup { + destroy .t +} -result {{} {} 1.0 2.1 2.0 3.1 2.0 3.0} +test text-22.217.1 {elide up to match, with UTF-8 chars before the match} -setup { + pack [text .t] + set res {} +} -body { + .t tag configure e -elide 0 + .t insert end A {} xyz e bb\n + .t insert end \u00c4 {} xyz e bb + set res {} + lappend res [.t search bb 1.0 "1.0 lineend"] + lappend res [.t search bb 2.0 "2.0 lineend"] + lappend res [.t search -regexp bb 1.0 "1.0 lineend"] + lappend res [.t search -regexp bb 2.0 "2.0 lineend"] + .t tag configure e -elide 1 + lappend res [.t search bb 1.0 "1.0 lineend"] + lappend res [.t search bb 2.0 "2.0 lineend"] + lappend res [.t search -regexp bb 1.0 "1.0 lineend"] + lappend res [.t search -regexp -elide bb 2.0 "2.0 lineend"] + lappend res [.t search -regexp bb 2.0 "2.0 lineend"] +} -cleanup { + destroy .t +} -result {1.4 2.4 1.4 2.4 1.4 2.4 1.4 2.4 2.4} +test text-22.218 {TextSearchCmd, strict limits} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -strictlimits -- "world" 1.3 1.8 +} -cleanup { + destroy .t +} -result {} +test text-22.219 {TextSearchCmd, strict limits} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -strictlimits -- "world" 1.3 1.10 +} -cleanup { + destroy .t +} -result {} +test text-22.220 {TextSearchCmd, strict limits} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -strictlimits -- "world" 1.3 1.11 +} -cleanup { + destroy .t +} -result {1.6} +test text-22.221 {TextSearchCmd, strict limits backwards} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -strictlimits -backward -- "world" 2.3 1.8 +} -cleanup { + destroy .t +} -result {} +test text-22.222 {TextSearchCmd, strict limits backwards} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -strictlimits -backward -- "world" 2.3 1.6 +} -cleanup { + destroy .t +} -result {1.6} +test text-22.223 {TextSearchCmd, strict limits backwards} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -strictlimits -backward -- "world" 2.3 1.7 +} -cleanup { + destroy .t +} -result {} +test text-22.224 {TextSearchCmd, strict limits} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -regexp -strictlimits -- "world" 1.3 1.8 +} -cleanup { + destroy .t +} -result {} +test text-22.225 {TextSearchCmd, strict limits} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -regexp -strictlimits -backward -- "world" 2.3 1.8 +} -cleanup { + destroy .t +} -result {} + + +test text-23.1 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs "\{{}" +} -cleanup { + destroy .t +} -returnCodes {error} -result {unmatched open brace in list} +test text-23.2 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs xyz +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad screen distance "xyz"} +test text-23.3 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs {100 200} + update idletasks + list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.4] 0] +} -cleanup { + destroy .t +} -result {100 200} +test text-23.4 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs {100 right 200 left 300 center 400 numeric} + update idletasks + list [expr [lindex [.t bbox 1.2] 0] + [lindex [.t bbox 1.2] 2]] \ + [lindex [.t bbox 1.4] 0] \ + [expr [lindex [.t bbox 1.6] 0] + [lindex [.t bbox 1.6] 2]/2] \ + [lindex [.t bbox 1.10] 0] +} -cleanup { + destroy .t +} -result {100 200 300 400} +test text-23.5 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs {105 r 205 l 305 c 405 n} + update idletasks + list [expr [lindex [.t bbox 1.2] 0] + [lindex [.t bbox 1.2] 2]] \ + [lindex [.t bbox 1.4] 0] \ + [expr [lindex [.t bbox 1.6] 0] + [lindex [.t bbox 1.6] 2]/2] \ + [lindex [.t bbox 1.10] 0] +} -cleanup { + destroy .t +} -result {105 205 305 405} +test text-23.6 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs {100 left 200 lork} +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad tab alignment "lork": must be left, right, center, or numeric} +test text-23.7 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs {100 !44 200 lork} +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad screen distance "!44"} + + +test text-24.1 {TextDumpCmd procedure, bad args} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t mark set insert 1.0 + .t dump +} -cleanup { + destroy .t +} -returnCodes {error} -result {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?} +test text-24.2 {TextDumpCmd procedure, bad args} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t mark set insert 1.0 + .t dump -all +} -cleanup { + destroy .t +} -returnCodes {error} -result {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?} +test text-24.3 {TextDumpCmd procedure, bad args} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t mark set insert 1.0 + .t dump -command +} -cleanup { + destroy .t +} -returnCodes {error} -result {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?} +test text-24.4 {TextDumpCmd procedure, bad args} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t mark set insert 1.0 + .t dump -bogus +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad option "-bogus": must be -all, -command, -image, -mark, -tag, -text, or -window} +test text-24.5 {TextDumpCmd procedure, bad args} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t mark set insert 1.0 + .t dump bogus +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "bogus"} +test text-24.6 {TextDumpCmd procedure, one index} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t dump -text 1.2 +} -cleanup { + destroy .t +} -result {text e 1.2} +test text-24.7 {TextDumpCmd procedure, two indices} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t dump -text 1.0 1.end +} -cleanup { + destroy .t +} -result {text {One Line} 1.0} +test text-24.8 {TextDumpCmd procedure, "end" index} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t dump -text 1.end end +} -cleanup { + destroy .t +} -result {text { +} 1.8} +test text-24.9 {TextDumpCmd procedure, same indices} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t dump 1.5 1.5 +} -cleanup { + destroy .t +} -result {} +test text-24.10 {TextDumpCmd procedure, negative range} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t mark set insert 1.0 + .t dump 1.5 1.0 +} -cleanup { + destroy .t +} -result {} +test text-24.11 {TextDumpCmd procedure, stop at begin-line} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t dump -text 1.0 2.0 +} -cleanup { + destroy .t +} -result {text {Line One +} 1.0} +test text-24.12 {TextDumpCmd procedure, span multiple lines} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t dump -text 1.5 3.end +} -cleanup { + destroy .t +} -result {text {One +} 1.5 text {Line Two +} 2.0 text {Line Three} 3.0} +test text-24.13 {TextDumpCmd procedure, tags only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t tag add x 2.0 2.end + .t tag add y 1.0 end + .t dump -tag 2.1 2.8 +} -cleanup { + destroy .t +} -result {} +test text-24.14 {TextDumpCmd procedure, tags only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t tag add x 2.0 2.end + .t tag add y 1.0 end + .t dump -tag 2.0 2.8 +} -cleanup { + destroy .t +} -result {tagon x 2.0} +test text-24.15 {TextDumpCmd procedure, tags only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t tag add x 2.0 2.end + .t tag add y 1.0 end + .t dump -tag 1.0 4.end +} -cleanup { + destroy .t +} -result {tagon y 1.0 tagon x 2.0 tagoff x 2.8} +test text-24.16 {TextDumpCmd procedure, tags only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t tag add x 2.0 2.end + .t tag add y 1.0 end + .t dump -tag 1.0 end +} -cleanup { + destroy .t +} -result {tagon y 1.0 tagon x 2.0 tagoff x 2.8 tagoff y 5.0} +test text-24.17 {TextDumpCmd procedure, marks only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t mark set insert 1.0 + .t mark set current 1.0 + .t mark set m 2.4 + .t mark set n 4.0 + .t mark set END end + .t dump -mark 1.1 1.8 +} -cleanup { + destroy .t +} -result {} +test text-24.18 {TextDumpCmd procedure, marks only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t mark set insert 1.0 + .t mark set current 1.0 + .t mark set m 2.4 + .t mark set n 4.0 + .t mark set END end + .t dump -mark 2.0 2.8 +} -cleanup { + destroy .t +} -result {mark m 2.4} +test text-24.19 {TextDumpCmd procedure, marks only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t mark set insert 1.0 + .t mark set current 1.0 + .t mark set m 2.4 + .t mark set n 4.0 + .t mark set END end + .t dump -mark 1.1 4.end +} -cleanup { + destroy .t +} -result {mark m 2.4 mark n 4.0} +test text-24.20 {TextDumpCmd procedure, marks only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t mark set insert 1.0 + .t mark set current 1.0 + .t mark set m 2.4 + .t mark set n 4.0 + .t mark set END end + .t dump -mark 1.0 end +} -cleanup { + destroy .t +} -result {mark current 1.0 mark insert 1.0 mark m 2.4 mark n 4.0 mark END 5.0} +test text-24.21 {TextDumpCmd procedure, windows only} -setup { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + for {set i 0} {$i < 100} {incr i} {.t insert end "-\n"} + button .hello -text Hello +} -body { + .t window create 3.end -window .hello + .t window create 100.0 -create { } + .t dump -window 1.0 5.0 +} -cleanup { + destroy .t +} -result {window .hello 3.10} +test text-24.22 {TextDumpCmd procedure, windows only} -setup { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + for {set i 0} {$i < 100} {incr i} {.t insert end "-\n"} + button .hello -text Hello +} -body { + .t window create 3.end -window .hello + .t window create 100.0 -create { } + .t dump -window 5.0 end +} -cleanup { + destroy .t +} -result {window {} 100.0} +test text-24.23 {TextDumpCmd procedure, command script} -setup { + set x {} + pack [text .t] + proc Append {varName key value index} { + upvar #0 $varName x + lappend x $key $index $value + } +} -body { + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t mark set insert 1.0 + .t mark set current 1.0 + .t tag add x 2.0 2.end + .t mark set m 2.4 + .t dump -command {Append x} -all 1.0 end + return $x +} -cleanup { + destroy .t + rename Append {} +} -result {mark 1.0 current mark 1.0 insert text 1.0 {Line One +} tagon 2.0 x text 2.0 Line mark 2.4 m text 2.4 { Two} tagoff 2.8 x text 2.8 { +} text 3.0 {Line Three +} text 4.0 {Line Four +}} +test text-24.24 {TextDumpCmd procedure, command script} -setup { + set x {} + pack [text .t] + proc Append {varName key value index} { + upvar #0 $varName x + lappend x $key $index $value + } +} -body { + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t mark set insert 1.0 + .t mark set current 1.0 + .t mark set m 2.4 + .t dump -mark -command {Append x} 1.0 end + return $x +} -cleanup { + destroy .t + rename Append {} +} -result {mark 1.0 current mark 1.0 insert mark 2.4 m} +test text-24.25 {TextDumpCmd procedure, unicode characters} -body { + text .t + .t insert 1.0 \xb1\xb1\xb1 + .t dump -all 1.0 2.0 +} -cleanup { + destroy .t +} -result "text \xb1\xb1\xb1 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3" +test text-24.26 {TextDumpCmd procedure, unicode characters} -body { + text .t + .t delete 1.0 end + .t insert 1.0 abc\xb1\xb1\xb1 + .t dump -all 1.0 2.0 +} -cleanup { + destroy .t +} -result "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6" +test text-24.27 {TextDumpCmd procedure, peer present} -body { + text .t + .t peer create .t.t + .t dump -all 1.0 end +} -cleanup { + destroy .t +} -result "mark insert 1.0 mark current 1.0 text {\n} 1.0" + +test text-25.1 {text widget vs hidden commands} -body { + text .t + set y [list {} [interp hidden]] + interp hide {} .t + destroy .t + set x [list [winfo children .] [interp hidden]] + expr {$x eq $y} +} -result {1} + + +test text-26.1 {bug fix - 1642} -body { + pack [text .t] + .t insert end "line 1\n" + .t insert end "line 2\n" + .t insert end "line 3\n" + .t insert end "line 4\n" + .t insert end "line 5\n" + tk::TextSetCursor .t 3.0 + .t search -backward -regexp "\$" insert 1.0 +} -cleanup { + destroy .t +} -result {2.6} + + +test text-27.1 {TextEditCmd procedure, argument parsing} -body { + pack [text .t] + .t edit +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t edit option ?arg ...?"} +test text-27.2 {TextEditCmd procedure, argument parsing} -body { + pack [text .t] + .t edit gorp +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad edit option "gorp": must be canundo, canredo, modified, redo, reset, separator, or undo} +test text-27.3 {TextEditUndo procedure, undoing changes} -body { + text .t -undo 1 + pack .t + .t insert end "line 1\n" + .t delete 1.4 1.6 + .t insert end "should be gone after undo\n" + .t edit undo + .t get 1.0 end +} -cleanup { + destroy .t +} -result "line\n\n" +test text-27.4 {TextEditRedo procedure, redoing changes} -body { + text .t -undo 1 + pack .t + .t insert end "line 1\n" + .t delete 1.4 1.6 + .t insert end "should be back after redo\n" + .t edit undo + .t edit redo + .t get 1.0 end +} -cleanup { + destroy .t +} -result "line\nshould be back after redo\n\n" +test text-27.5 {TextEditUndo procedure, resetting stack} -body { + text .t -undo 1 + pack .t + .t insert end "line 1\n" + .t delete 1.4 1.6 + .t insert end "should be back after redo\n" + .t edit reset + catch {.t edit undo} msg + return $msg +} -cleanup { + destroy .t +} -result "nothing to undo" +test text-27.6 {TextEditCmd procedure, insert separator} -body { + text .t -undo 1 + pack .t + .t insert end "line 1\n" + .t edit separator + .t insert end "line 2\n" + .t edit undo + .t get 1.0 end +} -cleanup { + destroy .t +} -result "line 1\n\n" +test text-27.7 {-autoseparators configuration option} -body { + text .t -undo 1 -autoseparators 0 + pack .t + .t insert end "line 1\n" + .t delete 1.4 1.6 + .t insert end "line 2\n" + .t edit undo + .t get 1.0 end +} -cleanup { + destroy .t +} -result "\n" +test text-27.8 {TextEditCmd procedure, modified flag} -body { + text .t + pack .t + .t insert end "line 1\n" + .t edit modified +} -cleanup { + destroy .t +} -result {1} +test text-27.9 {TextEditCmd procedure, reset modified flag} -body { + text .t + pack .t + .t insert end "line 1\n" + .t edit modified 0 + .t edit modified +} -cleanup { + destroy .t +} -result {0} +test text-27.10 {TextEditCmd procedure, set modified flag} -body { + text .t + pack .t + .t edit modified 1 + .t edit modified +} -cleanup { + destroy .t +} -result {1} +test text-27.11 {TextEditCmd procedure, set modified flag repeat} -setup { + text .t + pack .t + set ::retval {} +} -body { + bind .t <<Modified>> "lappend ::retval modified" +# Shouldn't require [update idle] to trigger event [Bug 1809538] + lappend ::retval [.t edit modified] + .t edit modified 1 + update + lappend ::retval [.t edit modified] + .t edit modified 1 ; # binding should only fire once [Bug 1799782] + update idletasks + lappend ::retval [.t edit modified] +} -cleanup { + destroy .t +} -result {0 modified 1 1} +test text-27.12 {<<Modified>> virtual event} -body { + set ::retval unmodified + text .t -undo 1 + pack .t + bind .t <<Modified>> "set ::retval modified" + update idletasks + .t insert end "nothing special\n" + update + return $::retval +} -cleanup { + destroy .t +} -result {modified} +test text-27.13 {<<Modified>> virtual event - insert before Modified} -body { + set ::retval {} + pack [text .t -undo 1] + bind .t <<Modified>> { set ::retval [.t get 1.0 end-1c] } + update idletasks + .t insert end "nothing special" + update + return $::retval +} -cleanup { + destroy .t +} -result {nothing special} +test text-27.14 {<<Modified>> virtual event - delete before Modified} -body { +# Bug 1737288, make sure we delete chars before triggering <<Modified>> + set ::retval {} + pack [text .t -undo 1] + bind .t <<Modified>> { set ::retval [.t get 1.0 end-1c] } + .t insert end "nothing special" + .t edit modified 0 + .t delete 1.0 1.2 + update + set ::retval +} -cleanup { + destroy .t +} -result {thing special} +test text-27.14a {<<Modified>> virtual event - propagation to peers} -body { +# Bug [fd3a4dc111], <<Modified>> event is not always sent to peers + set ::retval 0 + text .t -undo 1 + .t peer create .tt + pack .t .tt + bind .t <<Modified>> {incr ::retval} + bind .tt <<Modified>> {incr ::retval} + .t insert end "This increments ::retval once for each peer, i.e. twice." + .t edit modified 0 ; # shall increment twice as well, not just once + update + set ::retval +} -cleanup { + destroy .t .tt +} -result {4} +test text-27.15 {<<Selection>> virtual event} -body { + set ::retval no_selection + pack [text .t -undo 1] + bind .t <<Selection>> "set ::retval selection_changed" + update idletasks + .t insert end "nothing special\n" + .t tag add sel 1.0 1.1 + update + set ::retval +} -cleanup { + destroy .t +} -result {selection_changed} +test text-27.16 {-maxundo configuration option} -body { + text .t -undo 1 -autoseparators 1 -maxundo 2 + pack .t + .t insert end "line 1\n" + .t delete 1.4 1.6 + .t insert end "line 2\n" + catch {.t edit undo} + catch {.t edit undo} + catch {.t edit undo} + .t get 1.0 end +} -cleanup { + destroy .t +} -result "line 1\n\n" +test text-27.16a {undo configuration options with peers} -body { + text .t -undo 1 -autoseparators 0 -maxundo 100 + .t peer create .tt + set res [.t cget -undo] + lappend res [.tt cget -undo] + lappend res [.t cget -autoseparators] + lappend res [.tt cget -autoseparators] + lappend res [.t cget -maxundo] + lappend res [.tt cget -maxundo] + .t insert end "The undo stack is common between peers" + lappend res [.t edit canundo] + lappend res [.tt edit canundo] +} -cleanup { + destroy .t .tt +} -result {1 1 0 0 100 100 1 1} +test text-27.16b {undo configuration options with peers, defaults} -body { + text .t + .t peer create .tt + set res [.t cget -undo] + lappend res [.tt cget -undo] + lappend res [.t cget -autoseparators] + lappend res [.tt cget -autoseparators] + lappend res [.t cget -maxundo] + lappend res [.tt cget -maxundo] + .t insert end "The undo stack is common between peers" + lappend res [.t edit canundo] + lappend res [.tt edit canundo] +} -cleanup { + destroy .t .tt +} -result {0 0 1 1 0 0 0 0} +test text-27.17 {bug fix 1536735 - undo with empty text} -body { + text .t -undo 1 + set r [.t edit modified] + .t delete 1.0 + lappend r [.t edit modified] + lappend r [catch {.t edit undo}] + lappend r [.t edit modified] +} -cleanup { + destroy .t +} -result {0 0 1 0} +test text-27.18 {patch 1469210 - inserting after undo} -setup { + destroy .t +} -body { + text .t -undo 1 + .t insert end foo + .t edit modified 0 + .t edit undo + .t insert end bar + .t edit modified +} -cleanup { + destroy .t +} -result 1 +test text-27.19 {patch 1669632 (i) - undo after <Control-1>} -setup { + destroy .t +} -body { + text .t -undo 1 + .t insert end foo\nbar + .t edit reset + .t insert 2.2 WORLD + event generate .t <Control-1> -x 1 -y 1 + .t insert insert HELLO + .t edit undo + .t get 2.2 2.7 +} -cleanup { + destroy .t +} -result WORLD +test text-27.20 {patch 1669632 (iv) - undo after <<SelectNone>>} -setup { + destroy .top .top.t +} -body { + toplevel .top + pack [text .top.t -undo 1] + .top.t insert end "This is an example text" + .top.t edit reset + .top.t mark set insert 1.5 + .top.t insert 1.5 HELLO + .top.t tag add sel 1.10 1.12 + update + focus -force .top.t + event generate .top.t <<SelectNone>> + .top.t insert insert " WORLD " + .top.t edit undo + .top.t get 1.5 1.10 +} -cleanup { + destroy .top.t .top +} -result HELLO +test text-27.21 {patch 1669632 (vii) - <<Undo>> shall not remove separators} -setup { + destroy .t +} -body { + text .t -undo 1 + .t insert end "This is an example text" + .t edit reset + .t insert 1.5 "WORLD " + event generate .t <Control-1> -x 1 -y 1 + .t insert insert HELLO + event generate .t <<Undo>> + .t insert insert E + event generate .t <<Undo>> + .t get 1.0 "1.0 lineend" +} -cleanup { + destroy .t +} -result "This WORLD is an example text" +test text-27.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { + destroy .t +} -body { + toplevel .top + pack [text .top.t -undo 1] + .top.t insert end "This is an example text" + .top.t edit reset + .top.t mark set insert 1.5 + .top.t insert 1.5 "A" + update + focus -force .top.t + event generate .top.t <Delete> + event generate .top.t <<SelectNextChar>> + event generate .top.t <<Clear>> + event generate .top.t <Delete> + event generate .top.t <<Undo>> + .top.t get 1.0 "1.0 lineend" +} -cleanup { + destroy .top.t .top +} -result "This A an example text" + test text-27.23 {patch 1669632 (v) - <<Cut>> is atomic} -setup { + destroy .t +} -body { + toplevel .top + pack [text .top.t -undo 1] + .top.t insert end "This is an example text" + .top.t edit reset + .top.t mark set insert 1.5 + .top.t insert 1.5 "A" + update + focus -force .top.t + event generate .top.t <Delete> + event generate .top.t <<SelectNextChar>> + event generate .top.t <<Cut>> + event generate .top.t <Delete> + event generate .top.t <<Undo>> + .top.t get 1.0 "1.0 lineend" +} -cleanup { + destroy .top.t .top +} -result "This A an example text" +test text-27.24 {TextEditCmd procedure, canundo and canredo} -setup { + destroy .t + set res {} +} -body { + text .t -undo false -autoseparators false + lappend res [.t edit canundo] [.t edit canredo] + .t configure -undo true + lappend res [.t edit canundo] [.t edit canredo] + .t insert end "DO\n" + .t edit separator + .t insert end "IT\n" + .t insert end "YOURSELF\n" + .t edit separator + lappend res [.t edit canundo] [.t edit canredo] + .t edit undo + lappend res [.t edit canundo] [.t edit canredo] + .t configure -undo false + lappend res [.t edit canundo] [.t edit canredo] + .t configure -undo true + lappend res [.t edit canundo] [.t edit canredo] + .t edit redo + lappend res [.t edit canundo] [.t edit canredo] +} -cleanup { + destroy .t +} -result {0 0 0 0 1 0 1 1 0 0 1 1 1 0} +test text-27.25 {<<UndoStack>> virtual event} -setup { + destroy .t + set res {} + set nbUS 0 +} -body { + text .t -undo false -autoseparators false + bind .t <<UndoStack>> {incr nbUS} + update ; lappend res $nbUS + .t configure -undo true + update ; lappend res $nbUS + .t insert end "DO\n" + .t edit separator + .t insert end "IT\n" + .t insert end "YOURSELF\n" + .t edit separator + .t insert end "MAN\n" + .t edit separator + update ; lappend res $nbUS + .t edit undo + update ; lappend res $nbUS + .t edit redo + update ; lappend res $nbUS + .t edit undo + update ; lappend res $nbUS + .t edit undo + update ; lappend res $nbUS + .t edit undo + update ; lappend res $nbUS + .t edit redo + update ; lappend res $nbUS + .t edit redo + update ; lappend res $nbUS + .t edit redo + update ; lappend res $nbUS + .t edit undo + update ; lappend res $nbUS + .t edit undo + update ; lappend res $nbUS + .t edit reset + update ; lappend res $nbUS +} -cleanup { + destroy .t +} -result {0 0 1 2 3 4 4 5 6 6 7 8 8 9} + + +test text-28.1 {bug fix - 624372, ControlUtfProc long lines} -body { + pack [text .t -wrap none] + .t insert end [string repeat "\1" 500] +} -cleanup { + destroy .t +} -result {} + + +test text-29.1 {tabs - must be positive and must be increasing} -body { + pack [text .t -wrap none] + .t configure -tabs {0} +} -cleanup { + destroy .t +} -returnCodes {error} -result {tab stop "0" is not at a positive distance} +test text-29.2 {tabs - must be positive and must be increasing} -body { + pack [text .t -wrap none] + .t configure -tabs {-5} +} -cleanup { + destroy .t +} -returnCodes {error} -result {tab stop "-5" is not at a positive distance} +test text-29.3 {tabs - must be positive and must be increasing} -constraints { + knownBug +} -body { +# This bug will be fixed in Tk 9.0, when we can allow a minor +# incompatibility with Tk 8.x + pack [text .t -wrap none] + .t configure -tabs {10c 5c} +} -cleanup { + destroy .t +} -returnCodes {error} -result {tabs must be monotonically increasing, but "5c" is smaller than or equal to the previous tab} +test text-29.4 {tabs - must be positive and must be increasing} -body { + pack [text .t -wrap none] + .t insert end "a\tb\tc\td\te" + catch {.t configure -tabs {10c 5c}} + update ; update ; update +# This test must simply not go into an infinite loop to succeed + set result 1 +} -cleanup { + destroy .t +} -result {1} + + +test text-30.1 {repeated insert and scroll} -body { + pack [text .t] + for {set i 0} {$i < 30} {incr i} { + .t insert end "blabla\n" + eval .t yview moveto 1 + } +# This test must simply not crash to succeed + set result 1 +} -cleanup { + destroy .t +} -result {1} +test text-30.2 {repeated insert and scroll} -body { + pack [text .t] + for {set i 0} {$i < 30} {incr i} { + .t insert end "blabla\n" + eval .t yview scroll 1 pages + } +# This test must simply not crash to succeed + set result 1 +} -cleanup { + destroy .t +} -result {1} +test text-30.3 {repeated insert and scroll} -body { + pack [text .t] + for {set i 0} {$i < 30} {incr i} { + .t insert end "blabla\n" + eval .t yview scroll 100 pixels + } +# This test must simply not crash to succeed + set result 1 +} -cleanup { + destroy .t +} -result {1} +test text-30.4 {repeated insert and scroll} -body { + pack [text .t] + for {set i 0} {$i < 30} {incr i} { + .t insert end "blabla\n" + eval .t yview scroll 10 units + } +# This test must simply not crash to succeed + set result 1 +} -cleanup { + destroy .t +} -result {1} + + +test text-31.1 {peer widgets} -body { + toplevel .top + pack [text .t] + pack [.t peer create .top.t] + destroy .t .top +} -result {} +test text-31.2 {peer widgets} -body { + toplevel .top1 + toplevel .top2 + pack [text .t] + pack [.t peer create .top1.t] + pack [.t peer create .top2.t] + .t insert end "abcd\nabcd" + update + destroy .top1 + update + .t insert end "abcd\nabcd" + update + destroy .t .top2 + update +} -result {} +test text-31.3 {peer widgets} -body { + toplevel .top1 + toplevel .top2 + pack [text .t] + pack [.t peer create .top1.t] + pack [.t peer create .top2.t] + .t insert end "abcd\nabcd" + update + destroy .t + update + .top2.t insert end "abcd\nabcd" + update + destroy .t .top2 + update +} -result {} +test text-31.4 {peer widgets} -body { + toplevel .top + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .top.t -start 5 -end 11] + update + destroy .t .top +} -result {} +test text-31.5 {peer widgets} -body { + toplevel .top + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .top.t -start 5 -end 11] + pack [.top.t peer create .top.t2] + set res [list [.top.t index end] [.top.t2 index end]] + update + return $res +} -cleanup { + destroy .t .top +} -result {7.0 7.0} +test text-31.6 {peer widgets} -body { + toplevel .top + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .top.t -start 5 -end 11] + pack [.top.t peer create .top.t2 -start {} -end {}] + set res [list [.top.t index end] [.top.t2 index end]] + update + return $res +} -cleanup { + destroy .t .top +} -result {7.0 21.0} +test text-31.7 {peer widgets} -body { + toplevel .top + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .top.t -start 5 -end 11] + update ; update + set p1 [.top.t count -update -ypixels 1.0 end] + set p2 [.t count -update -ypixels 5.0 11.0] + expr {$p1 eq $p2} +} -cleanup { + destroy .t .top +} -result {1} +test text-31.8 {peer widgets} -body { + toplevel .top + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .top.t -start 5 -end 11] + update ; update + .t delete 3.0 6.0 + .top.t index end +} -cleanup { + destroy .t .top +} -result {6.0} +test text-31.9 {peer widgets} -body { + toplevel .top + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .top.t -start 5 -end 11] + update ; update + .t delete 8.0 12.0 + .top.t index end +} -cleanup { + destroy .t .top +} -result {4.0} +test text-31.10 {peer widgets} -body { + toplevel .top + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .top.t -start 5 -end 11] + update ; update + .t delete 3.0 13.0 + .top.t index end +} -cleanup { + destroy .t .top +} -result {1.0} +test text-31.11 {peer widgets} -setup { + pack [text .t] + set res {} +} -body { + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 end-1c + lappend res [.t tag ranges sel] + .t configure -start 10 -end 20 + lappend res [.t tag ranges sel] + return $res +} -cleanup { + destroy .t +} -result {{1.0 100.0} {1.0 11.0}} +test text-31.12 {peer widgets} -setup { + pack [text .t] + set res {} +} -body { + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 end-1c + lappend res [.t tag ranges sel] + .t configure -start 11 + lappend res [.t tag ranges sel] + return $res +} -cleanup { + destroy .t +} -result {{1.0 100.0} {1.0 90.0}} +test text-31.13 {peer widgets} -setup { + pack [text .t] + set res {} +} -body { + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 end-1c + lappend res [.t tag ranges sel] + .t configure -end 90 + lappend res [.t tag ranges sel] + destroy .t + return $res +} -cleanup { + destroy .t +} -result {{1.0 100.0} {1.0 90.0}} +test text-31.14 {peer widgets} -setup { + pack [text .t] + set res {} +} -body { + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 3.0 5.0 7.0 9.0 11.0 13.0 15.0 17.0 19.0 + lappend res [.t tag prevrange sel 1.0] + .t configure -start 6 -end 12 + lappend res [.t tag ranges sel] + lappend res "next" [.t tag nextrange sel 4.0] \ + [.t tag nextrange sel 5.0] [.t tag nextrange sel 6.0] \ + [.t tag nextrange sel 7.0] + lappend res "prev" [.t tag prevrange sel 1.0] \ + [.t tag prevrange sel 2.0] [.t tag prevrange sel 3.0] \ + [.t tag prevrange sel 4.0] + return $res +} -cleanup { + destroy .t +} -result {{} {1.0 2.0 4.0 6.0} next {4.0 6.0} {} {} {} prev {} {1.0 2.0} {1.0 2.0} {1.0 2.0}} +test text-31.15 {peer widgets} -setup { + pack [text .t] + set res {} +} -body { + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 3.0 9.0 11.0 13.0 15.0 17.0 19.0 + .t configure -start 6 -end 12 + lappend res [.t tag ranges sel] + lappend res "next" [.t tag nextrange sel 4.0] \ + [.t tag nextrange sel 5.0] [.t tag nextrange sel 6.0] \ + [.t tag nextrange sel 7.0] + lappend res "prev" [.t tag prevrange sel 1.0] \ + [.t tag prevrange sel 2.0] [.t tag prevrange sel 3.0] \ + [.t tag prevrange sel 4.0] + return $res +} -cleanup { + destroy .t +} -result {{4.0 6.0} next {4.0 6.0} {} {} {} prev {} {} {} {}} +test text-31.16 {peer widgets} -setup { + pack [text .t] + set res {} +} -body { + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 7.0 9.0 11.0 13.0 15.0 17.0 19.0 + .t configure -start 6 -end 12 + lappend res [.t tag ranges sel] + lappend res "next" [.t tag nextrange sel 4.0] \ + [.t tag nextrange sel 5.0] [.t tag nextrange sel 6.0] \ + [.t tag nextrange sel 7.0] + lappend res "prev" [.t tag prevrange sel 1.0] \ + [.t tag prevrange sel 2.0] [.t tag prevrange sel 3.0] \ + [.t tag prevrange sel 4.0] + return $res +} -cleanup { + destroy .t +} -result {{1.0 2.0 4.0 6.0} next {4.0 6.0} {} {} {} prev {} {1.0 2.0} {1.0 2.0} {1.0 2.0}} +test text-31.17 {peer widgets} -setup { + pack [text .t] + set res {} +} -body { + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 11.0 + lappend res [.t tag ranges sel] + lappend res [catch {.t configure -start 15 -end 10}] + lappend res [.t tag ranges sel] + .t configure -start 6 -end 12 + lappend res [.t tag ranges sel] + .t configure -start {} -end {} + lappend res [.t tag ranges sel] + return $res +} -cleanup { + destroy .t +} -result {{1.0 11.0} 1 {1.0 11.0} {1.0 6.0} {1.0 11.0}} +test text-31.18 {peer widgets} -setup { + pack [text .t] + set res {} +} -body { + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 11.0 + lappend res [.t index sel.first] + lappend res [.t index sel.last] + return $res +} -cleanup { + destroy .t +} -result {1.0 11.0} +test text-31.19 {peer widgets} -body { + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + .t tag delete sel + .t index sel.first +} -cleanup { + destroy .t +} -returnCodes {error} -result {text doesn't contain any characters tagged with "sel"} + + +test text-32.1 {line heights on creation} -setup { + text .t + proc makeText {} { + set w .g + set font "Times 11" + destroy .g + toplevel .g + frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken + set t $w.f.text + text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font \ + -width 70 -height 35 -wrap word -highlightthickness 0 \ + -borderwidth 0 + pack $t -expand yes -fill both + scrollbar $w.scroll -command "$t yview" + pack $w.scroll -side right -fill y + pack $w.f -expand yes -fill both + $t tag configure center -justify center -spacing1 5m -spacing3 5m + $t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \ + -spacing1 3m -spacing2 0 -spacing3 0 + for {set i 0} {$i < 40} {incr i} { + $t insert end "${i}word " + } + return $t + } +} -body { + set w [makeText] + update ; after 1000 ; update + set before [$w count -ypixels 1.0 2.0] + $w insert 1.0 "a" + update + set after [$w count -ypixels 1.0 2.0] + destroy .g + expr {$before eq $after} +} -cleanup { + destroy .t +} -result {1} + + +test text-33.1 {TextWidgetCmd procedure, "peer" option} -setup { + text .t +} -body { + .t peer foo 1 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad peer option "foo": must be create or names} +test text-33.2 {TextWidgetCmd procedure, "peer" option} -setup { + text .t +} -body { + .t peer names foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t peer names"} +test text-33.3 {TextWidgetCmd procedure, "peer" option} -setup { + text .t +} -body { + .t pee names +} -cleanup { + destroy .t +} -returnCodes {ok} -result {} +test text-33.4 {TextWidgetCmd procedure, "peer" option} -setup { + text .t +} -body { + .t peer names +} -cleanup { + destroy .t +} -result {} +test text-33.5 {TextWidgetCmd procedure, "peer" option} -setup { + text .t +} -body { + .t peer create foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad window path name "foo"} +test text-33.6 {TextWidgetCmd procedure, "peer" option} -setup { + text .t + set res {} +} -body { + .t peer create .t2 + lappend res [.t peer names] + lappend res [.t2 peer names] + destroy .t2 + lappend res [.t peer names] +} -cleanup { + destroy .t +} -result {.t2 .t {}} +test text-33.7 {peer widget -start, -end} -body { + text .t + set res [.t configure -start 10 -end 5] + return $res +} -cleanup { + destroy .t +} -returnCodes {2} -result {} +test text-33.8 {peer widget -start, -end} -body { + text .t + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t configure -start 10 -end 5 +} -cleanup { + destroy .t +} -returnCodes {error} -result {-startline must be less than or equal to -endline} +test text-33.9 {peer widget -start, -end} -body { + text .t + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t configure -start 5 -end 10 +} -cleanup { + destroy .t +} -returnCodes {ok} -result {} +test text-33.10 {peer widget -start, -end} -body { + text .t + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + set res [.t index end] + lappend res [catch {.t configure -start 5 -end 10 -tab foo}] + lappend res [.t index end] + lappend res [catch {.t configure -tab foo -start 15 -end 20}] + lappend res [.t index end] + .t configure -start {} -end {} + lappend res [.t index end] + return $res +} -cleanup { + destroy .t +} -result {101.0 1 101.0 1 101.0 101.0} +test text-33.11 {peer widget -start, -end} -body { + text .t + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + set res [.t index end] + lappend res [catch {.t configure -start 5 -end 15}] + lappend res [.t index end] + lappend res [catch {.t configure -start 10 -end 40}] + lappend res [.t index end] + .t configure -start {} -end {} + lappend res [.t index end] + return $res +} -cleanup { + destroy .t +} -result {101.0 0 11.0 0 31.0 101.0} + +test text-34.1 {peer widget -start, -end and selection} -setup { + text .t + set res {} +} -body { + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 10.0 20.0 + lappend res [.t tag ranges sel] + .t configure -start 5 -end 30 + lappend res [.t tag ranges sel] + .t configure -start 5 -end 15 + lappend res [.t tag ranges sel] + .t configure -start 15 -end 30 + lappend res [.t tag ranges sel] + .t configure -start 15 -end 16 + lappend res [.t tag ranges sel] + .t configure -start 25 -end 30 + lappend res [.t tag ranges sel] + .t configure -start {} -end {} + lappend res [.t tag ranges sel] + return $res +} -cleanup { + destroy .t +} -result {{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-32.2 {peer widget -start, -end and deletion (bug 1630262)} -setup { + destroy .t .pt + set res {} +} -body { + text .t + .t peer create .pt + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t configure -startline 5 + # none of the following delete shall crash + # (all did before fixing bug 1630262) + # 1. delete on the same line: line1 == line2 in DeleteIndexRange, + # and resetView is true neither for .t not for .pt + .pt delete 2.0 2.2 + # 2. delete just one line: line1 < line2 in DeleteIndexRange, + # and resetView is true only for .t, not for .pt + .pt delete 2.0 3.0 + # 3. delete several lines: line1 < line2 in DeleteIndexRange, + # and resetView is true only for .t, not for .pt + .pt delete 2.0 5.0 + # 4. delete to the end line: line1 < line2 in DeleteIndexRange, + # and resetView is true only for .t, not for .pt + .pt delete 2.0 end + # this test succeeds provided there is no crash + set res 1 +} -cleanup { + destroy .pt +} -result {1} + +test text-32.3 {peer widget -start, -end and deletion (bug 1630262)} -setup { + destroy .t .pt + set res {} +} -body { + text .t + .t peer create .pt + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t configure -startline 5 + .pt configure -startline 3 + # the following delete shall not crash + # (it did before fixing bug 1630262) + .pt delete 2.0 3.0 + # moreover -startline shall be correct + # (was wrong before fixing bug 1630262) + lappend res [.t cget -start] [.pt cget -start] +} -cleanup { + destroy .pt +} -result {4 3} + +test text-32.4 {peer widget -start, -end and deletion (bug 1630262)} -setup { + destroy .t .pt + set res {} +} -body { + text .t + .t peer create .pt + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t configure -startline 5 -endline 15 + .pt configure -startline 8 -endline 12 + # .pt now shows a range entirely inside the range of .pt + # from .t, delete lines located after [.pt cget -end] + .t delete 9.0 10.0 + # from .t, delete lines straddling [.pt cget -end] + .t delete 6.0 9.0 + lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] + .t configure -startline 5 -endline 12 + .pt configure -startline 8 -endline 12 + # .pt now shows again a range entirely inside the range of .pt + # from .t, delete lines located before [.pt cget -start] + .t delete 2.0 3.0 + # from .t, delete lines straddling [.pt cget -start] + .t delete 2.0 5.0 + lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] + .t configure -startline 22 -endline 31 + .pt configure -startline 42 -endline 51 + # .t now shows a range entirely before the range of .pt + # from .t, delete some lines, then do it from .pt + .t delete 2.0 3.0 + .t delete 2.0 5.0 + .pt delete 2.0 5.0 + lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] + .t configure -startline 55 -endline 75 + .pt configure -startline 60 -endline 70 + # .pt now shows a range entirely inside the range of .t + # from .t, delete a range straddling the entire range of .pt + .t delete 3.0 18.0 + lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] +} -cleanup { + destroy .pt .t +} -result {5 11 8 10 5 8 6 8 22 27 38 44 55 60 57 57} + +test text-35.1 {widget dump -command alters tags} -setup { + proc Dumpy {key value index} { +#puts "KK: $key, $value" + .t tag add $value [list $index linestart] [list $index lineend] + } + text .t +} -body { + .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c + .t tag configure b -background red + .t dump -all -command Dumpy 1.0 end + set result "ok" +} -cleanup { + destroy .t +} -result {ok} +test text-35.2 {widget dump -command makes massive changes} -setup { + proc Dumpy {key value index} { +#puts "KK: $key, $value" + .t delete 1.0 end + } + text .t +} -body { + .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c + .t tag configure b -background red + .t dump -all -command Dumpy 1.0 end + set result "ok" +} -cleanup { + destroy .t +} -result {ok} +test text-35.3 {widget dump -command destroys widget} -setup { + proc Dumpy {key value index} { +#puts "KK: $key, $value" + destroy .t + } + text .t +} -body { + .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c + .t tag configure b -background red + .t dump -all -command Dumpy 1.0 end + set result "ok" +} -cleanup { + destroy .t +} -result {ok} + + +test text-36.1 "bug #1777362: event handling with hyphenated windows" -setup { + set save [interp bgerror {}] + interp bgerror {} returnerror-36.1 + proc returnerror-36.1 {m opts} {set ::my_error $m} + set ::my_error {} + pack [set w [text .t-1]] +} -body { + tkwait visibility $w + event generate $w <1> + event generate $w <1> + update + set ::my_error +} -cleanup { + destroy .t-1 + rename returnerror-36.1 "" + interp bgerror {} $save + unset -nocomplain save ::my_error w +} -result {} +test text-36.2 "bug #1777362: event handling with hyphenated windows" -setup { + set save [interp bgerror {}] + interp bgerror {} returnerror-36.2 + proc returnerror-36.2 {m opts} {set ::my_error $m} + set ::my_error {} + pack [set w [text .t+1]] +} -body { + tkwait visibility $w + event generate $w <1> + event generate $w <1> + update + set ::my_error +} -cleanup { + destroy $w + rename returnerror-36.2 "" + interp bgerror {} $save + unset -nocomplain save ::my_error w +} -result {} +test text-36.3 "bug #1777362: event handling with hyphenated windows" -setup { + set save [interp bgerror {}] + interp bgerror {} returnerror-36.3 + proc returnerror-36.3 {m opts} {set ::my_error $m} + set ::my_error {} + pack [set w [text .t*1]] +} -body { + tkwait visibility $w + event generate $w <1> + event generate $w <1> + update + set ::my_error +} -cleanup { + destroy $w + rename returnerror-36.3 "" + interp bgerror {} $save + unset -nocomplain save ::my_error w +} -result {} + + +test text-37.1 "bug #dd9667635d: text anchor not set" -setup { + set save [interp bgerror {}] + interp bgerror {} returnerror-37.1 + proc returnerror-37.1 {m opts} {set ::my_error $m} + destroy .t + pack [text .t] +} -body { + .t insert end "Hello world!" + .t tag add sel 1.0 end + # this line shall not trigger error: + # bad text index "tk::anchorN" + event generate .t <<SelectPrevLine>> + update + set ::my_error +} -cleanup { + destroy .t + rename returnerror-37.1 "" + interp bgerror {} $save + unset -nocomplain save ::my_error +} -result {} + +# cleanup +cleanupTests +return + +# Local Variables: +# mode: tcl +# End: |