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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 29 - (hide annotations) (download)
Sat Oct 8 07:08:47 2016 UTC (8 years, 1 month ago) by dashley
Original Path: to_be_filed/sf_code/esrgpcpj/shared/tk_base/tkcursor.c
File MIME type: text/plain
File size: 26965 byte(s)
Directories relocated.
1 dashley 25 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkcursor.c,v 1.1.1.1 2001/06/13 04:59:04 dtashley Exp $ */
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    
868     /* $History: tkCursor.c $
869     *
870     * ***************** Version 1 *****************
871     * User: Dtashley Date: 1/02/01 Time: 2:39a
872     * Created in $/IjuScripter, IjuConsole/Source/Tk Base
873     * Initial check-in.
874     */
875    
876     /* End of TKCURSOR.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25