Viewing file:  cursors.tcl (3.91 KB) -rw-r--r--
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
#
# 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*
|