1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391
|
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"
# widget --
# This script demonstrates the various widgets provided by Tk,
# along with many of the features of the Tk toolkit. This file
# only contains code to generate the main window for the
# application, which invokes individual demonstrations. The
# code for the actual demonstrations is contained in separate
# ".tcl" files is this directory, which are sourced by this script
# as needed.
#
# RCS: @(#) $Id: widget,v 1.9 2000/09/26 10:51:21 spolk Exp $
eval destroy [winfo child .]
wm title . "Widget Demonstration"
set widgetDemo 1
#----------------------------------------------------------------
# The code below create the main window, consisting of a menu bar
# and a text widget that explains how to use the program, plus lists
# all of the demos as hypertext items.
#----------------------------------------------------------------
set font {Helvetica 14}
menu .menuBar -tearoff 0
.menuBar add cascade -menu .menuBar.file -label "File" -underline 0
menu .menuBar.file -tearoff 0
# On the Mac use the specia .apple menu for the about item
if {$tcl_platform(platform) == "macintosh"} {
.menuBar add cascade -menu .menuBar.apple
menu .menuBar.apple -tearoff 0
.menuBar.apple add command -label "About..." -command "aboutBox"
} else {
.menuBar.file add command -label "About..." -command "aboutBox" \
-underline 0 -accelerator "<F1>"
.menuBar.file add sep
}
.menuBar.file add command -label "Quit" -command "exit" -underline 0 \
-accelerator "Meta-Q"
. configure -menu .menuBar
bind . <F1> aboutBox
frame .statusBar
label .statusBar.lab -text " " -relief sunken -bd 1 \
-font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
label .statusBar.foo -width 8 -relief sunken -bd 1 \
-font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
pack .statusBar.lab -side left -padx 2 -expand yes -fill both
pack .statusBar.foo -side left -padx 2
pack .statusBar -side bottom -fill x -pady 2
frame .textFrame
scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \
-takefocus 1
pack .s -in .textFrame -side right -fill y
text .t -yscrollcommand {.s set} -wrap word -width 60 -height 30 -font $font \
-setgrid 1 -highlightthickness 0 -padx 4 -pady 2 -takefocus 0
pack .t -in .textFrame -expand y -fill both -padx 1
pack .textFrame -expand yes -fill both
# Create a bunch of tags to use in the text widget, such as those for
# section titles and demo descriptions. Also define the bindings for
# tags.
.t tag configure title -font {Helvetica 18 bold}
# We put some "space" characters to the left and right of each demo description
# so that the descriptions are highlighted only when the mouse cursor
# is right over them (but not when the cursor is to their left or right)
#
.t tag configure demospace -lmargin1 1c -lmargin2 1c
if {[winfo depth .] == 1} {
.t tag configure demo -lmargin1 1c -lmargin2 1c \
-underline 1
.t tag configure visited -lmargin1 1c -lmargin2 1c \
-underline 1
.t tag configure hot -background black -foreground white
} else {
.t tag configure demo -lmargin1 1c -lmargin2 1c \
-foreground blue -underline 1
.t tag configure visited -lmargin1 1c -lmargin2 1c \
-foreground #303080 -underline 1
.t tag configure hot -foreground red -underline 1
}
.t tag bind demo <ButtonRelease-1> {
invoke [.t index {@%x,%y}]
}
set lastLine ""
.t tag bind demo <Enter> {
set lastLine [.t index {@%x,%y linestart}]
.t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
.t config -cursor hand2
showStatus [.t index {@%x,%y}]
}
.t tag bind demo <Leave> {
.t tag remove hot 1.0 end
.t config -cursor xterm
.statusBar.lab config -text ""
}
.t tag bind demo <Motion> {
set newLine [.t index {@%x,%y linestart}]
if {[string compare $newLine $lastLine] != 0} {
.t tag remove hot 1.0 end
set lastLine $newLine
set tags [.t tag names {@%x,%y}]
set i [lsearch -glob $tags demo-*]
if {$i >= 0} {
.t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
}
}
showStatus [.t index {@%x,%y}]
}
# Create the text for the text widget.
.t insert end "Tk Widget Demonstrations\n" title
.t insert end {
This application provides a front end for several short scripts that demonstrate what you can do with Tk widgets. Each of the numbered lines below describes a demonstration; you can click on it to invoke the demonstration. Once the demonstration window appears, you can click the "See Code" button to see the Tcl/Tk code that created the demonstration. If you wish, you can edit the code and click the "Rerun Demo" button in the code window to reinvoke the demonstration with the modified code.
}
.t insert end "Labels, buttons, checkbuttons, and radiobuttons" title
.t insert end " \n " {demospace}
.t insert end "1. Labels (text and bitmaps)." {demo demo-label}
.t insert end " \n " {demospace}
.t insert end "2. Buttons." {demo demo-button}
.t insert end " \n " {demospace}
.t insert end "3. Checkbuttons (select any of a group)." {demo demo-check}
.t insert end " \n " {demospace}
.t insert end "4. Radiobuttons (select one of a group)." {demo demo-radio}
.t insert end " \n " {demospace}
.t insert end "5. A 15-puzzle game made out of buttons." {demo demo-puzzle}
.t insert end " \n " {demospace}
.t insert end "6. Iconic buttons that use bitmaps." {demo demo-icon}
.t insert end " \n " {demospace}
.t insert end "7. Two labels displaying images." {demo demo-image1}
.t insert end " \n " {demospace}
.t insert end "8. A simple user interface for viewing images." \
{demo demo-image2}
.t insert end " \n " {demospace}
.t insert end \n {} "Listboxes" title
.t insert end " \n " {demospace}
.t insert end "1. 50 states." {demo demo-states}
.t insert end " \n " {demospace}
.t insert end "2. Colors: change the color scheme for the application." \
{demo demo-colors}
.t insert end " \n " {demospace}
.t insert end "3. A collection of famous sayings." {demo demo-sayings}
.t insert end " \n " {demospace}
.t insert end \n {} "Entries" title
.t insert end " \n " {demospace}
.t insert end "1. Without scrollbars." {demo demo-entry1}
.t insert end " \n " {demospace}
.t insert end "2. With scrollbars." {demo demo-entry2}
.t insert end " \n " {demospace}
.t insert end "3. Simple Rolodex-like form." {demo demo-form}
.t insert end " \n " {demospace}
.t insert end \n {} "Text" title
.t insert end " \n " {demospace}
.t insert end "1. Basic editable text." {demo demo-text}
.t insert end " \n " {demospace}
.t insert end "2. Text display styles." {demo demo-style}
.t insert end " \n " {demospace}
.t insert end "3. Hypertext (tag bindings)." {demo demo-bind}
.t insert end " \n " {demospace}
.t insert end "4. A text widget with embedded windows." {demo demo-twind}
.t insert end " \n " {demospace}
.t insert end "5. A search tool built with a text widget." {demo demo-search}
.t insert end " \n " {demospace}
.t insert end \n {} "Canvases" title
.t insert end " \n " {demospace}
.t insert end "1. The canvas item types." {demo demo-items}
.t insert end " \n " {demospace}
.t insert end "2. A simple 2-D plot." {demo demo-plot}
.t insert end " \n " {demospace}
.t insert end "3. Text items in canvases." {demo demo-ctext}
.t insert end " \n " {demospace}
.t insert end "4. An editor for arrowheads on canvas lines." {demo demo-arrow}
.t insert end " \n " {demospace}
.t insert end "5. A ruler with adjustable tab stops." {demo demo-ruler}
.t insert end " \n " {demospace}
.t insert end "6. A building floor plan." {demo demo-floor}
.t insert end " \n " {demospace}
.t insert end "7. A simple scrollable canvas." {demo demo-cscroll}
.t insert end " \n " {demospace}
.t insert end \n {} "Scales" title
.t insert end " \n " {demospace}
.t insert end "1. Vertical scale." {demo demo-vscale}
.t insert end " \n " {demospace}
.t insert end "2. Horizontal scale." {demo demo-hscale}
.t insert end " \n " {demospace}
.t insert end \n {} "Menus" title
.t insert end " \n " {demospace}
.t insert end "1. Menus and cascades." \
{demo demo-menu}
.t insert end " \n " {demospace}
.t insert end "2. Menubuttons"\
{demo demo-menubu}
.t insert end " \n " {demospace}
.t insert end \n {} "Common Dialogs" title
.t insert end " \n " {demospace}
.t insert end "1. Message boxes." {demo demo-msgbox}
.t insert end " \n " {demospace}
.t insert end "2. File selection dialog." {demo demo-filebox}
.t insert end " \n " {demospace}
.t insert end "3. Color picker." {demo demo-clrpick}
.t insert end " \n " {demospace}
.t insert end \n {} "Miscellaneous" title
.t insert end " \n " {demospace}
.t insert end "1. The built-in bitmaps." {demo demo-bitmap}
.t insert end " \n " {demospace}
.t insert end "2. A dialog box with a local grab." {demo demo-dialog1}
.t insert end " \n " {demospace}
.t insert end "3. A dialog box with a global grab." {demo demo-dialog2}
.t insert end " \n " {demospace}
.t configure -state disabled
focus .s
# positionWindow --
# This procedure is invoked by most of the demos to position a
# new demo window.
#
# Arguments:
# w - The name of the window to position.
proc positionWindow w {
wm geometry $w +300+300
}
# showVars --
# Displays the values of one or more variables in a window, and
# updates the display whenever any of the variables changes.
#
# Arguments:
# w - Name of new window to create for display.
# args - Any number of names of variables.
proc showVars {w args} {
catch {destroy $w}
toplevel $w
wm title $w "Variable values"
label $w.title -text "Variable values:" -width 20 -anchor center \
-font {Helvetica 18}
pack $w.title -side top -fill x
set len 1
foreach i $args {
if {[string length $i] > $len} {
set len [string length $i]
}
}
foreach i $args {
frame $w.$i
label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w
label $w.$i.value -textvar $i -anchor w
pack $w.$i.name -side left
pack $w.$i.value -side left -expand 1 -fill x
pack $w.$i -side top -anchor w -fill x
}
button $w.ok -text OK -command "destroy $w" -default active
bind $w <Return> "tkButtonInvoke $w.ok"
pack $w.ok -side bottom -pady 2
}
# invoke --
# This procedure is called when the user clicks on a demo description.
# It is responsible for invoking the demonstration.
#
# Arguments:
# index - The index of the character that the user clicked on.
proc invoke index {
global tk_library
set tags [.t tag names $index]
set i [lsearch -glob $tags demo-*]
if {$i < 0} {
return
}
set cursor [.t cget -cursor]
.t configure -cursor watch
update
set demo [string range [lindex $tags $i] 5 end]
uplevel [list source [file join $tk_library demos $demo.tcl]]
update
.t configure -cursor $cursor
.t tag add visited "$index linestart +1 chars" "$index lineend -1 chars"
}
# showStatus --
#
# Show the name of the demo program in the status bar. This procedure
# is called when the user moves the cursor over a demo description.
#
proc showStatus index {
global tk_library
set tags [.t tag names $index]
set i [lsearch -glob $tags demo-*]
set cursor [.t cget -cursor]
if {$i < 0} {
.statusBar.lab config -text " "
set newcursor xterm
} else {
set demo [string range [lindex $tags $i] 5 end]
.statusBar.lab config -text "Run the \"$demo\" sample program"
set newcursor hand2
}
if [string compare $cursor $newcursor] {
.t config -cursor $newcursor
}
}
# showCode --
# This procedure creates a toplevel window that displays the code for
# a demonstration and allows it to be edited and reinvoked.
#
# Arguments:
# w - The name of the demonstration's window, which can be
# used to derive the name of the file containing its code.
proc showCode w {
global tk_library
set file [string range $w 1 end].tcl
if ![winfo exists .code] {
toplevel .code
frame .code.buttons
pack .code.buttons -side bottom -fill x
button .code.buttons.dismiss -text Dismiss \
-default active -command "destroy .code"
button .code.buttons.rerun -text "Rerun Demo" -command {
eval [.code.text get 1.0 end]
}
pack .code.buttons.dismiss .code.buttons.rerun -side left \
-expand 1 -pady 2
frame .code.frame
pack .code.frame -expand yes -fill both -padx 1 -pady 1
text .code.text -height 40 -wrap word\
-xscrollcommand ".code.xscroll set" \
-yscrollcommand ".code.yscroll set" \
-setgrid 1 -highlightthickness 0 -pady 2 -padx 3
scrollbar .code.xscroll -command ".code.text xview" \
-highlightthickness 0 -orient horizontal
scrollbar .code.yscroll -command ".code.text yview" \
-highlightthickness 0 -orient vertical
grid .code.text -in .code.frame -padx 1 -pady 1 \
-row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
grid .code.yscroll -in .code.frame -padx 1 -pady 1 \
-row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
# grid .code.xscroll -in .code.frame -padx 1 -pady 1 \
# -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
grid rowconfig .code.frame 0 -weight 1 -minsize 0
grid columnconfig .code.frame 0 -weight 1 -minsize 0
} else {
wm deiconify .code
raise .code
}
wm title .code "Demo code: [file join $tk_library demos $file]"
wm iconname .code $file
set id [open [file join $tk_library demos $file]]
.code.text delete 1.0 end
.code.text insert 1.0 [read $id]
.code.text mark set insert 1.0
close $id
}
# aboutBox --
#
# Pops up a message box with an "about" message
#
proc aboutBox {} {
tk_messageBox -icon info -type ok -title "About Widget Demo" -message \
"Tk widget demonstration\n\n\
Copyright (c) 1996-1997 Sun Microsystems, Inc."
}
|