diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/option.file1 | 17 | ||||
| -rw-r--r-- | tests/option.file2 | 2 | ||||
| -rw-r--r-- | tests/visual | 81 |
3 files changed, 100 insertions, 0 deletions
diff --git a/tests/option.file1 b/tests/option.file1 new file mode 100644 index 0000000..e64b6cc --- /dev/null +++ b/tests/option.file1 @@ -0,0 +1,17 @@ +! This file is a sample option (resource) database used to test +! Tk's option-handling capabilities. + +! Comment line \ + with a backslash-newline sequence embedded in it. + +*x1: blue + tktest.x2 : green +*\ +x3 \ + : pur\ +ple +*x 4: brown +# More comments, this time delimited by hash-marks. + # Comment-line with space. +*x6: +# comment line as last line of file. diff --git a/tests/option.file2 b/tests/option.file2 new file mode 100644 index 0000000..f1d020a --- /dev/null +++ b/tests/option.file2 @@ -0,0 +1,2 @@ +*foo1: magenta +foo2 missing colon diff --git a/tests/visual b/tests/visual new file mode 100644 index 0000000..1964c5d --- /dev/null +++ b/tests/visual @@ -0,0 +1,81 @@ +#!/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 $ + +set auto_path ". $auto_path" +wm title . "Visual Tests for Tk" + +#------------------------------------------------------- +# 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 exit + +menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m +menu .menu.group1.m +.menu.group1.m add command -label "Canvas arcs" -command {source arc.tcl} +.menu.group1.m add command -label "Beveled borders in text widgets" \ + -command {source bevel.tcl} +.menu.group1.m add command -label "Colormap management" \ + -command {source cmap.tcl} +.menu.group1.m add command -label "Label/button geometry" \ + -command {source butGeom.tcl} +.menu.group1.m add command -label "Label/button colors" \ + -command {source 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 {source canvPsGrph.tcl} +.menu.ps.m add command -label "Text" \ + -command {source canvPsText.tcl} +.menu.ps.m add command -label "Bitmaps" \ + -command {source canvPsBmap.tcl} +.menu.ps.m add command -label "Arcs" \ + -command {source 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 + +# 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 +} + +# 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]} |