http://purl.org/tcl/home/man/tcl8.4/TkCmd/cursors.htm


How would one script things to '''dynamically''' provide the user with the range of cursors available on their platform?
[[aka a tk_chooseCursors that works '''dynamically''' for the platform,
and includes hopefully application/user defined cursors]]

[LV]: The answer (based on the suggestions below) to the above question is ''you can't do this at this time''.  Perhaps someone will [TIP] something up.  This is just another of those areas where [Tk] surprises developers in a disappointing manner.

'''How would one go about defining a new cursor via Tk scripting?'''


----
[SO] Oct 12, 2001 - A minimalist tk script that displays the
77 cross-platform cursors in a listbox, and configures the
label above the listbox to use the currently selected cursor:
----
 set cursors {arrow based_arrow_down based_arrow_up boat bogosity\
 bottom_left_corner bottom_right_corner bottom_side bottom_tee\
 box_spiral center_ptr circle clock coffee_mug cross cross_reverse\
 crosshair diamond_cross dot dotbox double_arrow draft_large\
 draft_small draped_box exchange fleur gobbler gumby hand1\
 hand2 heart icon iron_cross left_ptr left_side left_tee leftbutton\
 ll_angle lr_angle man middlebutton mouse pencil pirate plus\
 question_arrow right_ptr right_side right_tee rightbutton rtl_logo\
 sailboat sb_down_arrow sb_h_double_arrow sb_left_arrow\
 sb_right_arrow sb_up_arrow sb_v_double_arrow shuttle sizing\
 spider spraycan star target tcross top_left_arrow top_left_corner\
 top_right_corner top_side top_tee trek ul_angle umbrella ur_angle\
 watch X_cursor xterm}

 listbox .list -width 20 -height 10 -bg white -selectmode single -yscrollcommand ".scroll set"  
 scrollbar .scroll -command ".list yview"

 foreach index $cursors {
	.list insert end $index
	}

 frame .top
 label .top.label -textvariable current -width 20 -relief groove

 set current [.list get active]

 bind .list <ButtonRelease-1> {config}

 proc config { } {
 	global current cursors
 	set idx [.list curselection]
	set current [lindex $cursors $idx]
	.top.label configure -cursor $current
 	return $current
  }

 pack .top
 pack .top.label
 pack .scroll -side right -fill y
 pack .list -side left -expand 1 -fill both 

 wm title . "Cursors"
----

From a subsequent discussion in the [Tcl chatroom]:

suchenwi: Steve: another style note - as the window title goes on top of the window, I like to place the "wm title . ..." command also high on top. 

A more general note: the script works as written, but for clearer code, I would structure it as follows: 
 proc main {} {...} 
 proc config {} {...} 
 main 

For this one-page script the flat code is no problem. But if it gets longer, the context is not so clear to see - better break it in procs not longer than half a page each. Also, this way you have to register the globals that you need (not using globals is of course better ;-) 

For instance, a listbox with a scrollbar is such a frequent component that it may be worth putting into a proc, which creates a frame and packs/grids the listbox and the scrollbar. 

On toplevel you then have only two widgets to pack, the label and the lbframe, so you can use the idiom 
 eval pack [winfo children .] 
which removes the need of changing two places when you add or remove other widgets. 

This is one thing I dislike about Tk - definition and management of a widget in two distinct places. 
In simple cases, I help myself with 
 pack [text .t ...] 
 pack [canvas .c ...] 
..and the "eval pack [[winfo children ..]]" trick for more complex layouts. 
That relieves you of the need to know what children "." has, because it knows itself - the power of introspection... 

----
Here is another variant of a cursor viewer from [Reinhard Max].

It looks up the cursor names in the respective header file (works on Linux, but should be OK for other *nixes, too), and creates a table of labels which show the cursor names and have the respective cursors bound to them.

 proc main {} {
    set fd [open /usr/X11R6/include/X11/cursorfont.h r]
    set i 0
    while {[gets $fd line] > -1} {
        if {
            [regexp {XC_([^ ]+) } $line -> c] &&
            ![catch {
                # not everything that begins with XC_ is a cursor name
                label .$c -cursor $c -text $c -bd 2 -relief raised \
                    -width 20 -height 3 -fg grey40
            }]
        } then {
            lappend labels .$c
            if {[incr i] == 6} {
                eval grid $labels
                set labels ""
                set i 0
            }
        }
    }
 }
 main
Path for Solaris: /usr/openwin/include/X11 [RS]
----
[Tk syntax help] - [Arts and crafts of Tcl-Tk programming]
- [Category Command]