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 .
]