diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | library/ttk/combobox.tcl | 16 | ||||
| -rw-r--r-- | library/ttk/cursors.tcl | 181 | ||||
| -rw-r--r-- | library/ttk/entry.tcl | 6 | ||||
| -rw-r--r-- | library/ttk/panedwindow.tcl | 17 | ||||
| -rw-r--r-- | library/ttk/sizegrip.tcl | 14 | ||||
| -rw-r--r-- | library/ttk/treeview.tcl | 11 |
7 files changed, 217 insertions, 37 deletions
@@ -1,3 +1,12 @@ +2008-10-28 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/cursors.tcl, library/ttk/combobox.tcl, + library/ttk/entry.tcl, library/ttk/paned.tcl, library/ttk/sizegrip.tcl, + library/treeview.tcl: + Add correct platform-specific cursors for OSX [Bug 2054562] + Expanded set of symbolic cursors. Use correct cursor for + ttk::entry and ttk::combobox widgets [Bug 1534835] + 2008-10-28 Don Porter <dgp@users.sourceforge.net> * win/tkWinTest.c: Revise [testclipboard] to form that diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl index 2f4838f..1cb325c 100644 --- a/library/ttk/combobox.tcl +++ b/library/ttk/combobox.tcl @@ -1,5 +1,5 @@ # -# $Id: combobox.tcl,v 1.12 2008/02/23 18:41:07 jenglish Exp $ +# $Id: combobox.tcl,v 1.13 2008/10/28 20:02:03 jenglish Exp $ # # Combobox bindings. # @@ -60,6 +60,7 @@ bind TCombobox <Shift-ButtonPress-1> { ttk::combobox::Press "s" %W %x %y } bind TCombobox <Double-ButtonPress-1> { ttk::combobox::Press "2" %W %x %y } bind TCombobox <Triple-ButtonPress-1> { ttk::combobox::Press "3" %W %x %y } bind TCombobox <B1-Motion> { ttk::combobox::Drag %W %x } +bind TCombobox <Motion> { ttk::combobox::Motion %W %x %y } bind TCombobox <MouseWheel> { ttk::combobox::Scroll %W [expr {%D/-120}] } if {[tk windowingsystem] eq "x11"} { @@ -152,6 +153,19 @@ proc ttk::combobox::Drag {w x} { } } +## Motion -- +# Set cursor. +# +proc ttk::combobox::Motion {w x y} { + if { [$w identify $x $y] eq "textarea" + && [$w instate {!readonly !disabled}] + } { + ttk::setCursor $w text + } else { + ttk::setCursor $w "" + } +} + ## TraverseIn -- receive focus due to keyboard navigation # For editable comboboxes, set the selection and insert cursor. # diff --git a/library/ttk/cursors.tcl b/library/ttk/cursors.tcl index a151194..8620098 100644 --- a/library/ttk/cursors.tcl +++ b/library/ttk/cursors.tcl @@ -1,35 +1,188 @@ # -# $Id: cursors.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# $Id: cursors.tcl,v 1.2 2008/10/28 20:02:03 jenglish Exp $ # -# Ttk package: Symbolic cursor names. +# Map symbolic cursor names to platform-appropriate cursors. # -# @@@ TODO: Figure out appropriate platform-specific cursors -# for the various functions. +# The following cursors are defined: +# +# standard -- default cursor for most controls +# "" -- inherit cursor from parent window +# none -- no cursor +# +# text -- editable widgets (entry, text) +# link -- hyperlinks within text +# crosshair -- graphic selection, fine control +# busy -- operation in progress +# forbidden -- action not allowed +# +# hresize -- horizontal resizing +# vresize -- vertical resizing +# +# Also resize cursors for each of the compass points, +# {nw,n,ne,w,e,sw,s,se}resize. +# +# Platform notes: +# +# Windows doesn't distinguish resizing at the 8 compass points, +# only horizontal, vertical, and the two diagonals. +# +# OSX doesn't have resize cursors for nw, ne, sw, or se corners. +# We use the Tk-defined X11 fallbacks for these. +# +# X11 doesn't have a "forbidden" cursor (usually a slashed circle); +# "pirate" seems to be the conventional cursor for this purpose. +# +# Windows has an IDC_HELP cursor, but it's not available from Tk. +# +# Tk does not support "none" on Windows. # namespace eval ttk { variable Cursors - switch -glob $::tcl_platform(platform) { - "windows" { + # Use X11 cursor names as defaults, since Tk supplies these + # on all platforms. + # + array set Cursors { + "" "" + none none + + standard left_ptr + text xterm + link hand2 + crosshair crosshair + busy watch + forbidden pirate + + hresize sb_h_double_arrow + vresize sb_v_double_arrow + + nresize top_side + sresize bottom_side + wresize left_side + eresize right_side + nwresize top_left_corner + neresize top_right_corner + swresize bottom_left_corner + seresize bottom_right_corner + move fleur + + } + + # Platform-specific overrides for Windows and OSX. + # + switch [tk windowingsystem] { + "win32" { array set Cursors { - hresize sb_h_double_arrow - vresize sb_v_double_arrow + none {} + + standard arrow + text ibeam + link hand2 + crosshair crosshair + busy wait + forbidden no + + vresize size_ns + nresize size_ns + sresize size_ns + + wresize size_we + eresize size_we + hresize size_we + + nwresize size_nw_se + swresize size_ne_sw + + neresize size_ne_sw seresize size_nw_se } } - "unix" - - * { - array set Cursors { - hresize sb_h_double_arrow - vresize sb_v_double_arrow - seresize bottom_right_corner + "aqua" { + if {[package vsatisfies [package provide Tk] 8.5]} { + # appeared 2007-04-23, Tk 8.5a6 + array set Cursors { + standard arrow + text ibeam + link pointinghand + crosshair crosshair + busy watch + forbidden notallowed + + hresize resizeleftright + vresize resizeupdown + nresize resizeup + sresize resizedown + wresize resizeleft + eresize resizeright + } } } + } +} + +## ttk::cursor $cursor -- +# Return platform-specific cursor for specified symbolic cursor. +# +proc ttk::cursor {name} { + variable Cursors + return $Cursors($name) +} + +## ttk::setCursor $w $cursor -- +# Set the cursor for specified window. +# +# [ttk::setCursor] should be used in <Motion> bindings +# instead of directly calling [$w configure -cursor ...], +# as the latter always incurs a server round-trip and +# can lead to high CPU load (see [#1184746]) +# +proc ttk::setCursor {w name} { + variable Cursors + if {[$w cget -cursor] ne $Cursors($name)} { + $w configure -cursor $Cursors($name) + } +} + +## Interactive test harness: +# +proc ttk::CursorSampler {f} { + ttk::frame $f + + set r 0 + foreach row { + {nwresize nresize neresize} + { wresize move eresize} + {swresize sresize seresize} + {text link crosshair} + {hresize vresize ""} + {busy forbidden ""} + {none standard ""} + } { + set c 0 + foreach cursor $row { + set w $f.${r}${c} + ttk::label $w -text $cursor -cursor [ttk::cursor $cursor] \ + -relief solid -borderwidth 1 -padding 3 + grid $w -row $r -column $c -sticky nswe + grid columnconfigure $f $c -uniform cols -weight 1 + incr c + } + grid rowconfigure $f $r -uniform rows -weight 1 + incr r } + + return $f +} + +if {[info exists argv0] && $argv0 eq [info script]} { + wm title . "[array size ::ttk::Cursors] cursors" + pack [ttk::CursorSampler .f] -expand true -fill both + bind . <KeyPress-Escape> [list destroy .] + focus .f } #*EOF* diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index 37a2419..360954e 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -1,5 +1,5 @@ # -# $Id: entry.tcl,v 1.4 2007/12/13 15:27:08 dgp Exp $ +# $Id: entry.tcl,v 1.5 2008/10/28 20:02:03 jenglish Exp $ # # DERIVED FROM: tk/library/entry.tcl r1.22 # @@ -34,6 +34,10 @@ namespace eval ttk { } } +### Option database settings. +# +option add *TEntry.cursor [ttk::cursor text] + ### Bindings. # # Removed the following standard Tk bindings: diff --git a/library/ttk/panedwindow.tcl b/library/ttk/panedwindow.tcl index 423baa9..60d08be 100644 --- a/library/ttk/panedwindow.tcl +++ b/library/ttk/panedwindow.tcl @@ -1,5 +1,5 @@ # -# $Id: panedwindow.tcl,v 1.5 2007/12/13 15:27:08 dgp Exp $ +# $Id: panedwindow.tcl,v 1.6 2008/10/28 20:02:03 jenglish Exp $ # # Bindings for ttk::panedwindow widget. # @@ -27,7 +27,6 @@ bind TPanedwindow <Leave> { ttk::panedwindow::ResetCursor %W } # See <<NOTE-PW-LEAVE-NOTIFYINFERIOR>> bind TPanedwindow <<EnteredChild>> { ttk::panedwindow::ResetCursor %W } - ## Sash movement: # proc ttk::panedwindow::Press {w x y} { @@ -66,22 +65,20 @@ proc ttk::panedwindow::Release {w x y} { proc ttk::panedwindow::ResetCursor {w} { variable State if {!$State(pressed)} { - $w configure -cursor {} + ttk::setCursor $w {} } } proc ttk::panedwindow::SetCursor {w x y} { - variable ::ttk::Cursors - - if {![llength [$w identify $x $y]]} { - ResetCursor $w - } else { + set cursor "" + if {[llength [$w identify $x $y]]} { # Assume we're over a sash. switch -- [$w cget -orient] { - horizontal { $w configure -cursor $Cursors(hresize) } - vertical { $w configure -cursor $Cursors(vresize) } + horizontal { set cursor hresize } + vertical { set cursor vresize } } } + ttk::setCursor $w $cursor } #*EOF* diff --git a/library/ttk/sizegrip.tcl b/library/ttk/sizegrip.tcl index 51667dd..a191b1f 100644 --- a/library/ttk/sizegrip.tcl +++ b/library/ttk/sizegrip.tcl @@ -1,14 +1,22 @@ # -# $Id: sizegrip.tcl,v 1.2 2008/04/04 14:18:30 patthoyts Exp $ +# $Id: sizegrip.tcl,v 1.3 2008/10/28 20:02:03 jenglish Exp $ # -# Ttk widget set -- sizegrip widget bindings. +# Sizegrip widget bindings. # # Dragging a sizegrip widget resizes the containing toplevel. # # NOTE: the sizegrip widget must be in the lower right hand corner. # -option add *TSizegrip.cursor $::ttk::Cursors(seresize) +switch -- [tk windowingsystem] { + x11 - + win32 { + option add *TSizegrip.cursor [ttk::cursor seresize] + } + aqua { + # Aqua sizegrips use default Arrow cursor. + } +} namespace eval ttk::sizegrip { variable State diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl index 608cdf2..575769a 100644 --- a/library/ttk/treeview.tcl +++ b/library/ttk/treeview.tcl @@ -1,4 +1,4 @@ -# $Id: treeview.tcl,v 1.6 2008/05/23 20:20:06 jenglish Exp $ +# $Id: treeview.tcl,v 1.7 2008/10/28 20:02:03 jenglish Exp $ # # ttk::treeview widget bindings and utilities. # @@ -103,20 +103,15 @@ proc ttk::treeview::Keynav {w dir} { # Sets cursor, active element ... # proc ttk::treeview::Motion {w x y} { - variable ::ttk::Cursors - variable State - set cursor {} set activeHeading {} switch -- [$w identify region $x $y] { - separator { set cursor $Cursors(hresize) } + separator { set cursor hresize } heading { set activeHeading [$w identify column $x $y] } } - if {[$w cget -cursor] ne $cursor} { - $w configure -cursor $cursor - } + ttk::setCursor $w $cursor ActivateHeading $w $activeHeading } |