tk/tests/text.test

   1 # This file is a Tcl script to test the code in the file tkText.c.
   2 # This file is organized in the standard fashion for Tcl tests.
   3 #
   4 # Copyright (c) 1992-1994 The Regents of the University of California.
   5 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
   6 # Copyright (c) 1998-1999 by Scriptics Corporation.
   7 # All rights reserved.
   8 #
   9 # RCS: @(#) $Id$
  10
  11 if {[lsearch [namespace children] ::tcltest] == -1} {
  12     source [file join [pwd] [file dirname [info script]] defs.tcl]
  13 }
  14
  15 eval destroy [winfo child .]
  16
  17 # Create entries in the option database to be sure that geometry options
  18 # like border width have predictable values.
  19
  20 option add *Text.borderWidth 2
  21 option add *Text.highlightThickness 2
  22 option add *Text.font {Courier -12}
  23
  24 text .t -width 20 -height 10
  25 pack append . .t {top expand fill}
  26 update
  27 .t debug on
  28 wm geometry . {}
  29
  30 # The statements below reset the main window;  it's needed if the window
  31 # manager is mwm to make mwm forget about a previous minimum size setting.
  32
  33 wm withdraw .
  34 wm minsize . 1 1
  35 wm positionfrom . user
  36 wm deiconify .
  37
  38 entry .t.e
  39 .t.e insert end abcdefg
  40 .t.e select from 0
  41
  42 .t insert 1.0 "Line 1
  43 abcdefghijklm
  44 12345
  45 Line 4
  46 bOy GIrl .#@? x_yz
  47 !@#$%
  48 Line 7"
  49
  50 catch {destroy .t2}
  51 text .t2
  52 set i 0
  53 foreach test {
  54     {-background #ff00ff #ff00ff <gorp>}
  55     {-bd 4 4 foo}
  56     {-bg blue blue #xx}
  57     {-borderwidth 7 7 ++}
  58     {-cursor watch watch lousy}
  59     {-exportselection no 0 maybe}
  60     {-fg red red stupid}
  61     {-font fixed fixed {}}
  62     {-foreground #012 #012 bogus}
  63     {-height 5 5 bad}
  64     {-highlightbackground #123 #123 bogus}
  65     {-highlightcolor #234 #234 bogus}
  66     {-highlightthickness -2 0 bad}
  67     {-insertbackground green green <bogus>}
  68     {-insertborderwidth 45 45 bogus}
  69     {-insertofftime 100 100 2.4}
  70     {-insertontime 47 47 e1}
  71     {-insertwidth 2.3 2 47d}
  72     {-padx 3.4 3 2.4.}
  73     {-pady 82 82 bogus}
  74     {-relief raised raised bumpy}
  75     {-selectbackground #ffff01234567 #ffff01234567 bogus}
  76     {-selectborderwidth 21 21 3x}
  77     {-selectforeground yellow yellow #12345}
  78     {-spacing1 20 20 1.3x}
  79     {-spacing1 -5 0 bogus}
  80     {-spacing2 5 5 bogus}
  81     {-spacing2 -1 0 bogus}
  82     {-spacing3 20 20 bogus}
  83     {-spacing3 -10 0 bogus}
  84     {-state d disabled foo}
  85     {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs}
  86     {-width 73 73 2.4}
  87     {-wrap w word bad_wrap}
  88 } {
  89     test text-1.[incr i] {text options} {
  90         set result {}
  91         lappend result [catch {.t2 configure [lindex $test 0] [lindex $test 3]}]
  92         .t2 configure [lindex $test 0] [lindex $test 1]
  93         lappend result [.t2 cget [lindex $test 0]]
  94     } [list 1 [lindex $test 2]]
  95 }
  96 test text-1.[incr i] {text options} {
  97     .t2 configure -takefocus "any old thing"
  98     .t2 cget -takefocus
  99 } {any old thing}
 100 test text-1.[incr i] {text options} {
 101     .t2 configure -xscrollcommand "x scroll command"
 102     .t2 configure -xscrollcommand
 103 } {-xscrollcommand xScrollCommand ScrollCommand {} {x scroll command}}
 104 test text-1.[incr i] {text options} {
 105     .t2 configure -yscrollcommand "test command"
 106     .t2 configure -yscrollcommand
 107 } {-yscrollcommand yScrollCommand ScrollCommand {} {test command}}
 108 test text-1.[incr i] {text options} {
 109     set result {}
 110     foreach i [.t2 configure] {
 111         lappend result [lindex $i 4]
 112     }
 113     set result
 114 } {blue {} {} 7 watch 0 {} fixed #012 5 #123 #234 0 green 45 100 47 2 3 82 raised #ffff01234567 21 yellow 0 0 0 0 disabled {1i 2i 3i 4i} {any old thing} 73 word {x scroll command} {test command}}
 115
 116 test text-2.1 {Tk_TextCmd procedure} {
 117     list [catch {text} msg] $msg
 118 } {1 {wrong # args: should be "text pathName ?options?"}}
 119 test text-2.2 {Tk_TextCmd procedure} {
 120     list [catch {text foobar} msg] $msg
 121 } {1 {bad window path name "foobar"}}
 122 test text-2.3 {Tk_TextCmd procedure} {
 123     catch {destroy .t2}
 124     list [catch {text .t2 -gorp nofun} msg] $msg [winfo exists .t2]
 125 } {1 {unknown option "-gorp"} 0}
 126 test text-2.4 {Tk_TextCmd procedure} {
 127     catch {destroy .t2}
 128     list [catch {text .t2 -bd 2 -fg red} msg] $msg \
 129         [lindex [.t2 config -bd] 4] [lindex [.t2 config -fg] 4]
 130 } {0 .t2 2 red}
 131 if {$tcl_platform(platform) == "macintosh"} {
 132     set relief solid
 133 } elseif {$tcl_platform(platform) == "windows"} {
 134     set relief flat
 135 } else {
 136     set relief raised
 137 }
 138 test text-2.5 {Tk_TextCmd procedure} {
 139     catch {destroy .t2}
 140     text .t2
 141     .t2 tag cget sel -relief
 142 } $relief
 143 test text-2.6 {Tk_TextCmd procedure} {
 144     catch {destroy .t2}
 145     list [text .t2] [winfo class .t2]
 146 } {.t2 Text}
 147
 148 test text-3.1 {TextWidgetCmd procedure, basics} {
 149     list [catch {.t} msg] $msg
 150 } {1 {wrong # args: should be ".t option ?arg arg ...?"}}
 151 test text-3.2 {TextWidgetCmd procedure} {
 152     list [catch {.t gorp 1.0 z 1.2} msg] $msg
 153 } {1 {bad option "gorp": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
 154
 155 test text-4.1 {TextWidgetCmd procedure, "bbox" option} {
 156     list [catch {.t bbox} msg] $msg
 157 } {1 {wrong # args: should be ".t bbox index"}}
 158 test text-4.2 {TextWidgetCmd procedure, "bbox" option} {
 159     list [catch {.t bbox a b} msg] $msg
 160 } {1 {wrong # args: should be ".t bbox index"}}
 161 test text-4.3 {TextWidgetCmd procedure, "bbox" option} {
 162     list [catch {.t bbox bad_mark} msg] $msg
 163 } {1 {bad text index "bad_mark"}}
 164
 165 test text-5.1 {TextWidgetCmd procedure, "cget" option} {
 166     list [catch {.t cget} msg] $msg
 167 } {1 {wrong # args: should be ".t cget option"}}
 168 test text-5.2 {TextWidgetCmd procedure, "cget" option} {
 169     list [catch {.t cget a b} msg] $msg
 170 } {1 {wrong # args: should be ".t cget option"}}
 171 test text-5.3 {TextWidgetCmd procedure, "cget" option} {
 172     list [catch {.t cget -gorp} msg] $msg
 173 } {1 {unknown option "-gorp"}}
 174 test text-5.4 {TextWidgetCmd procedure, "cget" option} {
 175     .t configure -bd 17
 176     .t cget -bd
 177 } {17}
 178 .t configure -bd [lindex [.t configure -bd] 3]
 179
 180 test text-6.1 {TextWidgetCmd procedure, "compare" option} {
 181     list [catch {.t compare a b} msg] $msg
 182 } {1 {wrong # args: should be ".t compare index1 op index2"}}
 183 test text-6.2 {TextWidgetCmd procedure, "compare" option} {
 184     list [catch {.t compare a b c d} msg] $msg
 185 } {1 {wrong # args: should be ".t compare index1 op index2"}}
 186 test text-6.3 {TextWidgetCmd procedure, "compare" option} {
 187     list [catch {.t compare @x == 1.0} msg] $msg
 188 } {1 {bad text index "@x"}}
 189 test text-6.4 {TextWidgetCmd procedure, "compare" option} {
 190     list [catch {.t compare 1.0 < @y} msg] $msg
 191 } {1 {bad text index "@y"}}
 192 test text-6.5 {TextWidgetCmd procedure, "compare" option} {
 193     list [.t compare 1.1 < 1.0] [.t compare 1.1 < 1.1] [.t compare 1.1 < 1.2]
 194 } {0 0 1}
 195 test text-6.6 {TextWidgetCmd procedure, "compare" option} {
 196     list [.t compare 1.1 <= 1.0] [.t compare 1.1 <= 1.1] [.t compare 1.1 <= 1.2]
 197 } {0 1 1}
 198 test text-6.7 {TextWidgetCmd procedure, "compare" option} {
 199     list [.t compare 1.1 == 1.0] [.t compare 1.1 == 1.1] [.t compare 1.1 == 1.2]
 200 } {0 1 0}
 201 test text-6.8 {TextWidgetCmd procedure, "compare" option} {
 202     list [.t compare 1.1 >= 1.0] [.t compare 1.1 >= 1.1] [.t compare 1.1 >= 1.2]
 203 } {1 1 0}
 204 test text-6.9 {TextWidgetCmd procedure, "compare" option} {
 205     list [.t compare 1.1 > 1.0] [.t compare 1.1 > 1.1] [.t compare 1.1 > 1.2]
 206 } {1 0 0}
 207 test text-6.10 {TextWidgetCmd procedure, "compare" option} {
 208     list [.t com 1.1 != 1.0] [.t compare 1.1 != 1.1] [.t compare 1.1 != 1.2]
 209 } {1 0 1}
 210 test text-6.11 {TextWidgetCmd procedure, "compare" option} {
 211     list [catch {.t compare 1.0 <x 1.2} msg] $msg
 212 } {1 {bad comparison operator "<x": must be <, <=, ==, >=, >, or !=}}
 213 test text-6.12 {TextWidgetCmd procedure, "compare" option} {
 214     list [catch {.t compare 1.0 >> 1.2} msg] $msg
 215 } {1 {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=}}
 216 test text-6.13 {TextWidgetCmd procedure, "compare" option} {
 217     list [catch {.t compare 1.0 z 1.2} msg] $msg
 218 } {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}}
 219 test text-6.14 {TextWidgetCmd procedure, "compare" option} {
 220     list [catch {.t co 1.0 z 1.2} msg] $msg
 221 } {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
 222
 223 # "configure" option is already covered above
 224
 225 test text-7.1 {TextWidgetCmd procedure, "debug" option} {
 226     list [catch {.t debug 0 1} msg] $msg
 227 } {1 {wrong # args: should be ".t debug boolean"}}
 228 test text-7.2 {TextWidgetCmd procedure, "debug" option} {
 229     list [catch {.t de 0 1} msg] $msg
 230 } {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
 231 test text-7.3 {TextWidgetCmd procedure, "debug" option} {
 232     .t debug true
 233     .t deb
 234 } 1
 235 test text-7.4 {TextWidgetCmd procedure, "debug" option} {
 236     .t debug false
 237     .t debug
 238 } 0
 239 .t debug
 240
 241 test text-8.1 {TextWidgetCmd procedure, "delete" option} {
 242     list [catch {.t delete} msg] $msg
 243 } {1 {wrong # args: should be ".t delete index1 ?index2?"}}
 244 test text-8.2 {TextWidgetCmd procedure, "delete" option} {
 245     list [catch {.t delete a b c} msg] $msg
 246 } {1 {wrong # args: should be ".t delete index1 ?index2?"}}
 247 test text-8.3 {TextWidgetCmd procedure, "delete" option} {
 248     list [catch {.t delete @x 2.2} msg] $msg
 249 } {1 {bad text index "@x"}}
 250 test text-8.4 {TextWidgetCmd procedure, "delete" option} {
 251     list [catch {.t delete 2.3 @y} msg] $msg
 252 } {1 {bad text index "@y"}}
 253 test text-8.5 {TextWidgetCmd procedure, "delete" option} {
 254     .t con -state disabled
 255     .t delete 2.3
 256     .t g 2.0 2.end
 257 } abcdefghijklm
 258 .t con -state normal
 259 test text-8.6 {TextWidgetCmd procedure, "delete" option} {
 260     .t delete 2.3
 261     .t get 2.0 2.end
 262 } abcefghijklm
 263 test text-8.7 {TextWidgetCmd procedure, "delete" option} {
 264     .t delete 2.1 2.3
 265     .t get 2.0 2.end
 266 } aefghijklm
 267
 268 test text-9.1 {TextWidgetCmd procedure, "get" option} {
 269     list [catch {.t get} msg] $msg
 270 } {1 {wrong # args: should be ".t get index1 ?index2?"}}
 271 test text-9.2 {TextWidgetCmd procedure, "get" option} {
 272     list [catch {.t get a b c} msg] $msg
 273 } {1 {wrong # args: should be ".t get index1 ?index2?"}}
 274 test text-9.3 {TextWidgetCmd procedure, "get" option} {
 275     list [catch {.t get @q 3.1} msg] $msg
 276 } {1 {bad text index "@q"}}
 277 test text-9.4 {TextWidgetCmd procedure, "get" option} {
 278     list [catch {.t get 3.1 @r} msg] $msg
 279 } {1 {bad text index "@r"}}
 280 test text-9.5 {TextWidgetCmd procedure, "get" option} {
 281     .t get 5.7 5.3
 282 } {}
 283 test text-9.6 {TextWidgetCmd procedure, "get" option} {
 284     .t get 5.3 5.5
 285 } { G}
 286 test text-9.7 {TextWidgetCmd procedure, "get" option} {
 287     .t get 5.3 end
 288 } { GIrl .#@? x_yz
 289 !@#$%
 290 Line 7
 291 }
 292 .t mark set a 5.3
 293 .t mark set b 5.3
 294 .t mark set c 5.5
 295 test text-9.8 {TextWidgetCmd procedure, "get" option} {
 296     .t get 5.2 5.7
 297 } {y GIr}
 298 test text-9.9 {TextWidgetCmd procedure, "get" option} {
 299     .t get 5.2
 300 } {y}
 301 test text-9.10 {TextWidgetCmd procedure, "get" option} {
 302     .t get 5.2 5.4
 303 } {y }
 304
 305 test text-10.1 {TextWidgetCmd procedure, "index" option} {
 306     list [catch {.t index} msg] $msg
 307 } {1 {wrong # args: should be ".t index index"}}
 308 test text-10.2 {TextWidgetCmd procedure, "index" option} {
 309     list [catch {.t ind a b} msg] $msg
 310 } {1 {wrong # args: should be ".t index index"}}
 311 test text-10.3 {TextWidgetCmd procedure, "index" option} {
 312     list [catch {.t in a b} msg] $msg
 313 } {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
 314 test text-10.4 {TextWidgetCmd procedure, "index" option} {
 315     list [catch {.t index @xyz} msg] $msg
 316 } {1 {bad text index "@xyz"}}
 317 test text-10.5 {TextWidgetCmd procedure, "index" option} {
 318     .t index 1.2
 319 } 1.2
 320
 321 test text-11.1 {TextWidgetCmd procedure, "insert" option} {
 322     list [catch {.t insert 1.2} msg] $msg
 323 } {1 {wrong # args: should be ".t insert index chars ?tagList chars tagList ...?"}}
 324 test text-11.2 {TextWidgetCmd procedure, "insert" option} {
 325     .t config -state disabled
 326     .t insert 1.2 xyzzy
 327     .t get 1.0 1.end
 328 } {Line 1}
 329 .t config -state normal
 330 test text-11.3 {TextWidgetCmd procedure, "insert" option} {
 331     .t insert 1.2 xyzzy
 332     .t get 1.0 1.end
 333 } {Lixyzzyne 1}
 334 test text-11.4 {TextWidgetCmd procedure, "insert" option} {
 335     .t delete 1.0 end
 336     .t insert 1.0 "Sample text" x
 337     .t tag ranges x
 338 } {1.0 1.11}
 339 test text-11.5 {TextWidgetCmd procedure, "insert" option} {
 340     .t delete 1.0 end
 341     .t insert 1.0 "Sample text" x
 342     .t insert 1.2 "XYZ" y
 343     list [.t tag ranges x] [.t tag ranges y]
 344 } {{1.0 1.2 1.5 1.14} {1.2 1.5}}
 345 test text-11.6 {TextWidgetCmd procedure, "insert" option} {
 346     .t delete 1.0 end
 347     .t insert 1.0 "Sample text" {x y z}
 348     list [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
 349 } {{1.0 1.11} {1.0 1.11} {1.0 1.11}}
 350 test text-11.7 {TextWidgetCmd procedure, "insert" option} {
 351     .t delete 1.0 end
 352     .t insert 1.0 "Sample text" {x y z}
 353     .t insert 1.3 "A" {a b z}
 354     list [.t tag ranges a] [.t tag ranges b] [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
 355 } {{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}}
 356 test text-11.8 {TextWidgetCmd procedure, "insert" option} {
 357     .t delete 1.0 end
 358     list [catch {.t insert 1.0 "Sample text" "a \{b"} msg] $msg
 359 } {1 {unmatched open brace in list}}
 360 test text-11.9 {TextWidgetCmd procedure, "insert" option} {
 361     .t delete 1.0 end
 362     .t insert 1.0 "First" bold " " {} second "x y z" " third"
 363     list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges x] \
 364             [.t tag ranges y] [.t tag ranges z]
 365 } {{First second third} {1.0 1.5} {1.6 1.12} {1.6 1.12} {1.6 1.12}}
 366 test text-11.10 {TextWidgetCmd procedure, "insert" option} {
 367     .t delete 1.0 end
 368     .t insert 1.0 "First" bold " second" silly
 369     list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly]
 370 } {{First second} {1.0 1.5} {1.5 1.12}}
 371
 372 # Mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere.
 373
 374 test text-12.1 {ConfigureText procedure} {
 375     list [catch {.t2 configure -state foobar} msg] $msg
 376 } {1 {bad state value "foobar": must be normal or disabled}}
 377 test text-12.2 {ConfigureText procedure} {
 378     .t2 configure -spacing1 -2 -spacing2 1 -spacing3 1
 379     list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
 380 } {0 1 1}
 381 test text-12.3 {ConfigureText procedure} {
 382     .t2 configure -spacing1 1 -spacing2 -1 -spacing3 1
 383     list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
 384 } {1 0 1}
 385 test text-12.4 {ConfigureText procedure} {
 386     .t2 configure -spacing1 1 -spacing2 1 -spacing3 -3
 387     list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
 388 } {1 1 0}
 389 test text-12.5 {ConfigureText procedure} {
 390     set x [list [catch {.t2 configure -tabs {30 foo}} msg] $msg $errorInfo]
 391     .t2 configure -tabs {10 20 30}
 392     set x
 393 } {1 {bad tab alignment "foo": must be left, right, center, or numeric} {bad tab alignment "foo": must be left, right, center, or numeric
 394     (while processing -tabs option)
 395     invoked from within
 396 ".t2 configure -tabs {30 foo}"}}
 397 test text-12.6 {ConfigureText procedure} {
 398     .t2 configure -tabs {10 20 30}
 399     .t2 configure -tabs {}
 400     .t2 cget -tabs
 401 } {}
 402 test text-12.7 {ConfigureText procedure} {
 403     list [catch {.t2 configure -wrap bogus} msg] $msg
 404 } {1 {bad wrap mode "bogus": must be char, none, or word}}
 405 test text-12.8 {ConfigureText procedure} {
 406     .t2 configure -selectborderwidth 17 -selectforeground #332211 \
 407             -selectbackground #abc
 408     list [lindex [.t2 tag config sel -borderwidth] 4] \
 409         [lindex [.t2 tag config sel -foreground] 4] \
 410         [lindex [.t2 tag config sel -background] 4]
 411 } {17 #332211 #abc}
 412 test text-12.9 {ConfigureText procedure} {
 413     .t2 configure -selectborderwidth {}
 414     .t2 tag cget sel -borderwidth
 415 } {}
 416 test text-12.10 {ConfigureText procedure} {
 417     list [catch {.t2 configure -selectborderwidth foo} msg] $msg
 418 } {1 {bad screen distance "foo"}}
 419 test text-12.11 {ConfigureText procedure} {
 420     catch {destroy .t2}
 421     .t.e select to 2
 422     text .t2 -exportselection 1
 423     selection get
 424 } {ab}
 425 test text-12.12 {ConfigureText procedure} {
 426     catch {destroy .t2}
 427     .t.e select to 2
 428     text .t2 -exportselection 0
 429     .t2 insert insert 1234657890
 430     .t2 tag add sel 1.0 1.4
 431     selection get
 432 } {ab}
 433 test text-12.13 {ConfigureText procedure} {
 434     catch {destroy .t2}
 435     .t.e select to 1
 436     text .t2 -exportselection 1
 437     .t2 insert insert 1234657890
 438     .t2 tag add sel 1.0 1.4
 439     selection get
 440 } {1234}
 441 test text-12.14 {ConfigureText procedure} {
 442     catch {destroy .t2}
 443     .t.e select to 1
 444     text .t2 -exportselection 0
 445     .t2 insert insert 1234657890
 446     .t2 tag add sel 1.0 1.4
 447     .t2 configure -exportselection 1
 448     selection get
 449 } {1234}
 450 test text-12.15 {ConfigureText procedure} {
 451     catch {destroy .t2}
 452     text .t2 -exportselection 1
 453     .t2 insert insert 1234657890
 454     .t2 tag add sel 1.0 1.4
 455     set result [selection get]
 456     .t2 configure -exportselection 0
 457     lappend result [catch {selection get} msg] $msg
 458 } {1234 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
 459 test text-12.16 {ConfigureText procedure} {fonts} {
 460     # This test is non-portable because the window size will vary depending
 461     # on the font size, which can vary.
 462
 463     catch {destroy .t2}
 464     toplevel .t2
 465     text .t2.t -width 20 -height 10
 466     pack append .t2 .t2.t top
 467     wm geometry .t2 +0+0
 468     update
 469     wm geometry .t2
 470 } {150x140+0+0}
 471 test text-12.17 {ConfigureText procedure} {
 472     # This test was failing Windows because the title bar on .t2
 473     # was a certain minimum size and it was interfering with the size
 474     # requested by the -setgrid.  The "overrideredirect" gets rid of the
 475     # titlebar so the toplevel can shrink to the appropriate size.
 476
 477     catch {destroy .t2}
 478     toplevel .t2
 479     wm overrideredirect .t2 1
 480     text .t2.t -width 20 -height 10 -setgrid 1
 481     pack append .t2 .t2.t top
 482     wm geometry .t2 +0+0
 483     update
 484     wm geometry .t2
 485 } {20x10+0+0}
 486 test text-12.18 {ConfigureText procedure} {
 487     # This test was failing on Windows because the title bar on .t2
 488     # was a certain minimum size and it was interfering with the size
 489     # requested by the -setgrid.  The "overrideredirect" gets rid of the
 490     # titlebar so the toplevel can shrink to the appropriate size.
 491
 492     catch {destroy .t2}
 493     toplevel .t2
 494     wm overrideredirect .t2 1
 495     text .t2.t -width 20 -height 10 -setgrid 1
 496     pack append .t2 .t2.t top
 497     wm geometry .t2 +0+0
 498     update
 499     set result [wm geometry .t2]
 500     wm geometry .t2 15x8
 501     update
 502     lappend result [wm geometry .t2]
 503     .t2.t configure -wrap word
 504     update
 505     lappend result [wm geometry .t2]
 506 } {20x10+0+0 15x8+0+0 15x8+0+0}
 507
 508 test text-13.1 {TextWorldChanged procedure, spacing options} fonts {
 509     catch {destroy .t2}
 510     text .t2 -width 20 -height 10
 511     set result [winfo reqheight .t2]
 512     .t2 configure -spacing1 2
 513     lappend result [winfo reqheight .t2]
 514     .t2  configure -spacing3 1
 515     lappend result [winfo reqheight .t2]
 516     .t2 configure -spacing1 0
 517     lappend result [winfo reqheight .t2]
 518 } {140 160 170 150}
 519
 520 test text-14.1 {TextEventProc procedure} {
 521     text .tx1 -bg #543210
 522     rename .tx1 .tx2
 523     set x {}
 524     lappend x [winfo exists .tx1]
 525     lappend x [.tx2 cget -bg]
 526     destroy .tx1
 527     lappend x [info command .tx*] [winfo exists .tx1] [winfo exists .tx2]
 528 } {1 #543210 {} 0 0}
 529
 530 test text-15.1 {TextCmdDeletedProc procedure} {
 531     text .tx1
 532     rename .tx1 {}
 533     list [info command .tx*] [winfo exists .tx1]
 534 } {{} 0}
 535 test text-15.2 {TextCmdDeletedProc procedure, disabling -setgrid} fonts {
 536     catch {destroy .top}
 537     toplevel .top
 538     wm geom .top +0+0
 539     text .top.t -setgrid 1 -width 20 -height 10
 540     pack .top.t
 541     update
 542     set x [wm geometry .top]
 543     rename .top.t {}
 544     update
 545     lappend x [wm geometry .top]
 546     destroy .top
 547     set x
 548 } {20x10+0+0 150x140+0+0}
 549
 550 test text-16.1 {InsertChars procedure} {
 551     catch {destroy .t2}
 552     text .t2
 553     .t2 insert 2.0 abcd\n
 554     .t2 get 1.0 end
 555 } {abcd
 556
 557 }
 558 test text-16.2 {InsertChars procedure} {
 559     catch {destroy .t2}
 560     text .t2
 561     .t2 insert 1.0 abcd\n
 562     .t2 insert end 123\n
 563     .t2 get 1.0 end
 564 } {abcd
 565 123
 566
 567 }
 568 test text-16.3 {InsertChars procedure} {
 569     catch {destroy .t2}
 570     text .t2
 571     .t2 insert 1.0 abcd\n
 572     .t2 insert 10.0 123
 573     .t2 get 1.0 end
 574 } {abcd
 575 123
 576 }
 577 test text-16.4 {InsertChars procedure, inserting on top visible line} {
 578     catch {destroy .t2}
 579     text .t2 -width 20 -height 4 -wrap word
 580     pack .t2
 581     .t2 insert insert "Now is the time for all great men to come to the "
 582     .t2 insert insert "aid of their party.\n"
 583     .t2 insert insert "Now is the time for all great men.\n"
 584     .t2 see end
 585     update
 586     .t2 insert 1.0 "Short\n"
 587     .t2 index @0,0
 588 } {2.56}
 589 test text-16.5 {InsertChars procedure, inserting on top visible line} {
 590     catch {destroy .t2}
 591     text .t2 -width 20 -height 4 -wrap word
 592     pack .t2
 593     .t2 insert insert "Now is the time for all great men to come to the "
 594     .t2 insert insert "aid of their party.\n"
 595     .t2 insert insert "Now is the time for all great men.\n"
 596     .t2 see end
 597     update
 598     .t2 insert 1.55 "Short\n"
 599     .t2 index @0,0
 600 } {2.0}
 601 test text-16.6 {InsertChars procedure, inserting on top visible line} {
 602     catch {destroy .t2}
 603     text .t2 -width 20 -height 4 -wrap word
 604     pack .t2
 605     .t2 insert insert "Now is the time for all great men to come to the "
 606     .t2 insert insert "aid of their party.\n"
 607     .t2 insert insert "Now is the time for all great men.\n"
 608     .t2 see end
 609     update
 610     .t2 insert 1.56 "Short\n"
 611     .t2 index @0,0
 612 } {1.56}
 613 test text-16.7 {InsertChars procedure, inserting on top visible line} {
 614     catch {destroy .t2}
 615     text .t2 -width 20 -height 4 -wrap word
 616     pack .t2
 617     .t2 insert insert "Now is the time for all great men to come to the "
 618     .t2 insert insert "aid of their party.\n"
 619     .t2 insert insert "Now is the time for all great men.\n"
 620     .t2 see end
 621     update
 622     .t2 insert 1.57 "Short\n"
 623     .t2 index @0,0
 624 } {1.56}
 625 catch {destroy .t2}
 626
 627 proc setup {} {
 628     .t delete 1.0 end
 629     .t insert 1.0 "Line 1
 630 abcde
 631 12345
 632 Line 4"
 633 }
 634
 635 .t delete 1.0 end
 636 test text-17.1 {DeleteChars procedure} {
 637     .t get 1.0 end
 638 } {
 639 }
 640 test text-17.2 {DeleteChars procedure} {
 641     list [catch {.t delete foobar} msg] $msg
 642 } {1 {bad text index "foobar"}}
 643 test text-17.3 {DeleteChars procedure} {
 644     list [catch {.t delete 1.0 lousy} msg] $msg
 645 } {1 {bad text index "lousy"}}
 646 test text-17.4 {DeleteChars procedure} {
 647     setup
 648     .t delete 2.1
 649     .t get 1.0 end
 650 } {Line 1
 651 acde
 652 12345
 653 Line 4
 654 }
 655 test text-17.5 {DeleteChars procedure} {
 656     setup
 657     .t delete 2.3
 658     .t get 1.0 end
 659 } {Line 1
 660 abce
 661 12345
 662 Line 4
 663 }
 664 test text-17.6 {DeleteChars procedure} {
 665     setup
 666     .t delete 2.end
 667     .t get 1.0 end
 668 } {Line 1
 669 abcde12345
 670 Line 4
 671 }
 672 test text-17.7 {DeleteChars procedure} {
 673     setup
 674     .t tag add sel 4.2 end
 675     .t delete 4.2 end
 676     list [.t tag ranges sel] [.t get 1.0 end]
 677 } {{} {Line 1
 678 abcde
 679 12345
 680 Li
 681 }}
 682 test text-17.8 {DeleteChars procedure} {
 683     setup
 684     .t tag add sel 1.0 end
 685     .t delete 4.0 end
 686     list [.t tag ranges sel] [.t get 1.0 end]
 687 } {{1.0 3.5} {Line 1
 688 abcde
 689 12345
 690 }}
 691 test text-17.9 {DeleteChars procedure} {
 692     setup
 693     .t delete 2.2 2.2
 694     .t get 1.0 end
 695 } {Line 1
 696 abcde
 697 12345
 698 Line 4
 699 }
 700 test text-17.10 {DeleteChars procedure} {
 701     setup
 702     .t delete 2.3 2.1
 703     .t get 1.0 end
 704 } {Line 1
 705 abcde
 706 12345
 707 Line 4
 708 }
 709 test text-17.11 {DeleteChars procedure} {
 710     catch {destroy .t2}
 711     toplevel .t2
 712     text .t2.t -width 20 -height 5
 713     pack append .t2 .t2.t top
 714     wm geometry .t2 +0+0
 715     .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns"
 716     update
 717     .t2.t delete 1.0 3.0
 718     list [.t2.t index @0,0] [.t2.t get @0,0]
 719 } {1.0 x}
 720 test text-17.12 {DeleteChars procedure} {
 721     catch {destroy .t2}
 722     toplevel .t2
 723     text .t2.t -width 20 -height 5
 724     pack append .t2 .t2.t top
 725     wm geometry .t2 +0+0
 726     .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns"
 727     .t2.t yview 3.0
 728     update
 729     .t2.t delete 2.0 4.0
 730     list [.t2.t index @0,0] [.t2.t get @0,0]
 731 } {2.0 y}
 732 catch {destroy .t2}
 733 toplevel .t2
 734 text .t2.t -width 1 -height 10 -wrap char
 735 frame .t2.f -width 200 -height 20 -relief raised -bd 2
 736 pack .t2.f .t2.t -side left
 737 wm geometry .t2 +0+0
 738 update
 739 test text-17.13 {DeleteChars procedure, updates affecting topIndex} {
 740     .t2.t delete 1.0 end
 741     .t2.t insert end "abcde\n12345\nqrstuv"
 742     .t2.t yview 2.1
 743     .t2.t delete 1.4 2.3
 744     .t2.t index @0,0
 745 } {1.2}
 746 test text-17.14 {DeleteChars procedure, updates affecting topIndex} {
 747     .t2.t delete 1.0 end
 748     .t2.t insert end "abcde\n12345\nqrstuv"
 749     .t2.t yview 2.1
 750     .t2.t delete 2.3 2.4
 751     .t2.t index @0,0
 752 } {2.0}
 753 test text-17.15 {DeleteChars procedure, updates affecting topIndex} {
 754     .t2.t delete 1.0 end
 755     .t2.t insert end "abcde\n12345\nqrstuv"
 756     .t2.t yview 1.3
 757     .t2.t delete 1.0 1.2
 758     .t2.t index @0,0
 759 } {1.1}
 760 test text-17.16 {DeleteChars procedure, updates affecting topIndex} {
 761     catch {destroy .t2}
 762     toplevel .t2
 763     text .t2.t -width 6 -height 10 -wrap word
 764     frame .t2.f -width 200 -height 20 -relief raised -bd 2
 765     pack .t2.f .t2.t -side left
 766     wm geometry .t2 +0+0
 767     update
 768     .t2.t insert end "abc def\n01 2345 678 9101112\nLine 3\nLine 4\nLine 5\n6\n7\n8\n"
 769     .t2.t yview 2.4
 770     .t2.t delete 2.5
 771     set x [.t2.t index @0,0]
 772     .t2.t delete 2.5
 773     list $x [.t2.t index @0,0]
 774 } {2.3 2.0}
 775
 776 .t delete 1.0 end
 777 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} {
 778     .t insert end $i.0$i.1$i.2$i.3$i.4\n
 779 }
 780 test text-18.1 {TextFetchSelection procedure} {
 781     .t tag add sel 1.3 3.4
 782     selection get
 783 } {a.1a.2a.3a.4
 784 b.0b.1b.2b.3b.4
 785 c.0c}
 786 test text-18.2 {TextFetchSelection procedure} {
 787     .t tag add x 1.2
 788     .t tag add x 1.4
 789     .t tag add x 2.0
 790     .t tag add x 2.3
 791     .t tag remove sel 1.0 end
 792     .t tag add sel 1.0 3.4
 793     selection get
 794 } {a.0a.1a.2a.3a.4
 795 b.0b.1b.2b.3b.4
 796 c.0c}
 797 test text-18.3 {TextFetchSelection procedure} {
 798     .t tag remove sel 1.0 end
 799     .t tag add sel 13.3
 800     selection get
 801 } {m}
 802 test text-18.4 {TextFetchSelection procedure} {
 803     .t tag remove x 1.0 end
 804     .t tag add sel 1.0 3.4
 805     .t tag remove sel 1.0 end
 806     .t tag add sel 1.2 1.5
 807     .t tag add sel 2.4 3.1
 808     .t tag add sel 10.0 10.end
 809     .t tag add sel 13.3
 810     selection get
 811 } {0a..1b.2b.3b.4
 812 cj.0j.1j.2j.3j.4m}
 813 set x ""
 814 for {set i 1} {$i < 200} {incr i} {
 815     append x "This is line $i, padded to just about 53 characters.\n"
 816 }
 817 test text-18.5 {TextFetchSelection procedure, long selections} {
 818     .t delete 1.0 end
 819     .t insert end $x
 820     .t tag add sel 1.0 end
 821     selection get
 822 } $x\n
 823
 824 test text-19.1 {TkTextLostSelection procedure} {unixOnly} {
 825     catch {destroy .t2}
 826     text .t2
 827     .t2 insert 1.0 "abc\ndef\nghijk\n1234"
 828     .t2 tag add sel 1.2 3.3
 829     .t.e select to 1
 830     .t2 tag ranges sel
 831 } {}
 832 test text-19.2 {TkTextLostSelection procedure} {macOrPc} {
 833     catch {destroy .t2}
 834     text .t2
 835     .t2 insert 1.0 "abc\ndef\nghijk\n1234"
 836     .t2 tag add sel 1.2 3.3
 837     .t.e select to 1
 838     .t2 tag ranges sel
 839 } {1.2 3.3}
 840 catch {destroy .t2}
 841 test text-19.3 {TkTextLostSelection procedure} {
 842     catch {destroy .t2}
 843     text .t2
 844     .t2 insert 1.0 "abcdef\nghijk\n1234"
 845     .t2 tag add sel 1.0 1.3
 846     set x [selection get]
 847     selection clear
 848     lappend x [catch {selection get} msg] $msg
 849     .t2 tag add sel 1.0 1.3
 850     lappend x [selection get]
 851 } {abc 1 {PRIMARY selection doesn't exist or form "STRING" not defined} abc}
 852
 853 .t delete 1.0 end
 854 .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx"
 855 test text-20.1 {TextSearchCmd procedure, argument parsing} {
 856     list [catch {.t search -} msg] $msg
 857 } {1 {bad switch "-": must be --, -backward, -count, -elide, -exact, -forward, -nocase, or -regexp}}
 858 test text-20.2 {TextSearchCmd procedure, -backwards option} {
 859     .t search -backwards xyz 1.4
 860 } {1.1}
 861 test text-20.3 {TextSearchCmd procedure, -forwards option} {
 862     .t search -forwards xyz 1.4
 863 } {1.5}
 864 test text-20.4 {TextSearchCmd procedure, -exact option} {
 865     .t search -f -exact x. 1.0
 866 } {1.9}
 867 test text-20.5 {TextSearchCmd procedure, -regexp option} {
 868     .t search -b -regexp x.z 1.4
 869 } {1.1}
 870 test text-20.6 {TextSearchCmd procedure, -count option} {
 871     set length unmodified
 872     list [.t search -count length x. 1.4] $length
 873 } {1.9 2}
 874 test text-20.7 {TextSearchCmd procedure, -count option} {
 875     list [catch {.t search -count} msg] $msg
 876 } {1 {no value given for "-count" option}}
 877 test text-20.8 {TextSearchCmd procedure, -nocase option} {
 878     list [.t search -nocase BaR 1.1] [.t search BaR 1.1]
 879 } {2.13 2.23}
 880 test text-20.9 {TextSearchCmd procedure, -nocase option} {
 881     .t search -n BaR 1.1
 882 } {2.13}
 883 test text-20.10 {TextSearchCmd procedure, -- option} {
 884     .t search -- -forward 1.0
 885 } {2.4}
 886 test text-20.11 {TextSearchCmd procedure, argument parsing} {
 887     list [catch {.t search abc} msg] $msg
 888 } {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"}}
 889 test text-20.12 {TextSearchCmd procedure, argument parsing} {
 890     list [catch {.t search abc d e f} msg] $msg
 891 } {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"}}
 892 test text-20.13 {TextSearchCmd procedure, check index} {
 893     list [catch {.t search abc gorp} msg] $msg
 894 } {1 {bad text index "gorp"}}
 895 test text-20.14 {TextSearchCmd procedure, startIndex == "end"} {
 896     .t search non-existent end
 897 } {}
 898 test text-20.15 {TextSearchCmd procedure, startIndex == "end"} {
 899     .t search non-existent end
 900 } {}
 901 test text-20.16 {TextSearchCmd procedure, bad stopIndex} {
 902     list [catch {.t search abc 1.0 lousy} msg] $msg
 903 } {1 {bad text index "lousy"}}
 904 test text-20.17 {TextSearchCmd procedure, pattern case conversion} {
 905     list [.t search -nocase BAR 1.1] [.t search BAR 1.1]
 906 } {2.13 {}}
 907 test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} {
 908     list [catch {.t search -regexp a( 1.0} msg] $msg
 909 } {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
 910 test text-20.19 {TextSearchCmd procedure, skip dummy last line} {
 911     .t search -backwards BaR end 1.0
 912 } {2.23}
 913 test text-20.20 {TextSearchCmd procedure, skip dummy last line} {
 914     .t search -backwards \n end 1.0
 915 } {3.9}
 916 test text-20.21 {TextSearchCmd procedure, skip dummy last line} {
 917     .t search \n end
 918 } {1.15}
 919 test text-20.22 {TextSearchCmd procedure, skip dummy last line} {
 920     .t search -back \n 1.0
 921 } {3.9}
 922 test text-20.23 {TextSearchCmd procedure, extract line contents} {
 923     .t tag add foo 1.2
 924     .t tag add x 1.3
 925     .t mark set silly 1.2
 926     .t search xyz 3.6
 927 } {1.1}
 928 test text-20.24 {TextSearchCmd procedure, stripping newlines} {
 929     .t search the\n 1.0
 930 } {1.12}
 931 test text-20.25 {TextSearchCmd procedure, stripping newlines} {
 932     .t search -regexp the\n 1.0
 933 } {}
 934 test text-20.26 {TextSearchCmd procedure, stripping newlines} {
 935     .t search -regexp {the$} 1.0
 936 } {1.12}
 937 test text-20.27 {TextSearchCmd procedure, stripping newlines} {
 938     .t search -regexp \n 1.0
 939 } {}
 940 test text-20.28 {TextSearchCmd procedure, line case conversion} {
 941     list [.t search -nocase bar 2.18] [.t search bar 2.18]
 942 } {2.23 2.13}
 943 test text-20.29 {TextSearchCmd procedure, firstChar and lastChar} {
 944     .t search -backwards xyz 1.6
 945 } {1.5}
 946 test text-20.30 {TextSearchCmd procedure, firstChar and lastChar} {
 947     .t search -backwards xyz 1.5
 948 } {1.1}
 949 test text-20.31 {TextSearchCmd procedure, firstChar and lastChar} {
 950     .t search xyz 1.5
 951 } {1.5}
 952 test text-20.32 {TextSearchCmd procedure, firstChar and lastChar} {
 953     .t search xyz 1.6
 954 } {3.0}
 955 test text-20.33 {TextSearchCmd procedure, firstChar and lastChar} {
 956     .t search {} 1.end
 957 } {1.15}
 958 test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} {
 959     .t search f 1.end
 960 } {2.0}
 961 test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} {
 962     .t search {} end
 963 } {1.0}
 964 test text-20.36 {TextSearchCmd procedure, regexp finds empty lines} {
 965     # Test for fix of bug #1643
 966     .t insert end "\n"
 967     tkTextSetCursor .t 4.0
 968     .t search -forward -regexp {^$} insert end
 969 } {4.0}
 970
 971 catch {destroy .t2}
 972 toplevel .t2
 973 wm geometry .t2 +0+0
 974 text .t2.t -width 30 -height 10
 975 pack .t2.t
 976 .t2.t insert 1.0 "This is a line\nand this is another"
 977 .t2.t insert end "\nand this is yet another"
 978 frame .t2.f -width 20 -height 20 -bd 2 -relief raised
 979 .t2.t window create 2.5 -window .t2.f
 980 test text-20.36 {TextSearchCmd procedure, firstChar and lastChar} {
 981     .t2.t search his 2.6
 982 } {2.6}
 983 test text-20.37 {TextSearchCmd procedure, firstChar and lastChar} {
 984     .t2.t search this 2.6
 985 } {3.4}
 986 test text-20.38 {TextSearchCmd procedure, firstChar and lastChar} {
 987     .t2.t search is 2.6
 988 } {2.7}
 989 test text-20.39 {TextSearchCmd procedure, firstChar and lastChar} {
 990     .t2.t search his 2.7
 991 } {3.5}
 992 test text-20.40 {TextSearchCmd procedure, firstChar and lastChar} {
 993     .t2.t search -backwards "his is another" 2.6
 994 } {2.6}
 995 test text-20.41 {TextSearchCmd procedure, firstChar and lastChar} {
 996     .t2.t search -backwards "his is" 2.6
 997 } {1.1}
 998 destroy .t2
 999 test text-20.42 {TextSearchCmd procedure, firstChar and lastChar} {
1000     .t search -backwards forw 2.5
1001 } {2.5}
1002 test text-20.43 {TextSearchCmd procedure, firstChar and lastChar} {
1003     .t search forw 2.5
1004 } {2.5}
1005 test text-20.44 {TextSearchCmd procedure, firstChar and lastChar} {
1006     catch {destroy .t2}
1007     text .t2
1008     list [.t2 search a 1.0] [.t2 search -backward a 1.0]
1009 } {{} {}}
1010 test text-20.45 {TextSearchCmd procedure, regexp match length} {
1011     set length unchanged
1012     list [.t search -regexp -count length x(.)(.*)z 1.1] $length
1013 } {1.1 7}
1014 test text-20.46 {TextSearchCmd procedure, regexp match length} {
1015     set length unchanged
1016     list [.t search -regexp -backward -count length fo* 2.5] $length
1017 } {2.0 3}
1018 test text-20.47 {TextSearchCmd procedure, checking stopIndex} {
1019     list [.t search bar 2.1 2.13] [.t search bar 2.1 2.14] \
1020             [.t search bar 2.12 2.14] [.t search bar 2.14 2.14]
1021 } {{} 2.13 2.13 {}}
1022 test text-20.48 {TextSearchCmd procedure, checking stopIndex} {
1023     list [.t search -backwards bar 2.20 2.13] \
1024             [.t search -backwards bar 2.20 2.14] \
1025             [.t search -backwards bar 2.14 2.13] \
1026             [.t search -backwards bar 2.13 2.13]
1027 } {2.13 {} 2.13 {}}
1028 test text-20.49 {TextSearchCmd procedure, embedded windows and index/count} {
1029     frame .t.f1 -width 20 -height 20 -relief raised -bd 2
1030     frame .t.f2 -width 20 -height 20 -relief raised -bd 2
1031     frame .t.f3 -width 20 -height 20 -relief raised -bd 2
1032     frame .t.f4 -width 20 -height 20 -relief raised -bd 2
1033     .t window create 2.10 -window .t.f3
1034     .t window create 2.8 -window .t.f2
1035     .t window create 2.8 -window .t.f1
1036     .t window create 2.1 -window .t.f4
1037     set result ""
1038     lappend result [.t search -count x forward 1.0] $x
1039     lappend result [.t search -count x wa 1.0] $x
1040     .t delete 2.1
1041     .t delete 2.8 2.10
1042     .t delete 2.10
1043     set result
1044 } {2.6 10 2.11 2}
1045 test text-20.50 {TextSearchCmd procedure, error setting variable} {
1046     catch {unset a}
1047     set a 44
1048     list [catch {.t search -count a(2) xyz 1.0} msg] $msg
1049 } {1 {can't set "a(2)": variable isn't array}}
1050 test text-20.51 {TextSearchCmd procedure, wrap-around} {
1051     .t search -backwards xyz 1.1
1052 } {3.5}
1053 test text-20.52 {TextSearchCmd procedure, wrap-around} {
1054     .t search -backwards xyz 1.1 1.0
1055 } {}
1056 test text-20.53 {TextSearchCmd procedure, wrap-around} {
1057     .t search xyz 3.6
1058 } {1.1}
1059 test text-20.54 {TextSearchCmd procedure, wrap-around} {
1060     .t search xyz 3.6 end
1061 } {}
1062 test text-20.55 {TextSearchCmd procedure, no match} {
1063     .t search non_existent 3.5
1064 } {}
1065 test text-20.56 {TextSearchCmd procedure, no match} {
1066     .t search -regexp non_existent 3.5
1067 } {}
1068 test text-20.57 {TextSearchCmd procedure, special cases} {
1069     .t search -back x 1.1
1070 } {1.0}
1071 test text-20.58 {TextSearchCmd procedure, special cases} {
1072     .t search -back x 1.0
1073 } {3.8}
1074 test text-20.59 {TextSearchCmd procedure, special cases} {
1075     .t search \n {end-2c}
1076 } {3.9}
1077 test text-20.60 {TextSearchCmd procedure, special cases} {
1078     .t search \n end
1079 } {1.15}
1080 test text-20.61 {TextSearchCmd procedure, special cases} {
1081     .t search x 1.0
1082 } {1.0}
1083 test text-20.62 {TextSearchCmd, freeing copy of pattern} {
1084     # This test doesn't return a result, but it will generate
1085     # a core leak if the pattern copy isn't properly freed.
1086
1087     set p abcdefg1234567890
1088     set p $p$p$p$p$p$p$p$p
1089     set p $p$p$p$p$p
1090     .t search -nocase $p 1.0
1091 } {}
1092 test text-20.63 {TextSearchCmd, unicode} {
1093     .t delete 1.0 end
1094     .t insert end "foo\u30c9\u30cabar"
1095     .t search \u30c9\u30ca 1.0
1096 } 1.3
1097 test text-20.64 {TextSearchCmd, unicode} {
1098     .t delete 1.0 end
1099     .t insert end "foo\u30c9\u30cabar"
1100     list [.t search -count n \u30c9\u30ca 1.0] $n
1101 } {1.3 2}
1102 test text-20.65 {TextSearchCmd, unicode with non-text segments} {
1103     .t delete 1.0 end
1104     button .b1 -text baz
1105     .t insert end "foo\u30c9"
1106     .t window create end -window .b1
1107     .t insert end "\u30cabar"
1108     set result [list [.t search -count n \u30c9\u30ca 1.0] $n]
1109     destroy .b1
1110     set result
1111 } {1.3 3}
1112
1113 test text-20.66 {TextSearchCmd, hidden text does not affect match index} {
1114     eval destroy [winfo child .]
1115     pack [text .t2]
1116     .t2 insert end "12345H7890"
1117     .t2 search 7 1.0
1118 } 1.6
1119 test text-20.67 {TextSearchCmd, hidden text does not affect match index} {
1120     eval destroy [winfo child .]
1121     pack [text .t2]
1122     .t2 insert end "12345H7890"
1123     .t2 tag configure hidden -elide true
1124     .t2 tag add hidden 1.5
1125     .t2 search 7 1.0
1126 } 1.6
1127 test text-20.68 {TextSearchCmd, hidden text does not affect match index} {
1128     eval destroy [winfo child .]
1129     pack [text .t2]
1130     .t2 insert end "foobar\nbarbaz\nbazboo"
1131     .t2 search boo 1.0
1132 } 3.3
1133 test text-20.69 {TextSearchCmd, hidden text does not affect match index} {
1134     eval destroy [winfo child .]
1135     pack [text .t2]
1136     .t2 insert end "foobar\nbarbaz\nbazboo"
1137     .t2 tag configure hidden -elide true
1138     .t2 tag add hidden 2.0 3.0
1139     .t2 search boo 1.0
1140 } 3.3
1141
1142 test text-20.70 {TextSearchCmd, -regexp -nocase searches} {
1143     catch {destroy .t}
1144     pack [text .t]
1145     .t insert end "word1 word2"
1146     set res [.t search -nocase -regexp {\mword.} 1.0 end]
1147     destroy .t
1148     set res
1149 } 1.0
1150 test text-20.71 {TextSearchCmd, -regexp -nocase searches} {
1151     catch {destroy .t}
1152     pack [text .t]
1153     .t insert end "word1 word2"
1154     set res [.t search -nocase -regexp {word.\M} 1.0 end]
1155     destroy .t
1156     set res
1157 } 1.0
1158 test text-20.72 {TextSearchCmd, -regexp -nocase searches} {
1159     catch {destroy .t}
1160     pack [text .t]
1161     .t insert end "word1 word2"
1162     set res [.t search -nocase -regexp {word.\W} 1.0 end]
1163     destroy .t
1164     set res
1165 } 1.0
1166
1167 eval destroy [winfo child .]
1168 text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
1169 pack .t2
1170 .t2 insert end "1\t2\t3\t4\t55.5"
1171 test text-21.1 {TkTextGetTabs procedure} {
1172     list [catch {.t2 configure -tabs "\{{}"} msg] $msg
1173 } {1 {unmatched open brace in list}}
1174 test text-21.2 {TkTextGetTabs procedure} {
1175     list [catch {.t2 configure -tabs xyz} msg] $msg
1176 } {1 {bad screen distance "xyz"}}
1177 test text-21.3 {TkTextGetTabs procedure} {
1178     .t2 configure -tabs {100 200}
1179     update idletasks
1180     list [lindex [.t2 bbox 1.2] 0] [lindex [.t2 bbox 1.4] 0]
1181 } {100 200}
1182 test text-21.4 {TkTextGetTabs procedure} {
1183     .t2 configure -tabs {100 right 200 left 300 center 400 numeric}
1184     update idletasks
1185     list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \
1186             [lindex [.t2 bbox 1.4] 0] \
1187             [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \
1188             [lindex [.t2 bbox 1.10] 0]
1189 } {100 200 300 400}
1190 test text-21.5 {TkTextGetTabs procedure} {
1191     .t2 configure -tabs {105 r 205 l 305 c 405 n}
1192     update idletasks
1193     list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \
1194             [lindex [.t2 bbox 1.4] 0] \
1195             [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \
1196             [lindex [.t2 bbox 1.10] 0]
1197 } {105 205 305 405}
1198 test text-21.6 {TkTextGetTabs procedure} {
1199     list [catch {.t2 configure -tabs {100 left 200 lork}} msg] $msg
1200 } {1 {bad tab alignment "lork": must be left, right, center, or numeric}}
1201 test text-21.7 {TkTextGetTabs procedure} {
1202     list [catch {.t2 configure -tabs {100 !44 200 lork}} msg] $msg
1203 } {1 {bad screen distance "!44"}}
1204
1205 eval destroy [winfo child .]
1206 text .t
1207 pack .t
1208 .t insert 1.0 "One Line"
1209 .t mark set insert 1.0
1210
1211 test text-22.1 {TextDumpCmd procedure, bad args} {
1212     list [catch {.t dump} msg] $msg
1213 } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
1214 test text-22.2 {TextDumpCmd procedure, bad args} {
1215     list [catch {.t dump -all} msg] $msg
1216 } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
1217 test text-22.3 {TextDumpCmd procedure, bad args} {
1218     list [catch {.t dump -command} msg] $msg
1219 } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
1220 test text-22.4 {TextDumpCmd procedure, bad args} {
1221     list [catch {.t dump -bogus} msg] $msg
1222 } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
1223 test text-22.5 {TextDumpCmd procedure, bad args} {
1224     list [catch {.t dump bogus} msg] $msg
1225 } {1 {bad text index "bogus"}}
1226 test text-22.6 {TextDumpCmd procedure, one index} {
1227     .t dump -text 1.2
1228 } {text e 1.2}
1229 test text-22.7 {TextDumpCmd procedure, two indices} {
1230     .t dump -text 1.0 1.end
1231 } {text {One Line} 1.0}
1232 test text-22.8 {TextDumpCmd procedure, "end" index} {
1233     .t dump -text 1.end end
1234 } {text {
1235 } 1.8}
1236 test text-22.9 {TextDumpCmd procedure, same indices} {
1237     .t dump 1.5 1.5
1238 } {}
1239 test text-22.10 {TextDumpCmd procedure, negative range} {
1240     .t dump 1.5 1.0
1241 } {}
1242
1243 .t delete 1.0 end
1244 .t insert end "Line One\nLine Two\nLine Three\nLine Four"
1245 .t mark set insert 1.0
1246 .t mark set current 1.0
1247
1248 test text-22.11 {TextDumpCmd procedure, stop at begin-line} {
1249     .t dump -text 1.0 2.0
1250 } {text {Line One
1251 } 1.0}
1252 test text-22.12 {TextDumpCmd procedure, span multiple lines} {
1253     .t dump -text 1.5 3.end
1254 } {text {One
1255 } 1.5 text {Line Two
1256 } 2.0 text {Line Three} 3.0}
1257
1258 .t tag add x 2.0 2.end
1259 .t tag add y 1.0 end
1260 .t mark set m 2.4
1261 .t mark set n 4.0
1262 .t mark set END end
1263 test text-22.13 {TextDumpCmd procedure, tags only} {
1264     .t dump -tag 2.1 2.8
1265 } {}
1266 test text-22.14 {TextDumpCmd procedure, tags only} {
1267     .t dump -tag 2.0 2.8
1268 } {tagon x 2.0}
1269 test text-22.15 {TextDumpCmd procedure, tags only} {
1270     .t dump -tag 1.0 4.end
1271 } {tagon y 1.0 tagon x 2.0 tagoff x 2.8}
1272 test text-22.16 {TextDumpCmd procedure, tags only} {
1273     .t dump -tag 1.0 end
1274 } {tagon y 1.0 tagon x 2.0 tagoff x 2.8 tagoff y 5.0}
1275
1276 .t mark set insert 1.0
1277 .t mark set current 1.0
1278 test text-22.17 {TextDumpCmd procedure, marks only} {
1279     .t dump -mark 1.1 1.8
1280 } {}
1281 test text-22.18 {TextDumpCmd procedure, marks only} {
1282     .t dump -mark 2.0 2.8
1283 } {mark m 2.4}
1284 test text-22.19 {TextDumpCmd procedure, marks only} {
1285     .t dump -mark 1.1 4.end
1286 } {mark m 2.4 mark n 4.0}
1287 test text-22.20 {TextDumpCmd procedure, marks only} {
1288     .t dump -mark 1.0 end
1289 } {mark current 1.0 mark insert 1.0 mark m 2.4 mark n 4.0 mark END 5.0}
1290
1291 button .hello -text Hello
1292 .t window create 3.end -window .hello
1293 for {set i 0} {$i < 100} {incr i} {
1294     .t insert end "-\n"
1295 }
1296 .t window create 100.0 -create { }
1297 test text-22.21 {TextDumpCmd procedure, windows only} {
1298     .t dump -window 1.0 5.0
1299 } {window .hello 3.10}
1300 test text-22.22 {TextDumpCmd procedure, windows only} {
1301     .t dump -window 5.0 end
1302 } {window {} 100.0}
1303
1304 .t delete 1.0 end
1305 eval {.t mark unset} [.t mark names]
1306 .t insert end "Line One\nLine Two\nLine Three\nLine Four"
1307 .t mark set insert 1.0
1308 .t mark set current 1.0
1309 .t tag add x 2.0 2.end
1310 .t mark set m 2.4
1311 proc Append {varName key value index} {
1312     upvar #0 $varName x
1313     lappend x $key $index $value
1314 }
1315 test text-22.23 {TextDumpCmd procedure, command script} {
1316     set x {}
1317     .t dump -command {Append x} -all 1.0 end
1318     set x
1319 } {mark 1.0 current mark 1.0 insert text 1.0 {Line One
1320 } tagon 2.0 x text 2.0 Line mark 2.4 m text 2.4 { Two} tagoff 2.8 x text 2.8 {
1321 } text 3.0 {Line Three
1322 } text 4.0 {Line Four
1323 }}
1324 test text-22.24 {TextDumpCmd procedure, command script} {
1325     set x {}
1326     .t dump -mark -command {Append x} 1.0 end
1327     set x
1328 } {mark 1.0 current mark 1.0 insert mark 2.4 m}
1329 catch {unset x}
1330 test text-22.25 {TextDumpCmd procedure, unicode characters} {
1331     catch {destroy .t}
1332     text .t
1333     .t delete 1.0 end
1334     .t insert 1.0 \xb1\xb1\xb1
1335     .t dump -all 1.0 2.0
1336 } "text \xb1\xb1\xb1 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3"
1337 test text-22.26 {TextDumpCmd procedure, unicode characters} {
1338     catch {destroy .t}
1339     text .t
1340     .t delete 1.0 end
1341     .t insert 1.0 abc\xb1\xb1\xb1
1342     .t dump -all 1.0 2.0
1343 } "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6"
1344
1345 set l [interp hidden]
1346 eval destroy [winfo children .]
1347
1348 test text-23.1 {text widget vs hidden commands} {
1349     catch {destroy .t}
1350     text .t
1351     interp hide {} .t
1352     destroy .t
1353     list [winfo children .] [interp hidden]
1354 } [list {} $l]
1355
1356 test text-24.1 {bug fix - 1642} {
1357     catch {destroy .t}
1358     text .t
1359     pack .t
1360     .t insert end "line 1\n"
1361     .t insert end "line 2\n"
1362     .t insert end "line 3\n"
1363     .t insert end "line 4\n"
1364     .t insert end "line 5\n"
1365     tkTextSetCursor .t 3.0
1366     .t search -backward -regexp "\$" insert 1.0
1367 } {2.6}
1368
1369 eval destroy [winfo child .]
1370 option clear
1371
1372 # cleanup
1373 ::tcltest::cleanupTests
1374 return
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388