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