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