static int
PlaceInfoCommand(
Tcl_Interp *interp, /* Interp into which to place result. */
Tk_Window tkwin) /* Token for the window to get info on. */
{
Slave *slavePtr;
Tcl_Obj *infoObj;
slavePtr = FindSlave(tkwin);
if (slavePtr == NULL) {
return TCL_OK;
}
infoObj = Tcl_NewObj();
if (slavePtr->masterPtr != NULL) {
Tcl_AppendToObj(infoObj, "-in", -1);
Tcl_ListObjAppendElement(NULL, infoObj,
TkNewWindowObj(slavePtr->masterPtr->tkwin));
Tcl_AppendToObj(infoObj, " ", -1);
}
Tcl_AppendPrintfToObj(infoObj,
"-x %d -relx %.4g -y %d -rely %.4g",
slavePtr->x, slavePtr->relX, slavePtr->y, slavePtr->relY);
if (slavePtr->flags & CHILD_WIDTH) {
Tcl_AppendPrintfToObj(infoObj, " -width %d", slavePtr->width);
} else {
Tcl_AppendToObj(infoObj, " -width {}", -1);
}
if (slavePtr->flags & CHILD_REL_WIDTH) {
Tcl_AppendPrintfToObj(infoObj,
" -relwidth %.4g", slavePtr->relWidth);
} else {
Tcl_AppendToObj(infoObj, " -relwidth {}", -1);
}
if (slavePtr->flags & CHILD_HEIGHT) {
Tcl_AppendPrintfToObj(infoObj, " -height %d", slavePtr->height);
} else {
Tcl_AppendToObj(infoObj, " -height {}", -1);
}
if (slavePtr->flags & CHILD_REL_HEIGHT) {
Tcl_AppendPrintfToObj(infoObj,
" -relheight %.4g", slavePtr->relHeight);
} else {
Tcl_AppendToObj(infoObj, " -relheight {}", -1);
}
Tcl_AppendPrintfToObj(infoObj, " -anchor %s -bordermode %s",
Tk_NameOfAnchor(slavePtr->anchor),
borderModeStrings[slavePtr->borderMode]);
Tcl_SetObjResult(interp, infoObj);
return TCL_OK;
}
int
Tk_PlaceObjCmd(
ClientData clientData, /* Interpreter main window. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tk_Window main_win = clientData;
Tk_Window tkwin;
Slave *slavePtr;
TkDisplay *dispPtr;
Tk_OptionTable optionTable;
static const char *const optionStrings[] = {
"configure", "forget", "info", "slaves", NULL
};
enum options { PLACE_CONFIGURE, PLACE_FORGET, PLACE_INFO, PLACE_SLAVES };
int index;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option|pathName args");
return TCL_ERROR;
}
/*
* Create the option table for this widget class. If it has already been
* created, the cached pointer will be returned.
*/
optionTable = Tk_CreateOptionTable(interp, optionSpecs);
/*
* Handle special shortcut where window name is first argument.
*/
if (Tcl_GetString(objv[1])[0] == '.') {
if (TkGetWindowFromObj(interp, main_win, objv[1],
&tkwin) != TCL_OK) {
return TCL_ERROR;
}
/*
* Initialize, if that hasn't been done yet.
*/
dispPtr = ((TkWindow *) tkwin)->dispPtr;
if (!dispPtr->placeInit) {
Tcl_InitHashTable(&dispPtr->masterTable, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(&dispPtr->slaveTable, TCL_ONE_WORD_KEYS);
dispPtr->placeInit = 1;
}
return ConfigureSlave(interp, tkwin, optionTable, objc-2, objv+2);
}
/*
* Handle more general case of option followed by window name followed by
* possible additional arguments.
*/
if (TkGetWindowFromObj(interp, main_win, objv[2],
&tkwin) != TCL_OK) {
return TCL_ERROR;
}
/*
* Initialize, if that hasn't been done yet.
*/
dispPtr = ((TkWindow *) tkwin)->dispPtr;
if (!dispPtr->placeInit) {
Tcl_InitHashTable(&dispPtr->masterTable, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(&dispPtr->slaveTable, TCL_ONE_WORD_KEYS);
dispPtr->placeInit = 1;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case PLACE_CONFIGURE:
if (objc == 3 || objc == 4) {
Tcl_Obj *objPtr;
slavePtr = FindSlave(tkwin);
if (slavePtr == NULL) {
return TCL_OK;
}
objPtr = Tk_GetOptionInfo(interp, (char *) slavePtr, optionTable,
(objc == 4) ? objv[3] : NULL, tkwin);
if (objPtr == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
return ConfigureSlave(interp, tkwin, optionTable, objc-3, objv+3);
case PLACE_FORGET:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "pathName");
return TCL_ERROR;
}
slavePtr = FindSlave(tkwin);
if (slavePtr == NULL) {
return TCL_OK;
}
if ((slavePtr->masterPtr != NULL) &&
(slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin))) {
Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
}
UnlinkSlave(slavePtr);
Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable,
(char *) tkwin));
Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
slavePtr);
Tk_ManageGeometry(tkwin, NULL, NULL);
Tk_UnmapWindow(tkwin);
FreeSlave(slavePtr);
break;
case PLACE_INFO:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "pathName");
return TCL_ERROR;
}
return PlaceInfoCommand(interp, tkwin);
case PLACE_SLAVES: {
Master *masterPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "pathName");
return TCL_ERROR;
}
masterPtr = FindMaster(tkwin);
if (masterPtr != NULL) {
Tcl_Obj *listPtr = Tcl_NewObj();
for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
slavePtr = slavePtr->nextPtr) {
Tcl_ListObjAppendElement(NULL, listPtr,
TkNewWindowObj(slavePtr->tkwin));
}
Tcl_SetObjResult(interp, listPtr);
}
break;
}
}
return TCL_OK;
}
int
Tk_SelectionObjCmd(
ClientData clientData, /* Main window associated with
* interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tk_Window tkwin = clientData;
const char *path = NULL;
Atom selection;
const char *selName = NULL;
const char *string;
int count, index;
Tcl_Obj **objs;
static const char *const optionStrings[] = {
"clear", "get", "handle", "own", NULL
};
enum options {
SELECTION_CLEAR, SELECTION_GET, SELECTION_HANDLE, SELECTION_OWN
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case SELECTION_CLEAR: {
static const char *const clearOptionStrings[] = {
"-displayof", "-selection", NULL
};
enum clearOptions { CLEAR_DISPLAYOF, CLEAR_SELECTION };
int clearIndex;
for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
count-=2, objs+=2) {
string = Tcl_GetString(objs[0]);
if (string[0] != '-') {
break;
}
if (count < 2) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"value for \"%s\" missing", string));
Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objs[0], clearOptionStrings,
"option", 0, &clearIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum clearOptions) clearIndex) {
case CLEAR_DISPLAYOF:
path = Tcl_GetString(objs[1]);
break;
case CLEAR_SELECTION:
selName = Tcl_GetString(objs[1]);
break;
}
}
if (count == 1) {
path = Tcl_GetString(objs[0]);
} else if (count > 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
return TCL_ERROR;
}
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
if (selName != NULL) {
selection = Tk_InternAtom(tkwin, selName);
} else {
selection = XA_PRIMARY;
}
Tk_ClearSelection(tkwin, selection);
break;
}
case SELECTION_GET: {
Atom target;
const char *targetName = NULL;
Tcl_DString selBytes;
int result;
static const char *const getOptionStrings[] = {
"-displayof", "-selection", "-type", NULL
};
enum getOptions { GET_DISPLAYOF, GET_SELECTION, GET_TYPE };
int getIndex;
for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count>0;
count-=2, objs+=2) {
string = Tcl_GetString(objs[0]);
if (string[0] != '-') {
break;
}
if (count < 2) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"value for \"%s\" missing", string));
Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objs[0], getOptionStrings,
"option", 0, &getIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum getOptions) getIndex) {
case GET_DISPLAYOF:
path = Tcl_GetString(objs[1]);
break;
case GET_SELECTION:
selName = Tcl_GetString(objs[1]);
break;
case GET_TYPE:
targetName = Tcl_GetString(objs[1]);
break;
}
}
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
if (selName != NULL) {
selection = Tk_InternAtom(tkwin, selName);
} else {
selection = XA_PRIMARY;
}
if (count > 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
return TCL_ERROR;
} else if (count == 1) {
target = Tk_InternAtom(tkwin, Tcl_GetString(objs[0]));
} else if (targetName != NULL) {
target = Tk_InternAtom(tkwin, targetName);
} else {
target = XA_STRING;
}
Tcl_DStringInit(&selBytes);
result = Tk_GetSelection(interp, tkwin, selection, target,
SelGetProc, &selBytes);
if (result == TCL_OK) {
Tcl_DStringResult(interp, &selBytes);
} else {
Tcl_DStringFree(&selBytes);
}
return result;
}
case SELECTION_HANDLE: {
Atom target, format;
const char *targetName = NULL;
const char *formatName = NULL;
register CommandInfo *cmdInfoPtr;
int cmdLength;
static const char *const handleOptionStrings[] = {
"-format", "-selection", "-type", NULL
};
enum handleOptions {
HANDLE_FORMAT, HANDLE_SELECTION, HANDLE_TYPE
};
int handleIndex;
for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
count-=2, objs+=2) {
string = Tcl_GetString(objs[0]);
if (string[0] != '-') {
break;
}
if (count < 2) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"value for \"%s\" missing", string));
Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objs[0],handleOptionStrings,
"option", 0, &handleIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum handleOptions) handleIndex) {
case HANDLE_FORMAT:
formatName = Tcl_GetString(objs[1]);
break;
case HANDLE_SELECTION:
selName = Tcl_GetString(objs[1]);
break;
case HANDLE_TYPE:
targetName = Tcl_GetString(objs[1]);
break;
}
}
if ((count < 2) || (count > 4)) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-option value ...? window command");
return TCL_ERROR;
}
tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
if (tkwin == NULL) {
return TCL_ERROR;
}
if (selName != NULL) {
selection = Tk_InternAtom(tkwin, selName);
} else {
selection = XA_PRIMARY;
}
if (count > 2) {
target = Tk_InternAtom(tkwin, Tcl_GetString(objs[2]));
} else if (targetName != NULL) {
target = Tk_InternAtom(tkwin, targetName);
} else {
target = XA_STRING;
}
if (count > 3) {
format = Tk_InternAtom(tkwin, Tcl_GetString(objs[3]));
} else if (formatName != NULL) {
format = Tk_InternAtom(tkwin, formatName);
} else {
format = XA_STRING;
}
string = Tcl_GetStringFromObj(objs[1], &cmdLength);
if (cmdLength == 0) {
Tk_DeleteSelHandler(tkwin, selection, target);
} else {
cmdInfoPtr = ckalloc(Tk_Offset(CommandInfo, command)
+ 1 + cmdLength);
cmdInfoPtr->interp = interp;
cmdInfoPtr->charOffset = 0;
cmdInfoPtr->byteOffset = 0;
cmdInfoPtr->buffer[0] = '\0';
cmdInfoPtr->cmdLength = cmdLength;
memcpy(cmdInfoPtr->command, string, cmdLength + 1);
Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
cmdInfoPtr, format);
}
return TCL_OK;
}
case SELECTION_OWN: {
register LostCommand *lostPtr;
Tcl_Obj *commandObj = NULL;
static const char *const ownOptionStrings[] = {
"-command", "-displayof", "-selection", NULL
};
enum ownOptions { OWN_COMMAND, OWN_DISPLAYOF, OWN_SELECTION };
int ownIndex;
for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
count-=2, objs+=2) {
string = Tcl_GetString(objs[0]);
if (string[0] != '-') {
break;
}
if (count < 2) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"value for \"%s\" missing", string));
Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objs[0], ownOptionStrings,
"option", 0, &ownIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum ownOptions) ownIndex) {
case OWN_COMMAND:
commandObj = objs[1];
break;
case OWN_DISPLAYOF:
path = Tcl_GetString(objs[1]);
break;
case OWN_SELECTION:
selName = Tcl_GetString(objs[1]);
break;
}
}
if (count > 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? ?window?");
return TCL_ERROR;
}
if (selName != NULL) {
selection = Tk_InternAtom(tkwin, selName);
} else {
selection = XA_PRIMARY;
}
if (count == 0) {
TkSelectionInfo *infoPtr;
TkWindow *winPtr;
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
winPtr = (TkWindow *) tkwin;
for (infoPtr = winPtr->dispPtr->selectionInfoPtr;
infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
if (infoPtr->selection == selection) {
break;
}
}
/*
* Ignore the internal clipboard window.
*/
if ((infoPtr != NULL)
&& (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
Tcl_SetObjResult(interp, TkNewWindowObj(infoPtr->owner));
}
return TCL_OK;
}
tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
if (tkwin == NULL) {
return TCL_ERROR;
}
if (count == 2) {
commandObj = objs[1];
}
if (commandObj == NULL) {
Tk_OwnSelection(tkwin, selection, NULL, NULL);
return TCL_OK;
}
lostPtr = ckalloc(sizeof(LostCommand));
lostPtr->interp = interp;
lostPtr->cmdObj = commandObj;
Tcl_IncrRefCount(commandObj);
Tk_OwnSelection(tkwin, selection, LostSelection, lostPtr);
return TCL_OK;
}
}
return TCL_OK;
}
/* ARGSUSED */
int
Tk_GrabObjCmd(
ClientData clientData, /* Main window associated with interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int globalGrab;
Tk_Window tkwin;
TkDisplay *dispPtr;
const char *arg;
int index;
TkSizeT len;
static const char *const optionStrings[] = {
"current", "release", "set", "status", NULL
};
static const char *const flagStrings[] = {
"-global", NULL
};
enum options {
GRABCMD_CURRENT, GRABCMD_RELEASE, GRABCMD_SET, GRABCMD_STATUS
};
if (objc < 2) {
/*
* Can't use Tcl_WrongNumArgs here because we want the message to
* read:
* wrong # args: should be "cmd ?-global? window" or "cmd option
* ?arg ...?"
* We can fake it with Tcl_WrongNumArgs if we assume the command name
* is "grab", but if it has been aliased, the message will be
* incorrect.
*/
Tcl_WrongNumArgs(interp, 1, objv, "?-global? window");
Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]),
" option ?arg ...?\"", NULL);
/* This API not exposed:
*
((Interp *) interp)->flags |= INTERP_ALTERNATE_WRONG_ARGS;
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
*/
return TCL_ERROR;
}
/*
* First check for a window name or "-global" as the first argument.
*/
arg = TkGetStringFromObj(objv[1], &len);
if (arg[0] == '.') {
/* [grab window] */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?-global? window");
return TCL_ERROR;
}
tkwin = Tk_NameToWindow(interp, arg, clientData);
if (tkwin == NULL) {
return TCL_ERROR;
}
return Tk_Grab(interp, tkwin, 0);
} else if (arg[0] == '-' && len > 1) {
if (Tcl_GetIndexFromObj(interp, objv[1], flagStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
/* [grab -global window] */
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?-global? window");
return TCL_ERROR;
}
tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), clientData);
if (tkwin == NULL) {
return TCL_ERROR;
}
return Tk_Grab(interp, tkwin, 1);
}
/*
* First argument is not a window name and not "-global", find out which
* option it is.
*/
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case GRABCMD_CURRENT:
/* [grab current ?window?] */
if (objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "current ?window?");
return TCL_ERROR;
}
if (objc == 3) {
tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
clientData);
if (tkwin == NULL) {
return TCL_ERROR;
}
dispPtr = ((TkWindow *) tkwin)->dispPtr;
if (dispPtr->eventualGrabWinPtr != NULL) {
Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window)
dispPtr->eventualGrabWinPtr));
}
} else {
Tcl_Obj *resultObj = Tcl_NewObj();
for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
dispPtr = dispPtr->nextPtr) {
if (dispPtr->eventualGrabWinPtr != NULL) {
Tcl_ListObjAppendElement(NULL, resultObj, TkNewWindowObj(
(Tk_Window) dispPtr->eventualGrabWinPtr));
}
}
Tcl_SetObjResult(interp, resultObj);
}
return TCL_OK;
case GRABCMD_RELEASE:
/* [grab release window] */
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "release window");
return TCL_ERROR;
}
tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), clientData);
if (tkwin == NULL) {
Tcl_ResetResult(interp);
} else {
Tk_Ungrab(tkwin);
}
break;
case GRABCMD_SET:
/* [grab set ?-global? window] */
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "set ?-global? window");
return TCL_ERROR;
}
if (objc == 3) {
globalGrab = 0;
tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
clientData);
} else {
globalGrab = 1;
/*
* We could just test the argument by hand instead of using
* Tcl_GetIndexFromObj; the benefit of using the function is that
* it sets up the error message for us, so we are certain to be
* consistant with the rest of Tcl.
*/
if (Tcl_GetIndexFromObj(interp, objv[2], flagStrings, "option",
0, &index) != TCL_OK) {
return TCL_ERROR;
}
tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[3]),
clientData);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
return Tk_Grab(interp, tkwin, globalGrab);
case GRABCMD_STATUS: {
/* [grab status window] */
TkWindow *winPtr;
const char *statusString;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "status window");
return TCL_ERROR;
}
winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
clientData);
if (winPtr == NULL) {
return TCL_ERROR;
}
dispPtr = winPtr->dispPtr;
if (dispPtr->eventualGrabWinPtr != winPtr) {
statusString = "none";
} else if (dispPtr->grabFlags & GRAB_GLOBAL) {
statusString = "global";
} else {
statusString = "local";
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(statusString, -1));
break;
}
}
return TCL_OK;
}
int
Tk_ScaleObjCmd(
ClientData clientData, /* NULL. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
register TkScale *scalePtr;
Tk_OptionTable optionTable;
Tk_Window tkwin;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
return TCL_ERROR;
}
tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
Tcl_GetString(objv[1]), NULL);
if (tkwin == NULL) {
return TCL_ERROR;
}
/*
* Create the option table for this widget class. If it has already been
* created, the cached pointer will be returned.
*/
optionTable = Tk_CreateOptionTable(interp, optionSpecs);
Tk_SetClass(tkwin, "Scale");
scalePtr = TkpCreateScale(tkwin);
/*
* Initialize fields that won't be initialized by ConfigureScale, or which
* ConfigureScale expects to have reasonable values (e.g. resource
* pointers).
*/
scalePtr->tkwin = tkwin;
scalePtr->display = Tk_Display(tkwin);
scalePtr->interp = interp;
scalePtr->widgetCmd = Tcl_CreateObjCommand(interp,
Tk_PathName(scalePtr->tkwin), ScaleWidgetObjCmd,
scalePtr, ScaleCmdDeletedProc);
scalePtr->optionTable = optionTable;
scalePtr->orient = ORIENT_VERTICAL;
scalePtr->width = 0;
scalePtr->length = 0;
scalePtr->value = 0.0;
scalePtr->varNamePtr = NULL;
scalePtr->fromValue = 0.0;
scalePtr->toValue = 0.0;
scalePtr->tickInterval = 0.0;
scalePtr->resolution = 1.0;
scalePtr->digits = 0;
scalePtr->bigIncrement = 0.0;
scalePtr->command = NULL;
scalePtr->repeatDelay = 0;
scalePtr->repeatInterval = 0;
scalePtr->label = NULL;
scalePtr->labelLength = 0;
scalePtr->state = STATE_NORMAL;
scalePtr->borderWidth = 0;
scalePtr->bgBorder = NULL;
scalePtr->activeBorder = NULL;
scalePtr->sliderRelief = TK_RELIEF_RAISED;
scalePtr->troughColorPtr = NULL;
scalePtr->troughGC = None;
scalePtr->copyGC = None;
scalePtr->tkfont = NULL;
scalePtr->textColorPtr = NULL;
scalePtr->textGC = None;
scalePtr->relief = TK_RELIEF_FLAT;
scalePtr->highlightWidth = 0;
scalePtr->highlightBorder = NULL;
scalePtr->highlightColorPtr = NULL;
scalePtr->inset = 0;
scalePtr->sliderLength = 0;
scalePtr->showValue = 0;
scalePtr->horizLabelY = 0;
scalePtr->horizValueY = 0;
scalePtr->horizTroughY = 0;
scalePtr->horizTickY = 0;
scalePtr->vertTickRightX = 0;
scalePtr->vertValueRightX = 0;
scalePtr->vertTroughX = 0;
scalePtr->vertLabelX = 0;
scalePtr->fontHeight = 0;
scalePtr->cursor = None;
scalePtr->takeFocusPtr = NULL;
scalePtr->flags = NEVER_SET;
Tk_SetClassProcs(scalePtr->tkwin, &scaleClass, scalePtr);
Tk_CreateEventHandler(scalePtr->tkwin,
ExposureMask|StructureNotifyMask|FocusChangeMask,
ScaleEventProc, scalePtr);
if ((Tk_InitOptions(interp, (char *) scalePtr, optionTable, tkwin)
!= TCL_OK) ||
(ConfigureScale(interp, scalePtr, objc - 2, objv + 2) != TCL_OK)) {
Tk_DestroyWindow(scalePtr->tkwin);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TkNewWindowObj(scalePtr->tkwin));
return TCL_OK;
}
int
Tk_BusyObjCmd(
ClientData clientData, /* Main window associated with interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tk_Window tkwin = clientData;
Tcl_HashTable *busyTablePtr = &((TkWindow *) tkwin)->mainPtr->busyTable;
Busy *busyPtr;
Tcl_Obj *objPtr;
int index, result = TCL_OK;
static const char *const optionStrings[] = {
"cget", "configure", "current", "forget", "hold", "status", NULL
};
enum options {
BUSY_CGET, BUSY_CONFIGURE, BUSY_CURRENT, BUSY_FORGET, BUSY_HOLD,
BUSY_STATUS
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "options ?arg arg ...?");
return TCL_ERROR;
}
/*
* [tk busy <window>] command shortcut.
*/
if (Tcl_GetString(objv[1])[0] == '.') {
if (objc%2 == 1) {
Tcl_WrongNumArgs(interp, 1, objv, "window ?option value ...?");
return TCL_ERROR;
}
return HoldBusy(busyTablePtr, interp, objv[1], objc-2, objv+2);
}
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case BUSY_CGET:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "window option");
return TCL_ERROR;
}
busyPtr = GetBusy(interp, busyTablePtr, objv[2]);
if (busyPtr == NULL) {
return TCL_ERROR;
}
Tcl_Preserve(busyPtr);
objPtr = Tk_GetOptionValue(interp, (char *) busyPtr,
busyPtr->optionTable, objv[3], busyPtr->tkBusy);
if (objPtr == NULL) {
result = TCL_ERROR;
} else {
Tcl_SetObjResult(interp, objPtr);
}
Tcl_Release(busyPtr);
return result;
case BUSY_CONFIGURE:
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "window ?option? ?value ...?");
return TCL_ERROR;
}
busyPtr = GetBusy(interp, busyTablePtr, objv[2]);
if (busyPtr == NULL) {
return TCL_ERROR;
}
Tcl_Preserve(busyPtr);
if (objc <= 4) {
objPtr = Tk_GetOptionInfo(interp, (char *) busyPtr,
busyPtr->optionTable, (objc == 4) ? objv[3] : NULL,
busyPtr->tkBusy);
if (objPtr == NULL) {
result = TCL_ERROR;
} else {
Tcl_SetObjResult(interp, objPtr);
}
} else {
result = ConfigureBusy(interp, busyPtr, objc-3, objv+3);
}
Tcl_Release(busyPtr);
return result;
case BUSY_CURRENT: {
Tcl_HashEntry *hPtr;
Tcl_HashSearch cursor;
const char *pattern = (objc == 3 ? Tcl_GetString(objv[2]) : NULL);
objPtr = Tcl_NewObj();
for (hPtr = Tcl_FirstHashEntry(busyTablePtr, &cursor); hPtr != NULL;
hPtr = Tcl_NextHashEntry(&cursor)) {
busyPtr = Tcl_GetHashValue(hPtr);
if (pattern == NULL ||
Tcl_StringMatch(Tk_PathName(busyPtr->tkRef), pattern)) {
Tcl_ListObjAppendElement(interp, objPtr,
TkNewWindowObj(busyPtr->tkRef));
}
}
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
case BUSY_FORGET:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "window");
return TCL_ERROR;
}
busyPtr = GetBusy(interp, busyTablePtr, objv[2]);
if (busyPtr == NULL) {
return TCL_ERROR;
}
TkpHideBusyWindow(busyPtr);
Tcl_EventuallyFree(busyPtr, DestroyBusy);
return TCL_OK;
case BUSY_HOLD:
if (objc < 3 || objc%2 != 1) {
Tcl_WrongNumArgs(interp, 2, objv, "window ?option value ...?");
return TCL_ERROR;
}
return HoldBusy(busyTablePtr, interp, objv[2], objc-3, objv+3);
case BUSY_STATUS:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "window");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
GetBusy(interp, busyTablePtr, objv[2]) != NULL));
return TCL_OK;
}
Tcl_Panic("unhandled option: %d", index);
return TCL_ERROR; /* Unreachable */
}
int
Tk_MenubuttonObjCmd(
ClientData clientData, /* NULL. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
register TkMenuButton *mbPtr;
Tk_OptionTable optionTable;
Tk_Window tkwin;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
return TCL_ERROR;
}
/*
* Create the new window.
*/
tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
Tcl_GetString(objv[1]), NULL);
if (tkwin == NULL) {
return TCL_ERROR;
}
/*
* Create the option table for this widget class. If it has already been
* created, the cached pointer will be returned.
*/
optionTable = Tk_CreateOptionTable(interp, optionSpecs);
Tk_SetClass(tkwin, "Menubutton");
mbPtr = TkpCreateMenuButton(tkwin);
Tk_SetClassProcs(tkwin, &tkpMenubuttonClass, mbPtr);
/*
* Initialize the data structure for the button.
*/
mbPtr->tkwin = tkwin;
mbPtr->display = Tk_Display (tkwin);
mbPtr->interp = interp;
mbPtr->widgetCmd = Tcl_CreateObjCommand(interp,
Tk_PathName(mbPtr->tkwin), MenuButtonWidgetObjCmd, mbPtr,
MenuButtonCmdDeletedProc);
mbPtr->optionTable = optionTable;
mbPtr->menuName = NULL;
mbPtr->text = NULL;
mbPtr->underline = -1;
mbPtr->textVarName = NULL;
mbPtr->bitmap = None;
mbPtr->imageString = NULL;
mbPtr->image = NULL;
mbPtr->state = STATE_NORMAL;
mbPtr->normalBorder = NULL;
mbPtr->activeBorder = NULL;
mbPtr->borderWidth = 0;
mbPtr->relief = TK_RELIEF_FLAT;
mbPtr->highlightWidth = 0;
mbPtr->highlightBgColorPtr = NULL;
mbPtr->highlightColorPtr = NULL;
mbPtr->inset = 0;
mbPtr->tkfont = NULL;
mbPtr->normalFg = NULL;
mbPtr->activeFg = NULL;
mbPtr->disabledFg = NULL;
mbPtr->normalTextGC = None;
mbPtr->activeTextGC = None;
mbPtr->gray = None;
mbPtr->disabledGC = None;
mbPtr->stippleGC = None;
mbPtr->leftBearing = 0;
mbPtr->rightBearing = 0;
mbPtr->widthString = NULL;
mbPtr->heightString = NULL;
mbPtr->width = 0;
mbPtr->width = 0;
mbPtr->wrapLength = 0;
mbPtr->padX = 0;
mbPtr->padY = 0;
mbPtr->anchor = TK_ANCHOR_CENTER;
mbPtr->justify = TK_JUSTIFY_CENTER;
mbPtr->textLayout = NULL;
mbPtr->indicatorOn = 0;
mbPtr->indicatorWidth = 0;
mbPtr->indicatorHeight = 0;
mbPtr->direction = DIRECTION_FLUSH;
mbPtr->cursor = None;
mbPtr->takeFocus = NULL;
mbPtr->flags = 0;
Tk_CreateEventHandler(mbPtr->tkwin,
ExposureMask|StructureNotifyMask|FocusChangeMask,
MenuButtonEventProc, mbPtr);
if (Tk_InitOptions(interp, (char *) mbPtr, optionTable, tkwin) != TCL_OK) {
Tk_DestroyWindow(mbPtr->tkwin);
return TCL_ERROR;
}
if (ConfigureMenuButton(interp, mbPtr, objc-2, objv+2) != TCL_OK) {
Tk_DestroyWindow(mbPtr->tkwin);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TkNewWindowObj(mbPtr->tkwin));
return TCL_OK;
}