Skip to content

Commit ef1dc94

Browse files
patthoytspatthoyts
committed
Update tk to version 8.5.8
Signed-off-by: Pat Thoyts <[email protected]>
1 parent a910049 commit ef1dc94

22 files changed

Lines changed: 432 additions & 187 deletions

‎mingw/bin/tk85.dll‎

-384 KB
Binary file not shown.

‎mingw/bin/wish.exe‎

-11.4 KB
Binary file not shown.

‎mingw/bin/wish85.exe‎

-11.4 KB
Binary file not shown.

‎mingw/include/tk.h‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
* See the file "license.terms" for information on usage and redistribution of
1313
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
1414
*
15-
* RCS: @(#) $Id: tk.h,v 1.109.2.11 2009/04/10 18:13:05 dgp Exp $
15+
* RCS: @(#) $Id: tk.h,v 1.109.2.12 2009/11/03 20:15:25 dgp Exp $
1616
*/
1717

1818
#ifndef _TK
@@ -53,10 +53,10 @@ extern "C" {
5353
#define TK_MAJOR_VERSION 8
5454
#define TK_MINOR_VERSION 5
5555
#define TK_RELEASE_LEVEL TCL_FINAL_RELEASE
56-
#define TK_RELEASE_SERIAL 7
56+
#define TK_RELEASE_SERIAL 8
5757

5858
#define TK_VERSION "8.5"
59-
#define TK_PATCH_LEVEL "8.5.7"
59+
#define TK_PATCH_LEVEL "8.5.8"
6060

6161
/*
6262
* A special definition used to allow this header file to be included from

‎mingw/lib/libtk85.a‎

-343 KB
Binary file not shown.

‎mingw/lib/libtkstub85.a‎

-2.49 KB
Binary file not shown.

‎mingw/lib/tk8.5/button.tcl‎

Lines changed: 118 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44
# checkbutton, and radiobutton widgets and provides procedures
55
# that help in implementing those bindings.
66
#
7-
# RCS: @(#) $Id: button.tcl,v 1.19 2005/07/25 09:06:01 dkf Exp $
7+
# RCS: @(#) $Id: button.tcl,v 1.19.4.1 2009/10/24 00:12:03 dkf Exp $
88
#
99
# Copyright (c) 1992-1994 The Regents of the University of California.
1010
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -37,6 +37,9 @@ if {[tk windowingsystem] eq "aqua"} {
3737
bind Checkbutton <ButtonRelease-1> {
3838
tk::ButtonUp %W
3939
}
40+
bind Checkbutton <Leave> {
41+
tk::ButtonLeave %W
42+
}
4043
}
4144
if {"windows" eq $tcl_platform(platform)} {
4245
bind Checkbutton <equal> {
@@ -57,6 +60,9 @@ if {"windows" eq $tcl_platform(platform)} {
5760
bind Checkbutton <Enter> {
5861
tk::CheckRadioEnter %W
5962
}
63+
bind Checkbutton <Leave> {
64+
tk::ButtonLeave %W
65+
}
6066

6167
bind Radiobutton <1> {
6268
tk::CheckRadioDown %W
@@ -71,7 +77,7 @@ if {"windows" eq $tcl_platform(platform)} {
7177
if {"x11" eq [tk windowingsystem]} {
7278
bind Checkbutton <Return> {
7379
if {!$tk_strictMotif} {
74-
tk::CheckRadioInvoke %W
80+
tk::CheckInvoke %W
7581
}
7682
}
7783
bind Radiobutton <Return> {
@@ -80,17 +86,20 @@ if {"x11" eq [tk windowingsystem]} {
8086
}
8187
}
8288
bind Checkbutton <1> {
83-
tk::CheckRadioInvoke %W
89+
tk::CheckInvoke %W
8490
}
8591
bind Radiobutton <1> {
8692
tk::CheckRadioInvoke %W
8793
}
8894
bind Checkbutton <Enter> {
89-
tk::ButtonEnter %W
95+
tk::CheckEnter %W
9096
}
9197
bind Radiobutton <Enter> {
9298
tk::ButtonEnter %W
9399
}
100+
bind Checkbutton <Leave> {
101+
tk::CheckLeave %W
102+
}
94103
}
95104

96105
bind Button <space> {
@@ -118,9 +127,6 @@ bind Button <ButtonRelease-1> {
118127
}
119128

120129
bind Checkbutton <FocusIn> {}
121-
bind Checkbutton <Leave> {
122-
tk::ButtonLeave %W
123-
}
124130

125131
bind Radiobutton <FocusIn> {}
126132
bind Radiobutton <Leave> {
@@ -635,3 +641,108 @@ proc ::tk::CheckRadioInvoke {w {cmd invoke}} {
635641
uplevel #0 [list $w $cmd]
636642
}
637643
}
644+
645+
# Special versions of the handlers for checkbuttons on Unix that do the magic
646+
# to make things work right when the checkbutton indicator is hidden;
647+
# radiobuttons don't need this complexity.
648+
649+
# ::tk::CheckInvoke --
650+
# The procedure below invokes the checkbutton, like ButtonInvoke, but handles
651+
# what to do when the checkbutton indicator is missing. Only used on Unix.
652+
#
653+
# Arguments:
654+
# w - The name of the widget.
655+
656+
proc ::tk::CheckInvoke {w} {
657+
variable ::tk::Priv
658+
if {[$w cget -state] ne "disabled"} {
659+
# Additional logic to switch the "selected" colors around if necessary
660+
# (when we're indicator-less).
661+
662+
if {![$w cget -indicatoron]} {
663+
if {[$w cget -selectcolor] eq $Priv($w,aselectcolor)} {
664+
$w configure -selectcolor $Priv($w,selectcolor)
665+
} else {
666+
$w configure -selectcolor $Priv($w,aselectcolor)
667+
}
668+
}
669+
uplevel #0 [list $w invoke]
670+
}
671+
}
672+
673+
# ::tk::CheckEnter --
674+
# The procedure below enters the checkbutton, like ButtonEnter, but handles
675+
# what to do when the checkbutton indicator is missing. Only used on Unix.
676+
#
677+
# Arguments:
678+
# w - The name of the widget.
679+
680+
proc ::tk::CheckEnter {w} {
681+
variable ::tk::Priv
682+
if {[$w cget -state] ne "disabled"} {
683+
# On unix the state is active just with mouse-over
684+
$w configure -state active
685+
686+
# If the mouse button is down, set the relief to sunken on entry.
687+
# Overwise, if there's an -overrelief value, set the relief to that.
688+
689+
set Priv($w,relief) [$w cget -relief]
690+
if {$Priv(buttonWindow) eq $w} {
691+
$w configure -relief sunken
692+
set Priv($w,prelief) sunken
693+
} elseif {[set over [$w cget -overrelief]] ne ""} {
694+
$w configure -relief $over
695+
set Priv($w,prelief) $over
696+
}
697+
698+
# Compute what the "selected and active" color should be.
699+
700+
if {![$w cget -indicatoron]} {
701+
set Priv($w,selectcolor) [$w cget -selectcolor]
702+
lassign [winfo rgb $w [$w cget -selectcolor]] r1 g1 b1
703+
lassign [winfo rgb $w [$w cget -activebackground]] r2 g2 b2
704+
set Priv($w,aselectcolor) \
705+
[format "#%04x%04x%04x" [expr {($r1+$r2)/2}] \
706+
[expr {($g1+$g2)/2}] [expr {($b1+$b2)/2}]]
707+
if {[set ::[$w cget -variable]] eq [$w cget -onvalue]} {
708+
$w configure -selectcolor $Priv($w,aselectcolor)
709+
}
710+
}
711+
}
712+
set Priv(window) $w
713+
}
714+
715+
# ::tk::CheckLeave --
716+
# The procedure below leaves the checkbutton, like ButtonLeave, but handles
717+
# what to do when the checkbutton indicator is missing. Only used on Unix.
718+
#
719+
# Arguments:
720+
# w - The name of the widget.
721+
722+
proc ::tk::CheckLeave {w} {
723+
variable ::tk::Priv
724+
if {[$w cget -state] ne "disabled"} {
725+
$w configure -state normal
726+
}
727+
728+
# Restore the original button "selected" color; assume that the user
729+
# wasn't monkeying around with things too much.
730+
731+
if {![$w cget -indicatoron] && [info exist Priv($w,selectcolor)]} {
732+
$w configure -selectcolor $Priv($w,selectcolor)
733+
}
734+
unset -nocomplain Priv($w,selectcolor) Priv($w,aselectcolor)
735+
736+
# Restore the original button relief if it was changed by Tk. That is
737+
# signaled by the existence of Priv($w,prelief).
738+
739+
if {[info exists Priv($w,relief)]} {
740+
if {[info exists Priv($w,prelief)] && \
741+
$Priv($w,prelief) eq [$w cget -relief]} {
742+
$w configure -relief $Priv($w,relief)
743+
}
744+
unset -nocomplain Priv($w,relief) Priv($w,prelief)
745+
}
746+
747+
set Priv(window) ""
748+
}

‎mingw/lib/tk8.5/demos/ctext.tcl‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
# This demonstration script creates a canvas widget with a text
44
# item that can be edited and reconfigured in various ways.
55
#
6-
# RCS: @(#) $Id: ctext.tcl,v 1.5 2004/12/21 11:56:35 dkf Exp $
6+
# RCS: @(#) $Id: ctext.tcl,v 1.5.4.1 2009/10/27 14:02:58 dkf Exp $
77

88
if {![info exists widgetDemo]} {
99
error "This script should be run from the \"widget\" demo."
@@ -42,7 +42,7 @@ $c create rectangle 245 195 255 205 -outline black -fill red
4242

4343
# First, create the text item and give it bindings so it can be edited.
4444

45-
$c addtag text withtag [$c create text 250 200 -text "This is just a string of text to demonstrate the text facilities of canvas widgets. Bindings have been been defined to support editing (see above)." -width 440 -anchor n -font {Helvetica 24} -justify left]
45+
$c addtag text withtag [$c create text 250 200 -text "This is just a string of text to demonstrate the text facilities of canvas widgets. Bindings have been been defined to support editing (see above)." -width 440 -anchor n -font $textFont -justify left]
4646
$c bind text <1> "textB1Press $c %x %y"
4747
$c bind text <B1-Motion> "textB1Move $c %x %y"
4848
$c bind text <Shift-1> "$c select adjust current @%x,%y"

‎mingw/lib/tk8.5/demos/pendulum.tcl‎

Lines changed: 18 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
# This demonstration illustrates how Tcl/Tk can be used to construct
44
# simulations of physical systems.
55
#
6-
# RCS: @(#) $Id: pendulum.tcl,v 1.3 2006/10/17 05:52:40 das Exp $
6+
# RCS: @(#) $Id: pendulum.tcl,v 1.3.4.1 2009/08/08 08:28:40 dkf Exp $
77

88
if {![info exists widgetDemo]} {
99
error "This script should be run from the \"widget\" demo."
@@ -35,10 +35,10 @@ $w.p add [labelframe $w.p.l2 -text "Phase Space"]
3535
canvas $w.c -width 320 -height 200 -background white -bd 2 -relief sunken
3636
$w.c create text 5 5 -anchor nw -text "Click to Adjust Bob Start Position"
3737
# Coordinates of these items don't matter; they will be set properly below
38-
$w.c create line 0 25 320 25 -width 2 -fill grey50 -tags plate
39-
$w.c create line 1 1 1 1 -tags pendulumRod -width 3 -fill black
40-
$w.c create oval 1 1 2 2 -tags pendulumBob -fill yellow -outline black
41-
$w.c create oval 155 20 165 30 -fill grey50 -outline {}
38+
$w.c create line 0 25 320 25 -tags plate -fill grey50 -width 2
39+
$w.c create oval 155 20 165 30 -tags pivot -fill grey50 -outline {}
40+
$w.c create line 1 1 1 1 -tags rod -fill black -width 3
41+
$w.c create oval 1 1 2 2 -tags bob -fill yellow -outline black
4242
pack $w.c -in $w.p.l1 -fill both -expand true
4343

4444
# Create the canvas containing the phase space graph; this consists of
@@ -62,6 +62,7 @@ set Theta 45.0
6262
set dTheta 0.0
6363
set pi 3.1415926535897933
6464
set length 150
65+
set home 160
6566

6667
# This procedure makes the pendulum appear at the correct place on the
6768
# canvas. If the additional arguments "at $x $y" are passed (the 'at'
@@ -70,20 +71,20 @@ set length 150
7071
# length and angle are computed in reverse from the given location
7172
# (which is taken to be the centre of the pendulum bob.)
7273
proc showPendulum {canvas {at {}} {x {}} {y {}}} {
73-
global Theta dTheta pi length
74-
if {$at eq "at" && ($x!=160 || $y!=25)} {
74+
global Theta dTheta pi length home
75+
if {$at eq "at" && ($x!=$home || $y!=25)} {
7576
set dTheta 0.0
76-
set x2 [expr {$x-160}]
77-
set y2 [expr {$y-25}]
78-
set length [expr {hypot($x2,$y2)}]
79-
set Theta [expr {atan2($x2,$y2)*180/$pi}]
77+
set x2 [expr {$x - $home}]
78+
set y2 [expr {$y - 25}]
79+
set length [expr {hypot($x2, $y2)}]
80+
set Theta [expr {atan2($x2, $y2) * 180/$pi}]
8081
} else {
8182
set angle [expr {$Theta * $pi/180}]
82-
set x [expr {160+$length*sin($angle)}]
83-
set y [expr {25+$length*cos($angle)}]
83+
set x [expr {$home + $length*sin($angle)}]
84+
set y [expr {25 + $length*cos($angle)}]
8485
}
85-
$canvas coords pendulumRod 160 25 $x $y
86-
$canvas coords pendulumBob \
86+
$canvas coords rod $home 25 $x $y
87+
$canvas coords bob \
8788
[expr {$x-15}] [expr {$y-15}] [expr {$x+15}] [expr {$y+15}]
8889
}
8990
showPendulum $w.c
@@ -127,6 +128,8 @@ bind $w.c <ButtonRelease-1> {
127128
}
128129
bind $w.c <Configure> {
129130
%W coords plate 0 25 %w 25
131+
set home [expr %w/2]
132+
%W coords pivot [expr $home-5] 20 [expr $home+5] 30
130133
}
131134
bind $w.k <Configure> {
132135
set psh [expr %h/2]

‎mingw/lib/tk8.5/msgbox.tcl‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
# Implements messageboxes for platforms that do not have native
44
# messagebox support.
55
#
6-
# RCS: @(#) $Id: msgbox.tcl,v 1.36.2.1 2009/04/10 16:45:46 das Exp $
6+
# RCS: @(#) $Id: msgbox.tcl,v 1.36.2.2 2009/08/24 21:19:35 dkf Exp $
77
#
88
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
99
#
@@ -396,12 +396,12 @@ proc ::tk::MessageBox {args} {
396396

397397
if {$data(-default) ne ""} {
398398
bind $w <FocusIn> {
399-
if {[winfo class %W] eq "Button"} {
399+
if {[winfo class %W] in "Button TButton"} {
400400
%W configure -default active
401401
}
402402
}
403403
bind $w <FocusOut> {
404-
if {[winfo class %W] eq "Button"} {
404+
if {[winfo class %W] in "Button TButton"} {
405405
%W configure -default normal
406406
}
407407
}
@@ -410,7 +410,7 @@ proc ::tk::MessageBox {args} {
410410
# 6. Create bindings for <Return>, <Escape> and <Destroy> on the dialog
411411

412412
bind $w <Return> {
413-
if {[winfo class %W] eq "Button"} {
413+
if {[winfo class %W] in "Button TButton"} {
414414
%W invoke
415415
}
416416
}

0 commit comments

Comments
 (0)