Return to tkcursor.c CVS log

Up to [Micropolis - Activity] / micropolis / src / tk

Annotation of micropolis/src/tk/tkcursor.c, revision 1.1

1.1     ! root        1: /* 
        !             2:  * tkCursor.c --
        !             3:  *
        !             4:  *     This file maintains a database of read-only cursors for the Tk
        !             5:  *     toolkit.  This allows cursors to be shared between widgets and
        !             6:  *     also avoids round-trips to the X server.
        !             7:  *
        !             8:  * Copyright 1990 Regents of the University of California
        !             9:  * Permission to use, copy, modify, and distribute this
        !            10:  * software and its documentation for any purpose and without
        !            11:  * fee is hereby granted, provided that the above copyright
        !            12:  * notice appear in all copies.  The University of California
        !            13:  * makes no representations about the suitability of this
        !            14:  * software for any purpose.  It is provided "as is" without
        !            15:  * express or implied warranty.
        !            16:  */
        !            17: 
        !            18: #ifndef lint
        !            19: static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkCursor.c,v 1.12 91/10/31 11:40:41 ouster Exp $ SPRITE (Berkeley)";
        !            20: #endif /* not lint */
        !            21: 
        !            22: #include "tkconfig.h"
        !            23: #include "tkint.h"
        !            24: 
        !            25: /*
        !            26:  * One of the following data structures exists for each cursor that is
        !            27:  * currently active.  Each structure is indexed with two hash tables
        !            28:  * defined below.  One of the tables is idTable, and the other is either
        !            29:  * nameTable or dataTable, also defined below.
        !            30:  * .
        !            31:  */
        !            32: 
        !            33: typedef struct {
        !            34:     Cursor cursor;             /* X identifier for cursor. */
        !            35:     Display *display;          /* Display for which cursor is valid. */
        !            36:     int refCount;              /* Number of active uses of cursor. */
        !            37:     Tcl_HashTable *otherTable; /* Second table (other than idTable) used
        !            38:                                 * to index this entry. */
        !            39:     Tcl_HashEntry *hashPtr;    /* Entry in otherTable for this structure
        !            40:                                 * (needed when deleting). */
        !            41: } TkCursor;
        !            42: 
        !            43: /*
        !            44:  * Hash table to map from a textual description of a cursor to the
        !            45:  * TkCursor record for the cursor, and key structure used in that
        !            46:  * hash table:
        !            47:  */
        !            48: 
        !            49: static Tcl_HashTable nameTable;
        !            50: typedef struct {
        !            51:     Tk_Uid name;               /* Textual name for desired cursor. */
        !            52:     Display *display;          /* Display for which cursor will be used. */
        !            53: } NameKey;
        !            54: 
        !            55: /*
        !            56:  * Hash table to map from a collection of in-core data about a
        !            57:  * cursor (bitmap contents, etc.) to a TkCursor structure:
        !            58:  */
        !            59: 
        !            60: static Tcl_HashTable dataTable;
        !            61: typedef struct {
        !            62:     char *source;              /* Cursor bits. */
        !            63:     char *mask;                        /* Mask bits. */
        !            64:     unsigned int width, height;        /* Dimensions of cursor (and data
        !            65:                                 * and mask). */
        !            66:     int xHot, yHot;            /* Location of cursor hot-spot. */
        !            67:     Tk_Uid fg, bg;             /* Colors for cursor. */
        !            68:     Display *display;          /* Display on which cursor will be used. */
        !            69: } DataKey;
        !            70: 
        !            71: /*
        !            72:  * Hash table that maps from Cursor identifiers to the TkCursor structure
        !            73:  * for the cursor.  This table is indexed by Cursor ids, and is used by
        !            74:  * Tk_FreeCursor.
        !            75:  */
        !            76: 
        !            77: static Tcl_HashTable idTable;
        !            78: 
        !            79: static int initialized = 0;    /* 0 means static structures haven't been
        !            80:                                 * initialized yet. */
        !            81: 
        !            82: /*
        !            83:  * The table below is used to map from the name of a cursor to its
        !            84:  * index in the official cursor font:
        !            85:  */
        !            86: 
        !            87: static struct CursorName {
        !            88:     char               *name;
        !            89:     unsigned int       shape;
        !            90: } cursorNames[] = {
        !            91:     {"X_cursor",               XC_X_cursor},
        !            92:     {"arrow",                  XC_arrow},
        !            93:     {"based_arrow_down",       XC_based_arrow_down},
        !            94:     {"based_arrow_up",         XC_based_arrow_up},
        !            95:     {"boat",                   XC_boat},
        !            96:     {"bogosity",               XC_bogosity},
        !            97:     {"bottom_left_corner",     XC_bottom_left_corner},
        !            98:     {"bottom_right_corner",    XC_bottom_right_corner},
        !            99:     {"bottom_side",            XC_bottom_side},
        !           100:     {"bottom_tee",             XC_bottom_tee},
        !           101:     {"box_spiral",             XC_box_spiral},
        !           102:     {"center_ptr",             XC_center_ptr},
        !           103:     {"circle",                 XC_circle},
        !           104:     {"clock",                  XC_clock},
        !           105:     {"coffee_mug",             XC_coffee_mug},
        !           106:     {"cross",                  XC_cross},
        !           107:     {"cross_reverse",          XC_cross_reverse},
        !           108:     {"crosshair",              XC_crosshair},
        !           109:     {"diamond_cross",          XC_diamond_cross},
        !           110:     {"dot",                    XC_dot},
        !           111:     {"dotbox",                 XC_dotbox},
        !           112:     {"double_arrow",           XC_double_arrow},
        !           113:     {"draft_large",            XC_draft_large},
        !           114:     {"draft_small",            XC_draft_small},
        !           115:     {"draped_box",             XC_draped_box},
        !           116:     {"exchange",               XC_exchange},
        !           117:     {"fleur",                  XC_fleur},
        !           118:     {"gobbler",                        XC_gobbler},
        !           119:     {"gumby",                  XC_gumby},
        !           120:     {"hand1",                  XC_hand1},
        !           121:     {"hand2",                  XC_hand2},
        !           122:     {"heart",                  XC_heart},
        !           123:     {"icon",                   XC_icon},
        !           124:     {"iron_cross",             XC_iron_cross},
        !           125:     {"left_ptr",               XC_left_ptr},
        !           126:     {"left_side",              XC_left_side},
        !           127:     {"left_tee",               XC_left_tee},
        !           128:     {"leftbutton",             XC_leftbutton},
        !           129:     {"ll_angle",               XC_ll_angle},
        !           130:     {"lr_angle",               XC_lr_angle},
        !           131:     {"man",                    XC_man},
        !           132:     {"middlebutton",           XC_middlebutton},
        !           133:     {"mouse",                  XC_mouse},
        !           134:     {"pencil",                 XC_pencil},
        !           135:     {"pirate",                 XC_pirate},
        !           136:     {"plus",                   XC_plus},
        !           137:     {"question_arrow",         XC_question_arrow},
        !           138:     {"right_ptr",              XC_right_ptr},
        !           139:     {"right_side",             XC_right_side},
        !           140:     {"right_tee",              XC_right_tee},
        !           141:     {"rightbutton",            XC_rightbutton},
        !           142:     {"rtl_logo",               XC_rtl_logo},
        !           143:     {"sailboat",               XC_sailboat},
        !           144:     {"sb_down_arrow",          XC_sb_down_arrow},
        !           145:     {"sb_h_double_arrow",      XC_sb_h_double_arrow},
        !           146:     {"sb_left_arrow",          XC_sb_left_arrow},
        !           147:     {"sb_right_arrow",         XC_sb_right_arrow},
        !           148:     {"sb_up_arrow",            XC_sb_up_arrow},
        !           149:     {"sb_v_double_arrow",      XC_sb_v_double_arrow},
        !           150:     {"shuttle",                        XC_shuttle},
        !           151:     {"sizing",                 XC_sizing},
        !           152:     {"spider",                 XC_spider},
        !           153:     {"spraycan",               XC_spraycan},
        !           154:     {"star",                   XC_star},
        !           155:     {"target",                 XC_target},
        !           156:     {"tcross",                 XC_tcross},
        !           157:     {"top_left_arrow",         XC_top_left_arrow},
        !           158:     {"top_left_corner",                XC_top_left_corner},
        !           159:     {"top_right_corner",       XC_top_right_corner},
        !           160:     {"top_side",               XC_top_side},
        !           161:     {"top_tee",                        XC_top_tee},
        !           162:     {"trek",                   XC_trek},
        !           163:     {"ul_angle",               XC_ul_angle},
        !           164:     {"umbrella",               XC_umbrella},
        !           165:     {"ur_angle",               XC_ur_angle},
        !           166:     {"watch",                  XC_watch},
        !           167:     {"xterm",                  XC_xterm},
        !           168:     {NULL,                     0}
        !           169: };
        !           170: 
        !           171: /*
        !           172:  * Font to use for cursors:
        !           173:  */
        !           174: 
        !           175: #ifndef CURSORFONT
        !           176: #define CURSORFONT "cursor"
        !           177: #endif
        !           178: 
        !           179: /*
        !           180:  * Forward declarations for procedures defined in this file:
        !           181:  */
        !           182: 
        !           183: static void            CursorInit _ANSI_ARGS_((void));
        !           184: 
        !           185: /*
        !           186:  *----------------------------------------------------------------------
        !           187:  *
        !           188:  * Tk_GetCursor --
        !           189:  *
        !           190:  *     Given a string describing a cursor, locate (or create if necessary)
        !           191:  *     a cursor that fits the description.
        !           192:  *
        !           193:  * Results:
        !           194:  *     The return value is the X identifer for the desired cursor,
        !           195:  *     unless string couldn't be parsed correctly.  In this case,
        !           196:  *     None is returned and an error message is left in interp->result.
        !           197:  *     The caller should never modify the cursor that is returned, and
        !           198:  *     should eventually call Tk_FreeCursor when the cursor is no longer
        !           199:  *     needed.
        !           200:  *
        !           201:  * Side effects:
        !           202:  *     The cursor is added to an internal database with a reference count.
        !           203:  *     For each call to this procedure, there should eventually be a call
        !           204:  *     to Tk_FreeCursor, so that the database can be cleaned up when cursors
        !           205:  *     aren't needed anymore.
        !           206:  *
        !           207:  *----------------------------------------------------------------------
        !           208:  */
        !           209: 
        !           210: Cursor
        !           211: Tk_GetCursor(interp, tkwin, string)
        !           212:     Tcl_Interp *interp;                /* Interpreter to use for error reporting. */
        !           213:     Tk_Window tkwin;           /* Window in which cursor will be used. */
        !           214:     Tk_Uid string;             /* Description of cursor.  See manual entry
        !           215:                                 * for details on legal syntax. */
        !           216: {
        !           217:     NameKey key;
        !           218:     Tcl_HashEntry *nameHashPtr, *idHashPtr;
        !           219:     register TkCursor *cursorPtr;
        !           220:     int new;
        !           221:     Cursor cursor;
        !           222:     int argc;
        !           223:     char **argv = NULL;
        !           224:     Pixmap source = None;
        !           225:     Pixmap mask = None;
        !           226: 
        !           227:     if (!initialized) {
        !           228:        CursorInit();
        !           229:     }
        !           230: 
        !           231:     key.name = string;
        !           232:     key.display = Tk_Display(tkwin);
        !           233:     nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &key, &new);
        !           234:     if (!new) {
        !           235:        cursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr);
        !           236:        cursorPtr->refCount++;
        !           237:        return cursorPtr->cursor;
        !           238:     }
        !           239: 
        !           240:     /*
        !           241:      * No suitable cursor exists.  Parse the cursor name into fields
        !           242:      * and create a cursor, either from the standard cursor font or
        !           243:      * from bitmap files.
        !           244:      */
        !           245: 
        !           246:     if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
        !           247:        goto error;
        !           248:     }
        !           249:     if (argc == 0) {
        !           250:        badString:
        !           251:        Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"",
        !           252:                (char *) NULL);
        !           253:        goto error;
        !           254:     }
        !           255:     if (argv[0][0] != '@') {
        !           256:        XColor fg, bg;
        !           257:        int maskIndex;
        !           258:        register struct CursorName *namePtr;
        !           259:        TkDisplay *dispPtr;
        !           260: 
        !           261:        /*
        !           262:         * The cursor is to come from the standard cursor font.  If one
        !           263:         * arg, it is cursor name (use black and white for fg and bg).
        !           264:         * If two args, they are name and fg color (ignore mask).  If
        !           265:         * three args, they are name, fg, bg.  Some of the code below
        !           266:         * is stolen from the XCreateFontCursor Xlib procedure.
        !           267:         */
        !           268: 
        !           269:        if (argc > 3) {
        !           270:            goto badString;
        !           271:        }
        !           272:        for (namePtr = cursorNames; ; namePtr++) {
        !           273:            if (namePtr->name == NULL) {
        !           274:                goto badString;
        !           275:            }
        !           276:            if ((namePtr->name[0] == argv[0][0])
        !           277:                    && (strcmp(namePtr->name, argv[0]) == 0)) {
        !           278:                break;
        !           279:            }
        !           280:        }
        !           281:        maskIndex = namePtr->shape + 1;
        !           282:        if (argc == 1) {
        !           283:            fg.red = fg.green = fg.blue = 0;
        !           284:            bg.red = bg.green = bg.blue = 65535;
        !           285:        } else {
        !           286:            if (XParseColor(key.display,
        !           287:                    Tk_DefaultColormap(Tk_Screen(tkwin)),
        !           288:                    argv[1], &fg) == 0) {
        !           289:                Tcl_AppendResult(interp, "invalid color name \"", argv[1],
        !           290:                        "\"", (char *) NULL);
        !           291:                goto error;
        !           292:            }
        !           293:            if (argc == 2) {
        !           294:                bg.red = bg.green = bg.blue = 0;
        !           295:                maskIndex = namePtr->shape;
        !           296:            } else {
        !           297:                if (XParseColor(key.display,
        !           298:                        Tk_DefaultColormap(Tk_Screen(tkwin)),
        !           299:                        argv[2], &bg) == 0) {
        !           300:                    Tcl_AppendResult(interp, "invalid color name \"", argv[2],
        !           301:                            "\"", (char *) NULL);
        !           302:                    goto error;
        !           303:                }
        !           304:            }
        !           305:        }
        !           306:        dispPtr = ((TkWindow *) tkwin)->dispPtr;
        !           307:        if (dispPtr->cursorFont == None) {
        !           308:            dispPtr->cursorFont = XLoadFont(key.display, CURSORFONT);
        !           309:            if (dispPtr->cursorFont == None) {
        !           310:                interp->result = "couldn't load cursor font";
        !           311:                goto error;
        !           312:            }
        !           313:        }
        !           314:        cursor = XCreateGlyphCursor(key.display, dispPtr->cursorFont,
        !           315:                dispPtr->cursorFont, namePtr->shape, maskIndex,
        !           316:                &fg, &bg);
        !           317:     } else {
        !           318:        unsigned int width, height, maskWidth, maskHeight;
        !           319:        int xHot, yHot, dummy1, dummy2;
        !           320:        XColor fg, bg;
        !           321: 
        !           322:        /*
        !           323:         * The cursor is to be created by reading bitmap files.  There
        !           324:         * should be either two elements in the list (source, color) or
        !           325:         * four (source mask fg bg).
        !           326:         */
        !           327: 
        !           328:        if ((argc != 2) && (argc != 4)) {
        !           329:            goto badString;
        !           330:        }
        !           331:        if (XReadBitmapFile(key.display, RootWindowOfScreen(Tk_Screen(tkwin)),
        !           332:                &argv[0][1], &width, &height, &source, &xHot, &yHot)
        !           333:                != BitmapSuccess) {
        !           334:            Tcl_AppendResult(interp, "error reading bitmap file \"",
        !           335:                    &argv[0][1], "\"", (char *) NULL);
        !           336:            goto error;
        !           337:        }
        !           338:        if ((xHot < 0) || (yHot < 0) || (xHot >= width) || (yHot >= height)) {
        !           339:            Tcl_AppendResult(interp, "bad hot spot in bitmap file \"",
        !           340:                    &argv[0][1], "\"", (char *) NULL);
        !           341:            goto error;
        !           342:        }
        !           343:        if (argc == 2) {
        !           344:            if (XParseColor(key.display,
        !           345:                    Tk_DefaultColormap(Tk_Screen(tkwin)),
        !           346:                    argv[1], &fg) == 0) {
        !           347:                Tcl_AppendResult(interp, "invalid color name \"",
        !           348:                        argv[1], "\"", (char *) NULL);
        !           349:                goto error;
        !           350:            }
        !           351:            cursor = XCreatePixmapCursor(key.display, source, source,
        !           352:                    &fg, &fg, xHot, yHot);
        !           353:        } else {
        !           354:            if (XReadBitmapFile(key.display,
        !           355:                    RootWindowOfScreen(Tk_Screen(tkwin)), argv[1],
        !           356:                    &maskWidth, &maskHeight, &mask, &dummy1,
        !           357:                    &dummy2) != BitmapSuccess) {
        !           358:                Tcl_AppendResult(interp, "error reading bitmap file \"",
        !           359:                        argv[1], "\"", (char *) NULL);
        !           360:                goto error;
        !           361:            }
        !           362:            if ((maskWidth != width) && (maskHeight != height)) {
        !           363:                interp->result =
        !           364:                        "source and mask bitmaps have different sizes";
        !           365:                goto error;
        !           366:            }
        !           367:            if (XParseColor(key.display,
        !           368:                    Tk_DefaultColormap(Tk_Screen(tkwin)),
        !           369:                    argv[2], &fg) == 0) {
        !           370:                Tcl_AppendResult(interp, "invalid color name \"", argv[2],
        !           371:                        "\"", (char *) NULL);
        !           372:                goto error;
        !           373:            }
        !           374:            if (XParseColor(key.display,
        !           375:                    Tk_DefaultColormap(Tk_Screen(tkwin)),
        !           376:                    argv[3], &bg) == 0) {
        !           377:                Tcl_AppendResult(interp, "invalid color name \"", argv[3],
        !           378:                        "\"", (char *) NULL);
        !           379:                goto error;
        !           380:            }
        !           381:            cursor = XCreatePixmapCursor(key.display, source, mask,
        !           382:                    &fg, &bg, xHot, yHot);
        !           383:        }
        !           384:     }
        !           385:     ckfree((char *) argv);
        !           386: 
        !           387:     /*
        !           388:      * Add information about this cursor to our database.
        !           389:      */
        !           390: 
        !           391:     cursorPtr = (TkCursor *) ckalloc(sizeof(TkCursor));
        !           392:     cursorPtr->cursor = cursor;
        !           393:     cursorPtr->display = key.display;
        !           394:     cursorPtr->refCount = 1;
        !           395:     cursorPtr->otherTable = &nameTable;
        !           396:     cursorPtr->hashPtr = nameHashPtr;
        !           397:     idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) cursorPtr->cursor,
        !           398:            &new);
        !           399:     if (!new) {
        !           400: /* deh patched to support multiple displays */
        !           401: /*     panic("cursor already registered in Tk_GetCursor"); */
        !           402:         cursorPtr->refCount = 1000;
        !           403:     }
        !           404:     Tcl_SetHashValue(nameHashPtr, cursorPtr);
        !           405:     Tcl_SetHashValue(idHashPtr, cursorPtr);
        !           406:     return cursorPtr->cursor;
        !           407: 
        !           408:     error:
        !           409:     Tcl_DeleteHashEntry(nameHashPtr);
        !           410:     if (argv != NULL) {
        !           411:        ckfree((char *) argv);
        !           412:     }
        !           413:     if (source != None) {
        !           414:        XFreePixmap(key.display, source);
        !           415:     }
        !           416:     if (mask != None) {
        !           417:        XFreePixmap(key.display, mask);
        !           418:     }
        !           419:     return None;
        !           420: }
        !           421: 
        !           422: /*
        !           423:  *----------------------------------------------------------------------
        !           424:  *
        !           425:  * Tk_GetCursorFromData --
        !           426:  *
        !           427:  *     Given a description of the bits and colors for a cursor,
        !           428:  *     make a cursor that has the given properties.
        !           429:  *
        !           430:  * Results:
        !           431:  *     The return value is the X identifer for the desired cursor,
        !           432:  *     unless it couldn't be created properly.  In this case, None is
        !           433:  *     returned and an error message is left in interp->result.  The
        !           434:  *     caller should never modify the cursor that is returned, and
        !           435:  *     should eventually call Tk_FreeCursor when the cursor is no
        !           436:  *     longer needed.
        !           437:  *
        !           438:  * Side effects:
        !           439:  *     The cursor is added to an internal database with a reference count.
        !           440:  *     For each call to this procedure, there should eventually be a call
        !           441:  *     to Tk_FreeCursor, so that the database can be cleaned up when cursors
        !           442:  *     aren't needed anymore.
        !           443:  *
        !           444:  *----------------------------------------------------------------------
        !           445:  */
        !           446: 
        !           447: Cursor
        !           448: Tk_GetCursorFromData(interp, tkwin, source, mask, width, height,
        !           449:        xHot, yHot, fg, bg)
        !           450:     Tcl_Interp *interp;                /* Interpreter to use for error reporting. */
        !           451:     Tk_Window tkwin;           /* Window in which cursor will be used. */
        !           452:     char *source;              /* Bitmap data for cursor shape. */
        !           453:     char *mask;                        /* Bitmap data for cursor mask. */
        !           454:     unsigned int width, height;        /* Dimensions of cursor. */
        !           455:     int xHot, yHot;            /* Location of hot-spot in cursor. */
        !           456:     Tk_Uid fg;                 /* Foreground color for cursor. */
        !           457:     Tk_Uid bg;                 /* Background color for cursor. */
        !           458: {
        !           459:     DataKey key;
        !           460:     Tcl_HashEntry *dataHashPtr, *idHashPtr;
        !           461:     register TkCursor *cursorPtr;
        !           462:     int new;
        !           463:     XColor fgColor, bgColor;
        !           464:     Pixmap sourcePixmap, maskPixmap;
        !           465: 
        !           466:     if (!initialized) {
        !           467:        CursorInit();
        !           468:     }
        !           469: 
        !           470:     key.source = source;
        !           471:     key.mask = mask;
        !           472:     key.width = width;
        !           473:     key.height = height;
        !           474:     key.xHot = xHot;
        !           475:     key.yHot = yHot;
        !           476:     key.fg = fg;
        !           477:     key.bg = bg;
        !           478:     key.display = Tk_Display(tkwin);
        !           479:     dataHashPtr = Tcl_CreateHashEntry(&dataTable, (char *) &key, &new);
        !           480:     if (!new) {
        !           481:        cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr);
        !           482:        cursorPtr->refCount++;
        !           483:        return cursorPtr->cursor;
        !           484:     }
        !           485: 
        !           486:     /*
        !           487:      * No suitable cursor exists yet.  Make one using the data
        !           488:      * available and add it to the database.
        !           489:      */
        !           490: 
        !           491:     if (XParseColor(key.display, Tk_DefaultColormap(Tk_Screen(tkwin)),
        !           492:            fg, &fgColor) == 0) {
        !           493:        Tcl_AppendResult(interp, "invalid color name \"", fg, "\"",
        !           494:                (char *) NULL);
        !           495:        goto error;
        !           496:     }
        !           497:     if (XParseColor(key.display, Tk_DefaultColormap(Tk_Screen(tkwin)),
        !           498:            bg, &bgColor) == 0) {
        !           499:        Tcl_AppendResult(interp, "invalid color name \"", bg, "\"",
        !           500:                (char *) NULL);
        !           501:        goto error;
        !           502:     }
        !           503: 
        !           504:     cursorPtr = (TkCursor *) ckalloc(sizeof(TkCursor));
        !           505:     sourcePixmap = XCreateBitmapFromData(key.display,
        !           506:            RootWindowOfScreen(Tk_Screen(tkwin)), source, width, height);
        !           507:     maskPixmap = XCreateBitmapFromData(key.display, 
        !           508:            RootWindowOfScreen(Tk_Screen(tkwin)), mask, width, height);
        !           509:     cursorPtr->cursor = XCreatePixmapCursor(key.display, sourcePixmap,
        !           510:            maskPixmap, &fgColor, &bgColor, xHot, yHot);
        !           511:     XFreePixmap(key.display, sourcePixmap);
        !           512:     XFreePixmap(key.display, maskPixmap);
        !           513:     cursorPtr->display = key.display;
        !           514:     cursorPtr->refCount = 1;
        !           515:     cursorPtr->otherTable = &dataTable;
        !           516:     cursorPtr->hashPtr = dataHashPtr;
        !           517:     idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) cursorPtr->cursor, &new);
        !           518:     if (!new) {
        !           519: /* deh patched to support multiple displays */
        !           520: /*     panic("cursor already registered in Tk_GetCursorFromData"); */
        !           521:         cursorPtr->refCount = 1000;
        !           522:     }
        !           523:     Tcl_SetHashValue(dataHashPtr, cursorPtr);
        !           524:     Tcl_SetHashValue(idHashPtr, cursorPtr);
        !           525:     return cursorPtr->cursor;
        !           526: 
        !           527:     error:
        !           528:     Tcl_DeleteHashEntry(dataHashPtr);
        !           529:     return None;
        !           530: }
        !           531: 
        !           532: /*
        !           533:  *--------------------------------------------------------------
        !           534:  *
        !           535:  * Tk_NameOfCursor --
        !           536:  *
        !           537:  *     Given a cursor, return a textual string identifying it.
        !           538:  *
        !           539:  * Results:
        !           540:  *     If cursor was created by Tk_GetCursor, then the return
        !           541:  *     value is the "string" that was used to create it.
        !           542:  *     Otherwise the return value is a string giving the X
        !           543:  *     identifier for the cursor.  The storage for the returned
        !           544:  *     string is only guaranteed to persist up until the next
        !           545:  *     call to this procedure.
        !           546:  *
        !           547:  * Side effects:
        !           548:  *     None.
        !           549:  *
        !           550:  *--------------------------------------------------------------
        !           551:  */
        !           552: 
        !           553: char *
        !           554: Tk_NameOfCursor(cursor)
        !           555:     Cursor cursor;                     /* Cursor to be released. */
        !           556: {
        !           557:     Tcl_HashEntry *idHashPtr;
        !           558:     TkCursor *cursorPtr;
        !           559:     static char string[20];
        !           560: 
        !           561:     if (!initialized) {
        !           562:        printid:
        !           563:        sprintf(string, "cursor id 0x%x", cursor);
        !           564:        return string;
        !           565:     }
        !           566:     idHashPtr = Tcl_FindHashEntry(&idTable, (char *) cursor);
        !           567:     if (idHashPtr == NULL) {
        !           568:        goto printid;
        !           569:     }
        !           570:     cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
        !           571:     if (cursorPtr->otherTable != &nameTable) {
        !           572:        goto printid;
        !           573:     }
        !           574:     return ((NameKey *) cursorPtr->hashPtr->key.words)->name;
        !           575: }
        !           576: 
        !           577: /*
        !           578:  *----------------------------------------------------------------------
        !           579:  *
        !           580:  * Tk_FreeCursor --
        !           581:  *
        !           582:  *     This procedure is called to release a cursor allocated by
        !           583:  *     Tk_GetCursor or TkGetCursorFromData.
        !           584:  *
        !           585:  * Results:
        !           586:  *     None.
        !           587:  *
        !           588:  * Side effects:
        !           589:  *     The reference count associated with cursor is decremented, and
        !           590:  *     it is officially deallocated if no-one is using it anymore.
        !           591:  *
        !           592:  *----------------------------------------------------------------------
        !           593:  */
        !           594: 
        !           595: void
        !           596: Tk_FreeCursor(cursor)
        !           597:     Cursor cursor;                     /* Cursor to be released. */
        !           598: {
        !           599:     Tcl_HashEntry *idHashPtr;
        !           600:     register TkCursor *cursorPtr;
        !           601: 
        !           602:     if (!initialized) {
        !           603:        panic("Tk_FreeCursor called before Tk_GetCursor");
        !           604:     }
        !           605: 
        !           606:     idHashPtr = Tcl_FindHashEntry(&idTable, (char *) cursor);
        !           607:     if (idHashPtr == NULL) {
        !           608:        panic("Tk_FreeCursor received unknown cursor argument");
        !           609:     }
        !           610:     cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
        !           611:     cursorPtr->refCount--;
        !           612:     if (cursorPtr->refCount == 0) {
        !           613:        XFreeCursor(cursorPtr->display, cursorPtr->cursor);
        !           614:        Tcl_DeleteHashEntry(cursorPtr->hashPtr);
        !           615:        Tcl_DeleteHashEntry(idHashPtr);
        !           616:        ckfree((char *) cursorPtr);
        !           617:     }
        !           618: }
        !           619: 
        !           620: /*
        !           621:  *----------------------------------------------------------------------
        !           622:  *
        !           623:  * CursorInit --
        !           624:  *
        !           625:  *     Initialize the structures used for cursor management.
        !           626:  *
        !           627:  * Results:
        !           628:  *     None.
        !           629:  *
        !           630:  * Side effects:
        !           631:  *     Read the code.
        !           632:  *
        !           633:  *----------------------------------------------------------------------
        !           634:  */
        !           635: 
        !           636: static void
        !           637: CursorInit()
        !           638: {
        !           639:     initialized = 1;
        !           640:     Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(long));
        !           641:     Tcl_InitHashTable(&dataTable, sizeof(DataKey)/sizeof(long));
        !           642:     Tcl_InitHashTable(&idTable, TCL_ONE_WORD_KEYS);
        !           643: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.