static int
DoConfig(
Tcl_Interp *interp, /* Interpreter for error reporting. */
Tk_Window tkwin, /* Window containing widget (needed to set up
* X resources). */
Tk_ConfigSpec *specPtr, /* Specifier to apply. */
Tk_Uid value, /* Value to use to fill in widgRec. */
int valueIsUid, /* Non-zero means value is a Tk_Uid; zero
* means it's an ordinary string. */
char *widgRec) /* Record whose fields are to be modified.
* Values must be properly initialized. */
{
char *ptr;
Tk_Uid uid;
int nullValue;
nullValue = 0;
if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) {
nullValue = 1;
}
do {
ptr = widgRec + specPtr->offset;
switch (specPtr->type) {
case TK_CONFIG_BOOLEAN:
if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) {
return TCL_ERROR;
}
break;
case TK_CONFIG_INT:
if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) {
return TCL_ERROR;
}
break;
case TK_CONFIG_DOUBLE:
if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) {
return TCL_ERROR;
}
break;
case TK_CONFIG_STRING: {
char *oldStr, *newStr;
if (nullValue) {
newStr = NULL;
} else {
newStr = (char *) ckalloc((unsigned) (strlen(value) + 1));
strcpy(newStr, value);
}
oldStr = *((char **) ptr);
if (oldStr != NULL) {
ckfree(oldStr);
}
*((char **) ptr) = newStr;
break;
}
case TK_CONFIG_UID:
if (nullValue) {
*((Tk_Uid *) ptr) = NULL;
} else {
uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
*((Tk_Uid *) ptr) = uid;
}
break;
case TK_CONFIG_COLOR: {
XColor *newPtr, *oldPtr;
if (nullValue) {
newPtr = NULL;
} else {
uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
newPtr = Tk_GetColor(interp, tkwin, uid);
if (newPtr == NULL) {
return TCL_ERROR;
}
}
oldPtr = *((XColor **) ptr);
if (oldPtr != NULL) {
Tk_FreeColor(oldPtr);
}
*((XColor **) ptr) = newPtr;
break;
}
case TK_CONFIG_FONT: {
Tk_Font newFont;
if (nullValue) {
newFont = NULL;
} else {
newFont = Tk_GetFont(interp, tkwin, value);
if (newFont == NULL) {
return TCL_ERROR;
}
}
Tk_FreeFont(*((Tk_Font *) ptr));
*((Tk_Font *) ptr) = newFont;
break;
}
case TK_CONFIG_BITMAP: {
Pixmap newBmp, oldBmp;
if (nullValue) {
newBmp = None;
} else {
uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
newBmp = Tk_GetBitmap(interp, tkwin, uid);
if (newBmp == None) {
return TCL_ERROR;
}
}
oldBmp = *((Pixmap *) ptr);
if (oldBmp != None) {
Tk_FreeBitmap(Tk_Display(tkwin), oldBmp);
}
*((Pixmap *) ptr) = newBmp;
break;
}
case TK_CONFIG_BORDER: {
Tk_3DBorder newBorder, oldBorder;
if (nullValue) {
newBorder = NULL;
} else {
uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
newBorder = Tk_Get3DBorder(interp, tkwin, uid);
if (newBorder == NULL) {
return TCL_ERROR;
}
}
oldBorder = *((Tk_3DBorder *) ptr);
if (oldBorder != NULL) {
Tk_Free3DBorder(oldBorder);
}
*((Tk_3DBorder *) ptr) = newBorder;
break;
}
case TK_CONFIG_RELIEF:
uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) {
return TCL_ERROR;
}
break;
case TK_CONFIG_CURSOR:
case TK_CONFIG_ACTIVE_CURSOR: {
Tk_Cursor newCursor, oldCursor;
if (nullValue) {
newCursor = None;
} else {
uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
newCursor = Tk_GetCursor(interp, tkwin, uid);
if (newCursor == None) {
return TCL_ERROR;
}
}
oldCursor = *((Tk_Cursor *) ptr);
if (oldCursor != None) {
Tk_FreeCursor(Tk_Display(tkwin), oldCursor);
}
*((Tk_Cursor *) ptr) = newCursor;
if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) {
Tk_DefineCursor(tkwin, newCursor);
}
break;
}
case TK_CONFIG_JUSTIFY:
uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) {
return TCL_ERROR;
}
break;
case TK_CONFIG_ANCHOR:
uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) {
return TCL_ERROR;
}
break;
case TK_CONFIG_CAP_STYLE:
uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) {
return TCL_ERROR;
}
break;
case TK_CONFIG_JOIN_STYLE:
uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) {
return TCL_ERROR;
}
break;
case TK_CONFIG_PIXELS:
if (Tk_GetPixels(interp, tkwin, value, (int *) ptr)
!= TCL_OK) {
return TCL_ERROR;
}
break;
case TK_CONFIG_MM:
if (Tk_GetScreenMM(interp, tkwin, value, (double*)ptr) != TCL_OK) {
return TCL_ERROR;
}
break;
case TK_CONFIG_WINDOW: {
Tk_Window tkwin2;
if (nullValue) {
tkwin2 = NULL;
} else {
tkwin2 = Tk_NameToWindow(interp, value, tkwin);
if (tkwin2 == NULL) {
return TCL_ERROR;
}
}
*((Tk_Window *) ptr) = tkwin2;
break;
}
case TK_CONFIG_CUSTOM:
if ((*specPtr->customPtr->parseProc)(
specPtr->customPtr->clientData, interp, tkwin, value,
widgRec, specPtr->offset) != TCL_OK) {
return TCL_ERROR;
}
break;
default: {
char buf[64 + TCL_INTEGER_SPACE];
sprintf(buf, "bad config table: unknown type %d", specPtr->type);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_ERROR;
}
}
specPtr++;
} while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END));
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;
}