This commit is contained in:
ton
2024-10-07 10:13:40 +07:00
parent aa1631742f
commit 3a7d696db6
9729 changed files with 1832837 additions and 161742 deletions

View File

@@ -118,7 +118,9 @@ proc ::tk::dialog::file::chooseDir:: {args} {
foreach trace [trace info variable data(selectPath)] {
trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
}
$data(dirMenuBtn) configure -textvariable {}
if {[winfo exists $data(dirMenuBtn)]} {
$data(dirMenuBtn) configure -textvariable {}
}
# Return value to user
#

View File

@@ -320,7 +320,6 @@ proc ::tk::dialog::color::BuildDialog {w} {
bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w]
bind $lab <Destroy> [list tk::dialog::color::CancelCmd $w]
}
# ::tk::dialog::color::SetRGBValue --

View File

@@ -595,7 +595,7 @@ proc ::tk::ConsoleBind {w} {
tk::ConsoleInsert %W %A
}
bind Console <F9> {
eval destroy [winfo child .]
destroy {*}[winfo children .]
source -encoding utf-8 [file join $tk_library console.tcl]
}
if {[tk windowingsystem] eq "aqua"} {

View File

@@ -65,7 +65,7 @@ proc tristate_check {n1 n2 op} {
set in_check 0
}
trace variable wipers w tristate_check
trace variable brakes w tristate_check
trace variable sober w tristate_check
trace variable safety w tristate_check
trace add variable wipers write tristate_check
trace add variable brakes write tristate_check
trace add variable sober write tristate_check
trace add variable safety write tristate_check

View File

@@ -62,6 +62,7 @@ proc floorDisplay {w active} {
$w create window 600 100 -anchor w -window $w.entry
$w create text 600 100 -anchor e -text "Room: "
$w config -scrollregion [$w bbox all]
}
@@ -1368,4 +1369,4 @@ if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk]
}
bind $c <Destroy> "unset currentRoom"
set currentRoom ""
trace variable currentRoom w "roomChanged $c"
trace add variable currentRoom write "roomChanged $c"

View File

