1/* 2 * tkOldConfig.c -- 3 * 4 * This file contains the Tk_ConfigureWidget function. THIS FILE IS HERE 5 * FOR BACKWARD COMPATIBILITY; THE NEW CONFIGURATION PACKAGE SHOULD BE 6 * USED FOR NEW PROJECTS. 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 "tkPort.h" 18 19/* 20 * Values for "flags" field of Tk_ConfigSpec structures. Be sure to coordinate 21 * these values with those defined in tk.h (TK_CONFIG_COLOR_ONLY, etc.) There 22 * must not be overlap! 23 * 24 * INIT - Non-zero means (char *) things have been converted to 25 * Tk_Uid's. 26 */ 27 28#define INIT 0x20 29 30/* 31 * Forward declarations for functions defined later in this file: 32 */ 33 34static int DoConfig(Tcl_Interp *interp, Tk_Window tkwin, 35 Tk_ConfigSpec *specPtr, Tk_Uid value, 36 int valueIsUid, char *widgRec); 37static Tk_ConfigSpec * FindConfigSpec(Tcl_Interp *interp, 38 Tk_ConfigSpec *specs, CONST char *argvName, 39 int needFlags, int hateFlags); 40static char * FormatConfigInfo(Tcl_Interp *interp, Tk_Window tkwin, 41 Tk_ConfigSpec *specPtr, char *widgRec); 42static CONST char * FormatConfigValue(Tcl_Interp *interp, Tk_Window tkwin, 43 Tk_ConfigSpec *specPtr, char *widgRec, 44 char *buffer, Tcl_FreeProc **freeProcPtr); 45static Tk_ConfigSpec * GetCachedSpecs(Tcl_Interp *interp, 46 const Tk_ConfigSpec *staticSpecs); 47static void DeleteSpecCacheTable(ClientData clientData, 48 Tcl_Interp *interp); 49 50/* 51 *-------------------------------------------------------------- 52 * 53 * Tk_ConfigureWidget -- 54 * 55 * Process command-line options and database options to fill in fields of 56 * a widget record with resources and other parameters. 57 * 58 * Results: 59 * A standard Tcl return value. In case of an error, the interp's result 60 * will hold an error message. 61 * 62 * Side effects: 63 * The fields of widgRec get filled in with information from argc/argv 64 * and the option database. Old information in widgRec's fields gets 65 * recycled. A copy of the spec-table is taken with (some of) the char* 66 * fields converted into Tk_Uid fields; this copy will be released when 67 * the interpreter terminates. 68 * 69 *-------------------------------------------------------------- 70 */ 71 72int 73Tk_ConfigureWidget( 74 Tcl_Interp *interp, /* Interpreter for error reporting. */ 75 Tk_Window tkwin, /* Window containing widget (needed to set up 76 * X resources). */ 77 Tk_ConfigSpec *specs, /* Describes legal options. */ 78 int argc, /* Number of elements in argv. */ 79 CONST char **argv, /* Command-line options. */ 80 char *widgRec, /* Record whose fields are to be modified. 81 * Values must be properly initialized. */ 82 int flags) /* Used to specify additional flags that must 83 * be present in config specs for them to be 84 * considered. Also, may have 85 * TK_CONFIG_ARGV_ONLY set. */ 86{ 87 register Tk_ConfigSpec *specPtr; 88 Tk_Uid value; /* Value of option from database. */ 89 int needFlags; /* Specs must contain this set of flags or 90 * else they are not considered. */ 91 int hateFlags; /* If a spec contains any bits here, it's not 92 * considered. */ 93 94 if (tkwin == NULL) { 95 /* 96 * Either we're not really in Tk, or the main window was destroyed and 97 * we're on our way out of the application 98 */ 99 100 Tcl_AppendResult(interp, "NULL main window", NULL); 101 return TCL_ERROR; 102 } 103 104 needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); 105 if (Tk_Depth(tkwin) <= 1) { 106 hateFlags = TK_CONFIG_COLOR_ONLY; 107 } else { 108 hateFlags = TK_CONFIG_MONO_ONLY; 109 } 110 111 /* 112 * Get the build of the config for this interpreter. 113 */ 114 115 specs = GetCachedSpecs(interp, specs); 116 117 /* 118 * Pass one: scan through all of the arguments, processing those that 119 * match entries in the specs. 120 */ 121 122 for ( ; argc > 0; argc -= 2, argv += 2) { 123 CONST char *arg; 124 125 if (flags & TK_CONFIG_OBJS) { 126 arg = Tcl_GetStringFromObj((Tcl_Obj *) *argv, NULL); 127 } else { 128 arg = *argv; 129 } 130 specPtr = FindConfigSpec(interp, specs, arg, needFlags, hateFlags); 131 if (specPtr == NULL) { 132 return TCL_ERROR; 133 } 134 135 /* 136 * Process the entry. 137 */ 138 139 if (argc < 2) { 140 Tcl_AppendResult(interp, "value for \"", arg, "\" missing", NULL); 141 return TCL_ERROR; 142 } 143 if (flags & TK_CONFIG_OBJS) { 144 arg = Tcl_GetString((Tcl_Obj *) argv[1]); 145 } else { 146 arg = argv[1]; 147 } 148 if (DoConfig(interp, tkwin, specPtr, arg, 0, widgRec) != TCL_OK) { 149 char msg[100]; 150 151 sprintf(msg, "\n (processing \"%.40s\" option)", 152 specPtr->argvName); 153 Tcl_AddErrorInfo(interp, msg); 154 return TCL_ERROR; 155 } 156 if (!(flags & TK_CONFIG_ARGV_ONLY)) { 157 specPtr->specFlags |= TK_CONFIG_OPTION_SPECIFIED; 158 } 159 } 160 161 /* 162 * Pass two: scan through all of the specs again; if no command-line 163 * argument matched a spec, then check for info in the option database. 164 * If there was nothing in the database, then use the default. 165 */ 166 167 if (!(flags & TK_CONFIG_ARGV_ONLY)) { 168 for (specPtr=specs; specPtr->type!=TK_CONFIG_END; specPtr++) { 169 if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED) 170 || (specPtr->argvName == NULL) 171 || (specPtr->type == TK_CONFIG_SYNONYM)) { 172 specPtr->specFlags &= ~TK_CONFIG_OPTION_SPECIFIED; 173 continue; 174 } 175 if (((specPtr->specFlags & needFlags) != needFlags) 176 || (specPtr->specFlags & hateFlags)) { 177 continue; 178 } 179 value = NULL; 180 if (specPtr->dbName != NULL) { 181 value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass); 182 } 183 if (value != NULL) { 184 if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != 185 TCL_OK) { 186 char msg[200]; 187 188 sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")", 189 "database entry for", 190 specPtr->dbName, Tk_PathName(tkwin)); 191 Tcl_AddErrorInfo(interp, msg); 192 return TCL_ERROR; 193 } 194 } else { 195 if (specPtr->defValue != NULL) { 196 value = Tk_GetUid(specPtr->defValue); 197 } else { 198 value = NULL; 199 } 200 if ((value != NULL) && !(specPtr->specFlags 201 & TK_CONFIG_DONT_SET_DEFAULT)) { 202 if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != 203 TCL_OK) { 204 char msg[200]; 205 206 sprintf(msg, 207 "\n (%s \"%.50s\" in widget \"%.50s\")", 208 "default value for", 209 specPtr->dbName, Tk_PathName(tkwin)); 210 Tcl_AddErrorInfo(interp, msg); 211 return TCL_ERROR; 212 } 213 } 214 } 215 } 216 } 217 218 return TCL_OK; 219} 220 221/* 222 *-------------------------------------------------------------- 223 * 224 * FindConfigSpec -- 225 * 226 * Search through a table of configuration specs, looking for one that 227 * matches a given argvName. 228 * 229 * Results: 230 * The return value is a pointer to the matching entry, or NULL if 231 * nothing matched. In that case an error message is left in the interp's 232 * result. 233 * 234 * Side effects: 235 * None. 236 * 237 *-------------------------------------------------------------- 238 */ 239 240static Tk_ConfigSpec * 241FindConfigSpec( 242 Tcl_Interp *interp, /* Used for reporting errors. */ 243 Tk_ConfigSpec *specs, /* Pointer to table of configuration 244 * specifications for a widget. */ 245 CONST char *argvName, /* Name (suitable for use in a "config" 246 * command) identifying particular option. */ 247 int needFlags, /* Flags that must be present in matching 248 * entry. */ 249 int hateFlags) /* Flags that must NOT be present in matching 250 * entry. */ 251{ 252 register Tk_ConfigSpec *specPtr; 253 register char c; /* First character of current argument. */ 254 Tk_ConfigSpec *matchPtr; /* Matching spec, or NULL. */ 255 size_t length; 256 257 c = argvName[1]; 258 length = strlen(argvName); 259 matchPtr = NULL; 260 for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { 261 if (specPtr->argvName == NULL) { 262 continue; 263 } 264 if ((specPtr->argvName[1] != c) 265 || (strncmp(specPtr->argvName, argvName, length) != 0)) { 266 continue; 267 } 268 if (((specPtr->specFlags & needFlags) != needFlags) 269 || (specPtr->specFlags & hateFlags)) { 270 continue; 271 } 272 if (specPtr->argvName[length] == 0) { 273 matchPtr = specPtr; 274 goto gotMatch; 275 } 276 if (matchPtr != NULL) { 277 Tcl_AppendResult(interp, "ambiguous option \"", argvName, 278 "\"", NULL); 279 return NULL; 280 } 281 matchPtr = specPtr; 282 } 283 284 if (matchPtr == NULL) { 285 Tcl_AppendResult(interp, "unknown option \"", argvName, "\"", NULL); 286 return NULL; 287 } 288 289 /* 290 * Found a matching entry. If it's a synonym, then find the entry that 291 * it's a synonym for. 292 */ 293 294 gotMatch: 295 specPtr = matchPtr; 296 if (specPtr->type == TK_CONFIG_SYNONYM) { 297 for (specPtr = specs; ; specPtr++) { 298 if (specPtr->type == TK_CONFIG_END) { 299 Tcl_AppendResult(interp, "couldn't find synonym for option \"", 300 argvName, "\"", NULL); 301 return NULL; 302 } 303 if ((specPtr->dbName == matchPtr->dbName) 304 && (specPtr->type != TK_CONFIG_SYNONYM) 305 && ((specPtr->specFlags & needFlags) == needFlags) 306 && !(specPtr->specFlags & hateFlags)) { 307 break; 308 } 309 } 310 } 311 return specPtr; 312} 313 314/* 315 *-------------------------------------------------------------- 316 * 317 * DoConfig -- 318 * 319 * This function applies a single configuration option to a widget 320 * record. 321 * 322 * Results: 323 * A standard Tcl return value. 324 * 325 * Side effects: 326 * WidgRec is modified as indicated by specPtr and value. The old value 327 * is recycled, if that is appropriate for the value type. 328 * 329 *-------------------------------------------------------------- 330 */ 331 332static int 333DoConfig( 334 Tcl_Interp *interp, /* Interpreter for error reporting. */ 335 Tk_Window tkwin, /* Window containing widget (needed to set up 336 * X resources). */ 337 Tk_ConfigSpec *specPtr, /* Specifier to apply. */ 338 Tk_Uid value, /* Value to use to fill in widgRec. */ 339 int valueIsUid, /* Non-zero means value is a Tk_Uid; zero 340 * means it's an ordinary string. */ 341 char *widgRec) /* Record whose fields are to be modified. 342 * Values must be properly initialized. */ 343{ 344 char *ptr; 345 Tk_Uid uid; 346 int nullValue; 347 348 nullValue = 0; 349 if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) { 350 nullValue = 1; 351 } 352 353 do { 354 ptr = widgRec + specPtr->offset; 355 switch (specPtr->type) { 356 case TK_CONFIG_BOOLEAN: 357 if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) { 358 return TCL_ERROR; 359 } 360 break; 361 case TK_CONFIG_INT: 362 if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) { 363 return TCL_ERROR; 364 } 365 break; 366 case TK_CONFIG_DOUBLE: 367 if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) { 368 return TCL_ERROR; 369 } 370 break; 371 case TK_CONFIG_STRING: { 372 char *oldStr, *newStr; 373 374 if (nullValue) { 375 newStr = NULL; 376 } else { 377 newStr = (char *) ckalloc((unsigned) (strlen(value) + 1)); 378 strcpy(newStr, value); 379 } 380 oldStr = *((char **) ptr); 381 if (oldStr != NULL) { 382 ckfree(oldStr); 383 } 384 *((char **) ptr) = newStr; 385 break; 386 } 387 case TK_CONFIG_UID: 388 if (nullValue) { 389 *((Tk_Uid *) ptr) = NULL; 390 } else { 391 uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); 392 *((Tk_Uid *) ptr) = uid; 393 } 394 break; 395 case TK_CONFIG_COLOR: { 396 XColor *newPtr, *oldPtr; 397 398 if (nullValue) { 399 newPtr = NULL; 400 } else { 401 uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); 402 newPtr = Tk_GetColor(interp, tkwin, uid); 403 if (newPtr == NULL) { 404 return TCL_ERROR; 405 } 406 } 407 oldPtr = *((XColor **) ptr); 408 if (oldPtr != NULL) { 409 Tk_FreeColor(oldPtr); 410 } 411 *((XColor **) ptr) = newPtr; 412 break; 413 } 414 case TK_CONFIG_FONT: { 415 Tk_Font newFont; 416 417 if (nullValue) { 418 newFont = NULL; 419 } else { 420 newFont = Tk_GetFont(interp, tkwin, value); 421 if (newFont == NULL) { 422 return TCL_ERROR; 423 } 424 } 425 Tk_FreeFont(*((Tk_Font *) ptr)); 426 *((Tk_Font *) ptr) = newFont; 427 break; 428 } 429 case TK_CONFIG_BITMAP: { 430 Pixmap newBmp, oldBmp; 431 432 if (nullValue) { 433 newBmp = None; 434 } else { 435 uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); 436 newBmp = Tk_GetBitmap(interp, tkwin, uid); 437 if (newBmp == None) { 438 return TCL_ERROR; 439 } 440 } 441 oldBmp = *((Pixmap *) ptr); 442 if (oldBmp != None) { 443 Tk_FreeBitmap(Tk_Display(tkwin), oldBmp); 444 } 445 *((Pixmap *) ptr) = newBmp; 446 break; 447 } 448 case TK_CONFIG_BORDER: { 449 Tk_3DBorder newBorder, oldBorder; 450 451 if (nullValue) { 452 newBorder = NULL; 453 } else { 454 uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); 455 newBorder = Tk_Get3DBorder(interp, tkwin, uid); 456 if (newBorder == NULL) { 457 return TCL_ERROR; 458 } 459 } 460 oldBorder = *((Tk_3DBorder *) ptr); 461 if (oldBorder != NULL) { 462 Tk_Free3DBorder(oldBorder); 463 } 464 *((Tk_3DBorder *) ptr) = newBorder; 465 break; 466 } 467 case TK_CONFIG_RELIEF: 468 uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); 469 if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) { 470 return TCL_ERROR; 471 } 472 break; 473 case TK_CONFIG_CURSOR: 474 case TK_CONFIG_ACTIVE_CURSOR: { 475 Tk_Cursor newCursor, oldCursor; 476 477 if (nullValue) { 478 newCursor = None; 479 } else { 480 uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); 481 newCursor = Tk_GetCursor(interp, tkwin, uid); 482 if (newCursor == None) { 483 return TCL_ERROR; 484 } 485 } 486 oldCursor = *((Tk_Cursor *) ptr); 487 if (oldCursor != None) { 488 Tk_FreeCursor(Tk_Display(tkwin), oldCursor); 489 } 490 *((Tk_Cursor *) ptr) = newCursor; 491 if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) { 492 Tk_DefineCursor(tkwin, newCursor); 493 } 494 break; 495 } 496 case TK_CONFIG_JUSTIFY: 497 uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); 498 if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) { 499 return TCL_ERROR; 500 } 501 break; 502 case TK_CONFIG_ANCHOR: 503 uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); 504 if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) { 505 return TCL_ERROR; 506 } 507 break; 508 case TK_CONFIG_CAP_STYLE: 509 uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); 510 if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) { 511 return TCL_ERROR; 512 } 513 break; 514 case TK_CONFIG_JOIN_STYLE: 515 uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); 516 if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) { 517 return TCL_ERROR; 518 } 519 break; 520 case TK_CONFIG_PIXELS: 521 if (Tk_GetPixels(interp, tkwin, value, (int *) ptr) 522 != TCL_OK) { 523 return TCL_ERROR; 524 } 525 break; 526 case TK_CONFIG_MM: 527 if (Tk_GetScreenMM(interp, tkwin, value, (double*)ptr) != TCL_OK) { 528 return TCL_ERROR; 529 } 530 break; 531 case TK_CONFIG_WINDOW: { 532 Tk_Window tkwin2; 533 534 if (nullValue) { 535 tkwin2 = NULL; 536 } else { 537 tkwin2 = Tk_NameToWindow(interp, value, tkwin); 538 if (tkwin2 == NULL) { 539 return TCL_ERROR; 540 } 541 } 542 *((Tk_Window *) ptr) = tkwin2; 543 break; 544 } 545 case TK_CONFIG_CUSTOM: 546 if ((*specPtr->customPtr->parseProc)( 547 specPtr->customPtr->clientData, interp, tkwin, value, 548 widgRec, specPtr->offset) != TCL_OK) { 549 return TCL_ERROR; 550 } 551 break; 552 default: { 553 char buf[64 + TCL_INTEGER_SPACE]; 554 555 sprintf(buf, "bad config table: unknown type %d", specPtr->type); 556 Tcl_SetResult(interp, buf, TCL_VOLATILE); 557 return TCL_ERROR; 558 } 559 } 560 specPtr++; 561 } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END)); 562 return TCL_OK; 563} 564 565/* 566 *-------------------------------------------------------------- 567 * 568 * Tk_ConfigureInfo -- 569 * 570 * Return information about the configuration options for a window, and 571 * their current values. 572 * 573 * Results: 574 * Always returns TCL_OK. The interp's result will be modified hold a 575 * description of either a single configuration option available for 576 * "widgRec" via "specs", or all the configuration options available. In 577 * the "all" case, the result will available for "widgRec" via "specs". 578 * The result will be a list, each of whose entries describes one option. 579 * Each entry will itself be a list containing the option's name for use 580 * on command lines, database name, database class, default value, and 581 * current value (empty string if none). For options that are synonyms, 582 * the list will contain only two values: name and synonym name. If the 583 * "name" argument is non-NULL, then the only information returned is 584 * that for the named argument (i.e. the corresponding entry in the 585 * overall list is returned). 586 * 587 * Side effects: 588 * None. 589 * 590 *-------------------------------------------------------------- 591 */ 592 593int 594Tk_ConfigureInfo( 595 Tcl_Interp *interp, /* Interpreter for error reporting. */ 596 Tk_Window tkwin, /* Window corresponding to widgRec. */ 597 Tk_ConfigSpec *specs, /* Describes legal options. */ 598 char *widgRec, /* Record whose fields contain current values 599 * for options. */ 600 CONST char *argvName, /* If non-NULL, indicates a single option 601 * whose info is to be returned. Otherwise 602 * info is returned for all options. */ 603 int flags) /* Used to specify additional flags that must 604 * be present in config specs for them to be 605 * considered. */ 606{ 607 register Tk_ConfigSpec *specPtr; 608 int needFlags, hateFlags; 609 char *list; 610 char *leader = "{"; 611 612 needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); 613 if (Tk_Depth(tkwin) <= 1) { 614 hateFlags = TK_CONFIG_COLOR_ONLY; 615 } else { 616 hateFlags = TK_CONFIG_MONO_ONLY; 617 } 618 619 /* 620 * Get the build of the config for this interpreter. 621 */ 622 623 specs = GetCachedSpecs(interp, specs); 624 625 /* 626 * If information is only wanted for a single configuration spec, then 627 * handle that one spec specially. 628 */ 629 630 Tcl_SetResult(interp, NULL, TCL_STATIC); 631 if (argvName != NULL) { 632 specPtr = FindConfigSpec(interp, specs, argvName, needFlags,hateFlags); 633 if (specPtr == NULL) { 634 return TCL_ERROR; 635 } 636 Tcl_SetResult(interp, 637 FormatConfigInfo(interp, tkwin, specPtr, widgRec), 638 TCL_DYNAMIC); 639 return TCL_OK; 640 } 641 642 /* 643 * Loop through all the specs, creating a big list with all their 644 * information. 645 */ 646 647 for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { 648 if ((argvName != NULL) && (specPtr->argvName != argvName)) { 649 continue; 650 } 651 if (((specPtr->specFlags & needFlags) != needFlags) 652 || (specPtr->specFlags & hateFlags)) { 653 continue; 654 } 655 if (specPtr->argvName == NULL) { 656 continue; 657 } 658 list = FormatConfigInfo(interp, tkwin, specPtr, widgRec); 659 Tcl_AppendResult(interp, leader, list, "}", NULL); 660 ckfree(list); 661 leader = " {"; 662 } 663 return TCL_OK; 664} 665 666/* 667 *-------------------------------------------------------------- 668 * 669 * FormatConfigInfo -- 670 * 671 * Create a valid Tcl list holding the configuration information for a 672 * single configuration option. 673 * 674 * Results: 675 * A Tcl list, dynamically allocated. The caller is expected to arrange 676 * for this list to be freed eventually. 677 * 678 * Side effects: 679 * Memory is allocated. 680 * 681 *-------------------------------------------------------------- 682 */ 683 684static char * 685FormatConfigInfo( 686 Tcl_Interp *interp, /* Interpreter to use for things like 687 * floating-point precision. */ 688 Tk_Window tkwin, /* Window corresponding to widget. */ 689 register Tk_ConfigSpec *specPtr, 690 /* Pointer to information describing 691 * option. */ 692 char *widgRec) /* Pointer to record holding current values of 693 * info for widget. */ 694{ 695 CONST char *argv[6]; 696 char *result; 697 char buffer[200]; 698 Tcl_FreeProc *freeProc = NULL; 699 700 argv[0] = specPtr->argvName; 701 argv[1] = specPtr->dbName; 702 argv[2] = specPtr->dbClass; 703 argv[3] = specPtr->defValue; 704 if (specPtr->type == TK_CONFIG_SYNONYM) { 705 return Tcl_Merge(2, argv); 706 } 707 argv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, 708 &freeProc); 709 if (argv[1] == NULL) { 710 argv[1] = ""; 711 } 712 if (argv[2] == NULL) { 713 argv[2] = ""; 714 } 715 if (argv[3] == NULL) { 716 argv[3] = ""; 717 } 718 if (argv[4] == NULL) { 719 argv[4] = ""; 720 } 721 result = Tcl_Merge(5, argv); 722 if (freeProc != NULL) { 723 if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) { 724 ckfree((char *)argv[4]); 725 } else { 726 (*freeProc)((char *)argv[4]); 727 } 728 } 729 return result; 730} 731 732/* 733 *---------------------------------------------------------------------- 734 * 735 * FormatConfigValue -- 736 * 737 * This function formats the current value of a configuration option. 738 * 739 * Results: 740 * The return value is the formatted value of the option given by specPtr 741 * and widgRec. If the value is static, so that it need not be freed, 742 * *freeProcPtr will be set to NULL; otherwise *freeProcPtr will be set 743 * to the address of a function to free the result, and the caller must 744 * invoke this function when it is finished with the result. 745 * 746 * Side effects: 747 * None. 748 * 749 *---------------------------------------------------------------------- 750 */ 751 752static CONST char * 753FormatConfigValue( 754 Tcl_Interp *interp, /* Interpreter for use in real conversions. */ 755 Tk_Window tkwin, /* Window corresponding to widget. */ 756 Tk_ConfigSpec *specPtr, /* Pointer to information describing option. 757 * Must not point to a synonym option. */ 758 char *widgRec, /* Pointer to record holding current values of 759 * info for widget. */ 760 char *buffer, /* Static buffer to use for small values. 761 * Must have at least 200 bytes of storage. */ 762 Tcl_FreeProc **freeProcPtr) /* Pointer to word to fill in with address of 763 * function to free the result, or NULL if 764 * result is static. */ 765{ 766 CONST char *ptr, *result; 767 768 *freeProcPtr = NULL; 769 ptr = widgRec + specPtr->offset; 770 result = ""; 771 switch (specPtr->type) { 772 case TK_CONFIG_BOOLEAN: 773 if (*((int *) ptr) == 0) { 774 result = "0"; 775 } else { 776 result = "1"; 777 } 778 break; 779 case TK_CONFIG_INT: 780 sprintf(buffer, "%d", *((int *) ptr)); 781 result = buffer; 782 break; 783 case TK_CONFIG_DOUBLE: 784 Tcl_PrintDouble(interp, *((double *) ptr), buffer); 785 result = buffer; 786 break; 787 case TK_CONFIG_STRING: 788 result = (*(char **) ptr); 789 if (result == NULL) { 790 result = ""; 791 } 792 break; 793 case TK_CONFIG_UID: { 794 Tk_Uid uid = *((Tk_Uid *) ptr); 795 796 if (uid != NULL) { 797 result = uid; 798 } 799 break; 800 } 801 case TK_CONFIG_COLOR: { 802 XColor *colorPtr = *((XColor **) ptr); 803 804 if (colorPtr != NULL) { 805 result = Tk_NameOfColor(colorPtr); 806 } 807 break; 808 } 809 case TK_CONFIG_FONT: { 810 Tk_Font tkfont = *((Tk_Font *) ptr); 811 812 if (tkfont != NULL) { 813 result = Tk_NameOfFont(tkfont); 814 } 815 break; 816 } 817 case TK_CONFIG_BITMAP: { 818 Pixmap pixmap = *((Pixmap *) ptr); 819 820 if (pixmap != None) { 821 result = Tk_NameOfBitmap(Tk_Display(tkwin), pixmap); 822 } 823 break; 824 } 825 case TK_CONFIG_BORDER: { 826 Tk_3DBorder border = *((Tk_3DBorder *) ptr); 827 828 if (border != NULL) { 829 result = Tk_NameOf3DBorder(border); 830 } 831 break; 832 } 833 case TK_CONFIG_RELIEF: 834 result = Tk_NameOfRelief(*((int *) ptr)); 835 break; 836 case TK_CONFIG_CURSOR: 837 case TK_CONFIG_ACTIVE_CURSOR: { 838 Tk_Cursor cursor = *((Tk_Cursor *) ptr); 839 840 if (cursor != None) { 841 result = Tk_NameOfCursor(Tk_Display(tkwin), cursor); 842 } 843 break; 844 } 845 case TK_CONFIG_JUSTIFY: 846 result = Tk_NameOfJustify(*((Tk_Justify *) ptr)); 847 break; 848 case TK_CONFIG_ANCHOR: 849 result = Tk_NameOfAnchor(*((Tk_Anchor *) ptr)); 850 break; 851 case TK_CONFIG_CAP_STYLE: 852 result = Tk_NameOfCapStyle(*((int *) ptr)); 853 break; 854 case TK_CONFIG_JOIN_STYLE: 855 result = Tk_NameOfJoinStyle(*((int *) ptr)); 856 break; 857 case TK_CONFIG_PIXELS: 858 sprintf(buffer, "%d", *((int *) ptr)); 859 result = buffer; 860 break; 861 case TK_CONFIG_MM: 862 Tcl_PrintDouble(interp, *((double *) ptr), buffer); 863 result = buffer; 864 break; 865 case TK_CONFIG_WINDOW: { 866 Tk_Window tkwin; 867 868 tkwin = *((Tk_Window *) ptr); 869 if (tkwin != NULL) { 870 result = Tk_PathName(tkwin); 871 } 872 break; 873 } 874 case TK_CONFIG_CUSTOM: 875 result = (*specPtr->customPtr->printProc)( 876 specPtr->customPtr->clientData, tkwin, widgRec, 877 specPtr->offset, freeProcPtr); 878 break; 879 default: 880 result = "?? unknown type ??"; 881 } 882 return result; 883} 884 885/* 886 *---------------------------------------------------------------------- 887 * 888 * Tk_ConfigureValue -- 889 * 890 * This function returns the current value of a configuration option for 891 * a widget. 892 * 893 * Results: 894 * The return value is a standard Tcl completion code (TCL_OK or 895 * TCL_ERROR). The interp's result will be set to hold either the value 896 * of the option given by argvName (if TCL_OK is returned) or an error 897 * message (if TCL_ERROR is returned). 898 * 899 * Side effects: 900 * None. 901 * 902 *---------------------------------------------------------------------- 903 */ 904 905int 906Tk_ConfigureValue( 907 Tcl_Interp *interp, /* Interpreter for error reporting. */ 908 Tk_Window tkwin, /* Window corresponding to widgRec. */ 909 Tk_ConfigSpec *specs, /* Describes legal options. */ 910 char *widgRec, /* Record whose fields contain current values 911 * for options. */ 912 CONST char *argvName, /* Gives the command-line name for the option 913 * whose value is to be returned. */ 914 int flags) /* Used to specify additional flags that must 915 * be present in config specs for them to be 916 * considered. */ 917{ 918 Tk_ConfigSpec *specPtr; 919 int needFlags, hateFlags; 920 Tcl_FreeProc *freeProc; 921 CONST char *result; 922 char buffer[200]; 923 924 needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); 925 if (Tk_Depth(tkwin) <= 1) { 926 hateFlags = TK_CONFIG_COLOR_ONLY; 927 } else { 928 hateFlags = TK_CONFIG_MONO_ONLY; 929 } 930 931 /* 932 * Get the build of the config for this interpreter. 933 */ 934 935 specs = GetCachedSpecs(interp, specs); 936 937 specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags); 938 if (specPtr == NULL) { 939 return TCL_ERROR; 940 } 941 result = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, 942 &freeProc); 943 Tcl_SetResult(interp, (char *) result, TCL_VOLATILE); 944 if (freeProc != NULL) { 945 if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) { 946 ckfree((char *)result); 947 } else { 948 (*freeProc)((char *)result); 949 } 950 } 951 return TCL_OK; 952} 953 954/* 955 *---------------------------------------------------------------------- 956 * 957 * Tk_FreeOptions -- 958 * 959 * Free up all resources associated with configuration options. 960 * 961 * Results: 962 * None. 963 * 964 * Side effects: 965 * Any resource in widgRec that is controlled by a configuration option 966 * (e.g. a Tk_3DBorder or XColor) is freed in the appropriate fashion. 967 * 968 * Notes: 969 * Since this is not looking anything up, this uses the static version of 970 * the config specs. 971 * 972 *---------------------------------------------------------------------- 973 */ 974 975 /* ARGSUSED */ 976void 977Tk_FreeOptions( 978 Tk_ConfigSpec *specs, /* Describes legal options. */ 979 char *widgRec, /* Record whose fields contain current values 980 * for options. */ 981 Display *display, /* X display; needed for freeing some 982 * resources. */ 983 int needFlags) /* Used to specify additional flags that must 984 * be present in config specs for them to be 985 * considered. */ 986{ 987 register Tk_ConfigSpec *specPtr; 988 char *ptr; 989 990 for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { 991 if ((specPtr->specFlags & needFlags) != needFlags) { 992 continue; 993 } 994 ptr = widgRec + specPtr->offset; 995 switch (specPtr->type) { 996 case TK_CONFIG_STRING: 997 if (*((char **) ptr) != NULL) { 998 ckfree(*((char **) ptr)); 999 *((char **) ptr) = NULL; 1000 } 1001 break; 1002 case TK_CONFIG_COLOR: 1003 if (*((XColor **) ptr) != NULL) { 1004 Tk_FreeColor(*((XColor **) ptr)); 1005 *((XColor **) ptr) = NULL; 1006 } 1007 break; 1008 case TK_CONFIG_FONT: 1009 Tk_FreeFont(*((Tk_Font *) ptr)); 1010 *((Tk_Font *) ptr) = NULL; 1011 break; 1012 case TK_CONFIG_BITMAP: 1013 if (*((Pixmap *) ptr) != None) { 1014 Tk_FreeBitmap(display, *((Pixmap *) ptr)); 1015 *((Pixmap *) ptr) = None; 1016 } 1017 break; 1018 case TK_CONFIG_BORDER: 1019 if (*((Tk_3DBorder *) ptr) != NULL) { 1020 Tk_Free3DBorder(*((Tk_3DBorder *) ptr)); 1021 *((Tk_3DBorder *) ptr) = NULL; 1022 } 1023 break; 1024 case TK_CONFIG_CURSOR: 1025 case TK_CONFIG_ACTIVE_CURSOR: 1026 if (*((Tk_Cursor *) ptr) != None) { 1027 Tk_FreeCursor(display, *((Tk_Cursor *) ptr)); 1028 *((Tk_Cursor *) ptr) = None; 1029 } 1030 } 1031 } 1032} 1033 1034/* 1035 *-------------------------------------------------------------- 1036 * 1037 * GetCachedSpecs -- 1038 * 1039 * Returns a writable per-interpreter (and hence thread-local) copy of 1040 * the given spec-table with (some of) the char* fields converted into 1041 * Tk_Uid fields; this copy will be released when the interpreter 1042 * terminates (during AssocData cleanup). 1043 * 1044 * Results: 1045 * A pointer to the copied table. 1046 * 1047 * Notes: 1048 * The conversion to Tk_Uid is only done the first time, when the table 1049 * copy is taken. After that, the table is assumed to have Tk_Uids where 1050 * they are needed. The time of deletion of the caches isn't very 1051 * important unless you've got a lot of code that uses Tk_ConfigureWidget 1052 * (or *Info or *Value} when the interpreter is being deleted. 1053 * 1054 *-------------------------------------------------------------- 1055 */ 1056 1057static Tk_ConfigSpec * 1058GetCachedSpecs( 1059 Tcl_Interp *interp, /* Interpreter in which to store the cache. */ 1060 const Tk_ConfigSpec *staticSpecs) 1061 /* Value to cache a copy of; it is also used 1062 * as a key into the cache. */ 1063{ 1064 Tk_ConfigSpec *cachedSpecs; 1065 Tcl_HashTable *specCacheTablePtr; 1066 Tcl_HashEntry *entryPtr; 1067 int isNew; 1068 1069 /* 1070 * Get (or allocate if it doesn't exist) the hash table that the writable 1071 * copies of the widget specs are stored in. In effect, this is 1072 * self-initializing code. 1073 */ 1074 1075 specCacheTablePtr = (Tcl_HashTable *) 1076 Tcl_GetAssocData(interp, "tkConfigSpec.threadTable", NULL); 1077 if (specCacheTablePtr == NULL) { 1078 specCacheTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); 1079 Tcl_InitHashTable(specCacheTablePtr, TCL_ONE_WORD_KEYS); 1080 Tcl_SetAssocData(interp, "tkConfigSpec.threadTable", 1081 DeleteSpecCacheTable, (ClientData) specCacheTablePtr); 1082 } 1083 1084 /* 1085 * Look up or create the hash entry that the constant specs are mapped to, 1086 * which will have the writable specs as its associated value. 1087 */ 1088 1089 entryPtr = Tcl_CreateHashEntry(specCacheTablePtr, (char *) staticSpecs, 1090 &isNew); 1091 if (isNew) { 1092 unsigned int entrySpace = sizeof(Tk_ConfigSpec); 1093 const Tk_ConfigSpec *staticSpecPtr; 1094 Tk_ConfigSpec *specPtr; 1095 1096 /* 1097 * OK, no working copy in this interpreter so copy. Need to work out 1098 * how much space to allocate first. 1099 */ 1100 1101 for (staticSpecPtr=staticSpecs; staticSpecPtr->type!=TK_CONFIG_END; 1102 staticSpecPtr++) { 1103 entrySpace += sizeof(Tk_ConfigSpec); 1104 } 1105 1106 /* 1107 * Now allocate our working copy's space and copy over the contents 1108 * from the master copy. 1109 */ 1110 1111 cachedSpecs = (Tk_ConfigSpec *) ckalloc(entrySpace); 1112 memcpy(cachedSpecs, staticSpecs, entrySpace); 1113 Tcl_SetHashValue(entryPtr, (ClientData) cachedSpecs); 1114 1115 /* 1116 * Finally, go through and replace database names, database classes 1117 * and default values with Tk_Uids. This is the bit that has to be 1118 * per-thread. 1119 */ 1120 1121 for (specPtr=cachedSpecs; specPtr->type!=TK_CONFIG_END; specPtr++) { 1122 if (specPtr->argvName != NULL) { 1123 if (specPtr->dbName != NULL) { 1124 specPtr->dbName = Tk_GetUid(specPtr->dbName); 1125 } 1126 if (specPtr->dbClass != NULL) { 1127 specPtr->dbClass = Tk_GetUid(specPtr->dbClass); 1128 } 1129 if (specPtr->defValue != NULL) { 1130 specPtr->defValue = Tk_GetUid(specPtr->defValue); 1131 } 1132 } 1133 specPtr->specFlags &= ~TK_CONFIG_OPTION_SPECIFIED; 1134 } 1135 } else { 1136 cachedSpecs = (Tk_ConfigSpec *) Tcl_GetHashValue(entryPtr); 1137 } 1138 1139 return cachedSpecs; 1140} 1141 1142/* 1143 *-------------------------------------------------------------- 1144 * 1145 * DeleteSpecCacheTable -- 1146 * 1147 * Delete the per-interpreter copy of all the Tk_ConfigSpec tables which 1148 * were stored in the interpreter's assoc-data store. 1149 * 1150 * Results: 1151 * None 1152 * 1153 * Side effects: 1154 * None (does *not* use any Tk API). 1155 * 1156 *-------------------------------------------------------------- 1157 */ 1158 1159static void 1160DeleteSpecCacheTable( 1161 ClientData clientData, 1162 Tcl_Interp *interp) 1163{ 1164 Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData; 1165 Tcl_HashEntry *entryPtr; 1166 Tcl_HashSearch search; 1167 1168 for (entryPtr = Tcl_FirstHashEntry(tablePtr,&search); entryPtr != NULL; 1169 entryPtr = Tcl_NextHashEntry(&search)) { 1170 /* 1171 * Someone else deallocates the Tk_Uids themselves. 1172 */ 1173 1174 ckfree((char *) Tcl_GetHashValue(entryPtr)); 1175 } 1176 Tcl_DeleteHashTable(tablePtr); 1177 ckfree((char *) tablePtr); 1178} 1179 1180/* 1181 * Local Variables: 1182 * mode: c 1183 * c-basic-offset: 4 1184 * fill-column: 78 1185 * End: 1186 */ 1187