util/src/TclTk/blt2.5/generic/bltObjConfig.c

   1 /*
   2  * bltObjConfig.c --
   3  *
   4  *      This file contains the Tk_ConfigureWidget procedure. THIS FILE
   5  *      IS HERE FOR BACKWARD COMPATIBILITY; THE NEW CONFIGURATION
   6  *      PACKAGE SHOULD BE 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
  12  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13  *
  14  * RCS: @(#) $Id: bltObjConfig.c,v 1.4 2009/10/25 04:30:52 pcmacdon Exp $
  15  */
  16
  17 #include "bltInt.h"
  18 #if (TK_VERSION_NUMBER >= _VERSION(8,0,0))
  19 #if defined(__STDC__)
  20 #include <stdarg.h>
  21 #else
  22 #include <varargs.h>
  23 #endif
  24 #include "bltObjConfig.h"
  25 #include "bltTile.h"
  26
  27 static Blt_ConfigSpec * GetCachedBltSpecs _ANSI_ARGS_((Tcl_Interp *interp,
  28                             const Blt_ConfigSpec *staticSpecs));
  29 static void             DeleteSpecCacheTable _ANSI_ARGS_((
  30                             ClientData clientData, Tcl_Interp *interp));
  31
  32 #if (TK_VERSION_NUMBER < _VERSION(8,1,0))
  33 /*
  34  *----------------------------------------------------------------------
  35  *
  36  * Tk_GetAnchorFromObj --
  37  *
  38  *      Return a Tk_Anchor value based on the value of the objPtr.
  39  *
  40  * Results:
  41  *      The return value is a standard Tcl result. If an error occurs during
  42  *      conversion, an error message is left in the interpreter's result
  43  *      unless "interp" is NULL.
  44  *
  45  * Side effects:
  46  *      The object gets converted by Tcl_GetIndexFromObj.
  47  *
  48  *----------------------------------------------------------------------
  49  */
  50 int
  51 Tk_GetAnchorFromObj(interp, objPtr, anchorPtr)
  52     Tcl_Interp *interp;         /* Used for error reporting. */
  53     Tcl_Obj *objPtr;            /* The object we are trying to get the
  54                                  * value from. */
  55     Tk_Anchor *anchorPtr;       /* Where to place the Tk_Anchor that
  56                                  * corresponds to the string value of
  57                                  * objPtr. */
  58 {
  59     return Tk_GetAnchor(interp, Tcl_GetString(objPtr), anchorPtr);
  60 }
  61
  62 /*
  63  *----------------------------------------------------------------------
  64  *
  65  * Tk_GetJustifyFromObj --
  66  *
  67  *      Return a Tk_Justify value based on the value of the objPtr.
  68  *
  69  * Results:
  70  *      The return value is a standard Tcl result. If an error occurs during
  71  *      conversion, an error message is left in the interpreter's result
  72  *      unless "interp" is NULL.
  73  *
  74  * Side effects:
  75  *      The object gets converted by Tcl_GetIndexFromObj.
  76  *
  77  *----------------------------------------------------------------------
  78  */
  79 int
  80 Tk_GetJustifyFromObj(interp, objPtr, justifyPtr)
  81     Tcl_Interp *interp;         /* Used for error reporting. */
  82     Tcl_Obj *objPtr;            /* The object we are trying to get the
  83                                  * value from. */
  84     Tk_Justify *justifyPtr;     /* Where to place the Tk_Justify that
  85                                  * corresponds to the string value of
  86                                  * objPtr. */
  87 {
  88     return Tk_GetJustify(interp, Tcl_GetString(objPtr), justifyPtr);
  89 }
  90 /*
  91  *----------------------------------------------------------------------
  92  *
  93  * Tk_GetReliefFromObj --
  94  *
  95  *      Return an integer value based on the value of the objPtr.
  96  *
  97  * Results:
  98  *      The return value is a standard Tcl result. If an error occurs during
  99  *      conversion, an error message is left in the interpreter's result
 100  *      unless "interp" is NULL.
 101  *
 102  * Side effects:
 103  *      The object gets converted by Tcl_GetIndexFromObj.
 104  *
 105  *----------------------------------------------------------------------
 106  */
 107 int
 108 Tk_GetReliefFromObj(interp, objPtr, reliefPtr)
 109     Tcl_Interp *interp;         /* Used for error reporting. */
 110     Tcl_Obj *objPtr;            /* The object we are trying to get the
 111                                  * value from. */
 112     int *reliefPtr;             /* Where to place the answer. */
 113 {
 114     return Tk_GetRelief(interp, Tcl_GetString(objPtr), reliefPtr);
 115 }
 116 /*
 117  *----------------------------------------------------------------------
 118  *
 119  * Tk_GetMMFromObj --
 120  *
 121  *      Attempt to return an mm value from the Tcl object "objPtr". If the
 122  *      object is not already an mm value, an attempt will be made to convert
 123  *      it to one.
 124  *
 125  * Results:
 126  *      The return value is a standard Tcl object result. If an error occurs
 127  *      during conversion, an error message is left in the interpreter's
 128  *      result unless "interp" is NULL.
 129  *
 130  * Side effects:
 131  *      If the object is not already a pixel, the conversion will free
 132  *      any old internal representation.
 133  *
 134  *----------------------------------------------------------------------
 135  */
 136 int
 137 Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr)
 138     Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
 139     Tk_Window tkwin;
 140     Tcl_Obj *objPtr;            /* The object from which to get mms. */
 141     double *doublePtr;          /* Place to store resulting millimeters. */
 142 {
 143     return Tk_GetScreenMM(interp, tkwin, Tcl_GetString(objPtr), doublePtr);
 144 }
 145 /*
 146  *----------------------------------------------------------------------
 147  *
 148  * Tk_GetPixelsFromObj --
 149  *
 150  *      Attempt to return a pixel value from the Tcl object "objPtr". If the
 151  *      object is not already a pixel value, an attempt will be made to convert
 152  *      it to one.
 153  *
 154  * Results:
 155  *      The return value is a standard Tcl object result. If an error occurs
 156  *      during conversion, an error message is left in the interpreter's
 157  *      result unless "interp" is NULL.
 158  *
 159  * Side effects:
 160  *      If the object is not already a pixel, the conversion will free
 161  *      any old internal representation.
 162  *
 163  *----------------------------------------------------------------------
 164  */
 165 int
 166 Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr)
 167     Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
 168     Tk_Window tkwin;
 169     Tcl_Obj *objPtr;            /* The object from which to get pixels. */
 170     int *intPtr;                /* Place to store resulting pixels. */
 171 {
 172     return Tk_GetPixels(interp, tkwin, Tcl_GetString(objPtr), intPtr);
 173 }
 174
 175 /*
 176  *----------------------------------------------------------------------
 177  *
 178  * Tk_Alloc3DBorderFromObj --
 179  *
 180  *      Given a Tcl_Obj *, map the value to a corresponding
 181  *      Tk_3DBorder structure based on the tkwin given.
 182  *
 183  * Results:
 184  *      The return value is a token for a data structure describing a
 185  *      3-D border.  This token may be passed to procedures such as
 186  *      Blt_Draw3DRectangle and Tk_Free3DBorder.  If an error prevented
 187  *      the border from being created then NULL is returned and an error
 188  *      message will be left in the interp's result.
 189  *
 190  * Side effects:
 191  *      The border is added to an internal database with a reference
 192  *      count. For each call to this procedure, there should eventually
 193  *      be a call to FreeBorderObjProc so that the database is
 194  *      cleaned up when borders aren't in use anymore.
 195  *
 196  *----------------------------------------------------------------------
 197  */
 198 Tk_3DBorder
 199 Tk_Alloc3DBorderFromObj(interp, tkwin, objPtr)
 200     Tcl_Interp *interp;         /* Interp for error results. */
 201     Tk_Window tkwin;            /* Need the screen the border is used on.*/
 202     Tcl_Obj *objPtr;            /* Object giving name of color for window
 203                                  * background. */
 204 {
 205     return Tk_Get3DBorder(interp, tkwin, Tcl_GetString(objPtr));
 206 }
 207 /*
 208  *----------------------------------------------------------------------
 209  *
 210  * Tk_AllocBitmapFromObj --
 211  *
 212  *      Given a Tcl_Obj *, map the value to a corresponding
 213  *      Pixmap structure based on the tkwin given.
 214  *
 215  * Results:
 216  *      The return value is the X identifer for the desired bitmap
 217  *      (i.e. a Pixmap with a single plane), unless string couldn't be
 218  *      parsed correctly.  In this case, None is returned and an error
 219  *      message is left in the interp's result.  The caller should never
 220  *      modify the bitmap that is returned, and should eventually call
 221  *      Tk_FreeBitmapFromObj when the bitmap is no longer needed.
 222  *
 223  * Side effects:
 224  *      The bitmap is added to an internal database with a reference count.
 225  *      For each call to this procedure, there should eventually be a call
 226  *      to Tk_FreeBitmapFromObj, so that the database can be cleaned up
 227  *      when bitmaps aren't needed anymore.
 228  *
 229  *----------------------------------------------------------------------
 230  */
 231 Pixmap
 232 Tk_AllocBitmapFromObj(interp, tkwin, objPtr)
 233     Tcl_Interp *interp;         /* Interp for error results. This may
 234                                  * be NULL. */
 235     Tk_Window tkwin;            /* Need the screen the bitmap is used on.*/
 236     Tcl_Obj *objPtr;            /* Object describing bitmap; see manual
 237                                  * entry for legal syntax of string value. */
 238 {
 239     return Tk_GetBitmap(interp, tkwin, Tcl_GetString(objPtr));
 240 }
 241
 242 /*
 243  *---------------------------------------------------------------------------
 244  *
 245  * Tk_AllocFontFromObj --
 246  *
 247  *      Given a string description of a font, map the description to a
 248  *      corresponding Tk_Font that represents the font.
 249  *
 250  * Results:
 251  *      The return value is token for the font, or NULL if an error
 252  *      prevented the font from being created.  If NULL is returned, an
 253  *      error message will be left in interp's result object.
 254  *
 255  * Side effects:
 256  *      The font is added to an internal database with a reference
 257  *      count.  For each call to this procedure, there should eventually
 258  *      be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
 259  *      database is cleaned up when fonts aren't in use anymore.
 260  *
 261  *---------------------------------------------------------------------------
 262  */
 263 Tk_Font
 264 Tk_AllocFontFromObj(interp, tkwin, objPtr)
 265     Tcl_Interp *interp;         /* Interp for database and error return. */
 266     Tk_Window tkwin;            /* For screen on which font will be used. */
 267     Tcl_Obj *objPtr;            /* Object describing font, as: named font,
 268                                  * native format, or parseable string. */
 269 {
 270     return Tk_GetFont(interp, tkwin, Tcl_GetString(objPtr));
 271 }
 272
 273 /*
 274  *----------------------------------------------------------------------
 275  *
 276  * Tk_AllocCursorFromObj --
 277  *
 278  *      Given a Tcl_Obj *, map the value to a corresponding
 279  *      Tk_Cursor structure based on the tkwin given.
 280  *
 281  * Results:
 282  *      The return value is the X identifer for the desired cursor,
 283  *      unless objPtr couldn't be parsed correctly.  In this case,
 284  *      None is returned and an error message is left in the interp's result.
 285  *      The caller should never modify the cursor that is returned, and
 286  *      should eventually call Tk_FreeCursorFromObj when the cursor is no
 287  *      longer needed.
 288  *
 289  * Side effects:
 290  *      The cursor is added to an internal database with a reference count.
 291  *      For each call to this procedure, there should eventually be a call
 292  *      to Tk_FreeCursorFromObj, so that the database can be cleaned up
 293  *      when cursors aren't needed anymore.
 294  *
 295  *----------------------------------------------------------------------
 296  */
 297 Tk_Cursor
 298 Tk_AllocCursorFromObj(interp, tkwin, objPtr)
 299     Tcl_Interp *interp;         /* Interp for error results. */
 300     Tk_Window tkwin;            /* Window in which the cursor will be used.*/
 301     Tcl_Obj *objPtr;            /* Object describing cursor; see manual
 302                                  * entry for description of legal
 303                                  * syntax of this obj's string rep. */
 304 {
 305     return Tk_GetCursor(interp, tkwin, Tcl_GetString(objPtr));
 306 }
 307
 308 /*
 309  *----------------------------------------------------------------------
 310  *
 311  * Tk_AllocColorFromObj --
 312  *
 313  *      Given a Tcl_Obj *, map the value to a corresponding
 314  *      XColor structure based on the tkwin given.
 315  *
 316  * Results:
 317  *      The return value is a pointer to an XColor structure that
 318  *      indicates the red, blue, and green intensities for the color
 319  *      given by the string in objPtr, and also specifies a pixel value
 320  *      to use to draw in that color.  If an error occurs, NULL is
 321  *      returned and an error message will be left in interp's result
 322  *      (unless interp is NULL).
 323  *
 324  * Side effects:
 325  *      The color is added to an internal database with a reference count.
 326  *      For each call to this procedure, there should eventually be a call
 327  *      to Tk_FreeColorFromObj so that the database is cleaned up when colors
 328  *      aren't in use anymore.
 329  *
 330  *----------------------------------------------------------------------
 331  */
 332 XColor *
 333 Tk_AllocColorFromObj(interp, tkwin, objPtr)
 334     Tcl_Interp *interp;         /* Used only for error reporting.  If NULL,
 335                                  * then no messages are provided. */
 336     Tk_Window tkwin;            /* Window in which the color will be used.*/
 337     Tcl_Obj *objPtr;            /* Object that describes the color; string
 338                                  * value is a color name such as "red" or
 339                                  * "#ff0000".*/
 340 {
 341     char *string;
 342
 343     string = Tcl_GetString(objPtr);
 344     return Tk_GetColor(interp, tkwin, Tk_GetUid(string));
 345 }
 346
 347 #endif /* 8.0 */
 348
 349 /*
 350  *--------------------------------------------------------------
 351  *
 352  * Blt_GetPosition --
 353  *
 354  *      Convert a string representing a numeric position.
 355  *      A position can be in one of the following forms.
 356  *
 357  *        number        - number of the item in the hierarchy, indexed
 358  *                        from zero.
 359  *        "end"         - last position in the hierarchy.
 360  *
 361  * Results:
 362  *      A standard Tcl result.  If "string" is a valid index, then
 363  *      *indexPtr is filled with the corresponding numeric index.
 364  *      If "end" was selected then *indexPtr is set to -1.
 365  *      Otherwise an error message is left in interp->result.
 366  *
 367  * Side effects:
 368  *      None.
 369  *
 370  *--------------------------------------------------------------
 371  */
 372 int
 373 Blt_GetPositionFromObj(interp, objPtr, indexPtr)
 374     Tcl_Interp *interp;         /* Interpreter to report results back
 375                                  * to. */
 376     Tcl_Obj *objPtr;            /* Tcl_Obj representation of the index.
 377                                  * Can be an integer or "end" to refer
 378                                  * to the last index. */
 379     int *indexPtr;              /* Holds the converted index. */
 380 {
 381     char *string;
 382
 383     string = Tcl_GetString(objPtr);
 384     if ((string[0] == 'e') && (strcmp(string, "end") == 0)) {
 385         *indexPtr = -1;         /* Indicates last position in hierarchy. */
 386     } else {
 387         int position;
 388
 389         if (Tcl_GetIntFromObj(interp, objPtr, &position) != TCL_OK) {
 390             return TCL_ERROR;
 391         }
 392         if (position < 0) {
 393             Tcl_AppendResult(interp, "bad position \"", string, "\"",
 394                 (char *)NULL);
 395             return TCL_ERROR;
 396         }
 397         *indexPtr = position;
 398     }
 399     return TCL_OK;
 400 }
 401 int
 402 Blt_GetPositionSizeFromObj(interp, objPtr, size, indexPtr)
 403     Tcl_Interp *interp;         /* Interpreter to report results back
 404                                  * to. */
 405     Tcl_Obj *objPtr;            /* Tcl_Obj representation of the index.
 406                                  * Can be an integer or "end" to refer
 407                                  * to the last index. */
 408     int size;
 409     int *indexPtr;              /* Holds the converted index. */
 410 {
 411     char *string;
 412     int position, n;
 413
 414     string = Tcl_GetString(objPtr);
 415     if ((string[0] == 'e') && (strcmp(string, "end") == 0)) {
 416         *indexPtr = -1;         /* Indicates last position in hierarchy. */
 417          return TCL_OK;
 418     }
 419     if ((string[0] == 'e') && (strncmp(string, "end-", 4) == 0) &&
 420         Tcl_GetInt(NULL, string+4, &n) == TCL_OK && n>=0 && n<=size) {
 421         position = size-n;              /* Indicates last position in hierarchy. */
 422     } else {
 423         if (Tcl_GetIntFromObj(interp, objPtr, &position) != TCL_OK) {
 424             return TCL_ERROR;
 425         }
 426     }
 427     if (position < 0 || position >= size) {
 428             Tcl_AppendResult(interp, "bad position \"", string, "\"",
 429                 (char *)NULL);
 430             return TCL_ERROR;
 431     }
 432     *indexPtr = position;
 433     return TCL_OK;
 434 }
 435
 436 /*
 437  *----------------------------------------------------------------------
 438  *
 439  * Blt_GetPixelsFromObj --
 440  *
 441  *      Like Tk_GetPixelsFromObj, but checks for negative, zero.
 442  *
 443  * Results:
 444  *      A standard Tcl result.
 445  *
 446  *----------------------------------------------------------------------
 447  */
 448 int
 449 Blt_GetPixelsFromObj(interp, tkwin, objPtr, check, valuePtr)
 450     Tcl_Interp *interp;
 451     Tk_Window tkwin;
 452     Tcl_Obj *objPtr;
 453     int check;                  /* Can be PIXELS_POSITIVE, PIXELS_NONNEGATIVE,
 454                                  * or PIXELS_ANY, */
 455     int *valuePtr;
 456 {
 457     int length;
 458
 459     if (Tk_GetPixelsFromObj(interp, tkwin, objPtr, &length) != TCL_OK) {
 460         return TCL_ERROR;
 461     }
 462     if (length >= SHRT_MAX) {
 463         Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(objPtr),
 464                  "\": too big to represent", (char *)NULL);
 465         return TCL_ERROR;
 466     }
 467     switch (check) {
 468     case PIXELS_NONNEGATIVE:
 469         if (length < 0) {
 470             Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(objPtr),
 471                      "\": can't be negative", (char *)NULL);
 472             return TCL_ERROR;
 473         }
 474         break;
 475
 476     case PIXELS_POSITIVE:
 477         if (length <= 0) {
 478             Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(objPtr),
 479                      "\": must be positive", (char *)NULL);
 480             return TCL_ERROR;
 481         }
 482         break;
 483
 484     case PIXELS_ANY:
 485         break;
 486     }
 487     *valuePtr = length;
 488     return TCL_OK;
 489 }
 490
 491 int
 492 Blt_GetPadFromObj(interp, tkwin, objPtr, padPtr)
 493     Tcl_Interp *interp;         /* Interpreter to send results back to */
 494     Tk_Window tkwin;            /* Window */
 495     Tcl_Obj *objPtr;            /* Pixel value string */
 496     Blt_Pad *padPtr;
 497 {
 498     int side1, side2;
 499     int objc;
 500     Tcl_Obj **objv;
 501
 502     if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
 503         return TCL_ERROR;
 504     }
 505     if ((objc < 1) || (objc > 2)) {
 506         Tcl_AppendResult(interp, "wrong # elements in padding list",
 507             (char *)NULL);
 508         return TCL_ERROR;
 509     }
 510     if (Blt_GetPixelsFromObj(interp, tkwin, objv[0], PIXELS_NONNEGATIVE,
 511              &side1) != TCL_OK) {
 512         return TCL_ERROR;
 513     }
 514     side2 = side1;
 515     if ((objc > 1) &&
 516         (Blt_GetPixelsFromObj(interp, tkwin, objv[1], PIXELS_NONNEGATIVE,
 517               &side2) != TCL_OK)) {
 518         return TCL_ERROR;
 519     }
 520     /* Don't update the pad structure until we know both values are okay. */
 521     padPtr->side1 = side1;
 522     padPtr->side2 = side2;
 523     return TCL_OK;
 524 }
 525
 526 int
 527 Blt_GetShadowFromObj(interp, tkwin, objPtr, shadowPtr)
 528     Tcl_Interp *interp;         /* Interpreter to send results back to */
 529     Tk_Window tkwin;            /* Window */
 530     Tcl_Obj *objPtr;            /* Pixel value string */
 531     Shadow *shadowPtr;
 532 {
 533     XColor *colorPtr;
 534     int dropOffset;
 535     int objc;
 536     Tcl_Obj **objv;
 537
 538     if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
 539         return TCL_ERROR;
 540     }
 541     if (objc > 2) {
 542         Tcl_AppendResult(interp, "wrong # elements in drop shadow value",
 543                          (char *)NULL);
 544         return TCL_ERROR;
 545     }
 546     dropOffset = 0;
 547     colorPtr = NULL;
 548     if (objc > 0) {
 549         colorPtr = Tk_AllocColorFromObj(interp, tkwin, objv[0]);
 550         if (colorPtr == NULL) {
 551             return TCL_ERROR;
 552         }
 553         dropOffset = 1;
 554         if (objc == 2) {
 555             if (Blt_GetPixelsFromObj(interp, tkwin, objv[1], PIXELS_NONNEGATIVE,
 556                                      &dropOffset) != TCL_OK) {
 557                 Tk_FreeColor(colorPtr);
 558                 return TCL_ERROR;
 559             }
 560         }
 561     }
 562     if (shadowPtr->color != NULL) {
 563         Tk_FreeColor(shadowPtr->color);
 564     }
 565     shadowPtr->color = colorPtr;
 566     shadowPtr->offset = dropOffset;
 567     return TCL_OK;
 568 }
 569
 570 int
 571 Blt_GetStateFromObj(interp, objPtr, statePtr)
 572     Tcl_Interp *interp;         /* Interpreter to send results back to */
 573     Tcl_Obj *objPtr;            /* Pixel value string */
 574     int *statePtr;
 575 {
 576     char *string;
 577
 578     string = Tcl_GetString(objPtr);
 579     if (strcmp(string, "normal") == 0) {
 580         *statePtr = STATE_NORMAL;
 581     } else if (strcmp(string, "disabled") == 0) {
 582         *statePtr = STATE_DISABLED;
 583     } else if (strcmp(string, "active") == 0) {
 584         *statePtr = STATE_ACTIVE;
 585     } else {
 586         Tcl_AppendResult(interp, "bad state \"", string,
 587             "\": should be normal, active, or disabled", (char *)NULL);
 588         return TCL_ERROR;
 589     }
 590     return TCL_OK;
 591 }
 592
 593 char *
 594 Blt_NameOfState(state)
 595     int state;
 596 {
 597     switch (state) {
 598     case STATE_ACTIVE:
 599         return "active";
 600     case STATE_DISABLED:
 601         return "disabled";
 602     case STATE_NORMAL:
 603         return "normal";
 604     default:
 605         return "???";
 606     }
 607 }
 608
 609 #ifdef notdef                   /* Replace this routine when Tcl_Obj-based
 610                                  * configuration comes on-line */
 611
 612 /*
 613  *----------------------------------------------------------------------
 614  *
 615  * Blt_NameOfFill --
 616  *
 617  *      Converts the integer representing the fill style into a string.
 618  *
 619  *----------------------------------------------------------------------
 620  */
 621 char *
 622 Blt_NameOfFill(fill)
 623     int fill;
 624 {
 625     switch (fill) {
 626     case FILL_X:
 627         return "x";
 628     case FILL_Y:
 629         return "y";
 630     case FILL_NONE:
 631         return "none";
 632     case FILL_BOTH:
 633         return "both";
 634     default:
 635         return "unknown value";
 636     }
 637 }
 638 #endif
 639
 640 /*
 641  *----------------------------------------------------------------------
 642  *
 643  * Blt_GetFillFromObj --
 644  *
 645  *      Converts the fill style string into its numeric representation.
 646  *
 647  *      Valid style strings are:
 648  *
 649  *        "none"   Use neither plane.
 650  *        "x"      X-coordinate plane.
 651  *        "y"      Y-coordinate plane.
 652  *        "both"   Use both coordinate planes.
 653  *
 654  *----------------------------------------------------------------------
 655  */
 656 /*ARGSUSED*/
 657 int
 658 Blt_GetFillFromObj(interp, objPtr, fillPtr)
 659     Tcl_Interp *interp;         /* Interpreter to send results back to */
 660     Tcl_Obj *objPtr;            /* Fill style string */
 661     int *fillPtr;
 662 {
 663     int length;
 664     char c;
 665     char *string;
 666
 667     string = Tcl_GetStringFromObj(objPtr, &length);
 668     c = string[0];
 669     if ((c == 'n') && (strncmp(string, "none", length) == 0)) {
 670         *fillPtr = FILL_NONE;
 671     } else if ((c == 'x') && (strncmp(string, "x", length) == 0)) {
 672         *fillPtr = FILL_X;
 673     } else if ((c == 'y') && (strncmp(string, "y", length) == 0)) {
 674         *fillPtr = FILL_Y;
 675     } else if ((c == 'b') && (strncmp(string, "both", length) == 0)) {
 676         *fillPtr = FILL_BOTH;
 677     } else {
 678         Tcl_AppendResult(interp, "bad argument \"", string,
 679             "\": should be \"none\", \"x\", \"y\", or \"both\"", (char *)NULL);
 680         return TCL_ERROR;
 681     }
 682     return TCL_OK;
 683 }
 684
 685 /*
 686  *----------------------------------------------------------------------
 687  *
 688  * Blt_GetDashesFromObj --
 689  *
 690  *      Converts a Tcl list of dash values into a dash list ready for
 691  *      use with XSetDashes.
 692  *
 693  *      A valid list dash values can have zero through 11 elements
 694  *      (PostScript limit).  Values must be between 1 and 255. Although
 695  *      a list of 0 (like the empty string) means no dashes.
 696  *
 697  * Results:
 698  *      A standard Tcl result. If the list represented a valid dash
 699  *      list TCL_OK is returned and *dashesPtr* will contain the
 700  *      valid dash list. Otherwise, TCL_ERROR is returned and
 701  *      interp->result will contain an error message.
 702  *
 703  *
 704  *----------------------------------------------------------------------
 705  */
 706 int
 707 Blt_GetDashesFromObj(interp, objPtr, dashesPtr)
 708     Tcl_Interp *interp;
 709     Tcl_Obj *objPtr;
 710     Blt_Dashes *dashesPtr;
 711 {
 712     char *string;
 713
 714     string = Tcl_GetString(objPtr);
 715     if ((string == NULL) || (*string == '\0')) {
 716         dashesPtr->values[0] = 0;
 717     } else if (strcmp(string, "dash") == 0) {   /* 5 2 */
 718         dashesPtr->values[0] = 5;
 719         dashesPtr->values[1] = 2;
 720         dashesPtr->values[2] = 0;
 721     } else if (strcmp(string, "dot") == 0) {    /* 1 */
 722         dashesPtr->values[0] = 1;
 723         dashesPtr->values[1] = 0;
 724     } else if (strcmp(string, "dashdot") == 0) {        /* 2 4 2 */
 725         dashesPtr->values[0] = 2;
 726         dashesPtr->values[1] = 4;
 727         dashesPtr->values[2] = 2;
 728         dashesPtr->values[3] = 0;
 729     } else if (strcmp(string, "dashdotdot") == 0) {     /* 2 4 2 2 */
 730         dashesPtr->values[0] = 2;
 731         dashesPtr->values[1] = 4;
 732         dashesPtr->values[2] = 2;
 733         dashesPtr->values[3] = 2;
 734         dashesPtr->values[4] = 0;
 735     } else {
 736         int objc;
 737         Tcl_Obj **objv;
 738         int value;
 739         register int i;
 740
 741         if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
 742             return TCL_ERROR;
 743         }
 744         if (objc > 11) {        /* This is the postscript limit */
 745             Tcl_AppendResult(interp, "too many values in dash list \"",
 746                              string, "\"", (char *)NULL);
 747             return TCL_ERROR;
 748         }
 749         for (i = 0; i < objc; i++) {
 750             if (Tcl_GetIntFromObj(interp, objv[i], &value) != TCL_OK) {
 751                 return TCL_ERROR;
 752             }
 753             /*
 754              * Backward compatibility:
 755              * Allow list of 0 to turn off dashes
 756              */
 757             if ((value == 0) && (objc == 1)) {
 758                 break;
 759             }
 760             if ((value < 1) || (value > 255)) {
 761                 Tcl_AppendResult(interp, "dash value \"",
 762                          Tcl_GetString(objv[i]), "\" is out of range",
 763                          (char *)NULL);
 764                 return TCL_ERROR;
 765             }
 766             dashesPtr->values[i] = (unsigned char)value;
 767         }
 768         /* Make sure the array ends with a NUL byte  */
 769         dashesPtr->values[i] = 0;
 770     }
 771     return TCL_OK;
 772 }
 773
 774 char *
 775 Blt_NameOfSide(side)
 776     int side;
 777 {
 778     switch (side) {
 779     case SIDE_LEFT:
 780         return "left";
 781     case SIDE_RIGHT:
 782         return "right";
 783     case SIDE_BOTTOM:
 784         return "bottom";
 785     case SIDE_TOP:
 786         return "top";
 787     }
 788     return "unknown side value";
 789 }
 790
 791 /*
 792  *----------------------------------------------------------------------
 793  *
 794  * Blt_GetSideFromObj --
 795  *
 796  *      Converts the fill style string into its numeric representation.
 797  *
 798  *      Valid style strings are "left", "right", "top", or  "bottom".
 799  *
 800  *----------------------------------------------------------------------
 801  */
 802 /*ARGSUSED */
 803 int
 804 Blt_GetSideFromObj(interp, objPtr, sidePtr)
 805     Tcl_Interp *interp;         /* Interpreter to send results back to */
 806     Tcl_Obj *objPtr;            /* Value string */
 807     int *sidePtr;               /* (out) Token representing side:
 808                                  * either SIDE_LEFT, SIDE_RIGHT,
 809                                  * SIDE_TOP, or SIDE_BOTTOM. */
 810 {
 811     char c;
 812     int length;
 813     char *string;
 814
 815     string = Tcl_GetStringFromObj(objPtr, &length);
 816     c = string[0];
 817     if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
 818         *sidePtr = SIDE_LEFT;
 819     } else if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
 820         *sidePtr = SIDE_RIGHT;
 821     } else if ((c == 't') && (strncmp(string, "top", length) == 0)) {
 822         *sidePtr = SIDE_TOP;
 823     } else if ((c == 'b') && (strncmp(string, "bottom", length) == 0)) {
 824         *sidePtr = SIDE_BOTTOM;
 825     } else {
 826         Tcl_AppendResult(interp, "bad side \"", string,
 827             "\": should be left, right, top, or bottom", (char *)NULL);
 828         return TCL_ERROR;
 829     }
 830     return TCL_OK;
 831 }
 832
 833 char *
 834 Blt_NameOfArrow(side)
 835     int side;
 836 {
 837     switch (side) {
 838     case ARROW_LEFT:
 839         return "left";
 840     case ARROW_RIGHT:
 841         return "right";
 842     case ARROW_DOWN:
 843         return "down";
 844     case ARROW_UP:
 845         return "up";
 846     case ARROW_NONE:
 847         return "none";
 848     }
 849     return "unknown arow value";
 850 }
 851
 852 /*
 853  *----------------------------------------------------------------------
 854  *
 855  * Blt_GetDirFromObj --
 856  *
 857  *      Converts the fill style string into its numeric representation.
 858  *
 859  *      Valid style strings are "left", "right", "up", or  "down".
 860  *
 861  *----------------------------------------------------------------------
 862  */
 863 /*ARGSUSED */
 864 int
 865 Blt_GetArrowFromObj(interp, objPtr, sidePtr)
 866     Tcl_Interp *interp;         /* Interpreter to send results back to */
 867     Tcl_Obj *objPtr;            /* Value string */
 868     int *sidePtr;               /* (out) Token representing arrow:
 869                                  * either ARROW_LEFT, ARROW_RIGHT,
 870                                  * ARROW_TOP, or ARROW_BOTTOM. */
 871 {
 872     char c;
 873     int length;
 874     char *string;
 875
 876     string = Tcl_GetStringFromObj(objPtr, &length);
 877     c = string[0];
 878     if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
 879         *sidePtr = ARROW_LEFT;
 880     } else if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
 881         *sidePtr = ARROW_RIGHT;
 882     } else if ((c == 'u') && (strncmp(string, "up", length) == 0)) {
 883         *sidePtr = ARROW_UP;
 884     } else if ((c == 'd') && (strncmp(string, "down", length) == 0)) {
 885         *sidePtr = ARROW_DOWN;
 886     } else if ((c == 'n') && (strncmp(string, "none", length) == 0)) {
 887         *sidePtr = ARROW_NONE;
 888     } else {
 889         Tcl_AppendResult(interp, "bad arrow \"", string,
 890             "\": should be none, left, right, up, or down", (char *)NULL);
 891         return TCL_ERROR;
 892     }
 893     return TCL_OK;
 894 }
 895
 896 /*
 897  *----------------------------------------------------------------------
 898  *
 899  * Blt_StringToEnum --
 900  *
 901  *      Converts the string into its enumerated type.
 902  *
 903  *----------------------------------------------------------------------
 904  */
 905 /*ARGSUSED*/
 906 int
 907 Blt_ObjToEnum(clientData, interp, tkwin, objPtr, widgRec, offset)
 908     ClientData clientData;      /* Vectors of valid strings. */
 909     Tcl_Interp *interp;         /* Interpreter to send results back to */
 910     Tk_Window tkwin;            /* Not used. */
 911     Tcl_Obj *objPtr;
 912     char *widgRec;              /* Widget record. */
 913     int offset;                 /* Offset of field in record */
 914 {
 915     int *enumPtr = (int *)(widgRec + offset);
 916     char c;
 917     register char **p;
 918     register int i;
 919     int count;
 920     char *string;
 921
 922     string = Tcl_GetString(objPtr);
 923     c = string[0];
 924     count = 0;
 925     for (p = (char **)clientData; *p != NULL; p++) {
 926         if ((c == p[0][0]) && (strcmp(string, *p) == 0)) {
 927             *enumPtr = count;
 928             return TCL_OK;
 929         }
 930         count++;
 931     }
 932     *enumPtr = -1;
 933
 934     Tcl_AppendResult(interp, "bad value \"", string, "\": should be ",
 935         (char *)NULL);
 936     p = (char **)clientData;
 937     if (count > 0) {
 938         Tcl_AppendResult(interp, p[0], (char *)NULL);
 939     }
 940     for (i = 1; i < (count - 1); i++) {
 941         Tcl_AppendResult(interp, " ", p[i], ", ", (char *)NULL);
 942     }
 943     if (count > 1) {
 944         Tcl_AppendResult(interp, " or ", p[count - 1], ".", (char *)NULL);
 945     }
 946     return TCL_ERROR;
 947 }
 948
 949 /*
 950  *----------------------------------------------------------------------
 951  *
 952  * Blt_EnumToObj --
 953  *
 954  *      Returns the string associated with the enumerated type.
 955  *
 956  *----------------------------------------------------------------------
 957  */
 958 /*ARGSUSED*/
 959 Tcl_Obj *
 960 Blt_EnumToObj(clientData, interp, tkwin, widgRec, offset)
 961     ClientData clientData;      /* List of strings. */
 962     Tcl_Interp *interp;
 963     Tk_Window tkwin;            /* Not used. */
 964     char *widgRec;              /* Widget record */
 965     int offset;                 /* Offset of field in widget record */
 966 {
 967     int value = *(int *)(widgRec + offset);
 968     char **strings = (char **)clientData;
 969     char **p;
 970     int count;
 971
 972     count = 0;
 973     for (p = strings; *p != NULL; p++) {
 974         if (value == count) {
 975             return Tcl_NewStringObj(*p, -1);
 976         }
 977         count++;
 978     }
 979     return Tcl_NewStringObj("unknown value", -1);
 980 }
 981
 982 /* Configuration option helper routines */
 983
 984 /*
 985  *--------------------------------------------------------------
 986  *
 987  * DoConfig --
 988  *
 989  *      This procedure applies a single configuration option
 990  *      to a widget record.
 991  *
 992  * Results:
 993  *      A standard Tcl return value.
 994  *
 995  * Side effects:
 996  *      WidgRec is modified as indicated by specPtr and value.
 997  *      The old value is recycled, if that is appropriate for
 998  *      the value type.
 999  *
1000  *--------------------------------------------------------------
1001  */
1002 static int
1003 DoConfig(interp, tkwin, specPtr, objPtr, widgRec)
1004     Tcl_Interp *interp;         /* Interpreter for error reporting. */
1005     Tk_Window tkwin;            /* Window containing widget (needed to
1006                                  * set up X resources). */
1007     Blt_ConfigSpec *specPtr;    /* Specifier to apply. */
1008     Tcl_Obj *objPtr;            /* Value to use to fill in widgRec. */
1009     char *widgRec;              /* Record whose fields are to be
1010                                  * modified.  Values must be properly
1011                                  * initialized. */
1012 {
1013     char *ptr;
1014     int objIsEmpty;
1015
1016     objIsEmpty = FALSE;
1017     if (objPtr == NULL) {
1018         objIsEmpty = TRUE;
1019     } else if (specPtr->specFlags & BLT_CONFIG_NULL_OK) {
1020         int length;
1021
1022         if (objPtr->bytes != NULL) {
1023             length = objPtr->length;
1024         } else {
1025             Tcl_GetStringFromObj(objPtr, &length);
1026         }
1027         objIsEmpty = (length == 0);
1028     }
1029     do {
1030         ptr = widgRec + specPtr->offset;
1031         switch (specPtr->type) {
1032         case BLT_CONFIG_ANCHOR:
1033             {
1034                 Tk_Anchor anchor;
1035
1036                 if (objIsEmpty) {
1037                       anchor = -1;
1038                 } else if (Tk_GetAnchorFromObj(interp, objPtr, &anchor) != TCL_OK) {
1039                     return TCL_ERROR;
1040                 }
1041                 *(Tk_Anchor *)ptr = anchor;
1042             }
1043             break;
1044
1045         case BLT_CONFIG_BITMAP:
1046             {
1047                 Pixmap newBitmap, oldBitmap;
1048
1049                 if (objIsEmpty) {
1050                     newBitmap = None;
1051                 } else {
1052                     newBitmap = Tk_AllocBitmapFromObj(interp, tkwin, objPtr);
1053                     if (newBitmap == None) {
1054                         return TCL_ERROR;
1055                     }
1056                 }
1057                 oldBitmap = *(Pixmap *)ptr;
1058                 if (oldBitmap != None) {
1059                     Tk_FreeBitmap(Tk_Display(tkwin), oldBitmap);
1060                 }
1061                 *(Pixmap *)ptr = newBitmap;
1062             }
1063             break;
1064
1065         case BLT_CONFIG_BOOLEAN:
1066             {
1067                 int newBool;
1068
1069                 if (Tcl_GetBooleanFromObj(interp, objPtr, &newBool)
1070                     != TCL_OK) {
1071                     return TCL_ERROR;
1072                 }
1073                 *(int *)ptr = newBool;
1074             }
1075             break;
1076
1077         case BLT_CONFIG_BORDER:
1078             {
1079                 Tk_3DBorder newBorder, oldBorder;
1080
1081                 if (objIsEmpty) {
1082                     newBorder = NULL;
1083                 } else {
1084                     newBorder = Tk_Alloc3DBorderFromObj(interp, tkwin, objPtr);
1085                     if (newBorder == NULL) {
1086                         return TCL_ERROR;
1087                     }
1088                 }
1089                 oldBorder = *(Tk_3DBorder *)ptr;
1090                 if (oldBorder != NULL) {
1091                     Tk_Free3DBorder(oldBorder);
1092                 }
1093                 *(Tk_3DBorder *)ptr = newBorder;
1094             }
1095             break;
1096
1097         case BLT_CONFIG_CAP_STYLE:
1098             {
1099                 int cap;
1100                 Tk_Uid value;
1101
1102                 value = Tk_GetUid(Tcl_GetString(objPtr));
1103                 if (Tk_GetCapStyle(interp, (char*)value, &cap) != TCL_OK) {
1104                     return TCL_ERROR;
1105                 }
1106                 *(int *)ptr = cap;
1107             }
1108             break;
1109
1110         case BLT_CONFIG_COLOR:
1111             {
1112                 XColor *newColor, *oldColor;
1113
1114                 if (objIsEmpty) {
1115                     newColor = NULL;
1116                 } else {
1117                     newColor = Tk_AllocColorFromObj(interp, tkwin, objPtr);
1118                     if (newColor == NULL) {
1119                         return TCL_ERROR;
1120                     }
1121                 }
1122                 oldColor = *(XColor **)ptr;
1123                 if (oldColor != NULL) {
1124                     Tk_FreeColor(oldColor);
1125                 }
1126                 *(XColor **)ptr = newColor;
1127             }
1128             break;
1129
1130         case BLT_CONFIG_CURSOR:
1131         case BLT_CONFIG_ACTIVE_CURSOR:
1132             {
1133                 Tk_Cursor newCursor, oldCursor;
1134
1135                 if (objIsEmpty) {
1136                     newCursor = None;
1137                 } else {
1138                     newCursor = Tk_AllocCursorFromObj(interp, tkwin, objPtr);
1139                     if (newCursor == None) {
1140                         return TCL_ERROR;
1141                     }
1142                 }
1143                 oldCursor = *(Tk_Cursor *)ptr;
1144                 if (oldCursor != None) {
1145                     Tk_FreeCursor(Tk_Display(tkwin), oldCursor);
1146                 }
1147                 *(Tk_Cursor *)ptr = newCursor;
1148                 if (specPtr->type == BLT_CONFIG_ACTIVE_CURSOR) {
1149                     Tk_DefineCursor(tkwin, newCursor);
1150                 }
1151             }
1152             break;
1153
1154         case BLT_CONFIG_CUSTOM:
1155             {
1156                 /* Note: defers freeProc call till after success from parseProc */
1157                 char *oldPtr;
1158                 oldPtr = (*(char **)ptr);
1159                 if (objIsEmpty) {
1160                       if ((oldPtr != NULL) &&
1161                       (specPtr->customPtr->freeProc != NULL)) {
1162                           (*specPtr->customPtr->freeProc)
1163                           (specPtr->customPtr->clientData, Tk_Display(tkwin),
1164                               widgRec, specPtr->offset, oldPtr);
1165                       }
1166                       *(char **)ptr = NULL;
1167                 } else {
1168                     int result;
1169
1170                     result = (*specPtr->customPtr->parseProc)
1171                         (specPtr->customPtr->clientData, interp, tkwin, objPtr,
1172                          widgRec, specPtr->offset);
1173                     if (result != TCL_OK) {
1174                           *(char **)ptr = oldPtr;
1175                           return TCL_ERROR;
1176                     }
1177                     if ((oldPtr != NULL) &&
1178                       (specPtr->customPtr->freeProc != NULL)) {
1179                           (*specPtr->customPtr->freeProc)
1180                           (specPtr->customPtr->clientData, Tk_Display(tkwin),
1181                               widgRec, specPtr->offset, oldPtr);
1182                       }
1183                   }
1184             }
1185             break;
1186
1187         case BLT_CONFIG_DOUBLE:
1188             {
1189                 double newDouble;
1190
1191                 if (Tcl_GetDoubleFromObj(interp, objPtr, &newDouble)
1192                     != TCL_OK) {
1193                     return TCL_ERROR;
1194                 }
1195                 *(double *)ptr = newDouble;
1196             }
1197             break;
1198
1199         case BLT_CONFIG_FONT:
1200             {
1201                 Tk_Font newFont, oldFont;
1202
1203                 if (objIsEmpty) {
1204                     newFont = NULL;
1205                 } else {
1206                     newFont = Tk_AllocFontFromObj(interp, tkwin, objPtr);
1207                     if (newFont == NULL) {
1208                         return TCL_ERROR;
1209                     }
1210                 }
1211                 oldFont = *(Tk_Font *)ptr;
1212                 if (oldFont != NULL) {
1213                     Tk_FreeFont(oldFont);
1214                 }
1215                 *(Tk_Font *)ptr = newFont;
1216             }
1217             break;
1218
1219         case BLT_CONFIG_INT:
1220             {
1221                 int newInt;
1222
1223                 if (Tcl_GetIntFromObj(interp, objPtr, &newInt) != TCL_OK) {
1224                     return TCL_ERROR;
1225                 }
1226                 *(int *)ptr = newInt;
1227             }
1228             break;
1229
1230         case BLT_CONFIG_JOIN_STYLE:
1231             {
1232                 int join;
1233                 Tk_Uid value;
1234
1235                 value = Tk_GetUid(Tcl_GetString(objPtr));
1236                 if (Tk_GetJoinStyle(interp, (char*)value, &join) != TCL_OK) {
1237                     return TCL_ERROR;
1238                 }
1239                 *(int *)ptr = join;
1240             }
1241             break;
1242
1243         case BLT_CONFIG_JUSTIFY:
1244             {
1245                 Tk_Justify justify;
1246
1247                 if (Tk_GetJustifyFromObj(interp, objPtr, &justify) != TCL_OK) {
1248                     return TCL_ERROR;
1249                 }
1250                 *(Tk_Justify *)ptr = justify;
1251             }
1252             break;
1253
1254         case BLT_CONFIG_MM:
1255             {
1256                 double mm;
1257
1258                 if (Tk_GetMMFromObj(interp, tkwin, objPtr, &mm) != TCL_OK) {
1259                     return TCL_ERROR;
1260                 }
1261                 *(double *)ptr = mm;
1262             }
1263             break;
1264
1265         case BLT_CONFIG_PIXELS:
1266             {
1267                 int pixels;
1268
1269                 if (Tk_GetPixelsFromObj(interp, tkwin, objPtr, &pixels)
1270                     != TCL_OK) {
1271                     return TCL_ERROR;
1272                 }
1273                 *(int *)ptr = pixels;
1274             }
1275             break;
1276
1277         case BLT_CONFIG_RELIEF:
1278             {
1279                 int relief;
1280
1281                 if (Tk_GetReliefFromObj(interp, objPtr, &relief) != TCL_OK) {
1282                     return TCL_ERROR;
1283                 }
1284                 *(int *)ptr = relief;
1285             }
1286             break;
1287
1288         case BLT_CONFIG_STRING:
1289             {
1290                 char *oldString, *newString;
1291
1292                 if (objIsEmpty) {
1293                     newString = NULL;
1294                 } else {
1295                     newString = (char *)Blt_Strdup(Tcl_GetString(objPtr));
1296                 }
1297                 oldString = *(char **)ptr;
1298                 if (oldString != NULL) {
1299                     Blt_Free(oldString);
1300                 }
1301                 *(char **)ptr = newString;
1302             }
1303             break;
1304
1305         case BLT_CONFIG_UID:
1306             if (objIsEmpty) {
1307                 *(Tk_Uid *)ptr = NULL;
1308             } else {
1309                 *(Tk_Uid *)ptr = Tk_GetUid(Tcl_GetString(objPtr));
1310             }
1311             break;
1312
1313         case BLT_CONFIG_WINDOW:
1314             {
1315                 Tk_Window tkwin2;
1316
1317                 if (objIsEmpty) {
1318                     tkwin2 = None;
1319                 } else {
1320                     char *path;
1321
1322                     path = Tcl_GetString(objPtr);
1323                     tkwin2 = Tk_NameToWindow(interp, path, tkwin);
1324                     if (tkwin2 == NULL) {
1325                         return TCL_ERROR;
1326                     }
1327                 }
1328                 *(Tk_Window *)ptr = tkwin2;
1329             }
1330             break;
1331
1332         case BLT_CONFIG_BITFLAG:
1333             {
1334                 int bool;
1335                 unsigned int flag;
1336
1337
1338                 if (Tcl_GetBooleanFromObj(interp, objPtr, &bool) != TCL_OK) {
1339                     return TCL_ERROR;
1340                 }
1341                 flag = (unsigned int)specPtr->customPtr;
1342                 *(int *)ptr &= ~flag;
1343                 if (bool) {
1344                     *(int *)ptr |= flag;
1345                 }
1346             }
1347             break;
1348
1349         case BLT_CONFIG_DASHES:
1350             if (Blt_GetDashesFromObj(interp, objPtr, (Blt_Dashes *)ptr)
1351                 != TCL_OK) {
1352                 return TCL_ERROR;
1353             }
1354             break;
1355
1356         case BLT_CONFIG_DISTANCE:
1357             {
1358                 int newPixels;
1359
1360                 if (Blt_GetPixelsFromObj(interp, tkwin, objPtr,
1361                         PIXELS_NONNEGATIVE, &newPixels) != TCL_OK) {
1362                     return TCL_ERROR;
1363                 }
1364                 *(int *)ptr = newPixels;
1365             }
1366             break;
1367
1368         case BLT_CONFIG_FILL:
1369             if (Blt_GetFillFromObj(interp, objPtr, (int *)ptr) != TCL_OK) {
1370                 return TCL_ERROR;
1371             }
1372             break;
1373
1374         case BLT_CONFIG_FLOAT:
1375             {
1376                 double newDouble;
1377
1378                 if (Tcl_GetDoubleFromObj(interp, objPtr, &newDouble)
1379                     != TCL_OK) {
1380                     return TCL_ERROR;
1381                 }
1382                 *(float *)ptr = (float)newDouble;
1383             }
1384             break;
1385
1386         case BLT_CONFIG_LIST:
1387             {
1388                 char **argv;
1389                 int argc;
1390
1391                 if (Tcl_SplitList(interp, Tcl_GetString(objPtr), &argc, &argv)
1392                     != TCL_OK) {
1393                     return TCL_ERROR;
1394                 }
1395                 *(char ***)ptr = argv;
1396             }
1397             break;
1398
1399         case BLT_CONFIG_OBJCMD:
1400         case BLT_CONFIG_LISTOBJ:
1401             {
1402                 Tcl_Obj **objv;
1403                 Tcl_Obj *listObjPtr, *oldObjPtr;
1404                 int objc;
1405
1406                 if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv)
1407                     != TCL_OK) {
1408                     return TCL_ERROR;
1409                 }
1410                 if (objc >= 1 && specPtr->type == BLT_CONFIG_OBJCMD) {
1411                     /* Precharge to a command object if possible. */
1412                     Tcl_GetCommandFromObj(interp, objv[0]);
1413                 }
1414                 oldObjPtr = *(Tcl_Obj **)ptr;
1415                 if (oldObjPtr != NULL) {
1416                       Tcl_DecrRefCount(oldObjPtr);
1417                 }
1418                 listObjPtr = Tcl_NewListObj(objc, objv);
1419                 Tcl_IncrRefCount(listObjPtr);
1420                 *(Tcl_Obj **)ptr = listObjPtr;
1421             }
1422             break;
1423
1424         case BLT_CONFIG_OBJ:
1425             {
1426                 Tcl_Obj *oldObjPtr;
1427                 oldObjPtr = *(Tcl_Obj **)ptr;
1428                 if (oldObjPtr != NULL) {
1429                       Tcl_DecrRefCount(oldObjPtr);
1430                 }
1431                 Tcl_IncrRefCount(objPtr);
1432                 *(Tcl_Obj **)ptr = objPtr;
1433             }
1434             break;
1435
1436         case BLT_CONFIG_PAD:
1437             if (Blt_GetPadFromObj(interp, tkwin, objPtr, (Blt_Pad *)ptr)
1438                 != TCL_OK) {
1439                 return TCL_ERROR;
1440             }
1441             break;
1442
1443         case BLT_CONFIG_POS_DISTANCE:
1444             {
1445                 int newPixels;
1446
1447                 if (Blt_GetPixelsFromObj(interp, tkwin, objPtr,
1448                         PIXELS_POSITIVE, &newPixels) != TCL_OK) {
1449                     return TCL_ERROR;
1450                 }
1451                 *(int *)ptr = newPixels;
1452             }
1453             break;
1454
1455         case BLT_CONFIG_SHADOW:
1456             {
1457                 Shadow *shadowPtr = (Shadow *)ptr;
1458
1459                 if (Blt_GetShadowFromObj(interp, tkwin, objPtr, shadowPtr)
1460                     != TCL_OK) {
1461                     return TCL_ERROR;
1462                 }
1463             }
1464             break;
1465
1466         case BLT_CONFIG_STATE:
1467             {
1468                 if (Blt_GetStateFromObj(interp, objPtr, (int *)ptr)
1469                     != TCL_OK) {
1470                     return TCL_ERROR;
1471                 }
1472             }
1473             break;
1474
1475         case BLT_CONFIG_TILE:
1476             {
1477                 Blt_Tile newTile, oldTile;
1478
1479                 if (objIsEmpty) {
1480                     newTile = None;
1481                 } else {
1482                     if (Blt_GetTile(interp, tkwin, Tcl_GetString(objPtr),
1483                                     &newTile) != TCL_OK) {
1484                         return TCL_ERROR;
1485                     }
1486                 }
1487                 oldTile = *(Blt_Tile *)ptr;
1488                 if (oldTile != NULL) {
1489                     Blt_FreeTile(oldTile);
1490                 }
1491                 *(Blt_Tile *)ptr = newTile;
1492             }
1493             break;
1494
1495         case BLT_CONFIG_SIDE:
1496             if (Blt_GetSideFromObj(interp, objPtr, (int *)ptr) != TCL_OK) {
1497                 return TCL_ERROR;
1498             }
1499             break;
1500
1501         case BLT_CONFIG_ARROW:
1502             if (Blt_GetArrowFromObj(interp, objPtr, (int *)ptr) != TCL_OK) {
1503                 return TCL_ERROR;
1504             }
1505             break;
1506
1507         default:
1508             {
1509                 char buf[200];
1510
1511                 sprintf(buf, "bad config table: unknown type %d",
1512                         specPtr->type);
1513                 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1514                 return TCL_ERROR;
1515             }
1516         }
1517         specPtr++;
1518     } while ((specPtr->switchName == NULL) &&
1519              (specPtr->type != BLT_CONFIG_END));
1520     return TCL_OK;
1521 }
1522
1523 /*
1524  *----------------------------------------------------------------------
1525  *
1526  * FormatConfigValue --
1527  *
1528  *      This procedure formats the current value of a configuration
1529  *      option.
1530  *
1531  * Results:
1532  *      The return value is the formatted value of the option given
1533  *      by specPtr and widgRec.  If the value is static, so that it
1534  *      need not be freed, *freeProcPtr will be set to NULL;  otherwise
1535  *      *freeProcPtr will be set to the address of a procedure to
1536  *      free the result, and the caller must invoke this procedure
1537  *      when it is finished with the result.
1538  *
1539  * Side effects:
1540  *      None.
1541  *
1542  *----------------------------------------------------------------------
1543  */
1544 static Tcl_Obj *
1545 FormatConfigValue(interp, tkwin, specPtr, widgRec)
1546     Tcl_Interp *interp;         /* Interpreter for use in real conversions. */
1547     Tk_Window tkwin;            /* Window corresponding to widget. */
1548     Blt_ConfigSpec *specPtr;    /* Pointer to information describing option.
1549                                  * Must not point to a synonym option. */
1550     char *widgRec;              /* Pointer to record holding current
1551                                  * values of info for widget. */
1552 {
1553     char *ptr;
1554     char *string;
1555
1556     ptr = widgRec + specPtr->offset;
1557     string = "";
1558     switch (specPtr->type) {
1559     case BLT_CONFIG_ANCHOR:
1560         if ((*(int *)ptr)>=0) {
1561             string = Tk_NameOfAnchor(*(Tk_Anchor *)ptr);
1562         }
1563         break;
1564
1565     case BLT_CONFIG_BITMAP:
1566         if (*(Pixmap *)ptr != None) {
1567             string = Tk_NameOfBitmap(Tk_Display(tkwin), *(Pixmap *)ptr);
1568         }
1569         break;
1570
1571     case BLT_CONFIG_BOOLEAN:
1572         return Tcl_NewBooleanObj(*(int *)ptr);
1573
1574     case BLT_CONFIG_BORDER:
1575         if (*(Tk_3DBorder *)ptr != NULL) {
1576             string = Tk_NameOf3DBorder(*(Tk_3DBorder *)ptr);
1577         }
1578         break;
1579
1580     case BLT_CONFIG_CAP_STYLE:
1581         string = Tk_NameOfCapStyle(*(int *)ptr);
1582         break;
1583
1584     case BLT_CONFIG_COLOR:
1585         if (*(XColor **)ptr != NULL) {
1586             string = Tk_NameOfColor(*(XColor **)ptr);
1587         }
1588         break;
1589
1590     case BLT_CONFIG_CURSOR:
1591     case BLT_CONFIG_ACTIVE_CURSOR:
1592         if (*(Tk_Cursor *)ptr != None) {
1593             string = Tk_NameOfCursor(Tk_Display(tkwin), *(Tk_Cursor *)ptr);
1594         }
1595         break;
1596
1597     case BLT_CONFIG_CUSTOM:
1598         return (*specPtr->customPtr->printProc)(specPtr->customPtr->clientData,
1599                 interp, tkwin, widgRec, specPtr->offset);
1600
1601     case BLT_CONFIG_DOUBLE:
1602         return Tcl_NewDoubleObj(*(double *)ptr);
1603
1604     case BLT_CONFIG_FONT:
1605         if (*(Tk_Font *)ptr != NULL) {
1606             string = Tk_NameOfFont(*(Tk_Font *)ptr);
1607         }
1608         break;
1609
1610     case BLT_CONFIG_INT:
1611         return Tcl_NewIntObj(*(int *)ptr);
1612
1613     case BLT_CONFIG_JOIN_STYLE:
1614         string = Tk_NameOfJoinStyle(*(int *)ptr);
1615         break;
1616
1617     case BLT_CONFIG_JUSTIFY:
1618         string = Tk_NameOfJustify(*(Tk_Justify *)ptr);
1619         break;
1620
1621     case BLT_CONFIG_MM:
1622         return Tcl_NewDoubleObj(*(double *)ptr);
1623
1624     case BLT_CONFIG_PIXELS:
1625         return Tcl_NewIntObj(*(int *)ptr);
1626
1627     case BLT_CONFIG_RELIEF:
1628         string = Tk_NameOfRelief(*(int *)ptr);
1629         break;
1630
1631     case BLT_CONFIG_STRING:
1632     case BLT_CONFIG_UID:
1633         if (*(char **)ptr != NULL) {
1634             string = *(char **)ptr;
1635         }
1636         break;
1637
1638     case BLT_CONFIG_BITFLAG:
1639         {
1640             unsigned int flag;
1641
1642             flag = (*(int *)ptr) & (unsigned int)specPtr->customPtr;
1643             return Tcl_NewBooleanObj((flag != 0));
1644         }
1645
1646     case BLT_CONFIG_DASHES:
1647         {
1648             unsigned char *p;
1649             Tcl_Obj *listObjPtr;
1650             Blt_Dashes *dashesPtr = (Blt_Dashes *)ptr;
1651
1652             listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
1653             for(p = dashesPtr->values; *p != 0; p++) {
1654                 Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewIntObj(*p));
1655             }
1656             return listObjPtr;
1657         }
1658
1659     case BLT_CONFIG_DISTANCE:
1660     case BLT_CONFIG_POS_DISTANCE:
1661         return Tcl_NewIntObj(*(int *)ptr);
1662
1663     case BLT_CONFIG_FILL:
1664         string = Blt_NameOfFill(*(int *)ptr);
1665         break;
1666
1667     case BLT_CONFIG_FLOAT:
1668         {
1669             double x = *(double *)ptr;
1670             return Tcl_NewDoubleObj(x);
1671         }
1672
1673     case BLT_CONFIG_LIST:
1674         {
1675             Tcl_Obj *objPtr, *listObjPtr;
1676             char **p;
1677
1678             listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
1679             for (p = *(char ***)ptr; *p != NULL; p++) {
1680                 objPtr = Tcl_NewStringObj(*p, -1);
1681                 Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
1682             }
1683             return listObjPtr;
1684         }
1685
1686     case BLT_CONFIG_OBJCMD:
1687     case BLT_CONFIG_OBJ:
1688     case BLT_CONFIG_LISTOBJ:
1689         if (*(Tcl_Obj **)ptr) {
1690            return *(Tcl_Obj **)ptr;
1691         }
1692         return Tcl_NewStringObj("", -1);
1693
1694     case BLT_CONFIG_PAD:
1695         {
1696             Blt_Pad *padPtr = (Blt_Pad *)ptr;
1697             Tcl_Obj *objPtr, *listObjPtr;
1698
1699             listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
1700             objPtr = Tcl_NewIntObj(padPtr->side1);
1701             Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
1702             objPtr = Tcl_NewIntObj(padPtr->side2);
1703             Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
1704             return listObjPtr;
1705         }
1706
1707     case BLT_CONFIG_SHADOW:
1708         {
1709             Shadow *shadowPtr = (Shadow *)ptr;
1710             Tcl_Obj *objPtr, *listObjPtr;
1711
1712             if (shadowPtr->color != NULL) {
1713                 listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
1714                 objPtr = Tcl_NewStringObj(Tk_NameOfColor(shadowPtr->color), -1);
1715                 Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
1716                 objPtr = Tcl_NewIntObj(shadowPtr->offset);
1717                 Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
1718                 return listObjPtr;
1719             }
1720             break;
1721         }
1722
1723     case BLT_CONFIG_STATE:
1724         string = Blt_NameOfState(*(int *)ptr);
1725         break;
1726
1727     case BLT_CONFIG_TILE:
1728         string = Blt_NameOfTile(*(Blt_Tile*)ptr);
1729         break;
1730
1731     case BLT_CONFIG_SIDE:
1732         string = Blt_NameOfSide(*(int *)ptr);
1733         break;
1734
1735     case BLT_CONFIG_ARROW:
1736         string = Blt_NameOfArrow(*(int *)ptr);
1737         break;
1738
1739     default:
1740         string = "?? unknown type ??";
1741     }
1742     return Tcl_NewStringObj(string, -1);
1743 }
1744
1745 /*
1746  *--------------------------------------------------------------
1747  *
1748  * FormatConfigInfo --
1749  *
1750  *      Create a valid Tcl list holding the configuration information
1751  *      for a single configuration option.
1752  *
1753  * Results:
1754  *      A Tcl list, dynamically allocated.  The caller is expected to
1755  *      arrange for this list to be freed eventually.
1756  *
1757  * Side effects:
1758  *      Memory is allocated.
1759  *
1760  *--------------------------------------------------------------
1761  */
1762 static Tcl_Obj *
1763 FormatConfigInfo(interp, tkwin, specPtr, widgRec)
1764     Tcl_Interp *interp;                 /* Interpreter to use for things
1765                                          * like floating-point precision. */
1766     Tk_Window tkwin;                    /* Window corresponding to widget. */
1767     register Blt_ConfigSpec *specPtr;   /* Pointer to information describing
1768                                          * option. */
1769     char *widgRec;                      /* Pointer to record holding current
1770                                          * values of info for widget. */
1771 {
1772     Tcl_Obj *objv[6];
1773     Tcl_Obj *listObjPtr;
1774     int size=5;
1775
1776     objv[0] = Tcl_NewStringObj(specPtr->switchName?specPtr->switchName:"", -1);
1777     if (specPtr->type == BLT_CONFIG_SYNONYM) {
1778         objv[1] = Tcl_NewStringObj(specPtr->customPtr?(char*)specPtr->customPtr:"", -1);
1779         listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
1780         Tcl_ListObjAppendElement(interp, listObjPtr, objv[0]);
1781         Tcl_ListObjAppendElement(interp, listObjPtr, objv[1]);
1782         return listObjPtr;
1783     }
1784     objv[1] = Tcl_NewStringObj(specPtr->dbName?(char*)specPtr->dbName:"", -1);
1785     objv[2] = Tcl_NewStringObj(specPtr->dbClass?(char*)specPtr->dbClass:"", -1);
1786     objv[3] = Tcl_NewStringObj(specPtr->defValue?(char*)specPtr->defValue:"", -1);
1787     objv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec);
1788
1789     if (strstr(Tk_PathName(tkwin), ".__##") &&
1790     specPtr->type < BLT_CONFIG_END && specPtr->type >=0) {
1791         int stype = specPtr->type;
1792         static char *conftypes[BLT_CONFIG_END+10] = {
1793             "cursor", "anchor", "bitmap", "bool", "border", "cap", "color",
1794             "activecursor", "custom", "double", "font", "int", "join",
1795             "justify", "mm", "pixels", "relief", "string", "syn", "uid",
1796             "window", "bitflag", "dashes", "distance", "fill", "float",
1797             "list", "listobj", "pad", "paddistance", "shadow", "side",
1798             "state", "tile", "obj", "objcmd", "arrow",
1799              "END"
1800         };
1801         if (conftypes[BLT_CONFIG_END] == 0 ||
1802         strcmp(conftypes[BLT_CONFIG_END],"END")) {
1803             fprintf(stderr, "Blt_ConfigTypes changed\n");
1804         }
1805         if (stype == BLT_CONFIG_CUSTOM) {
1806             extern Blt_CustomOption bltDistanceOption;
1807             extern Blt_CustomOption bltPositiveDistanceOption;
1808
1809             if (specPtr->customPtr == &bltDistanceOption ||
1810                 specPtr->customPtr == &bltPositiveDistanceOption
1811             ) {
1812                 stype = BLT_CONFIG_PIXELS;
1813             }
1814         }
1815
1816         objv[5] = Tcl_NewStringObj(conftypes[stype], -1);
1817         size=6;
1818     }
1819
1820     return Tcl_NewListObj(size, objv);
1821 }
1822
1823 /*
1824  *--------------------------------------------------------------
1825  *
1826  * FindConfigSpec --
1827  *
1828  *      Search through a table of configuration specs, looking for
1829  *      one that matches a given switchName.
1830  *
1831  * Results:
1832  *      The return value is a pointer to the matching entry, or NULL
1833  *      if nothing matched.  In that case an error message is left
1834  *      in the interp's result.
1835  *
1836  * Side effects:
1837  *      None.
1838  *
1839  *--------------------------------------------------------------
1840  */
1841 static Blt_ConfigSpec *
1842 FindConfigSpec(interp, specs, objPtr, needFlags, hateFlags)
1843     Tcl_Interp *interp;         /* Used for reporting errors. */
1844     Blt_ConfigSpec *specs;      /* Pointer to table of configuration
1845                                  * specifications for a widget. */
1846     Tcl_Obj *objPtr;            /* Name (suitable for use in a "config"
1847                                  * command) identifying particular option. */
1848     int needFlags;              /* Flags that must be present in matching
1849                                  * entry. */
1850     int hateFlags;              /* Flags that must NOT be present in
1851                                  * matching entry. */
1852 {
1853     register Blt_ConfigSpec *specPtr;
1854     register char c;            /* First character of current argument. */
1855     Blt_ConfigSpec *matchPtr;   /* Matching spec, or NULL. */
1856     int length;
1857     char *string;
1858
1859     string = Tcl_GetStringFromObj(objPtr, &length);
1860     c = string[1];
1861     matchPtr = NULL;
1862     for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
1863         if (specPtr->switchName == NULL) {
1864             continue;
1865         }
1866         if ((specPtr->switchName[1] != c) ||
1867             (strncmp(specPtr->switchName, string, length) != 0)) {
1868             continue;
1869         }
1870         if (((specPtr->specFlags & needFlags) != needFlags) ||
1871             (specPtr->specFlags & hateFlags)) {
1872             continue;
1873         }
1874         if (specPtr->switchName[length] == 0) {
1875             matchPtr = specPtr;
1876             goto gotMatch;
1877         }
1878         if (matchPtr != NULL) {
1879             if (interp != NULL) {
1880                 Tcl_AppendResult(interp, "ambiguous option \"", string, "\"",
1881                              (char *)NULL);
1882             }
1883             return (Blt_ConfigSpec *)NULL;
1884         }
1885         matchPtr = specPtr;
1886     }
1887
1888     if (matchPtr == NULL) {
1889         if (interp != NULL) {
1890             Tcl_AppendResult(interp, "unknown option \"", string, "\"",
1891                 (char *)NULL);
1892         }
1893         return (Blt_ConfigSpec *)NULL;
1894     }
1895
1896     /*
1897      * Found a matching entry.  If it's a synonym, then find the
1898      * entry that it's a synonym for.
1899      */
1900
1901  gotMatch:
1902     specPtr = matchPtr;
1903     if (specPtr->type == BLT_CONFIG_SYNONYM) {
1904         for (specPtr = specs; ; specPtr++) {
1905             if (specPtr->type == BLT_CONFIG_END) {
1906                 if (interp != NULL) {
1907                     Tcl_AppendResult(interp,
1908                         "couldn't find synonym for option \"", string,
1909                         "\"", (char *) NULL);
1910                 }
1911                 return (Blt_ConfigSpec *) NULL;
1912             }
1913              if ((specPtr->type != BLT_CONFIG_SYNONYM) &&
1914                 ((specPtr->specFlags & needFlags) == needFlags) &&
1915                 (specPtr->specFlags & hateFlags) == 0 &&
1916                 (strcmp(specPtr->switchName, (char*)matchPtr->customPtr)==0)) {
1917                 break;
1918             }
1919         }
1920     }
1921     return specPtr;
1922 }
1923
1924 /* Public routines */
1925
1926 /*
1927  *--------------------------------------------------------------
1928  *
1929  * Blt_ConfigureWidgetFromObj --
1930  *
1931  *      Process command-line options and database options to
1932  *      fill in fields of a widget record with resources and
1933  *      other parameters.
1934  *
1935  * Results:
1936  *      A standard Tcl return value.  In case of an error,
1937  *      the interp's result will hold an error message.
1938  *
1939  * Side effects:
1940  *      The fields of widgRec get filled in with information
1941  *      from argc/argv and the option database.  Old information
1942  *      in widgRec's fields gets recycled.
1943  *
1944  *--------------------------------------------------------------
1945  */
1946 int
1947 Blt_ConfigureWidgetFromObj(interp, tkwin, specs, objc, objv, widgRec, flags, subwin)
1948     Tcl_Interp *interp;         /* Interpreter for error reporting. */
1949     Tk_Window tkwin;            /* Window containing widget (needed to
1950                                  * set up X resources). */
1951     Blt_ConfigSpec *specs;      /* Describes legal options. */
1952     int objc;                   /* Number of elements in argv. */
1953     Tcl_Obj *CONST *objv;       /* Command-line options. */
1954     char *widgRec;              /* Record whose fields are to be
1955                                  * modified.  Values must be properly
1956                                  * initialized. */
1957     int flags;                  /* Used to specify additional flags
1958                                  * that must be present in config specs
1959                                  * for them to be considered.  Also,
1960                                  * may have BLT_CONFIG_ARGV_ONLY set. */
1961     Tk_Window subwin;           /* Child window for components. */
1962 {
1963     register Blt_ConfigSpec *specPtr;
1964     int needFlags;              /* Specs must contain this set of flags
1965                                  * or else they are not considered. */
1966     int hateFlags;              /* If a spec contains any bits here, it's
1967                                  * not considered. */
1968
1969     if (tkwin == NULL) {
1970         /*
1971          * Either we're not really in Tk, or the main window was destroyed and
1972          * we're on our way out of the application
1973          */
1974         Tcl_AppendResult(interp, "NULL main window", (char *)NULL);
1975         return TCL_ERROR;
1976     }
1977
1978     if (subwin == NULL) {
1979         subwin = tkwin;
1980     }
1981
1982     needFlags = flags & ~(BLT_CONFIG_USER_BIT - 1);
1983     if (Tk_Depth(tkwin) <= 1) {
1984         hateFlags = BLT_CONFIG_COLOR_ONLY;
1985     } else {
1986         hateFlags = BLT_CONFIG_MONO_ONLY;
1987     }
1988
1989     /*
1990      * Pass one:  scan through all the option specs, replacing strings
1991      * with Tk_Uid structs (if this hasn't been done already) and
1992      * clearing the BLT_CONFIG_OPTION_SPECIFIED flags.
1993      */
1994
1995      specs = Blt_GetCachedBltSpecs(interp, specs);
1996      for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
1997         if (!(specPtr->specFlags & INIT) && (specPtr->switchName != NULL)) {
1998             if (specPtr->dbName != NULL) {
1999                 specPtr->dbName = Tk_GetUid((char*)specPtr->dbName);
2000             }
2001             if (specPtr->dbClass != NULL) {
2002                 specPtr->dbClass = Tk_GetUid((char*)specPtr->dbClass);
2003             }
2004             if (specPtr->defValue != NULL) {
2005                 specPtr->defValue = Tk_GetUid((char*)specPtr->defValue);
2006             }
2007         }
2008         specPtr->specFlags =
2009             (specPtr->specFlags & ~BLT_CONFIG_OPTION_SPECIFIED) | INIT;
2010     }
2011
2012     /*
2013      * Pass two:  scan through all of the arguments, processing those
2014      * that match entries in the specs.
2015      */
2016     while (objc > 0) {
2017         specPtr = FindConfigSpec(interp, specs, objv[0], needFlags, hateFlags);
2018         if (specPtr == NULL) {
2019             return TCL_ERROR;
2020         }
2021
2022         /* Process the entry.  */
2023         if (objc < 2) {
2024             Tcl_AppendResult(interp, "value for \"", Tcl_GetString(objv[0]),
2025                     "\" missing", (char *) NULL);
2026             return TCL_ERROR;
2027         }
2028         if (DoConfig(interp, tkwin, specPtr, objv[1], widgRec) != TCL_OK) {
2029             char msg[100];
2030
2031             sprintf(msg, "\n    (processing \"%.40s\" option)",
2032                     specPtr->switchName);
2033             Tcl_AddErrorInfo(interp, msg);
2034             return TCL_ERROR;
2035         }
2036         specPtr->specFlags |= BLT_CONFIG_OPTION_SPECIFIED;
2037         objc -= 2, objv += 2;
2038     }
2039
2040     /*
2041      * Pass three:  scan through all of the specs again;  if no
2042      * command-line argument matched a spec, then check for info
2043      * in the option database.  If there was nothing in the
2044      * database, then use the default.
2045      */
2046
2047     if (!(flags & BLT_CONFIG_OBJV_ONLY)) {
2048         Tcl_Obj *objPtr;
2049
2050         for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
2051             if ((specPtr->specFlags & BLT_CONFIG_OPTION_SPECIFIED) ||
2052                 (specPtr->switchName == NULL) ||
2053                 (specPtr->type == BLT_CONFIG_SYNONYM)) {
2054                 continue;
2055             }
2056             if (((specPtr->specFlags & needFlags) != needFlags) ||
2057                 (specPtr->specFlags & hateFlags)) {
2058                 continue;
2059             }
2060             objPtr = NULL;
2061             if (specPtr->dbName != NULL) {
2062                 Tk_Uid value;
2063
2064                 value = Tk_GetOption(subwin, (char*)specPtr->dbName, (char*)specPtr->dbClass);
2065                 if (value != NULL) {
2066                     objPtr = Tcl_NewStringObj((char*)value, -1);
2067                     Tcl_IncrRefCount(objPtr);
2068                 }
2069             }
2070             if (objPtr != NULL) {
2071                 if (DoConfig(interp, tkwin, specPtr, objPtr, widgRec)
2072                     != TCL_OK) {
2073                     char msg[200];
2074
2075                     sprintf(msg, "\n    (%s \"%.50s\" in widget \"%.50s\")",
2076                             "database entry for",
2077                             specPtr->dbName, Tk_PathName(tkwin));
2078                     if (getenv("TCL_BADOPTS") == NULL) {
2079                           fprintf(stderr, "%s%s\n", Tcl_GetStringResult(interp), msg);
2080                           Tcl_DecrRefCount(objPtr);
2081                           objPtr = NULL;
2082                           goto dodefault;
2083                     }
2084                     Tcl_AddErrorInfo(interp, msg);
2085                     Tcl_DecrRefCount(objPtr);
2086                     return TCL_ERROR;
2087                 }
2088                 Tcl_DecrRefCount(objPtr);
2089               } else {
2090 dodefault:
2091                 if (specPtr->defValue != NULL) {
2092                     objPtr = Tcl_NewStringObj((char*)specPtr->defValue, -1);
2093                     Tcl_IncrRefCount(objPtr);
2094                 } else {
2095                     objPtr = NULL;
2096                 }
2097                 if ((objPtr != NULL) && !(specPtr->specFlags
2098                         & BLT_CONFIG_DONT_SET_DEFAULT)) {
2099                     if (DoConfig(interp, tkwin, specPtr, objPtr, widgRec)
2100                         != TCL_OK) {
2101                         char msg[200];
2102
2103                         Tcl_DecrRefCount(objPtr);
2104                         sprintf(msg,
2105                                 "\n    (%s \"%.50s\" in widget \"%.50s\")",
2106                                 "default value for",
2107                                 specPtr->dbName, Tk_PathName(tkwin));
2108                         Tcl_AddErrorInfo(interp, msg);
2109                         return TCL_ERROR;
2110                     }
2111                 }
2112                 if ((objPtr != NULL)) {
2113                     Tcl_DecrRefCount(objPtr);
2114                 }
2115             }
2116         }
2117     }
2118
2119     return TCL_OK;
2120 }
2121
2122 /*
2123  *--------------------------------------------------------------
2124  *
2125  * Blt_ConfigureInfoFromObj --
2126  *
2127  *      Return information about the configuration options
2128  *      for a window, and their current values.
2129  *
2130  * Results:
2131  *      Always returns TCL_OK.  The interp's result will be modified
2132  *      hold a description of either a single configuration option
2133  *      available for "widgRec" via "specs", or all the configuration
2134  *      options available.  In the "all" case, the result will
2135  *      available for "widgRec" via "specs".  The result will
2136  *      be a list, each of whose entries describes one option.
2137  *      Each entry will itself be a list containing the option's
2138  *      name for use on command lines, database name, database
2139  *      class, default value, and current value (empty string
2140  *      if none).  For options that are synonyms, the list will
2141  *      contain only two values:  name and synonym name.  If the
2142  *      "name" argument is non-NULL, then the only information
2143  *      returned is that for the named argument (i.e. the corresponding
2144  *      entry in the overall list is returned).
2145  *
2146  * Side effects:
2147  *      None.
2148  *
2149  *--------------------------------------------------------------
2150  */
2151
2152 int
2153 Blt_ConfigureInfoFromObj(interp, tkwin, specs, widgRec, objPtr, flags)
2154     Tcl_Interp *interp;         /* Interpreter for error reporting. */
2155     Tk_Window tkwin;            /* Window corresponding to widgRec. */
2156     Blt_ConfigSpec *specs;      /* Describes legal options. */
2157     char *widgRec;              /* Record whose fields contain current
2158                                  * values for options. */
2159     Tcl_Obj *objPtr;            /* If non-NULL, indicates a single option
2160                                  * whose info is to be returned.  Otherwise
2161                                  * info is returned for all options. */
2162     int flags;                  /* Used to specify additional flags
2163                                  * that must be present in config specs
2164                                  * for them to be considered. */
2165 {
2166     register Blt_ConfigSpec *specPtr;
2167     int needFlags, hateFlags;
2168     char *string;
2169     Tcl_Obj *listObjPtr, *valueObjPtr;
2170
2171     needFlags = flags & ~(BLT_CONFIG_USER_BIT - 1);
2172     if (Tk_Depth(tkwin) <= 1) {
2173         hateFlags = BLT_CONFIG_COLOR_ONLY;
2174     } else {
2175         hateFlags = BLT_CONFIG_MONO_ONLY;
2176     }
2177
2178     /*
2179      * If information is only wanted for a single configuration
2180      * spec, then handle that one spec specially.
2181      */
2182
2183     Tcl_SetResult(interp, (char *)NULL, TCL_STATIC);
2184     specs = Blt_GetCachedBltSpecs(interp, specs);
2185     if (objPtr != NULL) {
2186         specPtr = FindConfigSpec(interp, specs, objPtr, needFlags, hateFlags);
2187         if (specPtr == NULL) {
2188             return TCL_ERROR;
2189         }
2190         valueObjPtr =  FormatConfigInfo(interp, tkwin, specPtr, widgRec);
2191         Tcl_SetObjResult(interp, valueObjPtr);
2192         return TCL_OK;
2193     }
2194
2195     /*
2196      * Loop through all the specs, creating a big list with all
2197      * their information.
2198      */
2199     string = NULL;              /* Suppress compiler warning. */
2200     if (objPtr != NULL) {
2201         string = Tcl_GetString(objPtr);
2202     }
2203     listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
2204     for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
2205         if ((objPtr != NULL) && (specPtr->switchName != string)) {
2206             continue;
2207         }
2208         if (((specPtr->specFlags & needFlags) != needFlags) ||
2209             (specPtr->specFlags & hateFlags)) {
2210             continue;
2211         }
2212         if (specPtr->switchName == NULL) {
2213             continue;
2214         }
2215         valueObjPtr = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
2216         Tcl_ListObjAppendElement(interp, listObjPtr, valueObjPtr);
2217     }
2218     Tcl_SetObjResult(interp, listObjPtr);
2219     return TCL_OK;
2220 }
2221
2222 /* Format expected arguments into interp. */
2223 int
2224 Blt_FormatSpecOptions(interp, specs)
2225     Tcl_Interp *interp;         /* Interpreter for error reporting. */
2226     Blt_ConfigSpec *specs;      /* Describes legal options. */
2227 {
2228     Blt_ConfigSpec *specPtr;
2229     int cnt = 0;
2230     for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
2231         Tcl_AppendResult(interp, (cnt?", ":""), specPtr->switchName, 0);
2232         cnt++;
2233     }
2234     return TCL_OK;
2235 }
2236
2237
2238 /*
2239  *----------------------------------------------------------------------
2240  *
2241  * Blt_ConfigureValueFromObj --
2242  *
2243  *      This procedure returns the current value of a configuration
2244  *      option for a widget.
2245  *
2246  * Results:
2247  *      The return value is a standard Tcl completion code (TCL_OK or
2248  *      TCL_ERROR).  The interp's result will be set to hold either the value
2249  *      of the option given by objPtr (if TCL_OK is returned) or
2250  *      an error message (if TCL_ERROR is returned).
2251  *
2252  * Side effects:
2253  *      None.
2254  *
2255  *----------------------------------------------------------------------
2256  */
2257 int
2258 Blt_ConfigureValueFromObj(interp, tkwin, specs, widgRec, objPtr, flags)
2259     Tcl_Interp *interp;         /* Interpreter for error reporting. */
2260     Tk_Window tkwin;            /* Window corresponding to widgRec. */
2261     Blt_ConfigSpec *specs;      /* Describes legal options. */
2262     char *widgRec;              /* Record whose fields contain current
2263                                  * values for options. */
2264     Tcl_Obj *objPtr;            /* Gives the command-line name for the
2265                                  * option whose value is to be returned. */
2266     int flags;                  /* Used to specify additional flags
2267                                  * that must be present in config specs
2268                                  * for them to be considered. */
2269 {
2270     Blt_ConfigSpec *specPtr;
2271     int needFlags, hateFlags;
2272
2273     needFlags = flags & ~(BLT_CONFIG_USER_BIT - 1);
2274     if (Tk_Depth(tkwin) <= 1) {
2275         hateFlags = BLT_CONFIG_COLOR_ONLY;
2276     } else {
2277         hateFlags = BLT_CONFIG_MONO_ONLY;
2278     }
2279     specs = Blt_GetCachedBltSpecs(interp, specs);
2280     specPtr = FindConfigSpec(interp, specs, objPtr, needFlags, hateFlags);
2281     if (specPtr == NULL) {
2282         return TCL_ERROR;
2283     }
2284     objPtr = FormatConfigValue(interp, tkwin, specPtr, widgRec);
2285     Tcl_SetObjResult(interp, objPtr);
2286     return TCL_OK;
2287 }
2288
2289 /*
2290  *----------------------------------------------------------------------
2291  *
2292  * Blt_FreeObjOptions --
2293  *
2294  *      Free up all resources associated with configuration options.
2295  *
2296  * Results:
2297  *      None.
2298  *
2299  * Side effects:
2300  *      Any resource in widgRec that is controlled by a configuration
2301  *      option (e.g. a Tk_3DBorder or XColor) is freed in the appropriate
2302  *      fashion.
2303  *
2304  *----------------------------------------------------------------------
2305  */
2306 void
2307 Blt_FreeObjOptions(interp, specs, widgRec, display, needFlags)
2308     Tcl_Interp *interp;         /* Interpreter for error reporting. */
2309     Blt_ConfigSpec *specs;      /* Describes legal options. */
2310     char *widgRec;              /* Record whose fields contain current
2311                                  * values for options. */
2312     Display *display;           /* X display; needed for freeing some
2313                                  * resources. */
2314     int needFlags;              /* Used to specify additional flags
2315                                  * that must be present in config specs
2316                                  * for them to be considered. */
2317 {
2318     register Blt_ConfigSpec *specPtr;
2319     char *ptr;
2320
2321     specs = Blt_GetCachedBltSpecs(interp, specs);
2322     for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
2323         if ((specPtr->specFlags & needFlags) != needFlags) {
2324             continue;
2325         }
2326         ptr = widgRec + specPtr->offset;
2327         switch (specPtr->type) {
2328         case BLT_CONFIG_STRING:
2329             if (*((char **) ptr) != NULL) {
2330                 Blt_Free(*((char **) ptr));
2331                 *((char **) ptr) = NULL;
2332             }
2333             break;
2334
2335         case BLT_CONFIG_SHADOW: {
2336             Shadow *shadPtr = (Shadow*)ptr;
2337             if (shadPtr->color != NULL) {
2338                 Tk_FreeColor(shadPtr->color);
2339                 shadPtr->color = NULL;
2340             }
2341             shadPtr->offset = 0;
2342             break;
2343         }
2344
2345         case BLT_CONFIG_COLOR:
2346             if (*((XColor **) ptr) != NULL) {
2347                 Tk_FreeColor(*((XColor **) ptr));
2348                 *((XColor **) ptr) = NULL;
2349             }
2350             break;
2351
2352         case BLT_CONFIG_FONT:
2353             Tk_FreeFont(*((Tk_Font *) ptr));
2354             *((Tk_Font *) ptr) = NULL;
2355             break;
2356
2357         case BLT_CONFIG_BITMAP:
2358             if (*((Pixmap *) ptr) != None) {
2359                 Tk_FreeBitmap(display, *((Pixmap *) ptr));
2360                 *((Pixmap *) ptr) = None;
2361             }
2362             break;
2363
2364         case BLT_CONFIG_BORDER:
2365             if (*((Tk_3DBorder *) ptr) != NULL) {
2366                 Tk_Free3DBorder(*((Tk_3DBorder *) ptr));
2367                 *((Tk_3DBorder *) ptr) = NULL;
2368             }
2369             break;
2370
2371         case BLT_CONFIG_CURSOR:
2372         case BLT_CONFIG_ACTIVE_CURSOR:
2373             if (*((Tk_Cursor *) ptr) != None) {
2374                 Tk_FreeCursor(display, *((Tk_Cursor *) ptr));
2375                 *((Tk_Cursor *) ptr) = None;
2376             }
2377             break;
2378
2379         case BLT_CONFIG_OBJCMD:
2380         case BLT_CONFIG_OBJ:
2381         case BLT_CONFIG_LISTOBJ:
2382             if ((*(Tcl_Obj **)ptr) != NULL) {
2383                  Tcl_DecrRefCount(*(Tcl_Obj **)ptr);
2384                  *((Tcl_Obj **) ptr) = NULL;
2385             }
2386             break;
2387
2388         case BLT_CONFIG_LIST:
2389             {
2390                 char **argv;
2391
2392                 argv = *(char ***)ptr;
2393                 if (argv != NULL) {
2394                     Blt_Free(argv);
2395                     *(char ***)ptr = NULL;
2396                 }
2397
2398             }
2399             break;
2400
2401         case BLT_CONFIG_TILE:
2402             if (*(Blt_Tile*)ptr != NULL) {
2403                 Blt_FreeTile(*(Blt_Tile*)ptr);
2404                 *(Blt_Tile *)ptr = NULL;
2405             }
2406             break;
2407
2408         case BLT_CONFIG_CUSTOM:
2409             if ((*(char **)ptr != NULL) &&
2410                 (specPtr->customPtr->freeProc != NULL)) {
2411                 (*specPtr->customPtr->freeProc)(specPtr->customPtr->clientData,
2412                   display, widgRec, specPtr->offset, *(char **)ptr);
2413                 *(char **)ptr = NULL;
2414             }
2415             break;
2416         }
2417     }
2418 }
2419
2420 /*
2421  *----------------------------------------------------------------------
2422  *
2423  * Blt_ObjConfigModified --
2424  *
2425  *      Given the configuration specifications and one or more option
2426  *      patterns (terminated by a NULL), indicate if any of the matching
2427  *      configuration options has been reset.
2428  *
2429  * Results:
2430  *      Returns 1 if one of the options has changed, 0 otherwise.
2431  *      If no options specified, clears all modified flags.
2432  *
2433  *----------------------------------------------------------------------
2434  */
2435 int
2436 Blt_ObjConfigModified TCL_VARARGS_DEF(Blt_ConfigSpec *, arg1)
2437 {
2438     va_list argList;
2439     Blt_ConfigSpec *specs;
2440     register Blt_ConfigSpec *specPtr;
2441     register char *option;
2442     Tcl_Interp *interp;
2443     int cnt=0;
2444
2445     specs = TCL_VARARGS_START(Blt_ConfigSpec *, arg1, argList);
2446     interp = va_arg(argList, Tcl_Interp *);
2447     specs = Blt_GetCachedBltSpecs(interp, specs);
2448     while ((option = va_arg(argList, char *)) != NULL) {
2449         cnt++;
2450         for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
2451             if ((Tcl_StringMatch(specPtr->switchName, option)) &&
2452                 (specPtr->specFlags & BLT_CONFIG_OPTION_SPECIFIED)) {
2453                 va_end(argList);
2454                 return 1;
2455             }
2456         }
2457     }
2458     va_end(argList);
2459     if (cnt == 0) {
2460         for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
2461             specPtr->specFlags &= ~BLT_CONFIG_OPTION_SPECIFIED;
2462         }
2463     }
2464     return 0;
2465 }
2466
2467 /*
2468  *----------------------------------------------------------------------
2469  *
2470  * Blt_ConfigureComponentFromObj --
2471  *
2472  *      Configures a component of a widget.  This is useful for
2473  *      widgets that have multiple components which aren't uniquely
2474  *      identified by a Tk_Window. It allows us, for example, set
2475  *      resources for axes of the graph widget. The graph really has
2476  *      only one window, but its convenient to specify components in a
2477  *      hierarchy of options.
2478  *
2479  *              *graph.x.logScale yes
2480  *              *graph.Axis.logScale yes
2481  *              *graph.temperature.scaleSymbols yes
2482  *              *graph.Element.scaleSymbols yes
2483  *
2484  *      This is really a hack to work around the limitations of the Tk
2485  *      resource database.  It creates a temporary window, needed to
2486  *      call Tk_ConfigureWidget, using the name of the component.
2487  *
2488  * Results:
2489  *      A standard Tcl result.
2490  *
2491  * Side Effects:
2492  *      A temporary window is created merely to pass to Tk_ConfigureWidget.
2493  *
2494  *----------------------------------------------------------------------
2495  */
2496 int
2497 Blt_ConfigureComponentFromObj(interp, parent, name, className, specsPtr,
2498         objc, objv, widgRec, flags)
2499     Tcl_Interp *interp;
2500     Tk_Window parent;           /* Window to associate with component */
2501     char *name;                 /* Name of component */
2502     char *className;
2503     Blt_ConfigSpec *specsPtr;
2504     int objc;
2505     Tcl_Obj *CONST *objv;
2506     char *widgRec;
2507     int flags;
2508 {
2509     Tk_Window tkwin;
2510     int result;
2511     char *tmpName;
2512     int isTemporary = FALSE;
2513
2514     tmpName = Blt_Strdup(name);
2515
2516     /* Window name can't start with an upper case letter */
2517     tmpName[0] = tolower(name[0]);
2518
2519     /*
2520      * Create component if a child window by the component's name
2521      * doesn't already exist.
2522      */
2523     tkwin = Blt_FindChild(parent, tmpName);
2524     if (tkwin == NULL) {
2525         tkwin = Tk_CreateWindow(interp, parent, tmpName, (char *)NULL);
2526         isTemporary = TRUE;
2527     }
2528     if (tkwin == NULL) {
2529         Tcl_AppendResult(interp, "can't find window in \"",
2530                          Tk_PathName(parent), "\"", (char *)NULL);
2531         return TCL_ERROR;
2532     }
2533     assert(Tk_Depth(tkwin) == Tk_Depth(parent));
2534     Blt_Free(tmpName);
2535
2536     Tk_SetClass(tkwin, className);
2537     result = Blt_ConfigureWidgetFromObj(interp, parent, specsPtr, objc, objv,
2538         widgRec, flags, tkwin);
2539     if (isTemporary) {
2540         Tk_DestroyWindow(tkwin);
2541     }
2542     return result;
2543 }
2544
2545 /*
2546  *--------------------------------------------------------------
2547  *
2548  * Blt_ObjIsOption --
2549  *
2550  *      Indicates whether objPtr is a valid configuration option
2551  *      such as -background.
2552  *
2553  * Results:
2554  *      Returns 1 is a matching option is found and 0 otherwise.
2555  *
2556  *--------------------------------------------------------------
2557  */
2558 int
2559 Blt_ObjIsOption(interp, specs, objPtr, flags)
2560     Tcl_Interp *interp;
2561     Blt_ConfigSpec *specs;      /* Describes legal options. */
2562     Tcl_Obj *objPtr;            /* Command-line option name. */
2563     int flags;                  /* Used to specify additional flags
2564                                  * that must be present in config specs
2565                                  * for them to be considered.  Also,
2566                                  * may have BLT_CONFIG_ARGV_ONLY set. */
2567 {
2568     register Blt_ConfigSpec *specPtr;
2569     int needFlags;              /* Specs must contain this set of flags
2570                                  * or else they are not considered. */
2571     specs = Blt_GetCachedBltSpecs(interp, specs);
2572     needFlags = flags & ~(BLT_CONFIG_USER_BIT - 1);
2573     specPtr = FindConfigSpec((Tcl_Interp *)NULL, specs, objPtr, needFlags, 0);
2574     return (specPtr != NULL);
2575 }
2576
2577 /*
2578 *--------------------------------------------------------------
2579 *
2580 * DeleteSpecCacheTable --
2581 *
2582 *       Delete the per-interpreter copy of all the Blt_ConfigSpec tables which
2583 *       were stored in the interpreter's assoc-data store.
2584 *
2585 * Results:
2586 *       None
2587 *
2588 * Side effects:
2589 *       None
2590 *
2591 *--------------------------------------------------------------
2592 */
2593
2594 static void
2595 DeleteSpecCacheTable(clientData, interp)
2596 ClientData clientData;
2597 Tcl_Interp *interp;
2598 {
2599     Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData;
2600     Tcl_HashEntry *entryPtr;
2601     Tcl_HashSearch search;
2602
2603     for (entryPtr = Tcl_FirstHashEntry(tablePtr,&search); entryPtr != NULL;
2604     entryPtr = Tcl_NextHashEntry(&search)) {
2605         /*
2606         * Someone else deallocates the Tk_Uids themselves.
2607         */
2608
2609         ckfree((char *) Tcl_GetHashValue(entryPtr));
2610     }
2611     Tcl_DeleteHashTable(tablePtr);
2612     ckfree((char *) tablePtr);
2613 }
2614
2615
2616 Blt_ConfigSpec *
2617 Blt_GetCachedBltSpecs(interp, staticSpecs)
2618 Tcl_Interp *interp;
2619 const Blt_ConfigSpec *staticSpecs;
2620 {
2621     return GetCachedBltSpecs(interp, staticSpecs);
2622 }
2623
2624 static Blt_ConfigSpec *
2625 GetCachedBltSpecs(interp, staticSpecs)
2626 Tcl_Interp *interp;             /* Interpreter in which to store the cache. */
2627 const Blt_ConfigSpec *staticSpecs;
2628 /* Value to cache a copy of; it is also used
2629 * as a key into the cache. */
2630 {
2631     Blt_ConfigSpec *cachedSpecs;
2632     Tcl_HashTable *specCacheTablePtr;
2633     Tcl_HashEntry *entryPtr;
2634     int isNew;
2635
2636     /*
2637     * Get (or allocate if it doesn't exist) the hash table that the writable
2638     * copies of the widget specs are stored in. In effect, this is
2639     * self-initializing code.
2640     */
2641
2642     specCacheTablePtr = (Tcl_HashTable *)
2643     Tcl_GetAssocData(interp, "bltConfigSpec.threadTable", NULL);
2644     if (specCacheTablePtr == NULL) {
2645         specCacheTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
2646         Tcl_InitHashTable(specCacheTablePtr, TCL_ONE_WORD_KEYS);
2647         Tcl_SetAssocData(interp, "bltConfigSpec.threadTable",
2648             DeleteSpecCacheTable, (ClientData) specCacheTablePtr);
2649     }
2650
2651     /*
2652     * Look up or create the hash entry that the constant specs are mapped to,
2653         * which will have the writable specs as its associated value.
2654         */
2655
2656         entryPtr = Tcl_CreateHashEntry(specCacheTablePtr, (char *) staticSpecs,
2657         &isNew);
2658         if (isNew) {
2659         unsigned int entrySpace = sizeof(Blt_ConfigSpec);
2660         const Blt_ConfigSpec *staticSpecPtr;
2661         Blt_ConfigSpec *specPtr;
2662
2663         /*
2664         * OK, no working copy in this interpreter so copy. Need to work out
2665         * how much space to allocate first.
2666         */
2667
2668         for (staticSpecPtr=staticSpecs; staticSpecPtr->type!=BLT_CONFIG_END;
2669         staticSpecPtr++) {
2670             entrySpace += sizeof(Blt_ConfigSpec);
2671         }
2672
2673         /*
2674         * Now allocate our working copy's space and copy over the contents
2675         * from the master copy.
2676         */
2677
2678         cachedSpecs = (Blt_ConfigSpec *) ckalloc(entrySpace);
2679         memcpy((void *) cachedSpecs, (void *) staticSpecs, entrySpace);
2680         Tcl_SetHashValue(entryPtr, (ClientData) cachedSpecs);
2681
2682         /*
2683         * Finally, go through and replace database names, database classes
2684         * and default values with Tk_Uids. This is the bit that has to be
2685         * per-thread.
2686         */
2687
2688         for (specPtr=cachedSpecs; specPtr->type!=BLT_CONFIG_END; specPtr++) {
2689             if (specPtr->switchName != NULL) {
2690                 if (specPtr->dbName != NULL) {
2691                     specPtr->dbName = Tk_GetUid((char*)specPtr->dbName);
2692                 }
2693                 if (specPtr->dbClass != NULL) {
2694                     specPtr->dbClass = Tk_GetUid((char*)specPtr->dbClass);
2695                 }
2696                 if (specPtr->defValue != NULL) {
2697                     specPtr->defValue = Tk_GetUid((char*)specPtr->defValue);
2698                 }
2699             }
2700         }
2701     } else {
2702         cachedSpecs = (Blt_ConfigSpec *) Tcl_GetHashValue(entryPtr);
2703     }
2704
2705     return cachedSpecs;
2706 }
2707
2708
2709 #endif /* TK_VERSION_NUMBER >= 8.1.0 */