/[dtapublic]/to_be_filed/sf_code/esrgpcpj/shared/tk_base/tkcursor.c
ViewVC logotype

Contents of /to_be_filed/sf_code/esrgpcpj/shared/tk_base/tkcursor.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 29 - (show annotations) (download)
Sat Oct 8 07:08:47 2016 UTC (7 years, 8 months ago) by dashley
File MIME type: text/plain
File size: 26965 byte(s)
Directories relocated.
1 /* $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