![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tkconfig.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tk|
Return to tkconfig.c CVS log | Up to [Micropolis - Activity] / micropolis / src / tk |
1.1 ! root 1: /* ! 2: * tkConfig.c -- ! 3: * ! 4: * This file contains the Tk_ConfigureWidget procedure. ! 5: * ! 6: * Copyright 1990-1992 Regents of the University of California. ! 7: * Permission to use, copy, modify, and distribute this ! 8: * software and its documentation for any purpose and without ! 9: * fee is hereby granted, provided that the above copyright ! 10: * notice appear in all copies. The University of California ! 11: * makes no representations about the suitability of this ! 12: * software for any purpose. It is provided "as is" without ! 13: * express or implied warranty. ! 14: */ ! 15: ! 16: #ifndef lint ! 17: static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkConfig.c,v 1.28 92/07/25 15:52:26 ouster Exp $ SPRITE (Berkeley)"; ! 18: #endif ! 19: ! 20: #include "tkconfig.h" ! 21: #include "tk.h" ! 22: ! 23: /* ! 24: * Values for "flags" field of Tk_ConfigSpec structures. Be sure ! 25: * to coordinate these values with those defined in tk.h ! 26: * (TK_CONFIG_COLOR_ONLY, etc.). There must not be overlap! ! 27: * ! 28: * INIT - Non-zero means (char *) things have been ! 29: * converted to Tk_Uid's. ! 30: */ ! 31: ! 32: #define INIT 0x20 ! 33: ! 34: /* ! 35: * Forward declarations for procedures defined later in this file: ! 36: */ ! 37: ! 38: static int DoConfig _ANSI_ARGS_((Tcl_Interp *interp, ! 39: Tk_Window tkwin, Tk_ConfigSpec *specPtr, ! 40: Tk_Uid value, int valueIsUid, char *widgRec)); ! 41: static Tk_ConfigSpec * FindConfigSpec _ANSI_ARGS_ ((Tcl_Interp *interp, ! 42: Tk_ConfigSpec *specs, char *argvName, ! 43: int needFlags, int hateFlags)); ! 44: static char * FormatConfigInfo _ANSI_ARGS_ ((Tk_Window tkwin, ! 45: Tk_ConfigSpec *specPtr, char *widgRec)); ! 46: ! 47: /* ! 48: *-------------------------------------------------------------- ! 49: * ! 50: * Tk_ConfigureWidget -- ! 51: * ! 52: * Process command-line options and database options to ! 53: * fill in fields of a widget record with resources and ! 54: * other parameters. ! 55: * ! 56: * Results: ! 57: * A standard Tcl return value. In case of an error, ! 58: * interp->result will hold an error message. ! 59: * ! 60: * Side effects: ! 61: * The fields of widgRec get filled in with information ! 62: * from argc/argv and the option database. Old information ! 63: * in widgRec's fields gets recycled. ! 64: * ! 65: *-------------------------------------------------------------- ! 66: */ ! 67: ! 68: int ! 69: Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags) ! 70: Tcl_Interp *interp; /* Interpreter for error reporting. */ ! 71: Tk_Window tkwin; /* Window containing widget (needed to ! 72: * set up X resources). */ ! 73: Tk_ConfigSpec *specs; /* Describes legal options. */ ! 74: int argc; /* Number of elements in argv. */ ! 75: char **argv; /* Command-line options. */ ! 76: char *widgRec; /* Record whose fields are to be ! 77: * modified. Values must be properly ! 78: * initialized. */ ! 79: int flags; /* Used to specify additional flags ! 80: * that must be present in config specs ! 81: * for them to be considered. Also, ! 82: * may have TK_CONFIG_ARGV_ONLY set. */ ! 83: { ! 84: register Tk_ConfigSpec *specPtr; ! 85: Tk_Uid value; /* Value of option from database. */ ! 86: int needFlags; /* Specs must contain this set of flags ! 87: * or else they are not considered. */ ! 88: int hateFlags; /* If a spec contains any bits here, it's ! 89: * not considered. */ ! 90: ! 91: needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); ! 92: if (Tk_DefaultDepth(Tk_Screen(tkwin)) == 1) { ! 93: hateFlags = TK_CONFIG_COLOR_ONLY; ! 94: } else { ! 95: hateFlags = TK_CONFIG_MONO_ONLY; ! 96: } ! 97: ! 98: /* ! 99: * Pass one: scan through all the option specs, replacing strings ! 100: * with Tk_Uids (if this hasn't been done already) and clearing ! 101: * the TK_CONFIG_OPTION_SPECIFIED flags. ! 102: */ ! 103: ! 104: for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { ! 105: if (!(specPtr->specFlags & INIT) && (specPtr->argvName != NULL)) { ! 106: if (specPtr->dbName != NULL) { ! 107: specPtr->dbName = Tk_GetUid(specPtr->dbName); ! 108: } ! 109: if (specPtr->dbClass != NULL) { ! 110: specPtr->dbClass = Tk_GetUid(specPtr->dbClass); ! 111: } ! 112: if (specPtr->defValue != NULL) { ! 113: specPtr->defValue = Tk_GetUid(specPtr->defValue); ! 114: } ! 115: } ! 116: specPtr->specFlags = (specPtr->specFlags & ~TK_CONFIG_OPTION_SPECIFIED) ! 117: | INIT; ! 118: } ! 119: ! 120: /* ! 121: * Pass two: scan through all of the arguments, processing those ! 122: * that match entries in the specs. ! 123: */ ! 124: ! 125: for ( ; argc > 0; argc -= 2, argv += 2) { ! 126: specPtr = FindConfigSpec(interp, specs, *argv, needFlags, hateFlags); ! 127: if (specPtr == NULL) { ! 128: return TCL_ERROR; ! 129: } ! 130: ! 131: /* ! 132: * Process the entry. ! 133: */ ! 134: ! 135: if (argc < 2) { ! 136: Tcl_AppendResult(interp, "value for \"", *argv, ! 137: "\" missing", (char *) NULL); ! 138: return TCL_ERROR; ! 139: } ! 140: if (DoConfig(interp, tkwin, specPtr, argv[1], 0, widgRec) != TCL_OK) { ! 141: char msg[100]; ! 142: ! 143: sprintf(msg, "\n (processing \"%.40s\" option)", ! 144: specPtr->argvName); ! 145: Tcl_AddErrorInfo(interp, msg); ! 146: return TCL_ERROR; ! 147: } ! 148: specPtr->specFlags |= TK_CONFIG_OPTION_SPECIFIED; ! 149: } ! 150: ! 151: /* ! 152: * Pass three: scan through all of the specs again; if no ! 153: * command-line argument matched a spec, then check for info ! 154: * in the option database. If there was nothing in the ! 155: * database, then use the default. ! 156: */ ! 157: ! 158: if (!(flags & TK_CONFIG_ARGV_ONLY)) { ! 159: for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { ! 160: if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED) ! 161: || (specPtr->argvName == NULL) ! 162: || (specPtr->type == TK_CONFIG_SYNONYM)) { ! 163: continue; ! 164: } ! 165: if (((specPtr->specFlags & needFlags) != needFlags) ! 166: || (specPtr->specFlags & hateFlags)) { ! 167: continue; ! 168: } ! 169: value = NULL; ! 170: if (specPtr->dbName != NULL) { ! 171: value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass); ! 172: } ! 173: if (value != NULL) { ! 174: if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != ! 175: TCL_OK) { ! 176: char msg[200]; ! 177: ! 178: sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")", ! 179: "database entry for", ! 180: specPtr->dbName, Tk_PathName(tkwin)); ! 181: Tcl_AddErrorInfo(interp, msg); ! 182: return TCL_ERROR; ! 183: } ! 184: } else { ! 185: value = specPtr->defValue; ! 186: if ((value != NULL) && !(specPtr->specFlags ! 187: & TK_CONFIG_DONT_SET_DEFAULT)) { ! 188: if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != ! 189: TCL_OK) { ! 190: char msg[200]; ! 191: ! 192: sprintf(msg, ! 193: "\n (%s \"%.50s\" in widget \"%.50s\")", ! 194: "default value for", ! 195: specPtr->dbName, Tk_PathName(tkwin)); ! 196: Tcl_AddErrorInfo(interp, msg); ! 197: return TCL_ERROR; ! 198: } ! 199: } ! 200: } ! 201: } ! 202: } ! 203: ! 204: return TCL_OK; ! 205: } ! 206: ! 207: /* ! 208: *-------------------------------------------------------------- ! 209: * ! 210: * FindConfigSpec -- ! 211: * ! 212: * Search through a table of configuration specs, looking for ! 213: * one that matches a given argvName. ! 214: * ! 215: * Results: ! 216: * The return value is a pointer to the matching entry, or NULL ! 217: * if nothing matched. In that case an error message is left ! 218: * in interp->result. ! 219: * ! 220: * Side effects: ! 221: * None. ! 222: * ! 223: *-------------------------------------------------------------- ! 224: */ ! 225: ! 226: static Tk_ConfigSpec * ! 227: FindConfigSpec(interp, specs, argvName, needFlags, hateFlags) ! 228: Tcl_Interp *interp; /* Used for reporting errors. */ ! 229: Tk_ConfigSpec *specs; /* Pointer to table of configuration ! 230: * specifications for a widget. */ ! 231: char *argvName; /* Name (suitable for use in a "config" ! 232: * command) identifying particular option. */ ! 233: int needFlags; /* Flags that must be present in matching ! 234: * entry. */ ! 235: int hateFlags; /* Flags that must NOT be present in ! 236: * matching entry. */ ! 237: { ! 238: register Tk_ConfigSpec *specPtr; ! 239: register char c; /* First character of current argument. */ ! 240: Tk_ConfigSpec *matchPtr; /* Matching spec, or NULL. */ ! 241: int length; ! 242: ! 243: c = argvName[1]; ! 244: length = strlen(argvName); ! 245: matchPtr = NULL; ! 246: for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { ! 247: if (specPtr->argvName == NULL) { ! 248: continue; ! 249: } ! 250: if ((specPtr->argvName[1] != c) ! 251: || (strncmp(specPtr->argvName, argvName, length) != 0)) { ! 252: continue; ! 253: } ! 254: if (((specPtr->specFlags & needFlags) != needFlags) ! 255: || (specPtr->specFlags & hateFlags)) { ! 256: continue; ! 257: } ! 258: if (specPtr->argvName[length] == 0) { ! 259: matchPtr = specPtr; ! 260: goto gotMatch; ! 261: } ! 262: if (matchPtr != NULL) { ! 263: Tcl_AppendResult(interp, "ambiguous option \"", argvName, ! 264: "\"", (char *) NULL); ! 265: return (Tk_ConfigSpec *) NULL; ! 266: } ! 267: matchPtr = specPtr; ! 268: } ! 269: ! 270: if (matchPtr == NULL) { ! 271: Tcl_AppendResult(interp, "unknown option \"", argvName, ! 272: "\"", (char *) NULL); ! 273: return (Tk_ConfigSpec *) NULL; ! 274: } ! 275: ! 276: /* ! 277: * Found a matching entry. If it's a synonym, then find the ! 278: * entry that it's a synonym for. ! 279: */ ! 280: ! 281: gotMatch: ! 282: specPtr = matchPtr; ! 283: if (specPtr->type == TK_CONFIG_SYNONYM) { ! 284: for (specPtr = specs; ; specPtr++) { ! 285: if (specPtr->type == TK_CONFIG_END) { ! 286: Tcl_AppendResult(interp, ! 287: "couldn't find synonym for option \"", ! 288: argvName, "\"", (char *) NULL); ! 289: return (Tk_ConfigSpec *) NULL; ! 290: } ! 291: if ((specPtr->dbName == matchPtr->dbName) ! 292: && (specPtr->type != TK_CONFIG_SYNONYM) ! 293: && ((specPtr->specFlags & needFlags) == needFlags) ! 294: && !(specPtr->specFlags & hateFlags)) { ! 295: break; ! 296: } ! 297: } ! 298: } ! 299: return specPtr; ! 300: } ! 301: ! 302: /* ! 303: *-------------------------------------------------------------- ! 304: * ! 305: * DoConfig -- ! 306: * ! 307: * This procedure applies a single configuration option ! 308: * to a widget record. ! 309: * ! 310: * Results: ! 311: * A standard Tcl return value. ! 312: * ! 313: * Side effects: ! 314: * WidgRec is modified as indicated by specPtr and value. ! 315: * The old value is recycled, if that is appropriate for ! 316: * the value type. ! 317: * ! 318: *-------------------------------------------------------------- ! 319: */ ! 320: ! 321: static int ! 322: DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec) ! 323: Tcl_Interp *interp; /* Interpreter for error reporting. */ ! 324: Tk_Window tkwin; /* Window containing widget (needed to ! 325: * set up X resources). */ ! 326: Tk_ConfigSpec *specPtr; /* Specifier to apply. */ ! 327: char *value; /* Value to use to fill in widgRec. */ ! 328: int valueIsUid; /* Non-zero means value is a Tk_Uid; ! 329: * zero means it's an ordinary string. */ ! 330: char *widgRec; /* Record whose fields are to be ! 331: * modified. Values must be properly ! 332: * initialized. */ ! 333: { ! 334: char *ptr; ! 335: Tk_Uid uid; ! 336: int nullValue; ! 337: ! 338: nullValue = 0; ! 339: if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) { ! 340: nullValue = 1; ! 341: } ! 342: ! 343: do { ! 344: ptr = widgRec + specPtr->offset; ! 345: switch (specPtr->type) { ! 346: case TK_CONFIG_BOOLEAN: ! 347: if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) { ! 348: return TCL_ERROR; ! 349: } ! 350: break; ! 351: case TK_CONFIG_INT: ! 352: if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) { ! 353: return TCL_ERROR; ! 354: } ! 355: break; ! 356: case TK_CONFIG_DOUBLE: ! 357: if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) { ! 358: return TCL_ERROR; ! 359: } ! 360: break; ! 361: case TK_CONFIG_STRING: { ! 362: char *old, *new; ! 363: ! 364: if (nullValue) { ! 365: new = NULL; ! 366: } else { ! 367: new = (char *) ckalloc((unsigned) (strlen(value) + 1)); ! 368: strcpy(new, value); ! 369: } ! 370: old = *((char **) ptr); ! 371: if (old != NULL) { ! 372: ckfree(old); ! 373: } ! 374: *((char **) ptr) = new; ! 375: break; ! 376: } ! 377: case TK_CONFIG_UID: ! 378: if (nullValue) { ! 379: *((Tk_Uid *) ptr) = NULL; ! 380: } else { ! 381: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); ! 382: *((Tk_Uid *) ptr) = uid; ! 383: } ! 384: break; ! 385: case TK_CONFIG_COLOR: { ! 386: XColor *newPtr, *oldPtr; ! 387: ! 388: if (nullValue) { ! 389: newPtr = NULL; ! 390: } else { ! 391: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); ! 392: newPtr = Tk_GetColor(interp, tkwin, (Colormap) None, uid); ! 393: if (newPtr == NULL) { ! 394: return TCL_ERROR; ! 395: } ! 396: } ! 397: oldPtr = *((XColor **) ptr); ! 398: if (oldPtr != NULL) { ! 399: Tk_FreeColor(oldPtr); ! 400: } ! 401: *((XColor **) ptr) = newPtr; ! 402: break; ! 403: } ! 404: case TK_CONFIG_FONT: { ! 405: XFontStruct *newPtr, *oldPtr; ! 406: ! 407: if (nullValue) { ! 408: newPtr = NULL; ! 409: } else { ! 410: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); ! 411: newPtr = Tk_GetFontStruct(interp, tkwin, uid); ! 412: if (newPtr == NULL) { ! 413: return TCL_ERROR; ! 414: } ! 415: } ! 416: oldPtr = *((XFontStruct **) ptr); ! 417: if (oldPtr != NULL) { ! 418: Tk_FreeFontStruct(oldPtr); ! 419: } ! 420: *((XFontStruct **) ptr) = newPtr; ! 421: break; ! 422: } ! 423: case TK_CONFIG_BITMAP: { ! 424: Pixmap new, old; ! 425: ! 426: if (nullValue) { ! 427: new = None; ! 428: } else { ! 429: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); ! 430: new = Tk_GetBitmap(interp, tkwin, uid); ! 431: if (new == None) { ! 432: return TCL_ERROR; ! 433: } ! 434: } ! 435: old = *((Pixmap *) ptr); ! 436: if (old != None) { ! 437: Tk_FreeBitmap(old); ! 438: } ! 439: *((Pixmap *) ptr) = new; ! 440: break; ! 441: } ! 442: #if defined(USE_XPM3) ! 443: case TK_CONFIG_PIXMAP: { ! 444: Pixmap new, old; ! 445: ! 446: if (nullValue) { ! 447: new = None; ! 448: } else { ! 449: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); ! 450: new = Tk_GetPixmap(interp, tkwin, uid); ! 451: if (new == None) { ! 452: return TCL_ERROR; ! 453: } ! 454: } ! 455: old = *((Pixmap *) ptr); ! 456: if (old != None) { ! 457: Tk_FreePixmap(old); ! 458: } ! 459: *((Pixmap *) ptr) = new; ! 460: break; ! 461: } ! 462: #endif ! 463: case TK_CONFIG_BORDER: { ! 464: Tk_3DBorder new, old; ! 465: ! 466: if (nullValue) { ! 467: new = NULL; ! 468: } else { ! 469: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); ! 470: new = Tk_Get3DBorder(interp, tkwin, (Colormap) None, uid); ! 471: if (new == NULL) { ! 472: return TCL_ERROR; ! 473: } ! 474: } ! 475: old = *((Tk_3DBorder *) ptr); ! 476: if (old != NULL) { ! 477: Tk_Free3DBorder(old); ! 478: } ! 479: *((Tk_3DBorder *) ptr) = new; ! 480: break; ! 481: } ! 482: case TK_CONFIG_RELIEF: ! 483: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); ! 484: if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) { ! 485: return TCL_ERROR; ! 486: } ! 487: break; ! 488: case TK_CONFIG_CURSOR: ! 489: case TK_CONFIG_ACTIVE_CURSOR: { ! 490: Cursor new, old; ! 491: ! 492: if (nullValue) { ! 493: new = None; ! 494: } else { ! 495: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); ! 496: new = Tk_GetCursor(interp, tkwin, uid); ! 497: if (new == None) { ! 498: return TCL_ERROR; ! 499: } ! 500: } ! 501: old = *((Cursor *) ptr); ! 502: if (old != None) { ! 503: Tk_FreeCursor(old); ! 504: } ! 505: *((Cursor *) ptr) = new; ! 506: if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) { ! 507: Tk_DefineCursor(tkwin, new); ! 508: } ! 509: break; ! 510: } ! 511: case TK_CONFIG_JUSTIFY: ! 512: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); ! 513: if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) { ! 514: return TCL_ERROR; ! 515: } ! 516: break; ! 517: case TK_CONFIG_ANCHOR: ! 518: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); ! 519: if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) { ! 520: return TCL_ERROR; ! 521: } ! 522: break; ! 523: case TK_CONFIG_CAP_STYLE: ! 524: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); ! 525: if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) { ! 526: return TCL_ERROR; ! 527: } ! 528: break; ! 529: case TK_CONFIG_JOIN_STYLE: ! 530: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value); ! 531: if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) { ! 532: return TCL_ERROR; ! 533: } ! 534: break; ! 535: case TK_CONFIG_PIXELS: ! 536: if (Tk_GetPixels(interp, tkwin, value, (int *) ptr) ! 537: != TCL_OK) { ! 538: return TCL_ERROR; ! 539: } ! 540: break; ! 541: case TK_CONFIG_MM: ! 542: if (Tk_GetScreenMM(interp, tkwin, value, (double *) ptr) ! 543: != TCL_OK) { ! 544: return TCL_ERROR; ! 545: } ! 546: break; ! 547: case TK_CONFIG_WINDOW: { ! 548: Tk_Window tkwin2; ! 549: ! 550: if (nullValue) { ! 551: tkwin2 = NULL; ! 552: } else { ! 553: tkwin2 = Tk_NameToWindow(interp, value, tkwin); ! 554: if (tkwin2 == NULL) { ! 555: return TCL_ERROR; ! 556: } ! 557: } ! 558: *((Tk_Window *) ptr) = tkwin2; ! 559: break; ! 560: } ! 561: case TK_CONFIG_CUSTOM: ! 562: if ((*specPtr->customPtr->parseProc)( ! 563: specPtr->customPtr->clientData, interp, tkwin, ! 564: value, widgRec, specPtr->offset) != TCL_OK) { ! 565: return TCL_ERROR; ! 566: } ! 567: break; ! 568: default: { ! 569: sprintf(interp->result, "bad config table: unknown type %d", ! 570: specPtr->type); ! 571: return TCL_ERROR; ! 572: } ! 573: } ! 574: specPtr++; ! 575: } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END)); ! 576: return TCL_OK; ! 577: } ! 578: ! 579: /* ! 580: *-------------------------------------------------------------- ! 581: * ! 582: * Tk_ConfigureInfo -- ! 583: * ! 584: * Return information about the configuration options ! 585: * for a window, and their current values. ! 586: * ! 587: * Results: ! 588: * Always returns TCL_OK. Interp->result will be modified ! 589: * hold a description of either a single configuration option ! 590: * available for "widgRec" via "specs", or all the configuration ! 591: * options available. In the "all" case, the result will ! 592: * available for "widgRec" via "specs". The result will ! 593: * be a list, each of whose entries describes one option. ! 594: * Each entry will itself be a list containing the option's ! 595: * name for use on command lines, database name, database ! 596: * class, default value, and current value (empty string ! 597: * if none). For options that are synonyms, the list will ! 598: * contain only two values: name and synonym name. If the ! 599: * "name" argument is non-NULL, then the only information ! 600: * returned is that for the named argument (i.e. the corresponding ! 601: * entry in the overall list is returned). ! 602: * ! 603: * Side effects: ! 604: * None. ! 605: * ! 606: *-------------------------------------------------------------- ! 607: */ ! 608: ! 609: int ! 610: Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags) ! 611: Tcl_Interp *interp; /* Interpreter for error reporting. */ ! 612: Tk_Window tkwin; /* Window corresponding to widgRec. */ ! 613: Tk_ConfigSpec *specs; /* Describes legal options. */ ! 614: char *widgRec; /* Record whose fields contain current ! 615: * values for options. */ ! 616: char *argvName; /* If non-NULL, indicates a single option ! 617: * whose info is to be returned. Otherwise ! 618: * info is returned for all options. */ ! 619: int flags; /* Used to specify additional flags ! 620: * that must be present in config specs ! 621: * for them to be considered. */ ! 622: { ! 623: register Tk_ConfigSpec *specPtr; ! 624: int needFlags, hateFlags; ! 625: char *list; ! 626: char *leader = "{"; ! 627: ! 628: needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); ! 629: if (Tk_DefaultDepth(Tk_Screen(tkwin)) == 1) { ! 630: hateFlags = TK_CONFIG_COLOR_ONLY; ! 631: } else { ! 632: hateFlags = TK_CONFIG_MONO_ONLY; ! 633: } ! 634: ! 635: /* ! 636: * If information is only wanted for a single configuration ! 637: * spec, then handle that one spec specially. ! 638: */ ! 639: ! 640: Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); ! 641: if (argvName != NULL) { ! 642: specPtr = FindConfigSpec(interp, specs, argvName, needFlags, ! 643: hateFlags); ! 644: if (specPtr == NULL) { ! 645: return TCL_ERROR; ! 646: } ! 647: interp->result = FormatConfigInfo(tkwin, specPtr, widgRec); ! 648: interp->freeProc = TCL_DYNAMIC; ! 649: return TCL_OK; ! 650: } ! 651: ! 652: /* ! 653: * Loop through all the specs, creating a big list with all ! 654: * their information. ! 655: */ ! 656: ! 657: for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { ! 658: if ((argvName != NULL) && (specPtr->argvName != argvName)) { ! 659: continue; ! 660: } ! 661: if (((specPtr->specFlags & needFlags) != needFlags) ! 662: || (specPtr->specFlags & hateFlags)) { ! 663: continue; ! 664: } ! 665: if (specPtr->argvName == NULL) { ! 666: continue; ! 667: } ! 668: list = FormatConfigInfo(tkwin, specPtr, widgRec); ! 669: Tcl_AppendResult(interp, leader, list, "}", (char *) NULL); ! 670: ckfree(list); ! 671: leader = " {"; ! 672: } ! 673: return TCL_OK; ! 674: } ! 675: ! 676: /* ! 677: *-------------------------------------------------------------- ! 678: * ! 679: * FormatConfigInfo -- ! 680: * ! 681: * Create a valid Tcl list holding the configuration information ! 682: * for a single configuration option. ! 683: * ! 684: * Results: ! 685: * A Tcl list, dynamically allocated. The caller is expected to ! 686: * arrange for this list to be freed eventually. ! 687: * ! 688: * Side effects: ! 689: * Memory is allocated. ! 690: * ! 691: *-------------------------------------------------------------- ! 692: */ ! 693: ! 694: static char * ! 695: FormatConfigInfo(tkwin, specPtr, widgRec) ! 696: Tk_Window tkwin; /* Window corresponding to widget. */ ! 697: register Tk_ConfigSpec *specPtr; /* Pointer to information describing ! 698: * option. */ ! 699: char *widgRec; /* Pointer to record holding current ! 700: * values of info for widget. */ ! 701: { ! 702: char *argv[6], *ptr, *result; ! 703: char buffer[200]; ! 704: Tcl_FreeProc *freeProc = (Tcl_FreeProc *) NULL; ! 705: ! 706: argv[0] = specPtr->argvName; ! 707: argv[1] = specPtr->dbName; ! 708: argv[2] = specPtr->dbClass; ! 709: argv[3] = specPtr->defValue; ! 710: if (specPtr->type == TK_CONFIG_SYNONYM) { ! 711: return Tcl_Merge(2, argv); ! 712: } ! 713: ptr = widgRec + specPtr->offset; ! 714: argv[4] = ""; ! 715: switch (specPtr->type) { ! 716: case TK_CONFIG_BOOLEAN: ! 717: if (*((int *) ptr) == 0) { ! 718: argv[4] = "false"; ! 719: } else { ! 720: argv[4] = "true"; ! 721: } ! 722: break; ! 723: case TK_CONFIG_INT: ! 724: sprintf(buffer, "%d", *((int *) ptr)); ! 725: argv[4] = buffer; ! 726: break; ! 727: case TK_CONFIG_DOUBLE: ! 728: sprintf(buffer, "%g", *((double *) ptr)); ! 729: argv[4] = buffer; ! 730: break; ! 731: case TK_CONFIG_STRING: ! 732: argv[4] = (*(char **) ptr); ! 733: break; ! 734: case TK_CONFIG_UID: { ! 735: Tk_Uid uid = *((Tk_Uid *) ptr); ! 736: if (uid != NULL) { ! 737: argv[4] = uid; ! 738: } ! 739: break; ! 740: } ! 741: case TK_CONFIG_COLOR: { ! 742: XColor *colorPtr = *((XColor **) ptr); ! 743: if (colorPtr != NULL) { ! 744: argv[4] = Tk_NameOfColor(colorPtr); ! 745: } ! 746: break; ! 747: } ! 748: case TK_CONFIG_FONT: { ! 749: XFontStruct *fontStructPtr = *((XFontStruct **) ptr); ! 750: if (fontStructPtr != NULL) { ! 751: argv[4] = Tk_NameOfFontStruct(fontStructPtr); ! 752: } ! 753: break; ! 754: } ! 755: case TK_CONFIG_BITMAP: { ! 756: Pixmap pixmap = *((Pixmap *) ptr); ! 757: if (pixmap != None) { ! 758: argv[4] = Tk_NameOfBitmap(pixmap); ! 759: } ! 760: break; ! 761: } ! 762: #if defined(USE_XPM3) ! 763: case TK_CONFIG_PIXMAP: { ! 764: Pixmap pixmap = *((Pixmap *) ptr); ! 765: if (pixmap != None) { ! 766: argv[4] = Tk_NameOfPixmap(pixmap); ! 767: } ! 768: break; ! 769: } ! 770: #endif ! 771: case TK_CONFIG_BORDER: { ! 772: Tk_3DBorder border = *((Tk_3DBorder *) ptr); ! 773: if (border != NULL) { ! 774: argv[4] = Tk_NameOf3DBorder(border); ! 775: } ! 776: break; ! 777: } ! 778: case TK_CONFIG_RELIEF: ! 779: argv[4] = Tk_NameOfRelief(*((int *) ptr)); ! 780: break; ! 781: case TK_CONFIG_CURSOR: ! 782: case TK_CONFIG_ACTIVE_CURSOR: { ! 783: Cursor cursor = *((Cursor *) ptr); ! 784: if (cursor != None) { ! 785: argv[4] = Tk_NameOfCursor(cursor); ! 786: } ! 787: break; ! 788: } ! 789: case TK_CONFIG_JUSTIFY: ! 790: argv[4] = Tk_NameOfJustify(*((Tk_Justify *) ptr)); ! 791: break; ! 792: case TK_CONFIG_ANCHOR: ! 793: argv[4] = Tk_NameOfAnchor(*((Tk_Anchor *) ptr)); ! 794: break; ! 795: case TK_CONFIG_CAP_STYLE: ! 796: argv[4] = Tk_NameOfCapStyle(*((int *) ptr)); ! 797: break; ! 798: case TK_CONFIG_JOIN_STYLE: ! 799: argv[4] = Tk_NameOfJoinStyle(*((int *) ptr)); ! 800: break; ! 801: case TK_CONFIG_PIXELS: ! 802: sprintf(buffer, "%d", *((int *) ptr)); ! 803: argv[4] = buffer; ! 804: break; ! 805: case TK_CONFIG_MM: ! 806: sprintf(buffer, "%gm", *((int *) ptr)); ! 807: argv[4] = buffer; ! 808: break; ! 809: case TK_CONFIG_WINDOW: { ! 810: Tk_Window tkwin; ! 811: ! 812: tkwin = *((Tk_Window *) ptr); ! 813: if (tkwin != NULL) { ! 814: argv[4] = Tk_PathName(tkwin); ! 815: } ! 816: break; ! 817: } ! 818: case TK_CONFIG_CUSTOM: ! 819: argv[4] = (*specPtr->customPtr->printProc)( ! 820: specPtr->customPtr->clientData, tkwin, widgRec, ! 821: specPtr->offset, &freeProc); ! 822: break; ! 823: default: ! 824: argv[4] = "?? unknown type ??"; ! 825: } ! 826: if (argv[1] == NULL) { ! 827: argv[1] = ""; ! 828: } ! 829: if (argv[2] == NULL) { ! 830: argv[2] = ""; ! 831: } ! 832: if (argv[3] == NULL) { ! 833: argv[3] = ""; ! 834: } ! 835: if (argv[4] == NULL) { ! 836: argv[4] = ""; ! 837: } ! 838: result = Tcl_Merge(5, argv); ! 839: if (freeProc != NULL) { ! 840: if (freeProc == (Tcl_FreeProc *) free) { ! 841: ckfree(argv[4]); ! 842: } else { ! 843: (*freeProc)(argv[4]); ! 844: } ! 845: } ! 846: return result; ! 847: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.