2 # Map symbolic cursor names to platform-appropriate cursors.
4 # The following cursors are defined:
6 # standard -- default cursor for most controls
7 # "" -- inherit cursor from parent window
10 # text -- editable widgets (entry, text)
11 # link -- hyperlinks within text
12 # crosshair -- graphic selection, fine control
13 # busy -- operation in progress
14 # forbidden -- action not allowed
16 # hresize -- horizontal resizing
17 # vresize -- vertical resizing
19 # Also resize cursors for each of the compass points,
20 # {nw,n,ne,w,e,sw,s,se}resize.
24 # Windows doesn't distinguish resizing at the 8 compass points,
25 # only horizontal, vertical, and the two diagonals.
27 # OSX doesn't have resize cursors for nw, ne, sw, or se corners.
28 # We use the Tk-defined X11 fallbacks for these.
30 # X11 doesn't have a "forbidden" cursor (usually a slashed circle);
31 # "pirate" seems to be the conventional cursor for this purpose.
33 # Windows has an IDC_HELP cursor, but it's not available from Tk.
35 # Tk does not support "none" on Windows.
42 # Use X11 cursor names as defaults, since Tk supplies these
56 hresize sb_h_double_arrow
57 vresize sb_v_double_arrow
63 nwresize top_left_corner
64 neresize top_right_corner
65 swresize bottom_left_corner
66 seresize bottom_right_corner
71 # Platform-specific overrides for Windows and OSX.
73 switch [tk windowingsystem] {
102 if {[package vsatisfies [package provide Tk] 8.5]} {
103 # appeared 2007-04-23, Tk 8.5a6
112 hresize resizeleftright
124 ## ttk::cursor $cursor --
125 # Return platform-specific cursor for specified symbolic cursor.
127 proc ttk::cursor {name} {
129 return $Cursors($name)
132 ## ttk::setCursor $w $cursor --
133 # Set the cursor for specified window.
135 # [ttk::setCursor] should be used in <Motion> bindings
136 # instead of directly calling [$w configure -cursor ...],
137 # as the latter always incurs a server round-trip and
138 # can lead to high CPU load (see [#1184746])
141 proc ttk::setCursor {w name} {
143 if {[$w cget -cursor] ne $Cursors($name)} {
144 $w configure -cursor $Cursors($name)
148 ## Interactive test harness:
150 proc ttk::CursorSampler {f} {
155 {nwresize nresize neresize}
156 { wresize move eresize}
157 {swresize sresize seresize}
158 {text link crosshair}
164 foreach cursor $row {
166 ttk::label $w -text $cursor -cursor [ttk::cursor $cursor] \
167 -relief solid -borderwidth 1 -padding 3
168 grid $w -row $r -column $c -sticky nswe
169 grid columnconfigure $f $c -uniform cols -weight 1
172 grid rowconfigure $f $r -uniform rows -weight 1
179 if {[info exists argv0] && $argv0 eq [info script]} {
180 wm title . "[array size ::ttk::Cursors] cursors"
181 pack [ttk::CursorSampler .f] -expand true -fill both
182 bind . <KeyPress-Escape> [list destroy .]