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

Diff of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkcursor.c

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

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

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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25