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