/[dtapublic]/projs/dtats/trunk/shared_source/c_tk_base_7_5_w_mods/tkoldconfig.c

Diff of /projs/dtats/trunk/shared_source/c_tk_base_7_5_w_mods/tkoldconfig.c

Parent Directory | Revision Log | View Patch Patch

-revision 69 by dashley,
Sat Nov  5 10:54:17 2016 UTC
+revision 71 by dashley,
Sat Nov  5 11:07:06 2016 UTC
 Line 1
  /* $Header$ */
  /*
   * tkOldConfig.c --
   *
   *      This file contains the Tk_ConfigureWidget procedure. THIS FILE
   *      IS HERE FOR BACKWARD COMPATIBILITY; THE NEW CONFIGURATION
   *      PACKAGE SHOULD BE USED FOR NEW PROJECTS.
   *
   * Copyright (c) 1990-1994 The Regents of the University of California.
   * Copyright (c) 1994-1997 Sun Microsystems, Inc.
   *
   * See the file "license.terms" for information on usage and redistribution
   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   *
   * RCS: @(#) $Id: tkoldconfig.c,v 1.1.1.1 2001/06/13 05:06:29 dtashley Exp $
   */
  #include "tkPort.h"
  #include "tk.h"
  /*
   * Values for "flags" field of Tk_ConfigSpec structures.  Be sure
   * to coordinate these values with those defined in tk.h
   * (TK_CONFIG_COLOR_ONLY, etc.).  There must not be overlap!
   *
   * INIT -               Non-zero means (char *) things have been
   *                      converted to Tk_Uid's.
   */
  #define INIT            0x20
  /*
   * Forward declarations for procedures defined later in this file:
   */
  static int              DoConfig _ANSI_ARGS_((Tcl_Interp *interp,
                              Tk_Window tkwin, Tk_ConfigSpec *specPtr,
                              Tk_Uid value, int valueIsUid, char *widgRec));
  static Tk_ConfigSpec *  FindConfigSpec _ANSI_ARGS_((Tcl_Interp *interp,
                              Tk_ConfigSpec *specs, char *argvName,
                              int needFlags, int hateFlags));
  static char *           FormatConfigInfo _ANSI_ARGS_((Tcl_Interp *interp,
                              Tk_Window tkwin, Tk_ConfigSpec *specPtr,
                              char *widgRec));
  static char *           FormatConfigValue _ANSI_ARGS_((Tcl_Interp *interp,
                              Tk_Window tkwin, Tk_ConfigSpec *specPtr,
                              char *widgRec, char *buffer,
                              Tcl_FreeProc **freeProcPtr));
  /*
   *--------------------------------------------------------------
   *
   * Tk_ConfigureWidget --
   *
   *      Process command-line options and database options to
   *      fill in fields of a widget record with resources and
   *      other parameters.
   *
   * Results:
   *      A standard Tcl return value.  In case of an error,
   *      the interp's result will hold an error message.
   *
   * Side effects:
   *      The fields of widgRec get filled in with information
   *      from argc/argv and the option database.  Old information
   *      in widgRec's fields gets recycled.
   *
   *--------------------------------------------------------------
   */
  int
  Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags)
      Tcl_Interp *interp;         /* Interpreter for error reporting. */
      Tk_Window tkwin;            /* Window containing widget (needed to
                                   * set up X resources). */
      Tk_ConfigSpec *specs;       /* Describes legal options. */
      int argc;                   /* Number of elements in argv. */
      char **argv;                /* Command-line options. */
      char *widgRec;              /* Record whose fields are to be
                                   * modified.  Values must be properly
                                   * initialized. */
      int flags;                  /* Used to specify additional flags
                                   * that must be present in config specs
                                   * for them to be considered.  Also,
                                   * may have TK_CONFIG_ARGV_ONLY set. */
  {
      register Tk_ConfigSpec *specPtr;
      Tk_Uid value;               /* Value of option from database. */
      int needFlags;              /* Specs must contain this set of flags
                                   * or else they are not considered. */
      int hateFlags;              /* If a spec contains any bits here, it's
                                   * not considered. */
      if (tkwin == NULL) {
          /*
           * Either we're not really in Tk, or the main window was destroyed and
           * we're on our way out of the application
           */
          Tcl_AppendResult(interp, "NULL main window", (char *)NULL);
          return TCL_ERROR;
      }
      needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
      if (Tk_Depth(tkwin) <= 1) {
          hateFlags = TK_CONFIG_COLOR_ONLY;
      } else {
          hateFlags = TK_CONFIG_MONO_ONLY;
      }
      /*
       * Pass one:  scan through all the option specs, replacing strings
       * with Tk_Uid structs (if this hasn't been done already) and
       * clearing the TK_CONFIG_OPTION_SPECIFIED flags.
       */
      for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
          if (!(specPtr->specFlags & INIT) && (specPtr->argvName != NULL)) {
              if (specPtr->dbName != NULL) {
                  specPtr->dbName = Tk_GetUid(specPtr->dbName);
              }
              if (specPtr->dbClass != NULL) {
                  specPtr->dbClass = Tk_GetUid(specPtr->dbClass);
              }
              if (specPtr->defValue != NULL) {
                  specPtr->defValue = Tk_GetUid(specPtr->defValue);
              }
          }
          specPtr->specFlags = (specPtr->specFlags & ~TK_CONFIG_OPTION_SPECIFIED)
                  | INIT;
      }
      /*
       * Pass two:  scan through all of the arguments, processing those
       * that match entries in the specs.
       */
      for ( ; argc > 0; argc -= 2, argv += 2) {
          char *arg;
          if (flags & TK_CONFIG_OBJS) {
              arg = Tcl_GetStringFromObj((Tcl_Obj *) *argv, NULL);
          } else {
              arg = *argv;
          }
          specPtr = FindConfigSpec(interp, specs, arg, needFlags, hateFlags);
          if (specPtr == NULL) {
              return TCL_ERROR;
          }
          /*
           * Process the entry.
           */
          if (argc < 2) {
              Tcl_AppendResult(interp, "value for \"", arg,
                      "\" missing", (char *) NULL);
              return TCL_ERROR;
          }
          if (flags & TK_CONFIG_OBJS) {
              arg = Tcl_GetString((Tcl_Obj *) argv[1]);
          } else {
              arg = argv[1];
          }
          if (DoConfig(interp, tkwin, specPtr, arg, 0, widgRec) != TCL_OK) {
              char msg[100];
              sprintf(msg, "\n    (processing \"%.40s\" option)",
                      specPtr->argvName);
              Tcl_AddErrorInfo(interp, msg);
              return TCL_ERROR;
          }
          specPtr->specFlags |= TK_CONFIG_OPTION_SPECIFIED;
      }
      /*
       * Pass three:  scan through all of the specs again;  if no
       * command-line argument matched a spec, then check for info
       * in the option database.  If there was nothing in the
       * database, then use the default.
       */
      if (!(flags & TK_CONFIG_ARGV_ONLY)) {
          for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
              if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED)
                      || (specPtr->argvName == NULL)
                      || (specPtr->type == TK_CONFIG_SYNONYM)) {
                  continue;
              }
              if (((specPtr->specFlags & needFlags) != needFlags)
                      || (specPtr->specFlags & hateFlags)) {
                  continue;
              }
              value = NULL;
              if (specPtr->dbName != NULL) {
                  value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass);
              }
              if (value != NULL) {
                  if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
                          TCL_OK) {
                      char msg[200];
                      sprintf(msg, "\n    (%s \"%.50s\" in widget \"%.50s\")",
                              "database entry for",
                              specPtr->dbName, Tk_PathName(tkwin));
                      Tcl_AddErrorInfo(interp, msg);
                      return TCL_ERROR;
                  }
              } else {
                  if (specPtr->defValue != NULL) {
                      value = Tk_GetUid(specPtr->defValue);
                  } else {
                      value = NULL;
                  }
                  if ((value != NULL) && !(specPtr->specFlags
                          & TK_CONFIG_DONT_SET_DEFAULT)) {
                      if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
                              TCL_OK) {
                          char msg[200];
                          sprintf(msg,
                                  "\n    (%s \"%.50s\" in widget \"%.50s\")",
                                  "default value for",
                                  specPtr->dbName, Tk_PathName(tkwin));
                          Tcl_AddErrorInfo(interp, msg);
                          return TCL_ERROR;
                      }
                  }
              }
          }
      }
      return TCL_OK;
  }
  /*
   *--------------------------------------------------------------
   *
   * FindConfigSpec --
   *
   *      Search through a table of configuration specs, looking for
   *      one that matches a given argvName.
   *
   * Results:
   *      The return value is a pointer to the matching entry, or NULL
   *      if nothing matched.  In that case an error message is left
   *      in the interp's result.
   *
   * Side effects:
   *      None.
   *
   *--------------------------------------------------------------
   */
  static Tk_ConfigSpec *
  FindConfigSpec(interp, specs, argvName, needFlags, hateFlags)
      Tcl_Interp *interp;         /* Used for reporting errors. */
      Tk_ConfigSpec *specs;       /* Pointer to table of configuration
                                   * specifications for a widget. */
      char *argvName;             /* Name (suitable for use in a "config"
                                   * command) identifying particular option. */
      int needFlags;              /* Flags that must be present in matching
                                   * entry. */
      int hateFlags;              /* Flags that must NOT be present in
                                   * matching entry. */
  {
      register Tk_ConfigSpec *specPtr;
      register char c;            /* First character of current argument. */
      Tk_ConfigSpec *matchPtr;    /* Matching spec, or NULL. */
      size_t length;
      c = argvName[1];
      length = strlen(argvName);
      matchPtr = NULL;
      for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
          if (specPtr->argvName == NULL) {
              continue;
          }
          if ((specPtr->argvName[1] != c)
                  || (strncmp(specPtr->argvName, argvName, length) != 0)) {
              continue;
          }
          if (((specPtr->specFlags & needFlags) != needFlags)
                  || (specPtr->specFlags & hateFlags)) {
              continue;
          }
          if (specPtr->argvName[length] == 0) {
              matchPtr = specPtr;
              goto gotMatch;
          }
          if (matchPtr != NULL) {
              Tcl_AppendResult(interp, "ambiguous option \"", argvName,
                      "\"", (char *) NULL);
              return (Tk_ConfigSpec *) NULL;
          }
          matchPtr = specPtr;
      }
      if (matchPtr == NULL) {
          Tcl_AppendResult(interp, "unknown option \"", argvName,
                  "\"", (char *) NULL);
          return (Tk_ConfigSpec *) NULL;
      }
      /*
       * Found a matching entry.  If it's a synonym, then find the
       * entry that it's a synonym for.
       */
      gotMatch:
      specPtr = matchPtr;
      if (specPtr->type == TK_CONFIG_SYNONYM) {
          for (specPtr = specs; ; specPtr++) {
              if (specPtr->type == TK_CONFIG_END) {
                  Tcl_AppendResult(interp,
                          "couldn't find synonym for option \"",
                          argvName, "\"", (char *) NULL);
                  return (Tk_ConfigSpec *) NULL;
              }
              if ((specPtr->dbName == matchPtr->dbName)
                      && (specPtr->type != TK_CONFIG_SYNONYM)
                      && ((specPtr->specFlags & needFlags) == needFlags)
                      && !(specPtr->specFlags & hateFlags)) {
                  break;
              }
          }
      }
      return specPtr;
  }
  /*
   *--------------------------------------------------------------
   *
   * DoConfig --
   *
   *      This procedure applies a single configuration option
   *      to a widget record.
   *
   * Results:
   *      A standard Tcl return value.
   *
   * Side effects:
   *      WidgRec is modified as indicated by specPtr and value.
   *      The old value is recycled, if that is appropriate for
   *      the value type.
   *
   *--------------------------------------------------------------
   */
  static int
  DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec)
      Tcl_Interp *interp;         /* Interpreter for error reporting. */
      Tk_Window tkwin;            /* Window containing widget (needed to
                                   * set up X resources). */
      Tk_ConfigSpec *specPtr;     /* Specifier to apply. */
      char *value;                /* Value to use to fill in widgRec. */
      int valueIsUid;             /* Non-zero means value is a Tk_Uid;
                                   * zero means it's an ordinary string. */
      char *widgRec;              /* Record whose fields are to be
                                   * modified.  Values must be properly
                                   * initialized. */
  {
      char *ptr;
      Tk_Uid uid;
      int nullValue;
      nullValue = 0;
      if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) {
          nullValue = 1;
      }
      do {
          ptr = widgRec + specPtr->offset;
          switch (specPtr->type) {
              case TK_CONFIG_BOOLEAN:
                  if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) {
                      return TCL_ERROR;
                  }
                  break;
              case TK_CONFIG_INT:
                  if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) {
                      return TCL_ERROR;
                  }
                  break;
              case TK_CONFIG_DOUBLE:
                  if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) {
                      return TCL_ERROR;
                  }
                  break;
              case TK_CONFIG_STRING: {
                  char *old, *new;
                  if (nullValue) {
                      new = NULL;
                  } else {
                      new = (char *) ckalloc((unsigned) (strlen(value) + 1));
                      strcpy(new, value);
                  }
                  old = *((char **) ptr);
                  if (old != NULL) {
                      ckfree(old);
                  }
                  *((char **) ptr) = new;
                  break;
              }
              case TK_CONFIG_UID:
                  if (nullValue) {
                      *((Tk_Uid *) ptr) = NULL;
                  } else {
                      uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                      *((Tk_Uid *) ptr) = uid;
                  }
                  break;
              case TK_CONFIG_COLOR: {
                  XColor *newPtr, *oldPtr;
                  if (nullValue) {
                      newPtr = NULL;
                  } else {
                      uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                      newPtr = Tk_GetColor(interp, tkwin, uid);
                      if (newPtr == NULL) {
                          return TCL_ERROR;
                      }
                  }
                  oldPtr = *((XColor **) ptr);
                  if (oldPtr != NULL) {
                      Tk_FreeColor(oldPtr);
                  }
                  *((XColor **) ptr) = newPtr;
                  break;
              }
              case TK_CONFIG_FONT: {
                  Tk_Font new;
                  if (nullValue) {
                      new = NULL;
                  } else {
                      new = Tk_GetFont(interp, tkwin, value);
                      if (new == NULL) {
                          return TCL_ERROR;
                      }
                  }
                  Tk_FreeFont(*((Tk_Font *) ptr));
                  *((Tk_Font *) ptr) = new;
                  break;
              }
              case TK_CONFIG_BITMAP: {
                  Pixmap new, old;
                  if (nullValue) {
                      new = None;
                  } else {
                      uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                      new = Tk_GetBitmap(interp, tkwin, uid);
                      if (new == None) {
                          return TCL_ERROR;
                      }
                  }
                  old = *((Pixmap *) ptr);
                  if (old != None) {
                      Tk_FreeBitmap(Tk_Display(tkwin), old);
                  }
                  *((Pixmap *) ptr) = new;
                  break;
              }
              case TK_CONFIG_BORDER: {
                  Tk_3DBorder new, old;
                  if (nullValue) {
                      new = NULL;
                  } else {
                      uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                      new = Tk_Get3DBorder(interp, tkwin, uid);
                      if (new == NULL) {
                          return TCL_ERROR;
                      }
                  }
                  old = *((Tk_3DBorder *) ptr);
                  if (old != NULL) {
                      Tk_Free3DBorder(old);
                  }
                  *((Tk_3DBorder *) ptr) = new;
                  break;
              }
              case TK_CONFIG_RELIEF:
                  uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                  if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) {
                      return TCL_ERROR;
                  }
                  break;
              case TK_CONFIG_CURSOR:
              case TK_CONFIG_ACTIVE_CURSOR: {
                  Tk_Cursor new, old;
                  if (nullValue) {
                      new = None;
                  } else {
                      uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                      new = Tk_GetCursor(interp, tkwin, uid);
                      if (new == None) {
                          return TCL_ERROR;
                      }
                  }
                  old = *((Tk_Cursor *) ptr);
                  if (old != None) {
                      Tk_FreeCursor(Tk_Display(tkwin), old);
                  }
                  *((Tk_Cursor *) ptr) = new;
                  if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) {
                      Tk_DefineCursor(tkwin, new);
                  }
                  break;
              }
              case TK_CONFIG_JUSTIFY:
                  uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                  if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) {
                      return TCL_ERROR;
                  }
                  break;
              case TK_CONFIG_ANCHOR:
                  uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                  if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) {
                      return TCL_ERROR;
                  }
                  break;
              case TK_CONFIG_CAP_STYLE:
                  uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                  if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) {
                      return TCL_ERROR;
                  }
                  break;
              case TK_CONFIG_JOIN_STYLE:
                  uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                  if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) {
                      return TCL_ERROR;
                  }
                  break;
              case TK_CONFIG_PIXELS:
                  if (Tk_GetPixels(interp, tkwin, value, (int *) ptr)
                          != TCL_OK) {
                      return TCL_ERROR;
                  }
                  break;
              case TK_CONFIG_MM:
                  if (Tk_GetScreenMM(interp, tkwin, value, (double *) ptr)
                          != TCL_OK) {
                      return TCL_ERROR;
                  }
                  break;
              case TK_CONFIG_WINDOW: {
                  Tk_Window tkwin2;
                  if (nullValue) {
                      tkwin2 = NULL;
                  } else {
                      tkwin2 = Tk_NameToWindow(interp, value, tkwin);
                      if (tkwin2 == NULL) {
                          return TCL_ERROR;
                      }
                  }
                  *((Tk_Window *) ptr) = tkwin2;
                  break;
              }
              case TK_CONFIG_CUSTOM:
                  if ((*specPtr->customPtr->parseProc)(
                          specPtr->customPtr->clientData, interp, tkwin,
                          value, widgRec, specPtr->offset) != TCL_OK) {
                      return TCL_ERROR;
                  }
                  break;
              default: {
                  char buf[64 + TCL_INTEGER_SPACE];
                  sprintf(buf, "bad config table: unknown type %d",
                          specPtr->type);
                  Tcl_SetResult(interp, buf, TCL_VOLATILE);
                  return TCL_ERROR;
              }
          }
          specPtr++;
      } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END));
      return TCL_OK;
  }
  /*
   *--------------------------------------------------------------
   *
   * Tk_ConfigureInfo --
   *
   *      Return information about the configuration options
   *      for a window, and their current values.
   *
   * Results:
   *      Always returns TCL_OK.  The interp's result will be modified
   *      hold a description of either a single configuration option
   *      available for "widgRec" via "specs", or all the configuration
   *      options available.  In the "all" case, the result will
   *      available for "widgRec" via "specs".  The result will
   *      be a list, each of whose entries describes one option.
   *      Each entry will itself be a list containing the option's
   *      name for use on command lines, database name, database
   *      class, default value, and current value (empty string
   *      if none).  For options that are synonyms, the list will
   *      contain only two values:  name and synonym name.  If the
   *      "name" argument is non-NULL, then the only information
   *      returned is that for the named argument (i.e. the corresponding
   *      entry in the overall list is returned).
   *
   * Side effects:
   *      None.
   *
   *--------------------------------------------------------------
   */
  int
  Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags)
      Tcl_Interp *interp;         /* Interpreter for error reporting. */
      Tk_Window tkwin;            /* Window corresponding to widgRec. */
      Tk_ConfigSpec *specs;       /* Describes legal options. */
      char *widgRec;              /* Record whose fields contain current
                                   * values for options. */
      char *argvName;             /* If non-NULL, indicates a single option
                                   * whose info is to be returned.  Otherwise
                                   * info is returned for all options. */
      int flags;                  /* Used to specify additional flags
                                   * that must be present in config specs
                                   * for them to be considered. */
  {
      register Tk_ConfigSpec *specPtr;
      int needFlags, hateFlags;
      char *list;
      char *leader = "{";
      needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
      if (Tk_Depth(tkwin) <= 1) {
          hateFlags = TK_CONFIG_COLOR_ONLY;
      } else {
          hateFlags = TK_CONFIG_MONO_ONLY;
      }
      /*
       * If information is only wanted for a single configuration
       * spec, then handle that one spec specially.
       */
      Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
      if (argvName != NULL) {
          specPtr = FindConfigSpec(interp, specs, argvName, needFlags,
                  hateFlags);
          if (specPtr == NULL) {
              return TCL_ERROR;
          }
          Tcl_SetResult(interp,
                  FormatConfigInfo(interp, tkwin, specPtr, widgRec),
                  TCL_DYNAMIC);
          return TCL_OK;
      }
      /*
       * Loop through all the specs, creating a big list with all
       * their information.
       */
      for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
          if ((argvName != NULL) && (specPtr->argvName != argvName)) {
              continue;
          }
          if (((specPtr->specFlags & needFlags) != needFlags)
                  || (specPtr->specFlags & hateFlags)) {
              continue;
          }
          if (specPtr->argvName == NULL) {
              continue;
          }
          list = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
          Tcl_AppendResult(interp, leader, list, "}", (char *) NULL);
          ckfree(list);
          leader = " {";
      }
      return TCL_OK;
  }
  /*
   *--------------------------------------------------------------
   *
   * FormatConfigInfo --
   *
   *      Create a valid Tcl list holding the configuration information
   *      for a single configuration option.
   *
   * Results:
   *      A Tcl list, dynamically allocated.  The caller is expected to
   *      arrange for this list to be freed eventually.
   *
   * Side effects:
   *      Memory is allocated.
   *
   *--------------------------------------------------------------
   */
  static char *
  FormatConfigInfo(interp, tkwin, specPtr, widgRec)
      Tcl_Interp *interp;                 /* Interpreter to use for things
                                           * like floating-point precision. */
      Tk_Window tkwin;                    /* Window corresponding to widget. */
      register Tk_ConfigSpec *specPtr;    /* Pointer to information describing
                                           * option. */
      char *widgRec;                      /* Pointer to record holding current
                                           * values of info for widget. */
  {
      char *argv[6], *result;
      char buffer[200];
      Tcl_FreeProc *freeProc = (Tcl_FreeProc *) NULL;
      argv[0] = specPtr->argvName;
      argv[1] = specPtr->dbName;
      argv[2] = specPtr->dbClass;
      argv[3] = specPtr->defValue;
      if (specPtr->type == TK_CONFIG_SYNONYM) {
          return Tcl_Merge(2, argv);
      }
      argv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer,
              &freeProc);
      if (argv[1] == NULL) {
          argv[1] = "";
      }
      if (argv[2] == NULL) {
          argv[2] = "";
      }
      if (argv[3] == NULL) {
          argv[3] = "";
      }
      if (argv[4] == NULL) {
          argv[4] = "";
      }
      result = Tcl_Merge(5, argv);
      if (freeProc != NULL) {
          if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {
              ckfree(argv[4]);
          } else {
              (*freeProc)(argv[4]);
          }
      }
      return result;
  }
  /*
   *----------------------------------------------------------------------
   *
   * FormatConfigValue --
   *
   *      This procedure formats the current value of a configuration
   *      option.
   *
   * Results:
   *      The return value is the formatted value of the option given
   *      by specPtr and widgRec.  If the value is static, so that it
   *      need not be freed, *freeProcPtr will be set to NULL;  otherwise
   *      *freeProcPtr will be set to the address of a procedure to
   *      free the result, and the caller must invoke this procedure
   *      when it is finished with the result.
   *
   * Side effects:
   *      None.
   *
   *----------------------------------------------------------------------
   */
  static char *
  FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, freeProcPtr)
      Tcl_Interp *interp;         /* Interpreter for use in real conversions. */
      Tk_Window tkwin;            /* Window corresponding to widget. */
      Tk_ConfigSpec *specPtr;     /* Pointer to information describing option.
                                   * Must not point to a synonym option. */
      char *widgRec;              /* Pointer to record holding current
                                   * values of info for widget. */
      char *buffer;               /* Static buffer to use for small values.
                                   * Must have at least 200 bytes of storage. */
      Tcl_FreeProc **freeProcPtr; /* Pointer to word to fill in with address
                                   * of procedure to free the result, or NULL
                                   * if result is static. */
  {
      char *ptr, *result;
      *freeProcPtr = NULL;
      ptr = widgRec + specPtr->offset;
      result = "";
      switch (specPtr->type) {
          case TK_CONFIG_BOOLEAN:
              if (*((int *) ptr) == 0) {
                  result = "0";
              } else {
                  result = "1";
              }
              break;
          case TK_CONFIG_INT:
              sprintf(buffer, "%d", *((int *) ptr));
              result = buffer;
              break;
          case TK_CONFIG_DOUBLE:
              Tcl_PrintDouble(interp, *((double *) ptr), buffer);
              result = buffer;
              break;
          case TK_CONFIG_STRING:
              result = (*(char **) ptr);
              if (result == NULL) {
                  result = "";
              }
              break;
          case TK_CONFIG_UID: {
              Tk_Uid uid = *((Tk_Uid *) ptr);
              if (uid != NULL) {
                  result = uid;
              }
              break;
          }
          case TK_CONFIG_COLOR: {
              XColor *colorPtr = *((XColor **) ptr);
              if (colorPtr != NULL) {
                  result = Tk_NameOfColor(colorPtr);
              }
              break;
          }
          case TK_CONFIG_FONT: {
              Tk_Font tkfont = *((Tk_Font *) ptr);
              if (tkfont != NULL) {
                  result = Tk_NameOfFont(tkfont);
              }
              break;
          }
          case TK_CONFIG_BITMAP: {
              Pixmap pixmap = *((Pixmap *) ptr);
              if (pixmap != None) {
                  result = Tk_NameOfBitmap(Tk_Display(tkwin), pixmap);
              }
              break;
          }
          case TK_CONFIG_BORDER: {
              Tk_3DBorder border = *((Tk_3DBorder *) ptr);
              if (border != NULL) {
                  result = Tk_NameOf3DBorder(border);
              }
              break;
          }
          case TK_CONFIG_RELIEF:
              result = Tk_NameOfRelief(*((int *) ptr));
              break;
          case TK_CONFIG_CURSOR:
          case TK_CONFIG_ACTIVE_CURSOR: {
              Tk_Cursor cursor = *((Tk_Cursor *) ptr);
              if (cursor != None) {
                  result = Tk_NameOfCursor(Tk_Display(tkwin), cursor);
              }
              break;
          }
          case TK_CONFIG_JUSTIFY:
              result = Tk_NameOfJustify(*((Tk_Justify *) ptr));
              break;
          case TK_CONFIG_ANCHOR:
              result = Tk_NameOfAnchor(*((Tk_Anchor *) ptr));
              break;
          case TK_CONFIG_CAP_STYLE:
              result = Tk_NameOfCapStyle(*((int *) ptr));
              break;
          case TK_CONFIG_JOIN_STYLE:
              result = Tk_NameOfJoinStyle(*((int *) ptr));
              break;
          case TK_CONFIG_PIXELS:
              sprintf(buffer, "%d", *((int *) ptr));
              result = buffer;
              break;
          case TK_CONFIG_MM:
              Tcl_PrintDouble(interp, *((double *) ptr), buffer);
              result = buffer;
              break;
          case TK_CONFIG_WINDOW: {
              Tk_Window tkwin;
              tkwin = *((Tk_Window *) ptr);
              if (tkwin != NULL) {
                  result = Tk_PathName(tkwin);
              }
              break;
          }
          case TK_CONFIG_CUSTOM:
              result = (*specPtr->customPtr->printProc)(
                      specPtr->customPtr->clientData, tkwin, widgRec,
                      specPtr->offset, freeProcPtr);
              break;
          default:
              result = "?? unknown type ??";
      }
      return result;
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tk_ConfigureValue --
   *
   *      This procedure returns the current value of a configuration
   *      option for a widget.
   *
   * Results:
   *      The return value is a standard Tcl completion code (TCL_OK or
   *      TCL_ERROR).  The interp's result will be set to hold either the value
   *      of the option given by argvName (if TCL_OK is returned) or
   *      an error message (if TCL_ERROR is returned).
   *
   * Side effects:
   *      None.
   *
   *----------------------------------------------------------------------
   */
  int
  Tk_ConfigureValue(interp, tkwin, specs, widgRec, argvName, flags)
      Tcl_Interp *interp;         /* Interpreter for error reporting. */
      Tk_Window tkwin;            /* Window corresponding to widgRec. */
      Tk_ConfigSpec *specs;       /* Describes legal options. */
      char *widgRec;              /* Record whose fields contain current
                                   * values for options. */
      char *argvName;             /* Gives the command-line name for the
                                   * option whose value is to be returned. */
      int flags;                  /* Used to specify additional flags
                                   * that must be present in config specs
                                   * for them to be considered. */
  {
      Tk_ConfigSpec *specPtr;
      int needFlags, hateFlags;
      needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
      if (Tk_Depth(tkwin) <= 1) {
          hateFlags = TK_CONFIG_COLOR_ONLY;
      } else {
          hateFlags = TK_CONFIG_MONO_ONLY;
      }
      specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags);
      if (specPtr == NULL) {
          return TCL_ERROR;
      }
      interp->result = FormatConfigValue(interp, tkwin, specPtr, widgRec,
              interp->result, &interp->freeProc);
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tk_FreeOptions --
   *
   *      Free up all resources associated with configuration options.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      Any resource in widgRec that is controlled by a configuration
   *      option (e.g. a Tk_3DBorder or XColor) is freed in the appropriate
   *      fashion.
   *
   *----------------------------------------------------------------------
   */
          /* ARGSUSED */
  void
  Tk_FreeOptions(specs, widgRec, display, needFlags)
      Tk_ConfigSpec *specs;       /* Describes legal options. */
      char *widgRec;              /* Record whose fields contain current
                                   * values for options. */
      Display *display;           /* X display; needed for freeing some
                                   * resources. */
      int needFlags;              /* Used to specify additional flags
                                   * that must be present in config specs
                                   * for them to be considered. */
  {
      register Tk_ConfigSpec *specPtr;
      char *ptr;
      for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
          if ((specPtr->specFlags & needFlags) != needFlags) {
              continue;
          }
          ptr = widgRec + specPtr->offset;
          switch (specPtr->type) {
              case TK_CONFIG_STRING:
                  if (*((char **) ptr) != NULL) {
                      ckfree(*((char **) ptr));
                      *((char **) ptr) = NULL;
                  }
                  break;
              case TK_CONFIG_COLOR:
                  if (*((XColor **) ptr) != NULL) {
                      Tk_FreeColor(*((XColor **) ptr));
                      *((XColor **) ptr) = NULL;
                  }
                  break;
              case TK_CONFIG_FONT:
                  Tk_FreeFont(*((Tk_Font *) ptr));
                  *((Tk_Font *) ptr) = NULL;
                  break;
              case TK_CONFIG_BITMAP:
                  if (*((Pixmap *) ptr) != None) {
                      Tk_FreeBitmap(display, *((Pixmap *) ptr));
                      *((Pixmap *) ptr) = None;
                  }
                  break;
              case TK_CONFIG_BORDER:
                  if (*((Tk_3DBorder *) ptr) != NULL) {
                      Tk_Free3DBorder(*((Tk_3DBorder *) ptr));
                      *((Tk_3DBorder *) ptr) = NULL;
                  }
                  break;
              case TK_CONFIG_CURSOR:
              case TK_CONFIG_ACTIVE_CURSOR:
                  if (*((Tk_Cursor *) ptr) != None) {
                      Tk_FreeCursor(display, *((Tk_Cursor *) ptr));
                      *((Tk_Cursor *) ptr) = None;
                  }
          }
      }
  }
  /* End of tkoldconfig.c */

 Legend:



Removed from v.69
 


changed lines


 
Added in v.71
 Legend:



Removed from v.69
 


changed lines


 
Added in v.71
-Removed from v.69
+Added in v.71

dashley@gmail.com	ViewVC Help
Powered by ViewVC 1.1.25