head	1.9;
access;
symbols
	core-8-5-9:1.8
	core-8-5-8:1.8
	macosx-cocoa-merge:1.9
	macosx-cocoa-premerge:1.9
	macosx-carbon-freeze:1.9
	core-8-5-7:1.8
	core-8-5-6:1.8
	core-8-6-b1:1.9
	core-8-6-a3:1.9
	core-8-5-5:1.8
	core-8-6-a2:1.8
	core-8-5-4:1.8
	core-8-5-3:1.8
	core-8-6-a1:1.8
	core-8-4-19:1.7
	core-8-5-branch:1.8.0.6
	core-8-5-2:1.8
	core-8-4-18:1.7
	core-8-5-1:1.8
	core-8-4-17:1.7
	core-8-5-0:1.8
	core-8-5-b3:1.8
	core-8-5-b2:1.8
	core-8-4-16:1.7
	core-8-5-b1:1.8
	core-stablilizer-merge:1.8
	core-stabilizer-branch:1.8.0.4
	core-stabilizer-merge:1.8
	core-8-4-15:1.7
	core-8-5-a6:1.8
	core-8-5-a5:1.8
	core-8-4-14:1.7
	core-8-5-a4:1.8
	core-8-4-13:1.7
	core-8-4-12:1.7
	core-8-4-11:1.7
	core-8-5-a3:1.8
	core-8-4-10:1.7
	core-8-4-9-branch:1.7.0.4
	core-8-5-a2:1.8
	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.3
	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.3.8.1
	macosx-8-4-premerge-2002-08-31-trunk:1.7
	macosx-8-4-merge-2002-08-30-branch:1.3.8.1
	macosx-8-4-merge-2002-08-30-trunk:1.7
	macosx-8-4-merge-2002-08-20-branch:1.3.8.1
	macosx-8-4-merge-2002-08-20-trunk:1.7
	core-8-4-b2:1.7
	core-8-4-b1:1.3
	macosx-premerge-6-9-02:1.3
	core-8-4-a4:1.3
	core-8-3-4:1.3
	macosx-8-4-branch:1.3.0.8
	macosx-8-4-branchpoint:1.3
	core-8-4-a3:1.3
	core-8-3-3:1.3
	dgp-privates-into-namespace:1.3.0.6
	tclpro-1-5-0:1.3
	core-8-4-win-speedup:1.3.0.4
	core-8-4-a2:1.3
	tclpro-1-4-1:1.3
	tclpro-1-4-0:1.3
	core-8-3-2:1.3
	ajuba-ajuba2-2-1-base:1.3
	ajuba-ajuba2-2-0:1.3
	core-8-4-a1:1.3
	core-8-3-1-branch:1.3.0.2
	core-8-3-1:1.3
	scriptics-sc-2-0-b5:1.3
	scriptics-sc-2-0-fixed:1.3
	scriptics-sc-2-0-b2:1.3
	scriptics-sc-2-0-b1:1.3
	core-8-3-0:1.3
	core-8-3-b2:1.3
	core-8-3-b1:1.3
	scriptics-sc-1-1:1.2
	scriptics-sc-1-1-b1:1.2
	core-8-2-3:1.2
	scriptics-sc-1-1-branch:1.2.0.10
	scriptics-sc-1-1-base:1.2
	scriptics-sc-1-0:1.2
	scriptics-sc-1-0-branch:1.2.0.8
	scriptics-sc-1-0-base:1.2
	core-8-2-2:1.2
	core-8-2-1:1.2
	scriptics-bc-1-0-b1:1.2
	core-8-2-1-branch:1.2.0.6
	scriptics-tclpro-1-3-0:1.2
	core-8-2-0:1.2
	core-8-2-b3-branch:1.2.0.4
	core-8-2-b3-base:1.2
	scriptics-tclpro-1-3-b4:1.2
	core-8-2-b2:1.2
	scriptics-tclpro-1-3-b3:1.2
	core-8-2-b1:1.2
	scriptics-tclpro-1-3-b2:1.2
	merge-to-mainline-5/21/99:1.2
	scriptics-tclpro-1-3-b2-branch:1.2.0.2
	core-8-1-1:1.2
	scriptics-tclpro-1-3-b1:1.2
	core-8-1-1-base:1.2
	core-8-1-0:1.2
	merge-to-mainline-4-29-99:1.2
	merge-to-mainline-4-23-99:1.2
	core-8-1-branch-old:1.1.0.2
	core-8-1-b3:1.1.2.1;
locks; strict;
comment	@# @;


1.9
date	2008.08.30.21.52.26;	author aniap;	state Exp;
branches;
next	1.8;

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

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

