# This file is a Tcl script to test out Tk's selection management code,
# especially the "selection" command.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1993 The Regents of the University of California.
# All rights reserved.
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
# CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
# $Header: /user6/ouster/wish/tests/RCS/select.test,v 1.4 93/06/04 08:44:14 ouster Exp $ (Berkeley)

if {[string compare test [info procs test]] == 1} {
    source defs
}

catch {destroy .f1}
catch {destroy .f2}
catch {destroy .f3}

frame .f1
frame .f2
frame .f3

proc handler {type offset count} {
    global selValue selInfo

    lappend selInfo $type $offset $count
    set numBytes [expr {[string length $selValue] - $offset}]
    if {$numBytes <= 0} {
	return ""
    }
    string range $selValue $offset [expr $numBytes+$offset]
}

proc errHandler args {
    error "selection handler aborted"
}

# Eliminate any existing selection on the screen.  This is needed in case
# there is a selection in some other application, in order to prevent races
# from causing false errors in the tests below.

selection clear .
after 1000

test select-1.1 {simple Tcl-based handler} {
    selection own .f1
    lsort [selection get TARGETS]
} {APPLICATION MULTIPLE TARGETS TIMESTAMP WINDOW_NAME}
selection handle .f1 {handler TEST} TEST
test select-1.2 {simple Tcl-based handler} {
    selection own .f1
    lsort [selection get TARGETS]
} {APPLICATION MULTIPLE TARGETS TEST TIMESTAMP WINDOW_NAME}
test select-1.3 {simple Tcl-based handler} {
    selection own .f1
    set selValue "Test value"
    set selInfo ""
    list [selection get TEST] $selInfo
} {{Test value} {TEST 0 4000}}
selection handle .f1 {handler STRING}
test select-1.4 {simple Tcl-based handler} {
    selection own .f1
    lsort [selection get TARGETS]
} {APPLICATION MULTIPLE STRING TARGETS TEST TIMESTAMP WINDOW_NAME}
test select-1.5 {simple Tcl-based handler} {
    selection own .f1
    set selValue ""
    set selInfo ""
    list [selection get] $selInfo
} {{} {STRING 0 4000}}
test select-1.6 {simple Tcl-based handler} {
    list [catch {selection get BADTARGET} msg] $msg
} {1 {selection doesn't exist or form "BADTARGET" not defined}}
test select-1.7 {simple Tcl-based handler} {
    set lostSel {XXX}
    selection own .f1 {set lostSel "selection gone"}
    selection own .f2
    set lostSel
} {selection gone}
selection handle .f1 ERROR errHandler
test select-1.8 {simple Tcl-based handler} {
    selection own .f1
    list [catch {selection get ERROR} msg] $msg
} {1 {selection doesn't exist or form "ERROR" not defined}}
if $atBerkeley {
    test select-1.9 {simple Tcl-based handler} {
	set lostSel {XXX}
	set selValue "Test2"
	set selInfo ""
	selection own .f1 {set lostSel "selection gone"}
	destroy .f1
	list [catch {selection get} msg] $msg $lostSel $selInfo
    } {1 {selection doesn't exist or form "STRING" not defined} XXX {}}
}

selection handle .f2 {handler STRING.f2}
set selValue ""
foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} {
    set j $i.1$i.2$i.3$i.4$i.5$i.6$i.7$i.8$i.9$i.10$i.11$i.12$i.13$i.14
    append selValue A$j B$j C$j D$j E$j F$j G$j H$j I$j K$j L$j M$j N$j
}
test select-2.1 {long retrievals} {
    selection own .f2
    set selInfo ""
    list [selection get] $selInfo
} "$selValue {STRING.f2 0 4000 STRING.f2 4000 4000 STRING.f2 8000 4000 STRING.f2 12000 4000 STRING.f2 16000 4000}"

test select-3.1 {handlers provided by Tk} {
    selection own .f2
    list [selection get APPLICATION] [selection get WINDOW_NAME]
} [list [winfo name .] .f2]
selection handle .f2 {handler TARGETS.f2} TARGETS
test select-3.2 {handlers provided by Tk} {
    selection own .f2
    set selValue "Timestamp value"
    set selInfo ""
    list [selection get TARGETS] $selInfo
} {{Timestamp value} {TARGETS.f2 0 4000}}
selection handle .f2 {} TARGETS
test select-3.3 {handlers provided by Tk} {
    selection get TARGETS
} {APPLICATION MULTIPLE TARGETS TIMESTAMP WINDOW_NAME STRING}

catch {destroy .f1}
frame .f1
selection handle .f1 {handler TEST1.f1} TEST1
selection handle .f1 {handler TEST2.f1} TEST2
selection handle .f1 {handler TEST3.f1} TEST3
test select-4.1 {modifying and deleting handlers} {
    selection handle .f1 {handler TEST1.new} TEST1
    selection own .f1
    set selValue "value"
    set selInfo ""
    list [selection get TEST1] $selInfo
} {value {TEST1.new 0 4000}}
selection handle .f1 {} TEST2
test select-4.2 {modifying and deleting handlers} {
    selection get TARGETS
} {APPLICATION MULTIPLE TARGETS TIMESTAMP WINDOW_NAME TEST3 TEST1}
selection handle .f1 {} TEST1
test select-4.3 {modifying and deleting handlers} {
    selection get TARGETS
} {APPLICATION MULTIPLE TARGETS TIMESTAMP WINDOW_NAME TEST3}
selection handle .f1 {} TEST3
test select-4.4 {modifying and deleting handlers} {
    selection get TARGETS
} {APPLICATION MULTIPLE TARGETS TIMESTAMP WINDOW_NAME}

test select-5.1 {clearing the selection} {
    selection own .f2
    set result [selection get WINDOW_NAME]
    selection clear .
    list $result [catch {selection get WINDOW_NAME} msg] $msg
} {.f2 1 {selection doesn't exist or form "WINDOW_NAME" not defined}}

test select-6.1 {selection own option} {
    selection own .f2
    selection own
} .f2
test select-6.2 {selection own option} {
    selection own .f3
    selection clear .
    selection own
} {}

test select-6.1 {errors in selection command} {
    list [catch selection msg] $msg
} {1 {wrong # args: should be "selection option ?arg arg ...?"}}
test select-6.2 {errors in selection command} {
    list [catch {selection junk} msg] $msg
} {1 {bad option "junk":  must be clear, get, handle, or own}}
test select-6.3 {errors in selection command} {
    list [catch {selection clear} msg] $msg
} {1 {wrong # args: should be "selection clear window"}}
test select-6.4 {errors in selection command} {
    list [catch {selection clear foo} msg] $msg
} {1 {bad window path name "foo"}}
test select-6.5 {errors in selection command} {
    list [catch {selection get a b} msg] $msg
} {1 {too may args: should be "selection get ?type?"}}
test select-6.6 {errors in selection command} {
    list [catch {selection handle a} msg] $msg
} {1 {wrong # args: should be "selection handle window command ?type? ?format?"}}
test select-6.7 {errors in selection command} {
    list [catch {selection handle a b c d e} msg] $msg
} {1 {wrong # args: should be "selection handle window command ?type? ?format?"}}
test select-6.8 {errors in selection command} {
    list [catch {selection own a b c} msg] $msg
} {1 {wrong # args: should be "selection own ?window? ?command?"}}
test select-6.9 {errors in selection command} {
    list [catch {selection own junk} msg] $msg
} {1 {bad window path name "junk"}}

destroy .f1
destroy .f2
destroy .f3