diff options
Diffstat (limited to 'library/demos')
| -rw-r--r-- | library/demos/floor.tcl | 28 | ||||
| -rw-r--r-- | library/demos/rmt | 4 | ||||
| -rw-r--r-- | library/demos/tcolor | 17 | ||||
| -rw-r--r-- | library/demos/text.tcl | 6 | ||||
| -rw-r--r-- | library/demos/twind.tcl | 9 | ||||
| -rw-r--r-- | library/demos/widget | 29 |
6 files changed, 39 insertions, 54 deletions
diff --git a/library/demos/floor.tcl b/library/demos/floor.tcl index 5784db3..f1004b5 100644 --- a/library/demos/floor.tcl +++ b/library/demos/floor.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas widet that displays the # floorplan for DEC's Western Research Laboratory. # -# RCS: @(#) $Id: floor.tcl,v 1.6 2004/12/21 11:56:35 dkf Exp $ +# RCS: @(#) $Id: floor.tcl,v 1.7 2007/10/30 01:57:54 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -1309,28 +1309,26 @@ pack $btns -side bottom -fill x set f [frame $w.frame] pack $f -side top -fill both -expand yes -set h [scrollbar $f.hscroll -highlightthickness 0 -orient horizontal] -set v [scrollbar $f.vscroll -highlightthickness 0 -orient vertical] -set f1 [frame $f.f1 -bd 2 -relief sunken] -set c [canvas $f1.c -width 900 -height 500 -borderwidth 0 \ - -highlightthickness 0 -xscrollcommand "$h set" -yscrollcommand "$v set"] +set h [scrollbar $f.hscroll -orient horizontal] +set v [scrollbar $f.vscroll -orient vertical] +set f1 [frame $f.f1 -borderwidth 2 -relief sunken] +set c [canvas $f1.c -width 900 -height 500 -highlightthickness 0 \ + -xscrollcommand [list $h set] \ + -yscrollcommand [list $v set]] pack $c -expand yes -fill both -grid $f1 -padx 1 -pady 1 \ - -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news -grid $v -padx 1 -pady 1 \ - -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news -grid $h -padx 1 -pady 1 \ - -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news +grid $f1 -padx 1 -pady 1 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news +grid $v -padx 1 -pady 1 -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news +grid $h -padx 1 -pady 1 -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news grid rowconfig $f 0 -weight 1 -minsize 0 grid columnconfig $f 0 -weight 1 -minsize 0 pack $f -expand yes -fill both -padx 1 -pady 1 -$v config -command "$c yview" -$h config -command "$c xview" +$v configure -command [list $c yview] +$h configure -command [list $c xview] # Create an entry for displaying and typing in current room. -entry $c.entry -width 10 -relief sunken -bd 2 -textvariable currentRoom +entry $c.entry -width 10 -textvariable currentRoom # Choose colors, then fill in the floorplan. diff --git a/library/demos/rmt b/library/demos/rmt index 0e14cdb..026c35d 100644 --- a/library/demos/rmt +++ b/library/demos/rmt @@ -7,7 +7,7 @@ exec wish "$0" "$@" # Tk applications. It allows you to select an application and # then type commands to that application. # -# RCS: @(#) $Id: rmt,v 1.4 2003/09/30 14:54:30 dkf Exp $ +# RCS: @(#) $Id: rmt,v 1.5 2007/10/30 01:57:54 hobbs Exp $ package require Tcl 8.4 package require Tk @@ -45,7 +45,7 @@ menu .menu.file.apps -postcommand fillAppsMenu # Create text window and scrollbar. -text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true +text .t -yscrollcommand ".s set" -setgrid true scrollbar .s -command ".t yview" grid .t .s -sticky nsew grid rowconfigure . 0 -weight 1 diff --git a/library/demos/tcolor b/library/demos/tcolor index c94d459..deb893d 100644 --- a/library/demos/tcolor +++ b/library/demos/tcolor @@ -7,7 +7,7 @@ exec wish "$0" "$@" # create colors using either the RGB, HSB, or CYM color spaces # and apply the color to existing applications. # -# RCS: @(#) $Id: tcolor,v 1.4 2003/09/30 14:54:30 dkf Exp $ +# RCS: @(#) $Id: tcolor,v 1.5 2007/10/30 01:57:55 hobbs Exp $ package require Tk 8.4 wm title . "Color Editor" @@ -42,10 +42,6 @@ set updating 0 set autoUpdate 1 set name "" -if {$tcl_platform(platform) eq "unix"} { - option add *Entry.background white -} - # Create the menu bar at the top of the window. . configure -menu [menu .menu] @@ -69,8 +65,7 @@ menu .menu.file # with the update button. labelframe .command -text "Command:" -padx {1m 0} -entry .command.e -relief sunken -borderwidth 2 -textvariable command \ - -font {Courier 12} +entry .command.e -textvariable command button .command.update -text Update -command doUpdate pack .command.update -side right -pady .1c -padx {.25c 0} pack .command.e -expand yes -fill x -ipadx 0.25c @@ -96,12 +91,11 @@ foreach i { grid .names -row 0 -column 0 -sticky nsew -padx .15c -pady .15c -rowspan 2 grid columnconfigure . 0 -weight 1 listbox .names.lb -width 20 -height 12 -yscrollcommand ".names.s set" \ - -relief sunken -borderwidth 2 -exportselection false + -exportselection false bind .names.lb <Double-1> { tc_loadNamedColor [.names.lb get [.names.lb curselection]] } - scrollbar .names.s -orient vertical -command ".names.lb yview" \ - -relief sunken -borderwidth 2 + scrollbar .names.s -orient vertical -command ".names.lb yview" pack .names.lb .names.s -side left -fill y -expand 1 while {[gets $f line] >= 0} { if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} { @@ -127,8 +121,7 @@ foreach i {1 2 3} { grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c labelframe .name -text "Name:" -padx 1m -pady 1m -entry .name.e -relief sunken -borderwidth 2 -textvariable name -width 10 \ - -font {Courier 12} +entry .name.e -textvariable name -width 10 pack .name.e -side right -expand 1 -fill x bind .name.e <Return> {tc_loadNamedColor $name} grid .name -column 1 -row 1 -sticky nsew -padx .15c -pady .15c diff --git a/library/demos/text.tcl b/library/demos/text.tcl index 4bb1155..96bda1d 100644 --- a/library/demos/text.tcl +++ b/library/demos/text.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a text widget that describes # the basic editing functions. # -# RCS: @(#) $Id: text.tcl,v 1.6 2004/12/21 11:56:35 dkf Exp $ +# RCS: @(#) $Id: text.tcl,v 1.7 2007/10/30 01:57:55 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -22,9 +22,9 @@ positionWindow $w set btns [addSeeDismiss $w.buttons $w] pack $btns -side bottom -fill x -text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" -setgrid 1 \ +text $w.text -yscrollcommand [list $w.scroll set] -setgrid 1 \ -height 30 -undo 1 -autosep 1 -scrollbar $w.scroll -command "$w.text yview" +scrollbar $w.scroll -command [list $w.text yview] pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both $w.text insert 0.0 \ diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index b2d35dd..b3a17d8 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a text widget with a bunch of # embedded windows. # -# RCS: @(#) $Id: twind.tcl,v 1.9 2007/10/15 21:06:17 dkf Exp $ +# RCS: @(#) $Id: twind.tcl,v 1.10 2007/10/30 01:57:55 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -22,7 +22,7 @@ positionWindow $w set btns [addSeeDismiss $w.buttons $w] pack $btns -side bottom -fill x -frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken +frame $w.f -highlightthickness 1 -borderwidth 1 -relief sunken set t $w.f.text text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \ -height 35 -wrap word -highlightthickness 0 -borderwidth 0 @@ -301,8 +301,9 @@ proc textMakePeer {parent} { while {[winfo exists .peer$n]} { incr n } set w [toplevel .peer$n] wm title $w "Text Peer #$n" - frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken - set t [$parent peer create $w.f.text -yscrollcommand "$w.scroll set"] + frame $w.f -highlightthickness 1 -borderwidth 1 -relief sunken + set t [$parent peer create $w.f.text -yscrollcommand "$w.scroll set" \ + -borderwidth 0 -highlightthickness 0] pack $t -expand yes -fill both scrollbar $w.scroll -command "$t yview" pack $w.scroll -side right -fill y diff --git a/library/demos/widget b/library/demos/widget index b6b633b..666bc95 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -10,7 +10,7 @@ exec wish "$0" "$@" # separate ".tcl" files is this directory, which are sourced by this script as # needed. # -# RCS: @(#) $Id: widget,v 1.40 2007/10/23 06:31:16 das Exp $ +# RCS: @(#) $Id: widget,v 1.41 2007/10/30 01:57:55 hobbs Exp $ package require Tcl 8.5 package require Tk 8.5 @@ -35,7 +35,7 @@ if {[tk windowingsystem] eq "x11"} { if {"defaultFont" ni [font names]} { # TIP #145 defines some standard named fonts if {"TkDefaultFont" in [font names] && "TkFixedFont" in [font names]} { - # FIX ME: the following tecnique of cloning the font to copy it works + # FIX ME: the following technique of cloning the font to copy it works # fine but means that if the system font is changed by Tk # cannot update the copied font. font alias might be useful # here -- or fix the app to use TkDefaultFont etc. @@ -145,19 +145,17 @@ if {[tk windowingsystem] ne "aqua"} { pack .statusBar -side bottom -fill x -pady 2 ttk::frame .textFrame -scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \ - -takefocus 1 -bd 1 +scrollbar .s -orient vertical -command {.t yview} -takefocus 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 + -padx 4 -pady 2 -takefocus 0 pack .t -in .textFrame -expand y -fill both -padx 1 pack .textFrame -expand yes -fill both if {[tk windowingsystem] eq "aqua"} { pack configure .statusBar.lab -padx {10 18} -pady {4 6} pack configure .statusBar -pady 0 - .s configure -bd 0 - .t configure -padx 10 -pady 0 -bd 0 + .t configure -padx 10 -pady 0 } # Create a bunch of tags to use in the text widget, such as those for section @@ -263,7 +261,7 @@ proc addFormattedText {formattedText} { } demo { set description [lassign $values name] - .t insert end "[incr demoCount]. [mc $description]." \ + .t insert end "[incr demoCount]. [mc $description]" \ [list demo demo-$name] if {$new} { .t image create end -image ::img::new -padx 5 @@ -476,7 +474,7 @@ proc showVars {w args} { ttk::label $f.v$var -textvariable $var -anchor w grid $f.n$var $f.v$var -padx 2 -pady 2 -sticky w } - ttk::button $b.ok -width 8 -text [mc "OK"] \ + ttk::button $b.ok -text [mc "OK"] \ -command [list destroy $w] -default active bind $w <Return> [list $b.ok invoke] bind $w <Escape> [list $b.ok invoke] @@ -514,7 +512,7 @@ proc invoke index { .t configure -cursor watch update set demo [string range [lindex $tags $i] 5 end] - uplevel [list source [file join $tk_demoDirectory $demo.tcl]] + uplevel 1 [list source [file join $tk_demoDirectory $demo.tcl]] update .t configure -cursor $cursor @@ -569,17 +567,12 @@ proc showCode w { toplevel $top set t [frame $top.f] - set text [text $t.text -font fixedFont -height 30 -wrap word -bd 1 \ + set text [text $t.text -font fixedFont -height 24 -wrap word \ -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 - if {[tk windowingsystem] eq "aqua"} { - foreach i [list $t.text $t.xscroll $t.yscroll] {$i configure -bd 0} - } + scrollbar $t.xscroll -command [list $t.text xview] -orient horizontal + scrollbar $t.yscroll -command [list $t.text yview] -orient vertical grid $t.text $t.yscroll -sticky news #grid $t.xscroll |