head	1.15;
access;
symbols
	core-8-5-9:1.13
	core-8-5-8:1.13
	macosx-cocoa-merge:1.15
	macosx-cocoa-premerge:1.15
	macosx-carbon-freeze:1.15
	core-8-5-7:1.13
	core-8-5-6:1.13
	core-8-6-b1:1.15
	core-8-6-a3:1.14
	core-8-5-5:1.13
	core-8-6-a2:1.14
	core-8-5-4:1.13
	core-8-5-3:1.13
	core-8-6-a1:1.13
	core-8-4-19:1.7
	core-8-5-branch:1.13.0.4
	core-8-5-2:1.13
	core-8-4-18:1.7
	core-8-5-1:1.13
	core-8-4-17:1.7
	core-8-5-0:1.13
	core-8-5-b3:1.13
	core-8-5-b2:1.13
	core-8-4-16:1.7
	core-8-5-b1:1.13
	core-stablilizer-merge:1.13
	core-stabilizer-branch:1.13.0.2
	core-stabilizer-merge:1.13
	core-8-4-15:1.7
	core-8-5-a6:1.12
	core-8-5-a5:1.12
	core-8-4-14:1.7
	core-8-5-a4:1.12
	core-8-4-13:1.7
	core-8-4-12:1.7
	core-8-4-11:1.7
	core-8-5-a3:1.12
	core-8-4-10:1.7
	core-8-4-9-branch:1.7.0.4
	core-8-5-a2:1.12
	core-8-4-9:1.7
	core-8-4-8:1.7
	core-8-4-7:1.7
	core-8-5-a1:1.8
	core-8-4-6:1.7
	core-8-4-5:1.7
	mistachkin-dev-branch:1.8.0.2
	core-8-4-4:1.7
	core-8-4-3:1.7
	core-8-4-branch:1.7.0.2
	core-8-4-2:1.7
	core-8-4-1:1.7
	core-8-3-5:1.5
	core-8-4-0:1.7
	macosx-8-4-merge-2002-08-31-trunk:1.7
	macosx-8-4-premerge-2002-08-31-branch:1.6.2.1
	macosx-8-4-premerge-2002-08-31-trunk:1.7
	macosx-8-4-merge-2002-08-30-branch:1.6.2.1
	macosx-8-4-merge-2002-08-30-trunk:1.7
	macosx-8-4-merge-2002-08-20-branch:1.6.2.1
	macosx-8-4-merge-2002-08-20-trunk:1.7
	core-8-4-b2:1.7
	core-8-4-b1:1.6
	macosx-premerge-6-9-02:1.6
	core-8-4-a4:1.6
	core-8-3-4:1.5
	macosx-8-4-branch:1.6.0.2
	macosx-8-4-branchpoint:1.6
	core-8-4-a3:1.6
	core-8-3-3:1.5
	dgp-privates-into-namespace:1.5.0.6
	tclpro-1-5-0:1.5
	core-8-4-win-speedup:1.5.0.4
	core-8-4-a2:1.5
	tclpro-1-4-1:1.5
	tclpro-1-4-0:1.5
	core-8-3-2:1.5
	ajuba-ajuba2-2-1-base:1.5
	ajuba-ajuba2-2-0:1.5
	core-8-4-a1:1.5
	core-8-3-1-branch:1.5.0.2
	core-8-3-1:1.5
	scriptics-sc-2-0-b5:1.5
	scriptics-sc-2-0-fixed:1.5
	scriptics-sc-2-0-b2:1.5
	scriptics-sc-2-0-b1:1.5
	core-8-3-0:1.4
	core-8-3-b2:1.4
	core-8-3-b1:1.4
	scriptics-sc-1-1:1.3
	scriptics-sc-1-1-b1:1.3
	core-8-2-3:1.3
	scriptics-sc-1-1-branch:1.3.0.10
	scriptics-sc-1-1-base:1.3
	scriptics-sc-1-0:1.3
	scriptics-sc-1-0-branch:1.3.0.8
	scriptics-sc-1-0-base:1.3
	core-8-2-2:1.3
	core-8-2-1:1.3
	scriptics-bc-1-0-b1:1.3
	core-8-2-1-branch:1.3.0.6
	scriptics-tclpro-1-3-0:1.3
	core-8-2-0:1.3
	core-8-2-b3-branch:1.3.0.4
	core-8-2-b3-base:1.3
	scriptics-tclpro-1-3-b4:1.3
	core-8-2-b2:1.3
	scriptics-tclpro-1-3-b3:1.3
	core-8-2-b1:1.3
	scriptics-tclpro-1-3-b2:1.3
	merge-to-mainline-5/21/99:1.3
	scriptics-tclpro-1-3-b2-branch:1.3.0.2
	core-8-1-1:1.3
	scriptics-tclpro-1-3-b1:1.3
	core-8-1-1-base:1.3
	core-8-1-0:1.3
	merge-to-mainline-4-29-99:1.3
	merge-to-mainline-4-23-99:1.3
	core-8-1-branch-old:1.1.0.4
	core-8-0-6-branch:1.2.0.6
	core-8-0-6-base:1.2
	core-8-0-5:1.2
	core-8-1-b3:1.1.4.6
	core-8-1-b2:1.1.4.3
	dev-8-1-stubs-branch:1.1.4.2.0.2
	dev-stubs-branch:1.2.0.4
	scriptics-tclpro-1-2:1.2
	scriptics-tclpro-1-2-b2:1.2
	core-8-1-merge-2/10/99:1.2
	core-8-0-5-branch:1.2.0.2
	core-8-0-5-base:1.2
	scriptics-tclpro-1-2-b1:1.2
	scriptics-tclpro-1-2-a1:1.2
	core-8-1-b1:1.1.4.2
	core-8-0-4:1.2
	core-8-1-a2:1.1.4.1
	core-8-0-2:1.1
	core-8-0-3:1.2;
