static pascal void
ScaleActionProc(
ControlRef theControl, /* Handle to scrollbat control */
ControlPartCode partCode) /* Part of scrollbar that was "hit" */
{
int value;
TkScale *scalePtr = (TkScale *) GetControlReference(theControl);
#ifdef TK_MAC_DEBUG_SCALE
TkMacOSXDbgMsg("ScaleActionProc");
#endif
value = GetControlValue(theControl);
TkScaleSetValue(scalePtr, value, 1, 1);
Tcl_Preserve((ClientData) scalePtr);
TkMacOSXRunTclEventLoop();
Tcl_Release((ClientData) scalePtr);
}
static int
ScaleWidgetObjCmd(
ClientData clientData, /* Information about scale widget. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
TkScale *scalePtr = clientData;
Tcl_Obj *objPtr;
int index, result;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
"option", 0, &index);
if (result != TCL_OK) {
return result;
}
Tcl_Preserve(scalePtr);
switch (index) {
case COMMAND_CGET:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "cget option");
goto error;
}
objPtr = Tk_GetOptionValue(interp, (char *) scalePtr,
scalePtr->optionTable, objv[2], scalePtr->tkwin);
if (objPtr == NULL) {
goto error;
}
Tcl_SetObjResult(interp, objPtr);
break;
case COMMAND_CONFIGURE:
if (objc <= 3) {
objPtr = Tk_GetOptionInfo(interp, (char *) scalePtr,
scalePtr->optionTable,
(objc == 3) ? objv[2] : NULL, scalePtr->tkwin);
if (objPtr == NULL) {
goto error;
}
Tcl_SetObjResult(interp, objPtr);
} else {
result = ConfigureScale(interp, scalePtr, objc-2, objv+2);
}
break;
case COMMAND_COORDS: {
int x, y;
double value;
Tcl_Obj *coords[2];
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?");
goto error;
}
if (objc == 3) {
if (Tcl_GetDoubleFromObj(interp, objv[2], &value) != TCL_OK) {
goto error;
}
} else {
value = scalePtr->value;
}
if (scalePtr->orient == ORIENT_VERTICAL) {
x = scalePtr->vertTroughX + scalePtr->width/2
+ scalePtr->borderWidth;
y = TkScaleValueToPixel(scalePtr, value);
} else {
x = TkScaleValueToPixel(scalePtr, value);
y = scalePtr->horizTroughY + scalePtr->width/2
+ scalePtr->borderWidth;
}
coords[0] = Tcl_NewIntObj(x);
coords[1] = Tcl_NewIntObj(y);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
break;
}
case COMMAND_GET: {
double value;
int x, y;
if ((objc != 2) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "get ?x y?");
goto error;
}
if (objc == 2) {
value = scalePtr->value;
} else {
if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) ||
(Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
goto error;
}
value = TkScalePixelToValue(scalePtr, x, y);
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(scalePtr->format, value));
break;
}
case COMMAND_IDENTIFY: {
int x, y;
const char *zone = "";
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "identify x y");
goto error;
}
if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
|| (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
goto error;
}
switch (TkpScaleElement(scalePtr, x, y)) {
case TROUGH1:
zone = "trough1";
break;
case SLIDER:
zone = "slider";
break;
case TROUGH2:
zone = "trough2";
break;
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1));
break;
}
case COMMAND_SET: {
double value;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "set value");
goto error;
}
if (Tcl_GetDoubleFromObj(interp, objv[2], &value) != TCL_OK) {
goto error;
}
if (scalePtr->state != STATE_DISABLED) {
TkScaleSetValue(scalePtr, value, 1, 1);
}
break;
}
}
Tcl_Release(scalePtr);
return result;
error:
Tcl_Release(scalePtr);
return TCL_ERROR;
}
static int
ConfigureScale(
Tcl_Interp *interp, /* Used for error reporting. */
register TkScale *scalePtr, /* Information about widget; may or may not
* already have values for some fields. */
int objc, /* Number of valid entries in objv. */
Tcl_Obj *const objv[]) /* Argument values. */
{
Tk_SavedOptions savedOptions;
Tcl_Obj *errorResult = NULL;
int error;
double varValue;
/*
* Eliminate any existing trace on a variable monitored by the scale.
*/
if (scalePtr->varNamePtr != NULL) {
Tcl_UntraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ScaleVarProc, scalePtr);
}
for (error = 0; error <= 1; error++) {
if (!error) {
/*
* First pass: set options to new values.
*/
if (Tk_SetOptions(interp, (char *) scalePtr,
scalePtr->optionTable, objc, objv, scalePtr->tkwin,
&savedOptions, NULL) != TCL_OK) {
continue;
}
} else {
/*
* Second pass: restore options to old values.
*/
errorResult = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(errorResult);
Tk_RestoreSavedOptions(&savedOptions);
}
/*
* If the scale is tied to the value of a variable, then set the
* scale's value from the value of the variable, if it exists and it
* holds a valid double value.
*/
if (scalePtr->varNamePtr != NULL) {
double value;
Tcl_Obj *valuePtr;
valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
TCL_GLOBAL_ONLY);
if ((valuePtr != NULL) &&
(Tcl_GetDoubleFromObj(NULL, valuePtr, &value) == TCL_OK)) {
scalePtr->value = TkRoundToResolution(scalePtr, value);
}
}
/*
* Several options need special processing, such as parsing the
* orientation and creating GCs.
*/
scalePtr->fromValue = TkRoundToResolution(scalePtr,
scalePtr->fromValue);
scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue);
scalePtr->tickInterval = TkRoundToResolution(scalePtr,
scalePtr->tickInterval);
/*
* Make sure that the tick interval has the right sign so that
* addition moves from fromValue to toValue.
*/
if ((scalePtr->tickInterval < 0)
^ ((scalePtr->toValue - scalePtr->fromValue) < 0)) {
scalePtr->tickInterval = -scalePtr->tickInterval;
}
ComputeFormat(scalePtr);
scalePtr->labelLength = scalePtr->label ? (int)strlen(scalePtr->label) : 0;
Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder);
if (scalePtr->highlightWidth < 0) {
scalePtr->highlightWidth = 0;
}
scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
break;
}
if (!error) {
Tk_FreeSavedOptions(&savedOptions);
}
/*
* Set the scale value to itself; all this does is to make sure that the
* scale's value is within the new acceptable range for the scale. We
* don't set the var here because we need to make special checks for
* possibly changed varNamePtr.
*/
TkScaleSetValue(scalePtr, scalePtr->value, 0, 1);
/*
* Reestablish the variable trace, if it is needed.
*/
if (scalePtr->varNamePtr != NULL) {
Tcl_Obj *valuePtr;
/*
* Set the associated variable only when the new value differs from
* the current value, or the variable doesn't yet exist.
*/
valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
TCL_GLOBAL_ONLY);
if ((valuePtr == NULL) || (Tcl_GetDoubleFromObj(NULL,
valuePtr, &varValue) != TCL_OK)) {
ScaleSetVariable(scalePtr);
} else {
char varString[TCL_DOUBLE_SPACE], scaleString[TCL_DOUBLE_SPACE];
sprintf(varString, scalePtr->format, varValue);
sprintf(scaleString, scalePtr->format, scalePtr->value);
if (strcmp(varString, scaleString)) {
ScaleSetVariable(scalePtr);
}
}
Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ScaleVarProc, scalePtr);
}
ScaleWorldChanged(scalePtr);
if (error) {
Tcl_SetObjResult(interp, errorResult);
Tcl_DecrRefCount(errorResult);
return TCL_ERROR;
}
return TCL_OK;
}
/* ARGSUSED */
static char *
ScaleVarProc(
ClientData clientData, /* Information about button. */
Tcl_Interp *interp, /* Interpreter containing variable. */
const char *name1, /* Name of variable. */
const char *name2, /* Second part of variable name. */
int flags) /* Information about what happened. */
{
register TkScale *scalePtr = clientData;
const char *resultStr;
double value;
Tcl_Obj *valuePtr;
int result;
/*
* If the variable is unset, then immediately recreate it unless the whole
* interpreter is going away.
*/
if (flags & TCL_TRACE_UNSETS) {
if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ScaleVarProc, clientData);
scalePtr->flags |= NEVER_SET;
TkScaleSetValue(scalePtr, scalePtr->value, 1, 0);
}
return NULL;
}
/*
* If we came here because we updated the variable (in TkScaleSetValue),
* then ignore the trace. Otherwise update the scale with the value of the
* variable.
*/
if (scalePtr->flags & SETTING_VAR) {
return NULL;
}
resultStr = NULL;
valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
TCL_GLOBAL_ONLY);
result = Tcl_GetDoubleFromObj(interp, valuePtr, &value);
if (result != TCL_OK) {
resultStr = "can't assign non-numeric value to scale variable";
ScaleSetVariable(scalePtr);
} else {
scalePtr->value = TkRoundToResolution(scalePtr, value);
/*
* This code is a bit tricky because it sets the scale's value before
* calling TkScaleSetValue. This way, TkScaleSetValue won't bother to
* set the variable again or to invoke the -command. However, it also
* won't redisplay the scale, so we have to ask for that explicitly.
*/
TkScaleSetValue(scalePtr, scalePtr->value, 1, 0);
}
TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
return (char *) resultStr;
}
