1/* 2 * tkGet.c -- 3 * 4 * This file contains a number of "Tk_GetXXX" procedures, which 5 * parse text strings into useful forms for Tk. This file has 6 * the simpler procedures, like Tk_GetDirection and Tk_GetUid. 7 * The more complex procedures like Tk_GetColor are in separate 8 * files. 9 * 10 * Copyright (c) 1991-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: tkGet.c,v 1.10 2002/08/05 04:30:38 dgp Exp $ 17 */ 18 19#include "tkInt.h" 20#include "tkPort.h" 21 22/* 23 * One of these structures is created per thread to store 24 * thread-specific data. In this case, it is used to house the 25 * Tk_Uid structs used by each thread. The "dataKey" below is 26 * used to locate the ThreadSpecificData for the current thread. 27 */ 28 29typedef struct ThreadSpecificData { 30 int initialized; 31 Tcl_HashTable uidTable; 32} ThreadSpecificData; 33static Tcl_ThreadDataKey dataKey; 34 35static void FreeUidThreadExitProc _ANSI_ARGS_((ClientData clientData)); 36 37/* 38 * The following tables defines the string values for reliefs, which are 39 * used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj. 40 */ 41 42static CONST char *anchorStrings[] = { 43 "n", "ne", "e", "se", "s", "sw", "w", "nw", "center", (char *) NULL 44}; 45static CONST char *justifyStrings[] = { 46 "left", "right", "center", (char *) NULL 47}; 48 49 50/* 51 *---------------------------------------------------------------------- 52 * 53 * Tk_GetAnchorFromObj -- 54 * 55 * Return a Tk_Anchor value based on the value of the objPtr. 56 * 57 * Results: 58 * The return value is a standard Tcl result. If an error occurs during 59 * conversion, an error message is left in the interpreter's result 60 * unless "interp" is NULL. 61 * 62 * Side effects: 63 * The object gets converted by Tcl_GetIndexFromObj. 64 * 65 *---------------------------------------------------------------------- 66 */ 67 68int 69Tk_GetAnchorFromObj(interp, objPtr, anchorPtr) 70 Tcl_Interp *interp; /* Used for error reporting. */ 71 Tcl_Obj *objPtr; /* The object we are trying to get the 72 * value from. */ 73 Tk_Anchor *anchorPtr; /* Where to place the Tk_Anchor that 74 * corresponds to the string value of 75 * objPtr. */ 76{ 77 int index, code; 78 79 code = Tcl_GetIndexFromObj(interp, objPtr, anchorStrings, "anchor", 0, 80 &index); 81 if (code == TCL_OK) { 82 *anchorPtr = (Tk_Anchor) index; 83 } 84 return code; 85} 86 87/* 88 *-------------------------------------------------------------- 89 * 90 * Tk_GetAnchor -- 91 * 92 * Given a string, return the corresponding Tk_Anchor. 93 * 94 * Results: 95 * The return value is a standard Tcl return result. If 96 * TCL_OK is returned, then everything went well and the 97 * position is stored at *anchorPtr; otherwise TCL_ERROR 98 * is returned and an error message is left in 99 * the interp's result. 100 * 101 * Side effects: 102 * None. 103 * 104 *-------------------------------------------------------------- 105 */ 106 107int 108Tk_GetAnchor(interp, string, anchorPtr) 109 Tcl_Interp *interp; /* Use this for error reporting. */ 110 CONST char *string; /* String describing a direction. */ 111 Tk_Anchor *anchorPtr; /* Where to store Tk_Anchor corresponding 112 * to string. */ 113{ 114 switch (string[0]) { 115 case 'n': 116 if (string[1] == 0) { 117 *anchorPtr = TK_ANCHOR_N; 118 return TCL_OK; 119 } else if ((string[1] == 'e') && (string[2] == 0)) { 120 *anchorPtr = TK_ANCHOR_NE; 121 return TCL_OK; 122 } else if ((string[1] == 'w') && (string[2] == 0)) { 123 *anchorPtr = TK_ANCHOR_NW; 124 return TCL_OK; 125 } 126 goto error; 127 case 's': 128 if (string[1] == 0) { 129 *anchorPtr = TK_ANCHOR_S; 130 return TCL_OK; 131 } else if ((string[1] == 'e') && (string[2] == 0)) { 132 *anchorPtr = TK_ANCHOR_SE; 133 return TCL_OK; 134 } else if ((string[1] == 'w') && (string[2] == 0)) { 135 *anchorPtr = TK_ANCHOR_SW; 136 return TCL_OK; 137 } else { 138 goto error; 139 } 140 case 'e': 141 if (string[1] == 0) { 142 *anchorPtr = TK_ANCHOR_E; 143 return TCL_OK; 144 } 145 goto error; 146 case 'w': 147 if (string[1] == 0) { 148 *anchorPtr = TK_ANCHOR_W; 149 return TCL_OK; 150 } 151 goto error; 152 case 'c': 153 if (strncmp(string, "center", strlen(string)) == 0) { 154 *anchorPtr = TK_ANCHOR_CENTER; 155 return TCL_OK; 156 } 157 goto error; 158 } 159 160 error: 161 Tcl_AppendResult(interp, "bad anchor position \"", string, 162 "\": must be n, ne, e, se, s, sw, w, nw, or center", 163 (char *) NULL); 164 return TCL_ERROR; 165} 166 167/* 168 *-------------------------------------------------------------- 169 * 170 * Tk_NameOfAnchor -- 171 * 172 * Given a Tk_Anchor, return the string that corresponds 173 * to it. 174 * 175 * Results: 176 * None. 177 * 178 * Side effects: 179 * None. 180 * 181 *-------------------------------------------------------------- 182 */ 183 184CONST char * 185Tk_NameOfAnchor(anchor) 186 Tk_Anchor anchor; /* Anchor for which identifying string 187 * is desired. */ 188{ 189 switch (anchor) { 190 case TK_ANCHOR_N: return "n"; 191 case TK_ANCHOR_NE: return "ne"; 192 case TK_ANCHOR_E: return "e"; 193 case TK_ANCHOR_SE: return "se"; 194 case TK_ANCHOR_S: return "s"; 195 case TK_ANCHOR_SW: return "sw"; 196 case TK_ANCHOR_W: return "w"; 197 case TK_ANCHOR_NW: return "nw"; 198 case TK_ANCHOR_CENTER: return "center"; 199 } 200 return "unknown anchor position"; 201} 202 203/* 204 *-------------------------------------------------------------- 205 * 206 * Tk_GetJoinStyle -- 207 * 208 * Given a string, return the corresponding Tk JoinStyle. 209 * 210 * Results: 211 * The return value is a standard Tcl return result. If 212 * TCL_OK is returned, then everything went well and the 213 * justification is stored at *joinPtr; otherwise 214 * TCL_ERROR is returned and an error message is left in 215 * the interp's result. 216 * 217 * Side effects: 218 * None. 219 * 220 *-------------------------------------------------------------- 221 */ 222 223int 224Tk_GetJoinStyle(interp, string, joinPtr) 225 Tcl_Interp *interp; /* Use this for error reporting. */ 226 CONST char *string; /* String describing a justification style. */ 227 int *joinPtr; /* Where to store join style corresponding 228 * to string. */ 229{ 230 int c; 231 size_t length; 232 233 c = string[0]; 234 length = strlen(string); 235 236 if ((c == 'b') && (strncmp(string, "bevel", length) == 0)) { 237 *joinPtr = JoinBevel; 238 return TCL_OK; 239 } 240 if ((c == 'm') && (strncmp(string, "miter", length) == 0)) { 241 *joinPtr = JoinMiter; 242 return TCL_OK; 243 } 244 if ((c == 'r') && (strncmp(string, "round", length) == 0)) { 245 *joinPtr = JoinRound; 246 return TCL_OK; 247 } 248 249 Tcl_AppendResult(interp, "bad join style \"", string, 250 "\": must be bevel, miter, or round", 251 (char *) NULL); 252 return TCL_ERROR; 253} 254 255/* 256 *-------------------------------------------------------------- 257 * 258 * Tk_NameOfJoinStyle -- 259 * 260 * Given a Tk JoinStyle, return the string that corresponds 261 * to it. 262 * 263 * Results: 264 * None. 265 * 266 * Side effects: 267 * None. 268 * 269 *-------------------------------------------------------------- 270 */ 271 272CONST char * 273Tk_NameOfJoinStyle(join) 274 int join; /* Join style for which identifying string 275 * is desired. */ 276{ 277 switch (join) { 278 case JoinBevel: return "bevel"; 279 case JoinMiter: return "miter"; 280 case JoinRound: return "round"; 281 } 282 return "unknown join style"; 283} 284 285/* 286 *-------------------------------------------------------------- 287 * 288 * Tk_GetCapStyle -- 289 * 290 * Given a string, return the corresponding Tk CapStyle. 291 * 292 * Results: 293 * The return value is a standard Tcl return result. If 294 * TCL_OK is returned, then everything went well and the 295 * justification is stored at *capPtr; otherwise 296 * TCL_ERROR is returned and an error message is left in 297 * the interp's result. 298 * 299 * Side effects: 300 * None. 301 * 302 *-------------------------------------------------------------- 303 */ 304 305int 306Tk_GetCapStyle(interp, string, capPtr) 307 Tcl_Interp *interp; /* Use this for error reporting. */ 308 CONST char *string; /* String describing a justification style. */ 309 int *capPtr; /* Where to store cap style corresponding 310 * to string. */ 311{ 312 int c; 313 size_t length; 314 315 c = string[0]; 316 length = strlen(string); 317 318 if ((c == 'b') && (strncmp(string, "butt", length) == 0)) { 319 *capPtr = CapButt; 320 return TCL_OK; 321 } 322 if ((c == 'p') && (strncmp(string, "projecting", length) == 0)) { 323 *capPtr = CapProjecting; 324 return TCL_OK; 325 } 326 if ((c == 'r') && (strncmp(string, "round", length) == 0)) { 327 *capPtr = CapRound; 328 return TCL_OK; 329 } 330 331 Tcl_AppendResult(interp, "bad cap style \"", string, 332 "\": must be butt, projecting, or round", 333 (char *) NULL); 334 return TCL_ERROR; 335} 336 337/* 338 *-------------------------------------------------------------- 339 * 340 * Tk_NameOfCapStyle -- 341 * 342 * Given a Tk CapStyle, return the string that corresponds 343 * to it. 344 * 345 * Results: 346 * None. 347 * 348 * Side effects: 349 * None. 350 * 351 *-------------------------------------------------------------- 352 */ 353 354CONST char * 355Tk_NameOfCapStyle(cap) 356 int cap; /* Cap style for which identifying string 357 * is desired. */ 358{ 359 switch (cap) { 360 case CapButt: return "butt"; 361 case CapProjecting: return "projecting"; 362 case CapRound: return "round"; 363 } 364 return "unknown cap style"; 365} 366 367/* 368 *---------------------------------------------------------------------- 369 * 370 * Tk_GetJustifyFromObj -- 371 * 372 * Return a Tk_Justify value based on the value of the objPtr. 373 * 374 * Results: 375 * The return value is a standard Tcl result. If an error occurs during 376 * conversion, an error message is left in the interpreter's result 377 * unless "interp" is NULL. 378 * 379 * Side effects: 380 * The object gets converted by Tcl_GetIndexFromObj. 381 * 382 *---------------------------------------------------------------------- 383 */ 384 385int 386Tk_GetJustifyFromObj(interp, objPtr, justifyPtr) 387 Tcl_Interp *interp; /* Used for error reporting. */ 388 Tcl_Obj *objPtr; /* The object we are trying to get the 389 * value from. */ 390 Tk_Justify *justifyPtr; /* Where to place the Tk_Justify that 391 * corresponds to the string value of 392 * objPtr. */ 393{ 394 int index, code; 395 396 code = Tcl_GetIndexFromObj(interp, objPtr, justifyStrings, 397 "justification", 0, &index); 398 if (code == TCL_OK) { 399 *justifyPtr = (Tk_Justify) index; 400 } 401 return code; 402} 403 404/* 405 *-------------------------------------------------------------- 406 * 407 * Tk_GetJustify -- 408 * 409 * Given a string, return the corresponding Tk_Justify. 410 * 411 * Results: 412 * The return value is a standard Tcl return result. If 413 * TCL_OK is returned, then everything went well and the 414 * justification is stored at *justifyPtr; otherwise 415 * TCL_ERROR is returned and an error message is left in 416 * the interp's result. 417 * 418 * Side effects: 419 * None. 420 * 421 *-------------------------------------------------------------- 422 */ 423 424int 425Tk_GetJustify(interp, string, justifyPtr) 426 Tcl_Interp *interp; /* Use this for error reporting. */ 427 CONST char *string; /* String describing a justification style. */ 428 Tk_Justify *justifyPtr; /* Where to store Tk_Justify corresponding 429 * to string. */ 430{ 431 int c; 432 size_t length; 433 434 c = string[0]; 435 length = strlen(string); 436 437 if ((c == 'l') && (strncmp(string, "left", length) == 0)) { 438 *justifyPtr = TK_JUSTIFY_LEFT; 439 return TCL_OK; 440 } 441 if ((c == 'r') && (strncmp(string, "right", length) == 0)) { 442 *justifyPtr = TK_JUSTIFY_RIGHT; 443 return TCL_OK; 444 } 445 if ((c == 'c') && (strncmp(string, "center", length) == 0)) { 446 *justifyPtr = TK_JUSTIFY_CENTER; 447 return TCL_OK; 448 } 449 450 Tcl_AppendResult(interp, "bad justification \"", string, 451 "\": must be left, right, or center", 452 (char *) NULL); 453 return TCL_ERROR; 454} 455 456/* 457 *-------------------------------------------------------------- 458 * 459 * Tk_NameOfJustify -- 460 * 461 * Given a Tk_Justify, return the string that corresponds 462 * to it. 463 * 464 * Results: 465 * None. 466 * 467 * Side effects: 468 * None. 469 * 470 *-------------------------------------------------------------- 471 */ 472 473CONST char * 474Tk_NameOfJustify(justify) 475 Tk_Justify justify; /* Justification style for which 476 * identifying string is desired. */ 477{ 478 switch (justify) { 479 case TK_JUSTIFY_LEFT: return "left"; 480 case TK_JUSTIFY_RIGHT: return "right"; 481 case TK_JUSTIFY_CENTER: return "center"; 482 } 483 return "unknown justification style"; 484} 485 486/* 487 *---------------------------------------------------------------------- 488 * 489 * FreeUidThreadExitProc -- 490 * 491 * Cleans up memory used for Tk_Uids in the thread. 492 * 493 * Results: 494 * None. 495 * 496 * Side effects: 497 * All information in the identifier table is deleted. 498 * 499 *---------------------------------------------------------------------- 500 */ 501 502static void 503FreeUidThreadExitProc(clientData) 504 ClientData clientData; /* Not used. */ 505{ 506 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 507 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 508 Tcl_DeleteHashTable(&tsdPtr->uidTable); 509 tsdPtr->initialized = 0; 510} 511 512/* 513 *---------------------------------------------------------------------- 514 * 515 * Tk_GetUid -- 516 * 517 * Given a string, this procedure returns a unique identifier 518 * for the string. 519 * 520 * Results: 521 * This procedure returns a Tk_Uid corresponding to the "string" 522 * argument. The Tk_Uid has a string value identical to string 523 * (strcmp will return 0), but it's guaranteed that any other 524 * calls to this procedure with a string equal to "string" will 525 * return exactly the same result (i.e. can compare Tk_Uid 526 * *values* directly, without having to call strcmp on what they 527 * point to). 528 * 529 * Side effects: 530 * New information may be entered into the identifier table. 531 * 532 *---------------------------------------------------------------------- 533 */ 534 535Tk_Uid 536Tk_GetUid(string) 537 CONST char *string; /* String to convert. */ 538{ 539 int dummy; 540 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 541 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 542 Tcl_HashTable *tablePtr = &tsdPtr->uidTable; 543 544 if (!tsdPtr->initialized) { 545 Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS); 546 Tcl_CreateThreadExitHandler(FreeUidThreadExitProc, NULL); 547 tsdPtr->initialized = 1; 548 } 549 return (Tk_Uid) Tcl_GetHashKey(tablePtr, 550 Tcl_CreateHashEntry(tablePtr, string, &dummy)); 551} 552 553/* 554 *-------------------------------------------------------------- 555 * 556 * Tk_GetScreenMM -- 557 * 558 * Given a string, returns the number of screen millimeters 559 * corresponding to that string. 560 * 561 * Results: 562 * The return value is a standard Tcl return result. If 563 * TCL_OK is returned, then everything went well and the 564 * screen distance is stored at *doublePtr; otherwise 565 * TCL_ERROR is returned and an error message is left in 566 * the interp's result. 567 * 568 * Side effects: 569 * None. 570 * 571 *-------------------------------------------------------------- 572 */ 573 574int 575Tk_GetScreenMM(interp, tkwin, string, doublePtr) 576 Tcl_Interp *interp; /* Use this for error reporting. */ 577 Tk_Window tkwin; /* Window whose screen determines conversion 578 * from centimeters and other absolute 579 * units. */ 580 CONST char *string; /* String describing a screen distance. */ 581 double *doublePtr; /* Place to store converted result. */ 582{ 583 char *end; 584 double d; 585 586 d = strtod(string, &end); 587 if (end == string) { 588 error: 589 Tcl_AppendResult(interp, "bad screen distance \"", string, 590 "\"", (char *) NULL); 591 return TCL_ERROR; 592 } 593 while ((*end != '\0') && isspace(UCHAR(*end))) { 594 end++; 595 } 596 switch (*end) { 597 case 0: 598 d /= WidthOfScreen(Tk_Screen(tkwin)); 599 d *= WidthMMOfScreen(Tk_Screen(tkwin)); 600 break; 601 case 'c': 602 d *= 10; 603 end++; 604 break; 605 case 'i': 606 d *= 25.4; 607 end++; 608 break; 609 case 'm': 610 end++; 611 break; 612 case 'p': 613 d *= 25.4/72.0; 614 end++; 615 break; 616 default: 617 goto error; 618 } 619 while ((*end != '\0') && isspace(UCHAR(*end))) { 620 end++; 621 } 622 if (*end != 0) { 623 goto error; 624 } 625 *doublePtr = d; 626 return TCL_OK; 627} 628 629/* 630 *-------------------------------------------------------------- 631 * 632 * Tk_GetPixels -- 633 * 634 * Given a string, returns the number of pixels corresponding 635 * to that string. 636 * 637 * Results: 638 * The return value is a standard Tcl return result. If 639 * TCL_OK is returned, then everything went well and the 640 * rounded pixel distance is stored at *intPtr; otherwise 641 * TCL_ERROR is returned and an error message is left in 642 * the interp's result. 643 * 644 * Side effects: 645 * None. 646 * 647 *-------------------------------------------------------------- 648 */ 649 650int 651Tk_GetPixels(interp, tkwin, string, intPtr) 652 Tcl_Interp *interp; /* Use this for error reporting. */ 653 Tk_Window tkwin; /* Window whose screen determines conversion 654 * from centimeters and other absolute 655 * units. */ 656 CONST char *string; /* String describing a number of pixels. */ 657 int *intPtr; /* Place to store converted result. */ 658{ 659 double d; 660 661 if (TkGetDoublePixels(interp, tkwin, string, &d) != TCL_OK) { 662 return TCL_ERROR; 663 } 664 665 if (d < 0) { 666 *intPtr = (int) (d - 0.5); 667 } else { 668 *intPtr = (int) (d + 0.5); 669 } 670 return TCL_OK; 671} 672/* 673 *-------------------------------------------------------------- 674 * 675 * TkGetDoublePixels -- 676 * 677 * Given a string, returns the number of pixels corresponding 678 * to that string. 679 * 680 * Results: 681 * The return value is a standard Tcl return result. If 682 * TCL_OK is returned, then everything went well and the 683 * pixel distance is stored at *doublePtr; otherwise 684 * TCL_ERROR is returned and an error message is left in 685 * interp->result. 686 * 687 * Side effects: 688 * None. 689 * 690 *-------------------------------------------------------------- 691 */ 692 693int 694TkGetDoublePixels(interp, tkwin, string, doublePtr) 695 Tcl_Interp *interp; /* Use this for error reporting. */ 696 Tk_Window tkwin; /* Window whose screen determines conversion 697 * from centimeters and other absolute 698 * units. */ 699 CONST char *string; /* String describing a number of pixels. */ 700 double *doublePtr; /* Place to store converted result. */ 701{ 702 char *end; 703 double d; 704 705 d = strtod((char *) string, &end); 706 if (end == string) { 707 error: 708 Tcl_AppendResult(interp, "bad screen distance \"", string, 709 "\"", (char *) NULL); 710 return TCL_ERROR; 711 } 712 while ((*end != '\0') && isspace(UCHAR(*end))) { 713 end++; 714 } 715 switch (*end) { 716 case 0: 717 break; 718 case 'c': 719 d *= 10*WidthOfScreen(Tk_Screen(tkwin)); 720 d /= WidthMMOfScreen(Tk_Screen(tkwin)); 721 end++; 722 break; 723 case 'i': 724 d *= 25.4*WidthOfScreen(Tk_Screen(tkwin)); 725 d /= WidthMMOfScreen(Tk_Screen(tkwin)); 726 end++; 727 break; 728 case 'm': 729 d *= WidthOfScreen(Tk_Screen(tkwin)); 730 d /= WidthMMOfScreen(Tk_Screen(tkwin)); 731 end++; 732 break; 733 case 'p': 734 d *= (25.4/72.0)*WidthOfScreen(Tk_Screen(tkwin)); 735 d /= WidthMMOfScreen(Tk_Screen(tkwin)); 736 end++; 737 break; 738 default: 739 goto error; 740 } 741 while ((*end != '\0') && isspace(UCHAR(*end))) { 742 end++; 743 } 744 if (*end != 0) { 745 goto error; 746 } 747 *doublePtr = d; 748 return TCL_OK; 749} 750 751 752