summaryrefslogtreecommitdiffstats
path: root/library/ttk/cursors.tcl
blob: 23198bdd0fa4f269f41c4169ebf5acdd68707756 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
#
# $Id: cursors.tcl,v 1.1.4.2 2010/08/26 02:06:10 hobbs Exp $
#
# Map symbolic cursor names to platform-appropriate cursors.
#
# 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

    # 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 {
		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
	    }
	}

	"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*