text.test

linux系统下的音频通信

    text .t2
    .t2 insert 1.0 "abcdef\nghijk\n1234"
    .t2 tag add sel 1.0 1.3
    set x [selection get]
    selection clear
    lappend x [catch {selection get} msg] $msg
    .t2 tag add sel 1.0 1.3
    lappend x [selection get]
} {abc 1 {PRIMARY selection doesn't exist or form "STRING" not defined} abc}

.t delete 1.0 end
.t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx"
test text-20.1 {TextSearchCmd procedure, argument parsing} {
    list [catch {.t search -} msg] $msg
} {1 {bad switch "-": must be -forward, -backward, -exact, -regexp, -nocase, -count, or --}}
test text-20.2 {TextSearchCmd procedure, -backwards option} {
    .t search -backwards xyz 1.4
} {1.1}
test text-20.3 {TextSearchCmd procedure, -forwards option} {
    .t search -forwards xyz 1.4
} {1.5}
test text-20.4 {TextSearchCmd procedure, -exact option} {
    .t search -f -exact x. 1.0
} {1.9}
test text-20.5 {TextSearchCmd procedure, -regexp option} {
    .t search -b -regexp x.z 1.4
} {1.1}
test text-20.6 {TextSearchCmd procedure, -count option} {
    set length unmodified
    list [.t search -count length x. 1.4] $length
} {1.9 2}
test text-20.7 {TextSearchCmd procedure, -count option} {
    list [catch {.t search -count} msg] $msg
} {1 {no value given for "-count" option}}
test text-20.8 {TextSearchCmd procedure, -nocase option} {
    list [.t search -nocase BaR 1.1] [.t search BaR 1.1]
} {2.13 2.23}
test text-20.9 {TextSearchCmd procedure, -nocase option} {
    .t search -n BaR 1.1
} {2.13}
test text-20.10 {TextSearchCmd procedure, -- option} {
    .t search -- -forward 1.0
} {2.4}
test text-20.11 {TextSearchCmd procedure, argument parsing} {
    list [catch {.t search abc} msg] $msg
} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?}}
test text-20.12 {TextSearchCmd procedure, argument parsing} {
    list [catch {.t search abc d e f} msg] $msg
} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?}}
test text-20.13 {TextSearchCmd procedure, check index} {
    list [catch {.t search abc gorp} msg] $msg
} {1 {bad text index "gorp"}}
test text-20.14 {TextSearchCmd procedure, startIndex == "end"} {
    .t search non-existent end
} {}
test text-20.15 {TextSearchCmd procedure, startIndex == "end"} {
    .t search non-existent end
} {}
test text-20.16 {TextSearchCmd procedure, bad stopIndex} {
    list [catch {.t search abc 1.0 lousy} msg] $msg
} {1 {bad text index "lousy"}}
test text-20.17 {TextSearchCmd procedure, pattern case conversion} {
    list [.t search -nocase BAR 1.1] [.t search BAR 1.1]
} {2.13 {}}
test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} {
    list [catch {.t search -regexp a( 1.0} msg] $msg
} {1 {couldn't compile regular expression pattern: unmatched ()}}
test text-20.19 {TextSearchCmd procedure, skip dummy last line} {
    .t search -backwards BaR end 1.0
} {2.23}
test text-20.20 {TextSearchCmd procedure, skip dummy last line} {
    .t search -backwards \n end 1.0
} {3.9}
test text-20.21 {TextSearchCmd procedure, skip dummy last line} {
    .t search \n end
} {1.15}
test text-20.22 {TextSearchCmd procedure, skip dummy last line} {
    .t search -back \n 1.0
} {3.9}
test text-20.23 {TextSearchCmd procedure, extract line contents} {
    .t tag add foo 1.2
    .t tag add x 1.3
    .t mark set silly 1.2
    .t search xyz 3.6
} {1.1}
test text-20.24 {TextSearchCmd procedure, stripping newlines} {
    .t search the\n 1.0
} {1.12}
test text-20.25 {TextSearchCmd procedure, stripping newlines} {
    .t search -regexp the\n 1.0
} {}
test text-20.26 {TextSearchCmd procedure, stripping newlines} {
    .t search -regexp {the$} 1.0
} {1.12}
test text-20.27 {TextSearchCmd procedure, stripping newlines} {
    .t search -regexp \n 1.0
} {}
test text-20.28 {TextSearchCmd procedure, line case conversion} {
    list [.t search -nocase bar 2.18] [.t search bar 2.18]
} {2.23 2.13}
test text-20.29 {TextSearchCmd procedure, firstChar and lastChar} {
    .t search -backwards xyz 1.6
} {1.5}
test text-20.30 {TextSearchCmd procedure, firstChar and lastChar} {
    .t search -backwards xyz 1.5
} {1.1}
test text-20.31 {TextSearchCmd procedure, firstChar and lastChar} {
    .t search xyz 1.5
} {1.5}
test text-20.32 {TextSearchCmd procedure, firstChar and lastChar} {
    .t search xyz 1.6
} {3.0}
test text-20.33 {TextSearchCmd procedure, firstChar and lastChar} {
    .t search {} 1.end
} {1.15}
test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} {
    .t search f 1.end
} {2.0}
test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} {
    .t search {} end
} {1.0}
catch {destroy .t2}
toplevel .t2
wm geometry .t2 +0+0
text .t2.t -width 30 -height 10
pack .t2.t
.t2.t insert 1.0 "This is a line\nand this is another"
.t2.t insert end "\nand this is yet another"
frame .t2.f -width 20 -height 20 -bd 2 -relief raised
.t2.t window create 2.5 -window .t2.f
test text-20.36 {TextSearchCmd procedure, firstChar and lastChar} {
    .t2.t search his 2.6
} {2.6}
test text-20.37 {TextSearchCmd procedure, firstChar and lastChar} {
    .t2.t search this 2.6
} {3.4}
test text-20.38 {TextSearchCmd procedure, firstChar and lastChar} {
    .t2.t search is 2.6
} {2.7}
test text-20.39 {TextSearchCmd procedure, firstChar and lastChar} {
    .t2.t search his 2.7
} {3.5}
test text-20.40 {TextSearchCmd procedure, firstChar and lastChar} {
    .t2.t search -backwards "his is another" 2.6
} {2.6}
test text-20.41 {TextSearchCmd procedure, firstChar and lastChar} {
    .t2.t search -backwards "his is" 2.6
} {1.1}
destroy .t2
test text-20.42 {TextSearchCmd procedure, firstChar and lastChar} {
    .t search -backwards forw 2.5
} {2.5}
test text-20.43 {TextSearchCmd procedure, firstChar and lastChar} {
    .t search forw 2.5
} {2.5}
test text-20.44 {TextSearchCmd procedure, firstChar and lastChar} {
    catch {destroy .t2}
    text .t2
    list [.t2 search a 1.0] [.t2 search -backward a 1.0]
} {{} {}}
test text-20.45 {TextSearchCmd procedure, regexp match length} {
    set length unchanged
    list [.t search -regexp -count length x(.)(.*)z 1.1] $length
} {1.1 7}
test text-20.46 {TextSearchCmd procedure, regexp match length} {
    set length unchanged
    list [.t search -regexp -backward -count length fo* 2.5] $length
} {2.0 3}
test text-20.47 {TextSearchCmd procedure, checking stopIndex} {
    list [.t search bar 2.1 2.13] [.t search bar 2.1 2.14] \
	    [.t search bar 2.12 2.14] [.t search bar 2.14 2.14]
} {{} 2.13 2.13 {}}
test text-20.48 {TextSearchCmd procedure, checking stopIndex} {
    list [.t search -backwards bar 2.20 2.13] \
	    [.t search -backwards bar 2.20 2.14] \
	    [.t search -backwards bar 2.14 2.13] \
	    [.t search -backwards bar 2.13 2.13]
} {2.13 {} 2.13 {}}
test text-20.49 {TextSearchCmd procedure, embedded windows and index/count} {
    frame .t.f1 -width 20 -height 20 -relief raised -bd 2
    frame .t.f2 -width 20 -height 20 -relief raised -bd 2
    frame .t.f3 -width 20 -height 20 -relief raised -bd 2
    frame .t.f4 -width 20 -height 20 -relief raised -bd 2
    .t window create 2.10 -window .t.f3
    .t window create 2.8 -window .t.f2
    .t window create 2.8 -window .t.f1
    .t window create 2.1 -window .t.f4
    set result ""
    lappend result [.t search -count x forward 1.0] $x
    lappend result [.t search -count x wa 1.0] $x
    .t delete 2.1
    .t delete 2.8 2.10
    .t delete 2.10
    set result
} {2.6 10 2.11 2}
test text-20.50 {TextSearchCmd procedure, error setting variable} {
    catch {unset a}
    set a 44
    list [catch {.t search -count a(2) xyz 1.0} msg] $msg
} {1 {can't set "a(2)": variable isn't array}}
test text-20.51 {TextSearchCmd procedure, wrap-around} {
    .t search -backwards xyz 1.1
} {3.5}
test text-20.52 {TextSearchCmd procedure, wrap-around} {
    .t search -backwards xyz 1.1 1.0
} {}
test text-20.53 {TextSearchCmd procedure, wrap-around} {
    .t search xyz 3.6
} {1.1}
test text-20.54 {TextSearchCmd procedure, wrap-around} {
    .t search xyz 3.6 end
} {}
test text-20.55 {TextSearchCmd procedure, no match} {
    .t search non_existent 3.5
} {}
test text-20.56 {TextSearchCmd procedure, no match} {
    .t search -regexp non_existent 3.5
} {}
test text-20.57 {TextSearchCmd procedure, special cases} {
    .t search -back x 1.1
} {1.0}
test text-20.58 {TextSearchCmd procedure, special cases} {
    .t search -back x 1.0
} {3.8}
test text-20.59 {TextSearchCmd procedure, special cases} {
    .t search \n {end-2c}
} {3.9}
test text-20.60 {TextSearchCmd procedure, special cases} {
    .t search \n end
} {1.15}
test text-20.61 {TextSearchCmd procedure, special cases} {
    .t search x 1.0
} {1.0}
test text-20.62 {TextSearchCmd, freeing copy of pattern} {
    # This test doesn't return a result, but it will generate
    # a core leak if the pattern copy isn't properly freed.

    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
} {}

eval destroy [winfo child .]
text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
pack .t2
.t2 insert end "1\t2\t3\t4\t55.5"
test text-21.1 {TkTextGetTabs procedure} {
    list [catch {.t2 configure -tabs "\{{}"} msg] $msg
} {1 {unmatched open brace in list}}
test text-21.2 {TkTextGetTabs procedure} {
    list [catch {.t2 configure -tabs xyz} msg] $msg
} {1 {bad screen distance "xyz"}}
test text-21.3 {TkTextGetTabs procedure} {
    .t2 configure -tabs {100 200}
    update idletasks
    list [lindex [.t2 bbox 1.2] 0] [lindex [.t2 bbox 1.4] 0]
} {100 200}
test text-21.4 {TkTextGetTabs procedure} {
    .t2 configure -tabs {100 right 200 left 300 center 400 numeric}
    update idletasks
    list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \
	    [lindex [.t2 bbox 1.4] 0] \
	    [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \
	    [lindex [.t2 bbox 1.10] 0]
} {100 200 300 400}
test text-21.5 {TkTextGetTabs procedure} {
    .t2 configure -tabs {105 r 205 l 305 c 405 n}
    update idletasks
    list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \
	    [lindex [.t2 bbox 1.4] 0] \
	    [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \
	    [lindex [.t2 bbox 1.10] 0]
} {105 205 305 405}
test text-21.6 {TkTextGetTabs procedure} {
    list [catch {.t2 configure -tabs {100 left 200 lork}} msg] $msg
} {1 {bad tab alignment "lork": must be left, right, center, or numeric}}
test text-21.7 {TkTextGetTabs procedure} {
    list [catch {.t2 configure -tabs {100 !44 200 lork}} msg] $msg
} {1 {bad screen distance "!44"}}

eval destroy [winfo child .]
text .t
pack .t
.t insert 1.0 "One Line"
.t mark set insert 1.0

test text-22.1 {TextDumpCmd procedure, bad args} {
    list [catch {.t dump} msg] $msg
} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
test text-22.2 {TextDumpCmd procedure, bad args} {
    list [catch {.t dump -all} msg] $msg
} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
test text-22.3 {TextDumpCmd procedure, bad args} {
    list [catch {.t dump -command} msg] $msg
} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
test text-22.4 {TextDumpCmd procedure, bad args} {
    list [catch {.t dump -bogus} msg] $msg
} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
test text-22.5 {TextDumpCmd procedure, bad args} {
    list [catch {.t dump bogus} msg] $msg
} {1 {bad text index "bogus"}}
test text-22.6 {TextDumpCmd procedure, one index} {
    .t dump -text 1.2
} {text e 1.2}
test text-22.7 {TextDumpCmd procedure, two indices} {
    .t dump -text 1.0 1.end
} {text {One Line} 1.0}
test text-22.8 {TextDumpCmd procedure, "end" index} {
    .t dump -text 1.end end
} {text {
} 1.8}
test text-22.9 {TextDumpCmd procedure, same indices} {
    .t dump 1.5 1.5
} {}
test text-22.10 {TextDumpCmd procedure, negative range} {
    .t dump 1.5 1.0
} {}

.t delete 1.0 end
.t insert end "Line One\nLine Two\nLine Three\nLine Four"
.t mark set insert 1.0
.t mark set current 1.0

test text-22.11 {TextDumpCmd procedure, stop at begin-line} {
    .t dump -text 1.0 2.0
} {text {Line One
} 1.0}
test text-22.12 {TextDumpCmd procedure, span multiple lines} {
    .t dump -text 1.5 3.end
} {text {One
} 1.5 text {Line Two
} 2.0 text {Line Three} 3.0}

.t tag add x 2.0 2.end
.t tag add y 1.0 end
.t mark set m 2.4
.t mark set n 4.0
.t mark set END end
test text-22.13 {TextDumpCmd procedure, tags only} {
    .t dump -tag 2.1 2.8
} {}
test text-22.14 {TextDumpCmd procedure, tags only} {
    .t dump -tag 2.0 2.8
} {tagon x 2.0}
test text-22.15 {TextDumpCmd procedure, tags only} {
    .t dump -tag 1.0 4.end
} {tagon y 1.0 tagon x 2.0 tagoff x 2.8}
test text-22.16 {TextDumpCmd procedure, tags only} {
    .t dump -tag 1.0 end
} {tagon y 1.0 tagon x 2.0 tagoff x 2.8 tagoff y 5.0}

.t mark set insert 1.0
.t mark set current 1.0
test text-22.17 {TextDumpCmd procedure, marks only} {
    .t dump -mark 1.1 1.8
} {}
test text-22.18 {TextDumpCmd procedure, marks only} {
    .t dump -mark 2.0 2.8
} {mark m 2.4}
test text-22.19 {TextDumpCmd procedure, marks only} {
    .t dump -mark 1.1 4.end
} {mark m 2.4 mark n 4.0}
test text-22.20 {TextDumpCmd procedure, marks only} {
    .t dump -mark 1.0 end
} {mark current 1.0 mark insert 1.0 mark m 2.4 mark n 4.0 mark END 5.0}

button .hello -text Hello
.t window create 3.end -window .hello
for {set i 0} {$i < 100} {incr i} {
    .t insert end "-\n"
}
.t window create 100.0 -create { }
test text-22.21 {TextDumpCmd procedure, windows only} {
    .t dump -window 1.0 5.0
} {window .hello 3.10}
test text-22.22 {TextDumpCmd procedure, windows only} {
    .t dump -window 5.0 end
} {window {} 100.0}

.t delete 1.0 end
eval {.t mark unset} [.t mark names]
.t insert end "Line One\nLine Two\nLine Three\nLine Four"
.t mark set insert 1.0
.t mark set current 1.0
.t tag add x 2.0 2.end
.t mark set m 2.4
proc Append {varName key value index} {
    upvar #0 $varName x
    lappend x $key $index $value
}
test text-22.23 {TextDumpCmd procedure, command script} {
    set x {}
    .t dump -command {Append x} -all 1.0 end
    set x
} {mark 1.0 current mark 1.0 insert text 1.0 {Line One
} tagon 2.0 x text 2.0 Line mark 2.4 m text 2.4 { Two} tagoff 2.8 x text 2.8 {
} text 3.0 {Line Three
} text 4.0 {Line Four
}}
test text-22.24 {TextDumpCmd procedure, command script} {
    set x {}
    .t dump -mark -command {Append x} 1.0 end
    set x
} {mark 1.0 current mark 1.0 insert mark 2.4 m}
catch {unset x}

set l [interp hidden]
eval destroy [winfo children .]

test text-23.1 {text widget vs hidden commands} {
    catch {destroy .t}
    text .t
    interp hide {} .t
    destroy .t
    list [winfo children .] [interp hidden]
} [list {} $l]

eval destroy [winfo child .]
option clear