1.6
date	2002.07.13.20.28.36;	author dgp;	state Exp;
branches;
next	1.5;

1.5
date	2002.07.12.13.41.01;	author dgp;	state Exp;
branches;
next	1.4;

1.4
date	2002.07.11.13.01.31;	author dkf;	state Exp;
branches;
next	1.3;

1.3
date	99.12.14.06.53.15;	author hobbs;	state Exp;
branches
	1.3.8.1;
next	1.2;

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

1.1
date	99.04.05.18.36.06;	author hershey;	state dead;
branches
	1.1.2.1;
next	;

1.1.2.1
date	99.04.05.18.36.06;	author hershey;	state Exp;
branches;
next	;

1.3.8.1
date	2002.08.20.20.27.16;	author das;	state Exp;
branches;
next	;


desc
@@


1.9
log
@Update to tcltest2
@
text
@#!/usr/local/bin/wish -f
#
# This script displays provides visual tests for many of Tk's features.
# Each test displays a window with various information in it, along
# with instructions about how the window should appear.  You can look
# at the window to make sure it appears as expected.  Individual tests
# are kept in separate ".tcl" files in this directory.
#
# RCS: @@(#) $Id: visual_bb.test,v 1.8 2003/04/01 21:07:00 dgp Exp $

package require tcltest 2.2
namespace import ::tcltest::*
tcltest::configure {*}$argv
tcltest::loadTestedCommands


set auto_path ". $auto_path"
wm title . "Visual Tests for Tk"

set testNum 1

# Each menu entry invokes a visual test file

proc runTest {file} {
    global testNum

    test "2.$testNum" "testing $file" {userInteraction} {
    uplevel \#0 source [file join [testsDirectory] $file]
    concat ""
    } {}
    incr testNum
}

# The following procedure is invoked to print the contents of a canvas:

proc lpr {c args} {
    exec lpr <<[eval [list $c postscript] $args]
}

proc end {} {
    cleanupTests
    set ::EndOfVisualTests 1
}

# ----------------------------------------------------------------------

test 1.1 {running visual tests} -constraints userInteraction -body {
    #-------------------------------------------------------
    # The code below create the main window, consisting of a
    # menu bar and a message explaining the basic operation
    # of the program.
    #-------------------------------------------------------

    frame .menu -relief raised -borderwidth 1
    message .msg -font {Times 18} -relief raised -width 4i \
        -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit.  Each menu entry invokes a test, which displays information on the screen.  You can then verify visually that the information is being displayed in the correct way.  The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets."
   
    pack .menu -side top -fill x
    pack .msg -side bottom -expand yes -fill both

    #-------------------------------------------------------
    # The code below creates all the menus, which invoke procedures
    # to create particular demonstrations of various widgets.
    #-------------------------------------------------------

    menubutton .menu.file -text "File" -menu .menu.file.m
    menu .menu.file.m
    .menu.file.m add command -label "Quit" -command end
   
    menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m
    menu .menu.group1.m
    .menu.group1.m add command -label "Canvas arcs" -command {runTest arc.tcl}
    .menu.group1.m add command -label "Beveled borders in text widgets" \
        -command {runTest bevel.tcl}
    .menu.group1.m add command -label "Colormap management" \
        -command {runTest cmap.tcl}
    .menu.group1.m add command -label "Label/button geometry" \
        -command {runTest butGeom.tcl}
    .menu.group1.m add command -label "Label/button colors" \
        -command {runTest butGeom2.tcl}
   
    menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m
    menu .menu.ps.m
    .menu.ps.m add command -label "Rectangles and other graphics" \
        -command {runTest canvPsGrph.tcl}
    .menu.ps.m add command -label "Text" \
        -command {runTest canvPsText.tcl}
    .menu.ps.m add command -label "Bitmaps" \
        -command {runTest canvPsBmap.tcl}
    .menu.ps.m add command -label "Images" \
        -command {runTest canvPsImg.tcl}
    .menu.ps.m add command -label "Arcs" \
        -command {runTest canvPsArc.tcl}
   
    pack .menu.file .menu.group1 .menu.ps -side left -padx 1m
   
    # Set up for keyboard-based menu traversal
   
    bind . <Any-FocusIn> {
    if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
        focus .menu
    }
    }
    tk_menuBar .menu .menu.file .menu.group1 .menu.ps

    # Set up a class binding to allow objects to be deleted from a canvas
    # by clicking with mouse button 1:

    bind Canvas <1> {%W delete [%W find closest %x %y]}

    concat ""
} -result {}

