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