mingw/lib/tk8.4/demos/widget

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