cursors

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?

DKF - Defining a new cursor on UNIX/X via scripting currently requires creating an XBM-format temporary file (or two if you want a mask as well), though in 8.4 these may be in a VFS. On Windows, you can supply your own .CUR or .ANI files and they should work, though they cannot come from a VFS file ('cos the underlying API takes a filename.)

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:

WHD -- I think you're missing one: the cursor called "". If you do a "cget -cursor" on a freshly created widget, that's the cursor name that's returned. On both Windows and Sun Solaris it appears to be the usual arrow cursor. On Windows, "arrow" seems to get you the same one, but on Sun Solaris, "arrow" gets you an arrow pointing the other way. Setting the cursor to "" seems to work just fine.

SO Jul 15, 2002 very interesting... FWIW I just copied the list from the Active Tcl windows help file back when I wrote this

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. (RS verified on 2006-12-14 that the cursorfont.h path is valid on Cygwin too.)

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

MAKR 2009-02-06: path on newer Linux and HP-UX: /usr/include/X11/cursorfont.h; on AIX: /usr/lpp/X11/include/X11/cursorfont.h

Cursor palette from Michael Heca. Cursor is shown over each button. On press is cursor name copyed to entry and selected.

proc set2entry { text } {
    global cursorName
    set cursorName $text
    .e selection range 0 end
}

proc main {} {
    global tcl_platform cursorName

    set PAD 6; # extra space arount buttons
    set COLS 6; # number of button columns

    set CURSORS {
        {} X_cursor 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 xterm
    }

    if { $tcl_platform(platform) == "windows" } {
        lappend CURSORS no starting size_ne_sw size_ns size_nw_se size_we uparrow wait
    }

    if { $tcl_platform(platform) == "macintosh" } {
        lappend CURSORS text cross-hair
    }

    grid [entry .e -textvar cursorName] -columnspan $COLS -sticky nswe

    foreach cursor $CURSORS {
        set w [button .w_$cursor -text $cursor -cursor $cursor -command "set2entry $cursor"]
        lappend ws $w
        if { [llength $ws] >= $COLS } {
            # place whole row of buttons
            eval grid $ws -ipadx $PAD -ipady $PAD -sticky nswe
            set ws {}
        }
    }
    if { [llength $ws] > 0 } {
        # place rest of buttons
        eval grid $ws -ipadx $PAD -ipady $PAD -sticky nswe
    }
}

main

See also edit