123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186 |
- #
- # 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*
|