# 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 } -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 } -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 =, >, 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-8.28 {TextWidgetCmd procedure, "replace" option crash} -setup { text .tt } -body { .tt insert end "foo\n" .tt tag add sel 1.0 end .tt replace sel.first sel.last "bar" } -cleanup { destroy .tt } -result {} test text-9.1 {TextWidgetCmd procedure, "get" option} -setup { text .t } -body { .t get } -cleanup { destroy .t } -returnCodes {error} -result {wrong # args: should be ".t get ?-displaychars? ?--? index1 ?index2 ...?"} test text-9.2 {TextWidgetCmd procedure, "get" option} -setup { text .t } -body { .t get a b c } -cleanup { destroy .t } -returnCodes {error} -result {bad text index "a"} test text-9.3 {TextWidgetCmd procedure, "get" option} -setup { text .t } -body { .t get @q 3.1 } -cleanup { destroy .t } -returnCodes {error} -result {bad text index "@q"} test text-9.4 {TextWidgetCmd procedure, "get" option} -setup { text .t } -body { .t get 3.1 @r } -cleanup { destroy .t } -returnCodes {error} -result {bad text index "@r"} test text-9.5 {TextWidgetCmd procedure, "get" option} -setup { text .t } -body { .t insert 1.0 "Line 1 aefghijklm 12345 Line 4 bOy GIrl .#@? x_yz !@#$% Line 7" .t 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] update 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] update set content {} # Use long lines so the line metrics will need updating. for {set i 1} {$i < 30} {incr i} { append content [string repeat "$i " 200] \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] update 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] ; # {1} .top.yt sync -command [list set ::x 1] lappend res $::x ; # {1 0} # now finish line metrics calculations while {[.top.yt pendingsync]} {update} lappend res [.top.yt pendingsync] $::x ; # {1 0 0 1} # second case: line metrics calculation completed when launching 'sync -command' .top.yt sync -command [list set ::x 2] lappend res $::x ; # {1 0 0 1 1} vwait ::x lappend res $::x ; # {1 0 0 1 1 2} } -cleanup { destroy .top.yt .top } -result {1 0 0 1 1 2} test text-11a.31 {"<>" event} -setup { destroy .top.yt .top } -body { toplevel .top pack [text .top.yt] update set content {} for {set i 1} {$i < 300} {incr i} { append content [string repeat "$i " 15] \n } # Sync the widget and process <> events before binding. .top.yt sync update bind .top.yt <> { if {%d} {set yud(%W) 1} } .top.yt insert 1.0 $content .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 verify that the fractions agree. 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 <>} -setup { destroy .top.yt .top } -body { toplevel .top pack [text .top.yt] update set content {} for {set i 1} {$i < 300} {incr i} { append content [string repeat "$i " 50] \n } # Sync the widget and process all <> events before binding. .top.yt sync update bind .top.yt <> {lappend res Sync:%d} set res {} # The next line triggers <> with %d==0 i.e. out of sync. .top.yt insert 1.0 $content vwait res # Verify that the line metrics are not up-to-date (pendingsync is 1). lappend res "Pending:[.top.yt pendingsync]" # Update all line metrics by calling the sync command. .top.yt sync # <> should fire with %d==1 i.e. back in sync. vwait res # At this time the line metrics should be up-to-date (pendingsync is 0). 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 {<> calls TkSendVirtualEvent(), NOT Tk_HandleEvent(). Bug [b362182e45704dd7bbd6aed91e48122035ea3d16]} -setup { destroy .top.t .top } -body { set res {} toplevel .top pack [text .top.t] update for {set i 1} {$i < 10000} {incr i} { .top.t insert end "Hello world!\n" } bind .top.t <> {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. # On macOS, however, there is no way to make the window overlap the menubar. if {[tk windowingsystem] == "aqua"} { set minY 23 } else { set minY 0 } 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+$minY update wm geometry .top } -cleanup { destroy .top } -result "20x10+0+$minY" # 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. # On macOS we again use minY as a workaround. 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+$minY 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+$minY 15x8+0+$minY 15x8+0+$minY" 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} -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} -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} -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} -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 } -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-22.226 {TextSearchCmd, exact search for the empty string} -body { text .t set res [.t search -count C "" 1.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {1.0 0} test text-22.227 {TextSearchCmd, exact search for the empty string} -body { text .t .t insert end "Searching for the\nempty string!" set res [.t search -count C "" 2.5] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {2.5 0} test text-22.228 {TextSearchCmd, exact search all empty strings} -body { text .t set res [.t search -count C -all "" 1.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {1.0 0} test text-22.229 {TextSearchCmd, exact search all empty strings} -body { text .t .t insert end "Searching for the\nempty string!" set res [.t search -count C -all "" 2.5 2.8] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {2.5 2.6 2.7 {0 0 0}} test text-22.230 {TextSearchCmd, exact search all empty strings, with overlap} -body { text .t set res [.t search -count C -all -overlap "" 1.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {1.0 0} test text-22.231 {TextSearchCmd, exact search all empty strings, with overlap} -body { text .t .t insert end "Searching for the\nempty string!" set res [.t search -count C -all -overlap "" 2.5 2.8] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {2.5 2.6 2.7 {0 0 0}} test text-22.232 {TextSearchCmd, regexp search for the empty string} -body { text .t set res [.t search -count C -regexp "" 1.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {1.0 0} test text-22.233 {TextSearchCmd, regexp search for the empty string} -body { text .t .t insert end "Searching for the\nempty string!" set res [.t search -count C -regexp "" 2.5] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {2.5 0} test text-22.234 {TextSearchCmd, regexp search all empty strings} -body { text .t set res [.t search -count C -all -regexp "" 1.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {1.0 0} test text-22.235 {TextSearchCmd, regexp search all empty strings} -body { text .t .t insert end "Searching for the\nempty string!" set res [.t search -count C -all -regexp "" 2.5 2.8] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {2.5 2.6 2.7 {0 0 0}} test text-22.236 {TextSearchCmd, regexp search all empty strings, with overlap} -body { text .t set res [.t search -count C -all -regexp -overlap "" 1.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {1.0 0} test text-22.237 {TextSearchCmd, regexp search all empty strings, with overlap} -body { text .t .t insert end "Searching for the\nempty string!" set res [.t search -count C -all -regexp -overlap "" 2.5 2.8] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {2.5 2.6 2.7 {0 0 0}} test text-22.238 {TextSearchCmd, exact backwards search for the empty string} -body { text .t set res [.t search -count C -backwards "" 1.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {1.0 0} test text-22.239 {TextSearchCmd, exact backwards search for the empty string} -body { text .t .t insert end "Searching for the\nempty string!" set res [.t search -count C -backwards "" 2.5] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {2.4 0} test text-22.240 {TextSearchCmd, exact backwards search all empty strings} -body { text .t set res [.t search -count C -backwards -all "" 1.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {1.0 0} test text-22.241 {TextSearchCmd, exact backwards search all empty strings} -body { text .t .t insert end "Searching for the\nempty string!" set res [.t search -count C -backwards -all "" 2.5 2.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {2.4 2.3 2.2 2.1 2.0 {0 0 0 0 0}} test text-22.242 {TextSearchCmd, exact backwards search all empty strings, with overlap} -body { text .t set res [.t search -count C -backwards -all -overlap "" 1.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {1.0 0} test text-22.243 {TextSearchCmd, exact backwards search all empty strings, with overlap} -body { text .t .t insert end "Searching for the\nempty string!" set res [.t search -count C -backwards -all -overlap "" 2.5 2.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {2.4 2.3 2.2 2.1 2.0 {0 0 0 0 0}} test text-22.244 {TextSearchCmd, regexp backwards search for the empty string} -body { text .t set res [.t search -count C -backwards -regexp "" 1.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {1.0 0} test text-22.245 {TextSearchCmd, regexpbackwards search for the empty string} -body { text .t .t insert end "Searching for the\nempty string!" set res [.t search -count C -backwards -regexp "" 2.5] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {2.4 0} test text-22.246 {TextSearchCmd, regexp backwards search all empty strings} -body { text .t set res [.t search -count C -backwards -all -regexp "" 1.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {1.0 0} test text-22.247 {TextSearchCmd, regexp backwards search all empty strings} -body { text .t .t insert end "Searching for the\nempty string!" set res [.t search -count C -backwards -all -regexp "" 2.5 2.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {2.4 2.3 2.2 2.1 2.0 {0 0 0 0 0}} test text-22.248 {TextSearchCmd, regexp backwards search all empty strings, with overlap} -body { text .t set res [.t search -count C -backwards -all -regexp -overlap "" 1.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {1.0 0} test text-22.249 {TextSearchCmd, regexp backwards search all empty strings, with overlap} -body { text .t .t insert end "Searching for the\nempty string!" set res [.t search -count C -backwards -all -regexp -overlap "" 2.5 2.0] lappend res $C } -cleanup { destroy .t unset -nocomplain res C } -result {2.4 2.3 2.2 2.1 2.0 {0 0 0 0 0}} test text-22.250 {TextSearchCmd, backwards search all matching at start of line} -body { text .t .t insert end "abc" set res [.t search -backwards -all b end] ; # works lappend res [.t search -backwards a end] ; # works lappend res [.t search -backwards -all a end] ; # used to hang } -cleanup { destroy .t } -result {1.1 1.0 1.0} 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 # Make sure the Text is mapped before we start update set ::retval {} } -body { bind .t <> "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 {<> virtual event} -body { set ::retval unmodified text .t -undo 1 pack .t bind .t <> "set ::retval modified" update idletasks .t insert end "nothing special\n" update return $::retval } -cleanup { destroy .t } -result {modified} test text-27.13 {<> virtual event - insert before Modified} -body { set ::retval {} pack [text .t -undo 1] bind .t <> { 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 {<> virtual event - delete before Modified} -body { # Bug 1737288, make sure we delete chars before triggering <> set ::retval {} pack [text .t -undo 1] bind .t <> { 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 {<> virtual event - propagation to peers} -body { # Bug [fd3a4dc111], <> event is not always sent to peers set ::retval 0 text .t -undo 1 .t peer create .tt pack .t .tt bind .t <> {incr ::retval} bind .tt <> {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 {<> virtual event on sel tagging} -body { set ::retval no_selection pack [text .t] bind .t <> "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.15a {<> virtual event on sel removal} -body { set ::retval no_selection pack [text .t] .t insert end "nothing special\n" .t tag add sel 1.0 1.1 bind .t <> "set ::retval selection_changed" update idletasks .t tag remove 1.0 end update set ::retval } -cleanup { destroy .t } -result {selection_changed} test text-27.15b {<> virtual event on <> inside widget selection} -body { pack [text .t] .t insert end "There is a selection in this text widget,\n" .t insert end "and it will be impacted by the <> event received.\n" .t insert end "Therefore a <> event must fire back." .t tag add sel 1.0 1.28 bind .t <> "set ::retval <>_fired" update set ::retval no_<>_event_fired event generate .t <> -x 15 -y 3 update set ::retval } -cleanup { destroy .t } -result {<>_fired} test text-27.15c {No <> virtual event on <> outside widget selection} -body { pack [text .t] .t insert end "There is a selection in this text widget,\n" .t insert end "but it will not be impacted by the <> event received." .t tag add sel 1.0 1.28 bind .t <> "set ::retval <>_fired" update set ::retval no_<>_event_fired event generate .t <> -x 15 -y 80 update set ::retval } -cleanup { destroy .t } -result {no_<>_event_fired} test text-27.15d {<> virtual event on with cursor inside selection} -body { pack [text .t] .t insert end "There is a selection in this text widget,\n" .t insert end "and it will be impacted by the event received.\n" .t insert end "Therefore a <> event must fire back." .t tag add sel 1.0 1.28 bind .t <> "set ::retval <>_fired" update set ::retval no_<>_event_fired .t mark set insert 1.15 update idletasks focus -force .t event generate .t update set ::retval } -cleanup { destroy .t } -result {<>_fired} test text-27.15e {No <> virtual event on with cursor outside selection} -body { pack [text .t] .t insert end "There is a selection in this text widget,\n" .t insert end "but it will not be impacted by the event received." .t tag add sel 1.0 1.28 bind .t <> "set ::retval <>_fired" update set ::retval no_<>_event_fired .t mark set insert 2.15 focus .t event generate .t update set ::retval } -cleanup { destroy .t } -result {no_<>_event_fired} test text-27.15f {<> virtual event on <> with a widget selection} -body { pack [text .t] .t insert end "There is a selection in this text widget,\n" .t insert end "and it will be impacted by the <> event received.\n" .t insert end "Therefore a <> event must fire back." .t tag add sel 1.0 1.28 bind .t <> "set ::retval <>_fired" update set ::retval no_<>_event_fired event generate .t <> update set ::retval } -cleanup { destroy .t } -result {<>_fired} test text-27.15g {No <> virtual event on <> without widget selection} -body { pack [text .t] .t insert end "There is a selection in this text widget,\n" .t insert end "and it will be impacted by the <> event received.\n" .t insert end "Therefore a <> event must fire back." bind .t <> "set ::retval <>_fired" update set ::retval no_<>_event_fired event generate .t <> update set ::retval } -cleanup { destroy .t } -result {no_<>_event_fired} 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 } -setup { destroy .t } -body { text .t -undo 1 .t insert end foo\nbar .t edit reset .t insert 2.2 WORLD event generate .t -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 <>} -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 <> .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) - <> 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 -x 1 -y 1 .t insert insert HELLO event generate .t <> .t insert insert E event generate .t <> .t get 1.0 "1.0 lineend" } -cleanup { destroy .t } -result "This WORLD is an example text" test text-27.22 {patch 1669632 (v) - <> 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 event generate .top.t <> event generate .top.t <> event generate .top.t event generate .top.t <> .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) - <> 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 event generate .top.t <> event generate .top.t <> event generate .top.t event generate .top.t <> .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 {<> virtual event} -setup { destroy .t set res {} set nbUS 0 } -body { text .t -undo false -autoseparators false bind .t <> {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-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-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-35.1 {widget dump -command alters tags} -setup { proc Dumpy {key value index} { #puts "KK: $key, $value" .t tag add $value [list $index linestart] [list $index lineend] } text .t } -body { .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c .t tag configure b -background red .t dump -all -command Dumpy 1.0 end set result "ok" } -cleanup { destroy .t } -result {ok} test text-35.2 {widget dump -command makes massive changes} -setup { proc Dumpy {key value index} { #puts "KK: $key, $value" .t delete 1.0 end } text .t } -body { .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c .t tag configure b -background red .t dump -all -command Dumpy 1.0 end set result "ok" } -cleanup { destroy .t } -result {ok} test text-35.3 {widget dump -command destroys widget} -setup { proc Dumpy {key value index} { #puts "KK: $key, $value" destroy .t } text .t } -body { .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c .t tag configure b -background red .t dump -all -command Dumpy 1.0 end set result "ok" } -cleanup { destroy .t } -result {ok} test text-36.1 "bug #1777362: event handling with hyphenated windows" -setup { set save [interp bgerror {}] interp bgerror {} returnerror-36.1 proc returnerror-36.1 {m opts} {set ::my_error $m} set ::my_error {} pack [set w [text .t-1]] } -body { tkwait visibility $w event generate $w <1> event generate $w <1> update set ::my_error } -cleanup { destroy .t-1 rename returnerror-36.1 "" interp bgerror {} $save unset -nocomplain save ::my_error w } -result {} test text-36.2 "bug #1777362: event handling with hyphenated windows" -setup { set save [interp bgerror {}] interp bgerror {} returnerror-36.2 proc returnerror-36.2 {m opts} {set ::my_error $m} set ::my_error {} pack [set w [text .t+1]] } -body { tkwait visibility $w event generate $w <1> event generate $w <1> update set ::my_error } -cleanup { destroy $w rename returnerror-36.2 "" interp bgerror {} $save unset -nocomplain save ::my_error w } -result {} test text-36.3 "bug #1777362: event handling with hyphenated windows" -setup { set save [interp bgerror {}] interp bgerror {} returnerror-36.3 proc returnerror-36.3 {m opts} {set ::my_error $m} set ::my_error {} pack [set w [text .t*1]] } -body { tkwait visibility $w event generate $w <1> event generate $w <1> update set ::my_error } -cleanup { destroy $w rename returnerror-36.3 "" interp bgerror {} $save unset -nocomplain save ::my_error w } -result {} test text-37.1 "bug #dd9667635d: text anchor not set" -setup { set save [interp bgerror {}] interp bgerror {} returnerror-37.1 proc returnerror-37.1 {m opts} {set ::my_error $m} destroy .t set ::my_error {} pack [text .t] } -body { .t insert end "Hello world!" .t tag add sel 1.0 end # this line shall not trigger error: # bad text index "tk::anchorN" event generate .t <> update set ::my_error } -cleanup { destroy .t rename returnerror-37.1 "" interp bgerror {} $save unset -nocomplain save ::my_error } -result {} # cleanup cleanupTests return # Local Variables: # mode: tcl # End: