summaryrefslogtreecommitdiffstats
path: root/library/demos/widget
diff options
context:
space:
mode:
authorhobbs <hobbs>2003-08-20 23:02:18 (GMT)
committerhobbs <hobbs>2003-08-20 23:02:18 (GMT)
commit6a6da6c8b1a75b929d188969a3ee3643e476f4a1 (patch)
treed1ab85c4fc6afeef55b0202dba690a7273deed47 /library/demos/widget
parentd6703f5a8c28ebe155adaf2e6ed1bd2882ba2343 (diff)
downloadtk-6a6da6c8b1a75b929d188969a3ee3643e476f4a1.zip
tk-6a6da6c8b1a75b929d188969a3ee3643e476f4a1.tar.gz
tk-6a6da6c8b1a75b929d188969a3ee3643e476f4a1.tar.bz2
* library/demos/widget: Redo code view dialog, use named fonts,
* library/demos/arrow.tcl: add basic see/dismiss routine with * library/demos/bind.tcl: images for better look & feel * library/demos/bitmap.tcl: * library/demos/button.tcl: * library/demos/check.tcl: * library/demos/clrpick.tcl: * library/demos/colors.tcl: * library/demos/cscroll.tcl: * library/demos/ctext.tcl: * library/demos/entry1.tcl: * library/demos/entry2.tcl: * library/demos/entry3.tcl: * library/demos/filebox.tcl: * library/demos/floor.tcl: * library/demos/form.tcl: * library/demos/hscale.tcl: * library/demos/icon.tcl: * library/demos/image1.tcl: * library/demos/image2.tcl: * library/demos/items.tcl: * library/demos/label.tcl: * library/demos/labelframe.tcl: * library/demos/menu.tcl: * library/demos/menubu.tcl: * library/demos/paned1.tcl: * library/demos/paned2.tcl: * library/demos/plot.tcl: * library/demos/puzzle.tcl: * library/demos/radio.tcl: * library/demos/ruler.tcl: * library/demos/sayings.tcl: * library/demos/search.tcl: * library/demos/spin.tcl: * library/demos/states.tcl: * library/demos/style.tcl: * library/demos/text.tcl: * library/demos/twind.tcl: * library/demos/unicodeout.tcl: * library/demos/vscale.tcl:
Diffstat (limited to 'library/demos/widget')
-rw-r--r--library/demos/widget206
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.}]