summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authorculler <culler>2020-11-10 13:59:25 (GMT)
committerculler <culler>2020-11-10 13:59:25 (GMT)
commitd94200fdcf927707b43670e7751208ea902b382e (patch)
treec8f724ce055955eef67c4b799866138c5389715d /library
parenta49d6e52a72b1f086503ae32cb28b0da62e5fa99 (diff)
parent6133a711414cfb8fcc3a8b52ecf25b59a09e5800 (diff)
downloadtk-d94200fdcf927707b43670e7751208ea902b382e.zip
tk-d94200fdcf927707b43670e7751208ea902b382e.tar.gz
tk-d94200fdcf927707b43670e7751208ea902b382e.tar.bz2
Merge main
Diffstat (limited to 'library')
-rw-r--r--library/bgerror.tcl20
-rw-r--r--library/button.tcl10
-rw-r--r--library/choosedir.tcl2
-rw-r--r--library/clrpick.tcl2
-rw-r--r--library/comdlg.tcl11
-rw-r--r--library/console.tcl39
-rw-r--r--library/demos/bind.tcl12
-rw-r--r--library/demos/cscroll.tcl56
-rw-r--r--library/demos/ctext.tcl6
-rw-r--r--library/demos/dialog1.tcl14
-rw-r--r--library/demos/entry3.tcl2
-rw-r--r--library/demos/floor.tcl9
-rw-r--r--library/demos/fontchoose.tcl6
-rw-r--r--library/demos/goldberg.tcl8
-rw-r--r--library/demos/items.tcl21
-rw-r--r--library/demos/ixset2
-rw-r--r--library/demos/knightstour.tcl16
-rw-r--r--library/demos/menu.tcl2
-rw-r--r--library/demos/pendulum.tcl4
-rw-r--r--library/demos/tclIndex118
-rw-r--r--library/demos/tcolor2
-rw-r--r--library/demos/toolbar.tcl2
-rw-r--r--library/demos/ttkbut.tcl2
-rw-r--r--library/demos/ttkprogress.tcl2
-rw-r--r--library/demos/unicodeout.tcl50
-rw-r--r--library/demos/widget11
-rw-r--r--library/dialog.tcl4
-rw-r--r--library/entry.tcl63
-rw-r--r--library/focus.tcl2
-rw-r--r--library/fontchooser.tcl49
-rw-r--r--library/iconlist.tcl37
-rw-r--r--library/icons.tcl2
-rw-r--r--library/listbox.tcl96
-rw-r--r--library/megawidget.tcl4
-rw-r--r--library/menu.tcl8
-rw-r--r--library/msgbox.tcl2
-rw-r--r--library/msgs/da.msg30
-rw-r--r--library/msgs/de.msg2
-rw-r--r--library/obsolete.tcl4
-rw-r--r--library/optMenu.tcl4
-rw-r--r--library/palette.tcl2
-rw-r--r--library/safetk.tcl82
-rw-r--r--library/scale.tcl12
-rw-r--r--library/scrlbar.tcl41
-rw-r--r--library/spinbox.tcl45
-rw-r--r--library/tclIndex1
-rw-r--r--library/tearoff.tcl18
-rw-r--r--library/text.tcl129
-rw-r--r--library/tk.tcl34
-rw-r--r--library/tkfbox.tcl2
-rw-r--r--library/ttk/button.tcl2
-rw-r--r--library/ttk/combobox.tcl25
-rw-r--r--library/ttk/entry.tcl24
-rw-r--r--library/ttk/fonts.tcl2
-rw-r--r--library/ttk/menubutton.tcl4
-rw-r--r--library/ttk/notebook.tcl9
-rw-r--r--library/ttk/scrollbar.tcl21
-rw-r--r--library/ttk/spinbox.tcl53
-rw-r--r--library/ttk/ttk.tcl34
-rw-r--r--library/ttk/utils.tcl84
-rw-r--r--library/ttk/vistaTheme.tcl14
-rw-r--r--library/xmfbox.tcl4
62 files changed, 540 insertions, 838 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl
index d4d9b21..526d791 100644
--- a/library/bgerror.tcl
+++ b/library/bgerror.tcl
@@ -6,10 +6,10 @@
# trace (like save it to a log). This is adapted from work done by
# Donal K. Fellows.
#
-# Copyright (c) 1998-2000 by Ajuba Solutions.
-# Copyright (c) 2007 by ActiveState Software Inc.
-# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
-# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
+# Copyright © 1998-2000 by Ajuba Solutions.
+# Copyright © 2007 by ActiveState Software Inc.
+# Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
+# Copyright © 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
namespace eval ::tk::dialog::error {
namespace import -force ::tk::msgcat::*
@@ -41,7 +41,7 @@ proc ::tk::dialog::error::Details {} {
set w .bgerrorDialog
set caption [option get $w.function text {}]
set command [option get $w.function command {}]
- if { ($caption eq "") || ($command eq "") } {
+ if {($caption eq "") || ($command eq "")} {
grid forget $w.function
}
lappend command [$w.top.info.text get 1.0 end-1c]
@@ -50,7 +50,7 @@ proc ::tk::dialog::error::Details {} {
}
proc ::tk::dialog::error::SaveToLog {text} {
- if { $::tcl_platform(platform) eq "windows" } {
+ if {$::tcl_platform(platform) eq "windows"} {
set allFiles *.*
} else {
set allFiles *
@@ -129,11 +129,11 @@ proc ::tk::dialog::error::bgerror {err {flag 1}} {
set lines 0
set maxLine 45
foreach line [split $err \n] {
- if { [string length $line] > $maxLine } {
- append displayedErr "[string range $line 0 [expr {$maxLine-3}]]..."
+ if {[string length $line] > $maxLine} {
+ append displayedErr "[string range $line 0 $maxLine-3]..."
break
}
- if { $lines > 4 } {
+ if {$lines > 4} {
append displayedErr "..."
break
} else {
@@ -182,7 +182,7 @@ proc ::tk::dialog::error::bgerror {err {flag 1}} {
pack $W.text -side left -expand yes -fill both
$W.text insert 0.0 "$err\n$info"
$W.text mark set insert 0.0
- bind $W.text <Button-1> { focus %W }
+ bind $W.text <Button-1> {focus %W}
$W.text configure -state disabled
# 2. Fill the top part with bitmap and message
diff --git a/library/button.tcl b/library/button.tcl
index d824009..4be16b1 100644
--- a/library/button.tcl
+++ b/library/button.tcl
@@ -4,9 +4,9 @@
# checkbutton, and radiobutton widgets and provides procedures
# that help in implementing those bindings.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 2002 ActiveState Corporation.
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 2002 ActiveState Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -41,10 +41,10 @@ if {[tk windowingsystem] eq "aqua"} {
}
}
if {"win32" eq [tk windowingsystem]} {
- bind Checkbutton <equal> {
+ bind Checkbutton <=> {
tk::CheckRadioInvoke %W select
}
- bind Checkbutton <plus> {
+ bind Checkbutton <+> {
tk::CheckRadioInvoke %W select
}
bind Checkbutton <minus> {
diff --git a/library/choosedir.tcl b/library/choosedir.tcl
index 68dd9b0..ef90468 100644
--- a/library/choosedir.tcl
+++ b/library/choosedir.tcl
@@ -2,7 +2,7 @@
#
# Choose directory dialog implementation for Unix/Mac.
#
-# Copyright (c) 1998-2000 by Scriptics Corporation.
+# Copyright © 1998-2000 by Scriptics Corporation.
# All rights reserved.
# Make sure the tk::dialog namespace, in which all dialogs should live, exists
diff --git a/library/clrpick.tcl b/library/clrpick.tcl
index d67c67f..8bdb7a7 100644
--- a/library/clrpick.tcl
+++ b/library/clrpick.tcl
@@ -3,7 +3,7 @@
# Color selection dialog for platforms that do not support a
# standard color selection dialog.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright © 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/comdlg.tcl b/library/comdlg.tcl
index 18df8a6..0a7f65b 100644
--- a/library/comdlg.tcl
+++ b/library/comdlg.tcl
@@ -3,7 +3,7 @@
# Some functions needed for the common dialog boxes. Probably need to go
# in a different file.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright © 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -29,7 +29,8 @@
# {....}
# }
#
-# flags = currently unused.
+# flags = a list of flags. Currently supported flags are:
+# DONTSETDEFAULTS = skip default values setting
#
# argList = The list of "-option value" pairs.
#
@@ -63,8 +64,10 @@ proc tclParseConfigSpec {w specs flags argList} {
# 2: set the default values
#
- foreach cmdsw [array names cmd] {
- set data($cmdsw) $def($cmdsw)
+ if {"DONTSETDEFAULTS" ni $flags} {
+ foreach cmdsw [array names cmd] {
+ set data($cmdsw) $def($cmdsw)
+ }
}
# 3: parse the argument list
diff --git a/library/console.tcl b/library/console.tcl
index eb8990a..f88cfc1 100644
--- a/library/console.tcl
+++ b/library/console.tcl
@@ -4,9 +4,9 @@
# can be used by non-unix systems that do not have built-in support
# for shells.
#
-# Copyright (c) 1995-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 Ajuba Solutions.
-# Copyright (c) 2007-2008 Daniel A. Steffen <das@users.sourceforge.net>
+# Copyright © 1995-1997 Sun Microsystems, Inc.
+# Copyright © 1998-2000 Ajuba Solutions.
+# Copyright © 2007-2008 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -131,7 +131,7 @@ proc ::tk::ConsoleInit {} {
default { set preferred {} }
}
foreach {family size} $preferred {
- if {[lsearch -exact $families $family] != -1} {
+ if {$family in $families} {
font configure TkConsoleFont -family $family -size $size
break
}
@@ -215,7 +215,7 @@ proc ::tk::ConsoleSource {} {
[list [mc "Tcl Scripts"] .tcl] \
[list [mc "All Files"] *]]]
if {$filename ne ""} {
- set cmd [list source $filename]
+ set cmd [list source -encoding utf-8 $filename]
if {[catch {consoleinterp eval $cmd} result]} {
ConsoleOutput stderr "$result\n"
}
@@ -454,23 +454,16 @@ proc ::tk::ConsoleBind {w} {
<<Console_Transpose>> <Control-t>
<<Console_ClearLine>> <Control-u>
<<Console_SaveCommand>> <Control-z>
- <<Console_FontSizeIncr>> <Control-plus>
+ <<Console_FontSizeIncr>> <Control-+>
<<Console_FontSizeDecr>> <Control-minus>
+ <<Console_FontSizeIncr>> <Command-+>
+ <<Console_FontSizeDecr>> <Command-minus>
} {
event add $ev $key
bind Console $key {}
}
- if {[tk windowingsystem] eq "aqua"} {
- foreach {ev key} {
- <<Console_FontSizeIncr>> <Command-plus>
- <<Console_FontSizeDecr>> <Command-minus>
- } {
- event add $ev $key
- bind Console $key {}
- }
- if {$::tk::console::useFontchooser} {
- bind Console <Command-t> [list ::tk::console::FontchooserToggle]
- }
+ if {$::tk::console::useFontchooser} {
+ bind Console <Command-t> [list ::tk::console::FontchooserToggle]
}
bind Console <<Console_Expand>> {
if {[%W compare insert > promptEnd]} {
@@ -592,12 +585,10 @@ proc ::tk::ConsoleBind {w} {
}
bind Console <F9> {
eval destroy [winfo child .]
- source [file join $tk_library console.tcl]
+ source -encoding utf-8 [file join $tk_library console.tcl]
}
- if {[tk windowingsystem] eq "aqua"} {
- bind Console <Command-q> {
- exit
- }
+ bind Console <Command-q> {
+ exit
}
bind Console <<Cut>> { ::tk::console::Cut %W }
bind Console <<Copy>> { ::tk::console::Copy %W }
@@ -740,9 +731,9 @@ proc ::tk::console::FontchooserToggle {} {
}
proc ::tk::console::FontchooserVisibility {index} {
if {[tk fontchooser configure -visible]} {
- .menubar.edit entryconfigure $index -label [msgcat::mc "Hide Fonts"]
+ .menubar.edit entryconfigure $index -label [::tk::msgcat::mc "Hide Fonts"]
} else {
- .menubar.edit entryconfigure $index -label [msgcat::mc "Show Fonts"]
+ .menubar.edit entryconfigure $index -label [::tk::msgcat::mc "Show Fonts"]
}
}
proc ::tk::console::FontchooserFocus {w isFocusIn} {
diff --git a/library/demos/bind.tcl b/library/demos/bind.tcl
index 9146362..8b56639 100644
--- a/library/demos/bind.tcl
+++ b/library/demos/bind.tcl
@@ -67,12 +67,12 @@ foreach tag {d1 d2 d3 d4 d5 d6} {
$w.text tag bind $tag <Leave> "$w.text tag configure $tag $normal"
}
# Main widget program sets variable tk_demoDirectory
-$w.text tag bind d1 <Button-1> {source [file join $tk_demoDirectory items.tcl]}
-$w.text tag bind d2 <Button-1> {source [file join $tk_demoDirectory plot.tcl]}
-$w.text tag bind d3 <Button-1> {source [file join $tk_demoDirectory ctext.tcl]}
-$w.text tag bind d4 <Button-1> {source [file join $tk_demoDirectory arrow.tcl]}
-$w.text tag bind d5 <Button-1> {source [file join $tk_demoDirectory ruler.tcl]}
-$w.text tag bind d6 <Button-1> {source [file join $tk_demoDirectory cscroll.tcl]}
+$w.text tag bind d1 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory items.tcl]}
+$w.text tag bind d2 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory plot.tcl]}
+$w.text tag bind d3 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory ctext.tcl]}
+$w.text tag bind d4 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory arrow.tcl]}
+$w.text tag bind d5 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory ruler.tcl]}
+$w.text tag bind d6 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory cscroll.tcl]}
$w.text mark set insert 0.0
$w.text configure -state disabled
diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl
index c0c30ee..d210c7d 100644
--- a/library/demos/cscroll.tcl
+++ b/library/demos/cscroll.tcl
@@ -56,45 +56,61 @@ for {set i 0} {$i < 20} {incr i} {
$c bind all <Enter> "scrollEnter $c"
$c bind all <Leave> "scrollLeave $c"
$c bind all <Button-1> "scrollButton $c"
-bind $c <Button-2> "$c scan mark %x %y"
-bind $c <B2-Motion> "$c scan dragto %x %y"
-if {[tk windowingsystem] eq "aqua"} {
+if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk] 8.7-]} {
+ bind $c <Button-3> "$c scan mark %x %y"
+ bind $c <B3-Motion> "$c scan dragto %x %y"
bind $c <MouseWheel> {
- %W yview scroll [expr {-(%D)}] units
+ %W yview scroll [expr {-%D}] units
}
bind $c <Option-MouseWheel> {
- %W yview scroll [expr {-10 * (%D)}] units
+ %W yview scroll [expr {-10*%D}] units
}
bind $c <Shift-MouseWheel> {
- %W xview scroll [expr {-(%D)}] units
+ %W xview scroll [expr {-%D}] units
}
bind $c <Shift-Option-MouseWheel> {
- %W xview scroll [expr {-10 * (%D)}] units
+ %W xview scroll [expr {-10*%D}] units
}
} else {
+ bind $c <Button-2> "$c scan mark %x %y"
+ bind $c <B2-Motion> "$c scan dragto %x %y"
# We must make sure that positive and negative movements are rounded
# equally to integers, avoiding the problem that
- # (int)1/30 = 0,
+ # (int)1/-30 = -1,
# but
- # (int)-1/30 = -1
+ # (int)-1/-30 = 0
# The following code ensure equal +/- behaviour.
bind $c <MouseWheel> {
if {%D >= 0} {
- %W yview scroll [expr {-%D/30}] units
+ %W yview scroll [expr {%D/-30}] units
} else {
- %W yview scroll [expr {(29-%D)/30}] units
+ %W yview scroll [expr {(%D-29)/-30}] units
+ }
+ }
+ bind $c <Option-MouseWheel> {
+ if {%D >= 0} {
+ %W yview scroll [expr {%D/-3}] units
+ } else {
+ %W yview scroll [expr {(%D-2)/-3}] units
}
}
bind $c <Shift-MouseWheel> {
if {%D >= 0} {
- %W xview scroll [expr {-%D/30}] units
+ %W xview scroll [expr {%D/-30}] units
} else {
- %W xview scroll [expr {(29-%D)/30}] units
+ %W xview scroll [expr {(%D-29)/-30}] units
+ }
+ }
+ bind $c <Shift-Option-MouseWheel> {
+ if {%D >= 0} {
+ %W xview scroll [expr {%D/-3}] units
+ } else {
+ %W xview scroll [expr {(%D-2)/-3}] units
}
}
}
-if {[tk windowingsystem] eq "x11"} {
+if {[tk windowingsystem] eq "x11" && ![package vsatisfies [package provide Tk] 8.7-]} {
# Support for mousewheels on Linux/Unix commonly comes through mapping
# the wheel to the extended buttons. If you have a mousewheel, find
# Linux configuration info at:
@@ -119,18 +135,6 @@ if {[tk windowingsystem] eq "x11"} {
%W xview scroll 5 units
}
}
- if {[package vsatisfies [package provide Tk] 8.7]} {
- bind $c <Button-6> {
- if {!$tk_strictMotif} {
- %W xview scroll -5 units
- }
- }
- bind $c <Button-7> {
- if {!$tk_strictMotif} {
- %W xview scroll 5 units
- }
- }
- }
}
diff --git a/library/demos/ctext.tcl b/library/demos/ctext.tcl
index 502c9d0..d3fec33 100644
--- a/library/demos/ctext.tcl
+++ b/library/demos/ctext.tcl
@@ -50,7 +50,11 @@ $c bind text <Return> "textInsert $c \\n"
$c bind text <Control-h> "textBs $c"
$c bind text <BackSpace> "textBs $c"
$c bind text <Delete> "textDel $c"
-$c bind text <Button-2> "textPaste $c @%x,%y"
+if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} {
+ $c bind text <Button-3> "textPaste $c @%x,%y"
+} else {
+ $c bind text <Button-2> "textPaste $c @%x,%y"
+}
# Next, create some items that allow the text's anchor position
# to be edited.
diff --git a/library/demos/dialog1.tcl b/library/demos/dialog1.tcl
index 976e955..66d8c9a 100644
--- a/library/demos/dialog1.tcl
+++ b/library/demos/dialog1.tcl
@@ -2,16 +2,16 @@
#
# This demonstration script creates a dialog box with a local grab.
-interp create slave
-load {} Tk slave
-slave eval {
- wm title . slave
+interp create child
+load {} Tk child
+child eval {
+ wm title . child
wm geometry . +700+30
pack [text .t -width 30 -height 10]
}
after idle {.dialog1.msg configure -wraplength 4i}
-set i [tk_dialog .dialog1 "Dialog with local grab" {This is a modal dialog box. It uses Tk's "grab" command to create a "local grab" on the dialog box. The grab prevents any mouse or keyboard events from getting to any other windows in the application until you have answered the dialog by invoking one of the buttons below. However, you can still interact with other applications. For example, you should be able to edit text in the window named "slave" which was created by a slave interpreter.} \
+set i [tk_dialog .dialog1 "Dialog with local grab" {This is a modal dialog box. It uses Tk's "grab" command to create a "local grab" on the dialog box. The grab prevents any mouse or keyboard events from getting to any other windows in the application until you have answered the dialog by invoking one of the buttons below. However, you can still interact with other applications. For example, you should be able to edit text in the window named "child" which was created by a child interpreter.} \
info 0 OK Cancel {Show Code}]
switch $i {
@@ -20,6 +20,6 @@ switch $i {
2 {showCode .dialog1}
}
-if {[interp exists slave]} {
- interp delete slave
+if {[interp exists child]} {
+ interp delete child
}
diff --git a/library/demos/entry3.tcl b/library/demos/entry3.tcl
index d4435c6..acde1b3 100644
--- a/library/demos/entry3.tcl
+++ b/library/demos/entry3.tcl
@@ -102,7 +102,7 @@ foreach {chars digit} {abc 2 def 3 ghi 4 jkl 5 mno 6 pqrs 7 tuv 8 wxyz 9} {
proc validatePhoneChange {W vmode idx char} {
global phoneNumberMap entry3content
- if {$idx == -1} {return 1}
+ if {$idx < 0} {return 1}
after idle [list $W configure -validate $vmode -invcmd bell]
if {
!($idx<3 || $idx==6 || $idx==7 || $idx==11 || $idx>15) &&
diff --git a/library/demos/floor.tcl b/library/demos/floor.tcl
index b5d3c64..eb2ea7f 100644
--- a/library/demos/floor.tcl
+++ b/library/demos/floor.tcl
@@ -1359,8 +1359,13 @@ $c bind floor2 <Button-1> "floorDisplay $c 2"
$c bind floor3 <Button-1> "floorDisplay $c 3"
$c bind room <Enter> "newRoom $c"
$c bind room <Leave> {set currentRoom ""}
-bind $c <Button-2> "$c scan mark %x %y"
-bind $c <B2-Motion> "$c scan dragto %x %y"
+if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} {
+ bind $c <Button-3> "$c scan mark %x %y"
+ bind $c <B3-Motion> "$c scan dragto %x %y"
+} else {
+ bind $c <Button-2> "$c scan mark %x %y"
+ bind $c <B2-Motion> "$c scan dragto %x %y"
+}
bind $c <Destroy> "unset currentRoom"
set currentRoom ""
trace variable currentRoom w "roomChanged $c"
diff --git a/library/demos/fontchoose.tcl b/library/demos/fontchoose.tcl
index 8b34377..446ed34 100644
--- a/library/demos/fontchoose.tcl
+++ b/library/demos/fontchoose.tcl
@@ -55,10 +55,6 @@ grid $f.msg $f.vs -sticky news
grid $f.font - -sticky e
grid columnconfigure $f 0 -weight 1
grid rowconfigure $f 0 -weight 1
-bind $w <Visibility> {
- bind %W <Visibility> {}
- grid propagate %W.f 0
-}
## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
@@ -67,3 +63,5 @@ grid $f -sticky news
grid $btns -sticky ew
grid columnconfigure $w 0 -weight 1
grid rowconfigure $w 0 -weight 1
+update idletasks
+grid propagate $f 0
diff --git a/library/demos/goldberg.tcl b/library/demos/goldberg.tcl
index 1cc52c6..14ddb0b 100644
--- a/library/demos/goldberg.tcl
+++ b/library/demos/goldberg.tcl
@@ -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 "»" -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 "»" -command [list ShowCtrl $w] -width 2 -highlightbackground $C(bg)
}
place $w.show -in $w.c -relx 1 -rely 0 -anchor ne
update
@@ -204,10 +204,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 "»"
} else {
pack $w.ctrl -side right -fill both -ipady 5
- $w.show config -text "\u00ab"
+ $w.show config -text "»"
}
}
diff --git a/library/demos/items.tcl b/library/demos/items.tcl
index 1370560..1297046 100644
--- a/library/demos/items.tcl
+++ b/library/demos/items.tcl
@@ -17,7 +17,7 @@ wm iconname $w "Items"
positionWindow $w
set c $w.frame.c
-label $w.msg -font $font -wraplength 5i -justify left -text "This window contains a canvas widget with examples of the various kinds of items supported by canvases. The following operations are supported:\n Button-1 drag:\tmoves item under pointer.\n Button-2 drag:\trepositions view.\n Button-3 drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area."
+label $w.msg -font $font -wraplength 5i -justify left -text "This window contains a canvas widget with examples of the various kinds of items supported by canvases. The following operations are supported:\n Left-Button drag:\tmoves item under pointer.\n Middle-Button drag:\trepositions view.\n Right-Button drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area."
pack $w.msg -side top
## See Code / Dismiss buttons
@@ -173,10 +173,17 @@ $c create text 28.5c 17.4c -text Scale: -anchor s
$c bind item <Enter> "itemEnter $c"
$c bind item <Leave> "itemLeave $c"
-bind $c <Button-2> "$c scan mark %x %y"
-bind $c <B2-Motion> "$c scan dragto %x %y"
-bind $c <Button-3> "itemMark $c %x %y"
-bind $c <B3-Motion> "itemStroke $c %x %y"
+if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} {
+ bind $c <Button-2> "itemMark $c %x %y"
+ bind $c <B2-Motion> "itemStroke $c %x %y"
+ bind $c <Button-3> "$c scan mark %x %y"
+ bind $c <B3-Motion> "$c scan dragto %x %y"
+} else {
+ bind $c <Button-2> "$c scan mark %x %y"
+ bind $c <B2-Motion> "$c scan dragto %x %y"
+ bind $c <Button-3> "itemMark $c %x %y"
+ bind $c <B3-Motion> "itemStroke $c %x %y"
+}
bind $c <<NextChar>> "itemsUnderArea $c"
bind $c <Button-1> "itemStartDrag $c %x %y"
bind $c <B1-Motion> "itemDrag $c %x %y"
@@ -250,14 +257,14 @@ proc itemsUnderArea {c} {
set area [$c find withtag area]
set items ""
foreach i [$c find enclosed $areaX1 $areaY1 $areaX2 $areaY2] {
- if {[lsearch [$c gettags $i] item] != -1} {
+ if {[lsearch [$c gettags $i] item] >= 0} {
lappend items $i
}
}
puts stdout "Items enclosed by area: $items"
set items ""
foreach i [$c find overlapping $areaX1 $areaY1 $areaX2 $areaY2] {
- if {[lsearch [$c gettags $i] item] != -1} {
+ if {[lsearch [$c gettags $i] item] >= 0} {
lappend items $i
}
}
diff --git a/library/demos/ixset b/library/demos/ixset
index b2b3252..85664d9 100644
--- a/library/demos/ixset
+++ b/library/demos/ixset
@@ -54,7 +54,7 @@ proc readsettings {} {
global screencyc ; set screencyc 600
set xfd [open "|xset q" r]
- while {[gets $xfd line] > -1} {
+ while {[gets $xfd line] >= 0} {
switch -- [lindex $line 0] {
auto {
set rpt [lindex $line 1]
diff --git a/library/demos/knightstour.tcl b/library/demos/knightstour.tcl
index b5cffa8..09ceff0 100644
--- a/library/demos/knightstour.tcl
+++ b/library/demos/knightstour.tcl
@@ -1,4 +1,4 @@
-# Copyright (C) 2008 Pat Thoyts <patthoyts@users.sourceforge.net>
+# Copyright © 2008 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# Calculate a Knight's tour of a chessboard.
#
@@ -21,7 +21,7 @@
# If you let it repeat then it will choose random start positions
# for each new tour.
-package require Tk 8.5
+package require Tk
# Return a list of accessible squares from a given square
proc ValidMoves {square} {
@@ -29,7 +29,7 @@ proc ValidMoves {square} {
foreach pair {{-1 -2} {-2 -1} {-2 1} {-1 2} {1 2} {2 1} {2 -1} {1 -2}} {
set col [expr {($square % 8) + [lindex $pair 0]}]
set row [expr {($square / 8) + [lindex $pair 1]}]
- if {$row > -1 && $row < 8 && $col > -1 && $col < 8} {
+ if {$row >= 0 && $row < 8 && $col >= 0 && $col < 8} {
lappend moves [expr {$row * 8 + $col}]
}
}
@@ -41,7 +41,7 @@ proc CheckSquare {square} {
variable visited
set moves 0
foreach test [ValidMoves $square] {
- if {[lsearch -exact -integer $visited $test] == -1} {
+ if {[lsearch -exact -integer $visited $test] < 0} {
incr moves
}
}
@@ -55,7 +55,7 @@ proc Next {square} {
set minimum 9
set nextSquare -1
foreach testSquare [ValidMoves $square] {
- if {[lsearch -exact -integer $visited $testSquare] == -1} {
+ if {[lsearch -exact -integer $visited $testSquare] < 0} {
set count [CheckSquare $testSquare]
if {$count < $minimum} {
set minimum $count
@@ -190,7 +190,7 @@ proc CreateGUI {} {
ttk::button $dlg.tf.b1 -text Start -command [list Tour $dlg]
ttk::button $dlg.tf.b2 -text Exit -command [list Exit $dlg]
set square 0
- for {set row 7} {$row != -1} {incr row -1} {
+ for {set row 7} {$row >= 0} {incr row -1} {
for {set col 0} {$col < 8} {incr col} {
if {(($col & 1) ^ ($row & 1))} {
set fill tan3 ; set dfill tan4
@@ -205,10 +205,10 @@ proc CreateGUI {} {
}
if {[tk windowingsystem] ne "x11"} {
catch {eval font create KnightFont -size -24}
- $c create text 0 0 -font KnightFont -text "\u265e" \
+ $c create text 0 0 -font KnightFont -text "♞" \
-anchor nw -tags knight -fill black -activefill "#600000"
} else {
- # On X11 we cannot reliably tell if the \u265e glyph is available
+ # On X11 we cannot reliably tell if the ♞ glyph is available
# so just use a polygon
set pts {
2 25 24 25 21 19 20 8 14 0 10 0 0 13 0 16
diff --git a/library/demos/menu.tcl b/library/demos/menu.tcl
index abe70a3..a76bd54 100644
--- a/library/demos/menu.tcl
+++ b/library/demos/menu.tcl
@@ -63,7 +63,7 @@ if {[tk windowingsystem] eq "aqua"} {
}
foreach i {A B C D E F} {
$m add command -label "Print letter \"$i\"" -underline 14 \
- -accelerator Meta+$i -command "puts $i" -accelerator $modifier+$i
+ -accelerator $modifier+$i -command "puts $i"
bind $w <$modifier-[string tolower $i]> "puts $i"
}
diff --git a/library/demos/pendulum.tcl b/library/demos/pendulum.tcl
index 9833e8f..04f276b 100644
--- a/library/demos/pendulum.tcl
+++ b/library/demos/pendulum.tcl
@@ -50,8 +50,8 @@ for {set i 90} {$i>=0} {incr i -10} {
$w.k create line 0 0 1 1 -smooth true -tags graph$i -fill grey$i
}
-$w.k create text 0 0 -anchor ne -text "\u03b8" -tags label_theta
-$w.k create text 0 0 -anchor ne -text "\u03b4\u03b8" -tags label_dtheta
+$w.k create text 0 0 -anchor ne -text "θ" -tags label_theta
+$w.k create text 0 0 -anchor ne -text "δθ" -tags label_dtheta
pack $w.k -in $w.p.l2 -fill both -expand true
# Initialize some variables
diff --git a/library/demos/tclIndex b/library/demos/tclIndex
index 86a72e2..cdb2f2c 100644
--- a/library/demos/tclIndex
+++ b/library/demos/tclIndex
@@ -6,62 +6,62 @@
# element name is the name of a command and the value is
# a script that loads the command.
-set auto_index(arrowSetup) [list source [file join $dir arrow.tcl]]
-set auto_index(arrowMove1) [list source [file join $dir arrow.tcl]]
-set auto_index(arrowMove2) [list source [file join $dir arrow.tcl]]
-set auto_index(arrowMove3) [list source [file join $dir arrow.tcl]]
-set auto_index(textLoadFile) [list source [file join $dir search.tcl]]
-set auto_index(textSearch) [list source [file join $dir search.tcl]]
-set auto_index(textToggle) [list source [file join $dir search.tcl]]
-set auto_index(itemEnter) [list source [file join $dir items.tcl]]
-set auto_index(itemLeave) [list source [file join $dir items.tcl]]
-set auto_index(itemMark) [list source [file join $dir items.tcl]]
-set auto_index(itemStroke) [list source [file join $dir items.tcl]]
-set auto_index(itemsUnderArea) [list source [file join $dir items.tcl]]
-set auto_index(itemStartDrag) [list source [file join $dir items.tcl]]
-set auto_index(itemDrag) [list source [file join $dir items.tcl]]
-set auto_index(butPress) [list source [file join $dir items.tcl]]
-set auto_index(loadDir) [list source [file join $dir image2.tcl]]
-set auto_index(loadImage) [list source [file join $dir image2.tcl]]
-set auto_index(rulerMkTab) [list source [file join $dir ruler.tcl]]
-set auto_index(rulerNewTab) [list source [file join $dir ruler.tcl]]
-set auto_index(rulerSelectTab) [list source [file join $dir ruler.tcl]]
-set auto_index(rulerMoveTab) [list source [file join $dir ruler.tcl]]
-set auto_index(rulerReleaseTab) [list source [file join $dir ruler.tcl]]
-set auto_index(mkTextConfig) [list source [file join $dir ctext.tcl]]
-set auto_index(textEnter) [list source [file join $dir ctext.tcl]]
-set auto_index(textInsert) [list source [file join $dir ctext.tcl]]
-set auto_index(textPaste) [list source [file join $dir ctext.tcl]]
-set auto_index(textB1Press) [list source [file join $dir ctext.tcl]]
-set auto_index(textB1Move) [list source [file join $dir ctext.tcl]]
-set auto_index(textBs) [list source [file join $dir ctext.tcl]]
-set auto_index(textDel) [list source [file join $dir ctext.tcl]]
-set auto_index(bitmapRow) [list source [file join $dir bitmap.tcl]]
-set auto_index(scrollEnter) [list source [file join $dir cscroll.tcl]]
-set auto_index(scrollLeave) [list source [file join $dir cscroll.tcl]]
-set auto_index(scrollButton) [list source [file join $dir cscroll.tcl]]
-set auto_index(textWindOn) [list source [file join $dir twind.tcl]]
-set auto_index(textWindOff) [list source [file join $dir twind.tcl]]
-set auto_index(textWindPlot) [list source [file join $dir twind.tcl]]
-set auto_index(embPlotDown) [list source [file join $dir twind.tcl]]
-set auto_index(embPlotMove) [list source [file join $dir twind.tcl]]
-set auto_index(textWindDel) [list source [file join $dir twind.tcl]]
-set auto_index(embDefBg) [list source [file join $dir twind.tcl]]
-set auto_index(floorDisplay) [list source [file join $dir floor.tcl]]
-set auto_index(newRoom) [list source [file join $dir floor.tcl]]
-set auto_index(roomChanged) [list source [file join $dir floor.tcl]]
-set auto_index(bg1) [list source [file join $dir floor.tcl]]
-set auto_index(bg2) [list source [file join $dir floor.tcl]]
-set auto_index(bg3) [list source [file join $dir floor.tcl]]
-set auto_index(fg1) [list source [file join $dir floor.tcl]]
-set auto_index(fg2) [list source [file join $dir floor.tcl]]
-set auto_index(fg3) [list source [file join $dir floor.tcl]]
-set auto_index(setWidth) [list source [file join $dir hscale.tcl]]
-set auto_index(plotDown) [list source [file join $dir plot.tcl]]
-set auto_index(plotMove) [list source [file join $dir plot.tcl]]
-set auto_index(puzzleSwitch) [list source [file join $dir puzzle.tcl]]
-set auto_index(setHeight) [list source [file join $dir vscale.tcl]]
-set auto_index(showMessageBox) [list source [file join $dir msgbox.tcl]]
-set auto_index(setColor) [list source [file join $dir clrpick.tcl]]
-set auto_index(setColor_helper) [list source [file join $dir clrpick.tcl]]
-set auto_index(fileDialog) [list source [file join $dir filebox.tcl]]
+set auto_index(arrowSetup) [list source -encoding utf-8 [file join $dir arrow.tcl]]
+set auto_index(arrowMove1) [list source -encoding utf-8 [file join $dir arrow.tcl]]
+set auto_index(arrowMove2) [list source -encoding utf-8 [file join $dir arrow.tcl]]
+set auto_index(arrowMove3) [list source -encoding utf-8 [file join $dir arrow.tcl]]
+set auto_index(textLoadFile) [list source -encoding utf-8 [file join $dir search.tcl]]
+set auto_index(textSearch) [list source -encoding utf-8 [file join $dir search.tcl]]
+set auto_index(textToggle) [list source -encoding utf-8 [file join $dir search.tcl]]
+set auto_index(itemEnter) [list source -encoding utf-8 [file join $dir items.tcl]]
+set auto_index(itemLeave) [list source -encoding utf-8 [file join $dir items.tcl]]
+set auto_index(itemMark) [list source -encoding utf-8 [file join $dir items.tcl]]
+set auto_index(itemStroke) [list source -encoding utf-8 [file join $dir items.tcl]]
+set auto_index(itemsUnderArea) [list source -encoding utf-8 [file join $dir items.tcl]]
+set auto_index(itemStartDrag) [list source -encoding utf-8 [file join $dir items.tcl]]
+set auto_index(itemDrag) [list source -encoding utf-8 [file join $dir items.tcl]]
+set auto_index(butPress) [list source -encoding utf-8 [file join $dir items.tcl]]
+set auto_index(loadDir) [list source -encoding utf-8 [file join $dir image2.tcl]]
+set auto_index(loadImage) [list source -encoding utf-8 [file join $dir image2.tcl]]
+set auto_index(rulerMkTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
+set auto_index(rulerNewTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
+set auto_index(rulerSelectTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
+set auto_index(rulerMoveTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
+set auto_index(rulerReleaseTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
+set auto_index(mkTextConfig) [list source -encoding utf-8 [file join $dir ctext.tcl]]
+set auto_index(textEnter) [list source -encoding utf-8 [file join $dir ctext.tcl]]
+set auto_index(textInsert) [list source -encoding utf-8 [file join $dir ctext.tcl]]
+set auto_index(textPaste) [list source -encoding utf-8 [file join $dir ctext.tcl]]
+set auto_index(textB1Press) [list source -encoding utf-8 [file join $dir ctext.tcl]]
+set auto_index(textB1Move) [list source -encoding utf-8 [file join $dir ctext.tcl]]
+set auto_index(textBs) [list source -encoding utf-8 [file join $dir ctext.tcl]]
+set auto_index(textDel) [list source -encoding utf-8 [file join $dir ctext.tcl]]
+set auto_index(bitmapRow) [list source -encoding utf-8 [file join $dir bitmap.tcl]]
+set auto_index(scrollEnter) [list source -encoding utf-8 [file join $dir cscroll.tcl]]
+set auto_index(scrollLeave) [list source -encoding utf-8 [file join $dir cscroll.tcl]]
+set auto_index(scrollButton) [list source -encoding utf-8 [file join $dir cscroll.tcl]]
+set auto_index(textWindOn) [list source -encoding utf-8 [file join $dir twind.tcl]]
+set auto_index(textWindOff) [list source -encoding utf-8 [file join $dir twind.tcl]]
+set auto_index(textWindPlot) [list source -encoding utf-8 [file join $dir twind.tcl]]
+set auto_index(embPlotDown) [list source -encoding utf-8 [file join $dir twind.tcl]]
+set auto_index(embPlotMove) [list source -encoding utf-8 [file join $dir twind.tcl]]
+set auto_index(textWindDel) [list source -encoding utf-8 [file join $dir twind.tcl]]
+set auto_index(embDefBg) [list source -encoding utf-8 [file join $dir twind.tcl]]
+set auto_index(floorDisplay) [list source -encoding utf-8 [file join $dir floor.tcl]]
+set auto_index(newRoom) [list source -encoding utf-8 [file join $dir floor.tcl]]
+set auto_index(roomChanged) [list source -encoding utf-8 [file join $dir floor.tcl]]
+set auto_index(bg1) [list source -encoding utf-8 [file join $dir floor.tcl]]
+set auto_index(bg2) [list source -encoding utf-8 [file join $dir floor.tcl]]
+set auto_index(bg3) [list source -encoding utf-8 [file join $dir floor.tcl]]
+set auto_index(fg1) [list source -encoding utf-8 [file join $dir floor.tcl]]
+set auto_index(fg2) [list source -encoding utf-8 [file join $dir floor.tcl]]
+set auto_index(fg3) [list source -encoding utf-8 [file join $dir floor.tcl]]
+set auto_index(setWidth) [list source -encoding utf-8 [file join $dir hscale.tcl]]
+set auto_index(plotDown) [list source -encoding utf-8 [file join $dir plot.tcl]]
+set auto_index(plotMove) [list source -encoding utf-8 [file join $dir plot.tcl]]
+set auto_index(puzzleSwitch) [list source -encoding utf-8 [file join $dir puzzle.tcl]]
+set auto_index(setHeight) [list source -encoding utf-8 [file join $dir vscale.tcl]]
+set auto_index(showMessageBox) [list source -encoding utf-8 [file join $dir msgbox.tcl]]
+set auto_index(setColor) [list source -encoding utf-8 [file join $dir clrpick.tcl]]
+set auto_index(setColor_helper) [list source -encoding utf-8 [file join $dir clrpick.tcl]]
+set auto_index(fileDialog) [list source -encoding utf-8 [file join $dir filebox.tcl]]
diff --git a/library/demos/tcolor b/library/demos/tcolor
index 64e1a53..0aa133b 100644
--- a/library/demos/tcolor
+++ b/library/demos/tcolor
@@ -7,7 +7,7 @@ exec wish "$0" ${1+"$@"}
# create colors using either the RGB, HSB, or CYM color spaces
# and apply the color to existing applications.
-package require Tk 8.4
+package require Tk
wm title . "Color Editor"
# Global variables that control the program:
diff --git a/library/demos/toolbar.tcl b/library/demos/toolbar.tcl
index cb2a495..a53e390 100644
--- a/library/demos/toolbar.tcl
+++ b/library/demos/toolbar.tcl
@@ -17,7 +17,7 @@ positionWindow $w
ttk::label $w.msg -wraplength 4i -text "This is a demonstration of how to do\
a toolbar that is styled correctly and which can be torn off. The\
- buttons are configured to be \u201Ctoolbar style\u201D buttons by\
+ buttons are configured to be “toolbar style” buttons by\
telling them that they are to use the Toolbutton style. At the left\
end of the toolbar is a simple marker that the cursor changes to a\
movement icon over; drag that away from the toolbar to tear off the\
diff --git a/library/demos/ttkbut.tcl b/library/demos/ttkbut.tcl
index ab49cf4..f6d94ac 100644
--- a/library/demos/ttkbut.tcl
+++ b/library/demos/ttkbut.tcl
@@ -17,7 +17,7 @@ wm title $w "Simple Ttk Widgets"
wm iconname $w "ttkbut"
positionWindow $w
-ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set. This is a Ttk themed label, and below are three groups of Ttk widgets in Ttk labelframes. The first group are all buttons that set the current application theme when pressed. The second group contains three sets of checkbuttons, with a separator widget between the sets. Note that the \u201cEnabled\u201d button controls whether all the other themed widgets in this toplevel are in the disabled state. The third group has a collection of linked radiobuttons."
+ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set. This is a Ttk themed label, and below are three groups of Ttk widgets in Ttk labelframes. The first group are all buttons that set the current application theme when pressed. The second group contains three sets of checkbuttons, with a separator widget between the sets. Note that the “Enabled” button controls whether all the other themed widgets in this toplevel are in the disabled state. The third group has a collection of linked radiobuttons."
pack $w.msg -side top -fill x
## See Code / Dismiss
diff --git a/library/demos/ttkprogress.tcl b/library/demos/ttkprogress.tcl
index 8a72cf9..29ac508 100644
--- a/library/demos/ttkprogress.tcl
+++ b/library/demos/ttkprogress.tcl
@@ -15,7 +15,7 @@ wm title $w "Progress Bar Demonstration"
wm iconname $w "ttkprogress"
positionWindow $w
-ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Below are two progress bars. The top one is a \u201Cdeterminate\u201D progress bar, which is used for showing how far through a defined task the program has got. The bottom one is an \u201Cindeterminate\u201D progress bar, which is used to show that the program is busy but does not know how long for. Both are run here in self-animated mode, which can be turned on and off using the buttons underneath."
+ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Below are two progress bars. The top one is a “determinate” progress bar, which is used for showing how far through a defined task the program has got. The bottom one is an “indeterminate” progress bar, which is used to show that the program is busy but does not know how long for. Both are run here in self-animated mode, which can be turned on and off using the buttons underneath."
pack $w.msg -side top -fill x
## See Code / Dismiss buttons
diff --git a/library/demos/unicodeout.tcl b/library/demos/unicodeout.tcl
index ca325a4..1ecc064 100644
--- a/library/demos/unicodeout.tcl
+++ b/library/demos/unicodeout.tcl
@@ -21,9 +21,7 @@ label $w.msg -font $font -wraplength 4i -anchor w -justify left \
non-Western character sets. However, what you will actually see\
below depends largely on what character sets you have installed,\
and what you see for characters that are not present varies greatly\
- between platforms as well. The strings are written in Tcl using\
- UNICODE characters using the \\uXXXX (or \\UXXXXXX) escape so as to\
- do so in a portable fashion."
+ between platforms as well."
pack $w.msg -side top
## See Code / Dismiss buttons
@@ -98,47 +96,29 @@ update
## Add the samples...
if {[usePresentationFormsFor Arabic]} {
# Using presentation forms (pre-layouted)
- addSample $w Arabic \
- "\uFE94\uFEF4\uFE91\uFEAE\uFECC\uFEDF\uFE8D " \
- "\uFE94\uFEE4\uFEE0\uFEDC\uFEDF\uFE8D"
+ addSample $w Arabic "ﺔﻴﺑﺮﻌﻟﺍ ﺔﻤﻠﻜﻟﺍ"
} else {
# Using standard text characters
- addSample $w Arabic \
- "\u0627\u0644\u0643\u0644\u0645\u0629 " \
- "\u0627\u0644\u0639\u0631\u0628\u064A\u0629"
+ addSample $w Arabic "الكلمة العربية"
}
-addSample $w "Trad. Chinese" "\u4E2D\u570B\u7684\u6F22\u5B57"
-addSample $w "Simpl. Chinese" "\u6C49\u8BED"
-addSample $w French "Langue fran\xE7aise"
-addSample $w Greek \
- "\u0395\u03BB\u03BB\u03B7\u03BD\u03B9\u03BA\u03AE " \
- "\u03B3\u03BB\u03CE\u03C3\u03C3\u03B1"
+addSample $w "Trad. Chinese" "中國的漢字"
+addSample $w "Simpl. Chinese" "汉语"
+addSample $w French "Langue française"
+addSample $w Greek "Ελληνική γλώσσα"
if {[usePresentationFormsFor Hebrew]} {
# Visual order (pre-layouted)
- addSample $w Hebrew \
- "\u05EA\u05D9\u05E8\u05D1\u05E2 \u05D1\u05EA\u05DB"
+ addSample $w Hebrew "תירבע בתכ"
} else {
# Standard logical order
- addSample $w Hebrew \
- "\u05DB\u05EA\u05D1 \u05E2\u05D1\u05E8\u05D9\u05EA"
+ addSample $w Hebrew "כתב עברית"
}
-addSample $w Hindi \
- "\u0939\u093F\u0928\u094D\u0926\u0940 \u092D\u093E\u0937\u093E"
-addSample $w Icelandic "\xCDslenska"
-addSample $w Japanese \
- "\u65E5\u672C\u8A9E\u306E\u3072\u3089\u304C\u306A, " \
- "\u6F22\u5B57\u3068\u30AB\u30BF\u30AB\u30CA"
-addSample $w Korean "\uB300\uD55C\uBBFC\uAD6D\uC758 \uD55C\uAE00"
-addSample $w Russian \
- "\u0420\u0443\u0441\u0441\u043A\u0438\u0439 \u044F\u0437\u044B\u043A"
+addSample $w Hindi "हिन्दी भाषा"
+addSample $w Icelandic "Íslenska"
+addSample $w Japanese "日本語のひらがな, 漢字とカタカナ"
+addSample $w Korean "대한민국의 한글"
+addSample $w Russian "Русский язык"
if {([tk windowingsystem] ne "x11") || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))} {
- if {[package vsatisfies [package provide Tcl] 8.7-]} {
- addSample $w Emoji \
- "\U1F600\U1F4A9\U1F44D\U1F1F3\U1F1F1"
- } else {
- addSample $w Emoji \
- "\uD83D\uDE00\uD83D\uDCA9\uD83D\uDC4D\uD83C\uDDF3\uD83C\uDDF1"
- }
+ addSample $w Emoji "😀💩👍🇳🇱"
}
## We're done processing, so change things back to normal running...
diff --git a/library/demos/widget b/library/demos/widget
index e543846..4f7f715 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -516,7 +516,7 @@ proc invoke index {
.t configure -cursor [::ttk::cursor busy]
update
set demo [string range [lindex $tags $i] 5 end]
- uplevel 1 [list source [file join $tk_demoDirectory $demo.tcl]]
+ uplevel 1 [list source -encoding utf-8 [file join $tk_demoDirectory $demo.tcl]]
update
.t configure -cursor $cursor
@@ -624,6 +624,7 @@ proc showCode w {
wm title $top [mc "Demo code: %s" [file join $tk_demoDirectory $file]]
wm iconname $top $file
set id [open [file join $tk_demoDirectory $file]]
+ fconfigure $id -encoding utf-8 -eofchar \032
$top.f.text delete 1.0 end
$top.f.text insert 1.0 [read $id]
$top.f.text mark set insert 1.0
@@ -722,10 +723,10 @@ proc PrintTextWin32 {filename} {
proc tkAboutDialog {} {
tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \
-message [mc "Tk widget demonstration application"] -detail \
-"[mc "Copyright \u00a9 %s" {1996-1997 Sun Microsystems, Inc.}]
-[mc "Copyright \u00a9 %s" {1997-2000 Ajuba Solutions, Inc.}]
-[mc "Copyright \u00a9 %s" {2001-2009 Donal K. Fellows}]
-[mc "Copyright \u00a9 %s" {2002-2007 Daniel A. Steffen}]"
+"[mc "Copyright © %s" {1996-1997 Sun Microsystems, Inc.}]
+[mc "Copyright © %s" {1997-2000 Ajuba Solutions, Inc.}]
+[mc "Copyright © %s" {2001-2009 Donal K. Fellows}]
+[mc "Copyright © %s" {2002-2007 Daniel A. Steffen}]"
}
# Local Variables:
diff --git a/library/dialog.tcl b/library/dialog.tcl
index a099d90..ffbd8e4 100644
--- a/library/dialog.tcl
+++ b/library/dialog.tcl
@@ -3,8 +3,8 @@
# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
#
-# Copyright (c) 1992-1993 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1992-1993 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/entry.tcl b/library/entry.tcl
index 7a5ef2b..3652ebe 100644
--- a/library/entry.tcl
+++ b/library/entry.tcl
@@ -3,8 +3,8 @@
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -58,7 +58,7 @@ bind Entry <<Paste>> {
}
bind Entry <<Clear>> {
# ignore if there is no selection
- catch { %W delete sel.first sel.last }
+ catch {%W delete sel.first sel.last}
}
bind Entry <<PasteSelection>> {
if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
@@ -209,9 +209,7 @@ bind Entry <KP_Enter> {# nothing}
bind Entry <Tab> {# nothing}
bind Entry <Prior> {# nothing}
bind Entry <Next> {# nothing}
-if {[tk windowingsystem] eq "aqua"} {
- bind Entry <Command-Key> {# nothing}
-}
+bind Entry <Command-Key> {# nothing}
# Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
bind Entry <<NextLine>> {# nothing}
bind Entry <<PrevLine>> {# nothing}
@@ -278,7 +276,7 @@ bind Entry <<TkStartIMEMarkedText>> {
dict set ::tk::Priv(IMETextMark) "%W" [%W index insert]
}
bind Entry <<TkEndIMEMarkedText>> {
- if { [catch {dict get $::tk::Priv(IMETextMark) "%W"} mark] } {
+ if {[catch {dict get $::tk::Priv(IMETextMark) "%W"} mark]} {
bell
} else {
%W selection range $mark insert
@@ -293,28 +291,15 @@ bind Entry <<TkAccentBackspace>> {
# A few additional bindings of my own.
-if {[tk windowingsystem] ne "aqua"} {
- bind Entry <Button-2> {
- if {!$tk_strictMotif} {
- ::tk::EntryScanMark %W %x
- }
- }
- bind Entry <B2-Motion> {
- if {!$tk_strictMotif} {
- ::tk::EntryScanDrag %W %x
- }
- }
-} else {
- bind Entry <Button-3> {
- if {!$tk_strictMotif} {
+bind Entry <Button-2> {
+ if {!$tk_strictMotif} {
::tk::EntryScanMark %W %x
- }
}
- bind Entry <B3-Motion> {
- if {!$tk_strictMotif} {
+}
+bind Entry <B2-Motion> {
+ if {!$tk_strictMotif} {
::tk::EntryScanDrag %W %x
- }
- }
+ }
}
# ::tk::EntryClosestGap --
@@ -391,10 +376,10 @@ proc ::tk::EntryMouseSelect {w x} {
word {
if {$cur < $anchor} {
set before [tcl_wordBreakBefore [$w get] $cur]
- set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
+ set after [tcl_wordBreakAfter [$w get] $anchor-1]
} elseif {$cur > $anchor} {
set before [tcl_wordBreakBefore [$w get] $anchor]
- set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
+ set after [tcl_wordBreakAfter [$w get] $cur-1]
} else {
if {[$w index @$Priv(pressX)] < $anchor} {
incr anchor -1
@@ -520,7 +505,8 @@ proc ::tk::EntryBackspace w {
} else {
set x [expr {[$w index insert] - 1}]
if {$x >= 0} {
- $w delete [::tk::startOfGlyphCluster [$w get] $x] [::tk::endOfGlyphCluster [$w get] $x]
+ $w delete [::tk::startOfGlyphCluster [$w get] $x] \
+ [::tk::endOfGlyphCluster [$w get] $x]
}
if {[$w index @0] >= [$w index insert]} {
set range [$w xview]
@@ -575,12 +561,12 @@ proc ::tk::EntryTranspose w {
if {$i < [$w index end]} {
incr i
}
- set first [expr {$i-2}]
- if {$first < 0} {
+ if {$i < 2} {
return
}
+ set first [expr {$i-2}]
set data [$w get]
- set new [string index $data [expr {$i-1}]][string index $data $first]
+ set new [string index $data $i-1][string index $data $first]
$w delete $first $i
$w insert insert $new
EntrySeeInsert $w
@@ -685,7 +671,7 @@ proc ::tk::EntryScanMark {w x} {
proc ::tk::EntryScanDrag {w x} {
# Make sure these exist, as some weird situations can trigger the
# motion binding without the initial press. [Bug #220269]
- if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }
+ if {![info exists ::tk::Priv(x)]} {set ::tk::Priv(x) $x}
# allow for a delta
if {abs($x-$::tk::Priv(x)) > 2} {
set ::tk::Priv(mouseMoved) 1
@@ -702,19 +688,10 @@ proc ::tk::EntryScanDrag {w x} {
proc ::tk::EntryGetSelection {w} {
set entryString [string range [$w get] [$w index sel.first] \
- [expr {[$w index sel.last] - 1}]]
+ [$w index sel.last]-1]
if {[$w cget -show] ne ""} {
return [string repeat [string index [$w cget -show] 0] \
[string length $entryString]]
}
return $entryString
}
-
-
-
-
-
-
-
-
-
diff --git a/library/focus.tcl b/library/focus.tcl
index 640406e..2cf5ad7 100644
--- a/library/focus.tcl
+++ b/library/focus.tcl
@@ -3,7 +3,7 @@
# This file defines several procedures for managing the input
# focus.
#
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl
index 5395acb..9d49c57 100644
--- a/library/fontchooser.tcl
+++ b/library/fontchooser.tcl
@@ -14,11 +14,11 @@ namespace eval ::tk::fontchooser {
set S(W) .__tk__fontchooser
set S(fonts) [lsort -dictionary [font families]]
set S(styles) [list \
- [::msgcat::mc "Regular"] \
- [::msgcat::mc "Italic"] \
- [::msgcat::mc "Bold"] \
- [::msgcat::mc "Bold Italic"] \
- ]
+ [::msgcat::mc "Regular"] \
+ [::msgcat::mc "Italic"] \
+ [::msgcat::mc "Bold"] \
+ [::msgcat::mc "Bold Italic"] \
+ ]
set S(sizes) {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72}
set S(strike) 0
@@ -36,9 +36,9 @@ proc ::tk::fontchooser::Setup {} {
# Canonical versions of font families, styles, etc. for easier searching
set S(fonts,lcase) {}
- foreach font $S(fonts) { lappend S(fonts,lcase) [string tolower $font]}
+ foreach font $S(fonts) {lappend S(fonts,lcase) [string tolower $font]}
set S(styles,lcase) {}
- foreach style $S(styles) { lappend S(styles,lcase) [string tolower $style]}
+ foreach style $S(styles) {lappend S(styles,lcase) [string tolower $style]}
set S(sizes,lcase) $S(sizes)
::ttk::style layout FontchooserFrame {
@@ -111,7 +111,7 @@ proc ::tk::fontchooser::Configure {args} {
set cache [dict create -parent $S(-parent) -title $S(-title) \
-font $S(-font) -command $S(-command)]
- set r [tclParseConfigSpec [namespace which -variable S] $specs "" $args]
+ set r [tclParseConfigSpec [namespace which -variable S] $specs DONTSETDEFAULTS $args]
if {![winfo exists $S(-parent)]} {
set code [list TK LOOKUP WINDOW $S(-parent)]
set err "bad window path name \"$S(-parent)\""
@@ -121,7 +121,7 @@ proc ::tk::fontchooser::Configure {args} {
if {[string trim $S(-title)] eq ""} {
set S(-title) [::msgcat::mc "Font"]
}
- if {[winfo exists $S(W)] && [lsearch $args -font] != -1} {
+ if {[winfo exists $S(W)] && ("-font" in $args)} {
Init $S(-font)
event generate $S(-parent) <<TkFontchooserFontChanged>>
}
@@ -145,10 +145,13 @@ proc ::tk::fontchooser::Create {} {
wm title $S(W) $S(-title)
wm transient $S(W) [winfo toplevel $S(-parent)]
+ set scaling [tk scaling]
+ set sizeWidth [expr {int([string length [::msgcat::mc "&Size:"]] * $scaling)}]
+
set outer [::ttk::frame $S(W).outer -padding {10 10}]
::tk::AmpWidget ::ttk::label $S(W).font -text [::msgcat::mc "&Font:"]
::tk::AmpWidget ::ttk::label $S(W).style -text [::msgcat::mc "Font st&yle:"]
- ::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"]
+ ::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"] -width $sizeWidth
ttk::entry $S(W).efont -width 18 \
-textvariable [namespace which -variable S](font)
ttk::entry $S(W).estyle -width 10 \
@@ -199,7 +202,7 @@ proc ::tk::fontchooser::Create {} {
set minsize(sizes) \
[expr {[font measure TkDefaultFont "-99"] + $scroll_width}]
set min [expr {$minsize(gap) * 4}]
- foreach {what width} [array get minsize] { incr min $width }
+ foreach {what width} [array get minsize] {incr min $width}
wm minsize $S(W) $min 260
bind $S(W) <Return> [namespace code [list Done 1]]
@@ -277,7 +280,7 @@ proc ::tk::fontchooser::Create {} {
# Arguments:
# ok true if user pressed OK
#
-proc ::tk::::fontchooser::Done {ok} {
+proc ::tk::fontchooser::Done {ok} {
variable S
if {! $ok} {
@@ -327,13 +330,13 @@ proc ::tk::fontchooser::Init {{defaultFont ""}} {
set S(size) $F(-size)
set S(strike) $F(-overstrike)
set S(under) $F(-underline)
- set S(style) "Regular"
+ set S(style) [::msgcat::mc "Regular"]
if {$F(-weight) eq "bold" && $F(-slant) eq "italic"} {
- set S(style) "Bold Italic"
+ set S(style) [::msgcat::mc "Bold Italic"]
} elseif {$F(-weight) eq "bold"} {
- set S(style) "Bold"
+ set S(style) [::msgcat::mc "Bold"]
} elseif {$F(-slant) eq "italic"} {
- set S(style) "Italic"
+ set S(style) [::msgcat::mc "Italic"]
}
set S(first) 0
@@ -381,7 +384,7 @@ proc ::tk::fontchooser::Tracer {var1 var2 op} {
$S(W).l${var}s selection clear 0 end
set n [lsearch -exact $S(${var}s,lcase) $value]
$S(W).l${var}s selection set $n
- if {$n != -1} {
+ if {$n >= 0} {
set S($var) [lindex $S(${var}s) $n]
$S(W).e$var icursor end
$S(W).e$var selection clear
@@ -396,7 +399,7 @@ proc ::tk::fontchooser::Tracer {var1 var2 op} {
}
$S(W).l${var}s see $n
}
- if {!$bad} { Update }
+ if {!$bad} {Update}
$S(W).ok configure -state $nstate
}
@@ -408,11 +411,11 @@ proc ::tk::fontchooser::Update {} {
variable S
set S(result) [list $S(font) $S(size)]
- if {$S(style) eq "Bold"} { lappend S(result) bold }
- if {$S(style) eq "Italic"} { lappend S(result) italic }
- if {$S(style) eq "Bold Italic"} { lappend S(result) bold italic}
- if {$S(strike)} { lappend S(result) overstrike}
- if {$S(under)} { lappend S(result) underline}
+ if {$S(style) eq [::msgcat::mc "Bold"]} {lappend S(result) bold}
+ if {$S(style) eq [::msgcat::mc "Italic"]} {lappend S(result) italic}
+ if {$S(style) eq [::msgcat::mc "Bold Italic"]} {lappend S(result) bold italic}
+ if {$S(strike)} {lappend S(result) overstrike}
+ if {$S(under)} {lappend S(result) underline}
$S(sample) configure -font $S(result)
}
diff --git a/library/iconlist.tcl b/library/iconlist.tcl
index 35b40b6..0dddebc 100644
--- a/library/iconlist.tcl
+++ b/library/iconlist.tcl
@@ -3,8 +3,8 @@
# Implements the icon-list megawidget used in the "Tk" standard file
# selection dialog boxes.
#
-# Copyright (c) 1994-1998 Sun Microsystems, Inc.
-# Copyright (c) 2009 Donal K. Fellows
+# Copyright © 1994-1998 Sun Microsystems, Inc.
+# Copyright © 2009 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -26,7 +26,7 @@
# <path> selection includes <item>
# <path> selection set <first> ?<last>?
-package require Tk 8.6
+package require Tk
::tk::Megawidget create ::tk::IconList ::tk::FocusableWidget {
variable w canvas sbar accel accelCB fill font index \
@@ -446,18 +446,9 @@ package require Tk 8.6
bind $canvas <Control-B1-Motion> {;}
bind $canvas <Shift-B1-Motion> [namespace code {my ShiftMotion1 %x %y}]
- if {[tk windowingsystem] eq "aqua"} {
- bind $canvas <Shift-MouseWheel> [namespace code {my MouseWheel [expr {40 * (%D)}]}]
- bind $canvas <Option-Shift-MouseWheel> [namespace code {my MouseWheel [expr {400 * (%D)}]}]
- } else {
- bind $canvas <Shift-MouseWheel> [namespace code {my MouseWheel %D}]
- }
- if {[tk windowingsystem] eq "x11"} {
- bind $canvas <Shift-Button-4> [namespace code {my MouseWheel 120}]
- bind $canvas <Shift-Button-5> [namespace code {my MouseWheel -120}]
- bind $canvas <Button-6> [namespace code {my MouseWheel 120}]
- bind $canvas <Button-7> [namespace code {my MouseWheel -120}]
- }
+ bind $canvas <Shift-MouseWheel> [namespace code {my MouseWheel %D}]
+ bind $canvas <Option-Shift-MouseWheel> [namespace code {my MouseWheel %D -12}]
+
bind $canvas <<PrevLine>> [namespace code {my UpDown -1}]
bind $canvas <<NextLine>> [namespace code {my UpDown 1}]
@@ -505,21 +496,11 @@ package require Tk 8.6
# ----------------------------------------------------------------------
# Event handlers
- method MouseWheel {amount} {
+ method MouseWheel {amount {factor -120.0}} {
if {$noScroll || $::tk_strictMotif} {
return
}
- # We must make sure that positive and negative movements are rounded
- # equally to integers, avoiding the problem that
- # (int)1/120 = 0,
- # but
- # (int)-1/120 = -1
- # The following code ensure equal +/- behaviour.
- if {$amount > 0} {
- $canvas xview scroll [expr {(-119-$amount) / 120}] units
- } else {
- $canvas xview scroll [expr {-($amount / 120)}] units
- }
+ $canvas xview scroll [expr {$amount/$factor}] units
}
method Btn1 {x y} {
focus $canvas
@@ -705,7 +686,7 @@ package require Tk 8.6
}
}
- if {$theIndex > -1} {
+ if {$theIndex >= 0} {
$w selection clear 0 end
$w selection set $theIndex
$w selection anchor $theIndex
diff --git a/library/icons.tcl b/library/icons.tcl
index e53a1bd..d98e461 100644
--- a/library/icons.tcl
+++ b/library/icons.tcl
@@ -8,7 +8,7 @@
#
# See http://tango.freedesktop.org/Tango_Desktop_Project
#
-# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
+# Copyright © 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
namespace eval ::tk::icons {}
diff --git a/library/listbox.tcl b/library/listbox.tcl
index b653199..9038890 100644
--- a/library/listbox.tcl
+++ b/library/listbox.tcl
@@ -3,9 +3,9 @@
# This file defines the default bindings for Tk listbox widgets
# and provides procedures that help in implementing those bindings.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
-# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1998 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -176,81 +176,17 @@ bind Listbox <B2-Motion> {
%W scan dragto %x %y
}
-# The MouseWheel will typically only fire on Windows and Mac OS X.
-# However, someone could use the "event generate" command to produce
-# one on other platforms.
-
-if {[tk windowingsystem] eq "aqua"} {
- bind Listbox <MouseWheel> {
- %W yview scroll [expr {-(%D)}] units
- }
- bind Listbox <Option-MouseWheel> {
- %W yview scroll [expr {-10 * (%D)}] units
- }
- bind Listbox <Shift-MouseWheel> {
- %W xview scroll [expr {-(%D)}] units
- }
- bind Listbox <Shift-Option-MouseWheel> {
- %W xview scroll [expr {-10 * (%D)}] units
- }
-} else {
- # We must make sure that positive and negative movements are rounded
- # equally to integers, avoiding the problem that
- # (int)1/30 = 0,
- # but
- # (int)-1/30 = -1
- # The following code ensure equal +/- behaviour.
- bind Listbox <MouseWheel> {
- if {%D >= 0} {
- %W yview scroll [expr {-%D/30}] units
- } else {
- %W yview scroll [expr {(29-%D)/30}] units
- }
- }
- bind Listbox <Shift-MouseWheel> {
- if {%D >= 0} {
- %W xview scroll [expr {-%D/30}] units
- } else {
- %W xview scroll [expr {(29-%D)/30}] units
- }
- }
+bind Listbox <MouseWheel> {
+ tk::MouseWheel %W y %D -30.0
}
-
-if {[tk windowingsystem] eq "x11"} {
- # Support for mousewheels on Linux/Unix commonly comes through mapping
- # the wheel to the extended buttons. If you have a mousewheel, find
- # Linux configuration info at:
- # http://linuxreviews.org/howtos/xfree/mouse/
- bind Listbox <Button-4> {
- if {!$tk_strictMotif} {
- %W yview scroll -5 units
- }
- }
- bind Listbox <Shift-Button-4> {
- if {!$tk_strictMotif} {
- %W xview scroll -5 units
- }
- }
- bind Listbox <Button-5> {
- if {!$tk_strictMotif} {
- %W yview scroll 5 units
- }
- }
- bind Listbox <Shift-Button-5> {
- if {!$tk_strictMotif} {
- %W xview scroll 5 units
- }
- }
- bind Listbox <Button-6> {
- if {!$tk_strictMotif} {
- %W xview scroll -5 units
- }
- }
- bind Listbox <Button-7> {
- if {!$tk_strictMotif} {
- %W xview scroll 5 units
- }
- }
+bind Listbox <Option-MouseWheel> {
+ tk::MouseWheel %W y %D -3.0
+}
+bind Listbox <Shift-MouseWheel> {
+ tk::MouseWheel %W x %D -30.0
+}
+bind Listbox <Shift-Option-MouseWheel> {
+ tk::MouseWheel %W x %D -3.0
}
# ::tk::ListboxBeginSelect --
@@ -327,13 +263,13 @@ proc ::tk::ListboxMotion {w el} {
set Priv(listboxSelection) [$w curselection]
}
while {($i < $el) && ($i < $anchor)} {
- if {[lsearch $Priv(listboxSelection) $i] >= 0} {
+ if {$i in $Priv(listboxSelection)} {
$w selection set $i
}
incr i
}
while {($i > $el) && ($i > $anchor)} {
- if {[lsearch $Priv(listboxSelection) $i] >= 0} {
+ if {$i in $Priv(listboxSelection)} {
$w selection set $i
}
incr i -1
@@ -533,7 +469,7 @@ proc ::tk::ListboxCancel w {
}
$w selection clear $first $last
while {$first <= $last} {
- if {[lsearch $Priv(listboxSelection) $first] >= 0} {
+ if {$first in $Priv(listboxSelection)} {
$w selection set $first
}
incr first
diff --git a/library/megawidget.tcl b/library/megawidget.tcl
index aeb1263..c09d0da 100644
--- a/library/megawidget.tcl
+++ b/library/megawidget.tcl
@@ -4,13 +4,13 @@
# the ::tk::IconList megawdget, which is itself only designed for use in
# the Unix file dialogs.
#
-# Copyright (c) 2009-2010 Donal K. Fellows
+# Copyright © 2009-2010 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-package require Tk 8.6
+package require Tk
::oo::class create ::tk::Megawidget {
superclass ::oo::class
diff --git a/library/menu.tcl b/library/menu.tcl
index f1207dc..6728131 100644
--- a/library/menu.tcl
+++ b/library/menu.tcl
@@ -4,10 +4,10 @@
# It also implements keyboard traversal of menus and implements a few
# other utility procedures related to menus.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
+# Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index 646c143..b401ad1 100644
--- a/library/msgbox.tcl
+++ b/library/msgbox.tcl
@@ -3,7 +3,7 @@
# Implements messageboxes for platforms that do not have native
# messagebox support.
#
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/msgs/da.msg b/library/msgs/da.msg
index c302c79..282f919 100644
--- a/library/msgs/da.msg
+++ b/library/msgs/da.msg
@@ -3,11 +3,11 @@ namespace eval ::tk {
::msgcat::mcset da "&About..." "&Om..."
::msgcat::mcset da "All Files" "Alle filer"
::msgcat::mcset da "Application Error" "Programfejl"
- ::msgcat::mcset da "&Blue" "&Bl\u00E5"
+ ::msgcat::mcset da "&Blue" "&Blå"
::msgcat::mcset da "Cancel" "Annuller"
::msgcat::mcset da "&Cancel" "&Annuller"
::msgcat::mcset da "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kan ikke skifte til katalog \"%1\$s\".\nIngen rettigheder."
- ::msgcat::mcset da "Choose Directory" "V\u00E6lg katalog"
+ ::msgcat::mcset da "Choose Directory" "Vælg katalog"
::msgcat::mcset da "Cl&ear" "&Ryd"
::msgcat::mcset da "&Clear Console" "&Ryd konsolen"
::msgcat::mcset da "Color" "Farve"
@@ -31,8 +31,8 @@ namespace eval ::tk {
::msgcat::mcset da "Fi&les:" "Fi&ler:"
::msgcat::mcset da "&Filter"
::msgcat::mcset da "Fil&ter:"
- ::msgcat::mcset da "&Green" "&Gr\u00F8n"
- ::msgcat::mcset da "&Help" "&Hj\u00E6lp"
+ ::msgcat::mcset da "&Green" "&Grøn"
+ ::msgcat::mcset da "&Help" "&Hjælp"
::msgcat::mcset da "Hi" "Hej"
::msgcat::mcset da "&Hide Console" "Skjul &konsol"
::msgcat::mcset da "&Ignore" "&Ignorer"
@@ -42,37 +42,37 @@ namespace eval ::tk {
::msgcat::mcset da "&OK" "&O.K."
::msgcat::mcset da "OK" "O.K."
::msgcat::mcset da "Ok"
- ::msgcat::mcset da "Open" "\u00C5bn"
- ::msgcat::mcset da "&Open" "&\u00C5bn"
- ::msgcat::mcset da "Open Multiple Files" "\u00C5bn flere filer"
- ::msgcat::mcset da "P&aste" "&Inds\u00E6t"
+ ::msgcat::mcset da "Open" "Åbn"
+ ::msgcat::mcset da "&Open" "&Åbn"
+ ::msgcat::mcset da "Open Multiple Files" "Åbn flere filer"
+ ::msgcat::mcset da "P&aste" "&Indsæt"
::msgcat::mcset da "&Quit" "&Afslut"
- ::msgcat::mcset da "&Red" "&R\u00F8d"
+ ::msgcat::mcset da "&Red" "&Rød"
::msgcat::mcset da "Replace existing file?" "Erstat eksisterende fil?"
::msgcat::mcset da "&Retry" "&Gentag"
::msgcat::mcset da "&Save" "&Gem"
::msgcat::mcset da "Save As" "Gem som"
::msgcat::mcset da "Save To Log" "Gem i log"
- ::msgcat::mcset da "Select Log File" "V\u00E6lg logfil"
- ::msgcat::mcset da "Select a file to source" "V\u00E6lg k\u00F8rbar fil"
+ ::msgcat::mcset da "Select Log File" "Vælg logfil"
+ ::msgcat::mcset da "Select a file to source" "Vælg kørbar fil"
::msgcat::mcset da "&Selection:" "&Udvalg:"
::msgcat::mcset da "Show &Hidden Directories" "Vis &skjulte kataloger"
::msgcat::mcset da "Show &Hidden Files and Directories" "Vis &skjulte filer og kataloger"
::msgcat::mcset da "Skip Messages" "Overspring beskeder"
- ::msgcat::mcset da "&Source..." "&K\u00F8r..."
+ ::msgcat::mcset da "&Source..." "&Kør..."
::msgcat::mcset da "Tcl Scripts" "Tcl-Skripter"
::msgcat::mcset da "Tcl for Windows" "Tcl for Windows"
::msgcat::mcset da "Text Files" "Tekstfiler"
::msgcat::mcset da "&Yes" "&Ja"
::msgcat::mcset da "abort" "afbryd"
- ::msgcat::mcset da "blue" "bl\u00E5"
+ ::msgcat::mcset da "blue" "blå"
::msgcat::mcset da "cancel" "afbryd"
::msgcat::mcset da "extension"
::msgcat::mcset da "extensions"
- ::msgcat::mcset da "green" "gr\u00F8n"
+ ::msgcat::mcset da "green" "grøn"
::msgcat::mcset da "ignore" "ignorer"
::msgcat::mcset da "ok"
- ::msgcat::mcset da "red" "r\u00F8d"
+ ::msgcat::mcset da "red" "rød"
::msgcat::mcset da "retry" "gentag"
::msgcat::mcset da "yes" "ja"
}
diff --git a/library/msgs/de.msg b/library/msgs/de.msg
index 6dee507..2cf25d2 100644
--- a/library/msgs/de.msg
+++ b/library/msgs/de.msg
@@ -52,7 +52,7 @@ namespace eval ::tk {
::msgcat::mcset de "Ok"
::msgcat::mcset de "Open" "Öffnen"
::msgcat::mcset de "&Open" "Ö&ffnen"
- ::msgcat::mcset de "Open Multiple Files" "Mehrere Dateien \u00F6ffnen"
+ ::msgcat::mcset de "Open Multiple Files" "Mehrere Dateien Öffnen"
::msgcat::mcset de "P&aste" "E&infügen"
::msgcat::mcset de "&Quit" "&Beenden"
::msgcat::mcset de "&Red" "&Rot"
diff --git a/library/obsolete.tcl b/library/obsolete.tcl
index e66c48d..a31884d 100644
--- a/library/obsolete.tcl
+++ b/library/obsolete.tcl
@@ -3,8 +3,8 @@
# This file contains obsolete procedures that people really shouldn't
# be using anymore, but which are kept around for backward compatibility.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/optMenu.tcl b/library/optMenu.tcl
index 7cfdaa0..4beb3c7 100644
--- a/library/optMenu.tcl
+++ b/library/optMenu.tcl
@@ -3,8 +3,8 @@
# This file defines the procedure tk_optionMenu, which creates
# an option button and its associated menu.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/palette.tcl b/library/palette.tcl
index 42c6a90..e658067 100644
--- a/library/palette.tcl
+++ b/library/palette.tcl
@@ -3,7 +3,7 @@
# This file contains procedures that change the color palette used
# by Tk.
#
-# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright © 1995-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/safetk.tcl b/library/safetk.tcl
index 9f8e25d..0eb1220 100644
--- a/library/safetk.tcl
+++ b/library/safetk.tcl
@@ -2,7 +2,7 @@
#
# Support procs to use Tk in safe interpreters.
#
-# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright © 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -14,9 +14,9 @@
# Note: It is now ok to let untrusted code being executed
# between the creation of the interp and the actual loading
# of Tk in that interp because the C side Tk_Init will
-# now look up the master interp and ask its safe::TkInit
+# now look up the parent interp and ask its safe::TkInit
# for the actual parameters to use for it's initialization (if allowed),
-# not relying on the slave state.
+# not relying on the child state.
#
# We use opt (optional arguments parsing)
@@ -29,31 +29,31 @@ namespace eval ::safe {
}
#
-# tkInterpInit : prepare the slave interpreter for tk loading
+# tkInterpInit : prepare the child interpreter for tk loading
# most of the real job is done by loadTk
-# returns the slave name (tkInterpInit does)
+# returns the child name (tkInterpInit does)
#
-proc ::safe::tkInterpInit {slave argv} {
+proc ::safe::tkInterpInit {child argv} {
global env tk_library
# We have to make sure that the tk_library variable is normalized.
set tk_library [file normalize $tk_library]
# Clear Tk's access for that interp (path).
- allowTk $slave $argv
+ allowTk $child $argv
# Ensure tk_library and subdirs (eg, ttk) are on the access path
- ::interp eval $slave [list set tk_library [::safe::interpAddToAccessPath $slave $tk_library]]
+ ::interp eval $child [list set tk_library [::safe::interpAddToAccessPath $child $tk_library]]
foreach subdir [::safe::AddSubDirs [list $tk_library]] {
- ::safe::interpAddToAccessPath $slave $subdir
+ ::safe::interpAddToAccessPath $child $subdir
}
- return $slave
+ return $child
}
# tkInterpLoadTk:
# Do additional configuration as needed (calling tkInterpInit)
-# and actually load Tk into the slave.
+# and actually load Tk into the child.
#
# Either contained in the specified windowId (-use) or
# creating a decorated toplevel for it.
@@ -62,37 +62,37 @@ proc ::safe::tkInterpInit {slave argv} {
proc ::safe::loadTk {} {}
::tcl::OptProc ::safe::loadTk {
- {slave -interp "name of the slave interpreter"}
+ {child -interp "name of the child interpreter"}
{-use -windowId {} "window Id to use (new toplevel otherwise)"}
{-display -displayName {} "display name to use (current one otherwise)"}
} {
set displayGiven [::tcl::OptProcArgGiven "-display"]
if {!$displayGiven} {
# Try to get the current display from "."
- # (which might not exist if the master is tk-less)
+ # (which might not exist if the parent is tk-less)
if {[catch {set display [winfo screen .]}]} {
if {[info exists ::env(DISPLAY)]} {
set display $::env(DISPLAY)
} else {
- Log $slave "no winfo screen . nor env(DISPLAY)" WARNING
+ Log $child "no winfo screen . nor env(DISPLAY)" WARNING
set display ":0.0"
}
}
}
# Get state for access to the cleanupHook.
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe S$child state
if {![::tcl::OptProcArgGiven "-use"]} {
# create a decorated toplevel
- lassign [tkTopLevel $slave $display] w use
+ lassign [tkTopLevel $child $display] w use
- # set our delete hook (slave arg is added by interpDelete)
- # to clean up both window related code and tkInit(slave)
+ # set our delete hook (child arg is added by interpDelete)
+ # to clean up both window related code and tkInit(child)
set state(cleanupHook) [list tkDelete {} $w]
} else {
- # set our delete hook (slave arg is added by interpDelete)
- # to clean up tkInit(slave)
+ # set our delete hook (child arg is added by interpDelete)
+ # to clean up tkInit(child)
set state(cleanupHook) [list disallowTk]
# Let's be nice and also accept tk window names instead of ids
@@ -122,12 +122,12 @@ proc ::safe::loadTk {} {}
}
}
- # Prepares the slave for tk with those parameters
- tkInterpInit $slave [list "-use" $use "-display" $display]
+ # Prepares the child for tk with those parameters
+ tkInterpInit $child [list "-use" $use "-display" $display]
- load {} Tk $slave
+ load {} Tk $child
- return $slave
+ return $child
}
proc ::safe::TkInit {interpPath} {
@@ -149,7 +149,7 @@ proc ::safe::TkInit {interpPath} {
# safe::TkInit.
#
# Arguments:
-# interpPath slave interpreter handle
+# interpPath child interpreter handle
# argv arguments passed to safe::TkInterpInit
#
# Results:
@@ -168,7 +168,7 @@ proc ::safe::allowTk {interpPath argv} {
# in safe::TkInit.
#
# Arguments:
-# interpPath slave interpreter handle
+# interpPath child interpreter handle
#
# Results:
# none.
@@ -188,43 +188,43 @@ proc ::safe::disallowTk {interpPath} {
# Clean up the window associated with the interp being deleted.
#
# Arguments:
-# interpPath slave interpreter handle
+# interpPath child interpreter handle
#
# Results:
# none.
-proc ::safe::tkDelete {W window slave} {
+proc ::safe::tkDelete {W window child} {
# we are going to be called for each widget... skip untill it's
# top level
- Log $slave "Called tkDelete $W $window" NOTICE
- if {[::interp exists $slave]} {
- if {[catch {::safe::interpDelete $slave} msg]} {
- Log $slave "Deletion error : $msg"
+ Log $child "Called tkDelete $W $window" NOTICE
+ if {[::interp exists $child]} {
+ if {[catch {::safe::interpDelete $child} msg]} {
+ Log $child "Deletion error : $msg"
}
}
if {[winfo exists $window]} {
- Log $slave "Destroy toplevel $window" NOTICE
+ Log $child "Destroy toplevel $window" NOTICE
destroy $window
}
- # clean up tkInit(slave)
- disallowTk $slave
+ # clean up tkInit(child)
+ disallowTk $child
return
}
-proc ::safe::tkTopLevel {slave display} {
+proc ::safe::tkTopLevel {child display} {
variable tkSafeId
incr tkSafeId
set w ".safe$tkSafeId"
if {[catch {toplevel $w -screen $display -class SafeTk} msg]} {
return -code error -errorcode {TK TOPLEVEL SAFE} \
- "Unable to create toplevel for safe slave \"$slave\" ($msg)"
+ "Unable to create toplevel for \"$child\" ($msg)"
}
- Log $slave "New toplevel $w" NOTICE
+ Log $child "New toplevel $w" NOTICE
- set msg "Untrusted Tcl applet ($slave)"
+ set msg "Untrusted Tcl applet ($child)"
wm title $w $msg
# Control frame (we must create a style for it)
@@ -236,7 +236,7 @@ proc ::safe::tkTopLevel {slave display} {
# We will destroy the interp when the window is destroyed
bindtags $wc [concat Safe$wc [bindtags $wc]]
- bind Safe$wc <Destroy> [list ::safe::tkDelete %W $w $slave]
+ bind Safe$wc <Destroy> [list ::safe::tkDelete %W $w $child]
ttk::label $wc.l -text $msg -anchor w
@@ -247,7 +247,7 @@ proc ::safe::tkTopLevel {slave display} {
# but still have the default background instead of red one from the parent
ttk::frame $wc.fb -borderwidth 0
ttk::button $wc.fb.b -text "Delete" \
- -command [list ::safe::tkDelete $w $w $slave]
+ -command [list ::safe::tkDelete $w $w $child]
pack $wc.fb.b -side right -fill both
pack $wc.fb -side right -fill both -expand 1
pack $wc.l -side left -fill both -expand 1 -ipady 2
diff --git a/library/scale.tcl b/library/scale.tcl
index cc0de20..0da5472 100644
--- a/library/scale.tcl
+++ b/library/scale.tcl
@@ -3,8 +3,8 @@
# This file defines the default bindings for Tk scale widgets and provides
# procedures that help in implementing the bindings.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -60,14 +60,6 @@ bind Scale <ButtonRelease-2> {
tk::ScaleEndDrag %W
tk::ScaleActivate %W %x %y
}
-if {[tk windowingsystem] eq "win32"} {
- # On Windows do the same with button 3, as that is the right mouse button
- bind Scale <Button-3> [bind Scale <Button-2>]
- bind Scale <B3-Motion> [bind Scale <B2-Motion>]
- bind Scale <B3-Leave> [bind Scale <B2-Leave>]
- bind Scale <B3-Enter> [bind Scale <B2-Enter>]
- bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>]
-}
bind Scale <Control-Button-1> {
tk::ScaleControlPress %W %x %y
}
diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl
index 8106b3d..effae11 100644
--- a/library/scrlbar.tcl
+++ b/library/scrlbar.tcl
@@ -3,8 +3,8 @@
# This file defines the default bindings for Tk scrollbar widgets.
# It also provides procedures that help in implementing the bindings.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -129,34 +129,11 @@ bind Scrollbar <<LineEnd>> {
}
}
-if {[tk windowingsystem] eq "aqua"} {
- bind Scrollbar <MouseWheel> {
- tk::ScrollByUnits %W hv [expr {-(%D)}]
- }
- bind Scrollbar <Option-MouseWheel> {
- tk::ScrollByUnits %W hv [expr {-10 * (%D)}]
- }
-} else {
- # We must make sure that positive and negative movements are rounded
- # equally to integers, avoiding the problem that
- # (int)1/30 = 0,
- # but
- # (int)-1/30 = -1
- # The following code ensure equal +/- behaviour.
- bind Scrollbar <MouseWheel> {
- if {%D >= 0} {
- tk::ScrollByUnits %W hv [expr {-%D/30}]
- } else {
- tk::ScrollByUnits %W hv [expr {(29-%D)/30}]
- }
- }
+bind Scrollbar <MouseWheel> {
+ tk::ScrollByUnits %W hv %D -30.0
}
-
-if {[tk windowingsystem] eq "x11"} {
- bind Scrollbar <Button-4> {tk::ScrollByUnits %W hv -5}
- bind Scrollbar <Button-5> {tk::ScrollByUnits %W hv 5}
- bind Scrollbar <Button-6> {tk::ScrollByUnits %W hv -5}
- bind Scrollbar <Button-7> {tk::ScrollByUnits %W hv 5}
+bind Scrollbar <Option-MouseWheel> {
+ tk::ScrollByUnits %W hv %D -3.0
}
# tk::ScrollButtonDown --
@@ -329,7 +306,7 @@ proc ::tk::ScrollEndDrag {w x y} {
# horizontal, "v" for vertical, "hv" for both.
# amount - How many units to scroll: typically 1 or -1.
-proc ::tk::ScrollByUnits {w orient amount} {
+proc ::tk::ScrollByUnits {w orient amount {factor 1.0}} {
set cmd [$w cget -command]
if {$cmd eq "" || ([string first \
[string index [$w cget -orient] 0] $orient] < 0)} {
@@ -337,9 +314,9 @@ proc ::tk::ScrollByUnits {w orient amount} {
}
set info [$w get]
if {[llength $info] == 2} {
- uplevel #0 $cmd scroll $amount units
+ uplevel #0 $cmd scroll [expr {$amount/$factor}] units
} else {
- uplevel #0 $cmd [expr {[lindex $info 2] + $amount}]
+ uplevel #0 $cmd [expr {[lindex $info 2] + [expr {$amount/$factor}]}]
}
}
diff --git a/library/spinbox.tcl b/library/spinbox.tcl
index 15330e9..6d740bc 100644
--- a/library/spinbox.tcl
+++ b/library/spinbox.tcl
@@ -4,10 +4,10 @@
# procedures that help in implementing those bindings. The spinbox builds
# off the entry widget, so it can reuse Entry bindings and procedures.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1999-2000 Jeffrey Hobbs
-# Copyright (c) 2000 Ajuba Solutions
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1999-2000 Jeffrey Hobbs
+# Copyright © 2000 Ajuba Solutions
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -218,9 +218,7 @@ bind Spinbox <KP_Enter> {# nothing}
bind Spinbox <Tab> {# nothing}
bind Spinbox <Prior> {# nothing}
bind Spinbox <Next> {# nothing}
-if {[tk windowingsystem] eq "aqua"} {
- bind Spinbox <Command-Key> {# nothing}
-}
+bind Spinbox <Command-Key> {# nothing}
# On Windows, paste is done using Shift-Insert. Shift-Insert already
# generates the <<Paste>> event, so we don't need to do anything here.
@@ -280,27 +278,14 @@ bind Spinbox <Meta-Delete> {
# A few additional bindings of my own.
-if {[tk windowingsystem] ne "aqua"} {
- bind Spinbox <Button-2> {
- if {!$tk_strictMotif} {
- ::tk::EntryScanMark %W %x
- }
- }
- bind Spinbox <B2-Motion> {
- if {!$tk_strictMotif} {
- ::tk::EntryScanDrag %W %x
- }
- }
-} else {
- bind Spinbox <Button-3> {
- if {!$tk_strictMotif} {
- ::tk::EntryScanMark %W %x
- }
+bind Spinbox <Button-2> {
+ if {!$tk_strictMotif} {
+ ::tk::EntryScanMark %W %x
}
- bind Spinbox <B3-Motion> {
- if {!$tk_strictMotif} {
- ::tk::EntryScanDrag %W %x
- }
+}
+bind Spinbox <B2-Motion> {
+ if {!$tk_strictMotif} {
+ ::tk::EntryScanDrag %W %x
}
}
@@ -483,10 +468,10 @@ proc ::tk::spinbox::MouseSelect {w x {cursor {}}} {
word {
if {$cur < [$w index anchor]} {
set before [tcl_wordBreakBefore [$w get] $cur]
- set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
+ set after [tcl_wordBreakAfter [$w get] $anchor-1]
} else {
set before [tcl_wordBreakBefore [$w get] $anchor]
- set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
+ set after [tcl_wordBreakAfter [$w get] $cur-1]
}
if {$before < 0} {
set before 0
@@ -589,5 +574,5 @@ proc ::tk::spinbox::AutoScan {w} {
proc ::tk::spinbox::GetSelection {w} {
return [string range [$w get] [$w index sel.first] \
- [expr {[$w index sel.last] - 1}]]
+ [$w index sel.last]-1]
}
diff --git a/library/tclIndex b/library/tclIndex
index 919fa8a..06006cd 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -199,6 +199,7 @@ set auto_index(::tk::RestoreFocusGrab) [list source [file join $dir tk.tcl]]
set auto_index(::tk::ScreenChanged) [list source [file join $dir tk.tcl]]
set auto_index(::tk::EventMotifBindings) [list source [file join $dir tk.tcl]]
set auto_index(::tk::CancelRepeat) [list source [file join $dir tk.tcl]]
+set auto_index(::tk::MouseWheel) [list source [file join $dir tk.tcl]]
set auto_index(::tk::TabToWindow) [list source [file join $dir tk.tcl]]
set auto_index(::tk::dialog::file::) [list source [file join $dir tkfbox.tcl]]
set auto_index(::tk::dialog::file::Config) [list source [file join $dir tkfbox.tcl]]
diff --git a/library/tearoff.tcl b/library/tearoff.tcl
index c2d2d6b..f69a988 100644
--- a/library/tearoff.tcl
+++ b/library/tearoff.tcl
@@ -2,8 +2,8 @@
#
# This file contains procedures that implement tear-off menus.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -39,7 +39,7 @@ proc ::tk::TearOffMenu {w {x 0} {y 0}} {
# Shift by height of tearoff entry minus height of window titlebar
catch {incr y [expr {[$w yposition 1] - 16}]}
# Avoid the native menu bar which sits on top of everything.
- if {$y < 22} { set y 22 }
+ if {$y < 22} {set y 22}
}
}
@@ -153,11 +153,11 @@ proc ::tk::MenuDup {src dst type} {
# Copy tags to x, replacing each substring of src with dst.
- while {[set index [string first $src $tags]] != -1} {
+ while {[set index [string first $src $tags]] >= 0} {
if {$index > 0} {
- append x [string range $tags 0 [expr {$index - 1}]]$dst
+ append x [string range $tags 0 $index-1]$dst
}
- set tags [string range $tags [expr {$index + $srcLen}] end]
+ set tags [string range $tags $index+$srcLen end]
}
append x $tags
@@ -170,12 +170,12 @@ proc ::tk::MenuDup {src dst type} {
# Copy script to x, replacing each substring of event with dst.
- while {[set index [string first $event $script]] != -1} {
+ while {[set index [string first $event $script]] >= 0} {
if {$index > 0} {
- append x [string range $script 0 [expr {$index - 1}]]
+ append x [string range $script 0 $index-1]
}
append x $dst
- set script [string range $script [expr {$index + $eventLen}] end]
+ set script [string range $script $index+$eventLen end]
}
append x $script
diff --git a/library/text.tcl b/library/text.tcl
index 1c84b40..5db9453 100644
--- a/library/text.tcl
+++ b/library/text.tcl
@@ -3,9 +3,9 @@
# This file defines the default bindings for Tk text widgets and provides
# procedures that help in implementing the bindings.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -306,9 +306,7 @@ bind Text <Meta-Key> {# nothing}
bind Text <Control-Key> {# nothing}
bind Text <Escape> {# nothing}
bind Text <KP_Enter> {# nothing}
-if {[tk windowingsystem] eq "aqua"} {
- bind Text <Command-Key> {# nothing}
-}
+bind Text <Command-Key> {# nothing}
# Additional emacs-like bindings:
@@ -429,107 +427,29 @@ bind Text <Control-h> {
%W see insert
}
}
-if {[tk windowingsystem] ne "aqua"} {
- bind Text <Button-2> {
- if {!$tk_strictMotif} {
- tk::TextScanMark %W %x %y
- }
- }
- bind Text <B2-Motion> {
- if {!$tk_strictMotif} {
- tk::TextScanDrag %W %x %y
- }
- }
-} else {
- bind Text <Button-3> {
- if {!$tk_strictMotif} {
- tk::TextScanMark %W %x %y
- }
+bind Text <Button-2> {
+ if {!$tk_strictMotif} {
+ tk::TextScanMark %W %x %y
}
- bind Text <B3-Motion> {
- if {!$tk_strictMotif} {
- tk::TextScanDrag %W %x %y
- }
+}
+bind Text <B2-Motion> {
+ if {!$tk_strictMotif} {
+ tk::TextScanDrag %W %x %y
}
}
set ::tk::Priv(prevPos) {}
-# The MouseWheel will typically only fire on Windows and MacOS X.
-# However, someone could use the "event generate" command to produce one
-# on other platforms. We must be careful not to round -ve values of %D
-# down to zero.
-
-if {[tk windowingsystem] eq "aqua"} {
- bind Text <MouseWheel> {
- %W yview scroll [expr {-15 * (%D)}] pixels
- }
- bind Text <Option-MouseWheel> {
- %W yview scroll [expr {-150 * (%D)}] pixels
- }
- bind Text <Shift-MouseWheel> {
- %W xview scroll [expr {-15 * (%D)}] pixels
- }
- bind Text <Shift-Option-MouseWheel> {
- %W xview scroll [expr {-150 * (%D)}] pixels
- }
-} else {
- # We must make sure that positive and negative movements are rounded
- # equally to integers, avoiding the problem that
- # (int)1/3 = 0,
- # but
- # (int)-1/3 = -1
- # The following code ensure equal +/- behaviour.
- bind Text <MouseWheel> {
- if {%D >= 0} {
- %W yview scroll [expr {-%D/3}] pixels
- } else {
- %W yview scroll [expr {(2-%D)/3}] pixels
- }
- }
- bind Text <Shift-MouseWheel> {
- if {%D >= 0} {
- %W xview scroll [expr {-%D/3}] pixels
- } else {
- %W xview scroll [expr {(2-%D)/3}] pixels
- }
- }
+bind Text <MouseWheel> {
+ tk::MouseWheel %W y %D -3.0 pixels
}
-
-if {[tk windowingsystem] eq "x11"} {
- # Support for mousewheels on Linux/Unix commonly comes through mapping
- # the wheel to the extended buttons. If you have a mousewheel, find
- # Linux configuration info at:
- # http://linuxreviews.org/howtos/xfree/mouse/
- bind Text <Button-4> {
- if {!$tk_strictMotif} {
- %W yview scroll -50 pixels
- }
- }
- bind Text <Button-5> {
- if {!$tk_strictMotif} {
- %W yview scroll 50 pixels
- }
- }
- bind Text <Shift-Button-4> {
- if {!$tk_strictMotif} {
- %W xview scroll -50 pixels
- }
- }
- bind Text <Shift-Button-5> {
- if {!$tk_strictMotif} {
- %W xview scroll 50 pixels
- }
- }
- bind Text <Button-6> {
- if {!$tk_strictMotif} {
- %W xview scroll -50 pixels
- }
- }
- bind Text <Button-7> {
- if {!$tk_strictMotif} {
- %W xview scroll 50 pixels
- }
- }
+bind Text <Option-MouseWheel> {
+ tk::MouseWheel %W y %D -0.3 pixels
+}
+bind Text <Shift-MouseWheel> {
+ tk::MouseWheel %W x %D -3.0 pixels
+}
+bind Text <Shift-Option-MouseWheel> {
+ tk::MouseWheel %W x %D -0.3 pixels
}
# ::tk::TextClosestGap --
@@ -581,12 +501,7 @@ proc ::tk::TextButton1 {w x y} {
} else {
$w mark gravity $anchorname left
}
- # Allow focus in any case on Windows, because that will let the
- # selection be displayed even for state disabled text widgets.
- if {[tk windowingsystem] eq "win32" \
- || [$w cget -state] eq "normal"} {
- focus $w
- }
+ focus $w
if {[$w cget -autoseparators]} {
$w edit separator
}
diff --git a/library/tk.tcl b/library/tk.tcl
index 66b8a87..b1b7629 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -3,9 +3,9 @@
# Initialization script normally executed in the interpreter for each Tk-based
# application. Arranges class bindings for widgets.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 Ajuba Solutions.
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -366,15 +366,16 @@ if {![llength [info command tk_chooseDirectory]]} {
# Define the set of common virtual events.
#----------------------------------------------------------------------
+event add <<ContextMenu>> <Button-3>
+event add <<PasteSelection>> <ButtonRelease-2>
+
switch -exact -- [tk windowingsystem] {
"x11" {
event add <<Cut>> <Control-x> <F20> <Control-Lock-X>
event add <<Copy>> <Control-c> <F16> <Control-Lock-C>
event add <<Paste>> <Control-v> <F18> <Control-Lock-V>
- event add <<PasteSelection>> <ButtonRelease-2>
event add <<Undo>> <Control-z> <Control-Lock-Z>
event add <<Redo>> <Control-Z> <Control-Lock-z>
- event add <<ContextMenu>> <Button-3>
# On Darwin/Aqua, buttons from left to right are 1,3,2. On Darwin/X11 with recent
# XQuartz as the X server, they are 1,2,3; other X servers may differ.
@@ -422,10 +423,8 @@ switch -exact -- [tk windowingsystem] {
event add <<Cut>> <Control-x> <Shift-Delete> <Control-Lock-X>
event add <<Copy>> <Control-c> <Control-Insert> <Control-Lock-C>
event add <<Paste>> <Control-v> <Shift-Insert> <Control-Lock-V>
- event add <<PasteSelection>> <ButtonRelease-2>
event add <<Undo>> <Control-z> <Control-Lock-Z>
event add <<Redo>> <Control-y> <Control-Lock-Y>
- event add <<ContextMenu>> <Button-3>
event add <<SelectAll>> <Control-slash> <Control-a> <Control-Lock-A>
event add <<SelectNone>> <Control-backslash>
@@ -455,9 +454,7 @@ switch -exact -- [tk windowingsystem] {
event add <<Cut>> <Command-x> <F2> <Command-Lock-X>
event add <<Copy>> <Command-c> <F3> <Command-Lock-C>
event add <<Paste>> <Command-v> <F4> <Command-Lock-V>
- event add <<PasteSelection>> <ButtonRelease-3>
event add <<Clear>> <Clear>
- event add <<ContextMenu>> <Button-2>
# Official bindings
# See http://support.apple.com/kb/HT1343
@@ -496,7 +493,7 @@ switch -exact -- [tk windowingsystem] {
if {$::tk_library ne ""} {
proc ::tk::SourceLibFile {file} {
- namespace eval :: [list source [file join $::tk_library $file.tcl]]
+ namespace eval :: [list source -encoding utf-8 [file join $::tk_library $file.tcl]]
}
namespace eval ::tk {
SourceLibFile icons
@@ -536,6 +533,13 @@ proc ::tk::CancelRepeat {} {
set Priv(afterId) {}
}
+## ::tk::MouseWheel $w $dir $amount $factor $units
+
+proc ::tk::MouseWheel {w dir amount {factor -120.0} {units units}} {
+ $w ${dir}view scroll [expr {$amount/$factor}] $units
+}
+
+
# ::tk::TabToWindow --
# This procedure moves the focus to the given widget.
# It sends a <<TraverseOut>> virtual event to the previous focus window,
@@ -627,8 +631,8 @@ proc ::tk::FindAltKeyTarget {path char} {
[string index [$path cget -text] [$path cget -underline]]]} {
return $path
}
- set subwins [concat [grid slaves $path] [pack slaves $path] \
- [place slaves $path]]
+ set subwins [concat [grid content $path] [pack content $path] \
+ [place content $path]]
if {$class eq "Canvas"} {
foreach item [$path find all] {
if {[$path type $item] eq "window"} {
@@ -687,9 +691,11 @@ if {[tk windowingsystem] eq "aqua"} {
if {[tk windowingsystem] eq "aqua"} {
#stub procedures to respond to "do script" Apple Events
proc ::tk::mac::DoScriptFile {file} {
- source $file
+ uplevel #0 $file
+ source -encoding utf-8 $file
}
proc ::tk::mac::DoScriptText {script} {
+ uplevel #0 $script
eval $script
}
}
@@ -731,7 +737,7 @@ set ::tk::Priv(IMETextMark) [dict create]
# Run the Ttk themed widget set initialization
if {$::ttk::library ne ""} {
- uplevel \#0 [list source $::ttk::library/ttk.tcl]
+ uplevel \#0 [list source -encoding utf-8 $::ttk::library/ttk.tcl]
}
# Local Variables:
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index cf89287..af40a12 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -10,7 +10,7 @@
# "Directory" option menu. The user can select files by clicking on the
# file icons or by entering a filename in the "Filename:" entry.
#
-# Copyright (c) 1994-1998 Sun Microsystems, Inc.
+# Copyright © 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/ttk/button.tcl b/library/ttk/button.tcl
index e8c24a1..14460a2 100644
--- a/library/ttk/button.tcl
+++ b/library/ttk/button.tcl
@@ -42,7 +42,7 @@ ttk::copyBindings TButton TRadiobutton
bind TRadiobutton <Up> { ttk::button::RadioTraverse %W -1 }
bind TRadiobutton <Down> { ttk::button::RadioTraverse %W +1 }
-# bind TCheckbutton <plus> { %W select }
+# bind TCheckbutton <+> { %W select }
# bind TCheckbutton <minus> { %W deselect }
# activate --
diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl
index 9af8c59..58df760 100644
--- a/library/ttk/combobox.tcl
+++ b/library/ttk/combobox.tcl
@@ -182,11 +182,15 @@ proc ttk::combobox::SelectEntry {cb index} {
## Scroll -- Mousewheel binding
#
-proc ttk::combobox::Scroll {cb dir} {
+proc ttk::combobox::Scroll {cb dir {factor 1.0}} {
$cb instate disabled { return }
set max [llength [$cb cget -values]]
set current [$cb current]
- incr current $dir
+ set d [expr {round($dir/factor)}]
+ if {$d == 0 && $dir != 0} {
+ if {$dir > 0} {set d 1} else {set d -1}
+ }
+ incr current $d
if {$max != 0 && $current == $current % $max} {
SelectEntry $cb $current
}
@@ -197,7 +201,7 @@ proc ttk::combobox::Scroll {cb dir} {
# and unpost the listbox.
#
proc ttk::combobox::LBSelected {lb} {
- set cb [LBMaster $lb]
+ set cb [LBMain $lb]
LBSelect $lb
Unpost $cb
focus $cb
@@ -207,14 +211,14 @@ proc ttk::combobox::LBSelected {lb} {
# Unpost the listbox.
#
proc ttk::combobox::LBCancel {lb} {
- Unpost [LBMaster $lb]
+ Unpost [LBMain $lb]
}
## LBTab -- Tab key binding for combobox listbox.
# Set the selection, and navigate to next/prev widget.
#
proc ttk::combobox::LBTab {lb dir} {
- set cb [LBMaster $lb]
+ set cb [LBMain $lb]
switch -- $dir {
next { set newFocus [tk_focusNext $cb] }
prev { set newFocus [tk_focusPrev $cb] }
@@ -357,6 +361,9 @@ proc ttk::combobox::PlacePopdown {cb popdown} {
set w [winfo width $cb]
set h [winfo height $cb]
set style [$cb cget -style]
+ if { $style eq {} } {
+ set style TCombobox
+ }
set postoffset [ttk::style lookup $style -postoffset {} {0 0 0 0}]
foreach var {x y w h} delta $postoffset {
incr $var $delta
@@ -411,10 +418,10 @@ proc ttk::combobox::Unpost {cb} {
grab release $cb.popdown ;# in case of stuck or unexpected grab [#1239190]
}
-## LBMaster $lb --
+## LBMain $lb --
# Return the combobox main widget that owns the listbox.
#
-proc ttk::combobox::LBMaster {lb} {
+proc ttk::combobox::LBMain {lb} {
winfo parent [winfo parent [winfo parent $lb]]
}
@@ -422,7 +429,7 @@ proc ttk::combobox::LBMaster {lb} {
# Transfer listbox selection to combobox value.
#
proc ttk::combobox::LBSelect {lb} {
- set cb [LBMaster $lb]
+ set cb [LBMain $lb]
set selection [$lb curselection]
if {[llength $selection] == 1} {
SelectEntry $cb [lindex $selection 0]
@@ -439,7 +446,7 @@ proc ttk::combobox::LBSelect {lb} {
#
proc ttk::combobox::LBCleanup {lb} {
variable Values
- unset Values([LBMaster $lb])
+ unset Values([LBMain $lb])
}
#*EOF*
diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl
index 6723833..16f6108 100644
--- a/library/ttk/entry.tcl
+++ b/library/ttk/entry.tcl
@@ -1,9 +1,9 @@
#
# DERIVED FROM: tk/library/entry.tcl r1.22
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 2004, Joe English
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 2004, Joe English
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -82,20 +82,14 @@ bind TEntry <<ToggleSelection>> {
%W instate {!readonly !disabled} { %W icursor @%x ; focus %W }
}
-## Button2 (Button3 on Aqua) bindings:
+## Button2 bindings:
# Used for scanning and primary transfer.
-# Note: ButtonRelease-2 (ButtonRelease-3 on Aqua)
+# Note: ButtonRelease-2
# is mapped to <<PasteSelection>> in tk.tcl.
#
-if {[tk windowingsystem] ne "aqua"} {
- bind TEntry <Button-2> { ttk::entry::ScanMark %W %x }
- bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x }
- bind TEntry <ButtonRelease-2> { ttk::entry::ScanRelease %W %x }
-} else {
- bind TEntry <Button-3> { ttk::entry::ScanMark %W %x }
- bind TEntry <B3-Motion> { ttk::entry::ScanDrag %W %x }
- bind TEntry <ButtonRelease-3> { ttk::entry::ScanRelease %W %x }
-}
+bind TEntry <Button-2> { ttk::entry::ScanMark %W %x }
+bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x }
+bind TEntry <ButtonRelease-2> { ttk::entry::ScanRelease %W %x }
bind TEntry <<PasteSelection>> { ttk::entry::ScanRelease %W %x }
## Keyboard navigation bindings:
@@ -179,7 +173,7 @@ bind TEntry <<TkAccentBackspace>> {
#
proc ttk::entry::EntrySelection {w} {
set entryString [string range [$w get] [$w index sel.first] \
- [expr {[$w index sel.last] - 1}]]
+ [$w index sel.last]-1]
if {[$w cget -show] ne ""} {
return [string repeat [string index [$w cget -show] 0] \
[string length $entryString]]
diff --git a/library/ttk/fonts.tcl b/library/ttk/fonts.tcl
index d819973..65f2c5e 100644
--- a/library/ttk/fonts.tcl
+++ b/library/ttk/fonts.tcl
@@ -78,7 +78,7 @@ switch -- [tk windowingsystem] {
set F(family) "MS Sans Serif"
}
} else {
- if {[lsearch -exact [font families] Tahoma] != -1} {
+ if {[lsearch -exact [font families] Tahoma] >= 0} {
set F(family) "Tahoma"
} else {
set F(family) "MS Sans Serif"
diff --git a/library/ttk/menubutton.tcl b/library/ttk/menubutton.tcl
index 08b4a15..a245df8 100644
--- a/library/ttk/menubutton.tcl
+++ b/library/ttk/menubutton.tcl
@@ -224,11 +224,11 @@ proc ttk::menubutton::TransferGrab {mb} {
# FindMenuEntry --
# Hack to support tk_optionMenus.
# Returns the index of the menu entry with a matching -label,
-# -1 if not found.
+# "" if not found.
#
proc ttk::menubutton::FindMenuEntry {menu s} {
set last [$menu index last]
- if {$last eq "none"} {
+ if {$last eq "none" || $last eq ""} {
return ""
}
for {set i 0} {$i <= $last} {incr i} {
diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl
index c5340a5..a871081 100644
--- a/library/ttk/notebook.tcl
+++ b/library/ttk/notebook.tcl
@@ -112,13 +112,8 @@ proc ttk::notebook::enableTraversal {nb} {
catch {
bind $top <Control-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1}
}
- if {[tk windowingsystem] eq "aqua"} {
- bind $top <Option-Key> \
- +[list ttk::notebook::MnemonicActivation $top %K]
- } else {
- bind $top <Alt-Key> \
- +[list ttk::notebook::MnemonicActivation $top %K]
- }
+ bind $top <Option-Key> \
+ +[list ttk::notebook::MnemonicActivation $top %K]
bind $top <Destroy> {+ttk::notebook::TLCleanup %W}
}
diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl
index 7537491..8f6cf64 100644
--- a/library/ttk/scrollbar.tcl
+++ b/library/ttk/scrollbar.tcl
@@ -19,21 +19,8 @@ bind TScrollbar <ButtonRelease-2> { ttk::scrollbar::Release %W %x %y }
# Redirect scrollwheel bindings to the scrollbar widget
#
-# The shift-bindings scroll left/right (not up/down)
-# if a widget has both possibilities
-set eventList [list <MouseWheel>]
-switch [tk windowingsystem] {
- aqua {
- lappend eventList <Option-MouseWheel>
- }
- x11 {
- lappend eventList <Button-4> <Button-5> <Button-6> <Button-7>
- }
-}
-foreach event $eventList {
- bind TScrollbar $event [bind Scrollbar $event]
-}
-unset eventList event
+bind TScrollbar <MouseWheel> [bind Scrollbar <MouseWheel>]
+bind TScrollbar <Option-MouseWheel> [bind Scrollbar <Option-MouseWheel>]
proc ttk::scrollbar::Scroll {w n units} {
set cmd [$w cget -command]
@@ -56,7 +43,7 @@ proc ttk::scrollbar::Press {w x y} {
set State(yPress) $y
switch -glob -- [$w identify $x $y] {
- *uparrow -
+ *uparrow -
*leftarrow {
ttk::Repeatedly Scroll $w -1 units
}
@@ -64,6 +51,7 @@ proc ttk::scrollbar::Press {w x y} {
*rightarrow {
ttk::Repeatedly Scroll $w 1 units
}
+ *grip -
*thumb {
set State(first) [lindex [$w get] 0]
}
@@ -109,6 +97,7 @@ proc ttk::scrollbar::Jump {w x y} {
variable State
switch -glob -- [$w identify $x $y] {
+ *grip -
*thumb -
*trough {
set State(first) [$w fraction $x $y]
diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl
index 5db1d03..f580a21 100644
--- a/library/ttk/spinbox.tcl
+++ b/library/ttk/spinbox.tcl
@@ -32,7 +32,7 @@ proc ttk::spinbox::Motion {w x y} {
variable State
ttk::saveCursor $w State(userConfCursor) [ttk::cursor text]
if { [$w identify $x $y] eq "textarea"
- && [$w instate {!readonly !disabled}]
+ && [$w instate {!readonly !disabled}]
} {
ttk::setCursor $w text
} else {
@@ -46,16 +46,16 @@ proc ttk::spinbox::Press {w x y} {
if {[$w instate disabled]} { return }
focus $w
switch -glob -- [$w identify $x $y] {
- *textarea { ttk::entry::Press $w $x }
+ *textarea { ttk::entry::Press $w $x }
*rightarrow -
- *uparrow { ttk::Repeatedly event generate $w <<Increment>> }
+ *uparrow { ttk::Repeatedly event generate $w <<Increment>> }
*leftarrow -
- *downarrow { ttk::Repeatedly event generate $w <<Decrement>> }
+ *downarrow { ttk::Repeatedly event generate $w <<Decrement>> }
*spinbutton {
if {$y * 2 >= [winfo height $w]} {
- set event <<Decrement>>
+ set event <<Decrement>>
} else {
- set event <<Increment>>
+ set event <<Increment>>
}
ttk::Repeatedly event generate $w $event
}
@@ -69,7 +69,7 @@ proc ttk::spinbox::DoubleClick {w x y} {
if {[$w instate disabled]} { return }
switch -glob -- [$w identify $x $y] {
- *textarea { SelectAll $w }
+ *textarea { SelectAll $w }
* { Press $w $x $y }
}
}
@@ -82,11 +82,11 @@ proc ttk::spinbox::Release {w} {
# Mousewheel callback. Turn these into <<Increment>> (-1, up)
# or <<Decrement> (+1, down) events.
#
-proc ttk::spinbox::MouseWheel {w dir} {
+proc ttk::spinbox::MouseWheel {w dir {factor 1}} {
if {[$w instate disabled]} { return }
- if {$dir < 0} {
+ if {($dir < 0) ^ ($factor < 0)} {
event generate $w <<Increment>>
- } else {
+ } elseif {$dir > 0} {
event generate $w <<Decrement>>
}
}
@@ -135,16 +135,31 @@ proc ttk::spinbox::Adjust {w v min max} {
# -from, -to, and -increment.
#
proc ttk::spinbox::Spin {w dir} {
+ variable State
+
if {[$w instate disabled]} { return }
- set nvalues [llength [set values [$w cget -values]]]
- set value [$w get]
- if {$nvalues} {
- set current [lsearch -exact $values $value]
- set index [Adjust $w [expr {$current + $dir}] 0 [expr {$nvalues - 1}]]
- $w set [lindex $values $index]
+
+ if {![info exists State($w,values.length)]} {
+ set State($w,values.index) -1
+ set State($w,values.last) {}
+ }
+ set State($w,values) [$w cget -values]
+ set State($w,values.length) [llength $State($w,values)]
+
+ if {$State($w,values.length) > 0} {
+ set value [$w get]
+ set current $State($w,values.index)
+ if {$value ne $State($w,values.last)} {
+ set current [lsearch -exact $State($w,values) $value]
+ if {$current < 0} {set current -1}
+ }
+ set State($w,values.index) [Adjust $w [expr {$current + $dir}] 0 \
+ [expr {$State($w,values.length) - 1}]]
+ set State($w,values.last) [lindex $State($w,values) $State($w,values.index)]
+ $w set $State($w,values.last)
} else {
- if {[catch {
- set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}]
+ if {[catch {
+ set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}]
}]} {
set v [$w cget -from]
}
@@ -162,7 +177,7 @@ proc ttk::spinbox::FormatValue {w val} {
if {$fmt eq ""} {
# Try to guess a suitable -format based on -increment.
set delta [expr {abs([$w cget -increment])}]
- if {0 < $delta && $delta < 1} {
+ if {0 < $delta && $delta < 1} {
# NB: This guesses wrong if -increment has more than 1
# significant digit itself, e.g., -increment 0.25
set nsd [expr {int(ceil(-log10($delta)))}]
diff --git a/library/ttk/ttk.tcl b/library/ttk/ttk.tcl
index 665222d..73ee3d9 100644
--- a/library/ttk/ttk.tcl
+++ b/library/ttk/ttk.tcl
@@ -12,9 +12,9 @@ namespace eval ::ttk {
}
}
-source [file join $::ttk::library fonts.tcl]
-source [file join $::ttk::library cursors.tcl]
-source [file join $::ttk::library utils.tcl]
+source -encoding utf-8 [file join $::ttk::library fonts.tcl]
+source -encoding utf-8 [file join $::ttk::library cursors.tcl]
+source -encoding utf-8 [file join $::ttk::library utils.tcl]
## ttk::deprecated $old $new --
# Define $old command as a deprecated alias for $new command
@@ -97,18 +97,18 @@ proc ::ttk::setTheme {theme} {
### Load widget bindings.
#
-source [file join $::ttk::library button.tcl]
-source [file join $::ttk::library menubutton.tcl]
-source [file join $::ttk::library scrollbar.tcl]
-source [file join $::ttk::library scale.tcl]
-source [file join $::ttk::library progress.tcl]
-source [file join $::ttk::library notebook.tcl]
-source [file join $::ttk::library panedwindow.tcl]
-source [file join $::ttk::library entry.tcl]
-source [file join $::ttk::library combobox.tcl] ;# dependency: entry.tcl
-source [file join $::ttk::library spinbox.tcl] ;# dependency: entry.tcl
-source [file join $::ttk::library treeview.tcl]
-source [file join $::ttk::library sizegrip.tcl]
+source -encoding utf-8 [file join $::ttk::library button.tcl]
+source -encoding utf-8 [file join $::ttk::library menubutton.tcl]
+source -encoding utf-8 [file join $::ttk::library scrollbar.tcl]
+source -encoding utf-8 [file join $::ttk::library scale.tcl]
+source -encoding utf-8 [file join $::ttk::library progress.tcl]
+source -encoding utf-8 [file join $::ttk::library notebook.tcl]
+source -encoding utf-8 [file join $::ttk::library panedwindow.tcl]
+source -encoding utf-8 [file join $::ttk::library entry.tcl]
+source -encoding utf-8 [file join $::ttk::library combobox.tcl] ;# dependency: entry.tcl
+source -encoding utf-8 [file join $::ttk::library spinbox.tcl] ;# dependency: entry.tcl
+source -encoding utf-8 [file join $::ttk::library treeview.tcl]
+source -encoding utf-8 [file join $::ttk::library sizegrip.tcl]
## Label and Labelframe bindings:
# (not enough to justify their own file...)
@@ -122,7 +122,7 @@ proc ttk::LoadThemes {} {
variable library
# "default" always present:
- uplevel #0 [list source [file join $library defaults.tcl]]
+ uplevel #0 [list source -encoding utf-8 [file join $library defaults.tcl]]
set builtinThemes [style theme names]
foreach {theme scripts} {
@@ -135,7 +135,7 @@ proc ttk::LoadThemes {} {
} {
if {[lsearch -exact $builtinThemes $theme] >= 0} {
foreach script $scripts {
- uplevel #0 [list source [file join $library $script]]
+ uplevel #0 [list source -encoding utf-8 [file join $library $script]]
}
}
}
diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl
index e0ab45b..4b925f4 100644
--- a/library/ttk/utils.tcl
+++ b/library/ttk/utils.tcl
@@ -273,21 +273,6 @@ proc ttk::copyBindings {from to} {
#
# Platform inconsistencies:
#
-# On X11, the server typically maps the mouse wheel to Button4 and Button5.
-#
-# On OSX, Tk generates sensible values for the %D field in <MouseWheel> events.
-#
-# On Windows, %D must be scaled by a factor of 120.
-# In addition, Tk redirects mousewheel events to the window with
-# keyboard focus instead of sending them to the window under the pointer.
-# We do not attempt to fix that here, see also TIP#171.
-#
-# OSX conventionally uses Shift+MouseWheel for horizontal scrolling,
-# and Option+MouseWheel for accelerated scrolling.
-#
-# The Shift+MouseWheel behavior is not conventional on Windows or most
-# X11 toolkits, but it's useful.
-#
# MouseWheel scrolling is accelerated on X11, which is conventional
# for Tk and appears to be conventional for other toolkits (although
# Gtk+ and Qt do not appear to use as large a factor).
@@ -300,24 +285,8 @@ proc ttk::copyBindings {from to} {
#
proc ttk::bindMouseWheel {bindtag callback} {
- if {[tk windowingsystem] eq "x11"} {
- bind $bindtag <Button-4> "$callback -1"
- bind $bindtag <Button-5> "$callback +1"
- }
- if {[tk windowingsystem] eq "aqua"} {
- bind $bindtag <MouseWheel> [append callback { [expr {-(%D)}]} ]
- bind $bindtag <Option-MouseWheel> [append callback { [expr {-10 *(%D)}]} ]
- } else {
- # We must make sure that positive and negative movements are rounded
- # equally to integers, avoiding the problem that
- # (int)1/120 = 0,
- # but
- # (int)-1/120 = -1
- # The following code ensure equal +/- behaviour.
- bind $bindtag <MouseWheel> [append callback { [
- expr {%D>=0 ? (-%D/120) : ((119-%D)/120)}
- ]}]
- }
+ bind $bindtag <MouseWheel> "$callback %D -120.0"
+ bind $bindtag <Option-MouseWheel> "$callback %D -12.0"
}
## Mousewheel bindings for standard scrollable widgets.
@@ -328,46 +297,13 @@ proc ttk::bindMouseWheel {bindtag callback} {
# standard scrollbar protocol.
#
-if {[tk windowingsystem] eq "x11"} {
- bind TtkScrollable <Button-4> { %W yview scroll -5 units }
- bind TtkScrollable <Button-5> { %W yview scroll 5 units }
- bind TtkScrollable <Shift-Button-4> { %W xview scroll -5 units }
- bind TtkScrollable <Shift-Button-5> { %W xview scroll 5 units }
-}
-if {[tk windowingsystem] eq "aqua"} {
- bind TtkScrollable <MouseWheel> {
- %W yview scroll [expr {-(%D)}] units
- }
- bind TtkScrollable <Shift-MouseWheel> {
- %W xview scroll [expr {-(%D)}] units
- }
- bind TtkScrollable <Option-MouseWheel> {
- %W yview scroll [expr {-10 * (%D)}] units
- }
- bind TtkScrollable <Shift-Option-MouseWheel> {
- %W xview scroll [expr {-10 * (%D)}] units
- }
-} else {
- # We must make sure that positive and negative movements are rounded
- # equally to integers, avoiding the problem that
- # (int)1/120 = 0,
- # but
- # (int)-1/120 = -1
- # The following code ensure equal +/- behaviour.
- bind TtkScrollable <MouseWheel> {
- if {%D >= 0} {
- %W yview scroll [expr {-%D/120}] units
- } else {
- %W yview scroll [expr {(119-%D)/120}] units
- }
- }
- bind TtkScrollable <Shift-MouseWheel> {
- if {%D >= 0} {
- %W xview scroll [expr {-%D/120}] units
- } else {
- %W xview scroll [expr {(119-%D)/120}] units
- }
- }
-}
+bind TtkScrollable <MouseWheel> \
+ { tk::MouseWheel %W y %D }
+bind TtkScrollable <Option-MouseWheel> \
+ { tk::MouseWheel %W y %D -12.0 }
+bind TtkScrollable <Shift-MouseWheel> \
+ { tk::MouseWheel %W x %D }
+bind TtkScrollable <Shift-Option-MouseWheel> \
+ { tk::MouseWheel %W x %D -12.0 }
#*EOF*
diff --git a/library/ttk/vistaTheme.tcl b/library/ttk/vistaTheme.tcl
index 165b496..d841962 100644
--- a/library/ttk/vistaTheme.tcl
+++ b/library/ttk/vistaTheme.tcl
@@ -69,9 +69,9 @@ namespace eval ttk::theme::vista {
ttk::style layout TCombobox {
Combobox.border -sticky nswe -border 0 -children {
Combobox.rightdownarrow -side right -sticky ns
- Combobox.padding -expand 1 -sticky nswe -children {
+ Combobox.padding -sticky nswe -children {
Combobox.background -sticky nswe -children {
- Combobox.focus -expand 1 -sticky nswe -children {
+ Combobox.focus -sticky nswe -children {
Combobox.textarea -sticky nswe
}
}
@@ -138,7 +138,7 @@ namespace eval ttk::theme::vista {
Spinbox.background -sticky news -children {
Spinbox.padding -sticky news -children {
Spinbox.innerbg -sticky news -children {
- Spinbox.textarea -expand 1
+ Spinbox.textarea
}
}
Spinbox.uparrow -side top -sticky ens
@@ -203,8 +203,8 @@ namespace eval ttk::theme::vista {
TRACKBAR 3 {disabled 5 focus 4 pressed 3 active 2 {} 1} \
-width 6 -height 12
ttk::style layout Horizontal.TScale {
- Scale.focus -expand 1 -sticky nswe -children {
- Horizontal.Scale.trough -expand 1 -sticky nswe -children {
+ Scale.focus -sticky nswe -children {
+ Horizontal.Scale.trough -sticky nswe -children {
Horizontal.Scale.track -sticky we
Horizontal.Scale.slider -side left -sticky {}
}
@@ -214,8 +214,8 @@ namespace eval ttk::theme::vista {
TRACKBAR 6 {disabled 5 focus 4 pressed 3 active 2 {} 1} \
-width 12 -height 6
ttk::style layout Vertical.TScale {
- Scale.focus -expand 1 -sticky nswe -children {
- Vertical.Scale.trough -expand 1 -sticky nswe -children {
+ Scale.focus -sticky nswe -children {
+ Vertical.Scale.trough -sticky nswe -children {
Vertical.Scale.track -sticky ns
Vertical.Scale.slider -side top -sticky {}
}
diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl
index 0aaae38..71f3f1a 100644
--- a/library/xmfbox.tcl
+++ b/library/xmfbox.tcl
@@ -4,8 +4,8 @@
# Unix platform. This implementation is used only if the
# "::tk_strictMotif" flag is set.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 Scriptics Corporation
+# Copyright © 1996 Sun Microsystems, Inc.
+# Copyright © 1998-2000 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.