开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
tkOldConfig.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：33k
源码类别：

通讯编程

开发平台：

Visual C++

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