locks; strict;
comment	@# @;


1.15
date	2008.12.19.15.33.40;	author dgp;	state Exp;
branches;
next	1.14;

1.14
date	2008.08.15.01.10.03;	author aniap;	state Exp;
branches;
next	1.13;

1.13
date	2007.05.09.12.52.44;	author das;	state Exp;
branches;
next	1.12;

1.12
date	2004.06.24.12.45.42;	author dkf;	state Exp;
branches;
next	1.11;

1.11
date	2004.06.17.22.38.57;	author dkf;	state Exp;
branches;
next	1.10;

1.10
date	2004.05.23.17.34.48;	author dkf;	state Exp;
branches;
next	1.9;

1.9
date	2004.03.17.18.15.49;	author das;	state Exp;
branches;
next	1.8;

1.8
date	2003.04.01.21.06.20;	author dgp;	state Exp;
branches;
next	1.7;

1.7
date	2002.07.14.05.48.46;	author dgp;	state Exp;
branches;
next	1.6;

1.6
date	2001.08.01.16.21.12;	author dgp;	state Exp;
branches
	1.6.2.1;
next	1.5;

1.5
date	2000.03.02.03.02.13;	author ericm;	state Exp;
branches
	1.5.4.1
	1.5.6.1;
next	1.4;

1.4
date	99.11.30.00.02.20;	author hobbs;	state Exp;
branches;
next	1.3;

1.3
date	99.04.16.01.51.35;	author stanton;	state Exp;
branches;
next	1.2;

1.2
date	98.09.14.18.23.45;	author stanton;	state Exp;
branches;
next	1.1;

1.1
date	98.04.01.09.58.09;	author rjohnson;	state Exp;
branches
	1.1.4.1;
next	;

1.1.4.1
date	98.09.29.00.25.48;	author stanton;	state Exp;
branches;
next	1.1.4.2;

1.1.4.2
date	98.09.30.02.18.31;	author stanton;	state Exp;
branches;
next	1.1.4.3;

1.1.4.3
date	99.03.11.18.50.43;	author hershey;	state Exp;
branches;
next	1.1.4.4;

1.1.4.4
date	99.03.24.01.16.39;	author hershey;	state Exp;
branches;
next	1.1.4.5;

1.1.4.5
date	99.03.24.02.54.34;	author hershey;	state Exp;
branches;
next	1.1.4.6;

1.1.4.6
date	99.03.26.00.07.52;	author hershey;	state Exp;
branches;
next	;

1.5.4.1
date	2002.04.02.20.57.57;	author hobbs;	state Exp;
branches;
next	;

1.5.6.1
date	2001.02.28.23.29.56;	author dgp;	state Exp;
branches;
next	;

1.6.2.1
date	2002.08.20.20.27.13;	author das;	state Exp;
branches;
next	;


desc
@@


