home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / generic / tkScale.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  34.7 KB  |  1,144 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tkScale.c --
  3.  *
  4.  *    This module implements a scale widgets for the Tk toolkit.
  5.  *    A scale displays a slider that can be adjusted to change a
  6.  *    value;  it also displays numeric labels and a textual label,
  7.  *    if desired.
  8.  *    
  9.  *    The modifications to use floating-point values are based on
  10.  *    an implementation by Paul Mackerras.  The -variable option
  11.  *    is due to Henning Schulzrinne.  All of these are used with
  12.  *    permission.
  13.  *
  14.  * Copyright (c) 1990-1994 The Regents of the University of California.
  15.  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  16.  *
  17.  * See the file "license.terms" for information on usage and redistribution
  18.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  19.  *
  20.  * SCCS: @(#) tkScale.c 1.88 97/07/31 09:11:57
  21.  */
  22.  
  23. #include "tkPort.h"
  24. #include "default.h"
  25. #include "tkInt.h"
  26. #include "tclMath.h"
  27. #include "tkScale.h"
  28.  
  29. static Tk_ConfigSpec configSpecs[] = {
  30.     {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
  31.     DEF_SCALE_ACTIVE_BG_COLOR, Tk_Offset(TkScale, activeBorder),
  32.     TK_CONFIG_COLOR_ONLY},
  33.     {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
  34.     DEF_SCALE_ACTIVE_BG_MONO, Tk_Offset(TkScale, activeBorder),
  35.     TK_CONFIG_MONO_ONLY},
  36.     {TK_CONFIG_BORDER, "-background", "background", "Background",
  37.     DEF_SCALE_BG_COLOR, Tk_Offset(TkScale, bgBorder),
  38.     TK_CONFIG_COLOR_ONLY},
  39.     {TK_CONFIG_BORDER, "-background", "background", "Background",
  40.     DEF_SCALE_BG_MONO, Tk_Offset(TkScale, bgBorder),
  41.     TK_CONFIG_MONO_ONLY},
  42.     {TK_CONFIG_DOUBLE, "-bigincrement", "bigIncrement", "BigIncrement",
  43.     DEF_SCALE_BIG_INCREMENT, Tk_Offset(TkScale, bigIncrement), 0},
  44.     {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
  45.     (char *) NULL, 0, 0},
  46.     {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
  47.     (char *) NULL, 0, 0},
  48.     {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
  49.     DEF_SCALE_BORDER_WIDTH, Tk_Offset(TkScale, borderWidth), 0},
  50.     {TK_CONFIG_STRING, "-command", "command", "Command",
  51.     DEF_SCALE_COMMAND, Tk_Offset(TkScale, command), TK_CONFIG_NULL_OK},
  52.     {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
  53.     DEF_SCALE_CURSOR, Tk_Offset(TkScale, cursor), TK_CONFIG_NULL_OK},
  54.     {TK_CONFIG_INT, "-digits", "digits", "Digits",
  55.     DEF_SCALE_DIGITS, Tk_Offset(TkScale, digits), 0},
  56.     {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
  57.     (char *) NULL, 0, 0},
  58.     {TK_CONFIG_FONT, "-font", "font", "Font",
  59.     DEF_SCALE_FONT, Tk_Offset(TkScale, tkfont),
  60.     0},
  61.     {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
  62.     DEF_SCALE_FG_COLOR, Tk_Offset(TkScale, textColorPtr),
  63.     TK_CONFIG_COLOR_ONLY},
  64.     {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
  65.     DEF_SCALE_FG_MONO, Tk_Offset(TkScale, textColorPtr),
  66.     TK_CONFIG_MONO_ONLY},
  67.     {TK_CONFIG_DOUBLE, "-from", "from", "From",
  68.     DEF_SCALE_FROM, Tk_Offset(TkScale, fromValue), 0},
  69.     {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
  70.     "HighlightBackground", DEF_SCALE_HIGHLIGHT_BG,
  71.     Tk_Offset(TkScale, highlightBgColorPtr), 0},
  72.     {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
  73.     DEF_SCALE_HIGHLIGHT, Tk_Offset(TkScale, highlightColorPtr), 0},
  74.     {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
  75.     "HighlightThickness",
  76.     DEF_SCALE_HIGHLIGHT_WIDTH, Tk_Offset(TkScale, highlightWidth), 0},
  77.     {TK_CONFIG_STRING, "-label", "label", "Label",
  78.     DEF_SCALE_LABEL, Tk_Offset(TkScale, label), TK_CONFIG_NULL_OK},
  79.     {TK_CONFIG_PIXELS, "-length", "length", "Length",
  80.     DEF_SCALE_LENGTH, Tk_Offset(TkScale, length), 0},
  81.     {TK_CONFIG_UID, "-orient", "orient", "Orient",
  82.     DEF_SCALE_ORIENT, Tk_Offset(TkScale, orientUid), 0},
  83.     {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
  84.     DEF_SCALE_RELIEF, Tk_Offset(TkScale, relief), 0},
  85.     {TK_CONFIG_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
  86.     DEF_SCALE_REPEAT_DELAY, Tk_Offset(TkScale, repeatDelay), 0},
  87.     {TK_CONFIG_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
  88.     DEF_SCALE_REPEAT_INTERVAL, Tk_Offset(TkScale, repeatInterval), 0},
  89.     {TK_CONFIG_DOUBLE, "-resolution", "resolution", "Resolution",
  90.     DEF_SCALE_RESOLUTION, Tk_Offset(TkScale, resolution), 0},
  91.     {TK_CONFIG_BOOLEAN, "-showvalue", "showValue", "ShowValue",
  92.     DEF_SCALE_SHOW_VALUE, Tk_Offset(TkScale, showValue), 0},
  93.     {TK_CONFIG_PIXELS, "-sliderlength", "sliderLength", "SliderLength",
  94.     DEF_SCALE_SLIDER_LENGTH, Tk_Offset(TkScale, sliderLength), 0},
  95.     {TK_CONFIG_RELIEF, "-sliderrelief", "sliderRelief", "SliderRelief",
  96.     DEF_SCALE_SLIDER_RELIEF, Tk_Offset(TkScale, sliderRelief),
  97.     TK_CONFIG_DONT_SET_DEFAULT},
  98.     {TK_CONFIG_UID, "-state", "state", "State",
  99.     DEF_SCALE_STATE, Tk_Offset(TkScale, state), 0},
  100.     {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
  101.     DEF_SCALE_TAKE_FOCUS, Tk_Offset(TkScale, takeFocus),
  102.     TK_CONFIG_NULL_OK},
  103.     {TK_CONFIG_DOUBLE, "-tickinterval", "tickInterval", "TickInterval",
  104.     DEF_SCALE_TICK_INTERVAL, Tk_Offset(TkScale, tickInterval), 0},
  105.     {TK_CONFIG_DOUBLE, "-to", "to", "To",
  106.     DEF_SCALE_TO, Tk_Offset(TkScale, toValue), 0},
  107.     {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
  108.     DEF_SCALE_TROUGH_COLOR, Tk_Offset(TkScale, troughColorPtr),
  109.     TK_CONFIG_COLOR_ONLY},
  110.     {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
  111.     DEF_SCALE_TROUGH_MONO, Tk_Offset(TkScale, troughColorPtr),
  112.     TK_CONFIG_MONO_ONLY},
  113.     {TK_CONFIG_STRING, "-variable", "variable", "Variable",
  114.     DEF_SCALE_VARIABLE, Tk_Offset(TkScale, varName), TK_CONFIG_NULL_OK},
  115.     {TK_CONFIG_PIXELS, "-width", "width", "Width",
  116.     DEF_SCALE_WIDTH, Tk_Offset(TkScale, width), 0},
  117.     {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
  118.     (char *) NULL, 0, 0}
  119. };
  120.  
  121. /*
  122.  * Forward declarations for procedures defined later in this file:
  123.  */
  124.  
  125. static void        ComputeFormat _ANSI_ARGS_((TkScale *scalePtr));
  126. static void        ComputeScaleGeometry _ANSI_ARGS_((TkScale *scalePtr));
  127. static int        ConfigureScale _ANSI_ARGS_((Tcl_Interp *interp,
  128.                 TkScale *scalePtr, int argc, char **argv,
  129.                 int flags));
  130. static void        DestroyScale _ANSI_ARGS_((char *memPtr));
  131. static void        ScaleCmdDeletedProc _ANSI_ARGS_((
  132.                 ClientData clientData));
  133. static void        ScaleEventProc _ANSI_ARGS_((ClientData clientData,
  134.                 XEvent *eventPtr));
  135. static char *        ScaleVarProc _ANSI_ARGS_((ClientData clientData,
  136.                 Tcl_Interp *interp, char *name1, char *name2,
  137.                 int flags));
  138. static int        ScaleWidgetCmd _ANSI_ARGS_((ClientData clientData,
  139.                 Tcl_Interp *interp, int argc, char **argv));
  140. static void        ScaleWorldChanged _ANSI_ARGS_((
  141.                 ClientData instanceData));
  142.  
  143. /*
  144.  * The structure below defines scale class behavior by means of procedures
  145.  * that can be invoked from generic window code.
  146.  */
  147.  
  148. static TkClassProcs scaleClass = {
  149.     NULL,            /* createProc. */
  150.     ScaleWorldChanged,        /* geometryProc. */
  151.     NULL            /* modalProc. */
  152. };
  153.  
  154.  
  155. /*
  156.  *--------------------------------------------------------------
  157.  *
  158.  * Tk_ScaleCmd --
  159.  *
  160.  *    This procedure is invoked to process the "scale" Tcl
  161.  *    command.  See the user documentation for details on what
  162.  *    it does.
  163.  *
  164.  * Results:
  165.  *    A standard Tcl result.
  166.  *
  167.  * Side effects:
  168.  *    See the user documentation.
  169.  *
  170.  *--------------------------------------------------------------
  171.  */
  172.  
  173. int
  174. Tk_ScaleCmd(clientData, interp, argc, argv)
  175.     ClientData clientData;        /* Main window associated with
  176.                  * interpreter. */
  177.     Tcl_Interp *interp;        /* Current interpreter. */
  178.     int argc;            /* Number of arguments. */
  179.     char **argv;        /* Argument strings. */
  180. {
  181.     Tk_Window tkwin = (Tk_Window) clientData;
  182.     register TkScale *scalePtr;
  183.     Tk_Window new;
  184.  
  185.     if (argc < 2) {
  186.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  187.         argv[0], " pathName ?options?\"", (char *) NULL);
  188.     return TCL_ERROR;
  189.     }
  190.  
  191.     new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
  192.     if (new == NULL) {
  193.     return TCL_ERROR;
  194.     }
  195.     scalePtr = TkpCreateScale(new);
  196.  
  197.     /*
  198.      * Initialize fields that won't be initialized by ConfigureScale,
  199.      * or which ConfigureScale expects to have reasonable values
  200.      * (e.g. resource pointers).
  201.      */
  202.  
  203.     scalePtr->tkwin = new;
  204.     scalePtr->display = Tk_Display(new);
  205.     scalePtr->interp = interp;
  206.     scalePtr->widgetCmd = Tcl_CreateCommand(interp,
  207.         Tk_PathName(scalePtr->tkwin), ScaleWidgetCmd,
  208.         (ClientData) scalePtr, ScaleCmdDeletedProc);
  209.     scalePtr->orientUid = NULL;
  210.     scalePtr->vertical = 0;
  211.     scalePtr->width = 0;
  212.     scalePtr->length = 0;
  213.     scalePtr->value = 0;
  214.     scalePtr->varName = NULL;
  215.     scalePtr->fromValue = 0;
  216.     scalePtr->toValue = 0;
  217.     scalePtr->tickInterval = 0;
  218.     scalePtr->resolution = 1;
  219.     scalePtr->bigIncrement = 0.0;
  220.     scalePtr->command = NULL;
  221.     scalePtr->repeatDelay = 0;
  222.     scalePtr->repeatInterval = 0;
  223.     scalePtr->label = NULL;
  224.     scalePtr->labelLength = 0;
  225.     scalePtr->state = tkNormalUid;
  226.     scalePtr->borderWidth = 0;
  227.     scalePtr->bgBorder = NULL;
  228.     scalePtr->activeBorder = NULL;
  229.     scalePtr->sliderRelief = TK_RELIEF_RAISED;
  230.     scalePtr->troughColorPtr = NULL;
  231.     scalePtr->troughGC = None;
  232.     scalePtr->copyGC = None;
  233.     scalePtr->tkfont = NULL;
  234.     scalePtr->textColorPtr = NULL;
  235.     scalePtr->textGC = None;
  236.     scalePtr->relief = TK_RELIEF_FLAT;
  237.     scalePtr->highlightWidth = 0;
  238.     scalePtr->highlightBgColorPtr = NULL;
  239.     scalePtr->highlightColorPtr = NULL;
  240.     scalePtr->inset = 0;
  241.     scalePtr->sliderLength = 0;
  242.     scalePtr->showValue = 0;
  243.     scalePtr->horizLabelY = 0;
  244.     scalePtr->horizValueY = 0;
  245.     scalePtr->horizTroughY = 0;
  246.     scalePtr->horizTickY = 0;
  247.     scalePtr->vertTickRightX = 0;
  248.     scalePtr->vertValueRightX = 0;
  249.     scalePtr->vertTroughX = 0;
  250.     scalePtr->vertLabelX = 0;
  251.     scalePtr->cursor = None;
  252.     scalePtr->takeFocus = NULL;
  253.     scalePtr->flags = NEVER_SET;
  254.  
  255.     Tk_SetClass(scalePtr->tkwin, "Scale");
  256.     TkSetClassProcs(scalePtr->tkwin, &scaleClass, (ClientData) scalePtr);
  257.     Tk_CreateEventHandler(scalePtr->tkwin,
  258.         ExposureMask|StructureNotifyMask|FocusChangeMask,
  259.         ScaleEventProc, (ClientData) scalePtr);
  260.     if (ConfigureScale(interp, scalePtr, argc-2, argv+2, 0) != TCL_OK) {
  261.     goto error;
  262.     }
  263.  
  264.     interp->result = Tk_PathName(scalePtr->tkwin);
  265.     return TCL_OK;
  266.  
  267.     error:
  268.     Tk_DestroyWindow(scalePtr->tkwin);
  269.     return TCL_ERROR;
  270. }
  271.  
  272. /*
  273.  *--------------------------------------------------------------
  274.  *
  275.  * ScaleWidgetCmd --
  276.  *
  277.  *    This procedure is invoked to process the Tcl command
  278.  *    that corresponds to a widget managed by this module.
  279.  *    See the user documentation for details on what it does.
  280.  *
  281.  * Results:
  282.  *    A standard Tcl result.
  283.  *
  284.  * Side effects:
  285.  *    See the user documentation.
  286.  *
  287.  *--------------------------------------------------------------
  288.  */
  289.  
  290. static int
  291. ScaleWidgetCmd(clientData, interp, argc, argv)
  292.     ClientData clientData;        /* Information about scale
  293.                      * widget. */
  294.     Tcl_Interp *interp;            /* Current interpreter. */
  295.     int argc;                /* Number of arguments. */
  296.     char **argv;            /* Argument strings. */
  297. {
  298.     register TkScale *scalePtr = (TkScale *) clientData;
  299.     int result = TCL_OK;
  300.     size_t length;
  301.     int c;
  302.  
  303.     if (argc < 2) {
  304.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  305.         argv[0], " option ?arg arg ...?\"", (char *) NULL);
  306.     return TCL_ERROR;
  307.     }
  308.     Tcl_Preserve((ClientData) scalePtr);
  309.     c = argv[1][0];
  310.     length = strlen(argv[1]);
  311.     if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
  312.         && (length >= 2)) {
  313.     if (argc != 3) {
  314.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  315.             argv[0], " cget option\"",
  316.             (char *) NULL);
  317.         goto error;
  318.     }
  319.     result = Tk_ConfigureValue(interp, scalePtr->tkwin, configSpecs,
  320.         (char *) scalePtr, argv[2], 0);
  321.     } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
  322.         && (length >= 3)) {
  323.     if (argc == 2) {
  324.         result = Tk_ConfigureInfo(interp, scalePtr->tkwin, configSpecs,
  325.             (char *) scalePtr, (char *) NULL, 0);
  326.     } else if (argc == 3) {
  327.         result = Tk_ConfigureInfo(interp, scalePtr->tkwin, configSpecs,
  328.             (char *) scalePtr, argv[2], 0);
  329.     } else {
  330.         result = ConfigureScale(interp, scalePtr, argc-2, argv+2,
  331.             TK_CONFIG_ARGV_ONLY);
  332.     }
  333.     } else if ((c == 'c') && (strncmp(argv[1], "coords", length) == 0)
  334.         && (length >= 3)) {
  335.     int x, y ;
  336.     double value;
  337.  
  338.     if ((argc != 2) && (argc != 3)) {
  339.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  340.             argv[0], " coords ?value?\"", (char *) NULL);
  341.         goto error;
  342.     }
  343.     if (argc == 3) {
  344.         if (Tcl_GetDouble(interp, argv[2], &value) != TCL_OK) {
  345.         goto error;
  346.         }
  347.     } else {
  348.         value = scalePtr->value;
  349.     }
  350.     if (scalePtr->vertical) {
  351.         x = scalePtr->vertTroughX + scalePtr->width/2
  352.             + scalePtr->borderWidth;
  353.         y = TkpValueToPixel(scalePtr, value);
  354.     } else {
  355.         x = TkpValueToPixel(scalePtr, value);
  356.         y = scalePtr->horizTroughY + scalePtr->width/2
  357.             + scalePtr->borderWidth;
  358.     }
  359.     sprintf(interp->result, "%d %d", x, y);
  360.     } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
  361.     double value;
  362.     int x, y;
  363.  
  364.     if ((argc != 2) && (argc != 4)) {
  365.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  366.             argv[0], " get ?x y?\"", (char *) NULL);
  367.         goto error;
  368.     }
  369.     if (argc == 2) {
  370.         value = scalePtr->value;
  371.     } else {
  372.         if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
  373.             || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
  374.         goto error;
  375.         }
  376.         value = TkpPixelToValue(scalePtr, x, y);
  377.     }
  378.     sprintf(interp->result, scalePtr->format, value);
  379.     } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) {
  380.     int x, y, thing;
  381.  
  382.     if (argc != 4) {
  383.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  384.             argv[0], " identify x y\"", (char *) NULL);
  385.         goto error;
  386.     }
  387.     if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
  388.         || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
  389.         goto error;
  390.     }
  391.     thing = TkpScaleElement(scalePtr, x,y);
  392.     switch (thing) {
  393.         case TROUGH1:    interp->result = "trough1";    break;
  394.         case SLIDER:    interp->result = "slider";    break;
  395.         case TROUGH2:    interp->result = "trough2";    break;
  396.     }
  397.     } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) {
  398.     double value;
  399.  
  400.     if (argc != 3) {
  401.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  402.             argv[0], " set value\"", (char *) NULL);
  403.         goto error;
  404.     }
  405.     if (Tcl_GetDouble(interp, argv[2], &value) != TCL_OK) {
  406.         goto error;
  407.     }
  408.     if (scalePtr->state != tkDisabledUid) {
  409.         TkpSetScaleValue(scalePtr, value, 1, 1);
  410.     }
  411.     } else {
  412.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  413.         "\": must be cget, configure, coords, get, identify, or set",
  414.         (char *) NULL);
  415.     goto error;
  416.     }
  417.     Tcl_Release((ClientData) scalePtr);
  418.     return result;
  419.  
  420.     error:
  421.     Tcl_Release((ClientData) scalePtr);
  422.     return TCL_ERROR;
  423. }
  424.  
  425. /*
  426.  *----------------------------------------------------------------------
  427.  *
  428.  * DestroyScale --
  429.  *
  430.  *    This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
  431.  *    to clean up the internal structure of a button at a safe time
  432.  *    (when no-one is using it anymore).
  433.  *
  434.  * Results:
  435.  *    None.
  436.  *
  437.  * Side effects:
  438.  *    Everything associated with the scale is freed up.
  439.  *
  440.  *----------------------------------------------------------------------
  441.  */
  442.  
  443. static void
  444. DestroyScale(memPtr)
  445.     char *memPtr;    /* Info about scale widget. */
  446. {
  447.     register TkScale *scalePtr = (TkScale *) memPtr;
  448.  
  449.     /*
  450.      * Free up all the stuff that requires special handling, then
  451.      * let Tk_FreeOptions handle all the standard option-related
  452.      * stuff.
  453.      */
  454.  
  455.     if (scalePtr->varName != NULL) {
  456.     Tcl_UntraceVar(scalePtr->interp, scalePtr->varName,
  457.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  458.         ScaleVarProc, (ClientData) scalePtr);
  459.     }
  460.     if (scalePtr->troughGC != None) {
  461.     Tk_FreeGC(scalePtr->display, scalePtr->troughGC);
  462.     }
  463.     if (scalePtr->copyGC != None) {
  464.     Tk_FreeGC(scalePtr->display, scalePtr->copyGC);
  465.     }
  466.     if (scalePtr->textGC != None) {
  467.     Tk_FreeGC(scalePtr->display, scalePtr->textGC);
  468.     }
  469.     Tk_FreeOptions(configSpecs, (char *) scalePtr, scalePtr->display, 0);
  470.     TkpDestroyScale(scalePtr);
  471. }
  472.  
  473. /*
  474.  *----------------------------------------------------------------------
  475.  *
  476.  * ConfigureScale --
  477.  *
  478.  *    This procedure is called to process an argv/argc list, plus
  479.  *    the Tk option database, in order to configure (or
  480.  *    reconfigure) a scale widget.
  481.  *
  482.  * Results:
  483.  *    The return value is a standard Tcl result.  If TCL_ERROR is
  484.  *    returned, then interp->result contains an error message.
  485.  *
  486.  * Side effects:
  487.  *    Configuration information, such as colors, border width,
  488.  *    etc. get set for scalePtr;  old resources get freed,
  489.  *    if there were any.
  490.  *
  491.  *----------------------------------------------------------------------
  492.  */
  493.  
  494. static int
  495. ConfigureScale(interp, scalePtr, argc, argv, flags)
  496.     Tcl_Interp *interp;        /* Used for error reporting. */
  497.     register TkScale *scalePtr;    /* Information about widget;  may or may
  498.                  * not already have values for some fields. */
  499.     int argc;            /* Number of valid entries in argv. */
  500.     char **argv;        /* Arguments. */
  501.     int flags;            /* Flags to pass to Tk_ConfigureWidget. */
  502. {
  503.     size_t length;
  504.  
  505.     /*
  506.      * Eliminate any existing trace on a variable monitored by the scale.
  507.      */
  508.  
  509.     if (scalePtr->varName != NULL) {
  510.     Tcl_UntraceVar(interp, scalePtr->varName, 
  511.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  512.         ScaleVarProc, (ClientData) scalePtr);
  513.     }
  514.  
  515.     if (Tk_ConfigureWidget(interp, scalePtr->tkwin, configSpecs,
  516.         argc, argv, (char *) scalePtr, flags) != TCL_OK) {
  517.     return TCL_ERROR;
  518.     }
  519.  
  520.     /*
  521.      * If the scale is tied to the value of a variable, then set up
  522.      * a trace on the variable's value and set the scale's value from
  523.      * the value of the variable, if it exists.
  524.      */
  525.  
  526.     if (scalePtr->varName != NULL) {
  527.     char *stringValue, *end;
  528.     double value;
  529.  
  530.     stringValue = Tcl_GetVar(interp, scalePtr->varName, TCL_GLOBAL_ONLY);
  531.     if (stringValue != NULL) {
  532.         value = strtod(stringValue, &end);
  533.         if ((end != stringValue) && (*end == 0)) {
  534.         scalePtr->value = TkRoundToResolution(scalePtr, value);
  535.         }
  536.     }
  537.     Tcl_TraceVar(interp, scalePtr->varName,
  538.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  539.         ScaleVarProc, (ClientData) scalePtr);
  540.     }
  541.  
  542.     /*
  543.      * Several options need special processing, such as parsing the
  544.      * orientation and creating GCs.
  545.      */
  546.  
  547.     length = strlen(scalePtr->orientUid);
  548.     if (strncmp(scalePtr->orientUid, "vertical", length) == 0) {
  549.     scalePtr->vertical = 1;
  550.     } else if (strncmp(scalePtr->orientUid, "horizontal", length) == 0) {
  551.     scalePtr->vertical = 0;
  552.     } else {
  553.     Tcl_AppendResult(interp, "bad orientation \"", scalePtr->orientUid,
  554.         "\": must be vertical or horizontal", (char *) NULL);
  555.     return TCL_ERROR;
  556.     }
  557.  
  558.     scalePtr->fromValue = TkRoundToResolution(scalePtr, scalePtr->fromValue);
  559.     scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue);
  560.     scalePtr->tickInterval = TkRoundToResolution(scalePtr,
  561.         scalePtr->tickInterval);
  562.  
  563.     /*
  564.      * Make sure that the tick interval has the right sign so that
  565.      * addition moves from fromValue to toValue.
  566.      */
  567.  
  568.     if ((scalePtr->tickInterval < 0)
  569.         ^ ((scalePtr->toValue - scalePtr->fromValue) <  0)) {
  570.     scalePtr->tickInterval = -scalePtr->tickInterval;
  571.     }
  572.  
  573.     /*
  574.      * Set the scale value to itself;  all this does is to make sure
  575.      * that the scale's value is within the new acceptable range for
  576.      * the scale and reflect the value in the associated variable,
  577.      * if any.
  578.      */
  579.  
  580.     ComputeFormat(scalePtr);
  581.     TkpSetScaleValue(scalePtr, scalePtr->value, 1, 1);
  582.  
  583.     if (scalePtr->label != NULL) {
  584.     scalePtr->labelLength = strlen(scalePtr->label);
  585.     } else {
  586.     scalePtr->labelLength = 0;
  587.     }
  588.  
  589.     if ((scalePtr->state != tkNormalUid)
  590.         && (scalePtr->state != tkDisabledUid)
  591.         && (scalePtr->state != tkActiveUid)) {
  592.     Tcl_AppendResult(interp, "bad state value \"", scalePtr->state,
  593.         "\": must be normal, active, or disabled", (char *) NULL);
  594.     scalePtr->state = tkNormalUid;
  595.     return TCL_ERROR;
  596.     }
  597.  
  598.     Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder);
  599.  
  600.     if (scalePtr->highlightWidth < 0) {
  601.     scalePtr->highlightWidth = 0;
  602.     }
  603.     scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
  604.  
  605.     ScaleWorldChanged((ClientData) scalePtr);
  606.     return TCL_OK;
  607. }
  608.  
  609. /*
  610.  *---------------------------------------------------------------------------
  611.  *
  612.  * ScaleWorldChanged --
  613.  *
  614.  *      This procedure is called when the world has changed in some
  615.  *      way and the widget needs to recompute all its graphics contexts
  616.  *    and determine its new geometry.
  617.  *
  618.  * Results:
  619.  *      None.
  620.  *
  621.  * Side effects:
  622.  *      Scale will be relayed out and redisplayed.
  623.  *
  624.  *---------------------------------------------------------------------------
  625.  */
  626.  
  627. static void
  628. ScaleWorldChanged(instanceData)
  629.     ClientData instanceData;    /* Information about widget. */
  630. {
  631.     XGCValues gcValues;
  632.     GC gc;
  633.     TkScale *scalePtr;
  634.  
  635.     scalePtr = (TkScale *) instanceData;
  636.  
  637.     gcValues.foreground = scalePtr->troughColorPtr->pixel;
  638.     gc = Tk_GetGC(scalePtr->tkwin, GCForeground, &gcValues);
  639.     if (scalePtr->troughGC != None) {
  640.     Tk_FreeGC(scalePtr->display, scalePtr->troughGC);
  641.     }
  642.     scalePtr->troughGC = gc;
  643.  
  644.     gcValues.font = Tk_FontId(scalePtr->tkfont);
  645.     gcValues.foreground = scalePtr->textColorPtr->pixel;
  646.     gc = Tk_GetGC(scalePtr->tkwin, GCForeground | GCFont, &gcValues);
  647.     if (scalePtr->textGC != None) {
  648.     Tk_FreeGC(scalePtr->display, scalePtr->textGC);
  649.     }
  650.     scalePtr->textGC = gc;
  651.  
  652.     if (scalePtr->copyGC == None) {
  653.     gcValues.graphics_exposures = False;
  654.     scalePtr->copyGC = Tk_GetGC(scalePtr->tkwin, GCGraphicsExposures,
  655.         &gcValues);
  656.     }
  657.     scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
  658.  
  659.     /*
  660.      * Recompute display-related information, and let the geometry
  661.      * manager know how much space is needed now.
  662.      */
  663.  
  664.     ComputeScaleGeometry(scalePtr);
  665.  
  666.     TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
  667. }
  668.  
  669. /*
  670.  *----------------------------------------------------------------------
  671.  *
  672.  * ComputeFormat --
  673.  *
  674.  *    This procedure is invoked to recompute the "format" field
  675.  *    of a scale's widget record, which determines how the value
  676.  *    of the scale is converted to a string.
  677.  *
  678.  * Results:
  679.  *    None.
  680.  *
  681.  * Side effects:
  682.  *    The format field of scalePtr is modified.
  683.  *
  684.  *----------------------------------------------------------------------
  685.  */
  686.  
  687. static void
  688. ComputeFormat(scalePtr)
  689.     TkScale *scalePtr;            /* Information about scale widget. */
  690. {
  691.     double maxValue, x;
  692.     int mostSigDigit, numDigits, leastSigDigit, afterDecimal;
  693.     int eDigits, fDigits;
  694.  
  695.     /*
  696.      * Compute the displacement from the decimal of the most significant
  697.      * digit required for any number in the scale's range.
  698.      */
  699.  
  700.     maxValue = fabs(scalePtr->fromValue);
  701.     x = fabs(scalePtr->toValue);
  702.     if (x > maxValue) {
  703.     maxValue = x;
  704.     }
  705.     if (maxValue == 0) {
  706.     maxValue = 1;
  707.     }
  708.     mostSigDigit = (int) floor(log10(maxValue));
  709.  
  710.     /*
  711.      * If the number of significant digits wasn't specified explicitly,
  712.      * compute it. It's the difference between the most significant
  713.      * digit needed to represent any number on the scale and the
  714.      * most significant digit of the smallest difference between
  715.      * numbers on the scale.  In other words, display enough digits so
  716.      * that at least one digit will be different between any two adjacent
  717.      * positions of the scale.
  718.      */
  719.  
  720.     numDigits = scalePtr->digits;
  721.     if (numDigits <= 0) {
  722.     if  (scalePtr->resolution > 0) {
  723.         /*
  724.          * A resolution was specified for the scale, so just use it.
  725.          */
  726.  
  727.         leastSigDigit = (int) floor(log10(scalePtr->resolution));
  728.     } else {
  729.         /*
  730.          * No resolution was specified, so compute the difference
  731.          * in value between adjacent pixels and use it for the least
  732.          * significant digit.
  733.          */
  734.  
  735.         x = fabs(scalePtr->fromValue - scalePtr->toValue);
  736.         if (scalePtr->length > 0) {
  737.         x /= scalePtr->length;
  738.         }
  739.         if (x > 0){
  740.         leastSigDigit = (int) floor(log10(x));
  741.         } else {
  742.         leastSigDigit = 0;
  743.         }
  744.     }
  745.     numDigits = mostSigDigit - leastSigDigit + 1;
  746.     if (numDigits < 1) {
  747.         numDigits = 1;
  748.     }
  749.     }
  750.  
  751.     /*
  752.      * Compute the number of characters required using "e" format and
  753.      * "f" format, and then choose whichever one takes fewer characters.
  754.      */
  755.  
  756.     eDigits = numDigits + 4;
  757.     if (numDigits > 1) {
  758.     eDigits++;            /* Decimal point. */
  759.     }
  760.     afterDecimal = numDigits - mostSigDigit - 1;
  761.     if (afterDecimal < 0) {
  762.     afterDecimal = 0;
  763.     }
  764.     fDigits = (mostSigDigit >= 0) ? mostSigDigit + afterDecimal : afterDecimal;
  765.     if (afterDecimal > 0) {
  766.     fDigits++;            /* Decimal point. */
  767.     }
  768.     if (mostSigDigit < 0) {
  769.     fDigits++;            /* Zero to left of decimal point. */
  770.     }
  771.     if (fDigits <= eDigits) {
  772.     sprintf(scalePtr->format, "%%.%df", afterDecimal);
  773.     } else {
  774.     sprintf(scalePtr->format, "%%.%de", numDigits-1);
  775.     }
  776. }
  777.  
  778. /*
  779.  *----------------------------------------------------------------------
  780.  *
  781.  * ComputeScaleGeometry --
  782.  *
  783.  *    This procedure is called to compute various geometrical
  784.  *    information for a scale, such as where various things get
  785.  *    displayed.  It's called when the window is reconfigured.
  786.  *
  787.  * Results:
  788.  *    None.
  789.  *
  790.  * Side effects:
  791.  *    Display-related numbers get changed in *scalePtr.  The
  792.  *    geometry manager gets told about the window's preferred size.
  793.  *
  794.  *----------------------------------------------------------------------
  795.  */
  796.  
  797. static void
  798. ComputeScaleGeometry(scalePtr)
  799.     register TkScale *scalePtr;        /* Information about widget. */
  800. {
  801.     char valueString[PRINT_CHARS];
  802.     int tmp, valuePixels, x, y, extraSpace;
  803.     Tk_FontMetrics fm;
  804.  
  805.     /*
  806.      * Horizontal scales are simpler than vertical ones because
  807.      * all sizes are the same (the height of a line of text);
  808.      * handle them first and then quit.
  809.      */
  810.  
  811.     Tk_GetFontMetrics(scalePtr->tkfont, &fm);
  812.     if (!scalePtr->vertical) {
  813.     y = scalePtr->inset;
  814.     extraSpace = 0;
  815.     if (scalePtr->labelLength != 0) {
  816.         scalePtr->horizLabelY = y + SPACING;
  817.         y += fm.linespace + SPACING;
  818.         extraSpace = SPACING;
  819.     }
  820.     if (scalePtr->showValue) {
  821.         scalePtr->horizValueY = y + SPACING;
  822.         y += fm.linespace + SPACING;
  823.         extraSpace = SPACING;
  824.     } else {
  825.         scalePtr->horizValueY = y;
  826.     }
  827.     y += extraSpace;
  828.     scalePtr->horizTroughY = y;
  829.     y += scalePtr->width + 2*scalePtr->borderWidth;
  830.     if (scalePtr->tickInterval != 0) {
  831.         scalePtr->horizTickY = y + SPACING;
  832.         y += fm.linespace + 2*SPACING;
  833.     }
  834.     Tk_GeometryRequest(scalePtr->tkwin,
  835.         scalePtr->length + 2*scalePtr->inset, y + scalePtr->inset);
  836.     Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset);
  837.     return;
  838.     }
  839.  
  840.     /*
  841.      * Vertical scale:  compute the amount of space needed to display
  842.      * the scales value by formatting strings for the two end points;
  843.      * use whichever length is longer.
  844.      */
  845.  
  846.     sprintf(valueString, scalePtr->format, scalePtr->fromValue);
  847.     valuePixels = Tk_TextWidth(scalePtr->tkfont, valueString, -1);
  848.  
  849.     sprintf(valueString, scalePtr->format, scalePtr->toValue);
  850.     tmp = Tk_TextWidth(scalePtr->tkfont, valueString, -1);
  851.     if (valuePixels < tmp) {
  852.     valuePixels = tmp;
  853.     }
  854.  
  855.     /*
  856.      * Assign x-locations to the elements of the scale, working from
  857.      * left to right.
  858.      */
  859.  
  860.     x = scalePtr->inset;
  861.     if ((scalePtr->tickInterval != 0) && (scalePtr->showValue)) {
  862.     scalePtr->vertTickRightX = x + SPACING + valuePixels;
  863.     scalePtr->vertValueRightX = scalePtr->vertTickRightX + valuePixels
  864.         + fm.ascent/2;
  865.     x = scalePtr->vertValueRightX + SPACING;
  866.     } else if (scalePtr->tickInterval != 0) {
  867.     scalePtr->vertTickRightX = x + SPACING + valuePixels;
  868.     scalePtr->vertValueRightX = scalePtr->vertTickRightX;
  869.     x = scalePtr->vertTickRightX + SPACING;
  870.     } else if (scalePtr->showValue) {
  871.     scalePtr->vertTickRightX = x;
  872.     scalePtr->vertValueRightX = x + SPACING + valuePixels;
  873.     x = scalePtr->vertValueRightX + SPACING;
  874.     } else {
  875.     scalePtr->vertTickRightX = x;
  876.     scalePtr->vertValueRightX = x;
  877.     }
  878.     scalePtr->vertTroughX = x;
  879.     x += 2*scalePtr->borderWidth + scalePtr->width;
  880.     if (scalePtr->labelLength == 0) {
  881.     scalePtr->vertLabelX = 0;
  882.     } else {
  883.     scalePtr->vertLabelX = x + fm.ascent/2;
  884.     x = scalePtr->vertLabelX + fm.ascent/2
  885.         + Tk_TextWidth(scalePtr->tkfont, scalePtr->label,
  886.             scalePtr->labelLength);
  887.     }
  888.     Tk_GeometryRequest(scalePtr->tkwin, x + scalePtr->inset,
  889.         scalePtr->length + 2*scalePtr->inset);
  890.     Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset);
  891. }
  892.  
  893. /*
  894.  *--------------------------------------------------------------
  895.  *
  896.  * ScaleEventProc --
  897.  *
  898.  *    This procedure is invoked by the Tk dispatcher for various
  899.  *    events on scales.
  900.  *
  901.  * Results:
  902.  *    None.
  903.  *
  904.  * Side effects:
  905.  *    When the window gets deleted, internal structures get
  906.  *    cleaned up.  When it gets exposed, it is redisplayed.
  907.  *
  908.  *--------------------------------------------------------------
  909.  */
  910.  
  911. static void
  912. ScaleEventProc(clientData, eventPtr)
  913.     ClientData clientData;    /* Information about window. */
  914.     XEvent *eventPtr;        /* Information about event. */
  915. {
  916.     TkScale *scalePtr = (TkScale *) clientData;
  917.  
  918.     if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
  919.     TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
  920.     } else if (eventPtr->type == DestroyNotify) {
  921.     if (scalePtr->tkwin != NULL) {
  922.         scalePtr->tkwin = NULL;
  923.         Tcl_DeleteCommandFromToken(scalePtr->interp, scalePtr->widgetCmd);
  924.     }
  925.     if (scalePtr->flags & REDRAW_ALL) {
  926.         Tcl_CancelIdleCall(TkpDisplayScale, (ClientData) scalePtr);
  927.     }
  928.     Tcl_EventuallyFree((ClientData) scalePtr, DestroyScale);
  929.     } else if (eventPtr->type == ConfigureNotify) {
  930.     ComputeScaleGeometry(scalePtr);
  931.     TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
  932.     } else if (eventPtr->type == FocusIn) {
  933.     if (eventPtr->xfocus.detail != NotifyInferior) {
  934.         scalePtr->flags |= GOT_FOCUS;
  935.         if (scalePtr->highlightWidth > 0) {
  936.         TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
  937.         }
  938.     }
  939.     } else if (eventPtr->type == FocusOut) {
  940.     if (eventPtr->xfocus.detail != NotifyInferior) {
  941.         scalePtr->flags &= ~GOT_FOCUS;
  942.         if (scalePtr->highlightWidth > 0) {
  943.         TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
  944.         }
  945.     }
  946.     }
  947. }
  948.  
  949. /*
  950.  *----------------------------------------------------------------------
  951.  *
  952.  * ScaleCmdDeletedProc --
  953.  *
  954.  *    This procedure is invoked when a widget command is deleted.  If
  955.  *    the widget isn't already in the process of being destroyed,
  956.  *    this command destroys it.
  957.  *
  958.  * Results:
  959.  *    None.
  960.  *
  961.  * Side effects:
  962.  *    The widget is destroyed.
  963.  *
  964.  *----------------------------------------------------------------------
  965.  */
  966.  
  967. static void
  968. ScaleCmdDeletedProc(clientData)
  969.     ClientData clientData;    /* Pointer to widget record for widget. */
  970. {
  971.     TkScale *scalePtr = (TkScale *) clientData;
  972.     Tk_Window tkwin = scalePtr->tkwin;
  973.  
  974.     /*
  975.      * This procedure could be invoked either because the window was
  976.      * destroyed and the command was then deleted (in which case tkwin
  977.      * is NULL) or because the command was deleted, and then this procedure
  978.      * destroys the widget.
  979.      */
  980.  
  981.     if (tkwin != NULL) {
  982.     scalePtr->tkwin = NULL;
  983.     Tk_DestroyWindow(tkwin);
  984.     }
  985. }
  986.  
  987. /*
  988.  *--------------------------------------------------------------
  989.  *
  990.  * TkEventuallyRedrawScale --
  991.  *
  992.  *    Arrange for part or all of a scale widget to redrawn at
  993.  *    the next convenient time in the future.
  994.  *
  995.  * Results:
  996.  *    None.
  997.  *
  998.  * Side effects:
  999.  *    If "what" is REDRAW_SLIDER then just the slider and the
  1000.  *    value readout will be redrawn;  if "what" is REDRAW_ALL
  1001.  *    then the entire widget will be redrawn.
  1002.  *
  1003.  *--------------------------------------------------------------
  1004.  */
  1005.  
  1006. void
  1007. TkEventuallyRedrawScale(scalePtr, what)
  1008.     register TkScale *scalePtr;    /* Information about widget. */
  1009.     int what;            /* What to redraw:  REDRAW_SLIDER
  1010.                  * or REDRAW_ALL. */
  1011. {
  1012.     if ((what == 0) || (scalePtr->tkwin == NULL)
  1013.         || !Tk_IsMapped(scalePtr->tkwin)) {
  1014.     return;
  1015.     }
  1016.     if ((scalePtr->flags & REDRAW_ALL) == 0) {
  1017.     Tcl_DoWhenIdle(TkpDisplayScale, (ClientData) scalePtr);
  1018.     }
  1019.     scalePtr->flags |= what;
  1020. }
  1021.  
  1022. /*
  1023.  *--------------------------------------------------------------
  1024.  *
  1025.  * TkRoundToResolution --
  1026.  *
  1027.  *    Round a given floating-point value to the nearest multiple
  1028.  *    of the scale's resolution.
  1029.  *
  1030.  * Results:
  1031.  *    The return value is the rounded result.
  1032.  *
  1033.  * Side effects:
  1034.  *    None.
  1035.  *
  1036.  *--------------------------------------------------------------
  1037.  */
  1038.  
  1039. double
  1040. TkRoundToResolution(scalePtr, value)
  1041.     TkScale *scalePtr;        /* Information about scale widget. */
  1042.     double value;        /* Value to round. */
  1043. {
  1044.     double rem, new;
  1045.  
  1046.     if (scalePtr->resolution <= 0) {
  1047.     return value;
  1048.     }
  1049.     new = scalePtr->resolution * floor(value/scalePtr->resolution);
  1050.     rem = value - new;
  1051.     if (rem < 0) {
  1052.     if (rem <= -scalePtr->resolution/2) {
  1053.         new -= scalePtr->resolution;
  1054.     }
  1055.     } else {
  1056.     if (rem >= scalePtr->resolution/2) {
  1057.         new += scalePtr->resolution;
  1058.     }
  1059.     }
  1060.     return new;
  1061. }
  1062.  
  1063. /*
  1064.  *----------------------------------------------------------------------
  1065.  *
  1066.  * ScaleVarProc --
  1067.  *
  1068.  *    This procedure is invoked by Tcl whenever someone modifies a
  1069.  *    variable associated with a scale widget.
  1070.  *
  1071.  * Results:
  1072.  *    NULL is always returned.
  1073.  *
  1074.  * Side effects:
  1075.  *    The value displayed in the scale will change to match the
  1076.  *    variable's new value.  If the variable has a bogus value then
  1077.  *    it is reset to the value of the scale.
  1078.  *
  1079.  *----------------------------------------------------------------------
  1080.  */
  1081.  
  1082.     /* ARGSUSED */
  1083. static char *
  1084. ScaleVarProc(clientData, interp, name1, name2, flags)
  1085.     ClientData clientData;    /* Information about button. */
  1086.     Tcl_Interp *interp;        /* Interpreter containing variable. */
  1087.     char *name1;        /* Name of variable. */
  1088.     char *name2;        /* Second part of variable name. */
  1089.     int flags;            /* Information about what happened. */
  1090. {
  1091.     register TkScale *scalePtr = (TkScale *) clientData;
  1092.     char *stringValue, *end, *result;
  1093.     double value;
  1094.  
  1095.     /*
  1096.      * If the variable is unset, then immediately recreate it unless
  1097.      * the whole interpreter is going away.
  1098.      */
  1099.  
  1100.     if (flags & TCL_TRACE_UNSETS) {
  1101.     if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
  1102.         Tcl_TraceVar(interp, scalePtr->varName,
  1103.             TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  1104.             ScaleVarProc, clientData);
  1105.         scalePtr->flags |= NEVER_SET;
  1106.         TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0);
  1107.     }
  1108.     return (char *) NULL;
  1109.     }
  1110.  
  1111.     /*
  1112.      * If we came here because we updated the variable (in TkpSetScaleValue),
  1113.      * then ignore the trace.  Otherwise update the scale with the value
  1114.      * of the variable.
  1115.      */
  1116.  
  1117.     if (scalePtr->flags & SETTING_VAR) {
  1118.     return (char *) NULL;
  1119.     }
  1120.     result = NULL;
  1121.     stringValue = Tcl_GetVar(interp, scalePtr->varName, TCL_GLOBAL_ONLY);
  1122.     if (stringValue != NULL) {
  1123.     value = strtod(stringValue, &end);
  1124.     if ((end == stringValue) || (*end != 0)) {
  1125.         result = "can't assign non-numeric value to scale variable";
  1126.     } else {
  1127.         scalePtr->value = TkRoundToResolution(scalePtr, value);
  1128.     }
  1129.  
  1130.     /*
  1131.      * This code is a bit tricky because it sets the scale's value before
  1132.      * calling TkpSetScaleValue.  This way, TkpSetScaleValue won't bother 
  1133.      * to set the variable again or to invoke the -command.  However, it
  1134.      * also won't redisplay the scale, so we have to ask for that
  1135.      * explicitly.
  1136.      */
  1137.  
  1138.     TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0);
  1139.     TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
  1140.     }
  1141.  
  1142.     return result;
  1143. }
  1144.