Expanded set of symbolic cursors.

Add correct platform-specific cursors for OSX [Bug 2054562]
Use correct cursor for ttk::entry and ttk::combobox widgets [Bug 1534835]

6 files changed, 208 insertions, 37 deletions

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
 }