From 3c51939b4ba5c06f904a8d502f76c10c979acde9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 21 Sep 2020 14:54:14 +0000 Subject: Make demo's like floor/items/ctext behave the same on MacOS as other platforms: Switch between buttons 2/3 platform-based. More demo cleanups, nothing functional --- library/demos/arrow.tcl | 8 ++++---- library/demos/bind.tcl | 16 ++++++++-------- library/demos/colors.tcl | 2 +- library/demos/cscroll.tcl | 44 +++++++++++++++++++++++++++++++++----------- library/demos/ctext.tcl | 6 +++++- library/demos/floor.tcl | 15 ++++++++++----- library/demos/image2.tcl | 2 +- library/demos/items.tcl | 23 +++++++++++++++-------- library/demos/ixset | 2 +- library/demos/pendulum.tcl | 2 +- library/demos/plot.tcl | 6 +++--- library/demos/ruler.tcl | 6 +++--- library/demos/square | 2 +- library/demos/tcolor | 2 +- library/demos/twind.tcl | 6 +++--- 15 files changed, 90 insertions(+), 52 deletions(-) diff --git a/library/demos/arrow.tcl b/library/demos/arrow.tcl index 12249c0..3d0b406 100644 --- a/library/demos/arrow.tcl +++ b/library/demos/arrow.tcl @@ -154,11 +154,11 @@ $c bind box "$c itemconfigure current $demo_arrowInfo(activeStyle)" $c bind box "$c itemconfigure current $demo_arrowInfo(boxStyle)" $c bind box " " $c bind box " " -$c bind box1 <1> {set demo_arrowInfo(motionProc) arrowMove1} -$c bind box2 <1> {set demo_arrowInfo(motionProc) arrowMove2} -$c bind box3 <1> {set demo_arrowInfo(motionProc) arrowMove3} +$c bind box1 {set demo_arrowInfo(motionProc) arrowMove1} +$c bind box2 {set demo_arrowInfo(motionProc) arrowMove2} +$c bind box3 {set demo_arrowInfo(motionProc) arrowMove3} $c bind box "\$demo_arrowInfo(motionProc) $c %x %y" -bind $c "arrowSetup $c" +bind $c "arrowSetup $c" # arrowMove1 -- # This procedure is called for each mouse motion event on box1 (the diff --git a/library/demos/bind.tcl b/library/demos/bind.tcl index 03f6d3b..9146362 100644 --- a/library/demos/bind.tcl +++ b/library/demos/bind.tcl @@ -63,16 +63,16 @@ $w.text insert end \ # Create bindings for tags. foreach tag {d1 d2 d3 d4 d5 d6} { - $w.text tag bind $tag "$w.text tag configure $tag $bold" - $w.text tag bind $tag "$w.text tag configure $tag $normal" + $w.text tag bind $tag "$w.text tag configure $tag $bold" + $w.text tag bind $tag "$w.text tag configure $tag $normal" } # Main widget program sets variable tk_demoDirectory -$w.text tag bind d1 <1> {source [file join $tk_demoDirectory items.tcl]} -$w.text tag bind d2 <1> {source [file join $tk_demoDirectory plot.tcl]} -$w.text tag bind d3 <1> {source [file join $tk_demoDirectory ctext.tcl]} -$w.text tag bind d4 <1> {source [file join $tk_demoDirectory arrow.tcl]} -$w.text tag bind d5 <1> {source [file join $tk_demoDirectory ruler.tcl]} -$w.text tag bind d6 <1> {source [file join $tk_demoDirectory cscroll.tcl]} +$w.text tag bind d1 {source [file join $tk_demoDirectory items.tcl]} +$w.text tag bind d2 {source [file join $tk_demoDirectory plot.tcl]} +$w.text tag bind d3 {source [file join $tk_demoDirectory ctext.tcl]} +$w.text tag bind d4 {source [file join $tk_demoDirectory arrow.tcl]} +$w.text tag bind d5 {source [file join $tk_demoDirectory ruler.tcl]} +$w.text tag bind d6 {source [file join $tk_demoDirectory cscroll.tcl]} $w.text mark set insert 0.0 $w.text configure -state disabled diff --git a/library/demos/colors.tcl b/library/demos/colors.tcl index 99dec92..fdfdc5b 100644 --- a/library/demos/colors.tcl +++ b/library/demos/colors.tcl @@ -32,7 +32,7 @@ listbox $w.frame.list -yscroll "$w.frame.scroll set" \ -width 20 -height 16 -setgrid 1 pack $w.frame.list $w.frame.scroll -side left -fill y -expand 1 -bind $w.frame.list { +bind $w.frame.list { tk_setPalette [selection get] } $w.frame.list insert 0 gray60 gray70 gray80 gray85 gray90 gray95 \ diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index 443b102..f64ca5d 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -53,12 +53,12 @@ for {set i 0} {$i < 20} {incr i} { } } -$c bind all "scrollEnter $c" -$c bind all "scrollLeave $c" -$c bind all <1> "scrollButton $c" -bind $c <2> "$c scan mark %x %y" -bind $c "$c scan dragto %x %y" +$c bind all "scrollEnter $c" +$c bind all "scrollLeave $c" +$c bind all "scrollButton $c" if {[tk windowingsystem] eq "aqua"} { + bind $c "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" bind $c { %W yview scroll [expr {-(%D)}] units } @@ -72,11 +72,33 @@ if {[tk windowingsystem] eq "aqua"} { %W xview scroll [expr {-10 * (%D)}] units } } else { + bind $c "$c scan mark %x %y" + bind $c "$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, + # but + # (int)-1/30 = -1 + # The following code ensure equal +/- behaviour. bind $c { - %W yview scroll [expr {-(%D / 30)}] units + if {%D >= 0} { + %W yview scroll [expr {%D/-30}] units + } else { + %W yview scroll [expr {(%D-29)/-30}] units + } + } + bind $c { + %W yview scroll [expr {%D/-3}] units } bind $c { - %W xview scroll [expr {-(%D / 30)}] units + if {%D >= 0} { + %W xview scroll [expr {%D/-30}] units + } else { + %W xview scroll [expr {(%D-29)/-30}] units + } + } + bind $c { + %W xview scroll [expr {%D/-3}] units } } @@ -85,22 +107,22 @@ if {[tk windowingsystem] eq "x11"} { # the wheel to the extended buttons. If you have a mousewheel, find # Linux configuration info at: # http://linuxreviews.org/howtos/xfree/mouse/ - bind $c <4> { + bind $c { if {!$tk_strictMotif} { %W yview scroll -5 units } } - bind $c { + bind $c { if {!$tk_strictMotif} { %W xview scroll -5 units } } - bind $c <5> { + bind $c { if {!$tk_strictMotif} { %W yview scroll 5 units } } - bind $c { + bind $c { if {!$tk_strictMotif} { %W xview scroll 5 units } diff --git a/library/demos/ctext.tcl b/library/demos/ctext.tcl index 502c9d0..5acc82f 100644 --- a/library/demos/ctext.tcl +++ b/library/demos/ctext.tcl @@ -50,7 +50,11 @@ $c bind text "textInsert $c \\n" $c bind text "textBs $c" $c bind text "textBs $c" $c bind text "textDel $c" -$c bind text "textPaste $c @%x,%y" +if {[tk windowingsystem] eq "aqua"} { + $c bind text "textPaste $c @%x,%y" +} else { + $c bind text "textPaste $c @%x,%y" +} # Next, create some items that allow the text's anchor position # to be edited. diff --git a/library/demos/floor.tcl b/library/demos/floor.tcl index d5ef3a0..37e1b95 100644 --- a/library/demos/floor.tcl +++ b/library/demos/floor.tcl @@ -1354,13 +1354,18 @@ floorDisplay $c 3 # Set up event bindings for canvas: -$c bind floor1 <1> "floorDisplay $c 1" -$c bind floor2 <1> "floorDisplay $c 2" -$c bind floor3 <1> "floorDisplay $c 3" +$c bind floor1 "floorDisplay $c 1" +$c bind floor2 "floorDisplay $c 2" +$c bind floor3 "floorDisplay $c 3" $c bind room "newRoom $c" $c bind room {set currentRoom ""} -bind $c <2> "$c scan mark %x %y" -bind $c "$c scan dragto %x %y" +if {[tk windowingsystem] eq "aqua"} { + bind $c "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" +} else { + bind $c "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" +} bind $c "unset currentRoom" set currentRoom "" trace variable currentRoom w "roomChanged $c" diff --git a/library/demos/image2.tcl b/library/demos/image2.tcl index 2d7ba03..7af52be 100644 --- a/library/demos/image2.tcl +++ b/library/demos/image2.tcl @@ -95,7 +95,7 @@ listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set" ttk::scrollbar $w.f.scroll -command "$w.f.list yview" pack $w.f.list $w.f.scroll -side left -fill y -expand 1 $w.f.list insert 0 earth.gif earthris.gif teapot.ppm -bind $w.f.list "loadImage $w %x %y" +bind $w.f.list "loadImage $w %x %y" catch {image delete image2a} image create photo image2a diff --git a/library/demos/items.tcl b/library/demos/items.tcl index c3e14c1..545877c 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 @@ -171,14 +171,21 @@ $c create text 28.5c 17.4c -text Scale: -anchor s # Set up event bindings for canvas: -$c bind item "itemEnter $c" -$c bind item "itemLeave $c" -bind $c <2> "$c scan mark %x %y" -bind $c "$c scan dragto %x %y" -bind $c <3> "itemMark $c %x %y" -bind $c "itemStroke $c %x %y" +$c bind item "itemEnter $c" +$c bind item "itemLeave $c" +if {[tk windowingsystem] eq "aqua"} { + bind $c "itemMark $c %x %y" + bind $c "itemStroke $c %x %y" + bind $c "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" +} else { + bind $c "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" + bind $c "itemMark $c %x %y" + bind $c "itemStroke $c %x %y" +} bind $c <> "itemsUnderArea $c" -bind $c <1> "itemStartDrag $c %x %y" +bind $c "itemStartDrag $c %x %y" bind $c "itemDrag $c %x %y" # Utility procedures for highlighting the item under the pointer: diff --git a/library/demos/ixset b/library/demos/ixset index 7cc35aa..85664d9 100644 --- a/library/demos/ixset +++ b/library/demos/ixset @@ -197,7 +197,7 @@ proc createwindows {} { bind . {.buttons.ok flash; .buttons.ok invoke} bind . {.buttons.quit flash; .buttons.quit invoke} - bind . <1> { + bind . { if {![string match .buttons* %W]} { .buttons.apply configure -state normal .buttons.cancel configure -state normal diff --git a/library/demos/pendulum.tcl b/library/demos/pendulum.tcl index 6422c67..9833e8f 100644 --- a/library/demos/pendulum.tcl +++ b/library/demos/pendulum.tcl @@ -113,7 +113,7 @@ bind $w.c { after cancel $animationCallbacks(pendulum) unset animationCallbacks(pendulum) } -bind $w.c <1> { +bind $w.c { after cancel $animationCallbacks(pendulum) showPendulum %W at %x %y } diff --git a/library/demos/plot.tcl b/library/demos/plot.tcl index e7f0361..453b7a6 100644 --- a/library/demos/plot.tcl +++ b/library/demos/plot.tcl @@ -55,9 +55,9 @@ foreach point { $c addtag point withtag $item } -$c bind point "$c itemconfig current -fill red" -$c bind point "$c itemconfig current -fill SkyBlue2" -$c bind point <1> "plotDown $c %x %y" +$c bind point "$c itemconfig current -fill red" +$c bind point "$c itemconfig current -fill SkyBlue2" +$c bind point "plotDown $c %x %y" $c bind point "$c dtag selected" bind $c "plotMove $c %x %y" diff --git a/library/demos/ruler.tcl b/library/demos/ruler.tcl index f7bc37b..0b78370 100644 --- a/library/demos/ruler.tcl +++ b/library/demos/ruler.tcl @@ -77,10 +77,10 @@ $c addtag well withtag [$c create rect 13.2c 1c 13.8c 0.5c \ $c addtag well withtag [rulerMkTab $c [winfo pixels $c 13.5c] \ [winfo pixels $c .65c]] -$c bind well <1> "rulerNewTab $c %x %y" -$c bind tab <1> "rulerSelectTab $c %x %y" +$c bind well "rulerNewTab $c %x %y" +$c bind tab "rulerSelectTab $c %x %y" bind $c "rulerMoveTab $c %x %y" -bind $c "rulerReleaseTab $c" +bind $c "rulerReleaseTab $c" # rulerNewTab -- # Does all the work of creating a tab stop, including creating the diff --git a/library/demos/square b/library/demos/square index 6ce91b8..9f200ba 100644 --- a/library/demos/square +++ b/library/demos/square @@ -18,7 +18,7 @@ square .s pack .s -expand yes -fill both wm minsize . 1 1 -bind .s <1> {center %x %y} +bind .s {center %x %y} bind .s {center %x %y} bind .s a animate focus .s diff --git a/library/demos/tcolor b/library/demos/tcolor index d8067cc..0aa133b 100644 --- a/library/demos/tcolor +++ b/library/demos/tcolor @@ -90,7 +90,7 @@ foreach i { grid columnconfigure . 0 -weight 1 listbox .names.lb -width 20 -height 12 -yscrollcommand ".names.s set" \ -exportselection false - bind .names.lb { + bind .names.lb { tc_loadNamedColor [.names.lb get [.names.lb curselection]] } scrollbar .names.s -orient vertical -command ".names.lb yview" diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index 45d1da8..74f11eb 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -265,9 +265,9 @@ proc createPlot {t} { $c addtag point withtag $item } - $c bind point "$c itemconfig current -fill red" - $c bind point "$c itemconfig current -fill SkyBlue2" - $c bind point <1> "embPlotDown $c %x %y" + $c bind point "$c itemconfig current -fill red" + $c bind point "$c itemconfig current -fill SkyBlue2" + $c bind point "embPlotDown $c %x %y" $c bind point "$c dtag selected" bind $c "embPlotMove $c %x %y" return $c -- cgit v0.12