/[dtapublic]/projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkcursor.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkcursor.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

projs/trunk/shared_source/tk_base/tkcursor.c revision 42 by dashley, Fri Oct 14 01:50:00 2016 UTC projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkcursor.c revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkcursor.c,v 1.1.1.1 2001/06/13 04:59:04 dtashley Exp $ */  
   
 /*  
  * tkCursor.c --  
  *  
  *      This file maintains a database of read-only cursors for the Tk  
  *      toolkit.  This allows cursors to be shared between widgets and  
  *      also avoids round-trips to the X server.  
  *  
  * Copyright (c) 1990-1994 The Regents of the University of California.  
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tkcursor.c,v 1.1.1.1 2001/06/13 04:59:04 dtashley Exp $  
  */  
   
 #include "tkPort.h"  
 #include "tkInt.h"  
   
 /*  
  * A TkCursor structure exists for each cursor that is currently  
  * active.  Each structure is indexed with two hash tables defined  
  * below.  One of the tables is cursorIdTable, and the other is either  
  * cursorNameTable or cursorDataTable, each of which are stored in the  
  * TkDisplay structure for the current thread.  
  */  
   
 typedef struct {  
     char *source;               /* Cursor bits. */  
     char *mask;                 /* Mask bits. */  
     int width, height;          /* Dimensions of cursor (and data  
                                  * and mask). */  
     int xHot, yHot;             /* Location of cursor hot-spot. */  
     Tk_Uid fg, bg;              /* Colors for cursor. */  
     Display *display;           /* Display on which cursor will be used. */  
 } DataKey;  
   
 /*  
  * Forward declarations for procedures defined in this file:  
  */  
   
 static void             CursorInit _ANSI_ARGS_((TkDisplay *dispPtr));  
 static void             DupCursorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,  
                             Tcl_Obj *dupObjPtr));  
 static void             FreeCursor _ANSI_ARGS_((TkCursor *cursorPtr));  
 static void             FreeCursorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));  
 static TkCursor *       GetCursor _ANSI_ARGS_((Tcl_Interp *interp,  
                             Tk_Window tkwin, char *name));  
 static TkCursor *       GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin,  
                             Tcl_Obj *objPtr));  
 static void             InitCursorObj _ANSI_ARGS_((Tcl_Obj *objPtr));  
   
 /*  
  * The following structure defines the implementation of the "cursor" Tcl  
  * object, used for drawing. The color object remembers the hash table  
  * entry associated with a color. The actual allocation and deallocation  
  * of the color should be done by the configuration package when the cursor  
  * option is set.  
  */  
   
 static Tcl_ObjType cursorObjType = {  
     "cursor",                   /* name */  
     FreeCursorObjProc,          /* freeIntRepProc */  
     DupCursorObjProc,           /* dupIntRepProc */  
     NULL,                       /* updateStringProc */  
     NULL                        /* setFromAnyProc */  
 };  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_AllocCursorFromObj --  
  *  
  *      Given a Tcl_Obj *, map the value to a corresponding  
  *      Tk_Cursor structure based on the tkwin given.  
  *  
  * Results:  
  *      The return value is the X identifer for the desired cursor,  
  *      unless objPtr couldn't be parsed correctly.  In this case,  
  *      None is returned and an error message is left in the interp's result.  
  *      The caller should never modify the cursor that is returned, and  
  *      should eventually call Tk_FreeCursorFromObj when the cursor is no  
  *      longer needed.  
  *  
  * Side effects:  
  *      The cursor is added to an internal database with a reference count.  
  *      For each call to this procedure, there should eventually be a call  
  *      to Tk_FreeCursorFromObj, so that the database can be cleaned up  
  *      when cursors aren't needed anymore.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 Tk_Cursor  
 Tk_AllocCursorFromObj(interp, tkwin, objPtr)  
     Tcl_Interp *interp;         /* Interp for error results. */  
     Tk_Window tkwin;            /* Window in which the cursor will be used.*/  
     Tcl_Obj *objPtr;            /* Object describing cursor; see manual  
                                  * entry for description of legal  
                                  * syntax of this obj's string rep. */  
 {  
     TkCursor *cursorPtr;  
   
     if (objPtr->typePtr != &cursorObjType) {  
         InitCursorObj(objPtr);  
     }  
     cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;  
   
     /*  
      * If the object currently points to a TkCursor, see if it's the  
      * one we want.  If so, increment its reference count and return.  
      */  
   
     if (cursorPtr != NULL) {  
         if (cursorPtr->resourceRefCount == 0) {  
             /*  
              * This is a stale reference: it refers to a TkCursor that's  
              * no longer in use.  Clear the reference.  
              */  
             FreeCursorObjProc(objPtr);  
             cursorPtr = NULL;  
         } else if (Tk_Display(tkwin) == cursorPtr->display) {  
             cursorPtr->resourceRefCount++;  
             return cursorPtr->cursor;  
         }  
     }  
   
     /*  
      * The object didn't point to the TkCursor that we wanted.  Search  
      * the list of TkCursors with the same name to see if one of the  
      * other TkCursors is the right one.  
      */  
   
     if (cursorPtr != NULL) {  
         TkCursor *firstCursorPtr =  
                 (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr);  
         FreeCursorObjProc(objPtr);  
         for (cursorPtr = firstCursorPtr;  cursorPtr != NULL;  
                 cursorPtr = cursorPtr->nextPtr) {  
             if (Tk_Display(tkwin) == cursorPtr->display) {  
                 cursorPtr->resourceRefCount++;  
                 cursorPtr->objRefCount++;  
                 objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;  
                 return cursorPtr->cursor;  
             }  
         }  
     }  
   
     /*  
      * Still no luck.  Call GetCursor to allocate a new TkCursor object.  
      */  
   
     cursorPtr = GetCursor(interp, tkwin, Tcl_GetString(objPtr));  
     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;  
     if (cursorPtr == NULL) {  
         return None;  
     } else {  
         cursorPtr->objRefCount++;  
         return cursorPtr->cursor;  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_GetCursor --  
  *  
  *      Given a string describing a cursor, locate (or create if necessary)  
  *      a cursor that fits the description.  
  *  
  * Results:  
  *      The return value is the X identifer for the desired cursor,  
  *      unless string couldn't be parsed correctly.  In this case,  
  *      None is returned and an error message is left in the interp's result.  
  *      The caller should never modify the cursor that is returned, and  
  *      should eventually call Tk_FreeCursor when the cursor is no longer  
  *      needed.  
  *  
  * Side effects:  
  *      The cursor is added to an internal database with a reference count.  
  *      For each call to this procedure, there should eventually be a call  
  *      to Tk_FreeCursor, so that the database can be cleaned up when cursors  
  *      aren't needed anymore.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 Tk_Cursor  
 Tk_GetCursor(interp, tkwin, string)  
     Tcl_Interp *interp;         /* Interpreter to use for error reporting. */  
     Tk_Window tkwin;            /* Window in which cursor will be used. */  
     char *string;               /* Description of cursor.  See manual entry  
                                  * for details on legal syntax. */  
 {  
     TkCursor *cursorPtr = GetCursor(interp, tkwin, string);  
     if (cursorPtr == NULL) {  
         return None;  
     }  
     return cursorPtr->cursor;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * GetCursor --  
  *  
  *      Given a string describing a cursor, locate (or create if necessary)  
  *      a cursor that fits the description. This routine returns the  
  *      internal data structure for the cursor, which avoids extra  
  *      hash table lookups in Tk_AllocCursorFromObj.  
  *  
  * Results:  
  *      The return value is a pointer to the TkCursor for the desired  
  *      cursor, unless string couldn't be parsed correctly.  In this  
  *      case, NULL is returned and an error message is left in the  
  *      interp's result. The caller should never modify the cursor that  
  *      is returned, and should eventually call Tk_FreeCursor when the  
  *      cursor is no longer needed.  
  *  
  * Side effects:  
  *      The cursor is added to an internal database with a reference count.  
  *      For each call to this procedure, there should eventually be a call  
  *      to Tk_FreeCursor, so that the database can be cleaned up when cursors  
  *      aren't needed anymore.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static TkCursor *  
 GetCursor(interp, tkwin, string)  
     Tcl_Interp *interp;         /* Interpreter to use for error reporting. */  
     Tk_Window tkwin;            /* Window in which cursor will be used. */  
     char *string;               /* Description of cursor.  See manual entry  
                                  * for details on legal syntax. */  
 {  
     Tcl_HashEntry *nameHashPtr;  
     register TkCursor *cursorPtr;  
     TkCursor *existingCursorPtr = NULL;  
     int new;  
     TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;  
   
     if (!dispPtr->cursorInit) {  
         CursorInit(dispPtr);  
     }  
   
     nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable,  
             string, &new);  
     if (!new) {  
         existingCursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr);  
         for (cursorPtr = existingCursorPtr; cursorPtr != NULL;  
                 cursorPtr = cursorPtr->nextPtr) {  
             if (Tk_Display(tkwin) == cursorPtr->display) {  
                 cursorPtr->resourceRefCount++;  
                 return cursorPtr;  
             }  
         }  
     } else {  
         existingCursorPtr = NULL;  
     }  
   
     cursorPtr = TkGetCursorByName(interp, tkwin, string);  
   
     if (cursorPtr == NULL) {  
         if (new) {  
             Tcl_DeleteHashEntry(nameHashPtr);  
         }  
         return NULL;  
     }  
   
     /*  
      * Add information about this cursor to our database.  
      */  
   
     cursorPtr->display = Tk_Display(tkwin);  
     cursorPtr->resourceRefCount = 1;  
     cursorPtr->objRefCount = 0;  
     cursorPtr->otherTable = &dispPtr->cursorNameTable;  
     cursorPtr->hashPtr = nameHashPtr;  
     cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,  
             (char *) cursorPtr->cursor, &new);  
     if (!new) {  
         panic("cursor already registered in Tk_GetCursor");  
     }  
     cursorPtr->nextPtr = existingCursorPtr;  
     Tcl_SetHashValue(nameHashPtr, cursorPtr);  
     Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);  
   
     return cursorPtr;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_GetCursorFromData --  
  *  
  *      Given a description of the bits and colors for a cursor,  
  *      make a cursor that has the given properties.  
  *  
  * Results:  
  *      The return value is the X identifer for the desired cursor,  
  *      unless it couldn't be created properly.  In this case, None is  
  *      returned and an error message is left in the interp's result.  The  
  *      caller should never modify the cursor that is returned, and  
  *      should eventually call Tk_FreeCursor when the cursor is no  
  *      longer needed.  
  *  
  * Side effects:  
  *      The cursor is added to an internal database with a reference count.  
  *      For each call to this procedure, there should eventually be a call  
  *      to Tk_FreeCursor, so that the database can be cleaned up when cursors  
  *      aren't needed anymore.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 Tk_Cursor  
 Tk_GetCursorFromData(interp, tkwin, source, mask, width, height,  
         xHot, yHot, fg, bg)  
     Tcl_Interp *interp;         /* Interpreter to use for error reporting. */  
     Tk_Window tkwin;            /* Window in which cursor will be used. */  
     char *source;               /* Bitmap data for cursor shape. */  
     char *mask;                 /* Bitmap data for cursor mask. */  
     int width, height;          /* Dimensions of cursor. */  
     int xHot, yHot;             /* Location of hot-spot in cursor. */  
     Tk_Uid fg;                  /* Foreground color for cursor. */  
     Tk_Uid bg;                  /* Background color for cursor. */  
 {  
     DataKey dataKey;  
     Tcl_HashEntry *dataHashPtr;  
     register TkCursor *cursorPtr;  
     int new;  
     XColor fgColor, bgColor;  
     TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;  
   
   
     if (!dispPtr->cursorInit) {  
         CursorInit(dispPtr);  
     }  
   
     dataKey.source = source;  
     dataKey.mask = mask;  
     dataKey.width = width;  
     dataKey.height = height;  
     dataKey.xHot = xHot;  
     dataKey.yHot = yHot;  
     dataKey.fg = fg;  
     dataKey.bg = bg;  
     dataKey.display = Tk_Display(tkwin);  
     dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable,  
             (char *) &dataKey, &new);  
     if (!new) {  
         cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr);  
         cursorPtr->resourceRefCount++;  
         return cursorPtr->cursor;  
     }  
   
     /*  
      * No suitable cursor exists yet.  Make one using the data  
      * available and add it to the database.  
      */  
   
     if (XParseColor(dataKey.display, Tk_Colormap(tkwin), fg, &fgColor) == 0) {  
         Tcl_AppendResult(interp, "invalid color name \"", fg, "\"",  
                 (char *) NULL);  
         goto error;  
     }  
     if (XParseColor(dataKey.display, Tk_Colormap(tkwin), bg, &bgColor) == 0) {  
         Tcl_AppendResult(interp, "invalid color name \"", bg, "\"",  
                 (char *) NULL);  
         goto error;  
     }  
   
     cursorPtr = TkCreateCursorFromData(tkwin, source, mask, width, height,  
             xHot, yHot, fgColor, bgColor);  
   
     if (cursorPtr == NULL) {  
         goto error;  
     }  
   
     cursorPtr->resourceRefCount = 1;  
     cursorPtr->otherTable = &dispPtr->cursorDataTable;  
     cursorPtr->hashPtr = dataHashPtr;  
     cursorPtr->objRefCount = 0;  
     cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,  
             (char *) cursorPtr->cursor, &new);  
   
     if (!new) {  
         panic("cursor already registered in Tk_GetCursorFromData");  
     }  
     Tcl_SetHashValue(dataHashPtr, cursorPtr);  
     Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);  
     return cursorPtr->cursor;  
   
     error:  
     Tcl_DeleteHashEntry(dataHashPtr);  
     return None;  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * Tk_NameOfCursor --  
  *  
  *      Given a cursor, return a textual string identifying it.  
  *  
  * Results:  
  *      If cursor was created by Tk_GetCursor, then the return  
  *      value is the "string" that was used to create it.  
  *      Otherwise the return value is a string giving the X  
  *      identifier for the cursor.  The storage for the returned  
  *      string is only guaranteed to persist up until the next  
  *      call to this procedure.  
  *  
  * Side effects:  
  *      None.  
  *  
  *--------------------------------------------------------------  
  */  
   
 char *  
 Tk_NameOfCursor(display, cursor)  
     Display *display;           /* Display for which cursor was allocated. */  
     Tk_Cursor cursor;           /* Identifier for cursor whose name is  
                                  * wanted. */  
 {  
     Tcl_HashEntry *idHashPtr;  
     TkCursor *cursorPtr;  
     TkDisplay *dispPtr;  
   
     dispPtr = TkGetDisplay(display);  
   
     if (!dispPtr->cursorInit) {  
         printid:  
         sprintf(dispPtr->cursorString, "cursor id 0x%x",  
                 (unsigned int) cursor);  
         return dispPtr->cursorString;  
     }  
     idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);  
     if (idHashPtr == NULL) {  
         goto printid;  
     }  
     cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);  
     if (cursorPtr->otherTable != &dispPtr->cursorNameTable) {  
         goto printid;  
     }  
     return cursorPtr->hashPtr->key.string;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * FreeCursor --  
  *  
  *      This procedure is invoked by both Tk_FreeCursor and  
  *      Tk_FreeCursorFromObj; it does all the real work of deallocating  
  *      a cursor.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The reference count associated with cursor is decremented, and  
  *      it is officially deallocated if no-one is using it anymore.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 FreeCursor(cursorPtr)  
     TkCursor *cursorPtr;        /* Cursor to be released. */  
 {  
     TkCursor *prevPtr;  
   
     cursorPtr->resourceRefCount--;  
     if (cursorPtr->resourceRefCount > 0) {  
         return;  
     }  
   
     Tcl_DeleteHashEntry(cursorPtr->idHashPtr);  
     prevPtr = (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr);  
     if (prevPtr == cursorPtr) {  
         if (cursorPtr->nextPtr == NULL) {  
             Tcl_DeleteHashEntry(cursorPtr->hashPtr);  
         } else {  
             Tcl_SetHashValue(cursorPtr->hashPtr, cursorPtr->nextPtr);  
         }  
     } else {  
         while (prevPtr->nextPtr != cursorPtr) {  
             prevPtr = prevPtr->nextPtr;  
         }  
         prevPtr->nextPtr = cursorPtr->nextPtr;  
     }  
     TkpFreeCursor(cursorPtr);  
     if (cursorPtr->objRefCount == 0) {  
         ckfree((char *) cursorPtr);  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_FreeCursor --  
  *  
  *      This procedure is called to release a cursor allocated by  
  *      Tk_GetCursor or TkGetCursorFromData.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The reference count associated with cursor is decremented, and  
  *      it is officially deallocated if no-one is using it anymore.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tk_FreeCursor(display, cursor)  
     Display *display;           /* Display for which cursor was allocated. */  
     Tk_Cursor cursor;           /* Identifier for cursor to be released. */  
 {  
     Tcl_HashEntry *idHashPtr;  
     TkDisplay *dispPtr = TkGetDisplay(display);  
   
     if (!dispPtr->cursorInit) {  
         panic("Tk_FreeCursor called before Tk_GetCursor");  
     }  
   
     idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);  
     if (idHashPtr == NULL) {  
         panic("Tk_FreeCursor received unknown cursor argument");  
     }  
     FreeCursor((TkCursor *) Tcl_GetHashValue(idHashPtr));  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_FreeCursorFromObj --  
  *  
  *      This procedure is called to release a cursor allocated by  
  *      Tk_AllocCursorFromObj. It does not throw away the Tcl_Obj *;  
  *      it only gets rid of the hash table entry for this cursor  
  *      and clears the cached value that is normally stored in the object.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The reference count associated with the cursor represented by  
  *      objPtr is decremented, and the cursor is released to X if there are  
  *      no remaining uses for it.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tk_FreeCursorFromObj(tkwin, objPtr)  
     Tk_Window tkwin;            /* The window this cursor lives in. Needed  
                                  * for the display value. */  
     Tcl_Obj *objPtr;            /* The Tcl_Obj * to be freed. */  
 {  
     FreeCursor(GetCursorFromObj(tkwin, objPtr));  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * FreeCursorFromObjProc --  
  *  
  *      This proc is called to release an object reference to a cursor.  
  *      Called when the object's internal rep is released or when  
  *      the cached tkColPtr needs to be changed.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The object reference count is decremented. When both it  
  *      and the hash ref count go to zero, the color's resources  
  *      are released.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 static void  
 FreeCursorObjProc(objPtr)  
     Tcl_Obj *objPtr;            /* The object we are releasing. */  
 {  
     TkCursor *cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;  
   
     if (cursorPtr != NULL) {  
         cursorPtr->objRefCount--;  
         if ((cursorPtr->objRefCount == 0)  
                 && (cursorPtr->resourceRefCount == 0)) {  
             ckfree((char *) cursorPtr);  
         }  
         objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;  
     }  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * DupCursorObjProc --  
  *  
  *      When a cached cursor object is duplicated, this is called to  
  *      update the internal reps.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The color's objRefCount is incremented and the internal rep  
  *      of the copy is set to point to it.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 static void  
 DupCursorObjProc(srcObjPtr, dupObjPtr)  
     Tcl_Obj *srcObjPtr;         /* The object we are copying from. */  
     Tcl_Obj *dupObjPtr;         /* The object we are copying to. */  
 {  
     TkCursor *cursorPtr = (TkCursor *) srcObjPtr->internalRep.twoPtrValue.ptr1;  
       
     dupObjPtr->typePtr = srcObjPtr->typePtr;  
     dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;  
   
     if (cursorPtr != NULL) {  
         cursorPtr->objRefCount++;  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_GetCursorFromObj --  
  *  
  *      Returns the cursor referred to buy a Tcl object. The cursor must  
  *      already have been allocated via a call to Tk_AllocCursorFromObj or  
  *      Tk_GetCursor.  
  *  
  * Results:  
  *      Returns the Tk_Cursor that matches the tkwin and the string rep  
  *      of the name of the cursor given in objPtr.  
  *  
  * Side effects:  
  *      If the object is not already a cursor, the conversion will free  
  *      any old internal representation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 Tk_Cursor  
 Tk_GetCursorFromObj(tkwin, objPtr)  
     Tk_Window tkwin;  
     Tcl_Obj *objPtr;            /* The object from which to get pixels. */  
 {  
     TkCursor *cursorPtr = GetCursorFromObj(tkwin, objPtr);  
     /* GetCursorFromObj should never return NULL */  
     return cursorPtr->cursor;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * GetCursorFromObj --  
  *  
  *      Returns the cursor referred to by a Tcl object.  The cursor must  
  *      already have been allocated via a call to Tk_AllocCursorFromObj  
  *      or Tk_GetCursor.  
  *  
  * Results:  
  *      Returns the TkCursor * that matches the tkwin and the string rep  
  *      of the name of the cursor given in objPtr.  
  *  
  * Side effects:  
  *      If the object is not already a cursor, the conversion will free  
  *      any old internal representation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static TkCursor *  
 GetCursorFromObj(tkwin, objPtr)  
     Tk_Window tkwin;            /* Window in which the cursor will be used. */  
     Tcl_Obj *objPtr;            /* The object that describes the desired  
                                  * cursor. */  
 {  
     TkCursor *cursorPtr;  
     Tcl_HashEntry *hashPtr;  
     TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;  
   
     if (objPtr->typePtr != &cursorObjType) {  
         InitCursorObj(objPtr);  
     }  
   
     cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;  
     if (cursorPtr != NULL) {  
         if (Tk_Display(tkwin) == cursorPtr->display) {  
             return cursorPtr;  
         }  
         hashPtr = cursorPtr->hashPtr;  
     } else {  
         hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable,  
                 Tcl_GetString(objPtr));  
         if (hashPtr == NULL) {  
             goto error;  
         }  
     }  
   
     /*  
      * At this point we've got a hash table entry, off of which hang  
      * one or more TkCursor structures.  See if any of them will work.  
      */  
   
     for (cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr);  
             cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) {  
         if (Tk_Display(tkwin) == cursorPtr->display) {  
             objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;  
             cursorPtr->objRefCount++;  
             return cursorPtr;  
         }  
     }  
   
     error:  
     panic("GetCursorFromObj called with non-existent cursor!");  
     /*  
      * The following code isn't reached; it's just there to please compilers.  
      */  
     return NULL;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * InitCursorObj --  
  *  
  *      Bookeeping procedure to change an objPtr to a cursor type.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The old internal rep of the object is freed. The internal  
  *      rep is cleared. The final form of the object is set  
  *      by either Tk_AllocCursorFromObj or GetCursorFromObj.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 InitCursorObj(objPtr)  
     Tcl_Obj *objPtr;            /* The object to convert. */  
 {  
     Tcl_ObjType *typePtr;  
   
     /*  
      * Free the old internalRep before setting the new one.  
      */  
   
     Tcl_GetString(objPtr);  
     typePtr = objPtr->typePtr;  
     if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {  
         (*typePtr->freeIntRepProc)(objPtr);  
     }  
     objPtr->typePtr = &cursorObjType;  
     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * CursorInit --  
  *  
  *      Initialize the structures used for cursor management.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Read the code.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 CursorInit(dispPtr)  
     TkDisplay *dispPtr;   /* Display used to store thread-specific data. */  
 {  
     Tcl_InitHashTable(&dispPtr->cursorNameTable, TCL_STRING_KEYS);  
     Tcl_InitHashTable(&dispPtr->cursorDataTable, sizeof(DataKey)/sizeof(int));  
   
     /*  
      * The call below is tricky:  can't use sizeof(IdKey) because it  
      * gets padded with extra unpredictable bytes on some 64-bit  
      * machines.  
      */  
   
     /*  
      *  Old code....  
      *     Tcl_InitHashTable(&dispPtr->cursorIdTable, sizeof(Display *)  
      *                       /sizeof(int));  
      *  
      * The comment above doesn't make sense.  
      * However, XIDs should only be 32 bits, by the definition of X,  
      * so the code above causes Tk to crash.  Here is the real code:  
      */  
   
     Tcl_InitHashTable(&dispPtr->cursorIdTable, TCL_ONE_WORD_KEYS);  
   
     dispPtr->cursorInit = 1;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TkDebugCursor --  
  *  
  *      This procedure returns debugging information about a cursor.  
  *  
  * Results:  
  *      The return value is a list with one sublist for each TkCursor  
  *      corresponding to "name".  Each sublist has two elements that  
  *      contain the resourceRefCount and objRefCount fields from the  
  *      TkCursor structure.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 Tcl_Obj *  
 TkDebugCursor(tkwin, name)  
     Tk_Window tkwin;            /* The window in which the cursor will be  
                                  * used (not currently used). */  
     char *name;                 /* Name of the desired color. */  
 {  
     TkCursor *cursorPtr;  
     Tcl_HashEntry *hashPtr;  
     Tcl_Obj *resultPtr, *objPtr;  
     TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;  
   
     resultPtr = Tcl_NewObj();  
     hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, name);  
     if (hashPtr != NULL) {  
         cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr);  
         if (cursorPtr == NULL) {  
             panic("TkDebugCursor found empty hash table entry");  
         }  
         for ( ; (cursorPtr != NULL); cursorPtr = cursorPtr->nextPtr) {  
             objPtr = Tcl_NewObj();  
             Tcl_ListObjAppendElement(NULL, objPtr,  
                     Tcl_NewIntObj(cursorPtr->resourceRefCount));  
             Tcl_ListObjAppendElement(NULL, objPtr,  
                     Tcl_NewIntObj(cursorPtr->objRefCount));  
             Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);  
         }  
     }  
     return resultPtr;  
 }  
   
   
 /* $History: tkCursor.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 2:39a  
  * Created in $/IjuScripter, IjuConsole/Source/Tk Base  
  * Initial check-in.  
  */  
   
 /* End of TKCURSOR.C */  
1    /* $Header$ */
2    
3    /*
4     * tkCursor.c --
5     *
6     *      This file maintains a database of read-only cursors for the Tk
7     *      toolkit.  This allows cursors to be shared between widgets and
8     *      also avoids round-trips to the X server.
9     *
10     * Copyright (c) 1990-1994 The Regents of the University of California.
11     * Copyright (c) 1994-1997 Sun Microsystems, Inc.
12     *
13     * See the file "license.terms" for information on usage and redistribution
14     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15     *
16     * RCS: @(#) $Id: tkcursor.c,v 1.1.1.1 2001/06/13 04:59:04 dtashley Exp $
17     */
18    
19    #include "tkPort.h"
20    #include "tkInt.h"
21    
22    /*
23     * A TkCursor structure exists for each cursor that is currently
24     * active.  Each structure is indexed with two hash tables defined
25     * below.  One of the tables is cursorIdTable, and the other is either
26     * cursorNameTable or cursorDataTable, each of which are stored in the
27     * TkDisplay structure for the current thread.
28     */
29    
30    typedef struct {
31        char *source;               /* Cursor bits. */
32        char *mask;                 /* Mask bits. */
33        int width, height;          /* Dimensions of cursor (and data
34                                     * and mask). */
35        int xHot, yHot;             /* Location of cursor hot-spot. */
36        Tk_Uid fg, bg;              /* Colors for cursor. */
37        Display *display;           /* Display on which cursor will be used. */
38    } DataKey;
39    
40    /*
41     * Forward declarations for procedures defined in this file:
42     */
43    
44    static void             CursorInit _ANSI_ARGS_((TkDisplay *dispPtr));
45    static void             DupCursorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
46                                Tcl_Obj *dupObjPtr));
47    static void             FreeCursor _ANSI_ARGS_((TkCursor *cursorPtr));
48    static void             FreeCursorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
49    static TkCursor *       GetCursor _ANSI_ARGS_((Tcl_Interp *interp,
50                                Tk_Window tkwin, char *name));
51    static TkCursor *       GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin,
52                                Tcl_Obj *objPtr));
53    static void             InitCursorObj _ANSI_ARGS_((Tcl_Obj *objPtr));
54    
55    /*
56     * The following structure defines the implementation of the "cursor" Tcl
57     * object, used for drawing. The color object remembers the hash table
58     * entry associated with a color. The actual allocation and deallocation
59     * of the color should be done by the configuration package when the cursor
60     * option is set.
61     */
62    
63    static Tcl_ObjType cursorObjType = {
64        "cursor",                   /* name */
65        FreeCursorObjProc,          /* freeIntRepProc */
66        DupCursorObjProc,           /* dupIntRepProc */
67        NULL,                       /* updateStringProc */
68        NULL                        /* setFromAnyProc */
69    };
70    
71    /*
72     *----------------------------------------------------------------------
73     *
74     * Tk_AllocCursorFromObj --
75     *
76     *      Given a Tcl_Obj *, map the value to a corresponding
77     *      Tk_Cursor structure based on the tkwin given.
78     *
79     * Results:
80     *      The return value is the X identifer for the desired cursor,
81     *      unless objPtr couldn't be parsed correctly.  In this case,
82     *      None is returned and an error message is left in the interp's result.
83     *      The caller should never modify the cursor that is returned, and
84     *      should eventually call Tk_FreeCursorFromObj when the cursor is no
85     *      longer needed.
86     *
87     * Side effects:
88     *      The cursor is added to an internal database with a reference count.
89     *      For each call to this procedure, there should eventually be a call
90     *      to Tk_FreeCursorFromObj, so that the database can be cleaned up
91     *      when cursors aren't needed anymore.
92     *
93     *----------------------------------------------------------------------
94     */
95    
96    Tk_Cursor
97    Tk_AllocCursorFromObj(interp, tkwin, objPtr)
98        Tcl_Interp *interp;         /* Interp for error results. */
99        Tk_Window tkwin;            /* Window in which the cursor will be used.*/
100        Tcl_Obj *objPtr;            /* Object describing cursor; see manual
101                                     * entry for description of legal
102                                     * syntax of this obj's string rep. */
103    {
104        TkCursor *cursorPtr;
105    
106        if (objPtr->typePtr != &cursorObjType) {
107            InitCursorObj(objPtr);
108        }
109        cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;
110    
111        /*
112         * If the object currently points to a TkCursor, see if it's the
113         * one we want.  If so, increment its reference count and return.
114         */
115    
116        if (cursorPtr != NULL) {
117            if (cursorPtr->resourceRefCount == 0) {
118                /*
119                 * This is a stale reference: it refers to a TkCursor that's
120                 * no longer in use.  Clear the reference.
121                 */
122                FreeCursorObjProc(objPtr);
123                cursorPtr = NULL;
124            } else if (Tk_Display(tkwin) == cursorPtr->display) {
125                cursorPtr->resourceRefCount++;
126                return cursorPtr->cursor;
127            }
128        }
129    
130        /*
131         * The object didn't point to the TkCursor that we wanted.  Search
132         * the list of TkCursors with the same name to see if one of the
133         * other TkCursors is the right one.
134         */
135    
136        if (cursorPtr != NULL) {
137            TkCursor *firstCursorPtr =
138                    (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr);
139            FreeCursorObjProc(objPtr);
140            for (cursorPtr = firstCursorPtr;  cursorPtr != NULL;
141                    cursorPtr = cursorPtr->nextPtr) {
142                if (Tk_Display(tkwin) == cursorPtr->display) {
143                    cursorPtr->resourceRefCount++;
144                    cursorPtr->objRefCount++;
145                    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
146                    return cursorPtr->cursor;
147                }
148            }
149        }
150    
151        /*
152         * Still no luck.  Call GetCursor to allocate a new TkCursor object.
153         */
154    
155        cursorPtr = GetCursor(interp, tkwin, Tcl_GetString(objPtr));
156        objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
157        if (cursorPtr == NULL) {
158            return None;
159        } else {
160            cursorPtr->objRefCount++;
161            return cursorPtr->cursor;
162        }
163    }
164    
165    /*
166     *----------------------------------------------------------------------
167     *
168     * Tk_GetCursor --
169     *
170     *      Given a string describing a cursor, locate (or create if necessary)
171     *      a cursor that fits the description.
172     *
173     * Results:
174     *      The return value is the X identifer for the desired cursor,
175     *      unless string couldn't be parsed correctly.  In this case,
176     *      None is returned and an error message is left in the interp's result.
177     *      The caller should never modify the cursor that is returned, and
178     *      should eventually call Tk_FreeCursor when the cursor is no longer
179     *      needed.
180     *
181     * Side effects:
182     *      The cursor is added to an internal database with a reference count.
183     *      For each call to this procedure, there should eventually be a call
184     *      to Tk_FreeCursor, so that the database can be cleaned up when cursors
185     *      aren't needed anymore.
186     *
187     *----------------------------------------------------------------------
188     */
189    
190    Tk_Cursor
191    Tk_GetCursor(interp, tkwin, string)
192        Tcl_Interp *interp;         /* Interpreter to use for error reporting. */
193        Tk_Window tkwin;            /* Window in which cursor will be used. */
194        char *string;               /* Description of cursor.  See manual entry
195                                     * for details on legal syntax. */
196    {
197        TkCursor *cursorPtr = GetCursor(interp, tkwin, string);
198        if (cursorPtr == NULL) {
199            return None;
200        }
201        return cursorPtr->cursor;
202    }
203    
204    /*
205     *----------------------------------------------------------------------
206     *
207     * GetCursor --
208     *
209     *      Given a string describing a cursor, locate (or create if necessary)
210     *      a cursor that fits the description. This routine returns the
211     *      internal data structure for the cursor, which avoids extra
212     *      hash table lookups in Tk_AllocCursorFromObj.
213     *
214     * Results:
215     *      The return value is a pointer to the TkCursor for the desired
216     *      cursor, unless string couldn't be parsed correctly.  In this
217     *      case, NULL is returned and an error message is left in the
218     *      interp's result. The caller should never modify the cursor that
219     *      is returned, and should eventually call Tk_FreeCursor when the
220     *      cursor is no longer needed.
221     *
222     * Side effects:
223     *      The cursor is added to an internal database with a reference count.
224     *      For each call to this procedure, there should eventually be a call
225     *      to Tk_FreeCursor, so that the database can be cleaned up when cursors
226     *      aren't needed anymore.
227     *
228     *----------------------------------------------------------------------
229     */
230    
231    static TkCursor *
232    GetCursor(interp, tkwin, string)
233        Tcl_Interp *interp;         /* Interpreter to use for error reporting. */
234        Tk_Window tkwin;            /* Window in which cursor will be used. */
235        char *string;               /* Description of cursor.  See manual entry
236                                     * for details on legal syntax. */
237    {
238        Tcl_HashEntry *nameHashPtr;
239        register TkCursor *cursorPtr;
240        TkCursor *existingCursorPtr = NULL;
241        int new;
242        TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
243    
244        if (!dispPtr->cursorInit) {
245            CursorInit(dispPtr);
246        }
247    
248        nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable,
249                string, &new);
250        if (!new) {
251            existingCursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr);
252            for (cursorPtr = existingCursorPtr; cursorPtr != NULL;
253                    cursorPtr = cursorPtr->nextPtr) {
254                if (Tk_Display(tkwin) == cursorPtr->display) {
255                    cursorPtr->resourceRefCount++;
256                    return cursorPtr;
257                }
258            }
259        } else {
260            existingCursorPtr = NULL;
261        }
262    
263        cursorPtr = TkGetCursorByName(interp, tkwin, string);
264    
265        if (cursorPtr == NULL) {
266            if (new) {
267                Tcl_DeleteHashEntry(nameHashPtr);
268            }
269            return NULL;
270        }
271    
272        /*
273         * Add information about this cursor to our database.
274         */
275    
276        cursorPtr->display = Tk_Display(tkwin);
277        cursorPtr->resourceRefCount = 1;
278        cursorPtr->objRefCount = 0;
279        cursorPtr->otherTable = &dispPtr->cursorNameTable;
280        cursorPtr->hashPtr = nameHashPtr;
281        cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,
282                (char *) cursorPtr->cursor, &new);
283        if (!new) {
284            panic("cursor already registered in Tk_GetCursor");
285        }
286        cursorPtr->nextPtr = existingCursorPtr;
287        Tcl_SetHashValue(nameHashPtr, cursorPtr);
288        Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);
289    
290        return cursorPtr;
291    }
292    
293    /*
294     *----------------------------------------------------------------------
295     *
296     * Tk_GetCursorFromData --
297     *
298     *      Given a description of the bits and colors for a cursor,
299     *      make a cursor that has the given properties.
300     *
301     * Results:
302     *      The return value is the X identifer for the desired cursor,
303     *      unless it couldn't be created properly.  In this case, None is
304     *      returned and an error message is left in the interp's result.  The
305     *      caller should never modify the cursor that is returned, and
306     *      should eventually call Tk_FreeCursor when the cursor is no
307     *      longer needed.
308     *
309     * Side effects:
310     *      The cursor is added to an internal database with a reference count.
311     *      For each call to this procedure, there should eventually be a call
312     *      to Tk_FreeCursor, so that the database can be cleaned up when cursors
313     *      aren't needed anymore.
314     *
315     *----------------------------------------------------------------------
316     */
317    
318    Tk_Cursor
319    Tk_GetCursorFromData(interp, tkwin, source, mask, width, height,
320            xHot, yHot, fg, bg)
321        Tcl_Interp *interp;         /* Interpreter to use for error reporting. */
322        Tk_Window tkwin;            /* Window in which cursor will be used. */
323        char *source;               /* Bitmap data for cursor shape. */
324        char *mask;                 /* Bitmap data for cursor mask. */
325        int width, height;          /* Dimensions of cursor. */
326        int xHot, yHot;             /* Location of hot-spot in cursor. */
327        Tk_Uid fg;                  /* Foreground color for cursor. */
328        Tk_Uid bg;                  /* Background color for cursor. */
329    {
330        DataKey dataKey;
331        Tcl_HashEntry *dataHashPtr;
332        register TkCursor *cursorPtr;
333        int new;
334        XColor fgColor, bgColor;
335        TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
336    
337    
338        if (!dispPtr->cursorInit) {
339            CursorInit(dispPtr);
340        }
341    
342        dataKey.source = source;
343        dataKey.mask = mask;
344        dataKey.width = width;
345        dataKey.height = height;
346        dataKey.xHot = xHot;
347        dataKey.yHot = yHot;
348        dataKey.fg = fg;
349        dataKey.bg = bg;
350        dataKey.display = Tk_Display(tkwin);
351        dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable,
352                (char *) &dataKey, &new);
353        if (!new) {
354            cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr);
355            cursorPtr->resourceRefCount++;
356            return cursorPtr->cursor;
357        }
358    
359        /*
360         * No suitable cursor exists yet.  Make one using the data
361         * available and add it to the database.
362         */
363    
364        if (XParseColor(dataKey.display, Tk_Colormap(tkwin), fg, &fgColor) == 0) {
365            Tcl_AppendResult(interp, "invalid color name \"", fg, "\"",
366                    (char *) NULL);
367            goto error;
368        }
369        if (XParseColor(dataKey.display, Tk_Colormap(tkwin), bg, &bgColor) == 0) {
370            Tcl_AppendResult(interp, "invalid color name \"", bg, "\"",
371                    (char *) NULL);
372            goto error;
373        }
374    
375        cursorPtr = TkCreateCursorFromData(tkwin, source, mask, width, height,
376                xHot, yHot, fgColor, bgColor);
377    
378        if (cursorPtr == NULL) {
379            goto error;
380        }
381    
382        cursorPtr->resourceRefCount = 1;
383        cursorPtr->otherTable = &dispPtr->cursorDataTable;
384        cursorPtr->hashPtr = dataHashPtr;
385        cursorPtr->objRefCount = 0;
386        cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,
387                (char *) cursorPtr->cursor, &new);
388    
389        if (!new) {
390            panic("cursor already registered in Tk_GetCursorFromData");
391        }
392        Tcl_SetHashValue(dataHashPtr, cursorPtr);
393        Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);
394        return cursorPtr->cursor;
395    
396        error:
397        Tcl_DeleteHashEntry(dataHashPtr);
398        return None;
399    }
400    
401    /*
402     *--------------------------------------------------------------
403     *
404     * Tk_NameOfCursor --
405     *
406     *      Given a cursor, return a textual string identifying it.
407     *
408     * Results:
409     *      If cursor was created by Tk_GetCursor, then the return
410     *      value is the "string" that was used to create it.
411     *      Otherwise the return value is a string giving the X
412     *      identifier for the cursor.  The storage for the returned
413     *      string is only guaranteed to persist up until the next
414     *      call to this procedure.
415     *
416     * Side effects:
417     *      None.
418     *
419     *--------------------------------------------------------------
420     */
421    
422    char *
423    Tk_NameOfCursor(display, cursor)
424        Display *display;           /* Display for which cursor was allocated. */
425        Tk_Cursor cursor;           /* Identifier for cursor whose name is
426                                     * wanted. */
427    {
428        Tcl_HashEntry *idHashPtr;
429        TkCursor *cursorPtr;
430        TkDisplay *dispPtr;
431    
432        dispPtr = TkGetDisplay(display);
433    
434        if (!dispPtr->cursorInit) {
435            printid:
436            sprintf(dispPtr->cursorString, "cursor id 0x%x",
437                    (unsigned int) cursor);
438            return dispPtr->cursorString;
439        }
440        idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);
441        if (idHashPtr == NULL) {
442            goto printid;
443        }
444        cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
445        if (cursorPtr->otherTable != &dispPtr->cursorNameTable) {
446            goto printid;
447        }
448        return cursorPtr->hashPtr->key.string;
449    }
450    
451    /*
452     *----------------------------------------------------------------------
453     *
454     * FreeCursor --
455     *
456     *      This procedure is invoked by both Tk_FreeCursor and
457     *      Tk_FreeCursorFromObj; it does all the real work of deallocating
458     *      a cursor.
459     *
460     * Results:
461     *      None.
462     *
463     * Side effects:
464     *      The reference count associated with cursor is decremented, and
465     *      it is officially deallocated if no-one is using it anymore.
466     *
467     *----------------------------------------------------------------------
468     */
469    
470    static void
471    FreeCursor(cursorPtr)
472        TkCursor *cursorPtr;        /* Cursor to be released. */
473    {
474        TkCursor *prevPtr;
475    
476        cursorPtr->resourceRefCount--;
477        if (cursorPtr->resourceRefCount > 0) {
478            return;
479        }
480    
481        Tcl_DeleteHashEntry(cursorPtr->idHashPtr);
482        prevPtr = (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr);
483        if (prevPtr == cursorPtr) {
484            if (cursorPtr->nextPtr == NULL) {
485                Tcl_DeleteHashEntry(cursorPtr->hashPtr);
486            } else {
487                Tcl_SetHashValue(cursorPtr->hashPtr, cursorPtr->nextPtr);
488            }
489        } else {
490            while (prevPtr->nextPtr != cursorPtr) {
491                prevPtr = prevPtr->nextPtr;
492            }
493            prevPtr->nextPtr = cursorPtr->nextPtr;
494        }
495        TkpFreeCursor(cursorPtr);
496        if (cursorPtr->objRefCount == 0) {
497            ckfree((char *) cursorPtr);
498        }
499    }
500    
501    /*
502     *----------------------------------------------------------------------
503     *
504     * Tk_FreeCursor --
505     *
506     *      This procedure is called to release a cursor allocated by
507     *      Tk_GetCursor or TkGetCursorFromData.
508     *
509     * Results:
510     *      None.
511     *
512     * Side effects:
513     *      The reference count associated with cursor is decremented, and
514     *      it is officially deallocated if no-one is using it anymore.
515     *
516     *----------------------------------------------------------------------
517     */
518    
519    void
520    Tk_FreeCursor(display, cursor)
521        Display *display;           /* Display for which cursor was allocated. */
522        Tk_Cursor cursor;           /* Identifier for cursor to be released. */
523    {
524        Tcl_HashEntry *idHashPtr;
525        TkDisplay *dispPtr = TkGetDisplay(display);
526    
527        if (!dispPtr->cursorInit) {
528            panic("Tk_FreeCursor called before Tk_GetCursor");
529        }
530    
531        idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);
532        if (idHashPtr == NULL) {
533            panic("Tk_FreeCursor received unknown cursor argument");
534        }
535        FreeCursor((TkCursor *) Tcl_GetHashValue(idHashPtr));
536    }
537    
538    /*
539     *----------------------------------------------------------------------
540     *
541     * Tk_FreeCursorFromObj --
542     *
543     *      This procedure is called to release a cursor allocated by
544     *      Tk_AllocCursorFromObj. It does not throw away the Tcl_Obj *;
545     *      it only gets rid of the hash table entry for this cursor
546     *      and clears the cached value that is normally stored in the object.
547     *
548     * Results:
549     *      None.
550     *
551     * Side effects:
552     *      The reference count associated with the cursor represented by
553     *      objPtr is decremented, and the cursor is released to X if there are
554     *      no remaining uses for it.
555     *
556     *----------------------------------------------------------------------
557     */
558    
559    void
560    Tk_FreeCursorFromObj(tkwin, objPtr)
561        Tk_Window tkwin;            /* The window this cursor lives in. Needed
562                                     * for the display value. */
563        Tcl_Obj *objPtr;            /* The Tcl_Obj * to be freed. */
564    {
565        FreeCursor(GetCursorFromObj(tkwin, objPtr));
566    }
567    
568    /*
569     *---------------------------------------------------------------------------
570     *
571     * FreeCursorFromObjProc --
572     *
573     *      This proc is called to release an object reference to a cursor.
574     *      Called when the object's internal rep is released or when
575     *      the cached tkColPtr needs to be changed.
576     *
577     * Results:
578     *      None.
579     *
580     * Side effects:
581     *      The object reference count is decremented. When both it
582     *      and the hash ref count go to zero, the color's resources
583     *      are released.
584     *
585     *---------------------------------------------------------------------------
586     */
587    
588    static void
589    FreeCursorObjProc(objPtr)
590        Tcl_Obj *objPtr;            /* The object we are releasing. */
591    {
592        TkCursor *cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;
593    
594        if (cursorPtr != NULL) {
595            cursorPtr->objRefCount--;
596            if ((cursorPtr->objRefCount == 0)
597                    && (cursorPtr->resourceRefCount == 0)) {
598                ckfree((char *) cursorPtr);
599            }
600            objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
601        }
602    }
603    
604    /*
605     *---------------------------------------------------------------------------
606     *
607     * DupCursorObjProc --
608     *
609     *      When a cached cursor object is duplicated, this is called to
610     *      update the internal reps.
611     *
612     * Results:
613     *      None.
614     *
615     * Side effects:
616     *      The color's objRefCount is incremented and the internal rep
617     *      of the copy is set to point to it.
618     *
619     *---------------------------------------------------------------------------
620     */
621    
622    static void
623    DupCursorObjProc(srcObjPtr, dupObjPtr)
624        Tcl_Obj *srcObjPtr;         /* The object we are copying from. */
625        Tcl_Obj *dupObjPtr;         /* The object we are copying to. */
626    {
627        TkCursor *cursorPtr = (TkCursor *) srcObjPtr->internalRep.twoPtrValue.ptr1;
628        
629        dupObjPtr->typePtr = srcObjPtr->typePtr;
630        dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
631    
632        if (cursorPtr != NULL) {
633            cursorPtr->objRefCount++;
634        }
635    }
636    
637    /*
638     *----------------------------------------------------------------------
639     *
640     * Tk_GetCursorFromObj --
641     *
642     *      Returns the cursor referred to buy a Tcl object. The cursor must
643     *      already have been allocated via a call to Tk_AllocCursorFromObj or
644     *      Tk_GetCursor.
645     *
646     * Results:
647     *      Returns the Tk_Cursor that matches the tkwin and the string rep
648     *      of the name of the cursor given in objPtr.
649     *
650     * Side effects:
651     *      If the object is not already a cursor, the conversion will free
652     *      any old internal representation.
653     *
654     *----------------------------------------------------------------------
655     */
656    
657    Tk_Cursor
658    Tk_GetCursorFromObj(tkwin, objPtr)
659        Tk_Window tkwin;
660        Tcl_Obj *objPtr;            /* The object from which to get pixels. */
661    {
662        TkCursor *cursorPtr = GetCursorFromObj(tkwin, objPtr);
663        /* GetCursorFromObj should never return NULL */
664        return cursorPtr->cursor;
665    }
666    
667    /*
668     *----------------------------------------------------------------------
669     *
670     * GetCursorFromObj --
671     *
672     *      Returns the cursor referred to by a Tcl object.  The cursor must
673     *      already have been allocated via a call to Tk_AllocCursorFromObj
674     *      or Tk_GetCursor.
675     *
676     * Results:
677     *      Returns the TkCursor * that matches the tkwin and the string rep
678     *      of the name of the cursor given in objPtr.
679     *
680     * Side effects:
681     *      If the object is not already a cursor, the conversion will free
682     *      any old internal representation.
683     *
684     *----------------------------------------------------------------------
685     */
686    
687    static TkCursor *
688    GetCursorFromObj(tkwin, objPtr)
689        Tk_Window tkwin;            /* Window in which the cursor will be used. */
690        Tcl_Obj *objPtr;            /* The object that describes the desired
691                                     * cursor. */
692    {
693        TkCursor *cursorPtr;
694        Tcl_HashEntry *hashPtr;
695        TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
696    
697        if (objPtr->typePtr != &cursorObjType) {
698            InitCursorObj(objPtr);
699        }
700    
701        cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;
702        if (cursorPtr != NULL) {
703            if (Tk_Display(tkwin) == cursorPtr->display) {
704                return cursorPtr;
705            }
706            hashPtr = cursorPtr->hashPtr;
707        } else {
708            hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable,
709                    Tcl_GetString(objPtr));
710            if (hashPtr == NULL) {
711                goto error;
712            }
713        }
714    
715        /*
716         * At this point we've got a hash table entry, off of which hang
717         * one or more TkCursor structures.  See if any of them will work.
718         */
719    
720        for (cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr);
721                cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) {
722            if (Tk_Display(tkwin) == cursorPtr->display) {
723                objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
724                cursorPtr->objRefCount++;
725                return cursorPtr;
726            }
727        }
728    
729        error:
730        panic("GetCursorFromObj called with non-existent cursor!");
731        /*
732         * The following code isn't reached; it's just there to please compilers.
733         */
734        return NULL;
735    }
736    
737    /*
738     *----------------------------------------------------------------------
739     *
740     * InitCursorObj --
741     *
742     *      Bookeeping procedure to change an objPtr to a cursor type.
743     *
744     * Results:
745     *      None.
746     *
747     * Side effects:
748     *      The old internal rep of the object is freed. The internal
749     *      rep is cleared. The final form of the object is set
750     *      by either Tk_AllocCursorFromObj or GetCursorFromObj.
751     *
752     *----------------------------------------------------------------------
753     */
754    
755    static void
756    InitCursorObj(objPtr)
757        Tcl_Obj *objPtr;            /* The object to convert. */
758    {
759        Tcl_ObjType *typePtr;
760    
761        /*
762         * Free the old internalRep before setting the new one.
763         */
764    
765        Tcl_GetString(objPtr);
766        typePtr = objPtr->typePtr;
767        if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
768            (*typePtr->freeIntRepProc)(objPtr);
769        }
770        objPtr->typePtr = &cursorObjType;
771        objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
772    }
773    
774    /*
775     *----------------------------------------------------------------------
776     *
777     * CursorInit --
778     *
779     *      Initialize the structures used for cursor management.
780     *
781     * Results:
782     *      None.
783     *
784     * Side effects:
785     *      Read the code.
786     *
787     *----------------------------------------------------------------------
788     */
789    
790    static void
791    CursorInit(dispPtr)
792        TkDisplay *dispPtr;   /* Display used to store thread-specific data. */
793    {
794        Tcl_InitHashTable(&dispPtr->cursorNameTable, TCL_STRING_KEYS);
795        Tcl_InitHashTable(&dispPtr->cursorDataTable, sizeof(DataKey)/sizeof(int));
796    
797        /*
798         * The call below is tricky:  can't use sizeof(IdKey) because it
799         * gets padded with extra unpredictable bytes on some 64-bit
800         * machines.
801         */
802    
803        /*
804         *  Old code....
805         *     Tcl_InitHashTable(&dispPtr->cursorIdTable, sizeof(Display *)
806         *                       /sizeof(int));
807         *
808         * The comment above doesn't make sense.
809         * However, XIDs should only be 32 bits, by the definition of X,
810         * so the code above causes Tk to crash.  Here is the real code:
811         */
812    
813        Tcl_InitHashTable(&dispPtr->cursorIdTable, TCL_ONE_WORD_KEYS);
814    
815        dispPtr->cursorInit = 1;
816    }
817    
818    /*
819     *----------------------------------------------------------------------
820     *
821     * TkDebugCursor --
822     *
823     *      This procedure returns debugging information about a cursor.
824     *
825     * Results:
826     *      The return value is a list with one sublist for each TkCursor
827     *      corresponding to "name".  Each sublist has two elements that
828     *      contain the resourceRefCount and objRefCount fields from the
829     *      TkCursor structure.
830     *
831     * Side effects:
832     *      None.
833     *
834     *----------------------------------------------------------------------
835     */
836    
837    Tcl_Obj *
838    TkDebugCursor(tkwin, name)
839        Tk_Window tkwin;            /* The window in which the cursor will be
840                                     * used (not currently used). */
841        char *name;                 /* Name of the desired color. */
842    {
843        TkCursor *cursorPtr;
844        Tcl_HashEntry *hashPtr;
845        Tcl_Obj *resultPtr, *objPtr;
846        TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
847    
848        resultPtr = Tcl_NewObj();
849        hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, name);
850        if (hashPtr != NULL) {
851            cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr);
852            if (cursorPtr == NULL) {
853                panic("TkDebugCursor found empty hash table entry");
854            }
855            for ( ; (cursorPtr != NULL); cursorPtr = cursorPtr->nextPtr) {
856                objPtr = Tcl_NewObj();
857                Tcl_ListObjAppendElement(NULL, objPtr,
858                        Tcl_NewIntObj(cursorPtr->resourceRefCount));
859                Tcl_ListObjAppendElement(NULL, objPtr,
860                        Tcl_NewIntObj(cursorPtr->objRefCount));
861                Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
862            }
863        }
864        return resultPtr;
865    }
866    
867    /* End of tkcursor.c */

Legend:
Removed from v.42  
changed lines
  Added in v.71

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25