summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/bgerror.tcl137
-rw-r--r--library/demos/floor.tcl28
-rw-r--r--library/demos/rmt4
-rw-r--r--library/demos/tcolor17
-rw-r--r--library/demos/text.tcl6
-rw-r--r--library/demos/twind.tcl9
-rw-r--r--library/demos/widget29
-rw-r--r--library/dialog.tcl8
-rw-r--r--library/listbox.tcl12
-rw-r--r--library/msgbox.tcl13
-rw-r--r--library/obsolete.tcl159
-rw-r--r--library/optMenu.tcl4
-rw-r--r--library/tclIndex1
-rw-r--r--library/tkfbox.tcl9
-rw-r--r--library/ttk/fonts.tcl4
15 files changed, 277 insertions, 163 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl
index 0879a71..06d707d 100644
--- a/library/bgerror.tcl
+++ b/library/bgerror.tcl
@@ -7,10 +7,10 @@
# Donal K. Fellows.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
-# All rights reserved.
-#
-# RCS: @(#) $Id: bgerror.tcl,v 1.34 2007/05/30 06:34:18 das Exp $
-# $Id: bgerror.tcl,v 1.34 2007/05/30 06:34:18 das Exp $
+# Copyright (c) 2007 by ActiveState Software Inc.
+#
+# RCS: @(#) $Id: bgerror.tcl,v 1.35 2007/10/30 01:57:54 hobbs Exp $
+# $Id: bgerror.tcl,v 1.35 2007/10/30 01:57:54 hobbs Exp $
namespace eval ::tk::dialog::error {
namespace import -force ::tk::msgcat::*
@@ -18,6 +18,7 @@ namespace eval ::tk::dialog::error {
option add *ErrorDialog.function.text [mc "Save To Log"] \
widgetDefault
option add *ErrorDialog.function.command [namespace code SaveToLog]
+ option add *ErrorDialog*Label.font TkCaptionFont widgetDefault
if {[tk windowingsystem] eq "aqua"} {
option add *ErrorDialog*background systemAlertBackgroundActive \
widgetDefault
@@ -42,7 +43,7 @@ proc ::tk::dialog::error::Details {} {
if { ($caption eq "") || ($command eq "") } {
grid forget $w.function
}
- lappend command [.bgerrorDialog.top.info.text get 1.0 end-1c]
+ lappend command [$w.top.info.text get 1.0 end-1c]
$w.function configure -text $caption -command $command
grid $w.top.info - -sticky nsew -padx 3m -pady 3m
}
@@ -96,18 +97,11 @@ proc ::tk::dialog::error::bgerror err {
# we use the default dialog then :
set windowingsystem [tk windowingsystem]
if {$windowingsystem eq "aqua"} {
- set ok [mc Ok]
- set messageFont system
- set textRelief flat
- set textHilight 0
+ set ok [mc Ok]
} else {
- set ok [mc OK]
- set messageFont {Times -18}
- set textRelief sunken
- set textHilight 1
+ set ok [mc OK]
}
-
# Truncate the message if it is too wide (>maxLine characters) or
# too tall (>4 lines). Truncation occurs at the first point at
# which one of those conditions is met.
@@ -128,47 +122,40 @@ proc ::tk::dialog::error::bgerror err {
incr lines
}
- set w .bgerrorDialog
set title [mc "Application Error"]
set text [mc "Error: %1\$s" $displayedErr]
set buttons [list ok $ok dismiss [mc "Skip Messages"] \
- function [mc "Details >>"]]
+ function [mc "Details >>"]]
# 1. Create the top-level window and divide it into top
# and bottom parts.
- destroy .bgerrorDialog
- toplevel .bgerrorDialog -class ErrorDialog
- wm withdraw .bgerrorDialog
- wm title .bgerrorDialog $title
- wm iconname .bgerrorDialog ErrorDialog
- wm protocol .bgerrorDialog WM_DELETE_WINDOW { }
+ set dlg .bgerrorDialog
+ destroy $dlg
+ toplevel $dlg -class ErrorDialog
+ wm withdraw $dlg
+ wm title $dlg $title
+ wm iconname $dlg ErrorDialog
+ wm protocol $dlg WM_DELETE_WINDOW { }
if {$windowingsystem eq "aqua"} {
- ::tk::unsupported::MacWindowStyle style .bgerrorDialog moveableAlert {}
+ ::tk::unsupported::MacWindowStyle style $dlg moveableAlert {}
}
- frame .bgerrorDialog.bot
- frame .bgerrorDialog.top
+ frame $dlg.bot
+ frame $dlg.top
if {$windowingsystem eq "x11"} {
- .bgerrorDialog.bot configure -relief raised -bd 1
- .bgerrorDialog.top configure -relief raised -bd 1
+ $dlg.bot configure -relief raised -bd 1
+ $dlg.top configure -relief raised -bd 1
}
- pack .bgerrorDialog.bot -side bottom -fill both
- pack .bgerrorDialog.top -side top -fill both -expand 1
-
- set W [frame $w.top.info]
- text $W.text \
- -yscrollcommand [list $W.scroll set]\
- -setgrid true \
- -width 40 \
- -height 10 \
- -state normal \
- -relief $textRelief \
- -highlightthickness $textHilight \
- -wrap char
- if {$windowingsystem eq "aqua"} {
- $W.text configure -width 80 -background white
+ pack $dlg.bot -side bottom -fill both
+ pack $dlg.top -side top -fill both -expand 1
+
+ set W [frame $dlg.top.info]
+ text $W.text -setgrid true -height 10 -wrap char \
+ -yscrollcommand [list $W.scroll set]
+ if {$windowingsystem ne "aqua"} {
+ $W.text configure -width 40
}
scrollbar $W.scroll -command [list $W.text yview]
@@ -182,80 +169,68 @@ proc ::tk::dialog::error::bgerror err {
# 2. Fill the top part with bitmap and message
# Max-width of message is the width of the screen...
- set wrapwidth [winfo screenwidth .bgerrorDialog]
+ set wrapwidth [winfo screenwidth $dlg]
# ...minus the width of the icon, padding and a fudge factor for
# the window manager decorations and aesthetics.
- set wrapwidth [expr {$wrapwidth-60-[winfo pixels .bgerrorDialog 9m]}]
- label .bgerrorDialog.msg -justify left -text $text -font $messageFont \
- -wraplength $wrapwidth
+ set wrapwidth [expr {$wrapwidth-60-[winfo pixels $dlg 9m]}]
+ label $dlg.msg -justify left -text $text -wraplength $wrapwidth
if {$windowingsystem eq "aqua"} {
# On the Macintosh, use the stop bitmap
- label .bgerrorDialog.bitmap -bitmap stop
+ label $dlg.bitmap -bitmap stop
} else {
# On other platforms, make the error icon
- canvas .bgerrorDialog.bitmap -width 32 -height 32 -highlightthickness 0
- .bgerrorDialog.bitmap create oval 0 0 31 31 -fill red -outline black
- .bgerrorDialog.bitmap create line 9 9 23 23 -fill white -width 4
- .bgerrorDialog.bitmap create line 9 23 23 9 -fill white -width 4
+ canvas $dlg.bitmap -width 32 -height 32 -highlightthickness 0
+ $dlg.bitmap create oval 0 0 31 31 -fill red -outline black
+ $dlg.bitmap create line 9 9 23 23 -fill white -width 4
+ $dlg.bitmap create line 9 23 23 9 -fill white -width 4
}
- grid .bgerrorDialog.bitmap .bgerrorDialog.msg \
- -in .bgerrorDialog.top \
- -row 0 \
- -padx 3m \
- -pady 3m
- grid configure .bgerrorDialog.msg -sticky nsw -padx {0 3m}
- grid rowconfigure .bgerrorDialog.top 1 -weight 1
- grid columnconfigure .bgerrorDialog.top 1 -weight 1
+ grid $dlg.bitmap $dlg.msg -in $dlg.top -row 0 -padx 3m -pady 3m
+ grid configure $dlg.msg -sticky nsw -padx {0 3m}
+ grid rowconfigure $dlg.top 1 -weight 1
+ grid columnconfigure $dlg.top 1 -weight 1
# 3. Create a row of buttons at the bottom of the dialog.
set i 0
foreach {name caption} $buttons {
- button .bgerrorDialog.$name \
- -text $caption \
- -default normal \
+ button $dlg.$name -text $caption -default normal \
-command [namespace code [list set button $i]]
- grid .bgerrorDialog.$name \
- -in .bgerrorDialog.bot \
- -column $i \
- -row 0 \
- -sticky ew \
- -padx 10
- grid columnconfigure .bgerrorDialog.bot $i -weight 1
+ grid $dlg.$name -in $dlg.bot -column $i -row 0 -sticky ew -padx 10
+ grid columnconfigure $dlg.bot $i -weight 1
# We boost the size of some Mac buttons for l&f
if {$windowingsystem eq "aqua"} {
if {($name eq "ok") || ($name eq "dismiss")} {
- grid columnconfigure .bgerrorDialog.bot $i -minsize 90
+ grid columnconfigure $dlg.bot $i -minsize 90
}
- grid configure .bgerrorDialog.$name -pady 7
+ grid configure $dlg.$name -pady 7
}
incr i
}
# The "OK" button is the default for this dialog.
- .bgerrorDialog.ok configure -default active
+ $dlg.ok configure -default active
- bind .bgerrorDialog <Return> [namespace code Return]
- bind .bgerrorDialog <Destroy> [namespace code [list Destroy %W]]
- .bgerrorDialog.function configure -command [namespace code Details]
+ bind $dlg <Return> [namespace code Return]
+ bind $dlg <Destroy> [namespace code [list Destroy %W]]
+ $dlg.function configure -command [namespace code Details]
# 6. Place the window (centered in the display) and deiconify it.
- ::tk::PlaceWindow .bgerrorDialog
+ ::tk::PlaceWindow $dlg
# 7. Ensure that we are topmost.
- raise .bgerrorDialog
+ raise $dlg
if {$tcl_platform(platform) eq "windows"} {
# Place it topmost if we aren't at the top of the stacking
# order to ensure that it's seen
- if {[lindex [wm stackorder .] end] ne ".bgerrorDialog"} {
- wm attributes .bgerrorDialog -topmost 1
+ if {[lindex [wm stackorder .] end] ne "$dlg"} {
+ wm attributes $dlg -topmost 1
}
}
# 8. Set a grab and claim the focus too.
- ::tk::SetFocusGrab .bgerrorDialog .bgerrorDialog.ok
+ ::tk::SetFocusGrab $dlg $dlg.ok
# 9. Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
@@ -266,7 +241,7 @@ proc ::tk::dialog::error::bgerror err {
vwait [namespace which -variable button]
set copy $button; # Save a copy...
- ::tk::RestoreFocusGrab .bgerrorDialog .bgerrorDialog.ok destroy
+ ::tk::RestoreFocusGrab $dlg $dlg.ok destroy
if {$copy == 1} {
return -code break
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
diff --git a/library/dialog.tcl b/library/dialog.tcl
index 0623b89..29593a8 100644
--- a/library/dialog.tcl
+++ b/library/dialog.tcl
@@ -3,7 +3,7 @@
# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
#
-# RCS: @(#) $Id: dialog.tcl,v 1.22 2007/05/30 06:34:18 das Exp $
+# RCS: @(#) $Id: dialog.tcl,v 1.23 2007/10/30 01:57:54 hobbs Exp $
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -91,11 +91,7 @@ proc ::tk_dialog {w title text bitmap default args} {
# overridden by the caller).
option add *Dialog.msg.wrapLength 3i widgetDefault
- if {$windowingsystem eq "aqua"} {
- option add *Dialog.msg.font system widgetDefault
- } else {
- option add *Dialog.msg.font {Times 12} widgetDefault
- }
+ option add *Dialog.msg.font TkCaptionFont widgetDefault
label $w.msg -justify left -text $text
pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
diff --git a/library/listbox.tcl b/library/listbox.tcl
index 27cb114..26f494e 100644
--- a/library/listbox.tcl
+++ b/library/listbox.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk listbox widgets
# and provides procedures that help in implementing those bindings.
#
-# RCS: @(#) $Id: listbox.tcl,v 1.15 2005/09/10 14:53:20 das Exp $
+# RCS: @(#) $Id: listbox.tcl,v 1.16 2007/10/30 01:57:54 hobbs Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
@@ -35,7 +35,7 @@
bind Listbox <1> {
if {[winfo exists %W]} {
- tk::ListboxBeginSelect %W [%W index @%x,%y]
+ tk::ListboxBeginSelect %W [%W index @%x,%y] 1
}
}
@@ -227,7 +227,7 @@ if {"x11" eq [tk windowingsystem]} {
# el - The element for the selection operation (typically the
# one under the pointer). Must be in numerical form.
-proc ::tk::ListboxBeginSelect {w el} {
+proc ::tk::ListboxBeginSelect {w el {focus 1}} {
variable ::tk::Priv
if {[$w cget -selectmode] eq "multiple"} {
if {[$w selection includes $el]} {
@@ -243,6 +243,12 @@ proc ::tk::ListboxBeginSelect {w el} {
set Priv(listboxPrev) $el
}
event generate $w <<ListboxSelect>>
+ # check existence as ListboxSelect may destroy us
+ if {$focus && [winfo exists $w]
+ && [string is true -strict [$w cget -takefocus]]
+ && [$w cget -state] eq "normal"} {
+ focus $w
+ }
}
# ::tk::ListboxMotion --
diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index d2980d7..4bbfc92 100644
--- a/library/msgbox.tcl
+++ b/library/msgbox.tcl
@@ -3,7 +3,7 @@
# Implements messageboxes for platforms that do not have native
# messagebox support.
#
-# RCS: @(#) $Id: msgbox.tcl,v 1.31 2007/05/30 06:34:18 das Exp $
+# RCS: @(#) $Id: msgbox.tcl,v 1.32 2007/10/30 01:57:54 hobbs Exp $
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
@@ -264,7 +264,7 @@ proc ::tk::MessageBox {args} {
#
if {[winfo viewable [winfo toplevel $data(-parent)]] } {
wm transient $w $data(-parent)
- }
+ }
if {$windowingsystem eq "aqua"} {
::tk::unsupported::MacWindowStyle style $w moveableModal {}
@@ -286,13 +286,8 @@ proc ::tk::MessageBox {args} {
option add *Dialog.msg.wrapLength 3i widgetDefault
option add *Dialog.dtl.wrapLength 3i widgetDefault
- if {$windowingsystem eq "aqua"} {
- option add *Dialog.msg.font system widgetDefault
- option add *Dialog.dtl.font system widgetDefault
- } else {
- option add *Dialog.msg.font {Times 14} widgetDefault
- option add *Dialog.dtl.font {Times 10} widgetDefault
- }
+ option add *Dialog.msg.font TkCaptionFont widgetDefault
+ option add *Dialog.dtl.font TkDefaultFont widgetDefault
label $w.msg -anchor nw -justify left -text $data(-message) \
-background $bg
diff --git a/library/obsolete.tcl b/library/obsolete.tcl
index 16a19a1..8c11ca6 100644
--- a/library/obsolete.tcl
+++ b/library/obsolete.tcl
@@ -3,7 +3,7 @@
# This file contains obsolete procedures that people really shouldn't
# be using anymore, but which are kept around for backward compatibility.
#
-# RCS: @(#) $Id: obsolete.tcl,v 1.2 1998/09/14 18:23:24 stanton Exp $
+# RCS: @(#) $Id: obsolete.tcl,v 1.3 2007/10/30 01:57:54 hobbs Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
@@ -19,3 +19,160 @@
proc tk_menuBar args {}
proc tk_bindForTraversal args {}
+
+# ::tk::classic::restore --
+#
+# Restore the pre-8.5 (Tk classic) look as the widget defaults for classic
+# Tk widgets.
+#
+# The value following an 'option add' call is the new 8.5 value.
+#
+namespace eval ::tk::classic {
+ # This may need to be adjusted for some window managers that are
+ # more aggressive with their own Xdefaults (like KDE and CDE)
+ variable prio "widgetDefault"
+}
+
+proc ::tk::classic::restore {args} {
+ # Restore classic (8.4) look to classic Tk widgets
+ variable prio
+
+ if {[llength $args]} {
+ foreach what $args {
+ ::tk::classic::restore_$what
+ }
+ } else {
+ foreach cmd [info procs restore_*] {
+ $cmd
+ }
+ }
+}
+
+proc ::tk::classic::restore_font {args} {
+ # Many widgets were adjusted from hard-coded defaults to using the
+ # TIP#145 fonts defined in fonts.tcl (eg TkDefaultFont, TkFixedFont, ...)
+ # For restoring compatibility, we only correct size and weighting changes,
+ # as the fonts themselves remained mostly the same.
+ if {[tk windowingsystem] eq "x11"} {
+ font configure TkDefaultFont -weight bold ; # normal
+ font configure TkFixedFont -size -12 ; # -10
+ }
+ # Add these with prio 21 to override value in dialog/msgbox.tcl
+ if {[tk windowingsystem] eq "aqua"} {
+ option add *Dialog.msg.font system 21; # TkCaptionFont
+ option add *Dialog.dtl.font system 21; # TkCaptionFont
+ option add *ErrorDialog*Label.font system 21; # TkCaptionFont
+ } else {
+ option add *Dialog.msg.font {Times 12} 21; # TkCaptionFont
+ option add *Dialog.dtl.font {Times 10} 21; # TkCaptionFont
+ option add *ErrorDialog*Label.font {Times -18} 21; # TkCaptionFont
+ }
+}
+
+proc ::tk::classic::restore_button {args} {
+ variable prio
+ if {[tk windowingsystem] eq "x11"} {
+ foreach cls {Button Radiobutton Checkbutton} {
+ option add *$cls.borderWidth 2 $prio; # 1
+ }
+ }
+}
+
+proc ::tk::classic::restore_entry {args} {
+ variable prio
+ # Entry and Spinbox share core defaults
+ foreach cls {Entry Spinbox} {
+ if {[tk windowingsystem] ne "aqua"} {
+ option add *$cls.borderWidth 2 $prio; # 1
+ }
+ if {[tk windowingsystem] eq "x11"} {
+ option add *$cls.background "#d9d9d9" $prio; # "white"
+ option add *$cls.selectBorderWidth 1 $prio; # 0
+ }
+ }
+}
+
+proc ::tk::classic::restore_listbox {args} {
+ variable prio
+ if {[tk windowingsystem] ne "win32"} {
+ option add *Listbox.background "#d9d9d9" $prio; # "white"
+ option add *Listbox.activeStyle "underline" $prio; # "dotbox"
+ }
+ if {[tk windowingsystem] ne "aqua"} {
+ option add *Listbox.borderWidth 2 $prio; # 1
+ }
+ if {[tk windowingsystem] eq "x11"} {
+ option add *Listbox.selectBorderWidth 1 $prio; # 0
+ }
+ # Remove focus into Listbox added for 8.5
+ bind Listbox <1> {
+ if {[winfo exists %W]} {
+ tk::ListboxBeginSelect %W [%W index @%x,%y]
+ }
+ }
+}
+
+proc ::tk::classic::restore_menu {args} {
+ variable prio
+ if {[tk windowingsystem] eq "x11"} {
+ option add *Menu.activeBorderWidth 2 $prio; # 1
+ option add *Menu.borderWidth 2 $prio; # 1
+ }
+ if {[tk windowingsystem] ne "aqua"} {
+ option add *Menu.font "TkDefaultFont" $prio; # "TkMenuFont"
+ }
+}
+
+proc ::tk::classic::restore_menubutton {args} {
+ variable prio
+ option add *Menubutton.borderWidth 2 $prio; # 1
+}
+
+proc ::tk::classic::restore_message {args} {
+ variable prio
+ option add *Message.borderWidth 2 $prio; # 1
+}
+
+proc ::tk::classic::restore_panedwindow {args} {
+ variable prio
+ option add *Panedwindow.borderWidth 2 $prio; # 1
+ option add *Panedwindow.sashWidth 2 $prio; # 3
+ option add *Panedwindow.sashPad 2 $prio; # 0
+ option add *Panedwindow.sashRelief raised $prio; # flat
+ option add *Panedwindow.opaqueResize 0 $prio; # 1
+ if {[tk windowingsystem] ne "win32"} {
+ option add *Panedwindow.showHandle 1 $prio; # 0
+ }
+}
+
+proc ::tk::classic::restore_scale {args} {
+ variable prio
+ option add *Scale.borderWidth 2 $prio; # 1
+ if {[tk windowingsystem] eq "x11"} {
+ option add *Scale.troughColor "#c3c3c3" $prio; # "#b3b3b3"
+ }
+}
+
+proc ::tk::classic::restore_scrollbar {args} {
+ variable prio
+ if {[tk windowingsystem] eq "x11"} {
+ option add *Scrollbar.borderWidth 2 $prio; # 1
+ option add *Scrollbar.highlightThickness 1 $prio; # 0
+ option add *Scrollbar.width 15 $prio; # 11
+ option add *Scrollbar.troughColor "#c3c3c3" $prio; # "#b3b3b3"
+ }
+}
+
+proc ::tk::classic::restore_text {args} {
+ variable prio
+ if {[tk windowingsystem] ne "aqua"} {
+ option add *Text.borderWidth 2 $prio; # 1
+ }
+ if {[tk windowingsystem] eq "win32"} {
+ option add *Text.font "TkDefaultFont" $prio; # "TkFixedFont"
+ }
+ if {[tk windowingsystem] eq "x11"} {
+ option add *Text.background "#d9d9d9" $prio; # white
+ option add *Text.selectBorderWidth 1 $prio; # 0
+ }
+}
diff --git a/library/optMenu.tcl b/library/optMenu.tcl
index 05b3a45..e0818d9 100644
--- a/library/optMenu.tcl
+++ b/library/optMenu.tcl
@@ -3,7 +3,7 @@
# This file defines the procedure tk_optionMenu, which creates
# an option button and its associated menu.
#
-# RCS: @(#) $Id: optMenu.tcl,v 1.4 2001/08/01 16:21:11 dgp Exp $
+# RCS: @(#) $Id: optMenu.tcl,v 1.5 2007/10/30 01:57:54 hobbs Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
@@ -34,7 +34,7 @@ proc ::tk_optionMenu {w varName firstValue args} {
set var $firstValue
}
menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \
- -relief raised -bd 2 -highlightthickness 2 -anchor c \
+ -relief raised -highlightthickness 1 -anchor c \
-direction flush
menu $w.menu -tearoff 0
$w.menu add radiobutton -label $firstValue -variable $varName
diff --git a/library/tclIndex b/library/tclIndex
index 2550b4e..e7f5b81 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -122,6 +122,7 @@ set auto_index(::tk::ensure_psenc_is_loaded) [list source [file join $dir mkpsen
set auto_index(::tk::MessageBox) [list source [file join $dir msgbox.tcl]]
set auto_index(tk_menuBar) [list source [file join $dir obsolete.tcl]]
set auto_index(tk_bindForTraversal) [list source [file join $dir obsolete.tcl]]
+set auto_index(::tk::classic::restore) [list source [file join $dir obsolete.tcl]]
set auto_index(tk_optionMenu) [list source [file join $dir optMenu.tcl]]
set auto_index(tk_setPalette) [list source [file join $dir palette.tcl]]
set auto_index(::tk::RecolorTree) [list source [file join $dir palette.tcl]]
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index fe6eccd..bbd4dd9 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -11,7 +11,7 @@
# files by clicking on the file icons or by entering a filename
# in the "Filename:" entry.
#
-# RCS: @(#) $Id: tkfbox.tcl,v 1.60 2007/10/25 21:44:22 hobbs Exp $
+# RCS: @(#) $Id: tkfbox.tcl,v 1.61 2007/10/30 01:57:54 hobbs Exp $
#
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
@@ -222,7 +222,7 @@ proc ::tk::IconList_Create {w} {
frame $w
set data(sbar) [scrollbar $w.sbar -orient horizontal -takefocus 0]
catch {$data(sbar) configure -highlightthickness 0}
- set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \
+ set data(canvas) [canvas $w.canvas -borderwidth 1 -relief sunken \
-width 400 -height 120 -takefocus 1]
pack $data(sbar) -side bottom -fill x -padx 2
pack $data(canvas) -expand yes -fill both
@@ -1088,7 +1088,7 @@ static char updir_bits[] = {
# f2: the frame with the OK button, cancel button, "file name" field
# and file types field.
#
- set f2 [frame $w.f2 -bd 0]
+ set f2 [frame $w.f2]
bind [::tk::AmpWidget label $f2.lab -text $fNameCaption -anchor e -pady 0]\
<<AltUnderlined>> [list focus $f2.ent]
set data(ent) [entry $f2.ent]
@@ -1104,8 +1104,7 @@ static char updir_bits[] = {
set data(typeMenuBtn) [menubutton $f2.menu -indicatoron 1 \
-menu $f2.menu.m]
set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
- $data(typeMenuBtn) configure -takefocus 1 -highlightthickness 2 \
- -relief raised -bd 2 -anchor w
+ $data(typeMenuBtn) configure -takefocus 1 -relief raised -anchor w
bind $data(typeMenuLab) <<AltUnderlined>> [list \
focus $data(typeMenuBtn)]
}
diff --git a/library/ttk/fonts.tcl b/library/ttk/fonts.tcl
index a1c9267..f99aaf3 100644
--- a/library/ttk/fonts.tcl
+++ b/library/ttk/fonts.tcl
@@ -1,5 +1,5 @@
#
-# $Id: fonts.tcl,v 1.7 2007/10/21 14:51:27 das Exp $
+# $Id: fonts.tcl,v 1.8 2007/10/30 01:57:55 hobbs Exp $
#
# Font specifications.
#
@@ -122,7 +122,7 @@ switch -- [tk windowingsystem] {
font configure TkFixedFont -family $F(fixed) -size $F(fixedsize)
font configure TkIconFont -family $F(family) -size $F(size)
font configure TkMenuFont -family $F(family) -size $F(menusize)
- font configure TkSmallCaptionFont -family $F(family) -size $F(labelsize)
+ font configure TkSmallCaptionFont -family $F(family) -size $F(labelsize)
}
default -
x11 {
generated by cgit v0.12 at 2024-11-10 05:30:43 (GMT)