diff options
Diffstat (limited to 'library/demos/widget')
| -rw-r--r-- | library/demos/widget | 206 |
1 files changed, 133 insertions, 73 deletions
diff --git a/library/demos/widget b/library/demos/widget index e0fde72..f9c5932 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -11,7 +11,7 @@ exec wish "$0" "$@" # ".tcl" files is this directory, which are sourced by this script # as needed. # -# RCS: @(#) $Id: widget,v 1.10 2003/05/19 14:44:04 dkf Exp $ +# RCS: @(#) $Id: widget,v 1.11 2003/08/20 23:02:18 hobbs Exp $ eval destroy [winfo child .] package require msgcat @@ -28,16 +28,37 @@ if {$tcl_platform(platform) eq "unix"} { wm iconname . [mc "tkWidgetDemo"] } -array set widgetFont { - main {Helvetica 12} - bold {Helvetica 12 bold} - title {Helvetica 18 bold} - status {Helvetica 10} - vars {Helvetica 14} +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 $widgetFont(main) +set font mainFont + +image create photo ::img::refresh -format GIF -data { + R0lGODlhEAAQAPMAAMz/zCpnKdb/1z9mPypbKBtLGy9NMPL/9Or+6+P+4j1Y + PwQKBP7//xMLFAYBCAEBASH5BAEAAAAALAAAAAAQABAAAwR0EAD3Gn0Vyw0e + ++CncU7IIAezMA/nhUqSLJizvSdCEEjy2ZIV46AwDAoDHwPYGSoEiUJAAGJ6 + EDHBNCFINW5OqABKSFk/B9lUa94IDwIFgewFMwQDQwCZQCztTgM9Sl8SOEMG + KSAthiaOjBMPDhQONBiXABEAOw== +} + +image create photo ::img::view -format GIF -data { + R0lGODlhEAAQAPMAAMz/zP///8DAwICAgH9/fwAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAwRIcMhJB7h3hM33 + KFjWdQQYap1QrCaGBmrRrS4nj5b53jOgbwXBKGACoYLDIuAoHCmZyYvR1rT5 + RMAq8LqcIYGsrjPsW1XOmFUEADs= +} + +image create photo ::img::delete -format GIF -data { + R0lGODlhEAAOAKEAAIQAAO/n3v///////yH5BAEKAAIALAAAAAAQAA4AAAIm + lI9pAKHbIHNoVhYhTdjlJ2AWKG2g+CldmB6rxo2uybYhbS80eRQAOw== +} #---------------------------------------------------------------- # The code below create the main window, consisting of a menu bar @@ -69,20 +90,20 @@ bind . <Meta-q> {exit} frame .statusBar label .statusBar.lab -text " " -relief sunken -bd 1 \ - -font $widgetFont(status) -anchor w + -font statusFont -anchor w label .statusBar.foo -width 8 -relief sunken -bd 1 \ - -font $widgetFont(status) -anchor w + -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 + -takefocus 1 -bd 1 pack .s -in .textFrame -side right -fill y text .t -yscrollcommand {.s set} -wrap word -width 70 -height 30 \ - -font $widgetFont(main) -setgrid 1 -highlightthickness 0 \ - -padx 4 -pady 2 -takefocus 0 + -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 @@ -90,8 +111,8 @@ pack .textFrame -expand yes -fill both # section titles and demo descriptions. Also define the bindings for # tags. -.t tag configure title -font $widgetFont(title) -.t tag configure bold -font $widgetFont(bold) +.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 @@ -283,6 +304,33 @@ addDemoSection "Miscellaneous" { .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 {}}} { + ## See Code / Dismiss buttons + frame $w + button $w.dismiss -text [mc "Dismiss"] \ + -image ::img::refresh -compound left \ + -command [list destroy [winfo toplevel $w]] + button $w.code -text [mc "See Code"] \ + -image ::img::view -compound left \ + -command [list showCode $show] + if {[llength $vars]} { + button $w.vars -text [mc "See Variables"] \ + -image ::img::view -compound left \ + -command [concat [list showVars $w.dialog] $vars] + grid x $w.vars $w.code $w.dismiss -padx 4 -pady {6 4} + } else { + grid x $w.code $w.dismiss -padx 4 -pady {6 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. @@ -303,31 +351,26 @@ proc positionWindow w { # args - Any number of names of variables. proc showVars {w args} { - global widgetFont catch {destroy $w} toplevel $w wm title $w [mc "Variable values"] - label $w.title -text [mc "Variable values:"] -width 20 -anchor center \ - -font $widgetFont(vars) - 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 + + 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 -text [mc "OK"] -command [list destroy $w] -default active - bind $w <Return> [list tkButtonInvoke $w.ok] - bind $w <Escape> [list tkButtonInvoke $w.ok] - pack $w.ok -side bottom -pady 2 + bind $w <Return> [list $w.ok invoke] + bind $w <Escape> [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 -- @@ -378,6 +421,15 @@ proc showStatus index { } } +# 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 @@ -390,46 +442,54 @@ proc showStatus index { 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 [mc "Dismiss"] \ - -default active -command {destroy .code} - button .code.buttons.rerun -text [mc "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 + 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 <Return> [list $btns.dismiss invoke] + bind $top <Escape> [list $btns.dismiss invoke] } else { - wm deiconify .code - raise .code + wm deiconify $top + raise $top } - wm title .code [mc "Demo code: %s" [file join $tk_library demos $file]] - wm iconname .code $file + 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]] - .code.text delete 1.0 end - .code.text insert 1.0 [read $id] - .code.text mark set insert 1.0 + $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 } @@ -439,7 +499,7 @@ proc showCode w { # proc aboutBox {} { tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \ - -message "[mc {Tk widget demonstration application}] + -message "[mc {Tk widget demonstration application}] [mc {Copyright (c) %s} {1996-1997 Sun Microsystems, Inc.}] [mc {Copyright (c) %s} {1997-2000 Ajuba Solutions, Inc.}] |