summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/option.file117
-rw-r--r--tests/option.file22
-rw-r--r--tests/visual81
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..90e8558
--- /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.
+#
+# SCCS: @(#) visual 1.5 97/06/13 16:37:29
+
+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]}