1.15
log
@        * tests/clrpick.test:   Eliminate duplicate test names.
        * tests/embed.test:
        * tests/text.test:
        * tests/textMark.test:
@
text
@# This file is a Tcl script to test out Tk's "tk_chooseColor" command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @@(#) $Id: clrpick.test,v 1.14 2008/08/15 01:10:03 aniap Exp $
#

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

if {[testConstraint defaultPseudocolor8]} {
    # let's soak up a bunch of colors...so that
    # machines with small color palettes still fail.
    # some tests will be skipped if there are no more colors
    set numcolors 32
    testConstraint colorsLeftover 1
    set i 0
    canvas .c
    pack .c -expand 1 -fill both
    while {$i<$numcolors} {
	set color \#[format "%02x%02x%02x" $i [expr $i+1] [expr $i+3]]
	.c create rectangle [expr 10+$i] [expr 10+$i] [expr 50+$i] [expr 50+$i] -fill $color -outline $color
	incr i
    }
    set i 0
    while {$i<$numcolors} {
	set color [.c itemcget $i -fill]
	if {$color != ""} {
	    foreach {r g b} [winfo rgb . $color] {}
	    set r [expr $r/256]
	    set g [expr $g/256]
	    set b [expr $b/256]
	    if {"$color" != "#[format %02x%02x%02x $r $g $b]"} {
		testConstraint colorsLeftover 0
	    }
	}
	.c delete $i
	incr i
    }
    destroy .c
} else {
    testConstraint colorsLeftover 0
}

test clrpick-1.1 {tk_chooseColor command} -body {
    tk_chooseColor -foo
} -returnCodes error -result {bad option "-foo": must be -initialcolor, -parent, or -title}

test clrpick-1.2 {tk_chooseColor command } -body {
    tk_chooseColor -initialcolor
} -returnCodes error -result {value for "-initialcolor" missing}
test clrpick-1.2.1 {tk_chooseColor command } -body {
    tk_chooseColor -parent
} -returnCodes error -result {value for "-parent" missing}
test clrpick-1.2.2 {tk_chooseColor command } -body {
    tk_chooseColor -title
} -returnCodes error -result {value for "-title" missing}

test clrpick-1.3 {tk_chooseColor command} -body {
    tk_chooseColor -foo bar
} -returnCodes error -result {bad option "-foo": must be -initialcolor, -parent, or -title}
test clrpick-1.4 {tk_chooseColor command} -body {
    tk_chooseColor -initialcolor
} -returnCodes error -result {value for "-initialcolor" missing}
test clrpick-1.5 {tk_chooseColor command} -body {
    tk_chooseColor -parent foo.bar
} -returnCodes error -result {bad window path name "foo.bar"}
test clrpick-1.6 {tk_chooseColor command} -body {
    tk_chooseColor -initialcolor badbadbaadcolor
} -returnCodes error -result {unknown color name "badbadbaadcolor"}
test clrpick-1.7 {tk_chooseColor command} -body {
    tk_chooseColor -initialcolor ##badbadbaadcolor
} -returnCodes error -result {invalid color name "##badbadbaadcolor"}


# tests 3.1 and 3.2 fail when individually run
# if there is no catch {tk_chooseColor -foo 1} msg
# before settin isNative
catch {tk_chooseColor -foo 1} msg 
set isNative [expr {[info commands tk::dialog::color::] eq ""}]

proc ToPressButton {parent btn} {
    global isNative
    if {!$isNative} {
	after 200 "SendButtonPress . $btn mouse"
    }
}

proc ToChooseColorByKey {parent r g b} {
    global isNative
    if {!$isNative} {
	after 200 ChooseColorByKey . $r $g $b
    }
}

proc PressButton {btn} {
    event generate $btn <Enter>
    event generate $btn <1> -x 5 -y 5
    event generate $btn <ButtonRelease-1> -x 5 -y 5
}

proc ChooseColorByKey {parent r g b} {
    set w .__tk__color
    upvar ::tk::dialog::color::[winfo name $w] data

    update
    $data(red,entry)   delete 0 end
    $data(green,entry) delete 0 end
    $data(blue,entry)  delete 0 end

    $data(red,entry)   insert 0 $r
    $data(green,entry) insert 0 $g
    $data(blue,entry)  insert 0 $b

    # Manually force the refresh of the color values instead
    # of counting on the timing of the event stream to change
    # the values for us.
    tk::dialog::color::HandleRGBEntry $w

    SendButtonPress . ok mouse
}

