#!/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.17 2003/09/30 14:54:30 dkf Exp $ package require Tcl 8.4 package require Tk 8.4 package require msgcat eval destroy [winfo child .] ::msgcat::mcload [file join $tk_library demos] namespace import ::msgcat::mc wm title . [mc "Widget Demonstration"] if {[tk windowingsystem] eq "x11"} { # This won't work everywhere, but there's no other way in core Tk # at the moment to display a coloured icon. image create photo TclPowered \ -file [file join $tk_library images logo64.gif] wm iconwindow . [toplevel ._iconWindow] pack [label ._iconWindow.i -image TclPowered] wm iconname . [mc "tkWidgetDemo"] } if {[lsearch -exact [font names] defaultFont] == -1} { font create mainFont -family Helvetica -size 12 font create fixedFont -family Courier -size 10 font create boldFont -family Helvetica -size 12 -weight bold font create titleFont -family Helvetica -size 18 -weight bold font create statusFont -family Helvetica -size 10 font create varsFont -family Helvetica -size 14 } set widgetDemo 1 set font mainFont image create photo ::img::refresh -height 16 -format GIF -data { R0lGODlhEAAQAPMAAMz/zCpnKdb/1z9mPypbKBtLGy9NMPL/9Or+6+P+4j1Y PwQKBP7//xMLFAYBCAEBASH5BAEAAAAALAAAAAAQABAAAwR0EAD3Gn0Vyw0e ++CncU7IIAezMA/nhUqSLJizvSdCEEjy2ZIV46AwDAoDHwPYGSoEiUJAAGJ6 EDHBNCFINW5OqABKSFk/B9lUa94IDwIFgewFMwQDQwCZQCztTgM9Sl8SOEMG KSAthiaOjBMPDhQONBiXABEAOw== } image create photo ::img::view -height 16 -format GIF -data { R0lGODlhEAAQAPMAAMz/zP///8DAwICAgH9/fwAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAwRIcMhJB7h3hM33 KFjWdQQYap1QrCaGBmrRrS4nj5b53jOgbwXBKGACoYLDIuAoHCmZyYvR1rT5 RMAq8LqcIYGsrjPsW1XOmFUEADs= } image create photo ::img::delete -height 16 -format GIF -data { R0lGODlhEAAOAKEAAIQAAO/n3v///////yH5BAEKAAIALAAAAAAQAA4AAAIm lI9pAKHbIHNoVhYhTdjlJ2AWKG2g+CldmB6rxo2uybYhbS80eRQAOw== } #---------------------------------------------------------------- # 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. #---------------------------------------------------------------- menu .menuBar -tearoff 0 # This is a tk-internal procedure to make i18n easier ::tk::AmpMenuArgs .menuBar add cascade -label [mc "&File"] -menu .menuBar.file menu .menuBar.file -tearoff 0 # On the Mac use the specia .apple menu for the about item if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { .menuBar add cascade -menu .menuBar.apple menu .menuBar.apple -tearoff 0 .menuBar.apple add command -label [mc "About..."] -command {aboutBox} } else { ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&About..."] \ -command {aboutBox} -accelerator [mc ""] .menuBar.file add sep } ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \ -command {exit} -accelerator [mc "Meta-Q"] . configure -menu .menuBar bind . {aboutBox} bind . {exit} frame .statusBar label .statusBar.lab -text " " -relief sunken -bd 1 \ -font statusFont -anchor w label .statusBar.foo -width 8 -relief sunken -bd 1 \ -font statusFont -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 -bd 1 pack .s -in .textFrame -side right -fill y text .t -yscrollcommand {.s set} -wrap word -width 70 -height 30 \ -font mainFont -setgrid 1 -highlightthickness 0 \ -padx 4 -pady 2 -takefocus 0 -bd 1 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 titleFont .t tag configure bold -font boldFont # 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 { invoke [.t index {@%x,%y}] } set lastLine "" .t tag bind demo { 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 { .t tag remove hot 1.0 end .t config -cursor xterm .statusBar.lab config -text "" } .t tag bind demo { set newLine [.t index {@%x,%y linestart}] if {$newLine ne $lastLine} { .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. # addFormattedText -- # # Add formatted text (but not hypertext) to the text widget after # first passing it through the message catalog to allow for # localization. Lines starting with @@ are formatting directives # (begin newline, or change style) and all other lines are literal # strings to be inserted. Blank lines are ignored. # proc addFormattedText {formattedText} { set style normal set isNL 1 foreach line [split [mc $formattedText] \n] { set line [string trim $line] if {$line eq ""} { continue } if {$line eq "@@newline"} { .t insert end \n $style set isNL 1 continue } if {[string match @@* $line]} { set style [string range $line 1 end] continue } if {!$isNL} { .t insert end " " $style } set isNL 0 .t insert end $line $style } } # addDemoSection -- # # Add a new section of demos with a title and a (stride-2) list of # demo files and their descriptions. Titles and descriptions are # passed through the message catalog to allow for localization. # proc addDemoSection {title demos} { .t insert end "\n" {} [mc $title] title " \n " demospace set num 0 foreach {name description} $demos { .t insert end "[incr num]. [mc $description]." [list demo demo-$name] .t insert end " \n " demospace } } addFormattedText { @@title Tk Widget Demonstrations @@newline @@normal @@newline 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 @@bold See Code @@normal button to see the Tcl/Tk code that created the demonstration. If you wish, you can edit the code and click the @@bold Rerun Demo @@normal button in the code window to reinvoke the demonstration with the modified code. @@newline } addDemoSection "Labels, buttons, checkbuttons, and radiobuttons" { label "Labels (text and bitmaps)" unicodeout "Labels and UNICODE text" button "Buttons" check "Check-buttons (select any of a group)" radio "Radio-buttons (select one of a group)" puzzle "A 15-puzzle game made out of buttons" icon "Iconic buttons that use bitmaps" image1 "Two labels displaying images" image2 "A simple user interface for viewing images" labelframe "Labelled frames" } addDemoSection "Listboxes" { states "The 50 states" colors "Colors: change the color scheme for the application" sayings "A collection of famous and infamous sayings" } addDemoSection "Entries and Spin-boxes" { entry1 "Entries without scrollbars" entry2 "Entries with scrollbars" entry3 "Validated entries and password fields" spin "Spin-boxes" form "Simple Rolodex-like form" } addDemoSection "Text" { text "Basic editable text" style "Text display styles" bind "Hypertext (tag bindings)" twind "A text widget with embedded windows" search "A search tool built with a text widget" } addDemoSection "Canvases" { items "The canvas item types" plot "A simple 2-D plot" ctext "Text items in canvases" arrow "An editor for arrowheads on canvas lines" ruler "A ruler with adjustable tab stops" floor "A building floor plan" cscroll "A simple scrollable canvas" } addDemoSection "Scales" { hscale "Horizontal scale" vscale "Vertical scale" } addDemoSection "Paned Windows" { paned1 "Horizontal paned window" paned2 "Vertical paned window" } addDemoSection "Menus" { menu "Menus and cascades (sub-menus)" menubu "Menu-buttons" } addDemoSection "Common Dialogs" { msgbox "Message boxes" filebox "File selection dialog" clrpick "Color picker" } addDemoSection "Miscellaneous" { bitmap "The built-in bitmaps" dialog1 "A dialog box with a local grab" dialog2 "A dialog box with a global grab" } .t configure -state disabled focus .s # addSeeDismiss -- # Add "See Code" and "Dismiss" button frame, with optional "See Vars" # # Arguments: # w - The name of the frame to use. proc addSeeDismiss {w show {vars {}} {extra {}}} { ## See Code / Dismiss buttons frame $w frame $w.sep -height 2 -relief sunken -bd 2 grid $w.sep -columnspan 4 -row 0 -sticky ew -pady 2 button $w.dismiss -text [mc "Dismiss"] \ -image ::img::delete -compound left \ -command [list destroy [winfo toplevel $w]] button $w.code -text [mc "See Code"] \ -image ::img::view -compound left \ -command [list showCode $show] set buttons [list x $w.code $w.dismiss] if {[llength $vars]} { button $w.vars -text [mc "See Variables"] \ -image ::img::view -compound left \ -command [concat [list showVars $w.dialog] $vars] set buttons [linsert $buttons 1 $w.vars] } if {$extra ne ""} { set buttons [linsert $buttons 1 [uplevel 1 $extra]] } eval grid $buttons -padx 4 -pady 4 grid columnconfigure $w 0 -weight 1 return $w } # 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 [mc "Variable values"] set f [labelframe $w.title -text [mc "Variable values:"] -font varsFont] foreach var $args { label $f.n$var -text "$var:" -anchor w label $f.v$var -textvariable $var -anchor w grid $f.n$var $f.v$var -padx 2 -pady 2 -sticky w } button $w.ok -width 8 -text [mc "OK"] \ -command [list destroy $w] -default active bind $w [list $w.ok invoke] bind $w [list $w.ok invoke] grid $f -sticky news -padx 4 grid $w.ok -sticky e -padx 4 -pady {6 4} grid columnconfig $f 1 -weight 1 grid rowconfigure $f 100 -weight 1 grid columnconfig $w 0 -weight 1 grid rowconfigure $w 0 -weight 1 } # 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 [mc "Run the \"%s\" sample program" $demo] set newcursor hand2 } if {$cursor ne $newcursor} { .t config -cursor $newcursor } } # evalShowCode -- # # Arguments: # w - Name of text widget containing code to eval proc evalShowCode {w} { set code [$w get 1.0 end-1c] uplevel #0 $code } # 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 set top .code if {![winfo exists $top]} { toplevel $top set t [frame $top.f] set text [text $t.text -font fixedFont -height 30 -wrap word -bd 1 \ -xscrollcommand [list $t.xscroll set] \ -yscrollcommand [list $t.yscroll set] \ -setgrid 1 -highlightthickness 0 -pady 2 -padx 3] scrollbar $t.xscroll -command [list $t.text xview] \ -highlightthickness 0 -orient horizontal -bd 1 scrollbar $t.yscroll -command [list $t.text yview] \ -highlightthickness 0 -orient vertical -bd 1 grid $t.text $t.yscroll -sticky news #grid $t.xscroll grid rowconfigure $t 0 -weight 1 grid columnconfig $t 0 -weight 1 set btns [frame $top.btns] button $btns.dismiss -text [mc "Dismiss"] \ -default active -command [list destroy $top] \ -image ::img::delete -compound left button $btns.rerun -text [mc "Rerun Demo"] \ -command [list evalShowCode $text] \ -image ::img::refresh -compound left grid x $btns.rerun $btns.dismiss -padx 4 -pady {6 4} grid columnconfigure $btns 0 -weight 1 grid $t -sticky news grid $btns -sticky ew grid rowconfigure $top 0 -weight 1 grid columnconfig $top 0 -weight 1 bind $top { if {[winfo class %W] ne "Text"} { .code.btns.dismiss invoke } } bind $top [bind $top ] } else { wm deiconify $top raise $top } wm title $top [mc "Demo code: %s" [file join $tk_library demos $file]] wm iconname $top $file set id [open [file join $tk_library demos $file]] $top.f.text delete 1.0 end $top.f.text insert 1.0 [read $id] $top.f.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 [mc "About Widget Demo"] \ -message "[mc {Tk widget demonstration application}] [mc {Copyright (c) %s} {1996-1997 Sun Microsystems, Inc.}] [mc {Copyright (c) %s} {1997-2000 Ajuba Solutions, Inc.}] [mc {Copyright (c) %s} {2001-2003 Donal K. Fellows}]" } # Local Variables: # mode: tcl # End: