Lines Matching defs:cursor
0 # cursor.tcl --
3 # Tk cursor handling routines
10 # RCS: @(#) $Id: cursor.tcl,v 1.3 2009/04/24 22:03:48 hobbs Exp $
13 package provide cursor 0.3
15 namespace eval ::cursor {
19 # megawidgets that will self-propagate cursor changes down.
52 # ::cursor::propagate --
54 # Propagates a cursor to a widget and all descendants.
57 # w Parent widget to set cursor on (includes children)
58 # cursor The cursor to use
61 # Set the cursor of $w and all descendants to $cursor
63 proc ::cursor::propagate {w cursor} {
66 # Ignores {} cursors or widgets that don't have a -cursor option
67 if {![catch {set CURSOR($w) [$w cget -cursor]}] && $CURSOR($w) != ""} {
68 $w config -cursor $cursor
72 foreach child [winfo children $w] { propagate $child $cursor }
75 # ::cursor::restore --
77 # Restores original cursor of a widget and all descendants.
80 # w Parent widget to restore cursor for (includes children)
81 # cursor The default cursor to use (if none was cached by propagate)
84 # Restore the cursor of $w and all descendants
86 proc ::cursor::restore {w {cursor {}}} {
91 foreach child [winfo children $w] { restore $child $cursor }
94 $w config -cursor $CURSOR($w)
96 # Not all widgets have -cursor
97 catch {$w config -cursor $cursor}
100 foreach child [winfo children $w] { restore $child $cursor }
105 # ::cursor::display --
115 proc ::cursor::display {{root .}} {
125 label $t.lbl -text "Select a cursor:" -anchor w
134 bind $t.lb <Button-1> { %W config -cursor [%W get [%W nearest %y]] }