proc SendButtonPress {parent btn type} {
    set w .__tk__color
    upvar ::tk::dialog::color::[winfo name $w] data

    set button $data($btn\Btn)
    if ![winfo ismapped $button] {
	update
    }

    if {$type == "mouse"} {
	PressButton $button
    } else {
	event generate $w <Enter>
	focus $w
	event generate $button <Enter>
	event generate $w <KeyPress> -keysym Return
    }
}



test clrpick-2.1 {tk_chooseColor command} -constraints {
    nonUnixUserInteraction colorsLeftover
} -setup {
    set verylongstring longstring:
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    #set verylongstring $verylongstring$verylongstring
    # Interesting thing...when this is too long, the
    # delay caused in processing it kills the automated testing,
    # and makes a lot of the test cases fail.
    #set verylongstring $verylongstring$verylongstring
    #set verylongstring $verylongstring$verylongstring
    #set verylongstring $verylongstring$verylongstring
    #set verylongstring $verylongstring$verylongstring
} -body {
    ToPressButton . ok
    tk_chooseColor -title "Press Ok $verylongstring" -initialcolor #404040 \
        -parent .
} -result {#404040}
test clrpick-2.2 {tk_chooseColor command} -constraints {
    nonUnixUserInteraction colorsLeftover
} -body {
    set colors "128 128 64"
    ToChooseColorByKey . 128 128 64
    tk_chooseColor -parent . -title "choose #808040"
} -result {#808040}
test clrpick-2.3 {tk_chooseColor command} -constraints {
    nonUnixUserInteraction colorsLeftover
} -body {
    ToPressButton . ok
    tk_chooseColor -parent . -title "Press OK"
} -result {#808040}
test clrpick-2.4 {tk_chooseColor command} -constraints {
    nonUnixUserInteraction colorsLeftover
} -body {
    ToPressButton . cancel
    tk_chooseColor -parent . -title "Press Cancel"
} -result {}


test clrpick-3.1 {tk_chooseColor: background events} -constraints {
	nonUnixUserInteraction
} -body {
    after 1 {set x 53}
    ToPressButton . ok
    tk_chooseColor -parent . -title "Press OK" -initialcolor #000000
} -result {#000000}
test clrpick-3.2 {tk_chooseColor: background events} -constraints {
	nonUnixUserInteraction
} -body {
    after 1 {set x 53}
    ToPressButton . cancel
    tk_chooseColor -parent . -title "Press Cancel"
} -result {}


test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} -constraints {
	unix notAqua
} -body {
    after 50 {set ::scr [winfo screen .__tk__color]}
    ToPressButton . cancel
    tk_chooseColor -parent .
    set ::scr
} -result [winfo screen .]

# cleanup
cleanupTests
return

@


1.14
log
@Update to tcltest2
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.13 2007/05/09 12:52:44 das Exp $
d57 1
a57 1
test clrpick-1.2 {tk_chooseColor command } -body {
d60 1
a60 1
test clrpick-1.2 {tk_chooseColor command } -body {
@


1.13
log
@	* tests/constraints.tcl: ensure 'nonUnixUserInteraction' constraint is
				 set for aqua.

	* tests/choosedir.test:	add 'notAqua' constraints to X11-only tests;
	* tests/clrpick.test:	add 'nonUnixUserInteraction' to 'unix' tests
	* tests/menuDraw.test:	requiring interaction on aqua.
	* tests/unixMenu.test:
	* tests/unixWm.test:
	* tests/winMenu.test:
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.12 2004/06/24 12:45:42 dkf Exp $
d11 1
a11 1
package require tcltest 2.1
d14 1
d50 35
a84 32
test clrpick-1.1 {tk_chooseColor command} {
    list [catch {tk_chooseColor -foo} msg] $msg
} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}

catch {tk_chooseColor -foo 1} msg
regsub -all ,      $msg "" options
regsub \"-foo\" $options "" options

foreach option $options {
    if {[string index $option 0] eq "-"} {
	test clrpick-1.2$option {tk_chooseColor command} -body {
	    tk_chooseColor $option
	} -returnCodes error -result "value for \"$option\" missing"
    }
}

test clrpick-1.3 {tk_chooseColor command} {
    list [catch {tk_chooseColor -foo bar} msg] $msg
} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}
test clrpick-1.4 {tk_chooseColor command} {
    list [catch {tk_chooseColor -initialcolor} msg] $msg
} {1 {value for "-initialcolor" missing}}
test clrpick-1.5 {tk_chooseColor command} {
    list [catch {tk_chooseColor -parent foo.bar} msg] $msg
} {1 {bad window path name "foo.bar"}}
test clrpick-1.6 {tk_chooseColor command} {
    list [catch {tk_chooseColor -initialcolor badbadbaadcolor} msg] $msg
} {1 {unknown color name "badbadbaadcolor"}}
test clrpick-1.7 {tk_chooseColor command} {
    list [catch {tk_chooseColor -initialcolor ##badbadbaadcolor} msg] $msg
} {1 {invalid color name "##badbadbaadcolor"}}

d90 1
a90 1
	after 200 "SendButtonPress $parent $btn mouse"
d97 1
a97 1
	after 200 ChooseColorByKey $parent $r $g $b
d125 1
a125 1
    SendButtonPress $parent ok mouse
a146 1
set parent .
d148 25
a172 24
set verylongstring longstring:
set verylongstring $verylongstring$verylongstring
set verylongstring $verylongstring$verylongstring
set verylongstring $verylongstring$verylongstring
set verylongstring $verylongstring$verylongstring
#set verylongstring $verylongstring$verylongstring
# Interesting thing...when this is too long, the
# delay caused in processing it kills the automated testing,
# and makes a lot of the test cases fail.
#set verylongstring $verylongstring$verylongstring
#set verylongstring $verylongstring$verylongstring
#set verylongstring $verylongstring$verylongstring
#set verylongstring $verylongstring$verylongstring

set color #404040
test clrpick-2.1 {tk_chooseColor command} \
	{nonUnixUserInteraction colorsLeftover} {
    ToPressButton $parent ok
    tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color \
	    -parent $parent
} "$color"
set color #808040
test clrpick-2.2 {tk_chooseColor command} \
	{nonUnixUserInteraction colorsLeftover} {
d174 20
a193 15
    ToChooseColorByKey $parent 128 128 64
    tk_chooseColor -parent $parent -title "choose $colors"
} "$color"
test clrpick-2.3 {tk_chooseColor command} \
	{nonUnixUserInteraction colorsLeftover} {
    ToPressButton $parent ok
    tk_chooseColor -parent $parent -title "Press OK"
} "$color"
test clrpick-2.4 {tk_chooseColor command} {nonUnixUserInteraction} {
    ToPressButton $parent cancel
    tk_chooseColor -parent $parent -title "Press Cancel"
} ""

set color "#000000"
test clrpick-3.1 {tk_chooseColor: background events} {nonUnixUserInteraction} {
d195 6
a200 4
    ToPressButton $parent ok
    tk_chooseColor -parent $parent -title "Press OK" -initialcolor $color
} "#000000"
test clrpick-3.2 {tk_chooseColor: background events} {nonUnixUserInteraction} {
d202 3
a204 3
    ToPressButton $parent cancel
    tk_chooseColor -parent $parent -title "Press Cancel"
} ""
d206 4
a209 1
test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} {unix notAqua} {
d211 2
a212 2
    ToPressButton $parent cancel
    tk_chooseColor -parent $parent
d214 1
a214 1
} [winfo screen $parent]
d219 1
@


1.12
log
@Use standard constraint names
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.11 2004/06/17 22:38:57 dkf Exp $
d195 1
a195 1
test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} unix {
@


1.11
log
@Steps towards systematization of test constraints in Tk test suite
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.10 2004/05/23 17:34:48 dkf Exp $
d195 1
a195 1
test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} unixOnly {
@


1.10
log
@First step towards improving test style.  Also start using Tcl 8.5 features.
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.9 2004/03/17 18:15:49 das Exp $
d15 34
a67 1

a70 1

a73 1

a76 1

a158 31
# let's soak up a bunch of colors...so that
# machines with small color palettes still fail.
# some tests will be skipped if there are no more colors
set numcolors 32
testConstraint colorsLeftover 1
set i 0
canvas .c
pack .c -expand 1 -fill both
while {$i<$numcolors} {
    set color \#[format "%02x%02x%02x" $i [expr $i+1] [expr $i+3]]
    .c create rectangle [expr 10+$i] [expr 10+$i] [expr 50+$i] [expr 50+$i] -fill $color -outline $color
    incr i
}
set i 0
while {$i<$numcolors} {
    set color [.c itemcget $i -fill]
    if {$color != ""} {
	foreach {r g b} [winfo rgb . $color] {}
	set r [expr $r/256]
	set g [expr $g/256]
	set b [expr $b/256]
	if {"$color" != "#[format %02x%02x%02x $r $g $b]"} {
	    testConstraint colorsLeftover 0
	}
    }
    .c delete $i
    incr i
}

destroy .c

a165 1

a172 1

a177 1

@


1.9
log
@Removed support for Mac OS Classic platform [Patch 918139]
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.8 2003/04/01 21:06:20 dgp Exp $
d24 4
a27 4
    if {[string index $option 0] == "-"} {
	test clrpick-1.2 {tk_chooseColor command} {
	    list [catch {tk_chooseColor $option} msg] $msg
	} [list 1 "value for \"$option\" missing"]
d51 1
a51 5
if {[info commands tk::dialog::color::] == ""} {
    set isNative 1
} else {
    set isNative 0
}
@


1.8
log
@        * tests/all.tcl:                Made better use of a common
        * tests/constraints.tcl:        -loadfile to hold definitions
        * tests/*.test:                 common to all test files.
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.7 2002/07/14 05:48:46 dgp Exp $
d175 1
a175 5
    if {$tcl_platform(platform) == "macintosh"} {
	set colors "32768 32768 16384"
    } else {
	set colors "128 128 64"
    }
@


1.7
log
@	* Completed conversion of Tk test suite to use tcltest.
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.6 2001/08/01 16:21:12 dgp Exp $
d12 1
a12 4
namespace import -force tcltest::configure
namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
d215 1
a215 1
::tcltest::cleanupTests
@


1.6
log
@	Merged changes from feature branch dgp-privates-into-namespace,
	implementing TIP 44.  All Tk commands and variables matching
	tk[A-Z]* are now in the ::tk namespace.
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.5 2000/03/02 03:02:13 ericm Exp $
d11 6
a16 9
if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Some tests require user interaction on non-unix platform

set ::tcltest::testConfig(nonUnixUserInteraction) \
    [expr {$::tcltest::testConfig(userInteraction) || \
	$::tcltest::testConfig(unixOnly)}]
d140 1
a140 1
set ::tcltest::testConfig(colorsLeftover) 1
d158 1
a158 1
	    set ::tcltest::testConfig(colorsLeftover) 0
@


1.6.2.1
log
@merged with trunk at tag macosx-8-4-merge-2002-08-20-trunk
@
text
@d8 1
a8 1
# RCS: @@(#) $Id$
d11 9
a19 6
package require tcltest 2.1
namespace import -force tcltest::configure
namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
d143 1
a143 1
testConstraint colorsLeftover 1
d161 1
a161 1
	    testConstraint colorsLeftover 0
@


1.5
log
@* tests/clrpick.test:
* library/clrpick.tcl: Added code to make color chooser dialog
inherit screen setting from parent (bug #2334)
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.4 1999/11/30 00:02:20 hobbs Exp $
d57 1
a57 1
if {[info commands tkColorDialog] == ""} {
d85 1
a85 1
    upvar #0 $w data
d99 1
a99 1
    tkColorDialog_HandleRGBEntry $w
d106 1
a106 1
    upvar #0 $w data
@


1.5.4.1
log
@sync with head
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.6 2001/08/01 16:21:12 dgp Exp $
d57 1
a57 1
if {[info commands tk::dialog::color::] == ""} {
d85 1
a85 1
    upvar ::tk::dialog::color::[winfo name $w] data
d99 1
a99 1
    tk::dialog::color::HandleRGBEntry $w
d106 1
a106 1
    upvar ::tk::dialog::color::[winfo name $w] data
@


1.5.6.1
log
@2001-02-28  Don Porter  <dgp@@users.sourceforge.net>

        BRANCH dgp-privates-into-namespace:  Feature branch to move all
        of Tk's private commands and variable into the ::tk namespace
        and its children.

        * doc/tkvars.n:  Documented private variable tkPriv renamed tk::Priv.

        * generic/tkBind.c:
        * generic/tkMenu.c:
        * generic/tkTextDisp.c:
        * library/bgerror.tcl:
        * library/button.tcl:
        * library/choosedir.tcl:
        * library/clrpick.tcl:
        * library/comdlg.tcl:
        * library/console.tcl:
        * library/dialog.tcl:
        * library/entry.tcl:
        * library/focus.tcl:
        * library/listbox.tcl:
        * library/menu.tcl:
        * library/msgbox.tcl:
        * library/optMenu.tcl:
        * library/palette.tcl:
        * library/scale.tcl:
        * library/scrlbar.tcl:
        * library/spinbox.tcl:
        * library/tclIndex:
        * library/tearoff.tcl:
        * library/text.tcl:
        * library/tk.tcl:
        * library/tkfbox.tcl:
        * library/xmfbox.tcl:
        * mac/tkMacMenu.c:
        * tests/clrpick.test:
        * tests/filebox.test:
        * tests/macMenu.test:
        * tests/menu.test:
        * tests/menuDraw.test:
        * tests/msgbox.test:
        * tests/text.test:
        * tests/textDisp.test:
        * tests/unixMenu.test:
        * tests/winMenu.test:
        * tests/xmfbox.test:
        * unix/tkUnixDialog.c:  All Tk commands matching ::tk[A-Z]* and
        all Tk private variables in the global namespace were renamed to
        live in the namespace ::tk or one of its children.
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.5 2000/03/02 03:02:13 ericm Exp $
d57 1
a57 1
if {[info commands tk::dialog::color::] == ""} {
d85 1
a85 1
    upvar ::tk::dialog::color::[winfo name $w] data
d99 1
a99 1
    tk::dialog::color::HandleRGBEntry $w
d106 1
a106 1
    upvar ::tk::dialog::color::[winfo name $w] data
@


1.4
log
@minor whitespace cleanup
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.3 1999/04/16 01:51:35 stanton Exp $
d201 1
a201 1
set color #000000
d212 7
@


1.3
log
@* Merged 8.1 branch into the main trunk
@
text
@d8 1
a8 1
# RCS: @@(#) $Id$
d177 1
a177 1
    
d189 1
a189 1
    
d195 1
a195 1
    
a215 13













@


1.2
log
@Replaced SCCS strings, fixed binary files
@
text
@d5 2
a6 3
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
d11 2
a12 2
if {[string compare test [info procs test]] == 1} {
    source defs
d15 6
d23 1
a23 1
} {1 {unknown option "-foo", must be -initialcolor, -parent or -title}}
d25 1
a25 1
catch {tk_chooseColor -foo} msg
d39 1
a39 1
} {1 {unknown option "-foo", must be -initialcolor, -parent or -title}}
a62 8
if {$isNative && ![info exists INTERACTIVE]} {
    puts " Some tests were skipped because they could not be performed"
    puts " automatically on this platform. If you wish to execute them"
    puts " interactively, set the TCL variable INTERACTIVE and re-run"
    puts " the test."
    return
}

d141 1
d143 1
a143 1
set nomorecolors 0
d161 1
a161 1
	    set nomorecolors 1
d170 7
a176 6
if {!$nomorecolors} {
    set color #404040
    test clrpick-2.1 {tk_chooseColor command} {
	ToPressButton $parent ok
	tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color -parent $parent
    } "$color"
d178 11
a188 10
    set color #808040
    test clrpick-2.2 {tk_chooseColor command} {
	if {$tcl_platform(platform) == "macintosh"} {
	    set colors "32768 32768 16384"
	} else {
	    set colors "128 128 64"
	}
	ToChooseColorByKey $parent 128 128 64
	tk_chooseColor -parent $parent -title "choose $colors"
    } "$color"
d190 5
a194 9
    test clrpick-2.3 {tk_chooseColor command} {
	ToPressButton $parent ok
	tk_chooseColor -parent $parent -title "Press OK"
    } "$color"
} else {
    puts "Skipped tests clrpick2.1, clrpick2.2 and clrpick2.3 because"
    puts "you ran out of colors in your color palette, and this would"
    puts "have caused the tests to generate errors."
}
d196 1
a196 1
test clrpick-2.4 {tk_chooseColor command} {
d202 1
a202 1
test clrpick-3.1 {tk_chooseColor: background events} {
d207 1
a207 1
test clrpick-3.2 {tk_chooseColor: background events} {
d212 17
@


1.1
log
@Initial revision
@
text
@d9 1
a9 1
# @@(#) clrpick.test 1.9 97/10/21 11:29:53
@


1.1.4.1
log
@initial tk8.1a2 version
@
text
@d9 1
a9 1
# @@(#) clrpick.test 1.10 97/10/29 10:33:44
d18 1
a18 1
} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}
d20 1
a20 1
catch {tk_chooseColor -foo 1} msg
d34 1
a34 1
} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}
@


1.1.4.2
log
@Merged 8.0.3 changes into 8.1
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: clrpick.test,v 1.2 1998/09/14 18:23:45 stanton Exp $
@


1.1.4.3
log
@Updated the testsuite to use "test" namespace and commandline args
to control verbose  level and which tests get run.  Tests now work from
any working dir.
@
text
@a4 2
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
d6 4
a9 1
# RCS: @@(#) $Id: clrpick.test,v 1.1.4.2 1998/09/30 02:18:31 stanton Exp $
d12 2
a13 2
if {[lsearch [namespace children] ::test] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
a215 4

# cleanup
::test::cleanupTests
return
@


1.1.4.4
log
@- changed ::test to ::tcltest
- made many tests more atomic (still more work to do here)
- defs.tcl is now identicle for tcl and tk
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.1.4.3 1999/03/11 18:50:43 hershey Exp $
d11 1
a11 1
if {[lsearch [namespace children] ::tcltest] == -1} {
a52 1
    set ::tcltest::testConfig(tkDialog) 0
d55 8
a62 1
    set ::tcltest::testConfig(tkDialog) 1
a142 1
# some tests will be skipped if there are no more colors
d144 1
a144 1
set ::tcltest::testConfig(colorsLeftover) 1
d162 1
a162 1
	    set ::tcltest::testConfig(colorsLeftover) 0
d171 6
a176 7
set color #404040
test clrpick-2.1 {tk_chooseColor command} \
	{interactive colorsLeftover tkDialog} {
    ToPressButton $parent ok
    tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color \
	    -parent $parent
} "$color"
d178 10
a187 11
set color #808040
test clrpick-2.2 {tk_chooseColor command} \
	{interactive colorsLeftover tkDialog} {
    if {$tcl_platform(platform) == "macintosh"} {
	set colors "32768 32768 16384"
    } else {
	set colors "128 128 64"
    }
    ToChooseColorByKey $parent 128 128 64
    tk_chooseColor -parent $parent -title "choose $colors"
} "$color"
d189 9
a197 5
test clrpick-2.3 {tk_chooseColor command} \
	{interactive colorsLeftover tkDialog} {
    ToPressButton $parent ok
    tk_chooseColor -parent $parent -title "Press OK"
} "$color"
d199 1
a199 1
test clrpick-2.4 {tk_chooseColor command} {interactive tkDialog} {
d205 1
a205 1
test clrpick-3.1 {tk_chooseColor: background events} {interactive tkDialog} {
d210 1
a210 1
test clrpick-3.2 {tk_chooseColor: background events} {interactive tkDialog} {
d217 1
a217 1
::tcltest::cleanupTests
a218 12












@


1.1.4.5
log
@lint:  changed a tcltest namespace variable name from tmpDir to
       workingDir.
changes:  made more tests atomic.
README is now updated to match new test suite features.
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.1.4.4 1999/03/24 01:16:39 hershey Exp $
a211 1

@


1.1.4.6
log
@Now all test files that skip tests by returning early (which ideally they
shouldn't do) call ::tcltest::cleanupTests before returning.  The defs.tcl
file has one hew constraint:  userInteraction, used by tests that require
user interaction.  The next putback will include an updated version of the
"visual" test file to use this mechanism.
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: clrpick.test,v 1.1.4.5 1999/03/24 02:54:34 hershey Exp $
a14 6
# Some tests require user interaction on non-unix platform

set ::tcltest::testConfig(nonUnixUserInteraction) \
    [expr {$::tcltest::testConfig(userInteraction) || \
	$::tcltest::testConfig(unixOnly)}]

d53 1
d56 1
d168 1
a168 1
	{nonUnixUserInteraction colorsLeftover} {
d176 1
a176 1
	{nonUnixUserInteraction colorsLeftover} {
d187 1
a187 1
	{nonUnixUserInteraction colorsLeftover} {
d192 1
a192 1
test clrpick-2.4 {tk_chooseColor command} {nonUnixUserInteraction} {
d198 1
a198 1
test clrpick-3.1 {tk_chooseColor: background events} {nonUnixUserInteraction} {
d203 1
a203 1
test clrpick-3.2 {tk_chooseColor: background events} {nonUnixUserInteraction} {
@


