xcursor

EG: Some of the fancier features of modern *nix desktops aren't available in Tk by default. While the latest development addresses some of the issues (ttk/tile, Xft fonts), this is not the case of cursors, where they are still limited to bitmaps. Some people (see this post ) wants to use colored, animated cursors in their applications.

This bare-bones extension interfaces with the xcursor library allowing Tk developers use modern cursors on X11. It consist of three files: a .c file, a .tcl file for high level access and the pkgIndex.tcl library index.

/* file tkxcursor.c */
#include <tk.h>
#include <X11/Xcursor/Xcursor.h>

static int SetCursorCmd(clientData, interp, objc, objv)
    ClientData clientData;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *objv[];
{
    Tk_Window tkwin, mainw;
    long xid;
    Cursor cursor;

    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "window cursor");
        return TCL_ERROR;
    }

    if (Tcl_GetLongFromObj(interp, objv[2], &xid) != TCL_OK) 
        return TCL_ERROR;

    cursor = (Cursor) xid;

    mainw = Tk_MainWindow(interp);
    if (NULL == mainw)
        return TCL_ERROR;

    tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainw);
    if (NULL == tkwin)
        return TCL_ERROR;

    if (None == Tk_WindowId(tkwin))
        Tk_MakeWindowExist(tkwin);

    XDefineCursor(Tk_Display(tkwin), Tk_WindowId(tkwin), cursor);
    return TCL_OK;
}

static int GetThemeCmd(clientData, interp, objc, objv)
    ClientData clientData;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *objv[];
{
    const char *theme;
    Display *display = Tk_Display(Tk_MainWindow(interp));

    if (objc != 1) {
        Tcl_WrongNumArgs(interp, 1, objv, NULL);
        return TCL_ERROR;
    }

    theme = XcursorGetTheme(display);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(theme, -1));
    return TCL_OK;
}

static int LoadCursorFromFileCmd(clientData, interp, objc, objv)
    ClientData clientData;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *objv[];
{
    Cursor cursor;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "filename");
        return TCL_ERROR;
    }

    cursor = XcursorFilenameLoadCursor(Tk_Display(Tk_MainWindow(interp)),
        Tcl_GetString(objv[1]));

    if (cursor) {
        Tcl_SetObjResult(interp, Tcl_NewLongObj((long)cursor));
        return TCL_OK;
    }

    Tcl_AppendResult(interp, "Can't load cursor from file \"",
        Tcl_GetString(objv[1]), "\"", NULL);
    return TCL_ERROR;
}

static int FreeCursorCmd(clientData, interp, objc, objv)
    ClientData clientData;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *objv[];
{
    long xid;
    Cursor cursor;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "cursorid");
        return TCL_ERROR;
    }

    if (Tcl_GetLongFromObj(interp, objv[1], &xid) != TCL_OK)
        return TCL_ERROR;

    cursor = (Cursor) xid;

    XFreeCursor(Tk_Display(Tk_MainWindow(interp)), cursor);
    return TCL_OK;
}

static int IsARGBSupportedCmd(clientData, interp, objc, objv)
    ClientData clientData;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *objv[];
{
    Tk_Window tkwin = Tk_MainWindow(interp);

    if (objc != 1) {
        Tcl_WrongNumArgs(interp, 1, objv, NULL);
        return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewIntObj(XcursorSupportsARGB(Tk_Display(tkwin))));
    return TCL_OK;
}

int Xcursor_Init (interp)
    Tcl_Interp * interp;
{
    if (Tcl_InitStubs(interp, "8.5", 0) == NULL)
        return TCL_ERROR;
    if (Tk_InitStubs(interp, "8.5", 0) == NULL)
        return TCL_ERROR;

    if (Tcl_PkgProvide(interp, "xcursor", "0.1") == TCL_ERROR)
        return TCL_ERROR;

    /* these are "private" commands */
    Tcl_CreateObjCommand(interp, "xcursor::DefineCursor", SetCursorCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "xcursor::LoadFromFile", LoadCursorFromFileCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "xcursor::FreeCursor", FreeCursorCmd, NULL, NULL);
    /* these two are safe enough */
    Tcl_CreateObjCommand(interp, "xcursor::argbsupported", IsARGBSupportedCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "xcursor::gettheme", GetThemeCmd, NULL, NULL);

    return TCL_OK;
}
# file tkxcursor.tcl
namespace eval xcursor {
    variable cursors [dict create None 0]
}

proc xcursor::setcursor {window cursor} {
    variable cursors

    if {![winfo exists $window]} {
        return -code error "bad window path name \"$window\""
    }
    if {![dict exists $cursors $cursor]} {
        return -code error "cursor \"$cursor\" unknown"
    }
    DefineCursor $window [dict get $cursors $cursor]
}

proc xcursor::loadcursor {filename} {
    variable cursors
    if {![file exists $filename]} {
        return -code error "could not read \"$filename\":\
            no such file or directory"
    }
    set cursor [lindex [file split [file rootname $filename]] end]
    if {[dict exists $cursors $cursor]} {
        FreeCursor [dict get $cursors $cursor]
    }
    dict set cursors $cursor [LoadFromFile $filename]
    return $cursor
}

proc xcursor::names {} {
    variable cursors
    return [dict keys $cursors]
}

proc xcursor::deletecursor {cursor} {
    variable cursors
    if {![dict exists $cursors $cursor]} {
        return -code error "cursor \"$cursor\" unknown"
    }
    if {$cursor eq "None"} {
        # don't delete the "None" cursor
        return
    }
    FreeCursor [dict get $cursors $cursor]
    set cursors [dict remove $cursors $cursor]
    return
}
# file pkgIndex.tcl
package ifneeded xcursor 0.1 [list apply {{dir} {
    load [file join $dir libxcursor.so]
    source [file join $dir tkxcursor.tcl]
}} $dir]

Compile with

$ gcc -shared -fPIC -Wall -I/usr/local/include tkxcursor.c -o libxcursor.so \
-DUSE_TCL_STUBS -DUSE_TK_STUBS \
-L/usr/local/lib -ltkstub8.6 -ltclstub8.6 \
-L/usr/lib -lXcursor

In this case my Tcl (8.6) installation is on /usr/local/lib and the Xcursor library resides on /usr/lib. Adjust the paths and version numbers accordingly, compile and you're ready to go.

Simple usage:

$ tclsh8.6 
% lappend auto_path .
/usr/local/lib/tcl8.6 /usr/local/lib .
% package require xcursor ; # also loads Tk
0.1
% xcursor::names
None
% xcursor::loadcursor ./PolarCursorTheme/cursors/watch ; # animated watch cursor
watch
% xcursor::setcursor . watch
% xcursor::names
None watch
% xcursor::setcursor . None ; # equivalent to [. configure -cursor {}]
% xcursor::deletecursor watch
% xcursor::names
None
% xcursor::argbsupported ; # does this display support ARGB cursors?
1
% xcursor::gettheme ; # default theme, in my case empty
%

To set the default cursor theme see this wiki entry .

For cursor themes, see Gnome-Look or KDE-Look