/* ConfigurePane --
* Set pane options.
*/
static int ConfigurePane(
Tcl_Interp *interp, Paned *pw, Pane *pane, Tk_Window slaveWindow,
int objc, Tcl_Obj *const objv[])
{
Ttk_Manager *mgr = pw->paned.mgr;
Tk_SavedOptions savedOptions;
int mask = 0;
if (Tk_SetOptions(interp, (void*)pane, pw->paned.paneOptionTable,
objc, objv, slaveWindow, &savedOptions, &mask) != TCL_OK)
{
return TCL_ERROR;
}
/* Sanity-check:
*/
if (pane->weight < 0) {
Tcl_AppendResult(interp, "-weight must be nonnegative", NULL);
goto error;
}
/* Done.
*/
Tk_FreeSavedOptions(&savedOptions);
Ttk_ManagerSizeChanged(mgr);
return TCL_OK;
error:
Tk_RestoreSavedOptions(&savedOptions);
return TCL_ERROR;
}
/* Ttk_ConfigureTag -- implements [$w tag configure $tag -option value...]
*/
int Ttk_ConfigureTag(
Tcl_Interp *interp,
Ttk_TagTable tagTable,
Ttk_Tag tag,
int objc, Tcl_Obj *const objv[])
{
return Tk_SetOptions(
interp, tag->tagRecord, tagTable->optionTable,
objc, objv, tagTable->tkwin, NULL/*savedOptions*/, NULL/*mask*/);
}
static int
ConfigureBusy(
Tcl_Interp *interp,
Busy *busyPtr,
int objc,
Tcl_Obj *const objv[])
{
Tk_Cursor oldCursor = busyPtr->cursor;
if (Tk_SetOptions(interp, (char *) busyPtr, busyPtr->optionTable, objc,
objv, busyPtr->tkBusy, NULL, NULL) != TCL_OK) {
return TCL_ERROR;
}
if (busyPtr->cursor != oldCursor) {
if (busyPtr->cursor == None) {
Tk_UndefineCursor(busyPtr->tkBusy);
} else {
Tk_DefineCursor(busyPtr->tkBusy, busyPtr->cursor);
}
}
return TCL_OK;
}
static int
ConfigureSlave(
Tcl_Interp *interp, /* Used for error reporting. */
Tk_Window tkwin, /* Token for the window to manipulate. */
Tk_OptionTable table, /* Token for option table. */
int objc, /* Number of config arguments. */
Tcl_Obj *const objv[]) /* Object values for arguments. */
{
register Master *masterPtr;
Tk_SavedOptions savedOptions;
int mask;
Slave *slavePtr;
Tk_Window masterWin = (Tk_Window) NULL;
if (Tk_TopWinHierarchy(tkwin)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't use placer on top-level window \"%s\"; use "
"wm command instead", Tk_PathName(tkwin)));
Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL);
return TCL_ERROR;
}
slavePtr = CreateSlave(tkwin, table);
if (Tk_SetOptions(interp, (char *) slavePtr, table, objc, objv,
slavePtr->tkwin, &savedOptions, &mask) != TCL_OK) {
goto error;
}
/*
* Set slave flags. First clear the field, then add bits as needed.
*/
slavePtr->flags = 0;
if (slavePtr->heightPtr) {
slavePtr->flags |= CHILD_HEIGHT;
}
if (slavePtr->relHeightPtr) {
slavePtr->flags |= CHILD_REL_HEIGHT;
}
if (slavePtr->relWidthPtr) {
slavePtr->flags |= CHILD_REL_WIDTH;
}
if (slavePtr->widthPtr) {
slavePtr->flags |= CHILD_WIDTH;
}
if (!(mask & IN_MASK) && (slavePtr->masterPtr != NULL)) {
/*
* If no -in option was passed and the slave is already placed then
* just recompute the placement.
*/
masterPtr = slavePtr->masterPtr;
goto scheduleLayout;
} else if (mask & IN_MASK) {
/* -in changed */
Tk_Window tkwin;
Tk_Window ancestor;
tkwin = slavePtr->inTkwin;
/*
* Make sure that the new master is either the logical parent of the
* slave or a descendant of that window, and that the master and slave
* aren't the same.
*/
for (ancestor = tkwin; ; ancestor = Tk_Parent(ancestor)) {
if (ancestor == Tk_Parent(slavePtr->tkwin)) {
break;
}
if (Tk_TopWinHierarchy(ancestor)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't place %s relative to %s",
Tk_PathName(slavePtr->tkwin), Tk_PathName(tkwin)));
Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL);
goto error;
}
}
if (slavePtr->tkwin == tkwin) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't place %s relative to itself",
Tk_PathName(slavePtr->tkwin)));
Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL);
goto error;
}
if ((slavePtr->masterPtr != NULL)
&& (slavePtr->masterPtr->tkwin == tkwin)) {
/*
* Re-using same old master. Nothing to do.
*/
masterPtr = slavePtr->masterPtr;
goto scheduleLayout;
}
if ((slavePtr->masterPtr != NULL) &&
(slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin))) {
Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
}
UnlinkSlave(slavePtr);
masterWin = tkwin;
}
/*
* If there's no master specified for this slave, use its Tk_Parent.
*/
if (masterWin == NULL) {
masterWin = Tk_Parent(slavePtr->tkwin);
slavePtr->inTkwin = masterWin;
}
/*
* Manage the slave window in this master.
*/
masterPtr = CreateMaster(masterWin);
slavePtr->masterPtr = masterPtr;
slavePtr->nextPtr = masterPtr->slavePtr;
masterPtr->slavePtr = slavePtr;
Tk_ManageGeometry(slavePtr->tkwin, &placerType, slavePtr);
/*
* Arrange for the master to be re-arranged at the first idle moment.
*/
scheduleLayout:
Tk_FreeSavedOptions(&savedOptions);
if (!(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
masterPtr->flags |= PARENT_RECONFIG_PENDING;
Tcl_DoWhenIdle(RecomputePlacement, masterPtr);
}
return TCL_OK;
/*
* Error while processing some option, cleanup and return.
*/
error:
Tk_RestoreSavedOptions(&savedOptions);
return TCL_ERROR;
}
static int
EmbWinConfigure(
TkText *textPtr, /* Information about text widget that contains
* embedded window. */
TkTextSegment *ewPtr, /* Embedded window to be configured. */
int objc, /* Number of strings in objv. */
Tcl_Obj *const objv[]) /* Array of objects describing configuration
* options. */
{
Tk_Window oldWindow;
TkTextEmbWindowClient *client;
/*
* Copy over client specific value before querying or setting.
*/
client = EmbWinGetClient(textPtr, ewPtr);
if (client != NULL) {
ewPtr->body.ew.tkwin = client->tkwin;
} else {
ewPtr->body.ew.tkwin = NULL;
}
oldWindow = ewPtr->body.ew.tkwin;
if (Tk_SetOptions(textPtr->interp, (char *) &ewPtr->body.ew,
ewPtr->body.ew.optionTable, objc, objv, textPtr->tkwin, NULL,
NULL) != TCL_OK) {
return TCL_ERROR;
}
if (oldWindow != ewPtr->body.ew.tkwin) {
if (oldWindow != NULL) {
Tcl_DeleteHashEntry(Tcl_FindHashEntry(
&textPtr->sharedTextPtr->windowTable,
Tk_PathName(oldWindow)));
Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
EmbWinStructureProc, client);
Tk_ManageGeometry(oldWindow, NULL, NULL);
if (textPtr->tkwin != Tk_Parent(oldWindow)) {
Tk_UnmaintainGeometry(oldWindow, textPtr->tkwin);
} else {
Tk_UnmapWindow(oldWindow);
}
}
if (client != NULL) {
client->tkwin = NULL;
}
if (ewPtr->body.ew.tkwin != NULL) {
Tk_Window ancestor, parent;
Tcl_HashEntry *hPtr;
int isNew;
/*
* Make sure that the text is either the parent of the embedded
* window or a descendant of that parent. Also, don't allow a
* top-level window to be managed inside a text.
*/
parent = Tk_Parent(ewPtr->body.ew.tkwin);
for (ancestor = textPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
if (ancestor == parent) {
break;
}
if (Tk_TopWinHierarchy(ancestor)) {
badMaster:
Tcl_AppendResult(textPtr->interp, "can't embed ",
Tk_PathName(ewPtr->body.ew.tkwin), " in ",
Tk_PathName(textPtr->tkwin), NULL);
ewPtr->body.ew.tkwin = NULL;
if (client != NULL) {
client->tkwin = NULL;
}
return TCL_ERROR;
}
}
if (Tk_TopWinHierarchy(ewPtr->body.ew.tkwin)
|| (ewPtr->body.ew.tkwin == textPtr->tkwin)) {
goto badMaster;
}
if (client == NULL) {
/*
* Have to make the new client.
*/
client = (TkTextEmbWindowClient *)
ckalloc(sizeof(TkTextEmbWindowClient));
client->next = ewPtr->body.ew.clients;
client->textPtr = textPtr;
client->tkwin = NULL;
client->chunkCount = 0;
client->displayed = 0;
client->parent = ewPtr;
ewPtr->body.ew.clients = client;
}
client->tkwin = ewPtr->body.ew.tkwin;
/*
* Take over geometry management for the window, plus create an
* event handler to find out when it is deleted.
*/
Tk_ManageGeometry(ewPtr->body.ew.tkwin, &textGeomType, client);
Tk_CreateEventHandler(ewPtr->body.ew.tkwin, StructureNotifyMask,
EmbWinStructureProc, client);
/*
* Special trick! Must enter into the hash table *after* calling
* Tk_ManageGeometry: if the window was already managed elsewhere
* in this text, the Tk_ManageGeometry call will cause the entry
* to be removed, which could potentially lose the new entry.
*/
hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->windowTable,
Tk_PathName(ewPtr->body.ew.tkwin), &isNew);
Tcl_SetHashValue(hPtr, ewPtr);
}
}
return TCL_OK;
}
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;
}
int
TkTextTagCmd(
register TkText *textPtr, /* Information about text widget. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. Someone else has already
* parsed this command enough to know that
* objv[1] is "tag". */
{
static const char *const tagOptionStrings[] = {
"add", "bind", "cget", "configure", "delete", "lower", "names",
"nextrange", "prevrange", "raise", "ranges", "remove", NULL
};
enum tagOptions {
TAG_ADD, TAG_BIND, TAG_CGET, TAG_CONFIGURE, TAG_DELETE, TAG_LOWER,
TAG_NAMES, TAG_NEXTRANGE, TAG_PREVRANGE, TAG_RAISE, TAG_RANGES,
TAG_REMOVE
};
int optionIndex, i;
register TkTextTag *tagPtr;
TkTextIndex index1, index2;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[2], tagOptionStrings,
sizeof(char *), "tag option", 0, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum tagOptions)optionIndex) {
case TAG_ADD:
case TAG_REMOVE: {
int addTag;
if (((enum tagOptions)optionIndex) == TAG_ADD) {
addTag = 1;
} else {
addTag = 0;
}
if (objc < 5) {
Tcl_WrongNumArgs(interp, 3, objv,
"tagName index1 ?index2 index1 index2 ...?");
return TCL_ERROR;
}
tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3]), NULL);
if (tagPtr->elide) {
/*
* Indices are potentially obsolete after adding or removing
* elided character ranges, especially indices having "display"
* or "any" submodifier, therefore increase the epoch.
*/
textPtr->sharedTextPtr->stateEpoch++;
}
for (i = 4; i < objc; i += 2) {
if (TkTextGetObjIndex(interp, textPtr, objv[i],
&index1) != TCL_OK) {
return TCL_ERROR;
}
if (objc > (i+1)) {
if (TkTextGetObjIndex(interp, textPtr, objv[i+1],
&index2) != TCL_OK) {
return TCL_ERROR;
}
if (TkTextIndexCmp(&index1, &index2) >= 0) {
return TCL_OK;
}
} else {
index2 = index1;
TkTextIndexForwChars(NULL,&index2, 1, &index2, COUNT_INDICES);
}
if (tagPtr->affectsDisplay) {
TkTextRedrawTag(textPtr->sharedTextPtr, NULL, &index1, &index2,
tagPtr, !addTag);
} else {
/*
* Still need to trigger enter/leave events on tags that have
* changed.
*/
TkTextEventuallyRepick(textPtr);
}
if (TkBTreeTag(&index1, &index2, tagPtr, addTag)) {
/*
* If the tag is "sel", and we actually adjusted something
* then grab the selection if we're supposed to export it and
* don't already have it.
*
* Also, invalidate partially-completed selection retrievals.
* We only need to check whether the tag is "sel" for this
* textPtr (not for other peer widget's "sel" tags) because we
* cannot reach this code path with a different widget's "sel"
* tag.
*/
if (tagPtr == textPtr->selTagPtr) {
/*
* Send an event that the selection changed. This is
* equivalent to:
* event generate $textWidget <<Selection>>
*/
TkTextSelectionEvent(textPtr);
if (addTag && textPtr->exportSelection
&& !(textPtr->flags & GOT_SELECTION)) {
Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY,
TkTextLostSelection, textPtr);
textPtr->flags |= GOT_SELECTION;
}
textPtr->abortSelections = 1;
}
}
}
break;
}
case TAG_BIND:
if ((objc < 4) || (objc > 6)) {
Tcl_WrongNumArgs(interp, 3, objv, "tagName ?sequence? ?command?");
return TCL_ERROR;
}
tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3]), NULL);
/*
* Make a binding table if the widget doesn't already have one.
*/
if (textPtr->sharedTextPtr->bindingTable == NULL) {
textPtr->sharedTextPtr->bindingTable =
Tk_CreateBindingTable(interp);
}
if (objc == 6) {
int append = 0;
unsigned long mask;
const char *fifth = Tcl_GetString(objv[5]);
if (fifth[0] == 0) {
return Tk_DeleteBinding(interp,
textPtr->sharedTextPtr->bindingTable,
(ClientData) tagPtr->name, Tcl_GetString(objv[4]));
}
if (fifth[0] == '+') {
fifth++;
append = 1;
}
mask = Tk_CreateBinding(interp,
textPtr->sharedTextPtr->bindingTable,
(ClientData) tagPtr->name, Tcl_GetString(objv[4]), fifth,
append);
if (mask == 0) {
return TCL_ERROR;
}
if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
|Button2MotionMask|Button3MotionMask|Button4MotionMask
|Button5MotionMask|ButtonPressMask|ButtonReleaseMask
|EnterWindowMask|LeaveWindowMask|KeyPressMask
|KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
Tk_DeleteBinding(interp, textPtr->sharedTextPtr->bindingTable,
(ClientData) tagPtr->name, Tcl_GetString(objv[4]));
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"requested illegal events; only key, button, motion,"
" enter, leave, and virtual events may be used", -1));
Tcl_SetErrorCode(interp, "TK", "TEXT", "TAG_BIND_EVENT",NULL);
return TCL_ERROR;
}
} else if (objc == 5) {
const char *command;
command = Tk_GetBinding(interp,
textPtr->sharedTextPtr->bindingTable,
(ClientData) tagPtr->name, Tcl_GetString(objv[4]));
if (command == NULL) {
const char *string = Tcl_GetString(Tcl_GetObjResult(interp));
/*
* Ignore missing binding errors. This is a special hack that
* relies on the error message returned by FindSequence in
* tkBind.c.
*/
if (string[0] != '\0') {
return TCL_ERROR;
}
Tcl_ResetResult(interp);
} else {
Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
}
} else {
Tk_GetAllBindings(interp, textPtr->sharedTextPtr->bindingTable,
(ClientData) tagPtr->name);
}
break;
case TAG_CGET:
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv, "tag cget tagName option");
return TCL_ERROR;
} else {
Tcl_Obj *objPtr;
tagPtr = FindTag(interp, textPtr, objv[3]);
if (tagPtr == NULL) {
return TCL_ERROR;
}
objPtr = Tk_GetOptionValue(interp, (char *) tagPtr,
tagPtr->optionTable, objv[4], textPtr->tkwin);
if (objPtr == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
break;
case TAG_CONFIGURE: {
int newTag;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 3, objv,
"tagName ?-option? ?value? ?-option value ...?");
return TCL_ERROR;
}
tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3]), &newTag);
if (objc <= 5) {
Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) tagPtr,
tagPtr->optionTable,
(objc == 5) ? objv[4] : NULL, textPtr->tkwin);
if (objPtr == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
} else {
int result = TCL_OK;
if (Tk_SetOptions(interp, (char *) tagPtr, tagPtr->optionTable,
objc-4, objv+4, textPtr->tkwin, NULL, NULL) != TCL_OK) {
return TCL_ERROR;
}
/*
* Some of the configuration options, like -underline and
* -justify, require additional translation (this is needed
* because we need to distinguish a particular value of an option
* from "unspecified").
*/
if (tagPtr->borderWidth < 0) {
tagPtr->borderWidth = 0;
}
if (tagPtr->reliefString != NULL) {
if (Tk_GetRelief(interp, tagPtr->reliefString,
&tagPtr->relief) != TCL_OK) {
return TCL_ERROR;
}
}
if (tagPtr->justifyString != NULL) {
if (Tk_GetJustify(interp, tagPtr->justifyString,
&tagPtr->justify) != TCL_OK) {
return TCL_ERROR;
}
}
if (tagPtr->lMargin1String != NULL) {
if (Tk_GetPixels(interp, textPtr->tkwin,
tagPtr->lMargin1String, &tagPtr->lMargin1) != TCL_OK) {
return TCL_ERROR;
}
}
if (tagPtr->lMargin2String != NULL) {
if (Tk_GetPixels(interp, textPtr->tkwin,
tagPtr->lMargin2String, &tagPtr->lMargin2) != TCL_OK) {
return TCL_ERROR;
}
}
if (tagPtr->offsetString != NULL) {
if (Tk_GetPixels(interp, textPtr->tkwin, tagPtr->offsetString,
&tagPtr->offset) != TCL_OK) {
return TCL_ERROR;
}
}
if (tagPtr->overstrikeString != NULL) {
if (Tcl_GetBoolean(interp, tagPtr->overstrikeString,
&tagPtr->overstrike) != TCL_OK) {
return TCL_ERROR;
}
}
if (tagPtr->rMarginString != NULL) {
if (Tk_GetPixels(interp, textPtr->tkwin,
tagPtr->rMarginString, &tagPtr->rMargin) != TCL_OK) {
return TCL_ERROR;
}
}
if (tagPtr->spacing1String != NULL) {
if (Tk_GetPixels(interp, textPtr->tkwin,
tagPtr->spacing1String, &tagPtr->spacing1) != TCL_OK) {
return TCL_ERROR;
}
if (tagPtr->spacing1 < 0) {
tagPtr->spacing1 = 0;
}
}
if (tagPtr->spacing2String != NULL) {
if (Tk_GetPixels(interp, textPtr->tkwin,
tagPtr->spacing2String, &tagPtr->spacing2) != TCL_OK) {
return TCL_ERROR;
}
if (tagPtr->spacing2 < 0) {
tagPtr->spacing2 = 0;
}
}
if (tagPtr->spacing3String != NULL) {
if (Tk_GetPixels(interp, textPtr->tkwin,
tagPtr->spacing3String, &tagPtr->spacing3) != TCL_OK) {
return TCL_ERROR;
}
if (tagPtr->spacing3 < 0) {
tagPtr->spacing3 = 0;
}
}
if (tagPtr->tabArrayPtr != NULL) {
ckfree(tagPtr->tabArrayPtr);
tagPtr->tabArrayPtr = NULL;
}
if (tagPtr->tabStringPtr != NULL) {
tagPtr->tabArrayPtr =
TkTextGetTabs(interp, textPtr, tagPtr->tabStringPtr);
if (tagPtr->tabArrayPtr == NULL) {
return TCL_ERROR;
}
}
if (tagPtr->underlineString != NULL) {
if (Tcl_GetBoolean(interp, tagPtr->underlineString,
&tagPtr->underline) != TCL_OK) {
return TCL_ERROR;
}
}
if (tagPtr->elideString != NULL) {
if (Tcl_GetBoolean(interp, tagPtr->elideString,
&tagPtr->elide) != TCL_OK) {
return TCL_ERROR;
}
/*
* Indices are potentially obsolete after changing -elide,
* especially those computed with "display" or "any"
* submodifier, therefore increase the epoch.
*/
textPtr->sharedTextPtr->stateEpoch++;
}
/*
* If the "sel" tag was changed, be sure to mirror information
* from the tag back into the text widget record. NOTE: we don't
* have to free up information in the widget record before
* overwriting it, because it was mirrored in the tag and hence
* freed when the tag field was overwritten.
*/
if (tagPtr == textPtr->selTagPtr) {
textPtr->selBorder = tagPtr->border;
textPtr->selBorderWidth = tagPtr->borderWidth;
textPtr->selBorderWidthPtr = tagPtr->borderWidthPtr;
textPtr->selFgColorPtr = tagPtr->fgColor;
}
tagPtr->affectsDisplay = 0;
tagPtr->affectsDisplayGeometry = 0;
if ((tagPtr->elideString != NULL)
|| (tagPtr->tkfont != None)
|| (tagPtr->justifyString != NULL)
|| (tagPtr->lMargin1String != NULL)
|| (tagPtr->lMargin2String != NULL)
|| (tagPtr->offsetString != NULL)
|| (tagPtr->rMarginString != NULL)
|| (tagPtr->spacing1String != NULL)
|| (tagPtr->spacing2String != NULL)
|| (tagPtr->spacing3String != NULL)
|| (tagPtr->tabStringPtr != NULL)
|| (tagPtr->tabStyle != TK_TEXT_TABSTYLE_NONE)
|| (tagPtr->wrapMode != TEXT_WRAPMODE_NULL)) {
tagPtr->affectsDisplay = 1;
tagPtr->affectsDisplayGeometry = 1;
}
if ((tagPtr->border != NULL)
|| (tagPtr->reliefString != NULL)
|| (tagPtr->bgStipple != None)
|| (tagPtr->fgColor != NULL)
|| (tagPtr->fgStipple != None)
|| (tagPtr->overstrikeString != NULL)
|| (tagPtr->underlineString != NULL)) {
tagPtr->affectsDisplay = 1;
}
if (!newTag) {
/*
* This line is not necessary if this is a new tag, since it
* can't possibly have been applied to anything yet.
*/
/*
* VMD: If this is the 'sel' tag, then we don't need to call
* this for all peers, unless we actually want to synchronize
* sel-style changes across the peers.
*/
TkTextRedrawTag(textPtr->sharedTextPtr, NULL,
NULL, NULL, tagPtr, 1);
}
return result;
}
break;
}
case TAG_DELETE: {
Tcl_HashEntry *hPtr;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 3, objv, "tagName ?tagName ...?");
return TCL_ERROR;
}
for (i = 3; i < objc; i++) {
hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->tagTable,
Tcl_GetString(objv[i]));
if (hPtr == NULL) {
/*
* Either this tag doesn't exist or it's the 'sel' tag (which
* is not in the hash table). Either way we don't want to
* delete it.
*/
continue;
}
tagPtr = Tcl_GetHashValue(hPtr);
if (tagPtr == textPtr->selTagPtr) {
continue;
}
if (tagPtr->affectsDisplay) {
TkTextRedrawTag(textPtr->sharedTextPtr, NULL,
NULL, NULL, tagPtr, 1);
}
TkTextDeleteTag(textPtr, tagPtr);
Tcl_DeleteHashEntry(hPtr);
}
break;
}
case TAG_LOWER: {
TkTextTag *tagPtr2;
int prio;
if ((objc != 4) && (objc != 5)) {
Tcl_WrongNumArgs(interp, 3, objv, "tagName ?belowThis?");
return TCL_ERROR;
}
tagPtr = FindTag(interp, textPtr, objv[3]);
if (tagPtr == NULL) {
return TCL_ERROR;
}
if (objc == 5) {
tagPtr2 = FindTag(interp, textPtr, objv[4]);
if (tagPtr2 == NULL) {
return TCL_ERROR;
}
if (tagPtr->priority < tagPtr2->priority) {
prio = tagPtr2->priority - 1;
} else {
prio = tagPtr2->priority;
}
} else {
prio = 0;
}
ChangeTagPriority(textPtr, tagPtr, prio);
/*
* If this is the 'sel' tag, then we don't actually need to call this
* for all peers.
*/
TkTextRedrawTag(textPtr->sharedTextPtr, NULL, NULL, NULL, tagPtr, 1);
break;
}
case TAG_NAMES: {
TkTextTag **arrayPtr;
int arraySize;
Tcl_Obj *listObj;
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 3, objv, "?index?");
return TCL_ERROR;
}
if (objc == 3) {
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
arrayPtr = ckalloc(textPtr->sharedTextPtr->numTags
* sizeof(TkTextTag *));
for (i=0, hPtr = Tcl_FirstHashEntry(
&textPtr->sharedTextPtr->tagTable, &search);
hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) {
arrayPtr[i] = Tcl_GetHashValue(hPtr);
}
/*
* The 'sel' tag is not in the hash table.
*/
arrayPtr[i] = textPtr->selTagPtr;
arraySize = ++i;
} else {
if (TkTextGetObjIndex(interp, textPtr, objv[3],
&index1) != TCL_OK) {
return TCL_ERROR;
}
arrayPtr = TkBTreeGetTags(&index1, textPtr, &arraySize);
if (arrayPtr == NULL) {
return TCL_OK;
}
}
SortTags(arraySize, arrayPtr);
listObj = Tcl_NewListObj(0, NULL);
for (i = 0; i < arraySize; i++) {
tagPtr = arrayPtr[i];
Tcl_ListObjAppendElement(interp, listObj,
Tcl_NewStringObj(tagPtr->name,-1));
}
Tcl_SetObjResult(interp, listObj);
ckfree(arrayPtr);
break;
}
case TAG_NEXTRANGE: {
TkTextIndex last;
TkTextSearch tSearch;
char position[TK_POS_CHARS];
Tcl_Obj *resultObj;
if ((objc != 5) && (objc != 6)) {
Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?");
return TCL_ERROR;
}
tagPtr = FindTag(NULL, textPtr, objv[3]);
if (tagPtr == NULL) {
return TCL_OK;
}
if (TkTextGetObjIndex(interp, textPtr, objv[4], &index1) != TCL_OK) {
return TCL_ERROR;
}
TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
0, &last);
if (objc == 5) {
index2 = last;
} else if (TkTextGetObjIndex(interp, textPtr, objv[5],
&index2) != TCL_OK) {
return TCL_ERROR;
}
/*
* The search below is a bit tricky. Rather than use the B-tree
* facilities to stop the search at index2, let it search up until the
* end of the file but check for a position past index2 ourselves.
* The reason for doing it this way is that we only care whether the
* *start* of the range is before index2; once we find the start, we
* don't want TkBTreeNextTag to abort the search because the end of
* the range is after index2.
*/
TkBTreeStartSearch(&index1, &last, tagPtr, &tSearch);
if (TkBTreeCharTagged(&index1, tagPtr)) {
TkTextSegment *segPtr;
int offset;
/*
* The first character is tagged. See if there is an on-toggle
* just before the character. If not, then skip to the end of this
* tagged range.
*/
for (segPtr = index1.linePtr->segPtr, offset = index1.byteIndex;
offset >= 0;
offset -= segPtr->size, segPtr = segPtr->nextPtr) {
if ((offset == 0) && (segPtr->typePtr == &tkTextToggleOnType)
&& (segPtr->body.toggle.tagPtr == tagPtr)) {
goto gotStart;
}
}
if (!TkBTreeNextTag(&tSearch)) {
return TCL_OK;
}
}
/*
* Find the start of the tagged range.
*/
if (!TkBTreeNextTag(&tSearch)) {
return TCL_OK;
}
gotStart:
if (TkTextIndexCmp(&tSearch.curIndex, &index2) >= 0) {
return TCL_OK;
}
resultObj = Tcl_NewObj();
TkTextPrintIndex(textPtr, &tSearch.curIndex, position);
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(position, -1));
TkBTreeNextTag(&tSearch);
TkTextPrintIndex(textPtr, &tSearch.curIndex, position);
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(position, -1));
Tcl_SetObjResult(interp, resultObj);
break;
}
case TAG_PREVRANGE: {
TkTextIndex last;
TkTextSearch tSearch;
char position1[TK_POS_CHARS];
char position2[TK_POS_CHARS];
Tcl_Obj *resultObj;
if ((objc != 5) && (objc != 6)) {
Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?");
return TCL_ERROR;
}
tagPtr = FindTag(NULL, textPtr, objv[3]);
if (tagPtr == NULL) {
return TCL_OK;
}
if (TkTextGetObjIndex(interp, textPtr, objv[4], &index1) != TCL_OK) {
return TCL_ERROR;
}
if (objc == 5) {
TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
&index2);
} else if (TkTextGetObjIndex(interp, textPtr, objv[5],
&index2) != TCL_OK) {
return TCL_ERROR;
}
/*
* The search below is a bit weird. The previous toggle can be either
* an on or off toggle. If it is an on toggle, then we need to turn
* around and search forward for the end toggle. Otherwise we keep
* searching backwards.
*/
TkBTreeStartSearchBack(&index1, &index2, tagPtr, &tSearch);
if (!TkBTreePrevTag(&tSearch)) {
/*
* Special case, there may be a tag off toggle at index1, and a
* tag on toggle before the start of a partial peer widget. In
* this case we missed it.
*/
if (textPtr->start != NULL && (textPtr->start == index2.linePtr)
&& (index2.byteIndex == 0)
&& TkBTreeCharTagged(&index2, tagPtr)
&& (TkTextIndexCmp(&index2, &index1) < 0)) {
/*
* The first character is tagged, so just add the range from
* the first char to the start of the range.
*/
TkTextPrintIndex(textPtr, &index2, position1);
TkTextPrintIndex(textPtr, &index1, position2);
goto gotPrevIndexPair;
}
return TCL_OK;
}
if (tSearch.segPtr->typePtr == &tkTextToggleOnType) {
TkTextPrintIndex(textPtr, &tSearch.curIndex, position1);
if (textPtr->start != NULL) {
/*
* Make sure the first index is not before the first allowed
* text index in this widget.
*/
TkTextIndex firstIndex;
firstIndex.linePtr = textPtr->start;
firstIndex.byteIndex = 0;
firstIndex.textPtr = NULL;
if (TkTextIndexCmp(&tSearch.curIndex, &firstIndex) < 0) {
if (TkTextIndexCmp(&firstIndex, &index1) >= 0) {
/*
* But now the new first index is actually too far
* along in the text, so nothing is returned.
*/
return TCL_OK;
}
TkTextPrintIndex(textPtr, &firstIndex, position1);
}
}
TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
0, &last);
TkBTreeStartSearch(&tSearch.curIndex, &last, tagPtr, &tSearch);
TkBTreeNextTag(&tSearch);
TkTextPrintIndex(textPtr, &tSearch.curIndex, position2);
} else {
TkTextPrintIndex(textPtr, &tSearch.curIndex, position2);
TkBTreePrevTag(&tSearch);
TkTextPrintIndex(textPtr, &tSearch.curIndex, position1);
if (TkTextIndexCmp(&tSearch.curIndex, &index2) < 0) {
if (textPtr->start != NULL && index2.linePtr == textPtr->start
&& index2.byteIndex == 0) {
/* It's ok */
TkTextPrintIndex(textPtr, &index2, position1);
} else {
return TCL_OK;
}
}
}
gotPrevIndexPair:
resultObj = Tcl_NewObj();
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(position1, -1));
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(position2, -1));
Tcl_SetObjResult(interp, resultObj);
break;
}
case TAG_RAISE: {
TkTextTag *tagPtr2;
int prio;
if ((objc != 4) && (objc != 5)) {
Tcl_WrongNumArgs(interp, 3, objv, "tagName ?aboveThis?");
return TCL_ERROR;
}
tagPtr = FindTag(interp, textPtr, objv[3]);
if (tagPtr == NULL) {
return TCL_ERROR;
}
if (objc == 5) {
tagPtr2 = FindTag(interp, textPtr, objv[4]);
if (tagPtr2 == NULL) {
return TCL_ERROR;
}
if (tagPtr->priority <= tagPtr2->priority) {
prio = tagPtr2->priority;
} else {
prio = tagPtr2->priority + 1;
}
} else {
prio = textPtr->sharedTextPtr->numTags-1;
}
ChangeTagPriority(textPtr, tagPtr, prio);
/*
* If this is the 'sel' tag, then we don't actually need to call this
* for all peers.
*/
TkTextRedrawTag(textPtr->sharedTextPtr, NULL, NULL, NULL, tagPtr, 1);
break;
}
case TAG_RANGES: {
TkTextIndex first, last;
TkTextSearch tSearch;
Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);
int count = 0;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 3, objv, "tagName");
return TCL_ERROR;
}
tagPtr = FindTag(NULL, textPtr, objv[3]);
if (tagPtr == NULL) {
return TCL_OK;
}
TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
&first);
TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
0, &last);
TkBTreeStartSearch(&first, &last, tagPtr, &tSearch);
if (TkBTreeCharTagged(&first, tagPtr)) {
Tcl_ListObjAppendElement(NULL, listObj,
TkTextNewIndexObj(textPtr, &first));
count++;
}
while (TkBTreeNextTag(&tSearch)) {
Tcl_ListObjAppendElement(NULL, listObj,
TkTextNewIndexObj(textPtr, &tSearch.curIndex));
count++;
}
if (count % 2 == 1) {
/*
* If a text widget uses '-end', it won't necessarily run to the
* end of the B-tree, and therefore the tag range might not be
* closed. In this case we add the end of the range.
*/
Tcl_ListObjAppendElement(NULL, listObj,
TkTextNewIndexObj(textPtr, &last));
}
Tcl_SetObjResult(interp, listObj);
break;
}
}
return TCL_OK;
}
static int
ConfigureMenuButton(
Tcl_Interp *interp, /* Used for error reporting. */
register TkMenuButton *mbPtr,
/* 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[]) /* Arguments. */
{
Tk_SavedOptions savedOptions;
Tcl_Obj *errorResult = NULL;
int error;
Tk_Image image;
/*
* Eliminate any existing trace on variables monitored by the menubutton.
*/
if (mbPtr->textVarName != NULL) {
Tcl_UntraceVar(interp, mbPtr->textVarName,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
MenuButtonTextVarProc, mbPtr);
}
/*
* The following loop is potentially executed twice. During the first pass
* configuration options get set to their new values. If there is an error
* in this pass, we execute a second pass to restore all the options to
* their previous values.
*/
for (error = 0; error <= 1; error++) {
if (!error) {
/*
* First pass: set options to new values.
*/
if (Tk_SetOptions(interp, (char *) mbPtr,
mbPtr->optionTable, objc, objv,
mbPtr->tkwin, &savedOptions, NULL) != TCL_OK) {
continue;
}
} else {
/*
* Second pass: restore options to old values.
*/
errorResult = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(errorResult);
Tk_RestoreSavedOptions(&savedOptions);
}
/*
* A few options need special processing, such as setting the
* background from a 3-D border, or filling in complicated defaults
* that couldn't be specified to Tk_SetOptions.
*/
if ((mbPtr->state == STATE_ACTIVE)
&& !Tk_StrictMotif(mbPtr->tkwin)) {
Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->activeBorder);
} else {
Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->normalBorder);
}
if (mbPtr->highlightWidth < 0) {
mbPtr->highlightWidth = 0;
}
if (mbPtr->padX < 0) {
mbPtr->padX = 0;
}
if (mbPtr->padY < 0) {
mbPtr->padY = 0;
}
/*
* Get the image for the widget, if there is one. Allocate the new
* image before freeing the old one, so that the reference count
* doesn't go to zero and cause image data to be discarded.
*/
if (mbPtr->imageString != NULL) {
image = Tk_GetImage(mbPtr->interp, mbPtr->tkwin,
mbPtr->imageString, MenuButtonImageProc, mbPtr);
if (image == NULL) {
return TCL_ERROR;
}
} else {
image = NULL;
}
if (mbPtr->image != NULL) {
Tk_FreeImage(mbPtr->image);
}
mbPtr->image = image;
/*
* Recompute the geometry for the button.
*/
if ((mbPtr->bitmap != None) || (mbPtr->image != NULL)) {
if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->widthString,
&mbPtr->width) != TCL_OK) {
widthError:
Tcl_AddErrorInfo(interp, "\n (processing -width option)");
continue;
}
if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->heightString,
&mbPtr->height) != TCL_OK) {
heightError:
Tcl_AddErrorInfo(interp, "\n (processing -height option)");
continue;
}
} else {
if (Tcl_GetInt(interp, mbPtr->widthString, &mbPtr->width)
!= TCL_OK) {
goto widthError;
}
if (Tcl_GetInt(interp, mbPtr->heightString, &mbPtr->height)
!= TCL_OK) {
goto heightError;
}
}
break;
}
if (!error) {
Tk_FreeSavedOptions(&savedOptions);
}
if (mbPtr->textVarName != NULL) {
/*
* If no image or -compound is used, display the value of a variable.
* Set up a trace to watch for any changes in it, create the variable
* if it doesn't exist, and fetch its current value.
*/
const char *value;
value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY);
if (value == NULL) {
Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text,
TCL_GLOBAL_ONLY);
} else {
if (mbPtr->text != NULL) {
ckfree(mbPtr->text);
}
mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
strcpy(mbPtr->text, value);
}
Tcl_TraceVar(interp, mbPtr->textVarName,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
MenuButtonTextVarProc, mbPtr);
}
TkMenuButtonWorldChanged(mbPtr);
if (error) {
Tcl_SetObjResult(interp, errorResult);
Tcl_DecrRefCount(errorResult);
return TCL_ERROR;
}
return TCL_OK;
}
