From 66cc8f9b15845d8a5470409603feec48ee347d5f Mon Sep 17 00:00:00 2001
From: jenglish <jenglish@flightlab.com>
Date: Tue, 28 Oct 2008 20:02:03 +0000
Subject: 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]
---
ChangeLog | 9 +++
library/ttk/combobox.tcl | 16 +++-
library/ttk/cursors.tcl | 181 ++++++++++++++++++++++++++++++++++++++++----
library/ttk/entry.tcl | 6 +-
library/ttk/panedwindow.tcl | 17 ++---
library/ttk/sizegrip.tcl | 14 +++-
library/ttk/treeview.tcl | 11 +--
7 files changed, 217 insertions(+), 37 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 22a6b31..a625bfc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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
}
--
cgit v0.12