if {![testConstraint userInteraction]} {
    cleanupTests
} else {
    vwait EndOfVisualTests
}
@


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
@d9 1
a9 1
# RCS: @@(#) $Id: visual_bb.test,v 1.7 2002/07/14 18:31:48 dgp Exp $
d11 3
a13 2
package require tcltest 2.1
eval tcltest::configure $argv
d16 1
d28 2
a29 2
	uplevel \#0 source [file join [testsDirectory] $file]
	concat ""
d45 3
a47 1
test 1.1 "running visual tests" {userInteraction} {
d56 2
a57 2
	    -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit.  Each menu entry invokes a test, which displays information on the screen.  You can then verify visually that the information is being displayed in the correct way.  The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets."
    
d69 1
a69 1
    
d74 1
a74 1
	    -command {runTest bevel.tcl}
d76 1
a76 1
	    -command {runTest cmap.tcl}
d78 1
a78 1
	    -command {runTest butGeom.tcl}
d80 2
a81 2
	    -command {runTest butGeom2.tcl}
    
d85 1
a85 1
	    -command {runTest canvPsGrph.tcl}
d87 1
a87 1
	    -command {runTest canvPsText.tcl}
d89 1
a89 1
	    -command {runTest canvPsBmap.tcl}
d91 1
a91 1
	    -command {runTest canvPsImg.tcl}
d93 2
a94 2
	    -command {runTest canvPsArc.tcl}
    
d96 1
a96 1
    
d98 1
a98 1
    
d100 3
a102 3
	if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
	    focus .menu
	}
d112 1
a112 1
} {}
@


1.7
log
@        * tests/event.test:     Fixes to enable testing of only userInteraction
        * tests/visual_bb.test: tests.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: visual_bb.test,v 1.6 2002/07/13 20:28:36 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]
a13 2

namespace import -force tcltest::cleanupTests
@


1.6
log
@	* Converted more files to tcltest and factored out common code.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: visual_bb.test,v 1.5 2002/07/12 13:41:01 dgp Exp $
d43 5
d69 1
a69 1
    .menu.file.m add command -label "Quit" -command cleanupTests
d117 2
@


1.5
log
@	* Converted several files in the Tk test suite for testing by
	tcltest 2.1.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: visual_bb.test,v 1.4 2002/07/11 13:01:31 dkf Exp $
d12 1
a12 2
namespace import -force tcltest::test
namespace import -force tcltest::testConstraint
a13 2
namespace import -force tcltest::cleanupTests
namespace import -force tcltest::configure
d17 2
a18 1
eval configure $argv
@


1.4
log
@tests/visual_vv.test:	Removed some dependence on [exec]ed utilities

generic/tkImgPhoto.c:	Allowed photo image buffer allocation to fail more
tests/imgPhoto.test:	gracefully in some cicumstances.  The remaining ones
			require API changes before they can fail nicely.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: visual_bb.test,v 1.3 1999/12/14 06:53:15 hobbs Exp $
d11 10
a20 3
if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}
d33 1
a33 1
	uplevel \#0 source [file join $::tcltest::testsDir $file]
d66 1
a66 1
    .menu.file.m add command -label "Quit" -command ::tcltest::cleanupTests
d89 1
a89 1
	    -command {source canvPsImg.tcl}
