diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/ttk/cursors.tcl | 181 |
1 files changed, 167 insertions, 14 deletions
diff --git a/library/ttk/cursors.tcl b/library/ttk/cursors.tcl index a151194..f5abd54 100644 --- a/library/ttk/cursors.tcl +++ b/library/ttk/cursors.tcl @@ -1,35 +1,188 @@ # -# $Id: cursors.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# $Id: cursors.tcl,v 1.1.4.1 2009/04/10 16:39:47 das Exp $ # -# Ttk package: Symbolic cursor names. +# Map symbolic cursor names to platform-appropriate cursors. # -# @@@ TODO: Figure out appropriate platform-specific cursors -# for the various functions. +# 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 - switch -glob $::tcl_platform(platform) { - "windows" { + # 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 { - hresize sb_h_double_arrow - vresize sb_v_double_arrow + 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 } } - "unix" - - * { - array set Cursors { - hresize sb_h_double_arrow - vresize sb_v_double_arrow - seresize bottom_right_corner + "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* |