1#
2# $Id$
3#
4# Map symbolic cursor names to platform-appropriate cursors.
5#
6# The following cursors are defined:
7#
8#	standard	-- default cursor for most controls
9#	""		-- inherit cursor from parent window
10#	none		-- no cursor
11#
12#	text		-- editable widgets (entry, text)
13#	link		-- hyperlinks within text
14#	crosshair	-- graphic selection, fine control
15#	busy		-- operation in progress
16#	forbidden	-- action not allowed
17#
18#	hresize		-- horizontal resizing
19#	vresize		-- vertical resizing
20#
21# Also resize cursors for each of the compass points,
22# {nw,n,ne,w,e,sw,s,se}resize.
23#
24# Platform notes:
25#
26# Windows doesn't distinguish resizing at the 8 compass points,
27# only horizontal, vertical, and the two diagonals.
28#
29# OSX doesn't have resize cursors for nw, ne, sw, or se corners.
30# We use the Tk-defined X11 fallbacks for these.
31#
32# X11 doesn't have a "forbidden" cursor (usually a slashed circle);
33# "pirate" seems to be the conventional cursor for this purpose.
34#
35# Windows has an IDC_HELP cursor, but it's not available from Tk.
36#
37# Tk does not support "none" on Windows.
38#
39
40namespace eval ttk {
41
42    variable Cursors
43
44    # Use X11 cursor names as defaults, since Tk supplies these
45    # on all platforms.
46    #
47    array set Cursors {
48	""		""
49	none		none
50
51	standard	left_ptr
52	text 		xterm
53	link		hand2
54	crosshair	crosshair
55	busy		watch
56	forbidden	pirate
57
58	hresize 	sb_h_double_arrow
59	vresize 	sb_v_double_arrow
60
61	nresize 	top_side
62	sresize 	bottom_side
63	wresize 	left_side
64	eresize 	right_side
65	nwresize	top_left_corner
66	neresize	top_right_corner
67	swresize	bottom_left_corner
68	seresize	bottom_right_corner
69	move		fleur
70
71    }
72
73    # Platform-specific overrides for Windows and OSX.
74    #
75    switch [tk windowingsystem] {
76	"win32" {
77	    array set Cursors {
78		none		{}
79
80		standard	arrow
81		text		ibeam
82		link		hand2
83		crosshair	crosshair
84		busy		wait
85		forbidden	no
86
87		vresize 	size_ns
88		nresize 	size_ns
89		sresize		size_ns
90
91		wresize		size_we
92		eresize		size_we
93		hresize 	size_we
94
95		nwresize	size_nw_se
96		swresize	size_ne_sw
97
98		neresize	size_ne_sw
99		seresize	size_nw_se
100	    }
101	}
102
103	"aqua" {
104	    if {[package vsatisfies [package provide Tk] 8.5]} {
105		# appeared 2007-04-23, Tk 8.5a6
106		array set Cursors {
107		    standard	arrow
108		    text 	ibeam
109		    link	pointinghand
110		    crosshair	crosshair
111		    busy	watch
112		    forbidden	notallowed
113
114		    hresize 	resizeleftright
115		    vresize 	resizeupdown
116		    nresize	resizeup
117		    sresize	resizedown
118		    wresize	resizeleft
119		    eresize	resizeright
120		}
121	    }
122	}
123    }
124}
125
126## ttk::cursor $cursor --
127#	Return platform-specific cursor for specified symbolic cursor.
128#
129proc ttk::cursor {name} {
130    variable Cursors
131    return $Cursors($name)
132}
133
134## ttk::setCursor $w $cursor --
135#	Set the cursor for specified window.
136#
137# [ttk::setCursor] should be used in <Motion> bindings
138# instead of directly calling [$w configure -cursor ...],
139# as the latter always incurs a server round-trip and
140# can lead to high CPU load (see [#1184746])
141#
142
143proc ttk::setCursor {w name} {
144    variable Cursors
145    if {[$w cget -cursor] ne $Cursors($name)} {
146	$w configure -cursor $Cursors($name)
147    }
148}
149
150## Interactive test harness:
151#
152proc ttk::CursorSampler {f} {
153    ttk::frame $f
154
155    set r 0
156    foreach row {
157	{nwresize nresize   neresize}
158	{ wresize move       eresize}
159	{swresize sresize   seresize}
160	{text link crosshair}
161	{hresize vresize ""}
162	{busy forbidden ""}
163	{none standard ""}
164    } {
165	set c 0
166	foreach cursor $row {
167	    set w $f.${r}${c}
168	    ttk::label $w -text $cursor -cursor [ttk::cursor $cursor] \
169		-relief solid -borderwidth 1 -padding 3
170	    grid $w -row $r -column $c -sticky nswe
171	    grid columnconfigure $f $c -uniform cols -weight 1
172	    incr c
173	}
174	grid rowconfigure $f $r -uniform rows -weight 1
175	incr r
176    }
177
178    return $f
179}
180
181if {[info exists argv0] && $argv0 eq [info script]} {
182    wm title . "[array size ::ttk::Cursors] cursors"
183    pack [ttk::CursorSampler .f] -expand true -fill both
184    bind . <KeyPress-Escape> [list destroy .]
185    focus .f
186}
187
188#*EOF*
189