d112 2
a113 2
if {!$::tcltest::testConfig(userInteraction)} {
    ::tcltest::cleanupTests
@


1.3
log
@	* tests/bind.test:
	* tests/canvImg.test:
	* tests/canvPsArc.tcl:
	* tests/canvPsImg.tcl: (new file)
	* tests/canvRect.test:
	* tests/canvText.test:
	* tests/canvas.test:
	* tests/defs.tcl:
	* tests/entry.test:
	* tests/event.test:
	* tests/font.test:
	* tests/frame.test:
	* tests/imgPhoto.test:
	* tests/safe.test:
	* tests/scale.test:
	* tests/scrollbar.test:
	* tests/select.test:
	* tests/text.test:
	* tests/textDisp.test:
	* tests/textTag.test:
	* tests/unixFont.test:
	* tests/unixWm.test:
	* tests/visual_bb.test:
	* tests/winClipboard.test: tests for the dash patch changes
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: visual_bb.test,v 1.2 1999/04/16 01:51:43 stanton Exp $
d34 2
a35 5
proc lpr c {
    exec rm -f tmp.ps
    $c postscript -file tmp.ps
    exec lpr tmp.ps
    exec rm -f tmp.ps
a38 1

@


1.3.8.1
log
@merged with trunk at tag macosx-8-4-merge-2002-08-20-trunk
@
text
@d9 1
a9 1
# RCS: @@(#) $Id$
d11 3
a13 8
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

namespace import -force tcltest::cleanupTests
d26 1
a26 1
	uplevel \#0 source [file join [testsDirectory] $file]
d34 5
a38 2
proc lpr {c args} {
    exec lpr <<[eval [list $c postscript] $args]
d41 1
a41 4
proc end {} {
    cleanupTests
    set ::EndOfVisualTests 1
}
a42 1
test 1.1 "running visual tests" {userInteraction} {
d63 1
a63 1
    .menu.file.m add command -label "Quit" -command end
d86 1
a86 1
	    -command {runTest canvPsImg.tcl}
d109 2
a110 4
if {![testConstraint userInteraction]} {
    cleanupTests
} else {
    vwait EndOfVisualTests
@


1.2
log
@* Merged 8.1 branch into the main trunk
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: visual_bb.test,v 1.1.2.1 1999/04/05 18:36:06 hershey Exp $
d85 2
@


1.1
log
@file visual_bb.test was initially added on branch core-8-1-branch.
@
text
@d1 109
@


1.1.2.1
log
@fixed bad "fd" reference in send.test and unixSend.test--now refers to
::tcltest::fd (bugID 1523).

renamed "visual" test file to "visual_bb.test" and made it use the "test"
command with the userInteractive constraint.
@
text
@a0 109
#!/usr/local/bin/wish -f
#
# This script displays provides visual tests for many of Tk's features.
# Each test displays a window with various information in it, along
# with instructions about how the window should appear.  You can look
# at the window to make sure it appears as expected.  Individual tests
# are kept in separate ".tcl" files in this directory.
#
# RCS: @@(#) $Id: visual,v 1.1.4.1 1998/09/30 02:19:04 stanton Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

set auto_path ". $auto_path"
wm title . "Visual Tests for Tk"

set testNum 1

# Each menu entry invokes a visual test file

proc runTest {file} {
    global testNum

    test "2.$testNum" "testing $file" {userInteraction} {
	uplevel \#0 source [file join $::tcltest::testsDir $file]
	concat ""
    } {}
    incr testNum
}

# The following procedure is invoked to print the contents of a canvas:

proc lpr c {
    exec rm -f tmp.ps
    $c postscript -file tmp.ps
    exec lpr tmp.ps
    exec rm -f tmp.ps
}

test 1.1 "running visual tests" {userInteraction} {

    #-------------------------------------------------------
    # The code below create the main window, consisting of a
    # menu bar and a message explaining the basic operation
    # of the program.
    #-------------------------------------------------------

    frame .menu -relief raised -borderwidth 1
    message .msg -font {Times 18} -relief raised -width 4i \
	    -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit.  Each menu entry invokes a test, which displays information on the screen.  You can then verify visually that the information is being displayed in the correct way.  The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets."
    
    pack .menu -side top -fill x
    pack .msg -side bottom -expand yes -fill both

    #-------------------------------------------------------
    # The code below creates all the menus, which invoke procedures
    # to create particular demonstrations of various widgets.
    #-------------------------------------------------------

    menubutton .menu.file -text "File" -menu .menu.file.m
    menu .menu.file.m
    .menu.file.m add command -label "Quit" -command ::tcltest::cleanupTests
    
    menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m
    menu .menu.group1.m
    .menu.group1.m add command -label "Canvas arcs" -command {runTest arc.tcl}
    .menu.group1.m add command -label "Beveled borders in text widgets" \
	    -command {runTest bevel.tcl}
    .menu.group1.m add command -label "Colormap management" \
	    -command {runTest cmap.tcl}
    .menu.group1.m add command -label "Label/button geometry" \
	    -command {runTest butGeom.tcl}
    .menu.group1.m add command -label "Label/button colors" \
	    -command {runTest butGeom2.tcl}
    
    menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m
    menu .menu.ps.m
    .menu.ps.m add command -label "Rectangles and other graphics" \
	    -command {runTest canvPsGrph.tcl}
    .menu.ps.m add command -label "Text" \
	    -command {runTest canvPsText.tcl}
    .menu.ps.m add command -label "Bitmaps" \
	    -command {runTest canvPsBmap.tcl}
    .menu.ps.m add command -label "Arcs" \
	    -command {runTest canvPsArc.tcl}
    
    pack .menu.file .menu.group1 .menu.ps -side left -padx 1m
    
    # Set up for keyboard-based menu traversal
    
    bind . <Any-FocusIn> {
	if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
	    focus .menu
	}
    }
    tk_menuBar .menu .menu.file .menu.group1 .menu.ps

    # Set up a class binding to allow objects to be deleted from a canvas
    # by clicking with mouse button 1:

    bind Canvas <1> {%W delete [%W find closest %x %y]}

    concat ""
} {}

if {!$::tcltest::testConfig(userInteraction)} {
    ::tcltest::cleanupTests
}
@

