summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/bgerror.tcl2
-rw-r--r--library/console.tcl34
-rw-r--r--library/demos/aniwave.tcl2
-rw-r--r--library/demos/fontchoose.tcl2
-rw-r--r--library/demos/knightstour.tcl4
-rw-r--r--library/demos/menu.tcl2
-rw-r--r--library/demos/menubu.tcl2
-rw-r--r--library/demos/msgbox.tcl4
-rw-r--r--library/demos/puzzle.tcl2
-rw-r--r--library/dialog.tcl1
-rw-r--r--library/entry.tcl1
-rw-r--r--library/menu.tcl11
-rw-r--r--library/msgbox.tcl2
-rw-r--r--library/spinbox.tcl1
-rw-r--r--library/text.tcl2
-rw-r--r--library/tk.tcl1
16 files changed, 41 insertions, 32 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl
index d1ed60a..b15387e 100644
--- a/library/bgerror.tcl
+++ b/library/bgerror.tcl
@@ -98,7 +98,7 @@ proc ::tk::dialog::error::ReturnInDetails w {
# err - The error message.
#
proc ::tk::dialog::error::bgerror err {
- global errorInfo tcl_platform
+ global errorInfo
variable button
set info $errorInfo
diff --git a/library/console.tcl b/library/console.tcl
index 566140f..ba68ccc 100644
--- a/library/console.tcl
+++ b/library/console.tcl
@@ -41,8 +41,6 @@ interp alias {} EvalAttached {} consoleinterp eval
# None.
proc ::tk::ConsoleInit {} {
- global tcl_platform
-
if {![consoleinterp eval {set tcl_interactive}]} {
wm withdraw .
}
@@ -78,7 +76,7 @@ proc ::tk::ConsoleInit {} {
AmpMenuArgs .menubar.edit add command -label [mc P&aste] -accel "$mod+V"\
-command {event generate .console <<Paste>>}
- if {$tcl_platform(platform) ne "windows"} {
+ if {[tk windowingsystem] ne "win32"} {
AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \
-command {event generate .console <<Clear>>}
} else {
@@ -114,6 +112,8 @@ proc ::tk::ConsoleInit {} {
-accel "$mod++" -command {event generate .console <<Console_FontSizeIncr>>}
AmpMenuArgs .menubar.edit add command -label [mc "&Decrease Font Size"] \
-accel "$mod+-" -command {event generate .console <<Console_FontSizeDecr>>}
+ AmpMenuArgs .menubar.edit add command -label [mc "Fit To Screen Width"] \
+ -command {event generate .console <<Console_FitScreenWidth>>}
if {[tk windowingsystem] eq "aqua"} {
.menubar add cascade -label [mc Window] -menu [menu .menubar.window]
@@ -193,7 +193,7 @@ proc ::tk::ConsoleInit {} {
$w mark set promptEnd insert
$w mark gravity promptEnd left
- if {$tcl_platform(platform) eq "windows"} {
+ if {[tk windowingsystem] ne "aqua"} {
# Subtle work-around to erase the '% ' that tclMain.c prints out
after idle [subst -nocommand {
if {[$con get 1.0 output] eq "% "} { $con delete 1.0 output }
@@ -378,6 +378,26 @@ proc ::tk::console::Paste {w} {
}
}
+# Fit TkConsoleFont to window width
+proc ::tk::console::FitScreenWidth {w} {
+ set width [winfo screenwidth $w]
+ set cwidth [$w cget -width]
+ set s -50
+ set fit 0
+ array set fi [font configure TkConsoleFont]
+ while {$s < 0} {
+ set fi(-size) $s
+ set f [font create {*}[array get fi]]
+ set c [font measure $f "eM"]
+ font delete $f
+ if {$c * $cwidth < 1.667 * $width} {
+ font configure TkConsoleFont -size $s
+ break
+ }
+ incr s 2
+ }
+}
+
# ::tk::ConsoleBind --
# This procedure first ensures that the default bindings for the Text
# class have been defined. Then certain bindings are overridden for
@@ -600,6 +620,9 @@ proc ::tk::ConsoleBind {w} {
tk fontchooser configure -font TkConsoleFont
}
}
+ bind Console <<Console_FitScreenWidth>> {
+ ::tk::console::FitScreenWidth %W
+ }
##
## Bindings for doing special things based on certain keys
@@ -987,8 +1010,7 @@ proc ::tk::console::ExpandPathname str {
set match {}
} else {
if {[llength $m] > 1} {
- global tcl_platform
- if {[string match windows $tcl_platform(platform)]} {
+ if { $::tcl_platform(platform) eq "windows" } {
## Windows is screwy because it's case insensitive
set tmp [ExpandBestMatch [string tolower $m] \
[string tolower $dir]]
diff --git a/library/demos/aniwave.tcl b/library/demos/aniwave.tcl
index 6122132..a7539fb 100644
--- a/library/demos/aniwave.tcl
+++ b/library/demos/aniwave.tcl
@@ -17,7 +17,7 @@ wm title $w "Animated Wave Demonstration"
wm iconname $w "aniwave"
positionWindow $w
-label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration contains a canvas widget with a line item inside it. The animation routines work by adjusting the coordinates list of the line; a trace on a variable is used so updates to the variable result in a change of position of the line."
+label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration contains a canvas widget with a line item inside it. The animation routines work by adjusting the coordinates list of the line; a trace on a variable is used so updates to the variable result in a change of position of the line."
pack $w.msg -side top
## See Code / Dismiss buttons
diff --git a/library/demos/fontchoose.tcl b/library/demos/fontchoose.tcl
index def30c3..8b34377 100644
--- a/library/demos/fontchoose.tcl
+++ b/library/demos/fontchoose.tcl
@@ -57,7 +57,7 @@ grid columnconfigure $f 0 -weight 1
grid rowconfigure $f 0 -weight 1
bind $w <Visibility> {
bind %W <Visibility> {}
- grid propagate %W.f 0
+ grid propagate %W.f 0
}
## See Code / Dismiss buttons
diff --git a/library/demos/knightstour.tcl b/library/demos/knightstour.tcl
index 73ca3a3..6113db2 100644
--- a/library/demos/knightstour.tcl
+++ b/library/demos/knightstour.tcl
@@ -221,7 +221,7 @@ proc CreateGUI {} {
$c bind knight <ButtonPress-1> [namespace code [list DragStart %W %x %y]]
$c bind knight <Motion> [namespace code [list DragMotion %W %x %y]]
$c bind knight <ButtonRelease-1> [namespace code [list DragEnd %W %x %y]]
-
+
grid $c $f.txt $f.vs -sticky news
grid rowconfigure $f 0 -weight 1
grid columnconfigure $f 1 -weight 1
@@ -244,7 +244,7 @@ proc CreateGUI {} {
if {[info exists ::widgetDemo]} {
grid [addSeeDismiss $dlg.buttons $dlg] - - - - - -sticky ew
}
-
+
grid rowconfigure $dlg 0 -weight 1
grid columnconfigure $dlg 0 -weight 1
diff --git a/library/demos/menu.tcl b/library/demos/menu.tcl
index e19df57..e32b54f 100644
--- a/library/demos/menu.tcl
+++ b/library/demos/menu.tcl
@@ -16,7 +16,7 @@ wm title $w "Menu Demonstration"
wm iconname $w "menu"
positionWindow $w
-label $w.msg -font $font -wraplength 4i -justify left
+label $w.msg -font $font -wraplength 4i -justify left
if {[tk windowingsystem] eq "aqua"} {
catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1}
$w.msg configure -text "This window has a menubar with cascaded menus. You can invoke entries with an accelerator by typing Command+x, where \"x\" is the character next to the command key symbol. The rightmost menu can be torn off into a palette by selecting the first item in the menu."
diff --git a/library/demos/menubu.tcl b/library/demos/menubu.tcl
index 86326b5..96e3b15 100644
--- a/library/demos/menubu.tcl
+++ b/library/demos/menubu.tcl
@@ -21,7 +21,7 @@ pack $w.body -expand 1 -fill both
if {[tk windowingsystem] eq "aqua"} {catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1}}
menubutton $w.body.below -text "Below" -underline 0 -direction below -menu $w.body.below.m -relief raised
-menu $w.body.below.m -tearoff 0
+menu $w.body.below.m -tearoff 0
$w.body.below.m add command -label "Below menu: first item" -command "puts \"You have selected the first item from the Below menu.\""
$w.body.below.m add command -label "Below menu: second item" -command "puts \"You have selected the second item from the Below menu.\""
grid $w.body.below -row 0 -column 1 -sticky n
diff --git a/library/demos/msgbox.tcl b/library/demos/msgbox.tcl
index bd98bf2..2c2cc2d 100644
--- a/library/demos/msgbox.tcl
+++ b/library/demos/msgbox.tcl
@@ -23,7 +23,7 @@ pack [addSeeDismiss $w.buttons $w {} {
}] -side bottom -fill x
#pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1
-frame $w.left
+frame $w.left
frame $w.right
pack $w.left $w.right -side left -expand yes -fill y -pady .5c -padx .5c
@@ -56,7 +56,7 @@ proc showMessageBox {w} {
set button [tk_messageBox -icon $msgboxIcon -type $msgboxType \
-title Message -parent $w\
-message "This is a \"$msgboxType\" type messagebox with the \"$msgboxIcon\" icon"]
-
+
tk_messageBox -icon info -message "You have selected \"$button\"" -type ok\
-parent $w
}
diff --git a/library/demos/puzzle.tcl b/library/demos/puzzle.tcl
index fb8ab4c..4f7f955 100644
--- a/library/demos/puzzle.tcl
+++ b/library/demos/puzzle.tcl
@@ -54,7 +54,7 @@ pack $btns -side bottom -fill x
scrollbar $w.s
# The button metrics are a bit bigger in Aqua, and since we are
-# using place which doesn't autosize, then we need to have a
+# using place which doesn't autosize, then we need to have a
# slightly larger frame here...
if {[tk windowingsystem] eq "aqua"} {
diff --git a/library/dialog.tcl b/library/dialog.tcl
index 22c4dd3..c751621 100644
--- a/library/dialog.tcl
+++ b/library/dialog.tcl
@@ -28,7 +28,6 @@
# bottom of the dialog box.
proc ::tk_dialog {w title text bitmap default args} {
- global tcl_platform
variable ::tk::Priv
# Check that $default was properly given
diff --git a/library/entry.tcl b/library/entry.tcl
index c8422dc..f7170f7 100644
--- a/library/entry.tcl
+++ b/library/entry.tcl
@@ -46,7 +46,6 @@ bind Entry <<Copy>> {
}
}
bind Entry <<Paste>> {
- global tcl_platform
catch {
if {[tk windowingsystem] ne "x11"} {
catch {
diff --git a/library/menu.tcl b/library/menu.tcl
index 5a5d9de..a7aaa3f 100644
--- a/library/menu.tcl
+++ b/library/menu.tcl
@@ -248,7 +248,6 @@ proc ::tk::MbLeave w {
proc ::tk::MbPost {w {x {}} {y {}}} {
global errorInfo
variable ::tk::Priv
- global tcl_platform
if {[$w cget -state] eq "disabled" || $w eq $Priv(postedMb)} {
return
@@ -402,7 +401,6 @@ proc ::tk::MbPost {w {x {}} {y {}}} {
# is a posted menubutton.
proc ::tk::MenuUnpost menu {
- global tcl_platform
variable ::tk::Priv
set mb $Priv(postedMb)
@@ -531,7 +529,6 @@ proc ::tk::MbMotion {w upDown rootx rooty} {
proc ::tk::MbButtonUp w {
variable ::tk::Priv
- global tcl_platform
set menu [$w cget -menu]
set tearoff [expr {[tk windowingsystem] eq "x11" || \
@@ -606,7 +603,6 @@ proc ::tk::MenuMotion {menu x y state} {
proc ::tk::MenuButtonDown menu {
variable ::tk::Priv
- global tcl_platform
if {![winfo viewable $menu]} {
return
@@ -1218,8 +1214,6 @@ proc ::tk::MenuFindName {menu s} {
# upper-left corner goes at (x,y).
proc ::tk::PostOverPoint {menu x y {entry {}}} {
- global tcl_platform
-
if {$entry ne ""} {
if {$entry == [$menu index last]} {
incr y [expr {-([$menu yposition $entry] \
@@ -1234,8 +1228,8 @@ proc ::tk::PostOverPoint {menu x y {entry {}}} {
if {[tk windowingsystem] eq "win32"} {
# osVersion is not available in safe interps
set ver 5
- if {[info exists tcl_platform(osVersion)]} {
- scan $tcl_platform(osVersion) %d ver
+ if {[info exists ::tcl_platform(osVersion)]} {
+ scan $::tcl_platform(osVersion) %d ver
}
# We need to fix some problems with menu posting on Windows,
@@ -1340,7 +1334,6 @@ proc ::tk::GenerateMenuSelect {menu} {
proc ::tk_popup {menu x y {entry {}}} {
variable ::tk::Priv
- global tcl_platform
if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} {
tk::MenuUnpost {}
}
diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index 939928d..6d329c2 100644
--- a/library/msgbox.tcl
+++ b/library/msgbox.tcl
@@ -129,7 +129,7 @@ static unsigned char w3_bits[] = {
# See the user documentation for details on what tk_messageBox does.
#
proc ::tk::MessageBox {args} {
- global tcl_platform tk_strictMotif
+ global tk_strictMotif
variable ::tk::Priv
set w ::tk::PrivMsgBox
diff --git a/library/spinbox.tcl b/library/spinbox.tcl
index 4d94420..6a5f829 100644
--- a/library/spinbox.tcl
+++ b/library/spinbox.tcl
@@ -52,7 +52,6 @@ bind Spinbox <<Copy>> {
}
}
bind Spinbox <<Paste>> {
- global tcl_platform
catch {
if {[tk windowingsystem] ne "x11"} {
catch {
diff --git a/library/text.tcl b/library/text.tcl
index 279e2d9..18fed2c 100644
--- a/library/text.tcl
+++ b/library/text.tcl
@@ -543,7 +543,6 @@ proc ::tk::TextAnchor {w} {
}
proc ::tk::TextSelectTo {w x y {extend 0}} {
- global tcl_platform
variable ::tk::Priv
set anchorname [tk::TextAnchor $w]
@@ -1036,7 +1035,6 @@ proc ::tk_textCut w {
# w - Name of a text widget.
proc ::tk_textPaste w {
- global tcl_platform
if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {
set oldSeparator [$w cget -autoseparators]
if {$oldSeparator} {
diff --git a/library/tk.tcl b/library/tk.tcl
index da619e6..9a6a581 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -253,7 +253,6 @@ proc ::tk::ScreenChanged screen {
uplevel #0 [list upvar #0 ::tk::Priv.$disp ::tk::Priv]
variable ::tk::Priv
- global tcl_platform
if {[info exists Priv]} {
set Priv(screen) $screen
generated by cgit v0.12 at 2024-11-05 02:39:14 (GMT)