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