Import Tk 8.6.11

This commit is contained in:
Steve Dower
2021-03-30 00:54:10 +01:00
parent 42c69189d9
commit 070b8750b0
403 changed files with 21608 additions and 16269 deletions

View File

@@ -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
@@ -171,14 +171,21 @@ $c create text 28.5c 17.4c -text Scale: -anchor s
# Set up event bindings for canvas:
$c bind item <Any-Enter> "itemEnter $c"
$c bind item <Any-Leave> "itemLeave $c"
bind $c <2> "$c scan mark %x %y"
bind $c <B2-Motion> "$c scan dragto %x %y"
bind $c <3> "itemMark $c %x %y"
bind $c <B3-Motion> "itemStroke $c %x %y"
$c bind item <Enter> "itemEnter $c"
$c bind item <Leave> "itemLeave $c"
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 <1> "itemStartDrag $c %x %y"
bind $c <Button-1> "itemStartDrag $c %x %y"
bind $c <B1-Motion> "itemDrag $c %x %y"
# Utility procedures for highlighting the item under the pointer:
@@ -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
}
}