@@ -113,9 +113,9 @@ proc DoDisplay {w} {
DoCtrlFrame $w
DoDetailFrame $w
if {[tk windowingsystem] ne "aqua"} {
ttk::button $w.show -text "\u00bb" -command [list ShowCtrl $w] -width 2
ttk::button $w.show -text "\xbb" -command [list ShowCtrl $w] -width 2
} else {
button $w.show -text "\u00bb" -command [list ShowCtrl $w] -width 2 -highlightbackground $C(bg)
button $w.show -text "\xbb" -command [list ShowCtrl $w] -width 2 -highlightbackground $C(bg)
}
place $w.show -in $w.c -relx 1 -rely 0 -anchor ne
update
@@ -153,9 +153,9 @@ proc DoCtrlFrame {w} {
raise $w.details
raise $w.details.cb
grid rowconfigure $w.ctrl 50 -weight 1
trace variable ::S(mode) w [list ActiveGUI $w]
trace variable ::S(details) w [list ActiveGUI $w]
trace variable ::S(speed) w [list ActiveGUI $w]
trace add variable ::S(mode) write [list ActiveGUI $w]
trace add variable ::S(details) write [list ActiveGUI $w]
trace add variable ::S(speed) write [list ActiveGUI $w]
grid $w.message -in $w.ctrl -row 98 -sticky ew -pady 5
grid $w.message.e -sticky nsew
@@ -185,7 +185,6 @@ proc DoDetailFrame {w} {
set w2 $w.details.f
ttk::frame $w2
set bd 2
ttk::label $w2.l -textvariable S(cnt) -background white
grid $w2.l - - - -sticky ew -row 0
for {set i 1} {1} {incr i} {
@@ -204,10 +203,10 @@ proc DoDetailFrame {w} {
proc ShowCtrl {w} {
if {[winfo ismapped $w.ctrl]} {
pack forget $w.ctrl
$w.show config -text "\u00bb"
$w.show config -text "\xbb"
} else {
pack $w.ctrl -side right -fill both -ipady 5
$w.show config -text "\u00ab"
$w.show config -text "\xab"
}
}
@@ -272,7 +271,7 @@ proc Go {w {who {}}} {
set now [clock clicks -milliseconds]
catch {after cancel $animationCallbacks(goldberg)}
if {$who ne ""} { ;# Start here for debugging
set S(active) $who;
set S(active) $who
set S(mode) $MGO
}
if {$S(mode) == -1} return ;# Debugging

View File

@@ -82,8 +82,8 @@ proc showPendulum {canvas {at {}} {x {}} {y {}}} {
set y [expr {25 + $length*cos($angle)}]
}
$canvas coords rod $home 25 $x $y
$canvas coords bob \
[expr {$x-15}] [expr {$y-15}] [expr {$x+15}] [expr {$y+15}]
$canvas coords bob [expr {$x - 15}] [expr {$y - 15}] \
[expr {$x + 15}] [expr {$y + 15}]
}
showPendulum $w.c
@@ -92,7 +92,7 @@ showPendulum $w.c
# respect to time.)
proc showPhase {canvas} {
global Theta dTheta points psw psh
lappend points [expr {$Theta+$psw}] [expr {-20*$dTheta+$psh}]
lappend points [expr {$Theta + $psw}] [expr {-20*$dTheta + $psh}]
if {[llength $points] > 100} {
set points [lrange $points end-99 end]
}
@@ -127,15 +127,15 @@ bind $w.c <ButtonRelease-1> {
bind $w.c <Configure> {
%W coords plate 0 25 %w 25
set home [expr {%w/2}]
%W coords pivot [expr {$home-5}] 20 [expr {$home+5}] 30
%W coords pivot [expr {$home - 5}] 20 [expr {$home + 5}] 30
}
bind $w.k <Configure> {
set psh [expr {%h/2}]
set psw [expr {%w/2}]
%W coords x_axis 2 $psh [expr {%w-2}] $psh
%W coords y_axis $psw [expr {%h-2}] $psw 2
%W coords label_dtheta [expr {$psw-4}] 6
%W coords label_theta [expr {%w-6}] [expr {$psh+4}]
%W coords x_axis 2 $psh [expr {%w - 2}] $psh
%W coords y_axis $psw [expr {%h - 2}] $psw 2
%W coords label_dtheta [expr {$psw - 4}] 6
%W coords label_theta [expr {%w - 6}] [expr {$psh + 4}]
}
# This procedure is the "business" part of the simulation that does

View File

@@ -10,7 +10,7 @@ exec wish "$0" ${1+"$@"}
package require Tk
foreach i [winfo child .] {
foreach i [winfo children .] {
catch {destroy $i}
}

View File

@@ -13,7 +13,7 @@ exec wish "$0" ${1+"$@"}
package require Tk 8.5
package require msgcat
eval destroy [winfo child .]
destroy {*}[winfo children .]
set tk_demoDirectory [file join [pwd] [file dirname [info script]]]
::msgcat::mcload $tk_demoDirectory
namespace import ::msgcat::mc

View File

@@ -599,6 +599,10 @@ proc ::tk::EntryTranspose w {
if {[tk windowingsystem] eq "win32"} {
proc ::tk::EntryNextWord {w start} {
# the check on [winfo class] is because the spinbox also uses this proc
if {[winfo class $w] eq "Entry" && [$w cget -show] ne ""} {
return end
}
set pos [tcl_endOfWord [$w get] [$w index $start]]
if {$pos >= 0} {
set pos [tcl_startOfNextWord [$w get] $pos]
@@ -610,6 +614,10 @@ if {[tk windowingsystem] eq "win32"} {
}
} else {
proc ::tk::EntryNextWord {w start} {
# the check on [winfo class] is because the spinbox also uses this proc
if {[winfo class $w] eq "Entry" && [$w cget -show] ne ""} {
return end
}
set pos [tcl_endOfWord [$w get] [$w index $start]]
if {$pos < 0} {
return end
@@ -628,6 +636,10 @@ if {[tk windowingsystem] eq "win32"} {
# start - Position at which to start search.
proc ::tk::EntryPreviousWord {w start} {
# the check on [winfo class] is because the spinbox also uses this proc
if {[winfo class $w] eq "Entry" && [$w cget -show] ne ""} {
return 0
}
set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
if {$pos < 0} {
return 0

View File

@@ -324,11 +324,11 @@ proc ::tk::fontchooser::Done {ok} {
if {! $ok} {
set S(result) ""
}
trace vdelete S(size) w [namespace code [list Tracer]]
trace vdelete S(style) w [namespace code [list Tracer]]
trace vdelete S(font) w [namespace code [list Tracer]]
trace vdelete S(strike) w [namespace code [list Tracer]]
trace vdelete S(under) w [namespace code [list Tracer]]
trace remove variable S(size) write [namespace code [list Tracer]]
trace remove variable S(style) write [namespace code [list Tracer]]
trace remove variable S(font) write [namespace code [list Tracer]]
trace remove variable S(strike) write [namespace code [list Tracer]]
trace remove variable S(under) write [namespace code [list Tracer]]
destroy $S(W)
if {$ok} {
if {$S(-command) ne ""} {

View File

@@ -377,7 +377,7 @@ package require Tk
method DrawSelection {} {
$canvas delete selection
$canvas itemconfigure selectionText -fill black
$canvas itemconfigure selectionText -fill $fill
$canvas dtag selectionText
set cbg [ttk::style lookup TEntry -selectbackground focus]
set cfg [ttk::style lookup TEntry -selectforeground focus]
@@ -422,12 +422,7 @@ package require Tk
set noScroll 1
set selection {}
set index(anchor) ""
set fg [option get $canvas foreground Foreground]
if {$fg eq ""} {
set fill black
} else {
set fill $fg
}
set fill black
# Creates the event bindings.
#

View File

@@ -88,7 +88,7 @@ bind Menubutton <Enter> {
bind Menubutton <Leave> {
tk::MbLeave %W
}
bind Menubutton <1> {
bind Menubutton <Button-1> {
if {$tk::Priv(inMenubutton) ne ""} {
tk::MbPost $tk::Priv(inMenubutton) %X %Y
}
@@ -475,7 +475,7 @@ proc ::tk::MbButtonUp w {
proc ::tk::MenuMotion {menu x y state} {
variable ::tk::Priv
if {$menu eq $Priv(window)} {
set active [$menu index active]
set activeindex [$menu index active]
if {[$menu cget -type] eq "menubar"} {
if {[info exists Priv(focus)] && $menu ne $Priv(focus)} {
$menu activate @$x,$y
@@ -488,7 +488,8 @@ proc ::tk::MenuMotion {menu x y state} {
set index [$menu index @$x,$y]
if {[info exists Priv(menuActivated)] \
&& $index ne "none" \
&& $index ne $active} {
&& $index >= 0 \
&& $index ne $activeindex} {
set mode [option get $menu clickToFocus ClickToFocus]
if {[string is false $mode]} {
set delay [expr {[$menu cget -type] eq "menubar" ? 0 : 50}]
@@ -496,10 +497,12 @@ proc ::tk::MenuMotion {menu x y state} {
# Catch these postcascade commands since the menu could be
# destroyed before they run.
set Priv(menuActivatedTimer) \
[after $delay "catch {$menu postcascade active}"]
[after $delay [list catch [list \
$menu postcascade active]]]
} else {
set Priv(menuDeactivatedTimer) \
[after $delay "catch {$menu postcascade none}"]
[after $delay [list catch [list
$menu postcascade none]]]
}
}
}
@@ -527,7 +530,8 @@ proc ::tk::MenuButtonDown menu {
if {![winfo viewable $menu]} {
return
}
if {[$menu index active] eq "none"} {
set activeindex [$menu index active]
if {($activeindex eq "none") || ($activeindex < 0)} {
if {[$menu cget -type] ne "menubar" } {
set Priv(window) {}
}
@@ -585,7 +589,8 @@ proc ::tk::MenuButtonDown menu {
proc ::tk::MenuLeave {menu rootx rooty state} {
variable ::tk::Priv
set Priv(window) {}
if {[$menu index active] eq "none"} {
set activeindex [$menu index active]
if {($activeindex eq "none") || ($activeindex < 0)} {
return
}
if {[$menu type active] eq "cascade" \
@@ -630,8 +635,8 @@ proc ::tk::MenuInvoke {w buttonRelease} {
MenuUnpost $w
} elseif {[$w cget -type] eq "menubar"} {
$w postcascade none
set active [$w index active]
set isCascade [string equal [$w type $active] "cascade"]
set activeindex [$w index active]
set isCascade [string equal [$w type $activeindex] "cascade"]
# Only de-activate the active item if it's a cascade; this prevents
# the annoying "activation flicker" you otherwise get with
@@ -649,11 +654,11 @@ proc ::tk::MenuInvoke {w buttonRelease} {
# but not recommended)
if { !$isCascade } {
uplevel #0 [list $w invoke $active]
uplevel #0 [list $w invoke $activeindex]
}
} else {
set active [$w index active]
if {$Priv(popup) eq "" || $active ne "none"} {
set activeindex [$w index active]
if {($Priv(popup) eq "") || (($activeindex ne "none") && ($activeindex >= 0))} {
MenuUnpost $w
}
uplevel #0 [list $w invoke active]
@@ -797,7 +802,8 @@ proc ::tk::MenuNextMenu {menu direction} {
if {[winfo class $mb] eq "Menubutton" \
&& [$mb cget -state] ne "disabled" \
&& [$mb cget -menu] ne "" \
&& [[$mb cget -menu] index last] ne "none"} {
&& [[$mb cget -menu] index last] ne "none" \
&& [[$mb cget -menu] index last] >= 0} {
break
}
if {$mb eq $w} {
@@ -819,16 +825,17 @@ proc ::tk::MenuNextMenu {menu direction} {
# -1 means go to the next higher entry.
proc ::tk::MenuNextEntry {menu count} {
if {[$menu index last] eq "none"} {
set last [$menu index last]
if {($last eq "none") || ($last < 0)} {
return
}
set length [expr {[$menu index last]+1}]
set length [expr {$last+1}]
set quitAfter $length
set active [$menu index active]
if {$active eq "none"} {
set activeindex [$menu index active]
if {($activeindex eq "none") || ($activeindex < 0)} {
set i 0
} else {
set i [expr {$active + $count}]
set i [expr {$activeindex + $count}]
}
while {1} {
if {$quitAfter <= 0} {
@@ -850,7 +857,7 @@ proc ::tk::MenuNextEntry {menu count} {
break
}
}
if {$i == $active} {
if {$i == $activeindex} {
return
}
incr i $count
@@ -903,13 +910,12 @@ proc ::tk::MenuFind {w char} {
}
set last [$child index last]
for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
if {[$child type $i] eq "separator"} {
if {([$child type $i] eq "separator") || ([$child entrycget $i -state] eq "disabled")} {
continue
}
set char2 [string index [$child entrycget $i -label] \
[$child entrycget $i -underline]]
if {$char eq [string tolower $char2] || $char eq ""} {
if {[$child entrycget $i -state] ne "disabled"} {
set underline [$child entrycget $i -underline]
if {$underline >= 0} {
if {$char eq [string tolower [string index [$child entrycget $i -label] $underline]]} {
return $child
}
}
@@ -941,7 +947,7 @@ proc ::tk::MenuFind {w char} {
}
}
}
return ""
return {}
}
# ::tk::TraverseToMenu --
@@ -1068,7 +1074,8 @@ proc ::tk::MenuFirstEntry menu {
return
}
tk_menuSetFocus $menu
if {[$menu index active] ne "none"} {
set activeindex [$menu index active]
if {($activeindex ne "none") && ($activeindex >= 0)} {
return
}
set last [$menu index last]

View File

@@ -46,7 +46,7 @@ namespace eval ::tk {
::msgcat::mcset zh_cn "Invalid file name \"%1\$s\"." "无效的文件名 \"%1\$s\"。"
::msgcat::mcset zh_cn "Italic" "斜体"
::msgcat::mcset zh_cn "Log Files" "日志文件"
::msgcat::mcset zh_cn "&No" "&取消"
::msgcat::mcset zh_cn "&No" "&"
::msgcat::mcset zh_cn "&OK" "&确定"
::msgcat::mcset zh_cn "OK" "确定"
::msgcat::mcset zh_cn "Ok" "确定"

View File

@@ -1,7 +1,7 @@
if {![package vsatisfies [package provide Tcl] 8.6.0]} return
if {($::tcl_platform(platform) eq "unix") && ([info exists ::env(DISPLAY)]
|| ([info exists ::argv] && ("-display" in $::argv)))} {
package ifneeded Tk 8.6.13 [list load [file join $dir .. .. bin libtk8.6.dll]]
package ifneeded Tk 8.6.14 [list load [file join $dir .. .. bin libtk8.6.dll]]
} else {
package ifneeded Tk 8.6.13 [list load [file join $dir .. .. bin tk86t.dll]]
package ifneeded Tk 8.6.14 [list load [file join $dir .. .. bin tk86t.dll]]
}

View File

@@ -31,10 +31,10 @@ proc ::tk::TearOffMenu {w {x 0} {y 0}} {
# away when the toplevel goes away.
if {$x == 0} {
set x [winfo rootx $w]
set x [winfo rootx $w]
}
if {$y == 0} {
set y [winfo rooty $w]
set y [winfo rooty $w]
if {[tk windowingsystem] eq "aqua"} {
# Shift by height of tearoff entry minus height of window titlebar
catch {incr y [expr {[$w yposition 1] - 16}]}
@@ -66,14 +66,14 @@ proc ::tk::TearOffMenu {w {x 0} {y 0}} {
set parent [winfo parent $w]
if {[$menu cget -title] ne ""} {
wm title $menu [$menu cget -title]
wm title $menu [$menu cget -title]
} else {
switch -- [winfo class $parent] {
switch -- [winfo class $parent] {
Menubutton {
wm title $menu [$parent cget -text]
wm title $menu [$parent cget -text]
}
Menu {
wm title $menu [$parent entrycget active -label]
wm title $menu [$parent entrycget active -label]
}
}
}
@@ -134,51 +134,24 @@ proc ::tk::MenuDup {src dst type} {
lappend cmd [lindex $option 0] [lindex $option 4]
}
eval $cmd
# Copy the meny entries, if any
set last [$src index last]
if {$last eq "none" || $last < 0} {
return
}
for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {
set cmd [list $dst add [$src type $i]]
foreach option [$src entryconfigure $i] {
lappend cmd [lindex $option 0] [lindex $option 4]
if {$last ne "none"} {
for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {
set cmd [list $dst add [$src type $i]]
foreach option [$src entryconfigure $i] {
lappend cmd [lindex $option 0] [lindex $option 4]
}
eval $cmd
}
eval $cmd
}
# Duplicate the binding tags and bindings from the source menu.
# Duplicate the binding tags from the source menu, replacing src with dst
set tags [bindtags $src]
set srcLen [string length $src]
# Copy tags to x, replacing each substring of src with dst.
while {[set index [string first $src $tags]] >= 0} {
if {$index > 0} {
append x [string range $tags 0 $index-1]$dst
}
set tags [string range $tags $index+$srcLen end]
}
append x $tags
bindtags $dst $x
foreach event [bind $src] {
unset x
set script [bind $src $event]
set eventLen [string length $event]
# Copy script to x, replacing each substring of event with dst.
while {[set index [string first $event $script]] >= 0} {
if {$index > 0} {
append x [string range $script 0 $index-1]
}
append x $dst
set script [string range $script $index+$eventLen end]
}
append x $script
bind $dst $event $x
}
set x [lsearch -exact $tags $src]
if {$x >= 0} {lset tags $x $dst}
bindtags $dst $tags
}

View File

@@ -539,7 +539,11 @@ proc ::tk::TextClosestGap {w x y} {
if {$bbox eq ""} {
return $pos
}
if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
# The check on y coord of the line bbox with dlineinfo is to fix
# [a9cf210a42] to properly handle selecting and moving the mouse
# out of the widget.
if {$y < [lindex [$w dlineinfo $pos] 1] ||
$x - [lindex $bbox 0] < [lindex $bbox 2]/2} {
return $pos
}
$w index "$pos + 1 char"

View File

@@ -11,7 +11,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
# Verify that we have Tk binary and script components from the same release
package require -exact Tk 8.6.13
package require -exact Tk 8.6.14
# Create a ::tk namespace
namespace eval ::tk {
@@ -178,16 +178,21 @@ proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} {
catch {focus $oldFocus}
grab release $grab
if {$destroy eq "withdraw"} {
wm withdraw $grab
} else {
destroy $grab
if {[winfo exists $grab]} {
if {$destroy eq "withdraw"} {
wm withdraw $grab
} else {
destroy $grab
}
}
if {[winfo exists $oldGrab] && [winfo ismapped $oldGrab]} {
# The "grab" command will fail if another application
# already holds the grab on a window with the same name.
# So catch it. See [7447ed20ec] for an example.
if {$oldStatus eq "global"} {
grab -global $oldGrab
catch {grab -global $oldGrab}
} else {
grab $oldGrab
catch {grab $oldGrab}
}
}
}

View File

@@ -226,7 +226,9 @@ proc ::tk::dialog::file:: {type args} {
foreach trace [trace info variable data(selectPath)] {
trace remove variable data(selectPath) {*}$trace
}
$data(dirMenuBtn) configure -textvariable {}
if {[winfo exists $data(dirMenuBtn)]} {
$data(dirMenuBtn) configure -textvariable {}
}
return $Priv(selectFilePath)
}

View File

@@ -254,6 +254,10 @@ set ::ttk::entry::State(startNext) \
[string equal [tk windowingsystem] "win32"]
proc ttk::entry::NextWord {w start} {
# the check on [winfo class] is because the spinbox and combobox also use this proc
if {[winfo class $w] eq "TEntry" && [$w cget -show] ne ""} {
return end
}
variable State
set pos [tcl_endOfWord [$w get] [$w index $start]]
if {$pos >= 0 && $State(startNext)} {
@@ -268,6 +272,10 @@ proc ttk::entry::NextWord {w start} {
## PrevWord -- Find the previous word position.
#
proc ttk::entry::PrevWord {w start} {
# the check on [winfo class] is because the spinbox and combobox also use this proc
if {[winfo class $w] eq "TEntry" && [$w cget -show] ne ""} {
return 0
}
set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
if {$pos < 0} {
return 0

View File

@@ -45,9 +45,6 @@
# There does not appear to be any recommendations for fixed-width fonts.
#
# X11:
# Need a way to tell if Xft is enabled or not.
# For now, assume patch #971980 applied.
#
# "Classic" look used Helvetica bold for everything except
# for entry widgets, which use Helvetica medium.
# Most other toolkits use medium weight for all UI elements,

View File

@@ -142,8 +142,7 @@ if {[tk windowingsystem] eq "aqua"} {
incr y $bh
# if we go offscreen to the bottom, show as 'above'
if {($y + $mh) > ([winfo vrooty $mb] + [winfo vrootheight $mb])} {
set y [expr {[winfo vrooty $mb] + [winfo vrootheight $mb] \
+ [winfo rooty $mb] - $mh}]
set y [expr {[winfo vrooty $mb] + [winfo rooty $mb] - $mh}]
}
}
left {

View File

@@ -81,9 +81,11 @@ proc ttk::notebook::MnemonicTab {nb key} {
foreach tab [$nb tabs] {
set label [$nb tab $tab -text]
set underline [$nb tab $tab -underline]
set mnemonic [string toupper [string index $label $underline]]
if {$mnemonic ne "" && $mnemonic eq $key} {
return $tab
if {$underline >= 0} {
set mnemonic [string toupper [string index $label $underline]]
if {$mnemonic ne "" && $mnemonic eq $key} {
return $tab
}
}
}
return ""