diff options
Diffstat (limited to 'tests/text.test')
| -rw-r--r-- | tests/text.test | 8724 |
1 files changed, 2672 insertions, 6052 deletions
diff --git a/tests/text.test b/tests/text.test index 6812855..2ca5d54 100644 --- a/tests/text.test +++ b/tests/text.test @@ -6,1470 +6,344 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.2 +package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test +# Create entries in the odeption database to be sure that geometry options +# like border width have predictable values. + +option add *Text.borderWidth 2 +option add *Text.highlightThickness 2 +option add *Text.font {Courier -12} + +text .t -width 20 -height 10 +pack append . .t {top expand fill} +update +.t debug on +wm geometry . {} + # 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} +entry .t.e +.t.e insert end abcdefg +.t.e select from 0 -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 +.t insert 1.0 "Line 1 abcdefghijklm 12345 Line 4 bOy GIrl .#@? x_yz !@#$% Line 7" + +catch {destroy .t2} +text .t2 +set i 0 +foreach test { + {-autoseparators yes 1 nah} + {-background #ff00ff #ff00ff <gorp>} + {-bd 4 4 foo} + {-bg blue blue #xx} + {-blockcursor 0 0 xx} + {-borderwidth 7 7 ++} + {-cursor watch watch lousy} + {-exportselection no 0 maybe} + {-fg red red stupid} + {-font fixed fixed {}} + {-foreground #012 #012 bogus} + {-height 5 5 bad} + {-highlightbackground #123 #123 bogus} + {-highlightcolor #234 #234 bogus} + {-highlightthickness -2 0 bad} + {-inactiveselectbackground #ffff01234567 #ffff01234567 bogus} + {-insertbackground green green <bogus>} + {-insertborderwidth 45 45 bogus} + {-insertofftime 100 100 2.4} + {-insertontime 47 47 e1} + {-insertwidth 2.3 2 47d} + {-maxundo 5 5 noway} + {-padx 3.4 3 2.4.} + {-pady 82 82 bogus} + {-relief raised raised bumpy} + {-selectbackground #ffff01234567 #ffff01234567 bogus} + {-selectborderwidth 21 21 3x} + {-selectforeground yellow yellow #12345} + {-spacing1 20 20 1.3x} + {-spacing1 -5 0 bogus} + {-spacing2 5 5 bogus} + {-spacing2 -1 0 bogus} + {-spacing3 20 20 bogus} + {-spacing3 -10 0 bogus} + {-state d disabled foo} + {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs} + {-tabstyle wordprocessor wordprocessor garbage} + {-undo 1 1 eh} + {-width 73 73 2.4} + {-wrap w word bad_wrap} +} { + test text-1.[incr i] {text options} { + set result {} + lappend result [catch {.t2 configure [lindex $test 0] [lindex $test 3]}] + .t2 configure [lindex $test 0] [lindex $test 1] + lappend result [.t2 cget [lindex $test 0]] + } [list 1 [lindex $test 2]] +} +test text-1.[incr i] {text options} { + .t2 configure -takefocus "any old thing" + .t2 cget -takefocus +} {any old thing} +test text-1.[incr i] {text options} { + .t2 configure -xscrollcommand "x scroll command" + .t2 configure -xscrollcommand +} {-xscrollcommand xScrollCommand ScrollCommand {} {x scroll command}} +test text-1.[incr i] {text options} { + .t2 configure -yscrollcommand "test command" + .t2 configure -yscrollcommand +} {-yscrollcommand yScrollCommand ScrollCommand {} {test command}} +test text-1.[incr i] {text options} { + set result {} + foreach i [.t2 configure] { + lappend result [lindex $i 4] + } + set result +} {1 blue {} {} 0 7 watch {} 0 {} fixed #012 5 #123 #234 0 #ffff01234567 green 45 100 47 2 5 3 82 raised #ffff01234567 21 yellow 0 0 0 0 {} disabled {1i 2i 3i 4i} wordprocessor {any old thing} 1 73 word {x scroll command} {test command}} + +test text-2.1 {Tk_TextCmd procedure} { + list [catch {text} msg] $msg +} {1 {wrong # args: should be "text pathName ?options?"}} +test text-2.2 {Tk_TextCmd procedure} { + list [catch {text foobar} msg] $msg +} {1 {bad window path name "foobar"}} +test text-2.3 {Tk_TextCmd procedure} { + catch {destroy .t2} + list [catch {text .t2 -gorp nofun} msg] $msg [winfo exists .t2] +} {1 {unknown option "-gorp"} 0} +test text-2.4 {Tk_TextCmd procedure} { + catch {destroy .t2} + list [catch {text .t2 -bd 2 -fg red} msg] $msg \ + [lindex [.t2 config -bd] 4] [lindex [.t2 config -fg] 4] +} {0 .t2 2 red} +if {$tcl_platform(platform) == "windows"} { + set relief flat +} elseif {[tk windowingsystem] eq "aqua"} { + set relief solid +} else { + set relief raised +} +test text-2.5 {Tk_TextCmd procedure} { + catch {destroy .t2} + text .t2 + .t2 tag cget sel -relief +} $relief +test text-2.6 {Tk_TextCmd procedure} { + catch {destroy .t2} + list [text .t2] [winfo class .t2] +} {.t2 Text} + +test text-3.1 {TextWidgetCmd procedure, basics} { + list [catch {.t} msg] $msg +} {1 {wrong # args: should be ".t option ?arg arg ...?"}} +test text-3.2 {TextWidgetCmd procedure} { + list [catch {.t gorp 1.0 z 1.2} msg] $msg +} {1 {bad option "gorp": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} + +test text-4.1 {TextWidgetCmd procedure, "bbox" option} { + list [catch {.t bbox} msg] $msg +} {1 {wrong # args: should be ".t bbox index"}} +test text-4.2 {TextWidgetCmd procedure, "bbox" option} { + list [catch {.t bbox a b} msg] $msg +} {1 {wrong # args: should be ".t bbox index"}} +test text-4.3 {TextWidgetCmd procedure, "bbox" option} { + list [catch {.t bbox bad_mark} msg] $msg +} {1 {bad text index "bad_mark"}} + +test text-5.1 {TextWidgetCmd procedure, "cget" option} { + list [catch {.t cget} msg] $msg +} {1 {wrong # args: should be ".t cget option"}} +test text-5.2 {TextWidgetCmd procedure, "cget" option} { + list [catch {.t cget a b} msg] $msg +} {1 {wrong # args: should be ".t cget option"}} +test text-5.3 {TextWidgetCmd procedure, "cget" option} { + list [catch {.t cget -gorp} msg] $msg +} {1 {unknown option "-gorp"}} +test text-5.4 {TextWidgetCmd procedure, "cget" option} { + .t configure -bd 17 + .t cget -bd +} {17} +.t configure -bd [lindex [.t configure -bd] 3] + +test text-6.1 {TextWidgetCmd procedure, "compare" option} { + list [catch {.t compare a b} msg] $msg +} {1 {wrong # args: should be ".t compare index1 op index2"}} +test text-6.2 {TextWidgetCmd procedure, "compare" option} { + list [catch {.t compare a b c d} msg] $msg +} {1 {wrong # args: should be ".t compare index1 op index2"}} +test text-6.3 {TextWidgetCmd procedure, "compare" option} { + list [catch {.t compare @x == 1.0} msg] $msg +} {1 {bad text index "@x"}} +test text-6.4 {TextWidgetCmd procedure, "compare" option} { + list [catch {.t compare 1.0 < @y} msg] $msg +} {1 {bad text index "@y"}} +test text-6.5 {TextWidgetCmd procedure, "compare" option} { 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" +} {0 0 1} +test text-6.6 {TextWidgetCmd procedure, "compare" option} { 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" +} {0 1 1} +test text-6.7 {TextWidgetCmd procedure, "compare" option} { 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" +} {0 1 0} +test text-6.8 {TextWidgetCmd procedure, "compare" option} { 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" +} {1 1 0} +test text-6.9 {TextWidgetCmd procedure, "compare" option} { 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" +} {1 0 0} +test text-6.10 {TextWidgetCmd procedure, "compare" option} { 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} +} {1 0 1} +test text-6.11 {TextWidgetCmd procedure, "compare" option} { + list [catch {.t compare 1.0 <x 1.2} msg] $msg +} {1 {bad comparison operator "<x": must be <, <=, ==, >=, >, or !=}} +test text-6.12 {TextWidgetCmd procedure, "compare" option} { + list [catch {.t compare 1.0 >> 1.2} msg] $msg +} {1 {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=}} +test text-6.13 {TextWidgetCmd procedure, "compare" option} { + list [catch {.t compare 1.0 z 1.2} msg] $msg +} {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}} +test text-6.14 {TextWidgetCmd procedure, "compare" option} { + list [catch {.t co 1.0 z 1.2} msg] $msg +} {1 {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, 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 { +test text-7.1 {TextWidgetCmd procedure, "debug" option} { + list [catch {.t debug 0 1} msg] $msg +} {1 {wrong # args: should be ".t debug boolean"}} +test text-7.2 {TextWidgetCmd procedure, "debug" option} { + list [catch {.t de 0 1} msg] $msg +} {1 {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} +test text-7.3 {TextWidgetCmd procedure, "debug" option} { .t debug true .t deb -} -cleanup { - destroy .t -} -result {1} -test text-7.4 {TextWidgetCmd procedure, "debug" option} -setup { - text .t -} -body { +} 1 +test text-7.4 {TextWidgetCmd procedure, "debug" option} { .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" +} 0 +.t debug + +test text-8.1 {TextWidgetCmd procedure, "delete" option} { + list [catch {.t delete} msg] $msg +} {1 {wrong # args: should be ".t delete index1 ?index2 ...?"}} +test text-8.2 {TextWidgetCmd procedure, "delete" option} { + list [catch {.t delete a b c} msg] $msg +} {1 {bad text index "a"}} +test text-8.3 {TextWidgetCmd procedure, "delete" option} { + list [catch {.t delete @x 2.2} msg] $msg +} {1 {bad text index "@x"}} +test text-8.4 {TextWidgetCmd procedure, "delete" option} { + list [catch {.t delete 2.3 @y} msg] $msg +} {1 {bad text index "@y"}} +test text-8.5 {TextWidgetCmd procedure, "delete" option} { .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" +} abcdefghijklm +.t configure -state normal +test text-8.6 {TextWidgetCmd procedure, "delete" option} { .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" +} abcefghijklm +test text-8.7 {TextWidgetCmd procedure, "delete" option} { .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" +} aefghijklm +test text-8.8 {TextWidgetCmd procedure, "delete" option} { # 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" + list [catch {.t delete 2.1 2.3 foo} msg] $msg \ + [.t get 2.0 2.end] +} {1 {bad text index "foo"} aefghijklm} +set prevtext [.t get 1.0 end-1c] +test text-8.9 {TextWidgetCmd procedure, "delete" option} { # auto-forward one byte if the last "pair" is just one - .t delete 1.0 end - .t insert 1.0 "foo\nabcdefghijklm" + .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 { +} foo\naefghijklm +test text-8.10 {TextWidgetCmd procedure, "delete" option} { # all indices will be ordered before deletion - .t insert 1.0 "foo\nabcdefghijklm" + .t delete 1.0 end; .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 { +} foo\ndfgjklm +test text-8.11 {TextWidgetCmd procedure, "delete" option} { # and check again with even pairs - .t insert 1.0 "foo\nabcdefghijklm" + .t delete 1.0 end; .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 { +} foo\ncdfgjklm +test text-8.12 {TextWidgetCmd procedure, "delete" option} { # we should get the longest range on equal start indices - .t insert 1.0 "foo\nabcdefghijklm" + .t delete 1.0 end; .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 { +} foo\nfghijklm +test text-8.13 {TextWidgetCmd procedure, "delete" option} { # we should get the longest range on equal start indices - .t insert 1.0 "foo\nabcdefghijklm" + .t delete 1.0 end; .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 { +} foghijklm +test text-8.14 {TextWidgetCmd procedure, "delete" option} { # we should get the longest range on equal start indices - .t insert 1.0 "foo\nabcdefghijklm" + .t delete 1.0 end; .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 { +} ffghijklm +test text-8.15 {TextWidgetCmd procedure, "delete" option} { # we should get the watch for overlapping ranges - they should # essentially be merged into one span. - .t insert 1.0 "foo\nabcdefghijklm" + .t delete 1.0 end; .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 { +} foo\nijklm +test text-8.16 {TextWidgetCmd procedure, "delete" option} { # we should get the watch for overlapping ranges - they should # essentially be merged into one span. - .t insert 1.0 "foo\nabcdefghijklm" + .t delete 1.0 end; .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] +} foo\nghijklm +.t delete 1.0 end; .t insert 1.0 $prevtext +test text-8.17 {TextWidgetCmd procedure, "replace" option} { + list [catch {.t replace 1.3 2.3} err] $err +} {1 {wrong # args: should be ".t replace index1 index2 chars ?tagList chars tagList ...?"}} +test text-8.18 {TextWidgetCmd procedure, "replace" option} { + list [catch {.t replace 3.1 2.3 foo} err] $err +} {1 {Index "2.3" before "3.1" in the text}} +test text-8.19 {TextWidgetCmd procedure, "replace" option} { + list [catch {.t replace 2.1 2.3 foo} err] $err +} {0 {}} +.t delete 1.0 end; .t insert 1.0 $prevtext +test text-8.20 {TextWidgetCmd procedure, "replace" option with undo} { .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 + .t configure -undo 0 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" +} {1} +test text-8.21 {TextWidgetCmd procedure, "replace" option with undo} { .t configure -undo 0 .t configure -undo 1 .t replace 2.1 2.3 foo @@ -1478,25 +352,15 @@ Line 7" # 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 + set res {} 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 + set res +} {{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.22 {TextWidgetCmd procedure, "replace" option with undo} { .t configure -undo 0 .t configure -undo 1 # Ensure that undo (even composite undo like 'replace') @@ -1506,1145 +370,322 @@ Line 7" .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] + if {![string equal [.t get 1.0 end-1c] $prevtext]} { + set res [list [.t get 1.0 end-1c] ne $prevtext] + } else { + set res 1 + } +} {1} +.t delete 1.0 end; .t insert 1.0 $prevtext +test text-8.23 {TextWidgetCmd procedure, "replace" option with peers, undo} { .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. + # 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] + if {![string equal [.t get 1.0 end-1c] $prevtext]} { + set res [list [.t get 1.0 end-1c] ne $prevtext] + } else { + set res 1 + } +} {1} +.t delete 1.0 end; .t insert 1.0 $prevtext +test text-8.24 {TextWidgetCmd procedure, "replace" option with peers, undo} { .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. + # 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}] + # 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} msg] .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 + if {![string equal [.t get 1.0 end-1c] $prevtext]} { + lappend res [list [.t get 1.0 end-1c] ne $prevtext] + } else { + lappend res 1 + } +} {foo 0 1} +test text-8.25 {TextWidgetCmd procedure, "replace" option crash} -setup { + destroy .tt } -body { + text .tt .tt insert 0.0 foo\n .tt replace end-1l end bar } -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 delete 1.0 end; .t insert 1.0 $prevtext + +test text-9.1 {TextWidgetCmd procedure, "get" option} { + list [catch {.t get} msg] $msg +} {1 {wrong # args: should be ".t get ?-displaychars? ?--? index1 ?index2 ...?"}} +test text-9.2 {TextWidgetCmd procedure, "get" option} { + list [catch {.t get a b c} msg] $msg +} {1 {bad text index "a"}} +test text-9.3 {TextWidgetCmd procedure, "get" option} { + list [catch {.t get @q 3.1} msg] $msg +} {1 {bad text index "@q"}} +test text-9.4 {TextWidgetCmd procedure, "get" option} { + list [catch {.t get 3.1 @r} msg] $msg +} {1 {bad text index "@r"}} +test text-9.5 {TextWidgetCmd procedure, "get" option} { .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" +} {} +test text-9.6 {TextWidgetCmd procedure, "get" option} { .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" +} { G} +test text-9.7 {TextWidgetCmd procedure, "get" option} { .t get 5.3 end -} -cleanup { - destroy .t -} -result { GIrl .#@? x_yz +} { 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 mark set a 5.3 +.t mark set b 5.3 +.t mark set c 5.5 +test text-9.8 {TextWidgetCmd procedure, "get" option} { .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" +} {y GIr} +test text-9.9 {TextWidgetCmd procedure, "get" option} { .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" +} {y} +test text-9.10 {TextWidgetCmd procedure, "get" option} { .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" +} {y } +test text-9.11 {TextWidgetCmd procedure, "get" option} { .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" +} {{y } G} +test text-9.12 {TextWidgetCmd procedure, "get" option} { .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" +} {{y } G} +test text-9.13 {TextWidgetCmd procedure, "get" option} { .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" +} {{y } {Irl .}} +test text-9.14 {TextWidgetCmd procedure, "get" option} { .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" +} {{y } G { }} +test text-9.15 {TextWidgetCmd procedure, "get" option} { .t get 5.2 5.4 5.4 5.5 end-3c end -} -cleanup { - destroy .t -} -result {{y } G { 7 +} {{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" +test text-9.16 {TextWidgetCmd procedure, "get" option} { .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" +} {y} +test text-9.17 {TextWidgetCmd procedure, "get" option} { .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" +} {5.5} +test text-9.17a {TextWidgetCmd procedure, "get" option} { .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" +} {5.5} +test text-9.17b {TextWidgetCmd procedure, "get" option} { .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 +} {5.5} +.t tag configure elide -elide 1 +.t tag add elide 5.2 5.4 +test text-9.18 {TextWidgetCmd procedure, "get" option} { + list [catch {.t get 5.2 5.4 5.5 foo} msg] $msg +} {1 {bad text index "foo"}} +test text-9.19 {TextWidgetCmd procedure, "get" option} { .t get 5.2 5.4 5.4 5.5 end-3c end -} -cleanup { - destroy .t -} -result {{y } G { 7 +} {{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 +test text-9.20 {TextWidgetCmd procedure, "get" option} { .t get -displaychars 5.2 5.4 5.4 5.5 end-3c end -} -cleanup { - destroy .t -} -result {{} G { 7 +} {{} 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 +test text-9.21 {TextWidgetCmd procedure, "get" option} { 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 +} {5.5 5.7} +test text-9.22 {TextWidgetCmd procedure, "get" option} { 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 +} {5.5 5.7} +test text-9.23 {TextWidgetCmd procedure, "get" option} { 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 +} {5.1 5.1} +test text-9.24 {TextWidgetCmd procedure, "get" option} { 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 +} {5.1 5.1} +.t window create 5.4 +test text-9.25 {TextWidgetCmd procedure, "get" option} { 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 +} {5.5 5.7} +test text-9.25a {TextWidgetCmd procedure, "get" option} { 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 +} {5.6 5.8} +test text-9.26 {TextWidgetCmd procedure, "get" option} { 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 +} {5.1 5.1} +test text-9.26a {TextWidgetCmd procedure, "get" option} { 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 +} {5.1 5.1} +.t delete 5.4 +.t tag add elide 5.5 5.6 +test text-9.27 {TextWidgetCmd procedure, "get" option} { .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 { +} {Grl} +.t tag delete elide +.t mark unset a +.t mark unset b +.t mark unset c +test text-9.2.1 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count} msg] $msg +} {1 {wrong # args: should be ".t count ?options? index1 index2"}} +test text-9.2.2.1 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count blah 1.0 2.0} msg] $msg +} {1 {bad option "blah" must be -chars, -displaychars, -displayindices, -displaylines, -indices, -lines, -update, -xpixels, or -ypixels}} +test text-9.2.2 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count a b} msg] $msg +} {1 {bad text index "a"}} +test text-9.2.3 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count @q 3.1} msg] $msg +} {1 {bad text index "@q"}} +test text-9.2.4 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count 3.1 @r} msg] $msg +} {1 {bad text index "@r"}} +test text-9.2.5 {TextWidgetCmd procedure, "count" option} { .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 { +} {-4} +test text-9.2.6 {TextWidgetCmd procedure, "count" option} { .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" +} {2} +test text-9.2.7 {TextWidgetCmd procedure, "count" option} { .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 { +} {29} +.t mark set a 5.3 +.t mark set b 5.3 +.t mark set c 5.5 +test text-9.2.8 {TextWidgetCmd procedure, "count" option} { .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 { +} {5} +test text-9.2.9 {TextWidgetCmd procedure, "count" option} { .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 { +} {1} +test text-9.2.10 {TextWidgetCmd procedure, "count" option} { .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 +} {2} +test text-9.2.17 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count 5.2 foo} msg] $msg +} {1 {bad text index "foo"}} +.t tag configure elide -elide 1 +.t tag add elide 2.2 3.4 +.t tag add elide 4.0 4.1 +test text-9.2.18 {TextWidgetCmd procedure, "count" option} { .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 +} {2} +test text-9.2.19 {TextWidgetCmd procedure, "count" option} { .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 +} {0} +test text-9.2.20 {TextWidgetCmd procedure, "count" option} { .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 +} {5} # Create one visible and one invisible window - frame .t.w1 - frame .t.w2 +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 - .t window create 2.1 -window .t.w1 - .t window create 3.1 -window .t.w2 +# 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 +test text-9.2.21 {TextWidgetCmd procedure, "count" option} { .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 +} {3} +test text-9.2.22 {TextWidgetCmd procedure, "count" option} { .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 +} {1} +test text-9.2.23 {TextWidgetCmd procedure, "count" option} { .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 +} {0} +test text-9.2.24 {TextWidgetCmd procedure, "count" option} { .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 +} {6} +test text-9.2.25 {TextWidgetCmd procedure, "count" option} { .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 +} {2} +test text-9.2.26 {TextWidgetCmd procedure, "count" option} { .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 +} {1} +test text-9.2.27 {TextWidgetCmd procedure, "count" option} { .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 +} {0} +test text-9.2.28 {TextWidgetCmd procedure, "count" option} { .t count -displaychars 2.0 4.2 +} {5} +test text-9.2.29 {TextWidgetCmd procedure, "count" option} { 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 +} {10 10} +test text-9.2.30 {TextWidgetCmd procedure, "count" option} { 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 +} {9 9} +test text-9.2.31 {TextWidgetCmd procedure, "count" option} { .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 +} {21} +test text-9.2.32 {TextWidgetCmd procedure, "count" option} { .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 +} {10} +test text-9.2.33 {TextWidgetCmd procedure, "count" option} { .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 +} {9} +test text-9.2.34 {TextWidgetCmd procedure, "count" option} { .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] +} {19} +destroy .t.w1 +destroy .t.w2 +set current [.t get 1.0 end-1c] +.t delete 1.0 end +.t insert end [string repeat "abcde " 50]\n +.t insert end [string repeat "fghij " 50]\n +.t insert end [string repeat "klmno " 50] +test text-9.2.35 {TextWidgetCmd procedure, "count" option} { .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] +} {3} +test text-9.2.36 {TextWidgetCmd procedure, "count" option} { .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] +} {-3} +test text-9.2.37 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count -lines 1.0 2.0 3.0} res] $res +} {1 {bad option "1.0" must be -chars, -displaychars, -displayindices, -displaylines, -indices, -lines, -update, -xpixels, or -ypixels}} +test text-9.2.38 {TextWidgetCmd procedure, "count" option} { .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] +} {0} +test text-9.2.39 {TextWidgetCmd procedure, "count" option} { .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] +} {1} +test text-9.2.40 {TextWidgetCmd procedure, "count" option} { .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] +} {0} +test text-9.2.41 {TextWidgetCmd procedure, "count" option} { .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] +} {-1} +test text-9.2.42 {TextWidgetCmd procedure, "count" option} { + set old_wrap [.t cget -wrap] .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 append . .t {top expand fill} -} -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] + set res [.t count -displaylines 1.0 end] + .t configure -wrap $old_wrap + set res +} {3} +test text-9.2.43 {TextWidgetCmd procedure, "count" option} { .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 +} {3 903 903 45} +.t configure -wrap none +test text-9.2.44 {TextWidgetCmd procedure, "count" option} -setup { + .t delete 1.0 end update set res {} } -body { @@ -2657,12 +698,9 @@ test text-10.39 {TextWidgetCmd procedure, "count" option} -setup { .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 + .t delete 1.0 end update set res {} } -body { @@ -2673,8 +711,6 @@ test text-9.2.45 {TextWidgetCmd procedure, "count" option} -setup { .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 @@ -2699,8 +735,7 @@ test text-9.2.46 {TextWidgetCmd procedure, "count" option} -setup { destroy .mytop } -result {1 3} test text-9.2.47 {TextWidgetCmd procedure, "count" option} -setup { - text .t - pack .t + .t delete 1.0 end update set res {} } -body { @@ -2713,24 +748,24 @@ test text-9.2.47 {TextWidgetCmd procedure, "count" option} -setup { # 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 + .t count -update -ypixels 1.0 end 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} +# 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 -test text-11.1 {counting with tag priority eliding} -setup { - text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 - pack append . .t {top expand fill} -} -body { +test text-0.2.44.0 {counting with tag priority eliding} { + .t delete 1.0 end .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] \ @@ -2739,42 +774,23 @@ test text-11.1 {counting with tag priority eliding} -setup { [.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 append . .t {top expand fill} -} -body { +} {0 1 2 3 4 5 5 6} +test text-0.2.44 {counting with tag priority eliding} { + .t delete 1.0 end .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 { +} {5} +test text-0.2.45 {counting with tag priority eliding} { + .t delete 1.0 end .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 +} {3} +test text-0.2.46 {counting with tag priority eliding} { set res {} -} -body { + .t delete 1.0 end .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] @@ -2783,19 +799,11 @@ test text-11.4 {counting with tag priority eliding} -setup { .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 +} {3 3} +test text-0.2.47 {counting with tag priority eliding} { set res {} -} -body { + .t delete 1.0 end .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] @@ -2804,19 +812,11 @@ test text-11.5 {counting with tag priority eliding} -setup { .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 +} {5 5} +test text-0.2.48 {counting with tag priority eliding} { set res {} -} -body { + .t delete 1.0 end .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 @@ -2829,17 +829,10 @@ test text-11.6 {counting with tag priority eliding} -setup { .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 +} {3 3} +test text-0.2.49 {counting with tag priority eliding} { 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 delete 1.0 end .t insert end "hello" .t tag add elide2 1.2 1.4 .t tag add elide3 1.2 1.4 @@ -2851,18 +844,11 @@ test text-11.7 {counting with tag priority eliding} -setup { .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 append . .t {top expand fill} +} {5 5} +test text-0.2.50 {counting with tag priority eliding} { set res {} -} -body { + .t delete 1.0 end .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] @@ -2877,14 +863,10 @@ test text-11.8 {counting with tag priority eliding} -setup { 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 append . .t {top expand fill} +} {0 0 0 0 3 2 1 1} +test text-0.2.51 {counting with tag priority eliding} { set res {} -} -body { + .t delete 1.0 end .t tag configure WELCOME -elide 1 .t tag configure SYSTEM -elide 0 .t tag configure TRAFFIC -elide 1 @@ -2905,599 +887,225 @@ test text-11.9 {counting with tag priority eliding} -setup { 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 { +} {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} + +.t delete 1.0 end +.t insert end $current +unset current + +test text-10.1 {TextWidgetCmd procedure, "index" option} { + list [catch {.t index} msg] $msg +} {1 {wrong # args: should be ".t index index"}} +test text-10.2 {TextWidgetCmd procedure, "index" option} { + list [catch {.t ind a b} msg] $msg +} {1 {wrong # args: should be ".t index index"}} +test text-10.3 {TextWidgetCmd procedure, "index" option} { + list [catch {.t in a b} msg] $msg +} {1 {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} +test text-10.4 {TextWidgetCmd procedure, "index" option} { + list [catch {.t index @xyz} msg] $msg +} {1 {bad text index "@xyz"}} +test text-10.5 {TextWidgetCmd procedure, "index" option} { .t index 1.2 -} -cleanup { - destroy .t -} -result 1.2 - +} 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" +test text-11.1 {TextWidgetCmd procedure, "insert" option} { + list [catch {.t insert 1.2} msg] $msg +} {1 {wrong # args: should be ".t insert index chars ?tagList chars tagList ...?"}} +test text-11.2 {TextWidgetCmd procedure, "insert" option} { .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" +} {Line 1} +.t config -state normal +test text-11.3 {TextWidgetCmd procedure, "insert" option} { .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" +} {Lixyzzyne 1} +test text-11.4 {TextWidgetCmd procedure, "insert" option} { .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 { +} {1.0 1.11} +test text-11.5 {TextWidgetCmd procedure, "insert" option} { + .t delete 1.0 end .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 { +} {{1.0 1.2 1.5 1.14} {1.2 1.5}} +test text-11.6 {TextWidgetCmd procedure, "insert" option} { + .t delete 1.0 end .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 { +} {{1.0 1.11} {1.0 1.11} {1.0 1.11}} +test text-11.7 {TextWidgetCmd procedure, "insert" option} { + .t delete 1.0 end .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 { +} {{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-11.8 {TextWidgetCmd procedure, "insert" option} { + .t delete 1.0 end + list [catch {.t insert 1.0 "Sample text" "a \{b"} msg] $msg +} {1 {unmatched open brace in list}} +test text-11.9 {TextWidgetCmd procedure, "insert" option} { + .t delete 1.0 end .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 { +} {{First second third} {1.0 1.5} {1.6 1.12} {1.6 1.12} {1.6 1.12}} +test text-11.10 {TextWidgetCmd procedure, "insert" option} { + .t delete 1.0 end .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}} +} {{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 +test text-12.1 {ConfigureText procedure} { + list [catch {.t2 configure -state foobar} msg] $msg +} {1 {bad state "foobar": must be disabled or normal}} +test text-12.2 {ConfigureText procedure} { + .t2 configure -spacing1 -2 -spacing2 1 -spacing3 1 + list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3] +} {0 1 1} +test text-12.3 {ConfigureText procedure} { + .t2 configure -spacing1 1 -spacing2 -1 -spacing3 1 + list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3] +} {1 0 1} +test text-12.4 {ConfigureText procedure} { + .t2 configure -spacing1 1 -spacing2 1 -spacing3 -3 + list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3] +} {1 1 0} +test text-12.5 {ConfigureText procedure} { + set x [list [catch {.t2 configure -tabs {30 foo}} msg] $msg $errorInfo] + .t2 configure -tabs {10 20 30} + set x +} {1 {bad tab alignment "foo": must be left, right, center, or numeric} {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 \ +".t2 configure -tabs {30 foo}"}} +test text-12.6 {ConfigureText procedure} { + .t2 configure -tabs {10 20 30} + .t2 configure -tabs {} + .t2 cget -tabs +} {} +test text-12.7 {ConfigureText procedure} { + list [catch {.t2 configure -wrap bogus} msg] $msg +} {1 {bad wrap "bogus": must be char, none, or word}} +test text-12.8 {ConfigureText procedure} { + .t2 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 + list [lindex [.t2 tag config sel -borderwidth] 4] \ + [lindex [.t2 tag config sel -foreground] 4] \ + [lindex [.t2 tag config sel -background] 4] +} {17 #332211 #abc} +test text-12.9 {ConfigureText procedure} { + .t2 configure -selectborderwidth {} + .t2 tag cget sel -borderwidth +} {} +test text-12.10 {ConfigureText procedure} { + list [catch {.t2 configure -selectborderwidth foo} msg] $msg +} {1 {bad screen distance "foo"}} +test text-12.11 {ConfigureText procedure} { + catch {destroy .t2} .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 +} {ab} +test text-12.12 {ConfigureText procedure} { + catch {destroy .t2} .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 +} {ab} +test text-12.13 {ConfigureText procedure} { + catch {destroy .t2} .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 +} {1234} +test text-12.14 {ConfigureText procedure} { + catch {destroy .t2} .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 +} {1234} +test text-12.15 {ConfigureText procedure} { + catch {destroy .t2} 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 append .top .top.t top - 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 append .top .top.t top - 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 append .top .top.t top - 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 { + lappend result [catch {selection get} msg] $msg +} {1234 1 {PRIMARY selection doesn't exist or form "STRING" not defined}} +test text-12.16 {ConfigureText procedure} {fonts} { + # This test is non-portable because the window size will vary depending + # on the font size, which can vary. + catch {destroy .t2} + toplevel .t2 + text .t2.t -width 20 -height 10 + pack append .t2 .t2.t top + wm geometry .t2 +0+0 + update + wm geometry .t2 +} {150x140+0+0} +test text-12.17 {ConfigureText procedure} { + # This test was failing Windows because the title bar on .t2 + # 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. + catch {destroy .t2} + toplevel .t2 + wm overrideredirect .t2 1 + text .t2.t -width 20 -height 10 -setgrid 1 + pack append .t2 .t2.t top + wm geometry .t2 +0+0 + update + wm geometry .t2 +} {20x10+0+0} +test text-12.18 {ConfigureText procedure} { + # This test was failing on Windows because the title bar on .t2 + # 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. + catch {destroy .t2} + toplevel .t2 + wm overrideredirect .t2 1 + text .t2.t -width 20 -height 10 -setgrid 1 + pack append .t2 .t2.t top + wm geometry .t2 +0+0 + update + set result [wm geometry .t2] + wm geometry .t2 15x8 + update + lappend result [wm geometry .t2] + .t2.t configure -wrap word + update + lappend result [wm geometry .t2] +} {20x10+0+0 15x8+0+0 15x8+0+0} + +test text-13.1 {TextWorldChanged procedure, spacing options} fonts { + catch {destroy .t2} + text .t2 -width 20 -height 10 + set result [winfo reqheight .t2] + .t2 configure -spacing1 2 + lappend result [winfo reqheight .t2] + .t2 configure -spacing3 1 + lappend result [winfo reqheight .t2] + .t2 configure -spacing1 0 + lappend result [winfo reqheight .t2] +} {140 160 170 150} + +test text-14.1 {TextEventProc procedure} { text .tx1 -bg #543210 rename .tx1 .tx2 set x {} @@ -3505,363 +1113,265 @@ test text-16.1 {TextEventProc procedure} -body { 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} - +} {1 #543210 {} 0 0} -test text-17.1 {TextCmdDeletedProc procedure} -body { +test text-15.1 {TextCmdDeletedProc procedure} { 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 { +} {{} 0} +test text-15.2 {TextCmdDeletedProc procedure, disabling -setgrid} fonts { + catch {destroy .top} + toplevel .top + wm geom .top +0+0 + text .top.t -setgrid 1 -width 20 -height 10 + pack .top.t + update + set x [wm geometry .top] + rename .top.t {} + update + lappend x [wm geometry .top] destroy .top -} -result {20x10+ 150x140+} + set x +} {20x10+0+0 150x140+0+0} - -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-16.1 {InsertChars procedure} { + catch {destroy .t2} + text .t2 + .t2 insert 2.0 abcd\n + .t2 get 1.0 end +} {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 +test text-16.2 {InsertChars procedure} { + catch {destroy .t2} + text .t2 + .t2 insert 1.0 abcd\n + .t2 insert end 123\n + .t2 get 1.0 end +} {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 +test text-16.3 {InsertChars procedure} { + catch {destroy .t2} + text .t2 + .t2 insert 1.0 abcd\n + .t2 insert 10.0 123 + .t2 get 1.0 end +} {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 +test text-16.4 {InsertChars procedure, inserting on top visible line} { + catch {destroy .t2} + text .t2 -width 20 -height 4 -wrap word + pack .t2 + .t2 insert insert "Now is the time for all great men to come to the " + .t2 insert insert "aid of their party.\n" + .t2 insert insert "Now is the time for all great men.\n" + .t2 see end + update + .t2 insert 1.0 "Short\n" + .t2 index @0,0 +} {2.56} +test text-16.5 {InsertChars procedure, inserting on top visible line} { + catch {destroy .t2} + text .t2 -width 20 -height 4 -wrap word + pack .t2 + .t2 insert insert "Now is the time for all great men to come to the " + .t2 insert insert "aid of their party.\n" + .t2 insert insert "Now is the time for all great men.\n" + .t2 see end + update + .t2 insert 1.55 "Short\n" + .t2 index @0,0 +} {2.0} +test text-16.6 {InsertChars procedure, inserting on top visible line} { + catch {destroy .t2} + text .t2 -width 20 -height 4 -wrap word + pack .t2 + .t2 insert insert "Now is the time for all great men to come to the " + .t2 insert insert "aid of their party.\n" + .t2 insert insert "Now is the time for all great men.\n" + .t2 see end + update + .t2 insert 1.56 "Short\n" + .t2 index @0,0 +} {1.56} +test text-16.7 {InsertChars procedure, inserting on top visible line} { + catch {destroy .t2} + text .t2 -width 20 -height 4 -wrap word + pack .t2 + .t2 insert insert "Now is the time for all great men to come to the " + .t2 insert insert "aid of their party.\n" + .t2 insert insert "Now is the time for all great men.\n" + .t2 see end + update + .t2 insert 1.57 "Short\n" + .t2 index @0,0 +} {1.56} +catch {destroy .t2} + +proc setup {} { + .t delete 1.0 end .t insert 1.0 "Line 1 abcde 12345 Line 4" +} + +.t delete 1.0 end +test text-17.1 {DeleteChars procedure} { + .t get 1.0 end +} { +} +test text-17.2 {DeleteChars procedure} { + list [catch {.t delete foobar} msg] $msg +} {1 {bad text index "foobar"}} +test text-17.3 {DeleteChars procedure} { + list [catch {.t delete 1.0 lousy} msg] $msg +} {1 {bad text index "lousy"}} +test text-17.4 {DeleteChars procedure} { + setup .t delete 2.1 .t get 1.0 end -} -cleanup { - destroy .t -} -result {Line 1 +} {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" +test text-17.5 {DeleteChars procedure} { + setup .t delete 2.3 .t get 1.0 end -} -cleanup { - destroy .t -} -result {Line 1 +} {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" +test text-17.6 {DeleteChars procedure} { + setup .t delete 2.end .t get 1.0 end -} -cleanup { - destroy .t -} -result {Line 1 +} {Line 1 abcde12345 Line 4 } -test text-19.7 {DeleteChars procedure} -body { - text .t - .t insert 1.0 "Line 1 -abcde -12345 -Line 4" +test text-17.7 {DeleteChars procedure} { + setup .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 +} {{} {Line 1 abcde 12345 Li }} -test text-19.8 {DeleteChars procedure} -body { - text .t - .t insert 1.0 "Line 1 -abcde -12345 -Line 4" +test text-17.8 {DeleteChars procedure} { + setup .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 +} {{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" +test text-17.9 {DeleteChars procedure} { + setup .t delete 2.2 2.2 .t get 1.0 end -} -cleanup { - destroy .t -} -result {Line 1 +} {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" +test text-17.10 {DeleteChars procedure} { + setup .t delete 2.3 2.1 .t get 1.0 end -} -cleanup { - destroy .t -} -result {Line 1 +} {Line 1 abcde 12345 Line 4 } -test text-19.11 {DeleteChars procedure} -body { - toplevel .top - text .top.t -width 20 -height 5 - pack append .top .top.t top - 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 append .top .top.t top - 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 append . .t {top expand fill} - 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 - } +test text-17.11 {DeleteChars procedure} { + catch {destroy .t2} + toplevel .t2 + text .t2.t -width 20 -height 5 + pack append .t2 .t2.t top + wm geometry .t2 +0+0 + .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns" + update + .t2.t delete 1.0 3.0 + list [.t2.t index @0,0] [.t2.t get @0,0] +} {1.0 x} +test text-17.12 {DeleteChars procedure} { + catch {destroy .t2} + toplevel .t2 + text .t2.t -width 20 -height 5 + pack append .t2 .t2.t top + wm geometry .t2 +0+0 + .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns" + .t2.t yview 3.0 + update + .t2.t delete 2.0 4.0 + list [.t2.t index @0,0] [.t2.t get @0,0] +} {2.0 y} +catch {destroy .t2} +toplevel .t2 +text .t2.t -width 1 -height 10 -wrap char +frame .t2.f -width 200 -height 20 -relief raised -bd 2 +pack .t2.f .t2.t -side left +wm geometry .t2 +0+0 +update +test text-17.13 {DeleteChars procedure, updates affecting topIndex} { + .t2.t delete 1.0 end + .t2.t insert end "abcde\n12345\nqrstuv" + .t2.t yview 2.1 + .t2.t delete 1.4 2.3 + .t2.t index @0,0 +} {1.2} +test text-17.14 {DeleteChars procedure, updates affecting topIndex} { + .t2.t delete 1.0 end + .t2.t insert end "abcde\n12345\nqrstuv" + .t2.t yview 2.1 + .t2.t delete 2.3 2.4 + .t2.t index @0,0 +} {2.0} +test text-17.15 {DeleteChars procedure, updates affecting topIndex} { + .t2.t delete 1.0 end + .t2.t insert end "abcde\n12345\nqrstuv" + .t2.t yview 1.3 + .t2.t delete 1.0 1.2 + .t2.t index @0,0 +} {1.1} +test text-17.16 {DeleteChars procedure, updates affecting topIndex} { + catch {destroy .t2} + toplevel .t2 + text .t2.t -width 6 -height 10 -wrap word + frame .t2.f -width 200 -height 20 -relief raised -bd 2 + pack .t2.f .t2.t -side left + wm geometry .t2 +0+0 + update + .t2.t insert end "abc def\n01 2345 678 9101112\nLine 3\nLine 4\nLine 5\n6\n7\n8\n" + .t2.t yview 2.4 + .t2.t delete 2.5 + set x [.t2.t index @0,0] + .t2.t delete 2.5 + list $x [.t2.t index @0,0] +} {2.3 2.0} + +.t delete 1.0 end +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 +} +test text-18.1 {TextFetchSelection procedure} { .t tag add sel 1.3 3.4 selection get -} -cleanup { - destroy .t -} -result {a.1a.2a.3a.4 +} {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 append . .t {top expand fill} - 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 - } +test text-18.2 {TextFetchSelection procedure} { .t tag add x 1.2 .t tag add x 1.4 .t tag add x 2.0 @@ -3869,33 +1379,15 @@ test text-20.2 {TextFetchSelection procedure} -setup { .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 +} {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 append . .t {top expand fill} - 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 - } +test text-18.3 {TextFetchSelection procedure} { .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 append . .t {top expand fill} - 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 - } +} {m} +test text-18.4 {TextFetchSelection procedure} { .t tag remove x 1.0 end .t tag add sel 1.0 3.4 .t tag remove sel 1.0 end @@ -3904,1043 +1396,674 @@ test text-20.4 {TextFetchSelection procedure} -setup { .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 +} {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 append . .t {top expand fill} - 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" - } +set x "" +for {set i 1} {$i < 200} {incr i} { + append x "This is line $i, padded to just about 53 characters.\n" +} +test text-18.5 {TextFetchSelection procedure, long selections} { + .t delete 1.0 end .t insert end $x .t tag add sel 1.0 end - expr {[selection get] eq "$x\n"} -} -cleanup { - destroy .t -} -result {1} - + selection get +} $x\n -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" +test text-19.1 {TkTextLostSelection procedure} unix { + catch {destroy .t2} 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" +} {} +test text-19.2 {TkTextLostSelection procedure} win { + catch {destroy .t2} 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 +} {1.2 3.3} +catch {destroy .t2} +test text-19.3 {TkTextLostSelection procedure} { + catch {destroy .t2} + text .t2 + .t2 insert 1.0 "abcdef\nghijk\n1234" + .t2 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 [catch {selection get} msg] $msg + .t2 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" +} {abc 1 {PRIMARY selection doesn't exist or form "STRING" not defined} abc} + +.t delete 1.0 end +.t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" +test text-20.1 {TextSearchCmd procedure, argument parsing} { + list [catch {.t search -} msg] $msg +} {1 {bad switch "-": must be --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits}} +test text-20.2 {TextSearchCmd procedure, -backwards option} { .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" +} {1.1} +test text-20.2.1 {TextSearchCmd procedure, -all option} { .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" +} {1.5 3.0 3.5 1.1} +test text-20.3 {TextSearchCmd procedure, -forwards option} { .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" +} {1.5} +test text-20.4 {TextSearchCmd procedure, -exact option} { .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" +} {1.9} +test text-20.5 {TextSearchCmd procedure, -regexp option} { .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" +} {1.1} +test text-20.6 {TextSearchCmd procedure, -count option} { 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" +} {1.9 2} +test text-20.7 {TextSearchCmd procedure, -count option} { + list [catch {.t search -count} msg] $msg +} {1 {no value given for "-count" option}} +test text-20.8 {TextSearchCmd procedure, -nocase option} { 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" +} {2.13 2.23} +test text-20.9 {TextSearchCmd procedure, -n ambiguous option} { + list [catch {.t search -n BaR 1.1} msg] $msg +} {1 {bad switch "-n": must be --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits}} +test text-20.9.1 {TextSearchCmd procedure, -nocase option} { .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" +} {2.13} +test text-20.9.2 {TextSearchCmd procedure, -nolinestop option} { + list [catch {.t search -nolinestop BaR 1.1} msg] $msg +} {1 {the "-nolinestop" option requires the "-regexp" option to be present}} +test text-20.9.3 {TextSearchCmd procedure, -nolinestop option} { 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" +} {1.14 32} +test text-20.10 {TextSearchCmd procedure, -- option} { .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" +} {2.4} +test text-20.11 {TextSearchCmd procedure, argument parsing} { + list [catch {.t search abc} msg] $msg +} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"}} +test text-20.12 {TextSearchCmd procedure, argument parsing} { + list [catch {.t search abc d e f} msg] $msg +} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"}} +test text-20.13 {TextSearchCmd procedure, check index} { + list [catch {.t search abc gorp} msg] $msg +} {1 {bad text index "gorp"}} +test text-20.14 {TextSearchCmd procedure, startIndex == "end"} { .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" +} {} +test text-20.15 {TextSearchCmd procedure, startIndex == "end"} { .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" +} {} +test text-20.16 {TextSearchCmd procedure, bad stopIndex} { + list [catch {.t search abc 1.0 lousy} msg] $msg +} {1 {bad text index "lousy"}} +test text-20.17 {TextSearchCmd procedure, pattern case conversion} { 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" +} {2.13 {}} +test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} { + list [catch {.t search -regexp a( 1.0} msg] $msg +} {1 {couldn't compile regular expression pattern: parentheses () not balanced}} +test text-20.19 {TextSearchCmd procedure, skip dummy last line} { .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" +} {2.23} +test text-20.20 {TextSearchCmd procedure, skip dummy last line} { .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" +} {3.9} +test text-20.21 {TextSearchCmd procedure, skip dummy last line} { .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" +} {1.15} +test text-20.22 {TextSearchCmd procedure, skip dummy last line} { .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" +} {3.9} +test text-20.23 {TextSearchCmd procedure, extract line contents} { .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" +} {1.1} +test text-20.24 {TextSearchCmd procedure, stripping newlines} { .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" +} {1.12} +test text-20.25 {TextSearchCmd procedure, handling newlines} { .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" +} {1.12} +test text-20.26 {TextSearchCmd procedure, stripping newlines} { .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" +} {1.12} +test text-20.27 {TextSearchCmd procedure, handling newlines} { .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" +} {1.15} +test text-20.28 {TextSearchCmd procedure, line case conversion} { 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" +} {2.23 2.13} +test text-20.29 {TextSearchCmd procedure, firstChar and lastChar} { .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" +} {1.5} +test text-20.30 {TextSearchCmd procedure, firstChar and lastChar} { .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" +} {1.1} +test text-20.31 {TextSearchCmd procedure, firstChar and lastChar} { .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" +} {1.5} +test text-20.32 {TextSearchCmd procedure, firstChar and lastChar} { .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" +} {3.0} +test text-20.33 {TextSearchCmd procedure, firstChar and lastChar} { .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" +} {1.15} +test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} { .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" +} {2.0} +test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} { .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 +} {1.0} +test text-20.35a {TextSearchCmd procedure, regexp finds empty lines} { + # 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" +} {4.0} + +catch {destroy .t2} +toplevel .t2 +wm geometry .t2 +0+0 +text .t2.t -width 30 -height 10 +pack .t2.t +.t2.t insert 1.0 "This is a line\nand this is another" +.t2.t insert end "\nand this is yet another" +frame .t2.f -width 20 -height 20 -bd 2 -relief raised +.t2.t window create 2.5 -window .t2.f +test text-20.36 {TextSearchCmd procedure, firstChar and lastChar} { + .t2.t search his 2.6 +} {2.6} +test text-20.37 {TextSearchCmd procedure, firstChar and lastChar} { + .t2.t search this 2.6 +} {3.4} +test text-20.38 {TextSearchCmd procedure, firstChar and lastChar} { + .t2.t search is 2.6 +} {2.7} +test text-20.39 {TextSearchCmd procedure, firstChar and lastChar} { + .t2.t search his 2.7 +} {3.5} +test text-20.40 {TextSearchCmd procedure, firstChar and lastChar} { + .t2.t search -backwards "his is another" 2.6 +} {2.6} +test text-20.41 {TextSearchCmd procedure, firstChar and lastChar} { + .t2.t search -backwards "his is" 2.6 +} {1.1} +destroy .t2 +test text-20.42 {TextSearchCmd procedure, firstChar and lastChar} { .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" +} {2.5} +test text-20.43 {TextSearchCmd procedure, firstChar and lastChar} { .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} +} {2.5} +test text-20.44 {TextSearchCmd procedure, firstChar and lastChar} { + catch {destroy .t2} 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" +} {{} {}} +test text-20.45 {TextSearchCmd procedure, regexp match length} { 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" +} {1.1 7} +test text-20.46 {TextSearchCmd procedure, regexp match length} { 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" +} {2.0 3} +test text-20.47 {TextSearchCmd procedure, checking stopIndex} { 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" +} {{} 2.13 2.13 {}} +test text-20.48 {TextSearchCmd procedure, checking stopIndex} { 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" +} {2.13 {} 2.13 {}} +test text-20.48.1 {TextSearchCmd procedure, checking stopIndex} { 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 +} {2.13 {} {} {}} +test text-20.49 {TextSearchCmd procedure, embedded windows and index/count} { 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 + set result "" 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" + .t delete 2.1 + .t delete 2.8 2.10 + .t delete 2.10 + set result +} {2.6 10 2.11 2} +test text-20.50 {TextSearchCmd procedure, error setting variable} { + catch {unset a} 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" + list [catch {.t search -count a(2) xyz 1.0} msg] $msg +} {1 {can't set "a(2)": variable isn't array}} +test text-20.51 {TextSearchCmd procedure, wrap-around} { .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" +} {3.5} +test text-20.52 {TextSearchCmd procedure, wrap-around} { .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" +} {} +test text-20.53 {TextSearchCmd procedure, wrap-around} { .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" +} {1.1} +test text-20.54 {TextSearchCmd procedure, wrap-around} { .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" +} {} +test text-20.55 {TextSearchCmd procedure, no match} { .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" +} {} +test text-20.56 {TextSearchCmd procedure, no match} { .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" +} {} +test text-20.57 {TextSearchCmd procedure, special cases} { .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" +} {1.0} +test text-20.58 {TextSearchCmd procedure, special cases} { .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" +} {3.8} +test text-20.59 {TextSearchCmd procedure, special cases} { .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" +} {3.9} +test text-20.60 {TextSearchCmd procedure, special cases} { .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" +} {1.15} +test text-20.61 {TextSearchCmd procedure, special cases} { .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). +} {1.0} +test text-20.62 {TextSearchCmd, freeing copy of pattern} { + # 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 +} {} +test text-20.63 {TextSearchCmd, unicode} { + .t delete 1.0 end .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 +} 1.3 +test text-20.64 {TextSearchCmd, unicode} { + .t delete 1.0 end .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 +} {1.3 2} +test text-20.65 {TextSearchCmd, unicode with non-text segments} { + .t delete 1.0 end 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 { + set result [list [.t search -count n \u30c9\u30ca 1.0] $n] + destroy .b1 + set result +} {1.3 3} +test text-20.66 {TextSearchCmd, hidden text does not affect match index} { + deleteWindows + pack [text .t2] + .t2 insert end "12345H7890" + .t2 search 7 1.0 +} 1.6 +test text-20.67 {TextSearchCmd, hidden text does not affect match index} { + deleteWindows + pack [text .t2] + .t2 insert end "12345H7890" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.5 + .t2 search 7 1.0 +} 1.6 +test text-20.68 {TextSearchCmd, hidden text does not affect match index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nbarbaz\nbazboo" + .t2 search boo 1.0 +} 3.3 +test text-20.69 {TextSearchCmd, hidden text does not affect match index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nbarbaz\nbazboo" + .t2 tag configure hidden -elide true + .t2 tag add hidden 2.0 3.0 + .t2 search boo 1.0 +} 3.3 +test text-20.70 {TextSearchCmd, -regexp -nocase searches} { + catch {destroy .t} pack [text .t] .t insert end "word1 word2" - .t search -nocase -regexp {\mword.} 1.0 end -} -cleanup { + set res [.t search -nocase -regexp {\mword.} 1.0 end] destroy .t -} -result {1.0} -test text-22.77 {TextSearchCmd, -regexp -nocase searches} -body { + set res +} 1.0 +test text-20.71 {TextSearchCmd, -regexp -nocase searches} { + catch {destroy .t} pack [text .t] .t insert end "word1 word2" - .t search -nocase -regexp {word.\M} 1.0 end -} -cleanup { + set res [.t search -nocase -regexp {word.\M} 1.0 end] destroy .t -} -result {1.0} -test text-22.78 {TextSearchCmd, -regexp -nocase searches} -body { + set res +} 1.0 +test text-20.72 {TextSearchCmd, -regexp -nocase searches} { + catch {destroy .t} 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 { + set res [.t search -nocase -regexp {word.\W} 1.0 end] 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 + set res +} 1.0 +test text-20.73 {TextSearchCmd, hidden text and start index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search bar 1.3 +} 1.3 +test text-20.74 {TextSearchCmd, hidden text shouldn't influence start index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.0 1.2 + .t2 search bar 1.3 +} 1.3 +test text-20.75 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + list [.t2 search -count foo foar 1.3] $foo +} {1.0 6} +test text-20.75.1 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 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)); + [.t2 search -strict -count foo foar 1.3] \ + [.t2 search -strict -count foo foar 2.3] $foo +} {{} 1.0 6} +test text-20.76 {TextSearchCmd, hidden text and start index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -regexp bar 1.3 +} 1.3 +test text-20.77 {TextSearchCmd, hidden text shouldn't influence start index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.0 1.2 + .t2 search -regexp bar 1.3 +} 1.3 +test text-20.78 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + list [.t2 search -regexp -count foo foar 1.3] $foo +} {1.0 6} +test text-20.78.1 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + list [.t2 search -count foo foar 1.3] $foo +} {1.0 6} +test text-20.78.2 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + .t2 search -strict -count foo foar 1.3 +} {} +test text-20.78.3 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + .t2 tag add hidden 2.2 2.4 + list [.t2 search -regexp -all -count foo foar 1.3] $foo +} {{2.0 3.0 1.0} {6 4 6}} +test text-20.78.4 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + .t2 tag add hidden 2.2 2.4 + list [.t2 search -all -count foo foar 1.3] $foo +} {{2.0 3.0 1.0} {6 4 6}} +test text-20.78.5 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + .t2 tag add hidden 2.2 2.4 + list [.t2 search -strict -all -count foo foar 1.3] $foo +} {{2.0 3.0} {6 4}} +test text-20.78.6 {TextSearchCmd, single line with -all} { + deleteWindows + pack [text .t2] + .t2 insert end " X\n X\n X\n X\n X\n X\n" + .t2 search -all -regexp { +| *\n} 1.0 end +} {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-20.79 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -count foo foobar\nfoo 1.0] $foo +} {1.0 10} +test text-20.80 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -count foo bar\nfoo 1.0] $foo +} {1.3 7} +test text-20.81 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -count foo \nfoo 1.0] $foo +} {1.6 4} +test text-20.82 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -count foo bar\nfoobar\nfoo 1.0] $foo +} {1.3 14} +test text-20.83 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -count foo bar\nfoobar\nfoobanearly 1.0 +} {} +test text-20.84 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -regexp -count foo foobar\nfoo 1.0] $foo +} {1.0 10} +test text-20.85 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -regexp -count foo bar\nfoo 1.0] $foo +} {1.3 7} +test text-20.86 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -regexp -count foo \nfoo 1.0] $foo +} {1.6 4} +test text-20.87 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -regexp -count foo bar\nfoobar\nfoo 1.0] $foo +} {1.3 14} +test text-20.88 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -regexp -count foo bar\nfoobar\nfoobanearly 1.0 +} {} +test text-20.89 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfaoobar\nfoobar" + .t2 search -regexp -count foo bar\nfoo 1.0 +} {2.4} +test text-20.90 {TextSearchCmd, multiline matching end of window} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfaoobar\nfoobar" + .t2 search -regexp -count foo bar\nfoobar\n\n 1.0 +} {} +test text-20.91 {TextSearchCmd, multiline matching end of window} { + deleteWindows + pack [text .t2] + .t2 search "\n\n" 1.0 +} {} +test text-20.92 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -count foo foobar\nfoo end] $foo +} {2.0 10} +test text-20.93 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -count foo bar\nfoo 1.0] $foo +} {2.3 7} +test text-20.94 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -count foo \nfoo 1.0] $foo +} {2.6 4} +test text-20.95 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -count foo bar\nfoobar\nfoo 1.0] $foo +} {1.3 14} +test text-20.96 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -backwards -count foo bar\nfoobar\nfoobanearly 1.0 +} {} +test text-20.97 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo foobar\nfoo end] $foo +} {2.0 10} +test text-20.97.1 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo foobar\nfo end] $foo +} {2.0 9} +test text-20.98 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo bar\nfoo 1.0] $foo +} {2.3 7} +test text-20.99 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo \nfoo 1.0] $foo +} {2.6 4} +test text-20.100 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo bar\nfoobar\nfoo 1.0] $foo +} {1.3 14} +test text-20.101 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -backwards -regexp -count foo bar\nfoobar\nfoobanearly 1.0 +} {} +test text-20.102 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfaoobar\nfoobar" + .t2 search -backwards -regexp -count foo bar\nfoo 1.0 +} {2.4} +test text-20.103 {TextSearchCmd, multiline matching end of window} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfaoobar\nfoobar" + .t2 search -backwards -regexp -count foo bar\nfoobar\n\n 1.0 +} {} +test text-20.104 {TextSearchCmd, multiline matching end of window} { + deleteWindows + pack [text .t2] + .t2 search -backwards "\n\n" 1.0 +} {} +test text-20.105 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 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, + .t2 search -forwards -regexp $markExpr 1.41 end +} {} +test text-20.106 {TextSearchCmd, multiline regexp matching} { + # 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) + deleteWindows + pack [text .t2] + .t2 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 { + .t2 search -forwards -regexp $markExpr 1.41 end +} {} +test text-20.107 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 { static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static Tcl_Obj* FSNormalizeAbsolutePath @@ -4948,275 +2071,240 @@ static Tcl_Obj* FSNormalizeAbsolutePath 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 { + .t2 search -backwards -all -regexp $markExpr end +} {2.0} +test text-20.108 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -all -regexp -count foo bar\nfoo 1.0 +} {1.3 2.3} +test text-20.109 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -all -backwards -regexp -count foo bar\nfoo 1.0 +} {2.3 1.3} +test text-20.110 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -- "blah" 3.3 1.3 +} {} +test text-20.111 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -backwards -- "blah" 1.3 3.3 +} {} +test text-20.112 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -backwards -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0 +} {1.31} +test text-20.113 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -regexp -- "\[\]\")\}\[(\{\]" 1.30 "1.0 lineend" +} {1.31} +test text-20.114 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -backwards -all -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0 +} {1.31 1.29 1.3} +test text-20.115 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -all -regexp -- "\[\]\")\}\[(\{\]" 1.0 "1.0 lineend" +} {1.3 1.29 1.31} +test text-20.116 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -backwards -- "\{" "1.32" 1.0 +} {1.31} +test text-20.117 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -- "\{" 1.30 "1.0 lineend" +} {1.31} +test text-20.118 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 { void Tcl_SetObjLength(objPtr, length) register Tcl_Obj *objPtr; /* Pointer to object. This object must - * not currently be shared. */ + * not currently be shared. */ register int length; /* Number of bytes desired for string * representation of object, not including - * terminating null byte. */ + * 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" + .t2 search -all -regexp -- $markExpr 1.0 +} {4.0} +test text-20.119 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 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" + # This should not match, and should not wrap + .t2 search -regexp -- $markExpr end end +} {} +test text-20.120 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 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" + # This should not match, and should not wrap + .t2 search -regexp -- $markExpr end+10c end +} {} +test text-20.121 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 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 { + # This should not match, and should not wrap + .t2 search -regexp -backwards -- $markExpr 1.0 1.0 +} {} +test text-20.122 {TextSearchCmd, regexp linestop} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + .t2 search -regexp -- {i.*x} 1.0 +} {2.6} +test text-20.123 {TextSearchCmd, multiline regexp nolinestop matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + .t2 search -regexp -nolinestop -- {i.*x} 1.0 +} {1.1} +test text-20.124 {TextSearchCmd, regexp linestop} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + .t2 search -regexp -all -overlap -- {i.*x} 1.0 +} {2.6} +test text-20.124.1 {TextSearchCmd, regexp linestop} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + .t2 search -regexp -all -- {i.*x} 1.0 +} {2.6} +test text-20.125 {TextSearchCmd, multiline regexp nolinestop matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + list [.t2 search -regexp -all -overlap -count c -nolinestop -- {i.*x} 1.0] $c +} {{1.1 2.6} {26 10}} +test text-20.125.1 {TextSearchCmd, multiline regexp nolinestop matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + list [.t2 search -regexp -all -count c -nolinestop -- {i.*x} 1.0] $c +} {1.1 26} +test text-20.126 {TextSearchCmd, stop at end of line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " \t\n last line of text" + .t2 search -regexp -nolinestop -- {[^ \t]} 1.0 +} {1.3} +test text-20.127 {TextSearchCmd, overlapping all matches} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde abcde" + list [.t2 search -regexp -all -overlap -count c -- {\w+} 1.0] $c +} {{1.0 1.6} {5 5}} +test text-20.127.1 {TextSearchCmd, non-overlapping all matches} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde abcde" + list [.t2 search -regexp -all -count c -- {\w+} 1.0] $c +} {{1.0 1.6} {5 5}} +test text-20.128 {TextSearchCmd, stop at end of line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde abcde" + list [.t2 search -backwards -regexp -all -count c -- {\w+} 1.0] $c +} {{1.6 1.0} {5 5}} +test text-20.129 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t2 search -backwards -regexp -count c -- {Z\w+} 1.21 1.5] $c +} {1.8 8} +test text-20.130 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t2 search -backwards -all -overlap -regexp -count c -- {Z\w+} 1.21 1.5] $c +} {1.8 8} +test text-20.130.1 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t2 search -backwards -all -regexp -count c -- {Z\w+} 1.21 1.5] $c +} {1.8 8} +test text-20.131 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t2 search -backwards -overlap -all -regexp -count c -- {Z\w+} 1.21 1.1] $c +} {1.4 12} +test text-20.131.1 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t2 search -backwards -overlap -all -regexp -count c -- {Z[^Z]+Z} 1.21 1.1] $c +} {{1.8 1.4} {5 5}} +test text-20.131.2 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t2 search -backwards -all -regexp -count c -- {Z\w+} 1.21 1.1] $c +} {1.4 12} +test text-20.132 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + .t2 insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t2 search -backwards -all -overlap -regexp -count c -- {Z\w+} 2.21 1.5] $c +} {{2.4 1.8} {12 8}} +test text-20.132.1 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + .t2 insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t2 search -backwards -all -regexp -count c -- {Z\w+} 2.21 1.5] $c +} {{2.4 1.8} {12 8}} +test text-20.133 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + .t2 insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t2 search -backwards -overlap -all -regexp -count c -- {Z\w+} 2.21 1.1] $c +} {{2.4 1.4} {12 12}} +test text-20.133.1 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + .t2 insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t2 search -backwards -all -regexp -count c -- {Z\w+} 2.21 1.1] $c +} {{2.4 1.4} {12 12}} +test text-20.134 {TextSearchCmd, search -all example} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 { See the package: supersearch for more information. @@ -5230,968 +2318,715 @@ 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 \ + list [.t2 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" +} {{3.8 6.8 8.0 11.8} {20 26 13 14}} +test text-20.135 {TextSearchCmd, backwards search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t2 search -backwards -regexp {fooba+rfoo} end +} {1.6} +test text-20.135.1 {TextSearchCmd, backwards search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t2 search -backwards -overlap -all -regexp {fooba+rfoo} end +} {1.6 1.0} +test text-20.135.2 {TextSearchCmd, backwards search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t2 search -backwards -all -regexp {fooba+rfoo} end +} {1.6} +test text-20.135.3 {TextSearchCmd, forwards search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t2 search -all -overlap -regexp {fooba+rfoo} end +} {1.0 1.6} +test text-20.135.4 {TextSearchCmd, forwards search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t2 search -all -regexp {fooba+rfoo} end +} {1.0} +test text-20.136 {TextSearchCmd, forward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abababab" + .t2 search -exact -overlap -all {abab} 1.0 +} {1.0 1.2 1.4} +test text-20.136.1 {TextSearchCmd, forward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abababab" + .t2 search -exact -all {abab} 1.0 +} {1.0 1.4} +test text-20.137 {TextSearchCmd, backward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "ababababab" + .t2 search -exact -overlap -backwards -all {abab} end +} {1.6 1.4 1.2 1.0} +test text-20.137.1 {TextSearchCmd, backward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "ababababab" + .t2 search -exact -backwards -all {abab} end +} {1.6 1.2} +test text-20.137.2 {TextSearchCmd, backward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abababababab" + .t2 search -exact -backwards -all {abab} end +} {1.8 1.4 1.0} +test text-20.138 {TextSearchCmd, forward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t2 search -exact -overlap -all "foo\nbar\nfoo" 1.0 +} {1.0 3.0 5.0} +test text-20.138.1 {TextSearchCmd, forward exact search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t2 search -exact -all "foo\nbar\nfoo" 1.0 +} {1.0 5.0} +test text-20.139 {TextSearchCmd, backward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t2 search -exact -overlap -backward -all "foo\nbar\nfoo" end +} {5.0 3.0 1.0} +test text-20.140 {TextSearchCmd, backward exact search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t2 search -exact -backward -all "foo\nbar\nfoo" end +} {5.0 1.0} +test text-20.141 {TextSearchCmd, backward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t2 search -regexp -backward -overlap -all "foo\nbar\nfoo" end +} {5.0 3.0 1.0} +test text-20.142 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t2 search -regexp -backward -all "foo\nbar\nfoo" end +} {5.0 1.0} +test text-20.142a {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -- {(\$)?[\w:_]+} 1.9 +} {1.7} +test text-20.143 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.5 +} {1.7} +test text-20.144 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.7 +} {1.7} +test text-20.145 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.8 +} {1.8} +test text-20.146 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -all -- {(\$)?[\w:_]+} 1.9 1.3 +} {1.7 1.3} +test text-20.147 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -all -- {(\$)?[\w:_]+} 1.9 1.13 +} {} +test text-20.148 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -all -- {(\$)?[\w:_]+} 2.0 1.3 +} {1.12 1.7 1.3} +test text-20.149 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -all -- {(\$)?[\w:_]+} 1.3 +} {1.1 1.12 1.7 1.3} +test text-20.150 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\n" + .t2 search -regexp -backward -all -- {(\w+\n)+} end +} {1.0} +test text-20.151 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\n" + .t2 search -regexp -backward -all -- {(\w+\n)+} end 1.5 +} {2.0} +test text-20.152 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + .t2 search -regexp -backward -all -- {(\w+\n\w)+} end 1.5 +} {2.0} +test text-20.153 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -all -count foo -- {(\w+\n)+} 1.0] $foo +} {1.0 20} +test text-20.154 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 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 \ + [list [.t2 search -regexp -all -count foo -- {(\w+\n)+} 1.0] $foo] \ + [list [.t2 search -regexp -all -count foo -- {(\w+)+} 1.0] $foo] +} {{1.0 20} {{1.0 2.0 3.0 4.0} {5 5 5 1}}} +test text-20.155 {TextSearchCmd, regexp search greedy} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -all -nolinestop -count foo -- {.*} 1.0] $foo +} {1.0 20} +test text-20.156 {TextSearchCmd, regexp search greedy} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -all -count foo -- {.*} 1.0] $foo +} {{1.0 2.0 3.0 4.0} {5 5 5 1}} +test text-20.157 {TextSearchCmd, regexp search greedy multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -count foo -- {(\w+\n\w)+} 1.0] $foo +} {1.0 19} +test text-20.158 {TextSearchCmd, regexp search greedy multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -backwards -count foo -- {(\w+\n\w)+} end] $foo +} {1.0 19} +test text-20.159 {TextSearchCmd, regexp search greedy multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -all -backwards -count foo -- {(\w+\n\w)+} end] $foo +} {1.0 19} +test text-20.160 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + .t2 search -regexp -backward -all -- {(\w+\n\w)+} end 1.5 +} {2.0} +test text-20.161 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + .t2 search -regexp -backward -all -- {(\w+\n\w)+} end 1.3 +} {1.3} +test text-20.162 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -forward -count foo -- {(\w+\n\w)+} 1.3] $foo +} {1.3 16} +test text-20.163 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 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. +} {{1.3 1.0} {16 19}} +test text-20.164 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -forward -all -count foo -- {(\w+\n\w)+} 1.0 1.3] $foo +} {1.0 19} +test text-20.165 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\naaaa\nbbbb\n" + list [.t2 search -regexp -forward -all -count foo -- {(a+\n(b+\n))+} 1.0] $foo +} {1.0 20} +test text-20.166 {TextSearchCmd, regexp search complex cases} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\naaaa\nbbbb\n" + list [.t2 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" +} {1.0 20} +test text-20.167 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" set foo {} - list [.t search -regexp -forward -all -count foo \ + list [.t2 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" +} {2.0 19} +test text-20.168 {TextSearchCmd, regexp search multi-line} {knownBug} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" set foo {} - list [.t search -regexp -forward -all -count foo \ + list [.t2 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" +} {2.0 19} +test text-20.169 {TextSearchCmd, regexp search multi-line} {knownBug} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" set foo {} - list [.t search -regexp -forward -all -count foo \ + list [.t2 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" +} {2.0 19} +test text-20.170 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" set foo {} - list [.t search -regexp -forward -all -count foo \ + list [.t2 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 \ +} {1.0 24} +test text-20.171 {TextSearchCmd, regexp search multi-line} {knownBug} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\nbbbb\nbbbb\nbbbb\n" + list [.t2 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] +} {1.0 25} +test text-20.172 {TextSearchCmd, regexp search multi-line} {knownBug} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\nbbbb\nbbbb\nbbbb\n" + .t2 search -regexp -backward -- {b+\n|a+\n(b+\n)+} end + # Should match at 1.0 for a true greedy match +} {1.0} +test text-20.172.1 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "line0\nline1\nline1\nline1\nline1\nline2\nline2\nline2\nline3\n" + .t2 search -nolinestop -regexp -nocase -forwards -- {^(.*)\n(\1\n)+} 1.0 end + # Matches at 6.0 currently +} {2.0} +test text-20.173 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "\naaaxxx\nyyy\n" 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] + lappend res [.t2 search -count c -regexp -- {x*\ny*} 2.0] $c + lappend res [.t2 search -count c -regexp -- {x*\ny*} 2.1] $c + set res +} {2.3 7 2.3 7} +test text-20.174 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "\naaa\n\n\n\n\nxxx\n" 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] + lappend res [.t2 search -count c -regexp -- {\n+} 2.0] $c + lappend res [.t2 search -count c -regexp -- {\n+} 2.1] $c + set res +} {2.3 5 2.3 5} +test text-20.175 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "\naaa\n\n\t \n\t\t\t \n\nxxx\n" 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] + lappend res [.t2 search -count c -regexp -- {(\n+(\t+ *)*)+} 2.0] $c + set res +} {2.3 13} +test text-20.176 {TextSearchCmd, empty search range} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\na\na\n" + .t2 search -- a 2.0 1.0 +} {} +test text-20.177 {TextSearchCmd, empty search range} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\na\na\n" + .t2 search -backwards -- a 1.0 2.0 +} {} +test text-20.178 {TextSearchCmd, empty search range} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\na\na\n" + .t2 search -- a 1.0 1.0 +} {} +test text-20.179 {TextSearchCmd, empty search range} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\na\na\n" + .t2 search -backwards -- a 2.0 2.0 +} {} +test text-20.180 {TextSearchCmd, elide up to match} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\nb\nc" + .t2 tag configure e -elide 1 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] + lappend res [.t2 search -regexp a 1.0] + lappend res [.t2 search -regexp b 1.0] + lappend res [.t2 search -regexp c 1.0] + .t2 tag add e 1.0 2.0 + lappend res [.t2 search -regexp a 1.0] + lappend res [.t2 search -regexp b 1.0] + lappend res [.t2 search -regexp c 1.0] + lappend res [.t2 search -elide -regexp a 1.0] + lappend res [.t2 search -elide -regexp b 1.0] + lappend res [.t2 search -elide -regexp c 1.0] +} {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-20.181 {TextSearchCmd, elide up to match, backwards} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\nb\nc" + .t2 tag configure e -elide 1 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] + lappend res [.t2 search -backward -regexp a 1.0] + lappend res [.t2 search -backward -regexp b 1.0] + lappend res [.t2 search -backward -regexp c 1.0] + .t2 tag add e 1.0 2.0 + lappend res [.t2 search -backward -regexp a 1.0] + lappend res [.t2 search -backward -regexp b 1.0] + lappend res [.t2 search -backward -regexp c 1.0] + lappend res [.t2 search -backward -elide -regexp a 1.0] + lappend res [.t2 search -backward -elide -regexp b 1.0] + lappend res [.t2 search -backward -elide -regexp c 1.0] +} {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-20.182 {TextSearchCmd, elide up to match} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\nb\nc" + .t2 tag configure e -elide 1 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] + lappend res [.t2 search a 1.0] + lappend res [.t2 search b 1.0] + lappend res [.t2 search c 1.0] + .t2 tag add e 1.0 2.0 + lappend res [.t2 search a 1.0] + lappend res [.t2 search b 1.0] + lappend res [.t2 search c 1.0] + lappend res [.t2 search -elide a 1.0] + lappend res [.t2 search -elide b 1.0] + lappend res [.t2 search -elide c 1.0] +} {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-20.183 {TextSearchCmd, elide up to match, backwards} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\nb\nc" + .t2 tag configure e -elide 1 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] + lappend res [.t2 search -backward a 1.0] + lappend res [.t2 search -backward b 1.0] + lappend res [.t2 search -backward c 1.0] + .t2 tag add e 1.0 2.0 + lappend res [.t2 search -backward a 1.0] + lappend res [.t2 search -backward b 1.0] + lappend res [.t2 search -backward c 1.0] + lappend res [.t2 search -backward -elide a 1.0] + lappend res [.t2 search -backward -elide b 1.0] + lappend res [.t2 search -backward -elide c 1.0] +} {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-20.184 {TextSearchCmd, elide up to match} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aa\nbb\ncc" + .t2 tag configure e -elide 1 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] + lappend res [.t2 search ab 1.0] + lappend res [.t2 search bc 1.0] + .t2 tag add e 1.1 2.1 + lappend res [.t2 search ab 1.0] + lappend res [.t2 search b 1.0] + .t2 tag remove e 1.0 end + .t2 tag add e 2.1 3.1 + lappend res [.t2 search bc 1.0] + lappend res [.t2 search c 1.0] + .t2 tag remove e 1.0 end + .t2 tag add e 2.1 3.0 + lappend res [.t2 search bc 1.0] + lappend res [.t2 search c 1.0] +} {{} {} 1.0 2.1 2.0 3.1 2.0 3.0} +test text-20.185 {TextSearchCmd, elide up to match} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aa\nbb\ncc" + .t2 tag configure e -elide 1 set res {} -} -body { - .t tag configure e -elide 0 - .t insert end A {} xyz e bb\n - .t insert end \u00c4 {} xyz e bb + lappend res [.t2 search -regexp ab 1.0] + lappend res [.t2 search -regexp bc 1.0] + .t2 tag add e 1.1 2.1 + lappend res [.t2 search -regexp ab 1.0] + lappend res [.t2 search -regexp b 1.0] + .t2 tag remove e 1.0 end + .t2 tag add e 2.1 3.1 + lappend res [.t2 search -regexp bc 1.0] + lappend res [.t2 search -regexp c 1.0] + .t2 tag remove e 1.0 end + .t2 tag add e 2.1 3.0 + lappend res [.t2 search -regexp bc 1.0] + lappend res [.t2 search -regexp c 1.0] +} {{} {} 1.0 2.1 2.0 3.1 2.0 3.0} +test text-20.185.1 {TextSearchCmd, elide up to match, with UTF-8 chars before the match} { + deleteWindows + pack [text .t2] + .t2 tag configure e -elide 0 + .t2 insert end A {} xyz e bb\n + .t2 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} + lappend res [.t2 search bb 1.0 "1.0 lineend"] + lappend res [.t2 search bb 2.0 "2.0 lineend"] + lappend res [.t2 search -regexp bb 1.0 "1.0 lineend"] + lappend res [.t2 search -regexp bb 2.0 "2.0 lineend"] + .t2 tag configure e -elide 1 + lappend res [.t2 search bb 1.0 "1.0 lineend"] + lappend res [.t2 search bb 2.0 "2.0 lineend"] + lappend res [.t2 search -regexp bb 1.0 "1.0 lineend"] + lappend res [.t2 search -regexp -elide bb 2.0 "2.0 lineend"] + lappend res [.t2 search -regexp bb 2.0 "2.0 lineend"] +} {1.4 2.4 1.4 2.4 1.4 2.4 1.4 2.4 2.4} +test text-20.186 {TextSearchCmd, strict limits} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -strictlimits -- "world" 1.3 1.8 +} {} +test text-20.187 {TextSearchCmd, strict limits} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -strictlimits -- "world" 1.3 1.10 +} {} +test text-20.188 {TextSearchCmd, strict limits} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -strictlimits -- "world" 1.3 1.11 +} {1.6} +test text-20.189 {TextSearchCmd, strict limits backwards} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -strictlimits -backward -- "world" 2.3 1.8 +} {} +test text-20.190 {TextSearchCmd, strict limits backwards} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -strictlimits -backward -- "world" 2.3 1.6 +} {1.6} +test text-20.191 {TextSearchCmd, strict limits backwards} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -strictlimits -backward -- "world" 2.3 1.7 +} {} +test text-20.192 {TextSearchCmd, strict limits} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -regexp -strictlimits -- "world" 1.3 1.8 +} {} +test text-20.193 {TextSearchCmd, strict limits} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -regexp -strictlimits -backward -- "world" 2.3 1.8 +} {} + +deleteWindows +text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 +pack .t2 +.t2 insert end "1\t2\t3\t4\t55.5" + +test text-21.1 {TkTextGetTabs procedure} { + list [catch {.t2 configure -tabs "\{{}"} msg] $msg +} {1 {unmatched open brace in list}} +test text-21.2 {TkTextGetTabs procedure} { + list [catch {.t2 configure -tabs xyz} msg] $msg +} {1 {bad screen distance "xyz"}} +test text-21.3 {TkTextGetTabs procedure} { + .t2 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} + list [lindex [.t2 bbox 1.2] 0] [lindex [.t2 bbox 1.4] 0] +} {100 200} +test text-21.4 {TkTextGetTabs procedure} { + .t2 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} + list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \ + [lindex [.t2 bbox 1.4] 0] \ + [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \ + [lindex [.t2 bbox 1.10] 0] +} {100 200 300 400} +test text-21.5 {TkTextGetTabs procedure} { + .t2 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" + list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \ + [lindex [.t2 bbox 1.4] 0] \ + [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \ + [lindex [.t2 bbox 1.10] 0] +} {105 205 305 405} +test text-21.6 {TkTextGetTabs procedure} { + list [catch {.t2 configure -tabs {100 left 200 lork}} msg] $msg +} {1 {bad tab alignment "lork": must be left, right, center, or numeric}} +test text-21.7 {TkTextGetTabs procedure} { + list [catch {.t2 configure -tabs {100 !44 200 lork}} msg] $msg +} {1 {bad screen distance "!44"}} + +deleteWindows +text .t +pack .t +.t insert 1.0 "One Line" +.t mark set insert 1.0 + +test text-22.1 {TextDumpCmd procedure, bad args} { + list [catch {.t dump} msg] $msg +} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}} +test text-22.2 {TextDumpCmd procedure, bad args} { + list [catch {.t dump -all} msg] $msg +} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}} +test text-22.3 {TextDumpCmd procedure, bad args} { + list [catch {.t dump -command} msg] $msg +} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}} +test text-22.4 {TextDumpCmd procedure, bad args} { + list [catch {.t dump -bogus} msg] $msg +} {1 {bad option "-bogus": must be -all, -command, -image, -mark, -tag, -text, or -window}} +test text-22.5 {TextDumpCmd procedure, bad args} { + list [catch {.t dump bogus} msg] $msg +} {1 {bad text index "bogus"}} +test text-22.6 {TextDumpCmd procedure, one index} { .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" +} {text e 1.2} +test text-22.7 {TextDumpCmd procedure, two indices} { .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" +} {text {One Line} 1.0} +test text-22.8 {TextDumpCmd procedure, "end" index} { .t dump -text 1.end end -} -cleanup { - destroy .t -} -result {text { +} {text { } 1.8} -test text-24.9 {TextDumpCmd procedure, same indices} -body { - pack [text .t] - .t insert 1.0 "One Line" +test text-22.9 {TextDumpCmd procedure, same indices} { .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 +} {} +test text-22.10 {TextDumpCmd procedure, negative range} { .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 delete 1.0 end +.t insert end "Line One\nLine Two\nLine Three\nLine Four" +.t mark set insert 1.0 +.t mark set current 1.0 +test text-22.11 {TextDumpCmd procedure, stop at begin-line} { .t dump -text 1.0 2.0 -} -cleanup { - destroy .t -} -result {text {Line One +} {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" +test text-22.12 {TextDumpCmd procedure, span multiple lines} { .t dump -text 1.5 3.end -} -cleanup { - destroy .t -} -result {text {One +} {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 tag add x 2.0 2.end +.t tag add y 1.0 end +.t mark set m 2.4 +.t mark set n 4.0 +.t mark set END end +test text-22.13 {TextDumpCmd procedure, tags only} { .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 +} {} +test text-22.14 {TextDumpCmd procedure, tags only} { .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 +} {tagon x 2.0} +test text-22.15 {TextDumpCmd procedure, tags only} { .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 +} {tagon y 1.0 tagon x 2.0 tagoff x 2.8} +test text-22.16 {TextDumpCmd procedure, tags only} { .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 +} {tagon y 1.0 tagon x 2.0 tagoff x 2.8 tagoff y 5.0} +.t mark set insert 1.0 +.t mark set current 1.0 +test text-22.17 {TextDumpCmd procedure, marks only} { .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 +} {} +test text-22.18 {TextDumpCmd procedure, marks only} { .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 +} {mark m 2.4} +test text-22.19 {TextDumpCmd procedure, marks only} { .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 +} {mark m 2.4 mark n 4.0} +test text-22.20 {TextDumpCmd procedure, marks only} { .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 { } +} {mark current 1.0 mark insert 1.0 mark m 2.4 mark n 4.0 mark END 5.0} +button .hello -text Hello +.t window create 3.end -window .hello +for {set i 0} {$i < 100} {incr i} { + .t insert end "-\n" +} +.t window create 100.0 -create { } +test text-22.21 {TextDumpCmd procedure, windows only} { .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 { } +} {window .hello 3.10} +test text-22.22 {TextDumpCmd procedure, windows only} { .t dump -window 5.0 end -} -cleanup { - destroy .t -} -result {window {} 100.0} -test text-24.23 {TextDumpCmd procedure, command script} -setup { +} {window {} 100.0} +.t delete 1.0 end +eval {.t mark unset} [.t mark names] +.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 +proc Append {varName key value index} { + upvar #0 $varName x + lappend x $key $index $value +} +test text-22.23 {TextDumpCmd procedure, command script} { 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 + set x +} {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 { +test text-22.24 {TextDumpCmd procedure, command script} { 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 { + set x +} {mark 1.0 current mark 1.0 insert mark 2.4 m} +catch {unset x} +test text-22.25 {TextDumpCmd procedure, unicode characters} { + catch {destroy .t} text .t + .t delete 1.0 end .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 \xb1\xb1\xb1 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3" +test text-22.26 {TextDumpCmd procedure, unicode characters} { + catch {destroy .t} text .t .t delete 1.0 end .t insert 1.0 abc\xb1\xb1\xb1 .t dump -all 1.0 2.0 -} -cleanup { +} "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6" +test text-22.27 {TextDumpCmd procedure, peer present} -setup { 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 { +} -body { text .t .t peer create .t.t .t dump -all 1.0 end @@ -6199,18 +3034,21 @@ test text-24.27 {TextDumpCmd procedure, peer present} -body { 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 { +set l [interp hidden] +deleteWindows + +test text-23.1 {text widget vs hidden commands} { + catch {destroy .t} 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} - + list [winfo children .] [interp hidden] +} [list {} $l] -test text-26.1 {bug fix - 1642} -body { - pack [text .t] +test text-24.1 {bug fix - 1642} { + catch {destroy .t} + text .t + pack .t .t insert end "line 1\n" .t insert end "line 2\n" .t insert end "line 3\n" @@ -6218,24 +3056,16 @@ test text-26.1 {bug fix - 1642} -body { .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 { +} {2.6} + +test text-25.1 {TextEditCmd procedure, argument parsing} { + list [catch {.t edit} msg] $msg +} {1 {wrong # args: should be ".t edit option ?arg arg ...?"}} +test text-25.2 {TextEditCmd procedure, argument parsing} { + list [catch {.t edit gorp} msg] $msg +} {1 {bad edit option "gorp": must be modified, redo, reset, separator, or undo}} +test text-25.3 {TextEditUndo procedure, undoing changes} { + catch {destroy .t} text .t -undo 1 pack .t .t insert end "line 1\n" @@ -6243,10 +3073,9 @@ test text-27.3 {TextEditUndo procedure, undoing changes} -body { .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 { +} "line\n\n" +test text-25.4 {TextEditRedo procedure, redoing changes} { + catch {destroy .t} text .t -undo 1 pack .t .t insert end "line 1\n" @@ -6255,10 +3084,9 @@ test text-27.4 {TextEditRedo procedure, redoing changes} -body { .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 { +} "line\nshould be back after redo\n\n" +test text-25.5 {TextEditUndo procedure, resetting stack} { + catch {destroy .t} text .t -undo 1 pack .t .t insert end "line 1\n" @@ -6266,11 +3094,10 @@ test text-27.5 {TextEditUndo procedure, resetting stack} -body { .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 { + set msg +} "nothing to undo" +test text-25.6 {TextEditCmd procedure, insert separator} { + catch {destroy .t} text .t -undo 1 pack .t .t insert end "line 1\n" @@ -6278,10 +3105,9 @@ test text-27.6 {TextEditCmd procedure, insert separator} -body { .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 { +} "line 1\n\n" +test text-25.7 {-autoseparators configuration option} { + catch {destroy .t} text .t -undo 1 -autoseparators 0 pack .t .t insert end "line 1\n" @@ -6289,115 +3115,87 @@ test text-27.7 {-autoseparators configuration option} -body { .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 { +} "\n" +test text-25.8 {TextEditCmd procedure, modified flag} { + catch {destroy .t} 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 { +} {1} +test text-25.9 {TextEditCmd procedure, reset modified flag} { + catch {destroy .t} 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 { +} {0} +test text-25.10 {TextEditCmd procedure, set modified flag} { + catch {destroy .t} 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 { +} {1} +test text-25.10.1 {TextEditCmd procedure, set modified flag repeat} { + catch {destroy .t} text .t pack .t set ::retval {} -} -body { bind .t <<Modified>> "lappend ::retval modified" -# Shouldn't require [update idle] to trigger event [Bug 1809538] + # Shouldn't require [update idle] to trigger event [Bug 1809538] lappend ::retval [.t edit modified] .t edit modified 1 - update + update idletasks 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 { +} {0 modified 1 1} +test text-25.11 {<<Modified>> virtual event} { set ::retval unmodified + catch {destroy .t} 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 +} {modified} +test text-25.11.1 {<<Modified>> virtual event - insert before Modified} { set ::retval {} + destroy .t 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 +} {nothing special} +test text-25.11.2 {<<Modified>> virtual event - delete before Modified} { + # Bug 1737288, make sure we delete chars before triggering <<Modified>> set ::retval {} + destroy .t 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 { +} {thing special} +test text-25.12 {<<Selection>> virtual event} { set ::retval no_selection - pack [text .t -undo 1] + catch {destroy .t} + text .t -undo 1 + pack .t 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 { +} {selection_changed} +test text-25.13 {-maxundo configuration option} { + catch {destroy .t} text .t -undo 1 -autoseparators 1 -maxundo 2 pack .t .t insert end "line 1\n" @@ -6407,50 +3205,17 @@ test text-27.16 {-maxundo configuration option} -body { 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 { +} "line 1\n\n" +test text-25.15 {bug fix 1536735 - undo with empty text} { + catch {destroy .t} text .t -undo 1 set r [.t edit modified] .t delete 1.0 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 { +} {0 0 1 0} +test text-25.18 {patch 1469210 - inserting after undo} -setup { destroy .t } -body { text .t -undo 1 @@ -6462,7 +3227,7 @@ test text-27.18 {patch 1469210 - inserting after undo} -setup { } -cleanup { destroy .t } -result 1 -test text-27.19 {patch 1669632 (i) - undo after <Control-1>} -setup { +test text-25.19 {patch 1669632 (i) - undo after <Control-1>} -setup { destroy .t } -body { text .t -undo 1 @@ -6476,8 +3241,8 @@ test text-27.19 {patch 1669632 (i) - undo after <Control-1>} -setup { } -cleanup { destroy .t } -result WORLD -test text-27.20 {patch 1669632 (iv) - undo after <<SelectNone>>} -setup { - destroy .top .top.t +test text-25.20 {patch 1669632 (iv) - undo after <Control-backslash>} -setup { + destroy .t } -body { toplevel .top pack [text .top.t -undo 1] @@ -6488,14 +3253,14 @@ test text-27.20 {patch 1669632 (iv) - undo after <<SelectNone>>} -setup { .top.t tag add sel 1.10 1.12 update focus -force .top.t - event generate .top.t <<SelectNone>> + event generate .top.t <Control-backslash> .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 { +test text-25.21 {patch 1669632 (vii) - <<Undo>> shall not remove separators} -setup { destroy .t } -body { text .t -undo 1 @@ -6511,7 +3276,7 @@ test text-27.21 {patch 1669632 (vii) - <<Undo>> shall not remove separators} -se } -cleanup { destroy .t } -result "This WORLD is an example text" -test text-27.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { +test text-25.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { destroy .t } -body { toplevel .top @@ -6523,7 +3288,7 @@ test text-27.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { update focus -force .top.t event generate .top.t <Delete> - event generate .top.t <<SelectNextChar>> + event generate .top.t <Shift-Right> event generate .top.t <<Clear>> event generate .top.t <Delete> event generate .top.t <<Undo>> @@ -6531,7 +3296,7 @@ test text-27.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { } -cleanup { destroy .top.t .top } -result "This A an example text" - test text-27.23 {patch 1669632 (v) - <<Cut>> is atomic} -setup { + test text-25.23 {patch 1669632 (v) - <<Cut>> is atomic} -setup { destroy .t } -body { toplevel .top @@ -6543,7 +3308,7 @@ test text-27.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { update focus -force .top.t event generate .top.t <Delete> - event generate .top.t <<SelectNextChar>> + event generate .top.t <Shift-Right> event generate .top.t <<Cut>> event generate .top.t <Delete> event generate .top.t <<Undo>> @@ -6551,345 +3316,247 @@ test text-27.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { } -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 { +test text-26.1 {bug fix - 624372, ControlUtfProc long lines} { + destroy .t 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 { +test text-27.1 {tabs - must be positive and must be increasing} { + destroy .t pack [text .t -wrap none] - .t configure -tabs {0} -} -cleanup { + list [catch {.t configure -tabs {0}} msg] $msg +} {1 {tab stop "0" is not at a positive distance}} +test text-27.2 {tabs - must be positive and must be increasing} { 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 { + list [catch {.t configure -tabs {-5}} msg] $msg +} {1 {tab stop "-5" is not at a positive distance}} +test text-27.3 {tabs - must be positive and must be increasing} {knownBug} { + # This bug will be fixed in Tk 9.0, when we can allow a minor + # incompatibility with Tk 8.x 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 { + list [catch {.t configure -tabs {10c 5c}} msg] $msg +} {1 {tabs must be monotonically increasing, but "5c" is smaller than or equal to the previous tab}} +test text-27.4 {tabs - must be positive and must be increasing} { 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 + # This test must simply not go into an infinite loop 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 +} {1} + +test text-28.0 {repeated insert and scroll} { + foreach subcmd { + {moveto 1} + {scroll 1 pages} + {scroll 100 pixels} + {scroll 10 units} + } { + destroy .t + pack [text .t] + for {set i 0} {$i < 30} {incr i} { + .t insert end "blabla\n" + eval .t yview $subcmd + } } -# This test must simply not crash to succeed + # 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} +} {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 +test text-29.0 {peer widgets} { + destroy .t .tt + toplevel .tt pack [text .t] - pack [.t peer create .top1.t] - pack [.t peer create .top2.t] + pack [.t peer create .tt.t] + destroy .t .tt +} {} +test text-29.1 {peer widgets} { + destroy .t .t1 .t2 + toplevel .t1 + toplevel .t2 + pack [text .t] + pack [.t peer create .t1.t] + pack [.t peer create .t2.t] .t insert end "abcd\nabcd" update - destroy .top1 + destroy .t1 update .t insert end "abcd\nabcd" update - destroy .t .top2 + destroy .t .t2 update -} -result {} -test text-31.3 {peer widgets} -body { - toplevel .top1 - toplevel .top2 +} {} +test text-29.2 {peer widgets} { + destroy .t .t1 .t2 + toplevel .t1 + toplevel .t2 pack [text .t] - pack [.t peer create .top1.t] - pack [.t peer create .top2.t] + pack [.t peer create .t1.t] + pack [.t peer create .t2.t] .t insert end "abcd\nabcd" update destroy .t update - .top2.t insert end "abcd\nabcd" + .t2.t insert end "abcd\nabcd" update - destroy .t .top2 + destroy .t .t2 update -} -result {} -test text-31.4 {peer widgets} -body { - toplevel .top +} {} +test text-29.3 {peer widgets} { + destroy .t .tt + toplevel .tt pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - pack [.t peer create .top.t -start 5 -end 11] + pack [.t peer create .tt.t -start 5 -end 11] update - destroy .t .top -} -result {} -test text-31.5 {peer widgets} -body { - toplevel .top + destroy .t .tt +} {} +test text-29.4 {peer widgets} { + destroy .t .tt + toplevel .tt pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .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]] + pack [.t peer create .tt.t -start 5 -end 11] + pack [.tt.t peer create .tt.t2] + set res [list [.tt.t index end] [.tt.t2 index end]] update - return $res -} -cleanup { - destroy .t .top -} -result {7.0 7.0} -test text-31.6 {peer widgets} -body { - toplevel .top + destroy .t .tt + set res +} {7.0 7.0} +test text-29.4.1 {peer widgets} { + destroy .t .tt + toplevel .tt pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .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]] + pack [.t peer create .tt.t -start 5 -end 11] + pack [.tt.t peer create .tt.t2 -start {} -end {}] + set res [list [.tt.t index end] [.tt.t2 index end]] update - return $res -} -cleanup { - destroy .t .top -} -result {7.0 21.0} -test text-31.7 {peer widgets} -body { - toplevel .top + destroy .t .tt + set res +} {7.0 21.0} +test text-29.5 {peer widgets} { + destroy .t .tt + toplevel .tt pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - pack [.t peer create .top.t -start 5 -end 11] + pack [.t peer create .tt.t -start 5 -end 11] update ; update - set p1 [.top.t count -update -ypixels 1.0 end] + set p1 [.tt.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 + if {$p1 == $p2} { + set res "ok" + } else { + set res "$p1 and $p2 not equal" + } + destroy .t .tt + set res +} {ok} +test text-29.6 {peer widgets} { + destroy .t .tt + toplevel .tt pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - pack [.t peer create .top.t -start 5 -end 11] + pack [.t peer create .tt.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 + set res [.tt.t index end] + destroy .t .tt + set res +} {6.0} +test text-29.7 {peer widgets} { + destroy .t .tt + toplevel .tt pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - pack [.t peer create .top.t -start 5 -end 11] + pack [.t peer create .tt.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 + set res [.tt.t index end] + destroy .t .tt + set res +} {4.0} +test text-29.8 {peer widgets} { + destroy .t .tt + toplevel .tt pack [text .t] - for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + 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 [.t peer create .tt.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 { + set res [.tt.t index end] + destroy .t .tt + set res +} {1.0} +test text-29.9 {peer widgets} { + destroy .t pack [text .t] - set res {} -} -body { for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } .t tag add sel 1.0 end-1c + set res {} 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 { + set res +} {{1.0 100.0} {1.0 11.0}} +test text-29.10 {peer widgets} { + destroy .t pack [text .t] - set res {} -} -body { for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } .t tag add sel 1.0 end-1c + set res {} 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 { + set res +} {{1.0 100.0} {1.0 90.0}} +test text-29.11 {peer widgets} { + destroy .t pack [text .t] - set res {} -} -body { for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } .t tag add sel 1.0 end-1c + set res {} lappend res [.t tag ranges sel] .t configure -end 90 lappend res [.t tag ranges sel] destroy .t - return $res -} -cleanup { + set res +} {{1.0 100.0} {1.0 90.0}} +test text-29.12 {peer widgets} { 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 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 + set res {} lappend res [.t tag prevrange sel 1.0] .t configure -start 6 -end 12 lappend res [.t tag ranges sel] @@ -6899,18 +3566,17 @@ test text-31.14 {peer widgets} -setup { 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 { + set res +} {{} {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-29.13 {peer widgets} { + destroy .t pack [text .t] - set res {} -} -body { for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .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 + set res {} .t configure -start 6 -end 12 lappend res [.t tag ranges sel] lappend res "next" [.t tag nextrange sel 4.0] \ @@ -6919,18 +3585,17 @@ test text-31.15 {peer widgets} -setup { 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 { + set res +} {{4.0 6.0} next {4.0 6.0} {} {} {} prev {} {} {} {}} +test text-29.14 {peer widgets} { + destroy .t 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 + set res {} .t configure -start 6 -end 12 lappend res [.t tag ranges sel] lappend res "next" [.t tag nextrange sel 4.0] \ @@ -6939,17 +3604,16 @@ test text-31.16 {peer widgets} -setup { 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 { + set res +} {{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-29.15 {peer widgets} { + destroy .t pack [text .t] - set res {} -} -body { for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } + set res {} .t tag add sel 1.0 11.0 lappend res [.t tag ranges sel] lappend res [catch {.t configure -start 15 -end 10}] @@ -6958,61 +3622,58 @@ test text-31.17 {peer widgets} -setup { 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 { + set res +} {{1.0 11.0} 1 {1.0 11.0} {1.0 6.0} {1.0 11.0}} +test text-29.16 {peer widgets} { + destroy .t pack [text .t] - set res {} -} -body { for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } + set res {} .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 { + set res +} {1.0 11.0} +test text-29.17 {peer widgets} { + destroy .t pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } + set res {} .t tag delete sel - .t index sel.first -} -cleanup { + set res [list [catch {.t index sel.first} msg] $msg] destroy .t -} -returnCodes {error} -result {text doesn't contain any characters tagged with "sel"} - + set res +} {1 {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 +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 " } -} -body { + return $t +} + +test text-30.1 {line heights on creation} { set w [makeText] update ; after 1000 ; update set before [$w count -ypixels 1.0 2.0] @@ -7020,88 +3681,63 @@ test text-32.1 {line heights on creation} -setup { 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 { + if {$before != $after} { + set res "Count changed: $before $after" + } else { + set res "ok" + } +} {ok} + +destroy .t +text .t +test text-31.1 {TextWidgetCmd procedure, "peer" option} { + list [catch {.t peer foo 1} msg] $msg +} {1 {bad peer option "foo": must be create or names}} +test text-31.2 {TextWidgetCmd procedure, "peer" option} { + list [catch {.t peer names foo} msg] $msg +} {1 {wrong # args: should be ".t peer names"}} +test text-31.3 {TextWidgetCmd procedure, "peer" option} { + list [catch {.t p names} msg] $msg +} {0 {}} +test text-31.4 {TextWidgetCmd procedure, "peer" option} { .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 { +} {} +test text-31.5 {TextWidgetCmd procedure, "peer" option} { + list [catch {.t peer create foo} msg] $msg +} {1 {bad window path name "foo"}} +test text-31.6 {TextWidgetCmd procedure, "peer" option} { .t peer create .t2 + set res {} 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 +} {.t2 .t {}} +test text-31.7 {peer widget -start, -end} { + set res [list [catch {.t configure -start 10 -end 5} msg] $msg] + .t configure -start {} -end {} + set res +} {0 {}} +test text-31.8 {peer widget -start, -end} { + .t delete 1.0 end for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .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 + list [catch {.t configure -start 10 -end 5} msg] $msg +} {1 {-startline must be less than or equal to -endline}} +test text-31.9 {peer widget -start, -end} { + .t delete 1.0 end 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 + set res [list [catch {.t configure -start 5 -end 10} msg] $msg] + .t configure -start {} -end {} + set res +} {0 {}} +test text-31.10 {peer widget -start, -end} { + .t delete 1.0 end for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } set res [.t index end] lappend res [catch {.t configure -start 5 -end 10 -tab foo}] @@ -7110,14 +3746,12 @@ test text-33.10 {peer widget -start, -end} -body { 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 + set res +} {101.0 1 101.0 1 101.0 101.0} +test text-31.11 {peer widget -start, -end} { + .t delete 1.0 end for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } set res [.t index end] lappend res [catch {.t configure -start 5 -end 15}] @@ -7126,19 +3760,16 @@ test text-33.11 {peer widget -start, -end} -body { 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} + set res +} {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 { +test text-32.1 {peer widget -start, -end and selection} { + .t delete 1.0 end for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } .t tag add sel 10.0 20.0 + set res {} lappend res [.t tag ranges sel] .t configure -start 5 -end 30 lappend res [.t tag ranges sel] @@ -7152,10 +3783,8 @@ test text-34.1 {peer widget -start, -end and selection} -setup { 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}} + set res +} {{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 @@ -7248,52 +3877,45 @@ test text-32.4 {peer widget -start, -end and deletion (bug 1630262)} -setup { .t delete 3.0 18.0 lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] } -cleanup { - destroy .pt .t + destroy .pt } -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 { +test text-33.1 {widget dump -command alters tags} { + .t delete 1.0 end .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c .t tag configure b -background red + proc Dumpy {key value index} { + #puts "KK: $key, $value" + .t tag add $value [list $index linestart] [list $index lineend] + } .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 { +} {ok} +test text-33.2 {widget dump -command makes massive changes} { + .t delete 1.0 end + .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c + .t tag configure b -background red proc Dumpy {key value index} { -#puts "KK: $key, $value" + #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 { +} {ok} +test text-33.3 {widget dump -command destroys widget} { + .t delete 1.0 end .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c .t tag configure b -background red + proc Dumpy {key value index} { + #puts "KK: $key, $value" + destroy .t + } .t dump -all -command Dumpy 1.0 end set result "ok" -} -cleanup { - destroy .t -} -result {ok} +} {ok} +deleteWindows +option clear test text-36.1 "bug #1777362: event handling with hyphenated windows" -setup { proc bgerror {m} {set ::my_error $m} @@ -7308,6 +3930,7 @@ test text-36.1 "bug #1777362: event handling with hyphenated windows" -setup { } -cleanup { destroy .t-1 } -result {} + test text-36.2 "bug #1777362: event handling with hyphenated windows" -setup { proc bgerror {m} {set ::my_error $m} set ::my_error {} @@ -7321,6 +3944,7 @@ test text-36.2 "bug #1777362: event handling with hyphenated windows" -setup { } -cleanup { destroy $w } -result {} + test text-36.3 "bug #1777362: event handling with hyphenated windows" -setup { proc bgerror {m} {set ::my_error $m} set ::my_error {} @@ -7334,11 +3958,7 @@ test text-36.3 "bug #1777362: event handling with hyphenated windows" -setup { } -cleanup { destroy $w } -result {} - + # cleanup cleanupTests return - -# Local Variables: -# mode: tcl -# End: |