path: root/generic/tkText.c

/*
 * tkText.c --
 *
 *	This module provides a big chunk of the implementation of multi-line
 *	editable text widgets for Tk. Among other things, it provides the Tcl
 *	command interfaces to text widgets. The B-tree representation of text
 *	and its actual display are implemented elsewhere.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "default.h"
#include "tkInt.h"
#include "tkUndo.h"

#if defined(MAC_OSX_TK)
#define Style TkStyle
#define DInfo TkDInfo
#endif

/*
 * For compatibility with Tk 4.0 through 8.4.x, we allow tabs to be
 * mis-specified with non-increasing values. These are converted into tabs
 * which are the equivalent of at least a character width apart.
 */

#if (TK_MAJOR_VERSION < 9)
#define _TK_ALLOW_DECREASING_TABS
#endif

#include "tkText.h"

/*
 * Used to avoid having to allocate and deallocate arrays on the fly for
 * commonly used functions. Must be > 0.
 */

#define PIXEL_CLIENTS 5

/*
 * The 'TkTextState' enum in tkText.h is used to define a type for the -state
 * option of the Text widget. These values are used as indices into the string
 * table below.
 */

static const char *const stateStrings[] = {
    "disabled", "normal", NULL
};

/*
 * The 'TkWrapMode' enum in tkText.h is used to define a type for the -wrap
 * option of the Text widget. These values are used as indices into the string
 * table below.
 */

static const char *const wrapStrings[] = {
    "char", "none", "word", NULL
};

/*
 * The 'TkTextTabStyle' enum in tkText.h is used to define a type for the
 * -tabstyle option of the Text widget. These values are used as indices into
 * the string table below.
 */

static const char *const tabStyleStrings[] = {
    "tabular", "wordprocessor", NULL
};

/*
 * The 'TkTextInsertUnfocussed' enum in tkText.h is used to define a type for
 * the -insertunfocussed option of the Text widget. These values are used as
 * indice into the string table below.
 */

static const char *const insertUnfocussedStrings[] = {
    "hollow", "none", "solid", NULL
};

/*
 * The following functions and custom option type are used to define the
 * "line" option type, and thereby handle the text widget '-startline',
 * '-endline' configuration options which are of that type.
 *
 * We do not need a 'freeProc' because all changes to these two options are
 * handled through the TK_TEXT_LINE_RANGE flag in the optionSpecs list, and
 * the internal storage is just a pointer, which therefore doesn't need
 * freeing.
 */

static int		SetLineStartEnd(ClientData clientData,
			    Tcl_Interp *interp, Tk_Window tkwin,
			    Tcl_Obj **value, char *recordPtr,
			    int internalOffset, char *oldInternalPtr,
			    int flags);
static Tcl_Obj *	GetLineStartEnd(ClientData clientData,
			    Tk_Window tkwin, char *recordPtr,
			    int internalOffset);
static void		RestoreLineStartEnd(ClientData clientData,
			    Tk_Window tkwin, char *internalPtr,
			    char *oldInternalPtr);
static int		ObjectIsEmpty(Tcl_Obj *objPtr);

static const Tk_ObjCustomOption lineOption = {
    "line",			/* name */
    SetLineStartEnd,		/* setProc */
    GetLineStartEnd,		/* getProc */
    RestoreLineStartEnd,	/* restoreProc */
    NULL,			/* freeProc */
    0
};

/*
 * Information used to parse text configuration options:
 */

static const Tk_OptionSpec optionSpecs[] = {
    {TK_OPTION_BOOLEAN, "-autoseparators", "autoSeparators",
	"AutoSeparators", DEF_TEXT_AUTO_SEPARATORS, -1,
	Tk_Offset(TkText, autoSeparators), 0, 0, 0},
    {TK_OPTION_BORDER, "-background", "background", "Background",
	DEF_TEXT_BG_COLOR, -1, Tk_Offset(TkText, border),
	0, DEF_TEXT_BG_MONO, 0},
    {TK_OPTION_SYNONYM, "-bd", NULL, NULL,
	NULL, 0, -1, 0, "-borderwidth",
	TK_TEXT_LINE_GEOMETRY},
    {TK_OPTION_SYNONYM, "-bg", NULL, NULL,
	NULL, 0, -1, 0, "-background", 0},
    {TK_OPTION_BOOLEAN, "-blockcursor", "blockCursor",
	"BlockCursor", DEF_TEXT_BLOCK_CURSOR, -1,
	Tk_Offset(TkText, insertCursorType), 0, 0, 0},
    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_TEXT_BORDER_WIDTH, -1, Tk_Offset(TkText, borderWidth),
	0, 0, TK_TEXT_LINE_GEOMETRY},
    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_TEXT_CURSOR, -1, Tk_Offset(TkText, cursor),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_CUSTOM, "-endline", NULL, NULL,
	 NULL, -1, Tk_Offset(TkText, end), TK_OPTION_NULL_OK,
	 &lineOption, TK_TEXT_LINE_RANGE},
    {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
	"ExportSelection", DEF_TEXT_EXPORT_SELECTION, -1,
	Tk_Offset(TkText, exportSelection), 0, 0, 0},
    {TK_OPTION_SYNONYM, "-fg", "foreground", NULL,
	NULL, 0, -1, 0, "-foreground", 0},
    {TK_OPTION_FONT, "-font", "font", "Font",
	DEF_TEXT_FONT, -1, Tk_Offset(TkText, tkfont), 0, 0,
	TK_TEXT_LINE_GEOMETRY},
    {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
	DEF_TEXT_FG, -1, Tk_Offset(TkText, fgColor), 0,
	0, 0},
    {TK_OPTION_PIXELS, "-height", "height", "Height",
	DEF_TEXT_HEIGHT, -1, Tk_Offset(TkText, height), 0, 0, 0},
    {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
	"HighlightBackground", DEF_TEXT_HIGHLIGHT_BG,
	-1, Tk_Offset(TkText, highlightBgColorPtr),
	0, 0, 0},
    {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	DEF_TEXT_HIGHLIGHT, -1, Tk_Offset(TkText, highlightColorPtr),
	0, 0, 0},
    {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness", DEF_TEXT_HIGHLIGHT_WIDTH, -1,
	Tk_Offset(TkText, highlightWidth), 0, 0, TK_TEXT_LINE_GEOMETRY},
    {TK_OPTION_BORDER, "-inactiveselectbackground","inactiveSelectBackground",
	"Foreground",
	DEF_TEXT_INACTIVE_SELECT_COLOR,
	-1, Tk_Offset(TkText, inactiveSelBorder),
	TK_OPTION_NULL_OK, DEF_TEXT_SELECT_MONO, 0},
    {TK_OPTION_BORDER, "-insertbackground", "insertBackground", "Foreground",
	DEF_TEXT_INSERT_BG,
	-1, Tk_Offset(TkText, insertBorder),
	0, 0, 0},
    {TK_OPTION_PIXELS, "-insertborderwidth", "insertBorderWidth",
	"BorderWidth", DEF_TEXT_INSERT_BD_COLOR, -1,
	Tk_Offset(TkText, insertBorderWidth), 0,
	(ClientData) DEF_TEXT_INSERT_BD_MONO, 0},
    {TK_OPTION_INT, "-insertofftime", "insertOffTime", "OffTime",
	DEF_TEXT_INSERT_OFF_TIME, -1, Tk_Offset(TkText, insertOffTime),
	0, 0, 0},
    {TK_OPTION_INT, "-insertontime", "insertOnTime", "OnTime",
	DEF_TEXT_INSERT_ON_TIME, -1, Tk_Offset(TkText, insertOnTime),
	0, 0, 0},
    {TK_OPTION_STRING_TABLE,
	"-insertunfocussed", "insertUnfocussed", "InsertUnfocussed",
	DEF_TEXT_INSERT_UNFOCUSSED, -1, Tk_Offset(TkText, insertUnfocussed),
	0, insertUnfocussedStrings, 0},
    {TK_OPTION_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
	DEF_TEXT_INSERT_WIDTH, -1, Tk_Offset(TkText, insertWidth),
	0, 0, 0},
    {TK_OPTION_INT, "-maxundo", "maxUndo", "MaxUndo",
	DEF_TEXT_MAX_UNDO, -1, Tk_Offset(TkText, maxUndo), 0, 0, 0},
    {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
	DEF_TEXT_PADX, -1, Tk_Offset(TkText, padX), 0, 0,
	TK_TEXT_LINE_GEOMETRY},
    {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
	DEF_TEXT_PADY, -1, Tk_Offset(TkText, padY), 0, 0, 0},
    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
	DEF_TEXT_RELIEF, -1, Tk_Offset(TkText, relief), 0, 0, 0},
    {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
	DEF_TEXT_SELECT_COLOR, -1, Tk_Offset(TkText, selBorder),
	0, DEF_TEXT_SELECT_MONO, 0},
    {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth",
	"BorderWidth", DEF_TEXT_SELECT_BD_COLOR,
	Tk_Offset(TkText, selBorderWidthPtr),
	Tk_Offset(TkText, selBorderWidth),
	TK_OPTION_NULL_OK, DEF_TEXT_SELECT_BD_MONO, 0},
    {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
	DEF_TEXT_SELECT_FG_COLOR, -1, Tk_Offset(TkText, selFgColorPtr),
	TK_CONFIG_NULL_OK, DEF_TEXT_SELECT_FG_MONO, 0},
    {TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
	DEF_TEXT_SET_GRID, -1, Tk_Offset(TkText, setGrid), 0, 0, 0},
    {TK_OPTION_PIXELS, "-spacing1", "spacing1", "Spacing",
	DEF_TEXT_SPACING1, -1, Tk_Offset(TkText, spacing1),
	TK_OPTION_DONT_SET_DEFAULT, 0 , TK_TEXT_LINE_GEOMETRY },
    {TK_OPTION_PIXELS, "-spacing2", "spacing2", "Spacing",
	DEF_TEXT_SPACING2, -1, Tk_Offset(TkText, spacing2),
	TK_OPTION_DONT_SET_DEFAULT, 0 , TK_TEXT_LINE_GEOMETRY },
    {TK_OPTION_PIXELS, "-spacing3", "spacing3", "Spacing",
	DEF_TEXT_SPACING3, -1, Tk_Offset(TkText, spacing3),
	TK_OPTION_DONT_SET_DEFAULT, 0 , TK_TEXT_LINE_GEOMETRY },
    {TK_OPTION_CUSTOM, "-startline", NULL, NULL,
	 NULL, -1, Tk_Offset(TkText, start), TK_OPTION_NULL_OK,
	 &lineOption, TK_TEXT_LINE_RANGE},
    {TK_OPTION_STRING_TABLE, "-state", "state", "State",
	DEF_TEXT_STATE, -1, Tk_Offset(TkText, state),
	0, stateStrings, 0},
    {TK_OPTION_STRING, "-tabs", "tabs", "Tabs",
	DEF_TEXT_TABS, Tk_Offset(TkText, tabOptionPtr), -1,
	TK_OPTION_NULL_OK, 0, TK_TEXT_LINE_GEOMETRY},
    {TK_OPTION_STRING_TABLE, "-tabstyle", "tabStyle", "TabStyle",
	DEF_TEXT_TABSTYLE, -1, Tk_Offset(TkText, tabStyle),
	0, tabStyleStrings, TK_TEXT_LINE_GEOMETRY},
    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_TEXT_TAKE_FOCUS, -1, Tk_Offset(TkText, takeFocus),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_BOOLEAN, "-undo", "undo", "Undo",
	DEF_TEXT_UNDO, -1, Tk_Offset(TkText, undo), 0, 0 , 0},
    {TK_OPTION_INT, "-width", "width", "Width",
	DEF_TEXT_WIDTH, -1, Tk_Offset(TkText, width), 0, 0,
	TK_TEXT_LINE_GEOMETRY},
    {TK_OPTION_STRING_TABLE, "-wrap", "wrap", "Wrap",
	DEF_TEXT_WRAP, -1, Tk_Offset(TkText, wrapMode),
	0, wrapStrings, TK_TEXT_LINE_GEOMETRY},
    {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
	DEF_TEXT_XSCROLL_COMMAND, -1, Tk_Offset(TkText, xScrollCmd),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
	DEF_TEXT_YSCROLL_COMMAND, -1, Tk_Offset(TkText, yScrollCmd),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, 0, 0}
};

/*
 * These three typedefs, the structure and the SearchPerform, SearchCore
 * functions below are used for line-based searches of the text widget, and,
 * in particular, to handle multi-line matching even though the text widget is
 * a single-line based data structure. They are completely abstracted away
 * from the Text widget internals, however, so could easily be re-used with
 * any line-based entity to provide multi-line matching.
 *
 * We have abstracted this code away from the text widget to try to keep Tk as
 * modular as possible.
 */

struct SearchSpec;	/* Forward declaration. */

typedef ClientData	SearchAddLineProc(int lineNum,
			    struct SearchSpec *searchSpecPtr,
			    Tcl_Obj *theLine, int *lenPtr,
			    int *extraLinesPtr);
typedef int		SearchMatchProc(int lineNum,
			    struct SearchSpec *searchSpecPtr,
			    ClientData clientData, Tcl_Obj *theLine,
			    int matchOffset, int matchLength);
typedef int		SearchLineIndexProc(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, struct SearchSpec *searchSpecPtr,
			    int *linePosPtr, int *offsetPosPtr);

typedef struct SearchSpec {
    int exact;			/* Whether search is exact or regexp. */
    int noCase;			/* Case-insenstivive? */
    int noLineStop;		/* If not set, a regexp search will use the
				 * TCL_REG_NLSTOP flag. */
    int overlap;		/* If set, results from multiple searches
				 * (-all) are allowed to overlap each
				 * other. */
    int strictLimits;		/* If set, matches must be completely inside
				 * the from,to range. Otherwise the limits
				 * only apply to the start of each match. */
    int all;			/* Whether all or the first match should be
				 * reported. */
    int startLine;		/* First line to examine. */
    int startOffset;		/* Index in first line to start at. */
    int stopLine;		/* Last line to examine, or -1 when we search
				 * all available text. */
    int stopOffset;		/* Index to stop at, provided stopLine is not
				 * -1. */
    int numLines;		/* Total lines which are available. */
    int backwards;		/* Searching forwards or backwards. */
    Tcl_Obj *varPtr;		/* If non-NULL, store length(s) of match(es)
				 * in this variable. */
    Tcl_Obj *countPtr;		/* Keeps track of currently found lengths. */
    Tcl_Obj *resPtr;		/* Keeps track of currently found locations */
    int searchElide;		/* Search in hidden text as well. */
    SearchAddLineProc *addLineProc;
				/* Function to call when we need to add
				 * another line to the search string so far */
    SearchMatchProc *foundMatchProc;
				/* Function to call when we have found a
				 * match. */
    SearchLineIndexProc *lineIndexProc;
				/* Function to call when we have found a
				 * match. */
    ClientData clientData;	/* Information about structure being searched,
				 * in this case a text widget. */
} SearchSpec;

/*
 * The text-widget-independent functions which actually perform the search,
 * handling both regexp and exact searches.
 */

static int		SearchCore(Tcl_Interp *interp,
			    SearchSpec *searchSpecPtr, Tcl_Obj *patObj);
static int		SearchPerform(Tcl_Interp *interp,
			    SearchSpec *searchSpecPtr, Tcl_Obj *patObj,
			    Tcl_Obj *fromPtr, Tcl_Obj *toPtr);

/*
 * Boolean variable indicating whether or not special debugging code should be
 * executed.
 */

int tkTextDebug = 0;

/*
 * Forward declarations for functions defined later in this file:
 */

static int		ConfigureText(Tcl_Interp *interp,
			    TkText *textPtr, int objc, Tcl_Obj *const objv[]);
static int		DeleteIndexRange(TkSharedText *sharedPtr,
			    TkText *textPtr, const TkTextIndex *indexPtr1,
			    const TkTextIndex *indexPtr2, int viewUpdate);
static int		CountIndices(const TkText *textPtr,
			    const TkTextIndex *indexPtr1,
			    const TkTextIndex *indexPtr2,
			    TkTextCountType type);
static void		DestroyText(TkText *textPtr);
static int		InsertChars(TkSharedText *sharedTextPtr,
			    TkText *textPtr, TkTextIndex *indexPtr,
			    Tcl_Obj *stringPtr, int viewUpdate);
static void		TextBlinkProc(ClientData clientData);
static void		TextCmdDeletedProc(ClientData clientData);
static int		CreateWidget(TkSharedText *sharedPtr, Tk_Window tkwin,
			    Tcl_Interp *interp, const TkText *parent,
			    int objc, Tcl_Obj *const objv[]);
static void		TextEventProc(ClientData clientData,
			    XEvent *eventPtr);
static int		TextFetchSelection(ClientData clientData, int offset,
			    char *buffer, int maxBytes);
static int		TextIndexSortProc(const void *first,
			    const void *second);
static int		TextInsertCmd(TkSharedText *sharedTextPtr,
			    TkText *textPtr, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[],
			    const TkTextIndex *indexPtr, int viewUpdate);
static int		TextReplaceCmd(TkText *textPtr, Tcl_Interp *interp,
			    const TkTextIndex *indexFromPtr,
			    const TkTextIndex *indexToPtr,
			    int objc, Tcl_Obj *const objv[], int viewUpdate);
static int		TextSearchCmd(TkText *textPtr, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TextEditCmd(TkText *textPtr, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TextWidgetObjCmd(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		SharedTextObjCmd(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static void		TextWorldChangedCallback(ClientData instanceData);
static void		TextWorldChanged(TkText *textPtr, int mask);
static int		TextDumpCmd(TkText *textPtr, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		DumpLine(Tcl_Interp *interp, TkText *textPtr,
			    int what, TkTextLine *linePtr, int start, int end,
			    int lineno, Tcl_Obj *command);
static int		DumpSegment(TkText *textPtr, Tcl_Interp *interp,
			    const char *key, const char *value,
			    Tcl_Obj *command, const TkTextIndex *index,
			    int what);
static int		TextEditUndo(TkText *textPtr);
static int		TextEditRedo(TkText *textPtr);
static Tcl_Obj *	TextGetText(const TkText *textPtr,
			    const TkTextIndex *index1,
			    const TkTextIndex *index2, int visibleOnly);
static void		GenerateModifiedEvent(TkText *textPtr);
static void		UpdateDirtyFlag(TkSharedText *sharedPtr);
static void		TextPushUndoAction(TkText *textPtr,
			    Tcl_Obj *undoString, int insert,
			    const TkTextIndex *index1Ptr,
			    const TkTextIndex *index2Ptr);
static int		TextSearchIndexInLine(const SearchSpec *searchSpecPtr,
			    TkTextLine *linePtr, int byteIndex);
static int		TextPeerCmd(TkText *textPtr, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static TkUndoProc	TextUndoRedoCallback;

/*
 * Declarations of the three search procs required by the multi-line search
 * routines.
 */

static SearchMatchProc		TextSearchFoundMatch;
static SearchAddLineProc	TextSearchAddNextLine;
static SearchLineIndexProc	TextSearchGetLineIndex;

/*
 * The structure below defines text class behavior by means of functions that
 * can be invoked from generic window code.
 */

static const Tk_ClassProcs textClass = {
    sizeof(Tk_ClassProcs),	/* size */
    TextWorldChangedCallback,	/* worldChangedProc */
    NULL,					/* createProc */
    NULL					/* modalProc */
};

/*
 *--------------------------------------------------------------
 *
 * Tk_TextObjCmd --
 *
 *	This function is invoked to process the "text" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_TextObjCmd(
    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;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
	return TCL_ERROR;
    }

    return CreateWidget(NULL, tkwin, interp, NULL, objc, objv);
}

/*
 *--------------------------------------------------------------
 *
 * CreateWidget --
 *
 *	This function is invoked to process the "text" Tcl command, (when
 *	called by Tk_TextObjCmd) and the "$text peer create" text widget
 *	sub-command (called from TextPeerCmd).
 *
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result, places the name of the widget created into the
 *	interp's result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
CreateWidget(
    TkSharedText *sharedPtr,	/* Shared widget info, or NULL. */
    Tk_Window tkwin,		/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    const TkText *parent,	/* If non-NULL then take default start, end
				 * from this parent. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    register TkText *textPtr;
    Tk_OptionTable optionTable;
    TkTextIndex startIndex;
    Tk_Window newWin;

    /*
     * Create the window.
     */

    newWin = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[1]),
	    NULL);
    if (newWin == NULL) {
	return TCL_ERROR;
    }

    /*
     * Create the text widget and initialize everything to zero, then set the
     * necessary initial (non-NULL) values. It is important that the 'set' tag
     * and 'insert', 'current' mark pointers are all NULL to start.
     */

    textPtr = ckalloc(sizeof(TkText));
    memset(textPtr, 0, sizeof(TkText));

    textPtr->tkwin = newWin;
    textPtr->display = Tk_Display(newWin);
    textPtr->interp = interp;
    textPtr->widgetCmd = Tcl_CreateObjCommand(interp,
	    Tk_PathName(textPtr->tkwin), TextWidgetObjCmd,
	    textPtr, TextCmdDeletedProc);

    if (sharedPtr == NULL) {
	sharedPtr = ckalloc(sizeof(TkSharedText));
	memset(sharedPtr, 0, sizeof(TkSharedText));

	sharedPtr->refCount = 0;
	sharedPtr->peers = NULL;
	sharedPtr->tree = TkBTreeCreate(sharedPtr);

	Tcl_InitHashTable(&sharedPtr->tagTable, TCL_STRING_KEYS);
	Tcl_InitHashTable(&sharedPtr->markTable, TCL_STRING_KEYS);
	Tcl_InitHashTable(&sharedPtr->windowTable, TCL_STRING_KEYS);
	Tcl_InitHashTable(&sharedPtr->imageTable, TCL_STRING_KEYS);
	sharedPtr->undoStack = TkUndoInitStack(interp,0);
	sharedPtr->undo = 1;
	sharedPtr->isDirty = 0;
	sharedPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL;
	sharedPtr->autoSeparators = 1;
	sharedPtr->lastEditMode = TK_TEXT_EDIT_OTHER;
	sharedPtr->stateEpoch = 0;
    }

    /*
     * Add the new widget to the shared list.
     */

    textPtr->sharedTextPtr = sharedPtr;
    sharedPtr->refCount++;
    textPtr->next = sharedPtr->peers;
    sharedPtr->peers = textPtr;

    /*
     * This refCount will be held until DestroyText is called. Note also that
     * the later call to 'TkTextCreateDInfo' will add more refCounts.
     */

    textPtr->refCount = 1;

    /*
     * Specify start and end lines in the B-tree. The default is the same as
     * the parent, but this can be adjusted to display more or less if the
     * start, end where given as configuration options.
     */

    if (parent != NULL) {
	textPtr->start = parent->start;
	textPtr->end = parent->end;
    } else {
	textPtr->start = NULL;
	textPtr->end = NULL;
    }

    /*
     * Register with the B-tree. In some sense it would be best if we could do
     * this later (after configuration options), so that any changes to
     * start,end do not require a total recalculation.
     */

    TkBTreeAddClient(sharedPtr->tree, textPtr, textPtr->charHeight);

    textPtr->state = TK_TEXT_STATE_NORMAL;
    textPtr->relief = TK_RELIEF_FLAT;
    textPtr->cursor = None;
    textPtr->charWidth = 1;
    textPtr->charHeight = 10;
    textPtr->wrapMode = TEXT_WRAPMODE_CHAR;
    textPtr->prevWidth = Tk_Width(newWin);
    textPtr->prevHeight = Tk_Height(newWin);

    /*
     * This will add refCounts to textPtr.
     */

    TkTextCreateDInfo(textPtr);
    TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
	    &startIndex);
    TkTextSetYView(textPtr, &startIndex, 0);
    textPtr->exportSelection = 1;
    textPtr->pickEvent.type = LeaveNotify;
    textPtr->undo = textPtr->sharedTextPtr->undo;
    textPtr->maxUndo = textPtr->sharedTextPtr->maxUndo;
    textPtr->autoSeparators = textPtr->sharedTextPtr->autoSeparators;
    textPtr->tabOptionPtr = NULL;

    /*
     * Create the "sel" tag and the "current" and "insert" marks.
     */

    textPtr->selBorder = NULL;
    textPtr->inactiveSelBorder = NULL;
    textPtr->selBorderWidth = 0;
    textPtr->selBorderWidthPtr = NULL;
    textPtr->selFgColorPtr = NULL;

    /*
     * Note: it is important that textPtr->selTagPtr is NULL before this
     * initial call.
     */

    textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel", NULL);
    textPtr->selTagPtr->reliefString =
	    ckalloc(sizeof(DEF_TEXT_SELECT_RELIEF));
    strcpy(textPtr->selTagPtr->reliefString, DEF_TEXT_SELECT_RELIEF);
    Tk_GetRelief(interp, DEF_TEXT_SELECT_RELIEF, &textPtr->selTagPtr->relief);
    textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &startIndex);
    textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &startIndex);

    /*
     * 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(textPtr->tkwin, "Text");
    Tk_SetClassProcs(textPtr->tkwin, &textClass, textPtr);
    textPtr->optionTable = optionTable;

    Tk_CreateEventHandler(textPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    TextEventProc, textPtr);
    Tk_CreateEventHandler(textPtr->tkwin, KeyPressMask|KeyReleaseMask
	    |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
	    |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
	    TkTextBindProc, textPtr);
    Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, XA_STRING,
	    TextFetchSelection, textPtr, XA_STRING);

    if (Tk_InitOptions(interp, (char *) textPtr, optionTable, textPtr->tkwin)
	    != TCL_OK) {
	Tk_DestroyWindow(textPtr->tkwin);
	return TCL_ERROR;
    }
    if (ConfigureText(interp, textPtr, objc-2, objv+2) != TCL_OK) {
	Tk_DestroyWindow(textPtr->tkwin);
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TkNewWindowObj(textPtr->tkwin));
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * TextWidgetObjCmd --
 *
 *	This function is invoked to process the Tcl command that corresponds
 *	to a text widget. See the user documentation for details on what it
 *	does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
TextWidgetObjCmd(
    ClientData clientData,	/* Information about text widget. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    register TkText *textPtr = clientData;
    int result = TCL_OK;
    int index;

    static const char *const optionStrings[] = {
	"bbox", "cget", "compare", "configure", "count", "debug", "delete",
	"dlineinfo", "dump", "edit", "get", "image", "index", "insert",
	"mark", "peer", "replace", "scan", "search", "see", "tag", "window",
	"xview", "yview", NULL
    };
    enum options {
	TEXT_BBOX, TEXT_CGET, TEXT_COMPARE, TEXT_CONFIGURE, TEXT_COUNT,
	TEXT_DEBUG, TEXT_DELETE, TEXT_DLINEINFO, TEXT_DUMP, TEXT_EDIT,
	TEXT_GET, TEXT_IMAGE, TEXT_INDEX, TEXT_INSERT, TEXT_MARK,
	TEXT_PEER, TEXT_REPLACE, TEXT_SCAN, TEXT_SEARCH, TEXT_SEE,
	TEXT_TAG, TEXT_WINDOW, TEXT_XVIEW, TEXT_YVIEW
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
	    sizeof(char *), "option", 0, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    textPtr->refCount++;

    switch ((enum options) index) {
    case TEXT_BBOX: {
	int x, y, width, height;
	const TkTextIndex *indexPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index");
	    result = TCL_ERROR;
	    goto done;
	}
	indexPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]);
	if (indexPtr == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextIndexBbox(textPtr, indexPtr, &x, &y, &width, &height,
		NULL) == 0) {
	    Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);

	    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(x));
	    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(y));
	    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(width));
	    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(height));

	    Tcl_SetObjResult(interp, listObj);
	}
	break;
    }
    case TEXT_CGET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "option");
	    result = TCL_ERROR;
	    goto done;
	} else {
	    Tcl_Obj *objPtr = Tk_GetOptionValue(interp, (char *) textPtr,
		    textPtr->optionTable, objv[2], textPtr->tkwin);

	    if (objPtr == NULL) {
		result = TCL_ERROR;
		goto done;
	    }
	    Tcl_SetObjResult(interp, objPtr);
	    result = TCL_OK;
	}
	break;
    case TEXT_COMPARE: {
	int relation, value;
	const char *p;
	const TkTextIndex *index1Ptr, *index2Ptr;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index1 op index2");
	    result = TCL_ERROR;
	    goto done;
	}
	index1Ptr = TkTextGetIndexFromObj(interp, textPtr, objv[2]);
	index2Ptr = TkTextGetIndexFromObj(interp, textPtr, objv[4]);
	if (index1Ptr == NULL || index2Ptr == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	relation = TkTextIndexCmp(index1Ptr, index2Ptr);
	p = Tcl_GetString(objv[3]);
	if (p[0] == '<') {
	    value = (relation < 0);
	    if ((p[1] == '=') && (p[2] == 0)) {
		value = (relation <= 0);
	    } else if (p[1] != 0) {
		goto compareError;
	    }
	} else if (p[0] == '>') {
	    value = (relation > 0);
	    if ((p[1] == '=') && (p[2] == 0)) {
		value = (relation >= 0);
	    } else if (p[1] != 0) {
		goto compareError;
	    }
	} else if ((p[0] == '=') && (p[1] == '=') && (p[2] == 0)) {
	    value = (relation == 0);
	} else if ((p[0] == '!') && (p[1] == '=') && (p[2] == 0)) {
	    value = (relation != 0);
	} else {
	    goto compareError;
	}
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
	break;

    compareError:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad comparison operator \"%s\": must be"
		" <, <=, ==, >=, >, or !=", Tcl_GetString(objv[3])));
	Tcl_SetErrorCode(interp, "TK", "VALUE", "COMPARISON", NULL);
	result = TCL_ERROR;
	goto done;
    }
    case TEXT_CONFIGURE:
	if (objc <= 3) {
	    Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) textPtr,
		    textPtr->optionTable, ((objc == 3) ? objv[2] : NULL),
		    textPtr->tkwin);

	    if (objPtr == NULL) {
		result = TCL_ERROR;
		goto done;
	    }
	    Tcl_SetObjResult(interp, objPtr);
	} else {
	    result = ConfigureText(interp, textPtr, objc-2, objv+2);
	}
	break;
    case TEXT_COUNT: {
	const TkTextIndex *indexFromPtr, *indexToPtr;
	int i, found = 0, update = 0;
	Tcl_Obj *objPtr = NULL;

	if (objc < 4) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "?-option value ...? index1 index2");
	    result = TCL_ERROR;
	    goto done;
	}

	indexFromPtr = TkTextGetIndexFromObj(interp, textPtr, objv[objc-2]);
	if (indexFromPtr == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	indexToPtr = TkTextGetIndexFromObj(interp, textPtr, objv[objc-1]);
	if (indexToPtr == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}

	for (i = 2; i < objc-2; i++) {
	    int value, length;
	    const char *option = Tcl_GetString(objv[i]);
	    char c;

	    length = objv[i]->length;
	    if (length < 2 || option[0] != '-') {
		goto badOption;
	    }
	    c = option[1];
	    if (c == 'c' && !strncmp("-chars", option, (unsigned) length)) {
		value = CountIndices(textPtr, indexFromPtr, indexToPtr,
			COUNT_CHARS);
	    } else if (c == 'd' && (length > 8)
		    && !strncmp("-displaychars", option, (unsigned) length)) {
		value = CountIndices(textPtr, indexFromPtr, indexToPtr,
			COUNT_DISPLAY_CHARS);
	    } else if (c == 'd' && (length > 8)
		    && !strncmp("-displayindices", option,(unsigned)length)) {
		value = CountIndices(textPtr, indexFromPtr, indexToPtr,
			COUNT_DISPLAY_INDICES);
	    } else if (c == 'd' && (length > 8)
		    && !strncmp("-displaylines", option, (unsigned) length)) {
		TkTextLine *fromPtr, *lastPtr;
		TkTextIndex index;

		int compare = TkTextIndexCmp(indexFromPtr, indexToPtr);
		value = 0;

		if (compare == 0) {
		    goto countDone;
		}

		if (compare > 0) {
		    const TkTextIndex *tmpPtr = indexFromPtr;

		    indexFromPtr = indexToPtr;
		    indexToPtr = tmpPtr;
		}

		lastPtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
			textPtr,
			TkBTreeNumLines(textPtr->sharedTextPtr->tree,textPtr));
		fromPtr = indexFromPtr->linePtr;
		if (fromPtr == lastPtr) {
		    goto countDone;
		}

		/*
		 * Caution: we must NEVER call TkTextUpdateOneLine with the
		 * last artificial line in the widget.
		 */

		index = *indexFromPtr;
		index.byteIndex = 0;

		/*
		 * We're going to count up all display lines in the logical
		 * line of 'indexFromPtr' up to, but not including the logical
		 * line of 'indexToPtr', and then subtract off what we didn't
		 * want from 'from' and add on what we didn't count from 'to.
		 */

		while (index.linePtr != indexToPtr->linePtr) {
		    value += TkTextUpdateOneLine(textPtr, fromPtr,0,&index,0);

		    /*
		     * We might have skipped past indexToPtr, if we have
		     * multiple logical lines in a single display line.
		     */
		    if (TkTextIndexCmp(&index,indexToPtr) > 0) {
			break;
		    }
		}

		/*
		 * Now we need to adjust the count to add on the number of
		 * display lines in the last logical line, and subtract off
		 * the number of display lines overcounted in the first
		 * logical line. This logic is still ok if both indices are in
		 * the same logical line.
		 */

		index.linePtr = indexFromPtr->linePtr;
		index.byteIndex = 0;
		while (1) {
		    TkTextFindDisplayLineEnd(textPtr, &index, 1, NULL);
		    if (index.byteIndex >= indexFromPtr->byteIndex) {
			break;
		    }
		    TkTextIndexForwBytes(textPtr, &index, 1, &index);
		    value--;

		}
		if (indexToPtr->linePtr != lastPtr) {
		    index.linePtr = indexToPtr->linePtr;
		    index.byteIndex = 0;
		    while (1) {
			TkTextFindDisplayLineEnd(textPtr, &index, 1, NULL);
			if (index.byteIndex >= indexToPtr->byteIndex) {
			    break;
			}
			TkTextIndexForwBytes(textPtr, &index, 1, &index);
			value++;
		    }
		}

		if (compare > 0) {
		    value = -value;
		}
	    } else if (c == 'i'
		    && !strncmp("-indices", option, (unsigned) length)) {
		value = CountIndices(textPtr, indexFromPtr, indexToPtr,
			COUNT_INDICES);
	    } else if (c == 'l'
		    && !strncmp("-lines", option, (unsigned) length)) {
		value = TkBTreeLinesTo(textPtr, indexToPtr->linePtr)
			- TkBTreeLinesTo(textPtr, indexFromPtr->linePtr);
	    } else if (c == 'u'
		    && !strncmp("-update", option, (unsigned) length)) {
		update = 1;
		continue;
	    } else if (c == 'x'
		    && !strncmp("-xpixels", option, (unsigned) length)) {
		int x1, x2;
		TkTextIndex index;

		index = *indexFromPtr;
		TkTextFindDisplayLineEnd(textPtr, &index, 0, &x1);
		index = *indexToPtr;
		TkTextFindDisplayLineEnd(textPtr, &index, 0, &x2);
		value = x2 - x1;
	    } else if (c == 'y'
		    && !strncmp("-ypixels", option, (unsigned) length)) {
		if (update) {
		    TkTextUpdateLineMetrics(textPtr,
			    TkBTreeLinesTo(textPtr, indexFromPtr->linePtr),
			    TkBTreeLinesTo(textPtr, indexToPtr->linePtr), -1);
		}
		value = TkTextIndexYPixels(textPtr, indexToPtr)
			- TkTextIndexYPixels(textPtr, indexFromPtr);
	    } else {
		goto badOption;
	    }

	countDone:
	    found++;
	    if (found == 1) {
		Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
	    } else {
		if (found == 2) {
		    /*
		     * Move the first item we put into the result into the
		     * first element of the list object.
		     */

		    objPtr = Tcl_NewObj();
		    Tcl_ListObjAppendElement(NULL, objPtr,
			    Tcl_GetObjResult(interp));
		}
		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(value));
	    }
	}

	if (found == 0) {
	    /*
	     * Use the default '-indices'.
	     */

	    int value = CountIndices(textPtr, indexFromPtr, indexToPtr,
		    COUNT_INDICES);

	    Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
	} else if (found > 1) {
	    Tcl_SetObjResult(interp, objPtr);
	}
	break;

    badOption:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad option \"%s\" must be -chars, -displaychars, "
		"-displayindices, -displaylines, -indices, -lines, -update, "
		"-xpixels, or -ypixels", Tcl_GetString(objv[i])));
	Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_OPTION", NULL);
	result = TCL_ERROR;
	goto done;
    }
    case TEXT_DEBUG:
	if (objc > 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "boolean");
	    result = TCL_ERROR;
	    goto done;
	}
	if (objc == 2) {
	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(tkBTreeDebug));
	} else {
	    if (Tcl_GetBooleanFromObj(interp, objv[2],
		    &tkBTreeDebug) != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	    tkTextDebug = tkBTreeDebug;
	}
	break;
    case TEXT_DELETE:
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index1 ?index2 ...?");
	    result = TCL_ERROR;
	    goto done;
	}
	if (textPtr->state == TK_TEXT_STATE_NORMAL) {
	    if (objc < 5) {
		/*
		 * Simple case requires no predetermination of indices.
		 */

		const TkTextIndex *indexPtr1, *indexPtr2;

		/*
		 * Parse the starting and stopping indices.
		 */

		indexPtr1 = TkTextGetIndexFromObj(textPtr->interp, textPtr,
			objv[2]);
		if (indexPtr1 == NULL) {
		    result = TCL_ERROR;
		    goto done;
		}
		if (objc == 4) {
		    indexPtr2 = TkTextGetIndexFromObj(textPtr->interp,
			    textPtr, objv[3]);
		    if (indexPtr2 == NULL) {
			result = TCL_ERROR;
			goto done;
		    }
		} else {
		    indexPtr2 = NULL;
		}
		DeleteIndexRange(NULL, textPtr, indexPtr1, indexPtr2, 1);
	    } else {
		/*
		 * Multi-index pair case requires that we prevalidate the
		 * indices and sort from last to first so that deletes occur
		 * in the exact (unshifted) text. It also needs to handle
		 * partial and fully overlapping ranges. We have to do this
		 * with multiple passes.
		 */

		TkTextIndex *indices, *ixStart, *ixEnd, *lastStart;
		char *useIdx;
		int i;

		objc -= 2;
		objv += 2;
		indices = ckalloc((objc + 1) * sizeof(TkTextIndex));

		/*
		 * First pass verifies that all indices are valid.
		 */

		for (i = 0; i < objc; i++) {
		    const TkTextIndex *indexPtr =
			    TkTextGetIndexFromObj(interp, textPtr, objv[i]);

		    if (indexPtr == NULL) {
			result = TCL_ERROR;
			ckfree(indices);
			goto done;
		    }
		    indices[i] = *indexPtr;
		}

		/*
		 * Pad out the pairs evenly to make later code easier.
		 */

		if (objc & 1) {
		    indices[i] = indices[i-1];
		    TkTextIndexForwChars(NULL, &indices[i], 1, &indices[i],
			    COUNT_INDICES);
		    objc++;
		}
		useIdx = ckalloc(objc);
		memset(useIdx, 0, (unsigned) objc);

		/*
		 * Do a decreasing order sort so that we delete the end ranges
		 * first to maintain index consistency.
		 */

		qsort(indices, (unsigned) objc / 2,
			2 * sizeof(TkTextIndex), TextIndexSortProc);
		lastStart = NULL;

		/*
		 * Second pass will handle bogus ranges (end < start) and
		 * overlapping ranges.
		 */

		for (i = 0; i < objc; i += 2) {
		    ixStart = &indices[i];
		    ixEnd = &indices[i+1];
		    if (TkTextIndexCmp(ixEnd, ixStart) <= 0) {
			continue;
		    }
		    if (lastStart) {
			if (TkTextIndexCmp(ixStart, lastStart) == 0) {
			    /*
			     * Start indices were equal, and the sort placed
			     * the longest range first, so skip this one.
			     */

			    continue;
			} else if (TkTextIndexCmp(lastStart, ixEnd) < 0) {
			    /*
			     * The next pair has a start range before the end
			     * point of the last range. Constrain the delete
			     * range, but use the pointer values.
			     */

			    *ixEnd = *lastStart;
			    if (TkTextIndexCmp(ixEnd, ixStart) <= 0) {
				continue;
			    }
			}
		    }
		    lastStart = ixStart;
		    useIdx[i] = 1;
		}

		/*
		 * Final pass take the input from the previous and deletes the
		 * ranges which are flagged to be deleted.
		 */

		for (i = 0; i < objc; i += 2) {
		    if (useIdx[i]) {
			/*
			 * We don't need to check the return value because all
			 * indices are preparsed above.
			 */

			DeleteIndexRange(NULL, textPtr, &indices[i],
				&indices[i+1], 1);
		    }
		}
		ckfree(indices);
	    }
	}
	break;
    case TEXT_DLINEINFO: {
	int x, y, width, height, base;
	const TkTextIndex *indexPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index");
	    result = TCL_ERROR;
	    goto done;
	}
	indexPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]);
	if (indexPtr == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextDLineInfo(textPtr, indexPtr, &x, &y, &width, &height,
		&base) == 0) {
	    Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);

	    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(x));
	    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(y));
	    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(width));
	    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(height));
	    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(base));

	    Tcl_SetObjResult(interp, listObj);
	}
	break;
    }
    case TEXT_DUMP:
	result = TextDumpCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_EDIT:
	result = TextEditCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_GET: {
	Tcl_Obj *objPtr = NULL;
	int i, found = 0, visible = 0;
	const char *name;
	int length;

	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "?-displaychars? ?--? index1 ?index2 ...?");
	    result = TCL_ERROR;
	    goto done;
	}

	/*
	 * Simple, restrictive argument parsing. The only options are -- and
	 * -displaychars (or any unique prefix).
	 */

	i = 2;
	if (objc > 3) {
	    name = Tcl_GetString(objv[i]);
	    length = objv[i]->length;
	    if (length > 1 && name[0] == '-') {
		if (strncmp("-displaychars", name, (unsigned) length) == 0) {
		    i++;
		    visible = 1;
		    name = Tcl_GetString(objv[i]);
		    length = objv[i]->length;
		}
		if ((i < objc-1) && (length == 2) && !strcmp("--", name)) {
		    i++;
		}
	    }
	}

	for (; i < objc; i += 2) {
	    const TkTextIndex *index1Ptr, *index2Ptr;
	    TkTextIndex index2;

	    index1Ptr = TkTextGetIndexFromObj(interp, textPtr, objv[i]);
	    if (index1Ptr == NULL) {
		if (objPtr) {
		    Tcl_DecrRefCount(objPtr);
		}
		result = TCL_ERROR;
		goto done;
	    }

	    if (i+1 == objc) {
		TkTextIndexForwChars(NULL, index1Ptr, 1, &index2,
			COUNT_INDICES);
		index2Ptr = &index2;
	    } else {
		index2Ptr = TkTextGetIndexFromObj(interp, textPtr, objv[i+1]);
		if (index2Ptr == NULL) {
		    if (objPtr) {
			Tcl_DecrRefCount(objPtr);
		    }
		    result = TCL_ERROR;
		    goto done;
		}
	    }

	    if (TkTextIndexCmp(index1Ptr, index2Ptr) < 0) {
		/*
		 * We want to move the text we get from the window into the
		 * result, but since this could in principle be a megabyte or
		 * more, we want to do it efficiently!
		 */

		Tcl_Obj *get = TextGetText(textPtr, index1Ptr, index2Ptr,
			visible);

		found++;
		if (found == 1) {
		    Tcl_SetObjResult(interp, get);
		} else {
		    if (found == 2) {
			/*
			 * Move the first item we put into the result into the
			 * first element of the list object.
			 */

			objPtr = Tcl_NewObj();
			Tcl_ListObjAppendElement(NULL, objPtr,
				Tcl_GetObjResult(interp));
		    }
		    Tcl_ListObjAppendElement(NULL, objPtr, get);
		}
	    }
	}
	if (found > 1) {
	    Tcl_SetObjResult(interp, objPtr);
	}
	break;
    }
    case TEXT_IMAGE:
	result = TkTextImageCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_INDEX: {
	const TkTextIndex *indexPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index");
	    result = TCL_ERROR;
	    goto done;
	}

	indexPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]);
	if (indexPtr == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	Tcl_SetObjResult(interp, TkTextNewIndexObj(textPtr, indexPtr));
	break;
    }
    case TEXT_INSERT: {
	const TkTextIndex *indexPtr;

	if (objc < 4) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "index chars ?tagList chars tagList ...?");
	    result = TCL_ERROR;
	    goto done;
	}
	indexPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]);
	if (indexPtr == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (textPtr->state == TK_TEXT_STATE_NORMAL) {
	    result = TextInsertCmd(NULL, textPtr, interp, objc-3, objv+3,
		    indexPtr, 1);
	}
	break;
    }
    case TEXT_MARK:
	result = TkTextMarkCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_PEER:
	result = TextPeerCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_REPLACE: {
	const TkTextIndex *indexFromPtr, *indexToPtr;

	if (objc < 5) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "index1 index2 chars ?tagList chars tagList ...?");
	    result = TCL_ERROR;
	    goto done;
	}
	indexFromPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]);
	if (indexFromPtr == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	indexToPtr = TkTextGetIndexFromObj(interp, textPtr, objv[3]);
	if (indexToPtr == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextIndexCmp(indexFromPtr, indexToPtr) > 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "index \"%s\" before \"%s\" in the text",
		    Tcl_GetString(objv[3]), Tcl_GetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_ORDER", NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (textPtr->state == TK_TEXT_STATE_NORMAL) {
	    int lineNum, byteIndex;
	    TkTextIndex index;

	    /*
	     * The 'replace' operation is quite complex to do correctly,
	     * because we want a number of criteria to hold:
	     *
	     * 1.  The insertion point shouldn't move, unless it is within the
	     *	   deleted range. In this case it should end up after the new
	     *	   text.
	     *
	     * 2.  The window should not change the text it shows - should not
	     *	   scroll vertically - unless the result of the replace is
	     *	   that the insertion position which used to be on-screen is
	     *	   now off-screen.
	     */

	    byteIndex = textPtr->topIndex.byteIndex;
	    lineNum = TkBTreeLinesTo(textPtr, textPtr->topIndex.linePtr);

	    TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
	    if ((TkTextIndexCmp(indexFromPtr, &index) < 0)
		    && (TkTextIndexCmp(indexToPtr, &index) > 0)) {
		/*
		 * The insertion point is inside the range to be replaced, so
		 * we have to do some calculations to ensure it doesn't move
		 * unnecessarily.
		 */

		int deleteInsertOffset, insertLength, j;

		insertLength = 0;
		for (j = 4; j < objc; j += 2) {
		    insertLength += Tcl_GetCharLength(objv[j]);
		}

		/*
		 * Calculate 'deleteInsertOffset' as an offset we will apply
		 * to the insertion point after this operation.
		 */

		deleteInsertOffset = CountIndices(textPtr, indexFromPtr,
			&index, COUNT_CHARS);
		if (deleteInsertOffset > insertLength) {
		    deleteInsertOffset = insertLength;
		}

		result = TextReplaceCmd(textPtr, interp, indexFromPtr,
			indexToPtr, objc, objv, 0);

		if (result == TCL_OK) {
		    /*
		     * Move the insertion position to the correct place.
		     */

		    TkTextIndexForwChars(NULL, indexFromPtr,
			    deleteInsertOffset, &index, COUNT_INDICES);
		    TkBTreeUnlinkSegment(textPtr->insertMarkPtr,
			    textPtr->insertMarkPtr->body.mark.linePtr);
		    TkBTreeLinkSegment(textPtr->insertMarkPtr, &index);
		}
	    } else {
		result = TextReplaceCmd(textPtr, interp, indexFromPtr,
			indexToPtr, objc, objv, 1);
	    }
	    if (result == TCL_OK) {
		/*
		 * Now ensure the top-line is in the right place.
		 */

		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
			lineNum, byteIndex, &index);
		TkTextSetYView(textPtr, &index, TK_TEXT_NOPIXELADJUST);
	    }
	}
	break;
    }
    case TEXT_SCAN:
	result = TkTextScanCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_SEARCH:
	result = TextSearchCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_SEE:
	result = TkTextSeeCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_TAG:
	result = TkTextTagCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_WINDOW:
	result = TkTextWindowCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_XVIEW:
	result = TkTextXviewCmd(textPtr, interp, objc, objv);
	break;
    case TEXT_YVIEW:
	result = TkTextYviewCmd(textPtr, interp, objc, objv);
	break;
    }

  done:
    textPtr->refCount--;
    if (textPtr->refCount == 0) {
	ckfree(textPtr);
    }
    return result;
}

/*
 *--------------------------------------------------------------
 *
 * SharedTextObjCmd --
 *
 *	This function is invoked to process commands on the shared portion of
 *	a text widget. Currently it is not actually exported as a Tcl command,
 *	and is only used internally to process parts of undo/redo scripts.
 *	See the user documentation for 'text' for details on what it does -
 *	the only subcommands it currently supports are 'insert' and 'delete'.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation for "text".
 *
 *--------------------------------------------------------------
 */

static int
SharedTextObjCmd(
    ClientData clientData,	/* Information about shared test B-tree. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    register TkSharedText *sharedPtr = clientData;
    int result = TCL_OK;
    int index;

    static const char *const optionStrings[] = {
	"delete", "insert", NULL
    };
    enum options {
	TEXT_DELETE, TEXT_INSERT
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
	    sizeof(char *), "option", 0, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum options) index) {
    case TEXT_DELETE:
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index1 ?index2 ...?");
	    return TCL_ERROR;
	}
	if (objc < 5) {
	    /*
	     * Simple case requires no predetermination of indices.
	     */

	    TkTextIndex index1;

	    /*
	     * Parse the starting and stopping indices.
	     */

	    result = TkTextSharedGetObjIndex(interp, sharedPtr, objv[2],
		    &index1);
	    if (result != TCL_OK) {
		return result;
	    }
	    if (objc == 4) {
		TkTextIndex index2;

		result = TkTextSharedGetObjIndex(interp, sharedPtr, objv[3],
			&index2);
		if (result != TCL_OK) {
		    return result;
		}
		DeleteIndexRange(sharedPtr, NULL, &index1, &index2, 1);
	    } else {
		DeleteIndexRange(sharedPtr, NULL, &index1, NULL, 1);
	    }
	    return TCL_OK;
	} else {
	    /* Too many arguments */
	    return TCL_ERROR;
	}
	break;
    case TEXT_INSERT: {
	TkTextIndex index1;

	if (objc < 4) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "index chars ?tagList chars tagList ...?");
	    return TCL_ERROR;
	}
	result = TkTextSharedGetObjIndex(interp, sharedPtr, objv[2],
		&index1);
	if (result != TCL_OK) {
	    return result;
	}
	return TextInsertCmd(sharedPtr, NULL, interp, objc-3, objv+3, &index1,
		1);
    }
    default:
	return TCL_OK;
    }
}

/*
 *--------------------------------------------------------------
 *
 * TextPeerCmd --
 *
 *	This function is invoked to process the "text peer" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
TextPeerCmd(
    TkText *textPtr,		/* Information about text widget. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tk_Window tkwin = textPtr->tkwin;
    int index;

    static const char *const peerOptionStrings[] = {
	"create", "names", NULL
    };
    enum peerOptions {
	PEER_CREATE, PEER_NAMES
    };

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObjStruct(interp, objv[2], peerOptionStrings,
	    sizeof(char *), "peer option", 0, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum peerOptions) index) {
    case PEER_CREATE:
	if (objc < 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "pathName ?-option value ...?");
	    return TCL_ERROR;
	}
	return CreateWidget(textPtr->sharedTextPtr, tkwin, interp, textPtr,
		objc-2, objv+2);
    case PEER_NAMES: {
	TkText *tPtr = textPtr->sharedTextPtr->peers;
	Tcl_Obj *peersObj;

	if (objc > 3) {
	    Tcl_WrongNumArgs(interp, 3, objv, NULL);
	    return TCL_ERROR;
	}
	peersObj = Tcl_NewObj();
	while (tPtr != NULL) {
	    if (tPtr != textPtr) {
		Tcl_ListObjAppendElement(NULL, peersObj,
			TkNewWindowObj(tPtr->tkwin));
	    }
	    tPtr = tPtr->next;
	}
	Tcl_SetObjResult(interp, peersObj);
    }
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TextReplaceCmd --
 *
 *	This function is invoked to process part of the "replace" widget
 *	command for text widgets.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *	If 'viewUpdate' is false, then textPtr->topIndex may no longer be a
 *	valid index after this function returns. The caller is responsible for
 *	ensuring a correct index is in place.
 *
 *----------------------------------------------------------------------
 */

static int
TextReplaceCmd(
    TkText *textPtr,		/* Information about text widget. */
    Tcl_Interp *interp,		/* Current interpreter. */
    const TkTextIndex *indexFromPtr,
				/* Index from which to replace. */
    const TkTextIndex *indexToPtr,
				/* Index to which to replace. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects. */
    int viewUpdate)		/* Update vertical view if set. */
{
    /*
     * Perform the deletion and insertion, but ensure no undo-separator is
     * placed between the two operations. Since we are using the helper
     * functions 'DeleteIndexRange' and 'TextInsertCmd' we have to pretend
     * that the autoSeparators setting is off, so that we don't get an
     * undo-separator between the delete and insert.
     */

    int origAutoSep = textPtr->sharedTextPtr->autoSeparators;
    int result, lineNumber;
    TkTextIndex indexTmp;

    if (textPtr->sharedTextPtr->undo) {
	textPtr->sharedTextPtr->autoSeparators = 0;
	if (origAutoSep &&
		textPtr->sharedTextPtr->lastEditMode!=TK_TEXT_EDIT_REPLACE) {
	    TkUndoInsertUndoSeparator(textPtr->sharedTextPtr->undoStack);
	}
    }

    /*
     * Must save and restore line in indexFromPtr based on line number; can't
     * keep the line itself as that might be eliminated/invalidated when
     * deleting the range. [Bug 1602537]
     */

    indexTmp = *indexFromPtr;
    lineNumber = TkBTreeLinesTo(textPtr, indexFromPtr->linePtr);
    DeleteIndexRange(NULL, textPtr, indexFromPtr, indexToPtr, viewUpdate);
    indexTmp.linePtr = TkBTreeFindLine(indexTmp.tree, textPtr, lineNumber);
    result = TextInsertCmd(NULL, textPtr, interp, objc-4, objv+4,
	    &indexTmp, viewUpdate);

    if (textPtr->sharedTextPtr->undo) {
	textPtr->sharedTextPtr->lastEditMode = TK_TEXT_EDIT_REPLACE;
	textPtr->sharedTextPtr->autoSeparators = origAutoSep;
    }

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TextIndexSortProc --
 *
 *	This function is called by qsort when sorting an array of indices in
 *	*decreasing* order (last to first).
 *
 * Results:
 *	The return value is -1 if the first argument should be before the
 *	second element, 0 if it's equivalent, and 1 if it should be after the
 *	second element.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TextIndexSortProc(
    const void *first,		/* Elements to be compared. */
    const void *second)
{
    TkTextIndex *pair1 = (TkTextIndex *) first;
    TkTextIndex *pair2 = (TkTextIndex *) second;
    int cmp = TkTextIndexCmp(&pair1[1], &pair2[1]);

    if (cmp == 0) {
	/*
	 * If the first indices were equal, we want the second index of the
	 * pair also to be the greater. Use pointer magic to access the second
	 * index pair.
	 */

	cmp = TkTextIndexCmp(&pair1[0], &pair2[0]);
    }
    if (cmp > 0) {
	return -1;
    } else if (cmp < 0) {
	return 1;
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * DestroyText --
 *
 *	This function is invoked when we receive a destroy event to clean up
 *	the internal structure of a text widget. We will free up most of the
 *	internal structure and delete the associated Tcl command. If there are
 *	no outstanding references to the widget, we also free up the textPtr
 *	itself.
 *
 *	The widget has already been flagged as deleted.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Either everything or almost everything associated with the text is
 *	freed up.
 *
 *----------------------------------------------------------------------
 */

static void
DestroyText(
    TkText *textPtr)		/* Info about text widget. */
{
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    TkTextTag *tagPtr;
    TkSharedText *sharedTextPtr = textPtr->sharedTextPtr;

    /*
     * Free up all the stuff that requires special handling. We have already
     * called let Tk_FreeConfigOptions to handle all the standard
     * option-related stuff (and so none of that exists when we are called).
     * Special note: free up display-related information before deleting the
     * B-tree, since display-related stuff may refer to stuff in the B-tree.
     */

    TkTextFreeDInfo(textPtr);
    textPtr->dInfoPtr = NULL;

    /*
     * Remove ourselves from the peer list.
     */

    if (sharedTextPtr->peers == textPtr) {
	sharedTextPtr->peers = textPtr->next;
    } else {
	TkText *nextPtr = sharedTextPtr->peers;
	while (nextPtr != NULL) {
	    if (nextPtr->next == textPtr) {
		nextPtr->next = textPtr->next;
		break;
	    }
	    nextPtr = nextPtr->next;
	}
    }

    /*
     * Always clean up the widget-specific tags first. Common tags (i.e. most)
     * will only be cleaned up when the shared structure is cleaned up.
     *
     * We also need to clean up widget-specific marks ('insert', 'current'),
     * since otherwise marks will never disappear from the B-tree.
     */

    TkTextDeleteTag(textPtr, textPtr->selTagPtr);
    TkBTreeUnlinkSegment(textPtr->insertMarkPtr,
	    textPtr->insertMarkPtr->body.mark.linePtr);
    ckfree(textPtr->insertMarkPtr);
    TkBTreeUnlinkSegment(textPtr->currentMarkPtr,
	    textPtr->currentMarkPtr->body.mark.linePtr);
    ckfree(textPtr->currentMarkPtr);

    /*
     * Now we've cleaned up everything of relevance to us in the B-tree, so we
     * disassociate outselves from it.
     *
     * When the refCount reaches zero, it's time to clean up the shared
     * portion of the text widget.
     */

    sharedTextPtr->refCount--;

    if (sharedTextPtr->refCount > 0) {
	TkBTreeRemoveClient(sharedTextPtr->tree, textPtr);

	/*
	 * Free up any embedded windows which belong to this widget.
	 */

	for (hPtr = Tcl_FirstHashEntry(&sharedTextPtr->windowTable, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    TkTextEmbWindowClient *loop;
	    TkTextSegment *ewPtr = Tcl_GetHashValue(hPtr);

	    loop = ewPtr->body.ew.clients;
	    if (loop->textPtr == textPtr) {
		ewPtr->body.ew.clients = loop->next;
		TkTextWinFreeClient(hPtr, loop);
	    } else {
		TkTextEmbWindowClient *client = ewPtr->body.ew.clients;

		client = loop->next;
		while (client != NULL) {
		    if (client->textPtr == textPtr) {
			loop->next = client->next;
			TkTextWinFreeClient(hPtr, client);
			break;
		    } else {
			loop = loop->next;
		    }
		    client = loop->next;
		}
	    }
	}
    } else {
	/*
	 * No need to call 'TkBTreeRemoveClient' first, since this will do
	 * everything in one go, more quickly.
	 */

	TkBTreeDestroy(sharedTextPtr->tree);

	for (hPtr = Tcl_FirstHashEntry(&sharedTextPtr->tagTable, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    tagPtr = Tcl_GetHashValue(hPtr);

	    /*
	     * No need to use 'TkTextDeleteTag' since we've already removed
	     * the B-tree completely.
	     */

	    TkTextFreeTag(textPtr, tagPtr);
	}
	Tcl_DeleteHashTable(&sharedTextPtr->tagTable);
	for (hPtr = Tcl_FirstHashEntry(&sharedTextPtr->markTable, &search);
	     hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ckfree(Tcl_GetHashValue(hPtr));
	}
	Tcl_DeleteHashTable(&sharedTextPtr->markTable);
	TkUndoFreeStack(sharedTextPtr->undoStack);

	Tcl_DeleteHashTable(&sharedTextPtr->windowTable);
	Tcl_DeleteHashTable(&sharedTextPtr->imageTable);

	if (sharedTextPtr->bindingTable != NULL) {
	    Tk_DeleteBindingTable(sharedTextPtr->bindingTable);
	}
	ckfree(sharedTextPtr);
    }

    if (textPtr->tabArrayPtr != NULL) {
	ckfree(textPtr->tabArrayPtr);
    }
    if (textPtr->insertBlinkHandler != NULL) {
	Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
    }

    textPtr->tkwin = NULL;
    textPtr->refCount--;
    Tcl_DeleteCommandFromToken(textPtr->interp, textPtr->widgetCmd);
    if (textPtr->refCount == 0) {
	ckfree(textPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureText --
 *
 *	This function is called to process an objv/objc list, plus the Tk
 *	option database, in order to configure (or reconfigure) a text widget.
 *
 * Results:
 *	The return value is a standard Tcl result. If TCL_ERROR is returned,
 *	then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as text string, colors, font, etc. get
 *	set for textPtr; old resources get freed, if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureText(
    Tcl_Interp *interp,		/* Used for error reporting. */
    register TkText *textPtr,	/* Information about widget; may or may not
				 * already have values for some fields. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tk_SavedOptions savedOptions;
    int oldExport = textPtr->exportSelection;
    int mask = 0;

    if (Tk_SetOptions(interp, (char *) textPtr, textPtr->optionTable,
	    objc, objv, textPtr->tkwin, &savedOptions, &mask) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Copy down shared flags.
     */

    textPtr->sharedTextPtr->undo = textPtr->undo;
    textPtr->sharedTextPtr->maxUndo = textPtr->maxUndo;
    textPtr->sharedTextPtr->autoSeparators = textPtr->autoSeparators;

    TkUndoSetDepth(textPtr->sharedTextPtr->undoStack,
	    textPtr->sharedTextPtr->maxUndo);

    /*
     * A few other options also need special processing, such as parsing the
     * geometry and setting the background from a 3-D border.
     */

    Tk_SetBackgroundFromBorder(textPtr->tkwin, textPtr->border);

    if (mask & TK_TEXT_LINE_RANGE) {
	int start, end, current;
	TkTextIndex index1, index2, index3;

	/*
	 * Line start and/or end have been adjusted. We need to validate the
	 * first displayed line and arrange for re-layout.
	 */

	TkBTreeClientRangeChanged(textPtr, textPtr->charHeight);

	if (textPtr->start != NULL) {
	    start = TkBTreeLinesTo(NULL, textPtr->start);
	} else {
	    start = 0;
	}
	if (textPtr->end != NULL) {
	    end = TkBTreeLinesTo(NULL, textPtr->end);
	} else {
	    end = TkBTreeNumLines(textPtr->sharedTextPtr->tree, NULL);
	}
	if (start > end) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "-startline must be less than or equal to -endline", -1));
	    Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_ORDER", NULL);
	    Tk_RestoreSavedOptions(&savedOptions);
	    return TCL_ERROR;
	}
	current = TkBTreeLinesTo(NULL, textPtr->topIndex.linePtr);
	TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, start, 0,
		    &index1);
	TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, end, 0,
		    &index2);
	if (current < start || current > end) {
	    TkTextSearch search;
	    TkTextIndex first, last;
	    int selChanged = 0;

	    TkTextSetYView(textPtr, &index1, 0);

	    /*
	     * We may need to adjust the selection. So we have to check
	     * whether the "sel" tag was applied to anything outside the
	     * current start,end.
	     */

	    TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL, 0, 0,
		    &first);
	    TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, NULL,
		    TkBTreeNumLines(textPtr->sharedTextPtr->tree, NULL),
		    0, &last);
	    TkBTreeStartSearch(&first, &last, textPtr->selTagPtr, &search);
	    if (!TkBTreeCharTagged(&first, textPtr->selTagPtr)
		    && !TkBTreeNextTag(&search)) {
		/* Nothing tagged with "sel" */
	    } else {
		int line = TkBTreeLinesTo(NULL, search.curIndex.linePtr);

		if (line < start) {
		    selChanged = 1;
		} else {
		    TkTextLine *linePtr = search.curIndex.linePtr;

		    while (TkBTreeNextTag(&search)) {
			linePtr = search.curIndex.linePtr;
		    }
		    line = TkBTreeLinesTo(NULL, linePtr);
		    if (line >= end) {
			selChanged = 1;
		    }
		}
	    }
	    if (selChanged) {
		/*
		 * Send an event that the selection has changed, and abort any
		 * partial-selections in progress.
		 */

		TkTextSelectionEvent(textPtr);
		textPtr->abortSelections = 1;
	    }
	}

	/* Indices are potentially obsolete after changing -startline and/or
	 * -endline, therefore increase the epoch.
	 * Also, clamp the insert and current (unshared) marks to the new
	 * -startline/-endline range limits of the widget. All other (shared)
	 * marks are unchanged.
         * The return value of TkTextMarkNameToIndex does not need to be
         * checked: "insert" and "current" marks always exist, and the
         * purpose of the code below precisely is to move them inside the
         * -startline/-endline range.
	 */

	textPtr->sharedTextPtr->stateEpoch++;
	TkTextMarkNameToIndex(textPtr, "insert", &index3);
	if (TkTextIndexCmp(&index3, &index1) < 0) {
	    textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &index1);
	}
	if (TkTextIndexCmp(&index3, &index2) > 0) {
	    textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &index2);
	}
	TkTextMarkNameToIndex(textPtr, "current", &index3);
	if (TkTextIndexCmp(&index3, &index1) < 0) {
	    textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &index1);
	}
	if (TkTextIndexCmp(&index3, &index2) > 0) {
	    textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &index2);
	}
    }

    /*
     * Don't allow negative spacings.
     */

    if (textPtr->spacing1 < 0) {
	textPtr->spacing1 = 0;
    }
    if (textPtr->spacing2 < 0) {
	textPtr->spacing2 = 0;
    }
    if (textPtr->spacing3 < 0) {
	textPtr->spacing3 = 0;
    }

    /*
     * Parse tab stops.
     */

    if (textPtr->tabArrayPtr != NULL) {
	ckfree(textPtr->tabArrayPtr);
	textPtr->tabArrayPtr = NULL;
    }
    if (textPtr->tabOptionPtr != NULL) {
	textPtr->tabArrayPtr = TkTextGetTabs(interp, textPtr,
		textPtr->tabOptionPtr);
	if (textPtr->tabArrayPtr == NULL) {
	    Tcl_AddErrorInfo(interp,"\n    (while processing -tabs option)");
	    Tk_RestoreSavedOptions(&savedOptions);
	    return TCL_ERROR;
	}
    }

    /*
     * Make sure that configuration options are properly mirrored between the
     * widget record and the "sel" tags. NOTE: we don't have to free up
     * information during the mirroring; old information was freed when it was
     * replaced in the widget record.
     */

    textPtr->selTagPtr->border = textPtr->selBorder;
    if (textPtr->selTagPtr->borderWidthPtr != textPtr->selBorderWidthPtr) {
	textPtr->selTagPtr->borderWidthPtr = textPtr->selBorderWidthPtr;
	textPtr->selTagPtr->borderWidth = textPtr->selBorderWidth;
    }
    textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr;
    textPtr->selTagPtr->affectsDisplay = 0;
    textPtr->selTagPtr->affectsDisplayGeometry = 0;
    if ((textPtr->selTagPtr->elideString != NULL)
	    || (textPtr->selTagPtr->tkfont != None)
	    || (textPtr->selTagPtr->justifyString != NULL)
	    || (textPtr->selTagPtr->lMargin1String != NULL)
	    || (textPtr->selTagPtr->lMargin2String != NULL)
	    || (textPtr->selTagPtr->offsetString != NULL)
	    || (textPtr->selTagPtr->rMarginString != NULL)
	    || (textPtr->selTagPtr->spacing1String != NULL)
	    || (textPtr->selTagPtr->spacing2String != NULL)
	    || (textPtr->selTagPtr->spacing3String != NULL)
	    || (textPtr->selTagPtr->tabStringPtr != NULL)
	    || (textPtr->selTagPtr->wrapMode != TEXT_WRAPMODE_NULL)) {
	textPtr->selTagPtr->affectsDisplay = 1;
	textPtr->selTagPtr->affectsDisplayGeometry = 1;
    }
    if ((textPtr->selTagPtr->border != NULL)
	    || (textPtr->selTagPtr->reliefString != NULL)
	    || (textPtr->selTagPtr->bgStipple != None)
	    || (textPtr->selTagPtr->fgColor != NULL)
	    || (textPtr->selTagPtr->fgStipple != None)
	    || (textPtr->selTagPtr->overstrikeString != NULL)
	    || (textPtr->selTagPtr->underlineString != NULL)) {
	textPtr->selTagPtr->affectsDisplay = 1;
    }
    TkTextRedrawTag(NULL, textPtr, NULL, NULL, textPtr->selTagPtr, 1);

    /*
     * Claim the selection if we've suddenly started exporting it and there
     * are tagged characters.
     */

    if (textPtr->exportSelection && (!oldExport)) {
	TkTextSearch search;
	TkTextIndex first, last;

	TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
		&first);
	TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
		TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
		0, &last);
	TkBTreeStartSearch(&first, &last, textPtr->selTagPtr, &search);
	if (TkBTreeCharTagged(&first, textPtr->selTagPtr)
		|| TkBTreeNextTag(&search)) {
	    Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, TkTextLostSelection,
		    textPtr);
	    textPtr->flags |= GOT_SELECTION;
	}
    }

    /*
     * Account for state changes that would reenable blinking cursor state.
     */

    if (textPtr->flags & GOT_FOCUS) {
	Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
	textPtr->insertBlinkHandler = NULL;
	TextBlinkProc(textPtr);
    }

    /*
     * Register the desired geometry for the window, and arrange for the
     * window to be redisplayed.
     */

    if (textPtr->width <= 0) {
	textPtr->width = 1;
    }
    if (textPtr->height <= 0) {
	textPtr->height = 1;
    }
    Tk_FreeSavedOptions(&savedOptions);
    TextWorldChanged(textPtr, mask);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TextWorldChangedCallback --
 *
 *	This function is called when the world has changed in some way and the
 *	widget needs to recompute all its graphics contexts and determine its
 *	new geometry.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Configures all tags in the Text with a empty objc/objv, for the side
 *	effect of causing all the items to recompute their geometry and to be
 *	redisplayed.
 *
 *---------------------------------------------------------------------------
 */

static void
TextWorldChangedCallback(
    ClientData instanceData)	/* Information about widget. */
{
    TkText *textPtr = instanceData;

    TextWorldChanged(textPtr, TK_TEXT_LINE_GEOMETRY);
}

/*
 *---------------------------------------------------------------------------
 *
 * TextWorldChanged --
 *
 *	This function is called when the world has changed in some way and the
 *	widget needs to recompute all its graphics contexts and determine its
 *	new geometry.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Configures all tags in the Text with a empty objc/objv, for the side
 *	effect of causing all the items to recompute their geometry and to be
 *	redisplayed.
 *
 *---------------------------------------------------------------------------
 */

static void
TextWorldChanged(
    TkText *textPtr,		/* Information about widget. */
    int mask)			/* OR'd collection of bits showing what has
				 * changed. */
{
    Tk_FontMetrics fm;
    int border;

    textPtr->charWidth = Tk_TextWidth(textPtr->tkfont, "0", 1);
    if (textPtr->charWidth <= 0) {
	textPtr->charWidth = 1;
    }
    Tk_GetFontMetrics(textPtr->tkfont, &fm);

    textPtr->charHeight = fm.linespace;
    if (textPtr->charHeight <= 0) {
	textPtr->charHeight = 1;
    }
    border = textPtr->borderWidth + textPtr->highlightWidth;
    Tk_GeometryRequest(textPtr->tkwin,
	    textPtr->width * textPtr->charWidth + 2*textPtr->padX + 2*border,
	    textPtr->height*(fm.linespace+textPtr->spacing1+textPtr->spacing3)
		    + 2*textPtr->padY + 2*border);

    Tk_SetInternalBorderEx(textPtr->tkwin,
	    border + textPtr->padX, border + textPtr->padX,
	    border + textPtr->padY, border + textPtr->padY);
    if (textPtr->setGrid) {
	Tk_SetGrid(textPtr->tkwin, textPtr->width, textPtr->height,
		textPtr->charWidth, textPtr->charHeight);
    } else {
	Tk_UnsetGrid(textPtr->tkwin);
    }

    TkTextRelayoutWindow(textPtr, mask);
}

/*
 *--------------------------------------------------------------
 *
 * TextEventProc --
 *
 *	This function is invoked by the Tk dispatcher on structure changes to
 *	a text. For texts with 3D borders, this function is also invoked for
 *	exposures.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	When the window gets deleted, internal structures get cleaned up.
 *	When it gets exposed, it is redisplayed.
 *
 *--------------------------------------------------------------
 */

static void
TextEventProc(
    ClientData clientData,	/* Information about window. */
    register XEvent *eventPtr)	/* Information about event. */
{
    register TkText *textPtr = clientData;
    TkTextIndex index, index2;

    if (eventPtr->type == Expose) {
	TkTextRedrawRegion(textPtr, eventPtr->xexpose.x,
		eventPtr->xexpose.y, eventPtr->xexpose.width,
		eventPtr->xexpose.height);
    } else if (eventPtr->type == ConfigureNotify) {
	if ((textPtr->prevWidth != Tk_Width(textPtr->tkwin))
		|| (textPtr->prevHeight != Tk_Height(textPtr->tkwin))) {
	    int mask = 0;

	    if (textPtr->prevWidth != Tk_Width(textPtr->tkwin)) {
		mask = TK_TEXT_LINE_GEOMETRY;
	    }
	    TkTextRelayoutWindow(textPtr, mask);
	    textPtr->prevWidth = Tk_Width(textPtr->tkwin);
	    textPtr->prevHeight = Tk_Height(textPtr->tkwin);
	}
    } else if (eventPtr->type == DestroyNotify) {
	/*
	 * NOTE: we must zero out selBorder, selBorderWidthPtr and
	 * selFgColorPtr: they are duplicates of information in the "sel" tag,
	 * which will be freed up when we delete all tags. Hence we don't want
	 * the automatic config options freeing process to delete them as
	 * well.
	 */

	textPtr->selBorder = NULL;
	textPtr->selBorderWidthPtr = NULL;
	textPtr->selBorderWidth = 0;
	textPtr->selFgColorPtr = NULL;
	if (textPtr->setGrid) {
	    Tk_UnsetGrid(textPtr->tkwin);
	    textPtr->setGrid = 0;
	}
	if (!(textPtr->flags & OPTIONS_FREED)) {
	    Tk_FreeConfigOptions((char *) textPtr, textPtr->optionTable,
		    textPtr->tkwin);
	    textPtr->flags |= OPTIONS_FREED;
	}
	textPtr->flags |= DESTROYED;

	/*
	 * Call 'DestroyTest' to handle the deletion for us. The actual
	 * textPtr may still exist after this, if there are some outstanding
	 * references. But we have flagged it as DESTROYED just above, so
	 * nothing will try to make use of it very extensively.
	 */

	DestroyText(textPtr);
    } else if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
	if (eventPtr->xfocus.detail == NotifyInferior
		|| eventPtr->xfocus.detail == NotifyAncestor
		|| eventPtr->xfocus.detail == NotifyNonlinear) {
	    Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
	    if (eventPtr->type == FocusIn) {
		textPtr->flags |= GOT_FOCUS | INSERT_ON;
		if (textPtr->insertOffTime != 0) {
		    textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
			    textPtr->insertOnTime, TextBlinkProc, textPtr);
		}
	    } else {
		textPtr->flags &= ~(GOT_FOCUS | INSERT_ON);
		textPtr->insertBlinkHandler = NULL;
	    }
	    if (textPtr->inactiveSelBorder != textPtr->selBorder) {
		TkTextRedrawTag(NULL, textPtr, NULL, NULL, textPtr->selTagPtr,
			1);
	    }
	    TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
	    TkTextIndexForwChars(NULL, &index, 1, &index2, COUNT_INDICES);

	    /*
	     * While we wish to redisplay, no heights have changed, so no need
	     * to call TkTextInvalidateLineMetrics.
	     */

	    TkTextChanged(NULL, textPtr, &index, &index2);
	    if (textPtr->highlightWidth > 0) {
		TkTextRedrawRegion(textPtr, 0, 0, textPtr->highlightWidth,
			textPtr->highlightWidth);
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TextCmdDeletedProc --
 *
 *	This function is invoked when a widget command is deleted. If the
 *	widget isn't already in the process of being destroyed, this command
 *	destroys it.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The widget is destroyed.
 *
 *----------------------------------------------------------------------
 */

static void
TextCmdDeletedProc(
    ClientData clientData)	/* Pointer to widget record for widget. */
{
    TkText *textPtr = clientData;
    Tk_Window tkwin = textPtr->tkwin;

    /*
     * This function could be invoked either because the window was destroyed
     * and the command was then deleted (in which this flag is already set) or
     * because the command was deleted, and then this function destroys the
     * widget.
     */

    if (!(textPtr->flags & DESTROYED)) {
	if (textPtr->setGrid) {
	    Tk_UnsetGrid(textPtr->tkwin);
	    textPtr->setGrid = 0;
	}
	textPtr->flags |= DESTROYED;
	Tk_DestroyWindow(tkwin);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * InsertChars --
 *
 *	This function implements most of the functionality of the "insert"
 *	widget command.
 *
 * Results:
 *	The length of the inserted string.
 *
 * Side effects:
 *	The characters in "stringPtr" get added to the text just before the
 *	character indicated by "indexPtr".
 *
 *	If 'viewUpdate' is true, we may adjust the window contents'
 *	y-position, and scrollbar setting.
 *
 *----------------------------------------------------------------------
 */

static int
InsertChars(
    TkSharedText *sharedTextPtr,
    TkText *textPtr,		/* Overall information about text widget. */
    TkTextIndex *indexPtr,	/* Where to insert new characters. May be
				 * modified if the index is not valid for
				 * insertion (e.g. if at "end"). */
    Tcl_Obj *stringPtr,		/* Null-terminated string containing new
				 * information to add to text. */
    int viewUpdate)		/* Update the view if set. */
{
    int lineIndex, length;
    TkText *tPtr;
    int *lineAndByteIndex;
    int resetViewCount;
    int pixels[2*PIXEL_CLIENTS];
    const char *string = Tcl_GetString(stringPtr);

    length = stringPtr->length;
    if (sharedTextPtr == NULL) {
	sharedTextPtr = textPtr->sharedTextPtr;
    }

    /*
     * Don't allow insertions on the last (dummy) line of the text. This is
     * the only place in this function where the indexPtr is modified.
     */

    lineIndex = TkBTreeLinesTo(textPtr, indexPtr->linePtr);
    if (lineIndex == TkBTreeNumLines(sharedTextPtr->tree, textPtr)) {
	lineIndex--;
	TkTextMakeByteIndex(sharedTextPtr->tree, textPtr, lineIndex, 1000000,
		indexPtr);
    }

    /*
     * Notify the display module that lines are about to change, then do the
     * insertion. If the insertion occurs on the top line of the widget
     * (textPtr->topIndex), then we have to recompute topIndex after the
     * insertion, since the insertion could invalidate it.
     */

    resetViewCount = 0;
    if (sharedTextPtr->refCount > PIXEL_CLIENTS) {
	lineAndByteIndex = ckalloc(sizeof(int) * 2 * sharedTextPtr->refCount);
    } else {
	lineAndByteIndex = pixels;
    }
    for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
	lineAndByteIndex[resetViewCount] = -1;
	if (indexPtr->linePtr == tPtr->topIndex.linePtr) {
	    lineAndByteIndex[resetViewCount] =
		    TkBTreeLinesTo(tPtr, indexPtr->linePtr);
	    lineAndByteIndex[resetViewCount+1] = tPtr->topIndex.byteIndex;
	    if (lineAndByteIndex[resetViewCount+1] > indexPtr->byteIndex) {
		lineAndByteIndex[resetViewCount+1] += length;
	    }
	}
	resetViewCount += 2;
    }

    TkTextChanged(sharedTextPtr, NULL, indexPtr, indexPtr);

    sharedTextPtr->stateEpoch++;

    TkBTreeInsertChars(sharedTextPtr->tree, indexPtr, string);

    /*
     * Push the insertion on the undo stack, and update the modified status of
     * the widget.
     */

    if (length > 0) {
	if (sharedTextPtr->undo) {
	    TkTextIndex toIndex;

	    if (sharedTextPtr->autoSeparators &&
		sharedTextPtr->lastEditMode != TK_TEXT_EDIT_INSERT) {
		TkUndoInsertUndoSeparator(sharedTextPtr->undoStack);
	    }

	    sharedTextPtr->lastEditMode = TK_TEXT_EDIT_INSERT;

	    TkTextIndexForwBytes(textPtr, indexPtr, length, &toIndex);
	    TextPushUndoAction(textPtr, stringPtr, 1, indexPtr, &toIndex);
	}

	UpdateDirtyFlag(sharedTextPtr);
    }

    resetViewCount = 0;
    for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
	if (lineAndByteIndex[resetViewCount] != -1) {
	    if ((tPtr != textPtr) || viewUpdate) {
		TkTextIndex newTop;

		TkTextMakeByteIndex(sharedTextPtr->tree, tPtr,
			lineAndByteIndex[resetViewCount], 0, &newTop);
		TkTextIndexForwBytes(tPtr, &newTop,
			lineAndByteIndex[resetViewCount+1], &newTop);
		TkTextSetYView(tPtr, &newTop, 0);
	    }
	}
	resetViewCount += 2;
    }
    if (sharedTextPtr->refCount > PIXEL_CLIENTS) {
	ckfree(lineAndByteIndex);
    }

    /*
     * Invalidate any selection retrievals in progress.
     */

    for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
	tPtr->abortSelections = 1;
    }

    /*
     * For convenience, return the length of the string.
     */

    return length;
}

/*
 *----------------------------------------------------------------------
 *
 * TextPushUndoAction --
 *
 *	Shared by insert and delete actions. Stores the appropriate scripts
 *	into our undo stack. We will add a single refCount to the 'undoString'
 *	object, so, if it previously had a refCount of zero, the caller should
 *	not free it.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Items pushed onto stack.
 *
 *----------------------------------------------------------------------
 */

static void
TextPushUndoAction(
    TkText *textPtr,		/* Overall information about text widget. */
    Tcl_Obj *undoString,	/* New text. */
    int insert,			/* 1 if insert, else delete. */
    const TkTextIndex *index1Ptr,
				/* Index describing first location. */
    const TkTextIndex *index2Ptr)
				/* Index describing second location. */
{
    TkUndoSubAtom *iAtom, *dAtom;

    /*
     * Create the helpers.
     */

    Tcl_Obj *seeInsertObj = Tcl_NewObj();
    Tcl_Obj *markSet1InsertObj = Tcl_NewObj();
    Tcl_Obj *markSet2InsertObj = NULL;
    Tcl_Obj *insertCmdObj = Tcl_NewObj();
    Tcl_Obj *deleteCmdObj = Tcl_NewObj();

    /*
     * Get the index positions.
     */

    Tcl_Obj *index1Obj = TkTextNewIndexObj(NULL, index1Ptr);
    Tcl_Obj *index2Obj = TkTextNewIndexObj(NULL, index2Ptr);

    /*
     * These need refCounts, because they are used more than once below.
     */

    Tcl_IncrRefCount(seeInsertObj);
    Tcl_IncrRefCount(index1Obj);
    Tcl_IncrRefCount(index2Obj);

    Tcl_ListObjAppendElement(NULL, seeInsertObj,
	    Tcl_NewStringObj(Tk_PathName(textPtr->tkwin), -1));
    Tcl_ListObjAppendElement(NULL, seeInsertObj, Tcl_NewStringObj("see", 3));
    Tcl_ListObjAppendElement(NULL, seeInsertObj,
	    Tcl_NewStringObj("insert", 6));

    Tcl_ListObjAppendElement(NULL, markSet1InsertObj,
	    Tcl_NewStringObj(Tk_PathName(textPtr->tkwin), -1));
    Tcl_ListObjAppendElement(NULL, markSet1InsertObj,
	    Tcl_NewStringObj("mark", 4));
    Tcl_ListObjAppendElement(NULL, markSet1InsertObj,
	    Tcl_NewStringObj("set", 3));
    Tcl_ListObjAppendElement(NULL, markSet1InsertObj,
	    Tcl_NewStringObj("insert", 6));
    markSet2InsertObj = Tcl_DuplicateObj(markSet1InsertObj);
    Tcl_ListObjAppendElement(NULL, markSet1InsertObj, index1Obj);
    Tcl_ListObjAppendElement(NULL, markSet2InsertObj, index2Obj);

    Tcl_ListObjAppendElement(NULL, insertCmdObj,
	    Tcl_NewStringObj("insert", 6));
    Tcl_ListObjAppendElement(NULL, insertCmdObj, index1Obj);

    /*
     * Only use of 'undoString' is here.
     */

    Tcl_ListObjAppendElement(NULL, insertCmdObj, undoString);

    Tcl_ListObjAppendElement(NULL, deleteCmdObj,
	    Tcl_NewStringObj("delete", 6));
    Tcl_ListObjAppendElement(NULL, deleteCmdObj, index1Obj);
    Tcl_ListObjAppendElement(NULL, deleteCmdObj, index2Obj);

    /*
     * Note: we don't wish to use textPtr->widgetCmd in these callbacks
     * because if we delete the textPtr, but peers still exist, we will then
     * have references to a non-existent Tcl_Command in the undo stack, which
     * will lead to crashes later. Also, the behaviour of the widget w.r.t.
     * bindings (%W substitutions) always uses the widget path name, so there
     * is no good reason the undo stack should do otherwise.
     *
     * For the 'insert' and 'delete' actions, we have to register a functional
     * callback, because these actions are defined to operate on the
     * underlying data shared by all peers.
     */

    iAtom = TkUndoMakeSubAtom(&TextUndoRedoCallback, textPtr->sharedTextPtr,
	    insertCmdObj, NULL);
    TkUndoMakeCmdSubAtom(NULL, markSet2InsertObj, iAtom);
    TkUndoMakeCmdSubAtom(NULL, seeInsertObj, iAtom);

    dAtom = TkUndoMakeSubAtom(&TextUndoRedoCallback, textPtr->sharedTextPtr,
	    deleteCmdObj, NULL);
    TkUndoMakeCmdSubAtom(NULL, markSet1InsertObj, dAtom);
    TkUndoMakeCmdSubAtom(NULL, seeInsertObj, dAtom);

    Tcl_DecrRefCount(seeInsertObj);
    Tcl_DecrRefCount(index1Obj);
    Tcl_DecrRefCount(index2Obj);

    /*
     * Depending whether the action is to insert or delete, we provide the
     * appropriate second and third arguments to TkUndoPushAction. (The first
     * is the 'actionCommand', and the second the 'revertCommand').
     */

    if (insert) {
	TkUndoPushAction(textPtr->sharedTextPtr->undoStack, iAtom, dAtom);
    } else {
	TkUndoPushAction(textPtr->sharedTextPtr->undoStack, dAtom, iAtom);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TextUndoRedoCallback --
 *
 *	This function is registered with the generic undo/redo code to handle
 *	'insert' and 'delete' actions on all text widgets. We cannot perform
 *	those actions on any particular text widget, because that text widget
 *	might have been deleted by the time we get here.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Will insert or delete text, depending on the first word contained in
 *	objPtr.
 *
 *----------------------------------------------------------------------
 */

int
TextUndoRedoCallback(
    Tcl_Interp *interp,		/* Current interpreter. */
    ClientData clientData,	/* Passed from undo code, but contains our
				 * shared text data structure. */
    Tcl_Obj *objPtr)		/* Arguments of a command to be handled by the
				 * shared text data structure. */
{
    TkSharedText *sharedPtr = clientData;
    int res, objc;
    Tcl_Obj **objv;
    TkText *textPtr;

    res = Tcl_ListObjGetElements(interp, objPtr, &objc, &objv);
    if (res != TCL_OK) {
	return res;
    }

    /*
     * If possible, use a real text widget to perform the undo/redo action
     * (i.e. insertion or deletion of text). This provides maximum
     * compatibility with older versions of Tk, in which the user may rename
     * the text widget to allow capture of undo or redo actions.
     *
     * In particular, this sorting of capture is useful in text editors based
     * on the Tk text widget, which need to know which new text needs
     * re-coloring.
     *
     * It would be better if the text widget provided some other mechanism to
     * allow capture of this information ("What has just changed in the text
     * widget?"). What we have here is not entirely satisfactory under all
     * circumstances.
     */

    textPtr = sharedPtr->peers;
    while (textPtr != NULL) {
	if (textPtr->start == NULL && textPtr->end == NULL) {
	    Tcl_Obj *cmdNameObj, *evalObj;

	    evalObj = Tcl_NewObj();
	    Tcl_IncrRefCount(evalObj);

	    /*
	     * We might wish to use the real, current command-name for the
	     * widget, but this will break any code that has over-ridden the
	     * widget, and is expecting to observe the insert/delete actions
	     * which are caused by undo/redo operations.
	     *
	     * cmdNameObj = Tcl_NewObj();
	     * Tcl_GetCommandFullName(interp, textPtr->widgetCmd, cmdNameObj);
	     *
	     * While such interception is not explicitly documented as
	     * supported, it does occur, and so until we can provide some
	     * alternative mechanism for such code to do what it needs, we
	     * allow it to take place here.
	     */

	    cmdNameObj = Tcl_NewStringObj(Tk_PathName(textPtr->tkwin), -1);
	    Tcl_ListObjAppendElement(NULL, evalObj, cmdNameObj);
	    Tcl_ListObjAppendList(NULL, evalObj, objPtr);
	    res = Tcl_EvalObjEx(interp, evalObj, TCL_EVAL_GLOBAL);
	    Tcl_DecrRefCount(evalObj);
	    return res;
	}
	textPtr = textPtr->next;
    }

    /*
     * If there's no current text widget which shows everything, then we fall
     * back on acting directly. This means there is no way to intercept from
     * the Tcl level.
     */

    return SharedTextObjCmd(sharedPtr, interp, objc+1, objv-1);
}

/*
 *----------------------------------------------------------------------
 *
 * CountIndices --
 *
 *	This function implements most of the functionality of the "count"
 *	widget command.
 *
 *	Note that 'textPtr' is only used if we need to check for elided
 *	attributes, i.e. if type is COUNT_DISPLAY_INDICES or
 *	COUNT_DISPLAY_CHARS
 *
 * Results:
 *	Returns the number of characters in the range.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
CountIndices(
    const TkText *textPtr,	/* Overall information about text widget. */
    const TkTextIndex *indexPtr1,
				/* Index describing location of first
				 * character to delete. */
    const TkTextIndex *indexPtr2,
				/* Index describing location of last character
				 * to delete. NULL means just delete the one
				 * character given by indexPtr1. */
    TkTextCountType type)	/* The kind of indices to count. */
{
    /*
     * Order the starting and stopping indices.
     */

    int compare = TkTextIndexCmp(indexPtr1, indexPtr2);

    if (compare == 0) {
	return 0;
    } else if (compare > 0) {
	return -TkTextIndexCount(textPtr, indexPtr2, indexPtr1, type);
    } else {
	return TkTextIndexCount(textPtr, indexPtr1, indexPtr2, type);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteIndexRange --
 *
 *	This function implements most of the functionality of the "delete"
 *	widget command.
 *
 * Results:
 *	Returns a standard Tcl result, currently always TCL_OK.
 *
 * Side effects:
 *	Characters and other entities (windows, images) get deleted from the
 *	text.
 *
 *	If 'viewUpdate' is true, we may adjust the window contents'
 *	y-position, and scrollbar setting.
 *
 *	If 'viewUpdate' is false, true we can guarantee that textPtr->topIndex
 *	points to a valid TkTextLine after this function returns. However, if
 *	'viewUpdate' is false, then there is no such guarantee (since
 *	topIndex.linePtr can be garbage). The caller is expected to take
 *	actions to ensure the topIndex is validated before laying out the
 *	window again.
 *
 *----------------------------------------------------------------------
 */

static int
DeleteIndexRange(
    TkSharedText *sharedTextPtr,/* Shared portion of peer widgets. */
    TkText *textPtr,		/* Overall information about text widget. */
    const TkTextIndex *indexPtr1,
				/* Index describing location of first
				 * character (or other entity) to delete. */
    const TkTextIndex *indexPtr2,
				/* Index describing location of last
				 * character (or other entity) to delete.
				 * NULL means just delete the one character
				 * given by indexPtr1. */
    int viewUpdate)		/* Update vertical view if set. */
{
    int line1, line2;
    TkTextIndex index1, index2;
    TkText *tPtr;
    int *lineAndByteIndex;
    int resetViewCount;
    int pixels[2*PIXEL_CLIENTS];

    if (sharedTextPtr == NULL) {
	sharedTextPtr = textPtr->sharedTextPtr;
    }

    /*
     * Prepare the starting and stopping indices.
     */

    index1 = *indexPtr1;
    if (indexPtr2 != NULL) {
	index2 = *indexPtr2;
    } else {
	index2 = index1;
	TkTextIndexForwChars(NULL, &index2, 1, &index2, COUNT_INDICES);
    }

    /*
     * Make sure there's really something to delete.
     */

    if (TkTextIndexCmp(&index1, &index2) >= 0) {
	return TCL_OK;
    }

    /*
     * The code below is ugly, but it's needed to make sure there is always a
     * dummy empty line at the end of the text. If the final newline of the
     * file (just before the dummy line) is being deleted, then back up index
     * to just before the newline. If there is a newline just before the first
     * character being deleted, then back up the first index too, so that an
     * even number of lines gets deleted. Furthermore, remove any tags that
     * are present on the newline that isn't going to be deleted after all
     * (this simulates deleting the newline and then adding a "clean" one back
     * again). Note that index1 and index2 might now be equal again which
     * means that no text will be deleted but tags might be removed.
     */

    line1 = TkBTreeLinesTo(textPtr, index1.linePtr);
    line2 = TkBTreeLinesTo(textPtr, index2.linePtr);
    if (line2 == TkBTreeNumLines(sharedTextPtr->tree, textPtr)) {
	TkTextTag **arrayPtr;
	int arraySize, i;
	TkTextIndex oldIndex2;

	oldIndex2 = index2;
	TkTextIndexBackChars(NULL, &oldIndex2, 1, &index2, COUNT_INDICES);
	line2--;
	if ((index1.byteIndex == 0) && (line1 != 0)) {
	    TkTextIndexBackChars(NULL, &index1, 1, &index1, COUNT_INDICES);
	    line1--;
	}
	arrayPtr = TkBTreeGetTags(&index2, NULL, &arraySize);
	if (arrayPtr != NULL) {
	    for (i = 0; i < arraySize; i++) {
		TkBTreeTag(&index2, &oldIndex2, arrayPtr[i], 0);
	    }
	    ckfree(arrayPtr);
	}
    }

    if (line1 < line2) {
	/*
	 * We are deleting more than one line. For speed, we remove all tags
	 * from the range first. If we don't do this, the code below can (when
	 * there are many tags) grow non-linearly in execution time.
	 */

	Tcl_HashSearch search;
	Tcl_HashEntry *hPtr;
	int i;

	for (i=0, hPtr=Tcl_FirstHashEntry(&sharedTextPtr->tagTable, &search);
		hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) {
	    TkTextTag *tagPtr = Tcl_GetHashValue(hPtr);

	    TkBTreeTag(&index1, &index2, tagPtr, 0);
	}

	/*
	 * Special case for the sel tag which is not in the hash table. We
	 * need to do this once for each peer text widget.
	 */

	for (tPtr = sharedTextPtr->peers; tPtr != NULL ;
		tPtr = tPtr->next) {
	    if (TkBTreeTag(&index1, &index2, tPtr->selTagPtr, 0)) {
		/*
		 * Send an event that the selection changed. This is
		 * equivalent to:
		 *	event generate $textWidget <<Selection>>
		 */

		TkTextSelectionEvent(textPtr);
		tPtr->abortSelections = 1;
	    }
	}
    }

    /*
     * Tell the display what's about to happen so it can discard obsolete
     * display information, then do the deletion. Also, if the deletion
     * involves the top line on the screen, then we have to reset the view
     * (the deletion will invalidate textPtr->topIndex). Compute what the new
     * first character will be, then do the deletion, then reset the view.
     */

    TkTextChanged(sharedTextPtr, NULL, &index1, &index2);

    resetViewCount = 0;
    if (sharedTextPtr->refCount > PIXEL_CLIENTS) {
	lineAndByteIndex = ckalloc(sizeof(int) * 2 * sharedTextPtr->refCount);
    } else {
	lineAndByteIndex = pixels;
    }
    for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
	int line = 0;
	int byteIndex = 0;
	int resetView = 0;

	if (TkTextIndexCmp(&index2, &tPtr->topIndex) >= 0) {
	    if (TkTextIndexCmp(&index1, &tPtr->topIndex) <= 0) {
		/*
		 * Deletion range straddles topIndex: use the beginning of the
		 * range as the new topIndex.
		 */

		resetView = 1;
		line = line1;
		byteIndex = index1.byteIndex;
	    } else if (index1.linePtr == tPtr->topIndex.linePtr) {
		/*
		 * Deletion range starts on top line but after topIndex. Use
		 * the current topIndex as the new one.
		 */

		resetView = 1;
		line = line1;
		byteIndex = tPtr->topIndex.byteIndex;
            } else {
                /*
                 * Deletion range starts after the top line. This peers's view
                 * will not need to be reset. Nothing to do.
                 */
	    }
	} else if (index2.linePtr == tPtr->topIndex.linePtr) {
	    /*
	     * Deletion range ends on top line but before topIndex. Figure out
	     * what will be the new character index for the character
	     * currently pointed to by topIndex.
	     */

	    resetView = 1;
	    line = line2;
	    byteIndex = tPtr->topIndex.byteIndex;
	    if (index1.linePtr != index2.linePtr) {
		byteIndex -= index2.byteIndex;
	    } else {
		byteIndex -= (index2.byteIndex - index1.byteIndex);
	    }
        } else {
            /*
             * Deletion range ends before the top line. This peers's view
             * will not need to be reset. Nothing to do.
             */
	}
	if (resetView) {
	    lineAndByteIndex[resetViewCount] = line;
	    lineAndByteIndex[resetViewCount+1] = byteIndex;
	} else {
	    lineAndByteIndex[resetViewCount] = -1;
	}
	resetViewCount += 2;
    }

    /*
     * Push the deletion on the undo stack if something was actually deleted.
     */

    if (TkTextIndexCmp(&index1, &index2) < 0) {
	if (sharedTextPtr->undo) {
	    Tcl_Obj *get;

	    if (sharedTextPtr->autoSeparators
		    && (sharedTextPtr->lastEditMode != TK_TEXT_EDIT_DELETE)) {
		TkUndoInsertUndoSeparator(sharedTextPtr->undoStack);
	    }

	    sharedTextPtr->lastEditMode = TK_TEXT_EDIT_DELETE;

	    get = TextGetText(textPtr, &index1, &index2, 0);
	    TextPushUndoAction(textPtr, get, 0, &index1, &index2);
	}
	sharedTextPtr->stateEpoch++;

	TkBTreeDeleteIndexRange(sharedTextPtr->tree, &index1, &index2);

    	UpdateDirtyFlag(sharedTextPtr);
    }

    resetViewCount = 0;
    for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
	int line = lineAndByteIndex[resetViewCount];

	if (line != -1) {
	    int byteIndex = lineAndByteIndex[resetViewCount+1];
	    TkTextIndex indexTmp;

	    if (tPtr == textPtr) {
                if (viewUpdate) {
                    /*
                     * line cannot be before -startline of textPtr because
                     * this line corresponds to an index which is necessarily
                     * between "1.0" and "end" relative to textPtr.
                     * Therefore no need to clamp line to the -start/-end
                     * range.
                     */

		    TkTextMakeByteIndex(sharedTextPtr->tree, textPtr, line,
			    byteIndex, &indexTmp);
		    TkTextSetYView(tPtr, &indexTmp, 0);
		}
	    } else {
                TkTextMakeByteIndex(sharedTextPtr->tree, tPtr, line,
			byteIndex, &indexTmp);
                /*
                 * line may be before -startline of tPtr and must be
                 * clamped to -startline before providing it to
                 * TkTextSetYView otherwise lines before -startline
                 * would be displayed.
                 * There is no need to worry about -endline however,
                 * because the view will only be reset if the deletion
                 * involves the TOP line of the screen
                 */

                if (tPtr->start != NULL) {
                    int start;
                    TkTextIndex indexStart;

                    start = TkBTreeLinesTo(NULL, tPtr->start);
                    TkTextMakeByteIndex(sharedTextPtr->tree, NULL, start,
			    0, &indexStart);
                    if (TkTextIndexCmp(&indexTmp, &indexStart) < 0) {
                        indexTmp = indexStart;
                    }
                }
		TkTextSetYView(tPtr, &indexTmp, 0);
	    }
	}
	resetViewCount += 2;
    }
    if (sharedTextPtr->refCount > PIXEL_CLIENTS) {
	ckfree(lineAndByteIndex);
    }

    if (line1 >= line2) {
	/*
	 * Invalidate any selection retrievals in progress, assuming we didn't
	 * check for this case above.
	 */

	for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) {
	    tPtr->abortSelections = 1;
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TextFetchSelection --
 *
 *	This function is called back by Tk when the selection is requested by
 *	someone. It returns part or all of the selection in a buffer provided
 *	by the caller.
 *
 * Results:
 *	The return value is the number of non-NULL bytes stored at buffer.
 *	Buffer is filled (or partially filled) with a NULL-terminated string
 *	containing part or all of the selection, as given by offset and
 *	maxBytes.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TextFetchSelection(
    ClientData clientData,	/* Information about text widget. */
    int offset,			/* Offset within selection of first character
				 * to be returned. */
    char *buffer,		/* Location in which to place selection. */
    int maxBytes)		/* Maximum number of bytes to place at buffer,
				 * not including terminating NULL
				 * character. */
{
    register TkText *textPtr = clientData;
    TkTextIndex eof;
    int count, chunkSize, offsetInSeg;
    TkTextSearch search;
    TkTextSegment *segPtr;

    if (!textPtr->exportSelection) {
	return -1;
    }

    /*
     * Find the beginning of the next range of selected text. Note: if the
     * selection is being retrieved in multiple pieces (offset != 0) and some
     * modification has been made to the text that affects the selection then
     * reject the selection request (make 'em start over again).
     */

    if (offset == 0) {
	TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
		&textPtr->selIndex);
	textPtr->abortSelections = 0;
    } else if (textPtr->abortSelections) {
	return 0;
    }
    TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
	    TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr), 0, &eof);
    TkBTreeStartSearch(&textPtr->selIndex, &eof, textPtr->selTagPtr, &search);
    if (!TkBTreeCharTagged(&textPtr->selIndex, textPtr->selTagPtr)) {
	if (!TkBTreeNextTag(&search)) {
	    if (offset == 0) {
		return -1;
	    } else {
		return 0;
	    }
	}
	textPtr->selIndex = search.curIndex;
    }

    /*
     * Each iteration through the outer loop below scans one selected range.
     * Each iteration through the inner loop scans one segment in the selected
     * range.
     */

    count = 0;
    while (1) {
	/*
	 * Find the end of the current range of selected text.
	 */

	if (!TkBTreeNextTag(&search)) {
	    Tcl_Panic("TextFetchSelection couldn't find end of range");
	}

	/*
	 * Copy information from character segments into the buffer until
	 * either we run out of space in the buffer or we get to the end of
	 * this range of text.
	 */

	while (1) {
	    if (maxBytes == 0) {
		goto fetchDone;
	    }
	    segPtr = TkTextIndexToSeg(&textPtr->selIndex, &offsetInSeg);
	    chunkSize = segPtr->size - offsetInSeg;
	    if (chunkSize > maxBytes) {
		chunkSize = maxBytes;
	    }
	    if (textPtr->selIndex.linePtr == search.curIndex.linePtr) {
		int leftInRange;

		leftInRange = search.curIndex.byteIndex
			- textPtr->selIndex.byteIndex;
		if (leftInRange < chunkSize) {
		    chunkSize = leftInRange;
		    if (chunkSize <= 0) {
			break;
		    }
		}
	    }
	    if ((segPtr->typePtr == &tkTextCharType)
		    && !TkTextIsElided(textPtr, &textPtr->selIndex, NULL)) {
		memcpy(buffer, segPtr->body.chars + offsetInSeg,
			(size_t) chunkSize);
		buffer += chunkSize;
		maxBytes -= chunkSize;
		count += chunkSize;
	    }
	    TkTextIndexForwBytes(textPtr, &textPtr->selIndex, chunkSize,
		    &textPtr->selIndex);
	}

	/*
	 * Find the beginning of the next range of selected text.
	 */

	if (!TkBTreeNextTag(&search)) {
	    break;
	}
	textPtr->selIndex = search.curIndex;
    }

  fetchDone:
    *buffer = 0;
    return count;
}

/*
 *----------------------------------------------------------------------
 *
 * TkTextLostSelection --
 *
 *	This function is called back by Tk when the selection is grabbed away
 *	from a text widget. On Windows and Mac systems, we want to remember
 *	the selection for the next time the focus enters the window. On Unix,
 *	just remove the "sel" tag from everything in the widget.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The "sel" tag is cleared from the window.
 *
 *----------------------------------------------------------------------
 */

void
TkTextLostSelection(
    ClientData clientData)	/* Information about text widget. */
{
    register TkText *textPtr = clientData;

    if (TkpAlwaysShowSelection(textPtr->tkwin)) {
	TkTextIndex start, end;

	if (!textPtr->exportSelection) {
	    return;
	}

	/*
	 * On Windows and Mac systems, we want to remember the selection for
	 * the next time the focus enters the window. On Unix, just remove the
	 * "sel" tag from everything in the widget.
	 */

	TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
		0, 0, &start);
	TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
		TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
		0, &end);
	TkTextRedrawTag(NULL, textPtr, &start, &end, textPtr->selTagPtr, 1);
	TkBTreeTag(&start, &end, textPtr->selTagPtr, 0);
    }

    /*
     * Send an event that the selection changed. This is equivalent to:
     *	   event generate $textWidget <<Selection>>
     */

    TkTextSelectionEvent(textPtr);

    textPtr->flags &= ~GOT_SELECTION;
}

/*
 *----------------------------------------------------------------------
 *
 * TkTextSelectionEvent --
 *
 *	When anything relevant to the "sel" tag has been changed, call this
 *	function to generate a <<Selection>> event.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If <<Selection>> bindings are present, they will trigger.
 *
 *----------------------------------------------------------------------
 */

void
TkTextSelectionEvent(
    TkText *textPtr)
{
    /*
     * Send an event that the selection changed. This is equivalent to:
     *     event generate $textWidget <<Selection>>
     */

    union {XEvent general; XVirtualEvent virtual;} event;

    memset(&event, 0, sizeof(event));
    event.general.xany.type = VirtualEvent;
    event.general.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
    event.general.xany.send_event = False;
    event.general.xany.window = Tk_WindowId(textPtr->tkwin);
    event.general.xany.display = Tk_Display(textPtr->tkwin);
    event.virtual.name = Tk_GetUid("Selection");
    Tk_HandleEvent(&event.general);
}

/*
 *----------------------------------------------------------------------
 *
 * TextBlinkProc --
 *
 *	This function is called as a timer handler to blink the insertion
 *	cursor off and on.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The cursor gets turned on or off, redisplay gets invoked, and this
 *	function reschedules itself.
 *
 *----------------------------------------------------------------------
 */

static void
TextBlinkProc(
    ClientData clientData)	/* Pointer to record describing text. */
{
    register TkText *textPtr = clientData;
    TkTextIndex index;
    int x, y, w, h, charWidth;

    if ((textPtr->state == TK_TEXT_STATE_DISABLED) ||
	    !(textPtr->flags & GOT_FOCUS) || (textPtr->insertOffTime == 0)) {
	if (!(textPtr->flags & GOT_FOCUS) &&
		(textPtr->insertUnfocussed != TK_TEXT_INSERT_NOFOCUS_NONE)) {
	    /*
	     * The widget doesn't have the focus yet it is configured to
	     * display the cursor when it doesn't have the focus. Act now!
	     */

	    textPtr->flags |= INSERT_ON;
	    goto redrawInsert;
	}
	if ((textPtr->insertOffTime == 0) && !(textPtr->flags & INSERT_ON)) {
	    /*
	     * The widget was configured to have zero offtime while the
	     * insertion point was not displayed. We have to display it once.
	     */

	    textPtr->flags |= INSERT_ON;
	    goto redrawInsert;
	}
	return;
    }
    if (textPtr->flags & INSERT_ON) {
	textPtr->flags &= ~INSERT_ON;
	textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
		textPtr->insertOffTime, TextBlinkProc, textPtr);
    } else {
	textPtr->flags |= INSERT_ON;
	textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
		textPtr->insertOnTime, TextBlinkProc, textPtr);
    }
  redrawInsert:
    TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
    if (TkTextIndexBbox(textPtr, &index, &x, &y, &w, &h, &charWidth) == 0) {
	if (textPtr->insertCursorType) {
	    /* Block cursor */
	    TkTextRedrawRegion(textPtr, x - textPtr->width / 2, y,
		    charWidth + textPtr->insertWidth / 2, h);
	} else {
	    /* I-beam cursor */
	    TkTextRedrawRegion(textPtr, x - textPtr->insertWidth / 2, y,
		    textPtr->insertWidth, h);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TextInsertCmd --
 *
 *	This function is invoked to process the "insert" and "replace" widget
 *	commands for text widgets.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *	If 'viewUpdate' is true, we may adjust the window contents'
 *	y-position, and scrollbar setting.
 *
 *----------------------------------------------------------------------
 */

static int
TextInsertCmd(
    TkSharedText *sharedTextPtr,/* Shared portion of peer widgets. */
    TkText *textPtr,		/* Information about text widget. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects. */
    const TkTextIndex *indexPtr,/* Index at which to insert. */
    int viewUpdate)		/* Update the view if set. */
{
    TkTextIndex index1, index2;
    int j;

    if (sharedTextPtr == NULL) {
	sharedTextPtr = textPtr->sharedTextPtr;
    }

    index1 = *indexPtr;
    for (j = 0; j < objc; j += 2) {
	/*
	 * Here we rely on this call to modify index1 if it is outside the
	 * acceptable range. In particular, if index1 is "end", it must be set
	 * to the last allowable index for insertion, otherwise subsequent tag
	 * insertions will fail.
	 */

	int length = InsertChars(sharedTextPtr, textPtr, &index1, objv[j],
		viewUpdate);

	if (objc > (j+1)) {
	    Tcl_Obj **tagNamePtrs;
	    TkTextTag **oldTagArrayPtr;
	    int numTags;

	    TkTextIndexForwBytes(textPtr, &index1, length, &index2);
	    oldTagArrayPtr = TkBTreeGetTags(&index1, NULL, &numTags);
	    if (oldTagArrayPtr != NULL) {
		int i;

		for (i = 0; i < numTags; i++) {
		    TkBTreeTag(&index1, &index2, oldTagArrayPtr[i], 0);
		}
		ckfree(oldTagArrayPtr);
	    }
	    if (Tcl_ListObjGetElements(interp, objv[j+1], &numTags,
		    &tagNamePtrs) != TCL_OK) {
		return TCL_ERROR;
	    } else {
		int i;

		for (i = 0; i < numTags; i++) {
		    const char *strTag = Tcl_GetString(tagNamePtrs[i]);

		    TkBTreeTag(&index1, &index2,
			    TkTextCreateTag(textPtr, strTag, NULL), 1);
		}
		index1 = index2;
	    }
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TextSearchCmd --
 *
 *	This function is invoked to process the "search" widget command for
 *	text widgets. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
TextSearchCmd(
    TkText *textPtr,		/* Information about text widget. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, argsLeft, code;
    SearchSpec searchSpec;

    static const char *const switchStrings[] = {
	"-hidden",
	"--", "-all", "-backwards", "-count", "-elide", "-exact", "-forwards",
	"-nocase", "-nolinestop", "-overlap", "-regexp", "-strictlimits", NULL
    };
    enum SearchSwitches {
	SEARCH_HIDDEN,
	SEARCH_END, SEARCH_ALL, SEARCH_BACK, SEARCH_COUNT, SEARCH_ELIDE,
	SEARCH_EXACT, SEARCH_FWD, SEARCH_NOCASE,
	SEARCH_NOLINESTOP, SEARCH_OVERLAP, SEARCH_REGEXP, SEARCH_STRICTLIMITS
    };

    /*
     * Set up the search specification, including the last 4 fields which are
     * text widget specific.
     */

    searchSpec.exact = 1;
    searchSpec.noCase = 0;
    searchSpec.all = 0;
    searchSpec.backwards = 0;
    searchSpec.varPtr = NULL;
    searchSpec.countPtr = NULL;
    searchSpec.resPtr = NULL;
    searchSpec.searchElide = 0;
    searchSpec.noLineStop = 0;
    searchSpec.overlap = 0;
    searchSpec.strictLimits = 0;
    searchSpec.numLines =
	    TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr);
    searchSpec.clientData = textPtr;
    searchSpec.addLineProc = &TextSearchAddNextLine;
    searchSpec.foundMatchProc = &TextSearchFoundMatch;
    searchSpec.lineIndexProc = &TextSearchGetLineIndex;

    /*
     * Parse switches and other arguments.
     */

    for (i=2 ; i<objc ; i++) {
	int index;

	if (Tcl_GetString(objv[i])[0] != '-') {
	    break;
	}

	if (Tcl_GetIndexFromObjStruct(NULL, objv[i], switchStrings,
		sizeof(char *), "switch", 0, &index) != TCL_OK) {
	    /*
	     * Hide the -hidden option, generating the error description with
	     * the side effects of T_GIFO.
	     */

	    (void) Tcl_GetIndexFromObjStruct(interp, objv[i], switchStrings+1,
		    sizeof(char *), "switch", 0, &index);
	    return TCL_ERROR;
	}

	switch ((enum SearchSwitches) index) {
	case SEARCH_END:
	    i++;
	    goto endOfSwitchProcessing;
	case SEARCH_ALL:
	    searchSpec.all = 1;
	    break;
	case SEARCH_BACK:
	    searchSpec.backwards = 1;
	    break;
	case SEARCH_COUNT:
	    if (i >= objc-1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no value given for \"-count\" option", -1));
		Tcl_SetErrorCode(interp, "TK", "TEXT", "VALUE", NULL);
		return TCL_ERROR;
	    }
	    i++;

	    /*
	     * Assumption objv[i] isn't going to disappear on us during this
	     * function, which is fair.
	     */

	    searchSpec.varPtr = objv[i];
	    break;
	case SEARCH_ELIDE:
	case SEARCH_HIDDEN:
	    searchSpec.searchElide = 1;
	    break;
	case SEARCH_EXACT:
	    searchSpec.exact = 1;
	    break;
	case SEARCH_FWD:
	    searchSpec.backwards = 0;
	    break;
	case SEARCH_NOCASE:
	    searchSpec.noCase = 1;
	    break;
	case SEARCH_NOLINESTOP:
	    searchSpec.noLineStop = 1;
	    break;
	case SEARCH_OVERLAP:
	    searchSpec.overlap = 1;
	    break;
	case SEARCH_STRICTLIMITS:
	    searchSpec.strictLimits = 1;
	    break;
	case SEARCH_REGEXP:
	    searchSpec.exact = 0;
	    break;
	default:
	    Tcl_Panic("unexpected switch fallthrough");
	}
    }
  endOfSwitchProcessing:

    argsLeft = objc - (i+2);
    if ((argsLeft != 0) && (argsLeft != 1)) {
	Tcl_WrongNumArgs(interp, 2, objv,
		"?switches? pattern index ?stopIndex?");
	return TCL_ERROR;
    }

    if (searchSpec.noLineStop && searchSpec.exact) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"the \"-nolinestop\" option requires the \"-regexp\" option"
		" to be present", -1));
	Tcl_SetErrorCode(interp, "TK", "TEXT", "SEARCH_USAGE", NULL);
	return TCL_ERROR;
    }

    if (searchSpec.overlap && !searchSpec.all) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"the \"-overlap\" option requires the \"-all\" option"
		" to be present", -1));
	Tcl_SetErrorCode(interp, "TK", "TEXT", "SEARCH_USAGE", NULL);
	return TCL_ERROR;
    }

    /*
     * Scan through all of the lines of the text circularly, starting at the
     * given index. 'objv[i]' is the pattern which may be an exact string or a
     * regexp pattern depending on the flags set above.
     */

    code = SearchPerform(interp, &searchSpec, objv[i], objv[i+1],
	    (argsLeft == 1 ? objv[i+2] : NULL));
    if (code != TCL_OK) {
	goto cleanup;
    }

    /*
     * Set the '-count' variable, if given.
     */

    if (searchSpec.varPtr != NULL && searchSpec.countPtr != NULL) {
	Tcl_IncrRefCount(searchSpec.countPtr);
	if (Tcl_ObjSetVar2(interp, searchSpec.varPtr, NULL,
		searchSpec.countPtr, TCL_LEAVE_ERR_MSG) == NULL) {
	    code = TCL_ERROR;
	    goto cleanup;
	}
    }

    /*
     * Set the result.
     */

    if (searchSpec.resPtr != NULL) {
	Tcl_SetObjResult(interp, searchSpec.resPtr);
	searchSpec.resPtr = NULL;
    }

  cleanup:
    if (searchSpec.countPtr != NULL) {
	Tcl_DecrRefCount(searchSpec.countPtr);
    }
    if (searchSpec.resPtr != NULL) {
	Tcl_DecrRefCount(searchSpec.resPtr);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TextSearchGetLineIndex --
 *
 *	Extract a row, text offset index position from an objPtr
 *
 *	This means we ignore any embedded windows/images and elidden text
 *	(unless we are searching that).
 *
 * Results:
 *	Standard Tcl error code (with a message in the interpreter on error
 *	conditions).
 *
 *	The offset placed in offsetPosPtr is a utf-8 char* byte index for
 *	exact searches, and a Unicode character index for regexp searches.
 *
 *	The line number should start at zero (searches which wrap around
 *	assume the first line is numbered 0).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TextSearchGetLineIndex(
    Tcl_Interp *interp,		/* For error messages. */
    Tcl_Obj *objPtr,		/* Contains a textual index like "1.2" */
    SearchSpec *searchSpecPtr,	/* Contains other search parameters. */
    int *linePosPtr,		/* For returning the line number. */
    int *offsetPosPtr)		/* For returning the text offset in the
				 * line. */
{
    const TkTextIndex *indexPtr;
    int line;
    TkText *textPtr = searchSpecPtr->clientData;

    indexPtr = TkTextGetIndexFromObj(interp, textPtr, objPtr);
    if (indexPtr == NULL) {
	return TCL_ERROR;
    }

    line = TkBTreeLinesTo(textPtr, indexPtr->linePtr);
    if (line >= searchSpecPtr->numLines) {
	TkTextLine *linePtr;
	int count = 0;
	TkTextSegment *segPtr;

	line = searchSpecPtr->numLines-1;
	linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr, line);

	/*
	 * Count the number of bytes in this line.
	 */

	for (segPtr=linePtr->segPtr ; segPtr!=NULL ; segPtr=segPtr->nextPtr) {
	    count += segPtr->size;
	}
	*offsetPosPtr = TextSearchIndexInLine(searchSpecPtr, linePtr, count);
    } else {
	*offsetPosPtr = TextSearchIndexInLine(searchSpecPtr,
		indexPtr->linePtr, indexPtr->byteIndex);
    }

    *linePosPtr = line;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TextSearchIndexInLine --
 *
 *	Find textual index of 'byteIndex' in the searchable characters of
 *	'linePtr'.
 *
 *	This means we ignore any embedded windows/images and elidden text
 *	(unless we are searching that).
 *
 * Results:
 *	The returned index is a utf-8 char* byte index for exact searches, and
 *	a Unicode character index for regexp searches.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TextSearchIndexInLine(
    const SearchSpec *searchSpecPtr,
				/* Search parameters. */
    TkTextLine *linePtr,	/* The line we're looking at. */
    int byteIndex)		/* Index into the line. */
{
    TkTextSegment *segPtr;
    TkTextIndex curIndex;
    int index, leftToScan;
    TkText *textPtr = searchSpecPtr->clientData;

    index = 0;
    curIndex.tree = textPtr->sharedTextPtr->tree;
    curIndex.linePtr = linePtr; curIndex.byteIndex = 0;
    for (segPtr = linePtr->segPtr, leftToScan = byteIndex;
	    leftToScan > 0;
	    curIndex.byteIndex += segPtr->size, segPtr = segPtr->nextPtr) {
	if ((segPtr->typePtr == &tkTextCharType) &&
		(searchSpecPtr->searchElide
		|| !TkTextIsElided(textPtr, &curIndex, NULL))) {
	    if (leftToScan < segPtr->size) {
		if (searchSpecPtr->exact) {
		    index += leftToScan;
		} else {
		    index += Tcl_NumUtfChars(segPtr->body.chars, leftToScan);
		}
	    } else if (searchSpecPtr->exact) {
		index += segPtr->size;
	    } else {
		index += Tcl_NumUtfChars(segPtr->body.chars, -1);
	    }
	}
	leftToScan -= segPtr->size;
    }
    return index;
}

/*
 *----------------------------------------------------------------------
 *
 * TextSearchAddNextLine --
 *
 *	Adds a line from the text widget to the object 'theLine'.
 *
 * Results:
 *	A pointer to the TkTextLine corresponding to the given line, or NULL
 *	if there was no available line.
 *
 *	Also 'lenPtr' (if non-NULL) is filled in with the total length of
 *	'theLine' (not just what we added to it, but the length including what
 *	was already in there). This is in bytes for an exact search and in
 *	chars for a regexp search.
 *
 *	Also 'extraLinesPtr' (if non-NULL) will have its value incremented by
 *	1 for each additional logical line we have added because a newline is
 *	elided (this will only ever happen if we have chosen not to search
 *	elided text, of course).
 *
 * Side effects:
 *	Memory may be allocated or re-allocated for theLine's string
 *	representation.
 *
 *----------------------------------------------------------------------
 */

static ClientData
TextSearchAddNextLine(
    int lineNum,		/* Line we must add. */
    SearchSpec *searchSpecPtr,	/* Search parameters. */
    Tcl_Obj *theLine,		/* Object to append to. */
    int *lenPtr,		/* For returning the total length. */
    int *extraLinesPtr)		/* If non-NULL, will have its value
				 * incremented by the number of additional
				 * logical lines which are merged into this
				 * one by newlines being elided. */
{
    TkTextLine *linePtr, *thisLinePtr;
    TkTextIndex curIndex;
    TkTextSegment *segPtr;
    TkText *textPtr = searchSpecPtr->clientData;
    int nothingYet = 1;

    /*
     * Extract the text from the line.
     */

    linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr, lineNum);
    if (linePtr == NULL) {
	return NULL;
    }
    curIndex.tree = textPtr->sharedTextPtr->tree;
    thisLinePtr = linePtr;

    while (thisLinePtr != NULL) {
	int elideWraps = 0;

	curIndex.linePtr = thisLinePtr;
	curIndex.byteIndex = 0;
	for (segPtr = thisLinePtr->segPtr; segPtr != NULL;
		curIndex.byteIndex += segPtr->size, segPtr = segPtr->nextPtr) {
	    if (!searchSpecPtr->searchElide
		    && TkTextIsElided(textPtr, &curIndex, NULL)) {
		/*
		 * If we reach the end of the logical line, and if we have at
		 * least one character in the string, then we continue
		 * wrapping to the next logical line. If there are no
		 * characters yet, then the entire line of characters is
		 * elided and there's no need to complicate matters by
		 * wrapping - we'll look at the next line in due course.
		 */

		if (segPtr->nextPtr == NULL && !nothingYet) {
		    elideWraps = 1;
		}
		continue;
	    }
	    if (segPtr->typePtr != &tkTextCharType) {
		continue;
	    }
	    Tcl_AppendToObj(theLine, segPtr->body.chars, segPtr->size);
	    nothingYet = 0;
	}
	if (!elideWraps) {
	    break;
	}
	lineNum++;
	if (lineNum >= searchSpecPtr->numLines) {
	    break;
	}
	thisLinePtr = TkBTreeNextLine(textPtr, thisLinePtr);
	if (thisLinePtr != NULL && extraLinesPtr != NULL) {
	    /*
	     * Tell our caller we have an extra line merged in.
	     */

	    *extraLinesPtr = (*extraLinesPtr) + 1;
	}
    }

    /*
     * If we're ignoring case, convert the line to lower case. There is no
     * need to do this for regexp searches, since they handle a flag for this
     * purpose.
     */

    if (searchSpecPtr->exact && searchSpecPtr->noCase) {
	Tcl_SetObjLength(theLine, Tcl_UtfToLower(Tcl_GetString(theLine)));
    }

    if (lenPtr != NULL) {
	if (searchSpecPtr->exact) {
	    (void)Tcl_GetString(theLine);
	    *lenPtr = theLine->length;
	} else {
	    *lenPtr = Tcl_GetCharLength(theLine);
	}
    }
    return linePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TextSearchFoundMatch --
 *
 *	Stores information from a successful search.
 *
 * Results:
 *	1 if the information was stored, 0 if the position at which the match
 *	was found actually falls outside the allowable search region (and
 *	therefore the search is actually complete).
 *
 * Side effects:
 *	Memory may be allocated in the 'countPtr' and 'resPtr' fields of
 *	'searchSpecPtr'. Each of those objects will have refCount zero and
 *	must eventually be freed or stored elsewhere as appropriate.
 *
 *----------------------------------------------------------------------
 */

static int
TextSearchFoundMatch(
    int lineNum,		/* Line on which match was found. */
    SearchSpec *searchSpecPtr,	/* Search parameters. */
    ClientData clientData,	/* Token returned by the 'addNextLineProc',
				 * TextSearchAddNextLine. May be NULL, in
				 * which we case we must generate it (from
				 * lineNum). */
    Tcl_Obj *theLine,		/* Text from current line, only accessed for
				 * exact searches, and is allowed to be NULL
				 * for regexp searches. */
    int matchOffset,		/* Offset of found item in utf-8 bytes for
				 * exact search, Unicode chars for regexp. */
    int matchLength)		/* Length also in bytes/chars as per search
				 * type. */
{
    int numChars;
    int leftToScan;
    TkTextIndex curIndex, foundIndex;
    TkTextSegment *segPtr;
    TkTextLine *linePtr;
    TkText *textPtr = searchSpecPtr->clientData;

    if (lineNum == searchSpecPtr->stopLine) {
	/*
	 * If the current index is on the wrong side of the stopIndex, then
	 * the item we just found is actually outside the acceptable range,
	 * and the search is over.
	 */

	if (searchSpecPtr->backwards ^
		(matchOffset >= searchSpecPtr->stopOffset)) {
	    return 0;
	}
    }

    /*
     * Calculate the character count, which may need augmenting if there are
     * embedded windows or elidden text.
     */

    if (searchSpecPtr->exact) {
	const char *startOfLine = Tcl_GetString(theLine);

	numChars = Tcl_NumUtfChars(startOfLine + matchOffset, matchLength);
    } else {
	numChars = matchLength;
    }

    /*
     * If we're using strict limits checking, ensure that the match with its
     * full length fits inside the given range.
     */

    if (searchSpecPtr->strictLimits && lineNum == searchSpecPtr->stopLine) {
	if (searchSpecPtr->backwards ^
		((matchOffset + numChars) > searchSpecPtr->stopOffset)) {
	    return 0;
	}
    }

    /*
     * The index information returned by the regular expression parser only
     * considers textual information: it doesn't account for embedded windows,
     * elided text (when we are not searching elided text) or any other
     * non-textual info. Scan through the line's segments again to adjust both
     * matchChar and matchCount.
     *
     * We will walk through the segments of this line until we have either
     * reached the end of the match or we have reached the end of the line.
     */

    linePtr = clientData;
    if (linePtr == NULL) {
	linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr,
		lineNum);
    }

    curIndex.tree = textPtr->sharedTextPtr->tree;

    /*
     * Find the starting point.
     */

    leftToScan = matchOffset;
    while (1) {
	curIndex.linePtr = linePtr;
	curIndex.byteIndex = 0;

	/*
	 * Note that we allow leftToScan to be zero because we want to skip
	 * over any preceding non-textual items.
	 */

	for (segPtr = linePtr->segPtr; leftToScan >= 0 && segPtr;
		segPtr = segPtr->nextPtr) {
	    if (segPtr->typePtr != &tkTextCharType) {
		matchOffset += segPtr->size;
	    } else if (!searchSpecPtr->searchElide
		    && TkTextIsElided(textPtr, &curIndex, NULL)) {
		if (searchSpecPtr->exact) {
		    matchOffset += segPtr->size;
		} else {
		    matchOffset += Tcl_NumUtfChars(segPtr->body.chars, -1);
		}
	    } else {
		leftToScan -= segPtr->size;
	    }
	    curIndex.byteIndex += segPtr->size;
	}
	if (segPtr == NULL && leftToScan >= 0) {
	    /*
	     * This will only happen if we are eliding newlines.
	     */

	    linePtr = TkBTreeNextLine(textPtr, linePtr);
	    if (linePtr == NULL) {
		/*
		 * If we reach the end of the text, we have a serious problem,
		 * unless there's actually nothing left to look for.
		 */

		if (leftToScan == 0) {
		    break;
		} else {
		    Tcl_Panic("Reached end of text in a match");
		}
	    }

	    /*
	     * We've wrapped to the beginning of the next logical line, which
	     * has been merged with the previous one whose newline was elided.
	     */

	    lineNum++;
	    matchOffset = 0;
	} else {
	    break;
	}
    }

    /*
     * Calculate and store the found index in the result.
     */

    if (searchSpecPtr->exact) {
	TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, lineNum,
		matchOffset, &foundIndex);
    } else {
	TkTextMakeCharIndex(textPtr->sharedTextPtr->tree, textPtr, lineNum,
		matchOffset, &foundIndex);
    }

    if (searchSpecPtr->all) {
	if (searchSpecPtr->resPtr == NULL) {
	    searchSpecPtr->resPtr = Tcl_NewObj();
	}
	Tcl_ListObjAppendElement(NULL, searchSpecPtr->resPtr,
		TkTextNewIndexObj(textPtr, &foundIndex));
    } else {
	searchSpecPtr->resPtr = TkTextNewIndexObj(textPtr, &foundIndex);
    }

    /*
     * Find the end point. Here 'leftToScan' could be negative already as a
     * result of the above loop if the segment we reached spanned the start of
     * the string. When we add matchLength it will become non-negative.
     */

    for (leftToScan += matchLength; leftToScan > 0;
	    curIndex.byteIndex += segPtr->size, segPtr = segPtr->nextPtr) {
	if (segPtr == NULL) {
	    /*
	     * We are on the next line - this of course should only ever
	     * happen with searches which have matched across multiple lines.
	     */

	    linePtr = TkBTreeNextLine(textPtr, linePtr);
	    segPtr = linePtr->segPtr;
	    curIndex.linePtr = linePtr; curIndex.byteIndex = 0;
	}
	if (segPtr->typePtr != &tkTextCharType) {
	    /*
	     * Anything we didn't count in the search needs adding.
	     */

	    numChars += segPtr->size;
	    continue;
	} else if (!searchSpecPtr->searchElide
		&& TkTextIsElided(textPtr, &curIndex, NULL)) {
	    numChars += Tcl_NumUtfChars(segPtr->body.chars, -1);
	    continue;
	}
	if (searchSpecPtr->exact) {
	    leftToScan -= segPtr->size;
	} else {
	    leftToScan -= Tcl_NumUtfChars(segPtr->body.chars, -1);
	}
    }

    /*
     * Now store the count result, if it is wanted.
     */

    if (searchSpecPtr->varPtr != NULL) {
	Tcl_Obj *tmpPtr = Tcl_NewIntObj(numChars);
	if (searchSpecPtr->all) {
	    if (searchSpecPtr->countPtr == NULL) {
		searchSpecPtr->countPtr = Tcl_NewObj();
	    }
	    Tcl_ListObjAppendElement(NULL, searchSpecPtr->countPtr, tmpPtr);
	} else {
	    searchSpecPtr->countPtr = tmpPtr;
	}
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * TkTextGetTabs --
 *
 *	Parses a string description of a set of tab stops.
 *
 * Results:
 *	The return value is a pointer to a malloc'ed structure holding parsed
 *	information about the tab stops. If an error occurred then the return
 *	value is NULL and an error message is left in the interp's result.
 *
 * Side effects:
 *	Memory is allocated for the structure that is returned. It is up to
 *	the caller to free this structure when it is no longer needed.
 *
 *----------------------------------------------------------------------
 */

TkTextTabArray *
TkTextGetTabs(
    Tcl_Interp *interp,		/* Used for error reporting. */
    TkText *textPtr,		/* Information about the text widget. */
    Tcl_Obj *stringPtr)		/* Description of the tab stops. See the text
				 * manual entry for details. */
{
    int objc, i, count;
    Tcl_Obj **objv;
    TkTextTabArray *tabArrayPtr;
    TkTextTab *tabPtr;
    Tcl_UniChar ch;
    double prevStop, lastStop;
    /*
     * Map these strings to TkTextTabAlign values.
     */
    static const char *const tabOptionStrings[] = {
	"left", "right", "center", "numeric", NULL
    };

    if (Tcl_ListObjGetElements(interp, stringPtr, &objc, &objv) != TCL_OK) {
	return NULL;
    }

    /*
     * First find out how many entries we need to allocate in the tab array.
     */

    count = 0;
    for (i = 0; i < objc; i++) {
	char c = Tcl_GetString(objv[i])[0];

	if ((c != 'l') && (c != 'r') && (c != 'c') && (c != 'n')) {
	    count++;
	}
    }

    /*
     * Parse the elements of the list one at a time to fill in the array.
     */

    tabArrayPtr = ckalloc(sizeof(TkTextTabArray)
	    + (count - 1) * sizeof(TkTextTab));
    tabArrayPtr->numTabs = 0;
    prevStop = 0.0;
    lastStop = 0.0;
    for (i = 0, tabPtr = &tabArrayPtr->tabs[0]; i < objc; i++, tabPtr++) {
	int index;

	/*
	 * This will round fractional pixels above 0.5 upwards, and otherwise
	 * downwards, to find the right integer pixel position.
	 */

	if (Tk_GetPixelsFromObj(interp, textPtr->tkwin, objv[i],
		&tabPtr->location) != TCL_OK) {
	    goto error;
	}

	if (tabPtr->location <= 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "tab stop \"%s\" is not at a positive distance",
		    Tcl_GetString(objv[i])));
	    Tcl_SetErrorCode(interp, "TK", "VALUE", "TAB_STOP", NULL);
	    goto error;
	}

	prevStop = lastStop;
	if (Tk_GetDoublePixelsFromObj(interp, textPtr->tkwin, objv[i],
		&lastStop) != TCL_OK) {
	    goto error;
	}

	if (i > 0 && (tabPtr->location <= (tabPtr-1)->location)) {
	    /*
	     * This tab is actually to the left of the previous one, which is
	     * illegal.
	     */

#ifdef _TK_ALLOW_DECREASING_TABS
	    /*
	     * Force the tab to be a typical character width to the right of
	     * the previous one, and update the 'lastStop' with the changed
	     * position.
	     */

	    if (textPtr->charWidth > 0) {
		tabPtr->location = (tabPtr-1)->location + textPtr->charWidth;
	    } else {
		tabPtr->location = (tabPtr-1)->location + 8;
	    }
	    lastStop = tabPtr->location;
#else
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "tabs must be monotonically increasing, but \"%s\" is "
		    "smaller than or equal to the previous tab",
		    Tcl_GetString(objv[i])));
	    Tcl_SetErrorCode(interp, "TK", "VALUE", "TAB_STOP", NULL);
	    goto error;
#endif /* _TK_ALLOW_DECREASING_TABS */
	}

	tabArrayPtr->numTabs++;

	/*
	 * See if there is an explicit alignment in the next list element.
	 * Otherwise just use "left".
	 */

	tabPtr->alignment = LEFT;
	if ((i+1) == objc) {
	    continue;
	}

	/*
	 * There may be a more efficient way of getting this.
	 */

	Tcl_UtfToUniChar(Tcl_GetString(objv[i+1]), &ch);
	if (!Tcl_UniCharIsAlpha(ch)) {
	    continue;
	}
	i += 1;

	if (Tcl_GetIndexFromObjStruct(interp, objv[i], tabOptionStrings,
		sizeof(char *), "tab alignment", 0, &index) != TCL_OK) {
	    goto error;
	}
	tabPtr->alignment = (TkTextTabAlign) index;
    }

    /*
     * For when we need to interpolate tab stops, store these two so we know
     * the tab stop size to very high precision. With the above checks, we can
     * guarantee that tabIncrement is strictly positive here.
     */

    tabArrayPtr->lastTab = lastStop;
    tabArrayPtr->tabIncrement = lastStop - prevStop;

    return tabArrayPtr;

  error:
    ckfree(tabArrayPtr);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TextDumpCmd --
 *
 *	Return information about the text, tags, marks, and embedded windows
 *	and images in a text widget. See the man page for the description of
 *	the text dump operation for all the details.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Memory is allocated for the result, if needed (standard Tcl result
 *	side effects).
 *
 *----------------------------------------------------------------------
 */

static int
TextDumpCmd(
    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 "dump". */
{
    TkTextIndex index1, index2;
    int arg;
    int lineno;			/* Current line number. */
    int what = 0;		/* bitfield to select segment types. */
    int atEnd;			/* True if dumping up to logical end. */
    TkTextLine *linePtr;
    Tcl_Obj *command = NULL;	/* Script callback to apply to segments. */
#define TK_DUMP_TEXT	0x1
#define TK_DUMP_MARK	0x2
#define TK_DUMP_TAG	0x4
#define TK_DUMP_WIN	0x8
#define TK_DUMP_IMG	0x10
#define TK_DUMP_ALL	(TK_DUMP_TEXT|TK_DUMP_MARK|TK_DUMP_TAG| \
	TK_DUMP_WIN|TK_DUMP_IMG)
    static const char *const optStrings[] = {
	"-all", "-command", "-image", "-mark", "-tag", "-text", "-window",
	NULL
    };
    enum opts {
	DUMP_ALL, DUMP_CMD, DUMP_IMG, DUMP_MARK, DUMP_TAG, DUMP_TXT, DUMP_WIN
    };

    for (arg=2 ; arg < objc ; arg++) {
	int index;
	if (Tcl_GetString(objv[arg])[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObjStruct(interp, objv[arg], optStrings,
		sizeof(char *), "option", 0, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum opts) index) {
	case DUMP_ALL:
	    what = TK_DUMP_ALL;
	    break;
	case DUMP_TXT:
	    what |= TK_DUMP_TEXT;
	    break;
	case DUMP_TAG:
	    what |= TK_DUMP_TAG;
	    break;
	case DUMP_MARK:
	    what |= TK_DUMP_MARK;
	    break;
	case DUMP_IMG:
	    what |= TK_DUMP_IMG;
	    break;
	case DUMP_WIN:
	    what |= TK_DUMP_WIN;
	    break;
	case DUMP_CMD:
	    arg++;
	    if (arg >= objc) {
		goto wrongArgs;
	    }
	    command = objv[arg];
	    break;
	default:
	    Tcl_Panic("unexpected switch fallthrough");
	}
    }
    if (arg >= objc || arg+2 < objc) {
    wrongArgs:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"Usage: %s dump ?-all -image -text -mark -tag -window? "
		"?-command script? index ?index2?", Tcl_GetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
	return TCL_ERROR;
    }
    if (what == 0) {
	what = TK_DUMP_ALL;
    }
    if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index1) != TCL_OK) {
	return TCL_ERROR;
    }
    arg++;
    atEnd = 0;
    if (objc == arg) {
	TkTextIndexForwChars(NULL, &index1, 1, &index2, COUNT_INDICES);
    } else {
	int length;
	const char *str;

	if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index2) != TCL_OK) {
	    return TCL_ERROR;
	}
	str = Tcl_GetString(objv[arg]);
	length = objv[arg]->length;
	if (strncmp(str, "end", (unsigned) length) == 0) {
	    atEnd = 1;
	}
    }
    if (TkTextIndexCmp(&index1, &index2) >= 0) {
	return TCL_OK;
    }
    lineno = TkBTreeLinesTo(textPtr, index1.linePtr);
    if (index1.linePtr == index2.linePtr) {
	DumpLine(interp, textPtr, what, index1.linePtr,
		index1.byteIndex, index2.byteIndex, lineno, command);
    } else {
	int textChanged;
	int lineend = TkBTreeLinesTo(textPtr, index2.linePtr);
	int endByteIndex = index2.byteIndex;

	textChanged = DumpLine(interp, textPtr, what, index1.linePtr,
		index1.byteIndex, 32000000, lineno, command);
	if (textChanged) {
	    if (textPtr->flags & DESTROYED) {
		return TCL_OK;
	    }
	    linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
		    textPtr, lineno);
	    textChanged = 0;
	} else {
	    linePtr = index1.linePtr;
	}
	while ((linePtr = TkBTreeNextLine(textPtr, linePtr)) != NULL) {
	    lineno++;
	    if (lineno == lineend) {
		break;
	    }
	    textChanged = DumpLine(interp, textPtr, what, linePtr, 0,
		    32000000, lineno, command);
	    if (textChanged) {
		if (textPtr->flags & DESTROYED) {
		    return TCL_OK;
		}
		linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
			textPtr, lineno);
		textChanged = 0;
	    }
	}
	if (linePtr != NULL) {
	    DumpLine(interp, textPtr, what, linePtr, 0, endByteIndex, lineno,
		    command);
	    if (textPtr->flags & DESTROYED) {
		return TCL_OK;
	    }
	}
    }

    /*
     * Special case to get the leftovers hiding at the end mark.
     */

    if (atEnd) {
	if (textPtr->flags & DESTROYED) {
	    return TCL_OK;
	}

	/*
	 * Re-get the end index, in case it has changed.
	 */

	if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index2) != TCL_OK) {
	    return TCL_ERROR;
	}
	DumpLine(interp, textPtr, what & ~TK_DUMP_TEXT, index2.linePtr,
		0, 1, lineno, command);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DumpLine
 *
 *	Return information about a given text line from character position
 *	"start" up to, but not including, "end".
 *
 * Results:
 *	Returns 1 if the command callback made any changes to the text widget
 *	which will have invalidated internal structures such as TkTextSegment,
 *	TkTextIndex, pointers. Our caller can then take action to recompute
 *	such entities. Returns 0 otherwise.
 *
 * Side effects:
 *	None, but see DumpSegment which can have arbitrary side-effects
 *
 *----------------------------------------------------------------------
 */

static int
DumpLine(
    Tcl_Interp *interp,
    TkText *textPtr,
    int what,			/* Bit flags to select segment types. */
    TkTextLine *linePtr,	/* The current line. */
    int startByte, int endByte,	/* Byte range to dump. */
    int lineno,			/* Line number for indices dump. */
    Tcl_Obj *command)		/* Script to apply to the segment. */
{
    TkTextSegment *segPtr;
    TkTextIndex index;
    int offset = 0, textChanged = 0;

    /*
     * Must loop through line looking at its segments.
     * character
     * toggleOn, toggleOff
     * mark
     * image
     * window
     */

    segPtr = linePtr->segPtr;
    while ((offset < endByte) && (segPtr != NULL)) {
	int lineChanged = 0;
	int currentSize = segPtr->size;

	if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) &&
		(offset + currentSize > startByte)) {
	    int last = currentSize;	/* Index of last char in seg. */
	    int first = 0;		/* Index of first char in seg. */

	    if (offset + currentSize > endByte) {
		last = endByte - offset;
	    }
	    if (startByte > offset) {
		first = startByte - offset;
	    }
	    if (last != currentSize) {
		/*
		 * To avoid modifying the string in place we copy over just
		 * the segment that we want. Since DumpSegment can modify the
		 * text, we could not confidently revert the modification
		 * here.
		 */

		int length = last - first;
		char *range = ckalloc(length + 1);

		memcpy(range, segPtr->body.chars + first, length);
		range[length] = '\0';

		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
			lineno, offset + first, &index);
		lineChanged = DumpSegment(textPtr, interp, "text", range,
			command, &index, what);
		ckfree(range);
	    } else {
		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
			lineno, offset + first, &index);
		lineChanged = DumpSegment(textPtr, interp, "text",
			segPtr->body.chars + first, command, &index, what);
	    }
	} else if ((offset >= startByte)) {
	    if ((what & TK_DUMP_MARK)
		    && (segPtr->typePtr == &tkTextLeftMarkType
		    || segPtr->typePtr == &tkTextRightMarkType)) {
		const char *name;
		TkTextMark *markPtr = &segPtr->body.mark;

		if (segPtr == textPtr->insertMarkPtr) {
		    name = "insert";
		} else if (segPtr == textPtr->currentMarkPtr) {
		    name = "current";
		} else if (markPtr->hPtr == NULL) {
		    name = NULL;
		    lineChanged = 0;
		} else {
		    name = Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable,
			    markPtr->hPtr);
		}
		if (name != NULL) {
		    TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
			    lineno, offset, &index);
		    lineChanged = DumpSegment(textPtr, interp, "mark", name,
			    command, &index, what);
		}
	    } else if ((what & TK_DUMP_TAG) &&
		    (segPtr->typePtr == &tkTextToggleOnType)) {
		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
			lineno, offset, &index);
		lineChanged = DumpSegment(textPtr, interp, "tagon",
			segPtr->body.toggle.tagPtr->name, command, &index,
			what);
	    } else if ((what & TK_DUMP_TAG) &&
		    (segPtr->typePtr == &tkTextToggleOffType)) {
		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
			lineno, offset, &index);
		lineChanged = DumpSegment(textPtr, interp, "tagoff",
			segPtr->body.toggle.tagPtr->name, command, &index,
			what);
	    } else if ((what & TK_DUMP_IMG) &&
		    (segPtr->typePtr == &tkTextEmbImageType)) {
		TkTextEmbImage *eiPtr = &segPtr->body.ei;
		const char *name = (eiPtr->name == NULL) ? "" : eiPtr->name;

		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
			lineno, offset, &index);
		lineChanged = DumpSegment(textPtr, interp, "image", name,
			command, &index, what);
	    } else if ((what & TK_DUMP_WIN) &&
		    (segPtr->typePtr == &tkTextEmbWindowType)) {
		TkTextEmbWindow *ewPtr = &segPtr->body.ew;
		const char *pathname;

		if (ewPtr->tkwin == (Tk_Window) NULL) {
		    pathname = "";
		} else {
		    pathname = Tk_PathName(ewPtr->tkwin);
		}
		TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
			lineno, offset, &index);
		lineChanged = DumpSegment(textPtr, interp, "window", pathname,
			command, &index, what);
	    }
	}

	offset += currentSize;
	if (lineChanged) {
	    TkTextSegment *newSegPtr;
	    int newOffset = 0;

	    textChanged = 1;

	    /*
	     * Our indices are no longer valid.
	     */

	    if (textPtr->flags & DESTROYED) {
		return textChanged;
	    }
	    linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
		    textPtr, lineno);
	    newSegPtr = linePtr->segPtr;
	    if (segPtr != newSegPtr) {
		while ((newOffset < endByte) && (newOffset < offset)
			&& (newSegPtr != NULL)) {
		    newOffset += currentSize;
		    newSegPtr = newSegPtr->nextPtr;
		    if (segPtr == newSegPtr) {
			break;
		    }
		}
		if (segPtr != newSegPtr && newOffset == offset
			&& currentSize == 0) {
		    TkTextSegment *searchPtr = newSegPtr;

		    while (searchPtr != NULL && searchPtr->size == 0) {
			if (searchPtr == segPtr) {
			    newSegPtr = searchPtr;
			    break;
			}
			searchPtr = searchPtr->nextPtr;
		    }
		}
		segPtr = newSegPtr;
	    }
	}
	if (segPtr != NULL) {
	    segPtr = segPtr->nextPtr;
	}
    }
    return textChanged;
}

/*
 *----------------------------------------------------------------------
 *
 * DumpSegment
 *
 *	Either append information about the current segment to the result, or
 *	make a script callback with that information as arguments.
 *
 * Results:
 *	Returns 1 if the command callback made any changes to the text widget
 *	which will have invalidated internal structures such as TkTextSegment,
 *	TkTextIndex, pointers. Our caller can then take action to recompute
 *	such entities. Returns 0 otherwise.
 *
 * Side effects:
 *	Either evals the callback or appends elements to the result string.
 *	The callback can have arbitrary side-effects.
 *
 *----------------------------------------------------------------------
 */

static int
DumpSegment(
    TkText *textPtr,
    Tcl_Interp *interp,
    const char *key,		/* Segment type key. */
    const char *value,		/* Segment value. */
    Tcl_Obj *command,		/* Script callback. */
    const TkTextIndex *index,	/* index with line/byte position info. */
    int what)			/* Look for TK_DUMP_INDEX bit. */
{
    char buffer[TK_POS_CHARS];
    Tcl_Obj *values[3], *tuple;

    TkTextPrintIndex(textPtr, index, buffer);
    values[0] = Tcl_NewStringObj(key, -1);
    values[1] = Tcl_NewStringObj(value, -1);
    values[2] = Tcl_NewStringObj(buffer, -1);
    tuple = Tcl_NewListObj(3, values);
    if (command == NULL) {
	Tcl_ListObjAppendList(NULL, Tcl_GetObjResult(interp), tuple);
	Tcl_DecrRefCount(tuple);
	return 0;
    } else {
	int oldStateEpoch = TkBTreeEpoch(textPtr->sharedTextPtr->tree);
	Tcl_DString buf;
	int code;

	Tcl_DStringInit(&buf);
	Tcl_DStringAppend(&buf, Tcl_GetString(command), -1);
	Tcl_DStringAppend(&buf, " ", -1);
	Tcl_DStringAppend(&buf, Tcl_GetString(tuple), -1);
	code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
	Tcl_DStringFree(&buf);
	if (code != TCL_OK) {
	    Tcl_AddErrorInfo(interp,
		    "\n    (segment dumping command executed by text)");
	    Tcl_BackgroundException(interp, code);
	}
	Tcl_DecrRefCount(tuple);
	return ((textPtr->flags & DESTROYED) ||
		TkBTreeEpoch(textPtr->sharedTextPtr->tree) != oldStateEpoch);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TextEditUndo --
 *
 *	Undo the last change.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Apart from manipulating the undo and redo stacks, the state of the
 *	rest of the widget may also change (due to whatever is being undone).
 *
 *----------------------------------------------------------------------
 */

static int
TextEditUndo(
    TkText *textPtr)		/* Overall information about text widget. */
{
    int status;

    if (!textPtr->sharedTextPtr->undo) {
	return TCL_OK;
    }

    /*
     * Turn off the undo feature while we revert a compound action, setting
     * the dirty handling mode to undo for the duration (unless it is
     * 'fixed').
     */

    textPtr->sharedTextPtr->undo = 0;
    if (textPtr->sharedTextPtr->dirtyMode != TK_TEXT_DIRTY_FIXED) {
	textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_UNDO;
    }

    status = TkUndoRevert(textPtr->sharedTextPtr->undoStack);

    if (textPtr->sharedTextPtr->dirtyMode != TK_TEXT_DIRTY_FIXED) {
	textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL;
    }
    textPtr->sharedTextPtr->undo = 1;

    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * TextEditRedo --
 *
 *	Redo the last undone change.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Apart from manipulating the undo and redo stacks, the state of the
 *	rest of the widget may also change (due to whatever is being redone).
 *
 *----------------------------------------------------------------------
 */

static int
TextEditRedo(
    TkText *textPtr)		/* Overall information about text widget. */
{
    int status;

    if (!textPtr->sharedTextPtr->undo) {
	return TCL_OK;
    }

    /*
     * Turn off the undo feature temporarily while we revert a previously
     * undone compound action, setting the dirty handling mode to redo for the
     * duration (unless it is 'fixed').
     */

    textPtr->sharedTextPtr->undo = 0;
    if (textPtr->sharedTextPtr->dirtyMode != TK_TEXT_DIRTY_FIXED) {
	textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_REDO;
    }

    status = TkUndoApply(textPtr->sharedTextPtr->undoStack);

    if (textPtr->sharedTextPtr->dirtyMode != TK_TEXT_DIRTY_FIXED) {
	textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL;
    }
    textPtr->sharedTextPtr->undo = 1;
    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * TextEditCmd --
 *
 *	Handle the subcommands to "$text edit ...". See documentation for
 *	details.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TextEditCmd(
    TkText *textPtr,		/* Information about text widget. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int index, setModified, oldModified;
    static const char *const editOptionStrings[] = {
	"modified", "redo", "reset", "separator", "undo", NULL
    };
    enum editOptions {
	EDIT_MODIFIED, EDIT_REDO, EDIT_RESET, EDIT_SEPARATOR, EDIT_UNDO
    };

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObjStruct(interp, objv[2], editOptionStrings,
	    sizeof(char *), "edit option", 0, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum editOptions) index) {
    case EDIT_MODIFIED:
	if (objc == 3) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewBooleanObj(textPtr->sharedTextPtr->isDirty));
	    return TCL_OK;
	} else if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "?boolean?");
	    return TCL_ERROR;
	} else if (Tcl_GetBooleanFromObj(interp, objv[3],
		&setModified) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * Set or reset the dirty info, and trigger a Modified event.
	 */

	setModified = setModified ? 1 : 0;

	oldModified = textPtr->sharedTextPtr->isDirty;
	textPtr->sharedTextPtr->isDirty = setModified;
	if (setModified) {
	    textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_FIXED;
	} else {
	    textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL;
	}

	/*
	 * Only issue the <<Modified>> event if the flag actually changed.
	 * However, degree of modified-ness doesn't matter. [Bug 1799782]
	 */

	if ((!oldModified) != (!setModified)) {
	    GenerateModifiedEvent(textPtr);
	}
	break;
    case EDIT_REDO:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 3, objv, NULL);
	    return TCL_ERROR;
	}
	if (TextEditRedo(textPtr)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to redo", -1));
	    Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_REDO", NULL);
	    return TCL_ERROR;
	}
	break;
    case EDIT_RESET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 3, objv, NULL);
	    return TCL_ERROR;
	}
	TkUndoClearStacks(textPtr->sharedTextPtr->undoStack);
	break;
    case EDIT_SEPARATOR:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 3, objv, NULL);
	    return TCL_ERROR;
	}
	TkUndoInsertUndoSeparator(textPtr->sharedTextPtr->undoStack);
	break;
    case EDIT_UNDO:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 3, objv, NULL);
	    return TCL_ERROR;
	}
	if (TextEditUndo(textPtr)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to undo", -1));
	    Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_UNDO", NULL);
	    return TCL_ERROR;
	}
	break;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TextGetText --
 *
 *	Returns the text from indexPtr1 to indexPtr2, placing that text in a
 *	string object which is returned with a refCount of zero.
 *
 *	Since the amount of text may potentially be several megabytes (e.g.
 *	in text editors built on the text widget), efficiency is very
 *	important. We may want to investigate the efficiency of the
 *	Tcl_AppendToObj more carefully (e.g. if we know we are going to be
 *	appending several thousand lines, we could attempt to pre-allocate a
 *	larger space).
 *
 *	Also the result is built up as a utf-8 string, but, if we knew we
 *	wanted it as Unicode, we could potentially save a huge conversion by
 *	building it up as Unicode directly. This could be as simple as
 *	replacing Tcl_NewObj by Tcl_NewUnicodeObj.
 *
 * Results:
 *	Tcl_Obj of string type containing the specified text. If the
 *	visibleOnly flag is set to 1, then only those characters which are not
 *	elided will be returned. Otherwise (flag is 0) all characters in the
 *	given range are returned.
 *
 * Side effects:
 *	Memory will be allocated for the new object. Remember to free it if it
 *	isn't going to be stored appropriately.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
TextGetText(
    const TkText *textPtr,	/* Information about text widget. */
    const TkTextIndex *indexPtr1,
				/* Get text from this index... */
    const TkTextIndex *indexPtr2,
				/* ...to this index. */
    int visibleOnly)		/* If non-zero, then only return non-elided
				 * characters. */
{
    TkTextIndex tmpIndex;
    Tcl_Obj *resultPtr = Tcl_NewObj();

    TkTextMakeByteIndex(indexPtr1->tree, textPtr,
	    TkBTreeLinesTo(textPtr, indexPtr1->linePtr),
	    indexPtr1->byteIndex, &tmpIndex);

    if (TkTextIndexCmp(indexPtr1, indexPtr2) < 0) {
	while (1) {
	    int offset;
	    TkTextSegment *segPtr = TkTextIndexToSeg(&tmpIndex, &offset);
	    int last = segPtr->size, last2;

	    if (tmpIndex.linePtr == indexPtr2->linePtr) {
		/*
		 * The last line that was requested must be handled carefully,
		 * because we may need to break out of this loop in the middle
		 * of the line.
		 */

		if (indexPtr2->byteIndex == tmpIndex.byteIndex) {
		    break;
		}
		last2 = indexPtr2->byteIndex - tmpIndex.byteIndex + offset;
		if (last2 < last) {
		    last = last2;
		}
	    }
	    if (segPtr->typePtr == &tkTextCharType &&
		    !(visibleOnly && TkTextIsElided(textPtr,&tmpIndex,NULL))){
		Tcl_AppendToObj(resultPtr, segPtr->body.chars + offset,
			last - offset);
	    }
	    TkTextIndexForwBytes(textPtr, &tmpIndex, last-offset, &tmpIndex);
	}
    }
    return resultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * GenerateModifiedEvent --
 *
 *	Send an event that the text was modified. This is equivalent to:
 *	   event generate $textWidget <<Modified>>
 *
 * Results:
 *	None
 *
 * Side effects:
 *	May force the text window into existence.
 *
 *----------------------------------------------------------------------
 */

static void
GenerateModifiedEvent(
    TkText *textPtr)	/* Information about text widget. */
{
    union {
	XEvent general;
	XVirtualEvent virtual;
    } event;

    Tk_MakeWindowExist(textPtr->tkwin);

    memset(&event, 0, sizeof(event));
    event.general.xany.type = VirtualEvent;
    event.general.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
    event.general.xany.send_event = False;
    event.general.xany.window = Tk_WindowId(textPtr->tkwin);
    event.general.xany.display = Tk_Display(textPtr->tkwin);
    event.virtual.name = Tk_GetUid("Modified");
    Tk_HandleEvent(&event.general);
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateDirtyFlag --
 *
 *	Updates the dirtyness of the text widget
 *
 * Results:
 *	None
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateDirtyFlag(
    TkSharedText *sharedTextPtr)/* Information about text widget. */
{
    int oldDirtyFlag;
    TkText *textPtr;

    /*
     * If we've been forced to be dirty, we stay dirty (until explicitly
     * reset, of course).
     */

    if (sharedTextPtr->dirtyMode == TK_TEXT_DIRTY_FIXED) {
	return;
    }

    if (sharedTextPtr->isDirty < 0
	    && sharedTextPtr->dirtyMode == TK_TEXT_DIRTY_NORMAL) {
	/*
	 * If dirty flag is negative, only redo operations can make it zero
	 * again. If we do a normal operation, it can never become zero any
	 * more (other than by explicit reset).
	 */

	sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_FIXED;
	return;
    }

    oldDirtyFlag = sharedTextPtr->isDirty;
    if (sharedTextPtr->dirtyMode == TK_TEXT_DIRTY_UNDO) {
	sharedTextPtr->isDirty--;
    } else {
	sharedTextPtr->isDirty++;
    }

    if (sharedTextPtr->isDirty == 0 || oldDirtyFlag == 0) {
	for (textPtr = sharedTextPtr->peers; textPtr != NULL;
		textPtr = textPtr->next) {
	    GenerateModifiedEvent(textPtr);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SearchPerform --
 *
 *	Overall control of search process. Is given a pattern, a starting
 *	index and an ending index, and attempts to perform a search. This
 *	function is actually completely independent of Tk, and could in the
 *	future be split off.
 *
 * Results:
 *	Standard Tcl result code. In particular, if fromPtr or toPtr are not
 *	considered valid by the 'lineIndexProc', an error will be thrown and
 *	no search performed.
 *
 * Side effects:
 *	See 'SearchCore'.
 *
 *----------------------------------------------------------------------
 */

static int
SearchPerform(
    Tcl_Interp *interp,		/* For error messages. */
    SearchSpec *searchSpecPtr,	/* Search parameters. */
    Tcl_Obj *patObj,		/* Contains an exact string or a regexp
				 * pattern. Must have a refCount > 0. */
    Tcl_Obj *fromPtr,		/* Contains information describing the first
				 * index. */
    Tcl_Obj *toPtr)		/* NULL or information describing the last
				 * index. */
{
    /*
     * Find the starting line and starting offset (measured in Unicode chars
     * for regexp search, utf-8 bytes for exact search).
     */

    if (searchSpecPtr->lineIndexProc(interp, fromPtr, searchSpecPtr,
	    &searchSpecPtr->startLine,
	    &searchSpecPtr->startOffset) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Find the optional end location, similarly.
     */

    if (toPtr != NULL) {
	const TkTextIndex *indexToPtr, *indexFromPtr;
	TkText *textPtr = searchSpecPtr->clientData;

	indexToPtr = TkTextGetIndexFromObj(interp, textPtr, toPtr);
	if (indexToPtr == NULL) {
	    return TCL_ERROR;
	}
	indexFromPtr = TkTextGetIndexFromObj(interp, textPtr, fromPtr);

	/*
	 * Check for any empty search range here. It might be better in the
	 * future to embed that in SearchCore (whose default behaviour is to
	 * wrap when given a negative search range).
	 */

	if (TkTextIndexCmp(indexFromPtr, indexToPtr) ==
		(searchSpecPtr->backwards ? -1 : 1)) {
	    return TCL_OK;
	}

	if (searchSpecPtr->lineIndexProc(interp, toPtr, searchSpecPtr,
		&searchSpecPtr->stopLine,
		&searchSpecPtr->stopOffset) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	searchSpecPtr->stopLine = -1;
    }

    /*
     * Scan through all of the lines of the text circularly, starting at the
     * given index. 'patObj' is the pattern which may be an exact string or a
     * regexp pattern depending on the flags in searchSpecPtr.
     */

    return SearchCore(interp, searchSpecPtr, patObj);
}

/*
 *----------------------------------------------------------------------
 *
 * SearchCore --
 *
 *	The core of the search function. This function is actually completely
 *	independent of Tk, and could in the future be split off.
 *
 *	The function assumes regexp-based searches operate on Unicode strings,
 *	and exact searches on utf-8 strings. Therefore the 'foundMatchProc'
 *	and 'addLineProc' need to be aware of this distinction.
 *
 * Results:
 *	Standard Tcl result code.
 *
 * Side effects:
 *	Only those of the 'searchSpecPtr->foundMatchProc' which is called
 *	whenever a match is found.
 *
 *	Note that the way matching across multiple lines is implemented, we
 *	start afresh with each line we have available, even though we may
 *	already have examined the contents of that line (and further ones) if
 *	we were attempting a multi-line match using the previous line. This
 *	means there may be ways to speed this up a lot by not throwing away
 *	all the multi-line information one has accumulated. Profiling should
 *	be done to see where the bottlenecks lie before attempting this,
 *	however. We would also need to be very careful such optimisation keep
 *	within the specified search bounds.
 *
 *----------------------------------------------------------------------
 */

static int
SearchCore(
    Tcl_Interp *interp,		/* For error messages. */
    SearchSpec *searchSpecPtr,	/* Search parameters. */
    Tcl_Obj *patObj)		/* Contains an exact string or a regexp
				 * pattern. Must have a refCount > 0. */
{
    /*
     * For exact searches these are utf-8 char* offsets, for regexp searches
     * they are Unicode char offsets.
     */

    int firstOffset, lastOffset, matchOffset, matchLength;
    int passes;
    int lineNum = searchSpecPtr->startLine;
    int code = TCL_OK;
    Tcl_Obj *theLine;
    int alreadySearchOffset = -1;

    const char *pattern = NULL;	/* For exact searches only. */
    int firstNewLine = -1; 	/* For exact searches only. */
    Tcl_RegExp regexp = NULL;	/* For regexp searches only. */

    /*
     * These items are for backward regexp searches only. They are for two
     * purposes: to allow us to report backwards matches in the correct order,
     * even though the implementation uses repeated forward searches; and to
     * provide for overlap checking between backwards matches on different
     * text lines.
     */

#define LOTS_OF_MATCHES 20
    int matchNum = LOTS_OF_MATCHES;
    int smArray[2 * LOTS_OF_MATCHES];
    int *storeMatch = smArray;
    int *storeLength = smArray + LOTS_OF_MATCHES;
    int lastBackwardsLineMatch = -1;
    int lastBackwardsMatchOffset = -1;

    if (searchSpecPtr->exact) {
	/*
	 * Convert the pattern to lower-case if we're supposed to ignore case.
	 */

	if (searchSpecPtr->noCase) {
	    patObj = Tcl_DuplicateObj(patObj);

	    /*
	     * This can change the length of the string behind the object's
	     * back, so ensure it is correctly synchronised.
	     */

	    Tcl_SetObjLength(patObj, Tcl_UtfToLower(Tcl_GetString(patObj)));
	}
    } else {
	/*
	 * Compile the regular expression. We want '^$' to match after and
	 * before \n respectively, so use the TCL_REG_NLANCH flag.
	 */

	regexp = Tcl_GetRegExpFromObj(interp, patObj,
		(searchSpecPtr->noCase ? TCL_REG_NOCASE : 0)
		| (searchSpecPtr->noLineStop ? 0 : TCL_REG_NLSTOP)
		| TCL_REG_ADVANCED | TCL_REG_CANMATCH | TCL_REG_NLANCH);
	if (regexp == NULL) {
	    return TCL_ERROR;
	}
    }

    /*
     * For exact strings, we want to know where the first newline is, and we
     * will also use this as a flag to test whether it is even possible to
     * match the pattern on a single line. If not we will have to search
     * across multiple lines.
     */

    if (searchSpecPtr->exact) {
	const char *nl;

	/*
	 * We only need to set the matchLength once for exact searches, and we
	 * do it here. It is also used below as the actual pattern length, so
	 * it has dual purpose.
	 */

	pattern = Tcl_GetString(patObj);
	matchLength = patObj->length;
	nl = strchr(pattern, '\n');

	/*
	 * If there is no newline, or it is the very end of the string, then
	 * we don't need any special treatment, since single-line matching
	 * will work fine.
	 */

	if (nl != NULL && nl[1] != '\0') {
	    firstNewLine = (nl - pattern);
	}
    } else {
	matchLength = 0;	/* Only needed to prevent compiler warnings. */
    }

    /*
     * Keep a reference here, so that we can be sure the object doesn't
     * disappear behind our backs and invalidate its contents which we are
     * using.
     */

    Tcl_IncrRefCount(patObj);

    /*
     * For building up the current line being checked.
     */

    theLine = Tcl_NewObj();
    Tcl_IncrRefCount(theLine);

    for (passes = 0; passes < 2; ) {
	ClientData lineInfo;
	int linesSearched = 1;
	int extraLinesSearched = 0;

	if (lineNum >= searchSpecPtr->numLines) {
	    /*
	     * Don't search the dummy last line of the text.
	     */

	    goto nextLine;
	}

	/*
	 * Extract the text from the line, storing its length in 'lastOffset'
	 * (in bytes if exact, chars if regexp), since obviously the length is
	 * the maximum offset at which it is possible to find something on
	 * this line, which is what 'lastOffset' represents.
	 */

	lineInfo = searchSpecPtr->addLineProc(lineNum, searchSpecPtr, theLine,
		&lastOffset, &linesSearched);

	if (lineInfo == NULL) {
	    /*
	     * This should not happen, since 'lineNum' should be valid in the
	     * call above. However, let's try to be flexible and not cause a
	     * crash below.
	     */

	    goto nextLine;
	}

	if (lineNum == searchSpecPtr->stopLine && searchSpecPtr->backwards) {
	    firstOffset = searchSpecPtr->stopOffset;
	} else {
	    firstOffset = 0;
	}

	if (alreadySearchOffset != -1) {
	    if (searchSpecPtr->backwards) {
		if (alreadySearchOffset < lastOffset) {
		    lastOffset = alreadySearchOffset;
		}
	    } else {
		if (alreadySearchOffset > firstOffset) {
		    firstOffset = alreadySearchOffset;
		}
	    }
	    alreadySearchOffset = -1;
	}

	if (lineNum == searchSpecPtr->startLine) {
	    /*
	     * The starting line is tricky: the first time we see it we check
	     * one part of the line, and the second pass through we check the
	     * other part of the line.
	     */

	    passes++;
	    if ((passes == 1) ^ searchSpecPtr->backwards) {
		/*
		 * Forward search and first pass, or backward search and
		 * second pass.
		 *
		 * Only use the last part of the line.
		 */

		if (searchSpecPtr->startOffset > firstOffset) {
		    firstOffset = searchSpecPtr->startOffset;
		}
		if ((firstOffset >= lastOffset)
		    && ((lastOffset != 0) || searchSpecPtr->exact)) {
		    goto nextLine;
		}
	    } else {
		/*
		 * Use only the first part of the line.
		 */

		if (searchSpecPtr->startOffset < lastOffset) {
		    lastOffset = searchSpecPtr->startOffset;
		}
	    }
	}

	/*
	 * Check for matches within the current line 'lineNum'. If so, and if
	 * we're searching backwards or for all matches, repeat the search
	 * until we find the last match in the line. The 'lastOffset' is one
	 * beyond the last position in the line at which a match is allowed to
	 * begin.
	 */

	matchOffset = -1;

	if (searchSpecPtr->exact) {
	    int maxExtraLines = 0;
	    const char *startOfLine = Tcl_GetString(theLine);

	    CLANG_ASSERT(pattern);
	    do {
		Tcl_UniChar ch;
		const char *p;
		int lastFullLine = lastOffset;

		if (firstNewLine == -1) {
		    if (searchSpecPtr->strictLimits
			    && (firstOffset + matchLength > lastOffset)) {
			/*
			 * Not enough characters to match.
			 */

			break;
		    }

		    /*
		     * Single line matching. We want to scan forwards or
		     * backwards as appropriate.
		     */

		    if (searchSpecPtr->backwards) {
			/*
			 * Search back either from the previous match or from
			 * 'startOfLine + lastOffset - 1' until we find a
			 * match.
			 */

			const char c = pattern[0];

			if (alreadySearchOffset != -1) {
			    p = startOfLine + alreadySearchOffset;
			    alreadySearchOffset = -1;
			} else {
			    p = startOfLine + lastOffset -1;
			}
			while (p >= startOfLine + firstOffset) {
			    if (p[0] == c && !strncmp(p, pattern,
				    (unsigned) matchLength)) {
				goto backwardsMatch;
			    }
			    p--;
			}
			break;
		    } else {
			p = strstr(startOfLine + firstOffset, pattern);
		    }
		    if (p == NULL) {
			/*
			 * Single line match failed.
			 */

			break;
		    }
		} else if (firstNewLine >= (lastOffset - firstOffset)) {
		    /*
		     * Multi-line match, but not enough characters to match.
		     */

		    break;
		} else {
		    /*
		     * Multi-line match has only one possible match position,
		     * because we know where the '\n' is.
		     */

		    p = startOfLine + lastOffset - firstNewLine - 1;
		    if (strncmp(p, pattern, (unsigned) firstNewLine + 1)) {
			/*
			 * No match.
			 */

			break;
		    } else {
			int extraLines = 1;

			/*
			 * If we find a match that overlaps more than one
			 * line, we will use this value to determine the first
			 * allowed starting offset for the following search
			 * (to avoid overlapping results).
			 */

			int lastTotal = lastOffset;
			int skipFirst = lastOffset - firstNewLine -1;

			/*
			 * We may be able to match if given more text. The
			 * following 'while' block handles multi-line exact
			 * searches.
			 */

			while (1) {
			    lastFullLine = lastTotal;

			    if (lineNum+extraLines>=searchSpecPtr->numLines) {
				p = NULL;
				break;
			    }

			    /*
			     * Only add the line if we haven't already done so
			     * already.
			     */

			    if (extraLines > maxExtraLines) {
				if (searchSpecPtr->addLineProc(lineNum
					+ extraLines, searchSpecPtr, theLine,
					&lastTotal, &extraLines) == NULL) {
				    p = NULL;
				    if (!searchSpecPtr->backwards) {
					extraLinesSearched = extraLines;
				    }
				    break;
				}
				maxExtraLines = extraLines;
			    }

			    startOfLine = Tcl_GetString(theLine);
			    p = startOfLine + skipFirst;

			    /*
			     * Use the fact that 'matchLength = patLength' for
			     * exact searches.
			     */

			    if ((lastTotal - skipFirst) >= matchLength) {
				/*
				 * We now have enough text to match, so we
				 * make a final test and break whatever the
				 * result.
				 */

				if (strncmp(p,pattern,(unsigned)matchLength)) {
				    p = NULL;
				}
				break;
			    } else {
				/*
				 * Not enough text yet, but check the prefix.
				 */

				if (strncmp(p, pattern,
					(unsigned)(lastTotal - skipFirst))) {
				    p = NULL;
				    break;
				}

				/*
				 * The prefix matches, so keep looking.
				 */
			    }
			    extraLines++;
			}
			/*
			 * If we reach here, with p != NULL, we've found a
			 * multi-line match, else we started a multi-match but
			 * didn't finish it off, so we go to the next line.
			 */

			if (p == NULL) {
			    break;
			}

			/*
			 * We've found a multi-line match.
			 */

			if (extraLines > 0) {
			    extraLinesSearched = extraLines - 1;
			}
		    }
		}

	    backwardsMatch:
		if ((p - startOfLine) >= lastOffset) {
		    break;
		}

		/*
		 * Remember the match.
		 */

		matchOffset = p - startOfLine;

		if (searchSpecPtr->all &&
			!searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr,
			lineInfo, theLine, matchOffset, matchLength)) {
		    /*
		     * We reached the end of the search.
		     */

		    goto searchDone;
		}

		if (!searchSpecPtr->overlap) {
		    if (searchSpecPtr->backwards) {
			alreadySearchOffset = p - startOfLine;
			if (firstNewLine != -1) {
			    break;
			} else {
			    alreadySearchOffset -= matchLength;
			}
		    } else {
			firstOffset = p - startOfLine + matchLength;
			if (firstOffset >= lastOffset) {
			    /*
			     * Now, we have to be careful not to find
			     * overlapping matches either on the same or
			     * following lines. Assume that if we did find
			     * something, it goes until the last extra line we
			     * added.
			     *
			     * We can break out of the loop, since we know no
			     * more will be found.
			     */

			    if (!searchSpecPtr->backwards) {
				alreadySearchOffset =
					firstOffset - lastFullLine;
				break;
			    }
			}
		    }
		} else {
		    if (searchSpecPtr->backwards) {
			alreadySearchOffset = p - startOfLine - 1;
			if (alreadySearchOffset < 0) {
			    break;
			}
		    } else {
			firstOffset = p - startOfLine +
				Tcl_UtfToUniChar(startOfLine+matchOffset,&ch);
		    }
		}
	    } while (searchSpecPtr->all);
	} else {
	    int maxExtraLines = 0;
	    int matches = 0;
	    int lastNonOverlap = -1;

	    do {
		Tcl_RegExpInfo info;
		int match;
		int lastFullLine = lastOffset;

		match = Tcl_RegExpExecObj(interp, regexp, theLine,
			firstOffset, 1, (firstOffset>0 ? TCL_REG_NOTBOL : 0));
		if (match < 0) {
		    code = TCL_ERROR;
		    goto searchDone;
		}
		Tcl_RegExpGetInfo(regexp, &info);

		/*
		 * If we don't have a match, or if we do, but it extends to
		 * the end of the line, we must try to add more lines to get a
		 * full greedy match.
		 */

		if (!match ||
			((info.extendStart == info.matches[0].start)
			&& (info.matches[0].end == lastOffset-firstOffset))) {
		    int extraLines = 0;
		    int prevFullLine;

		    /*
		     * If we find a match that overlaps more than one line, we
		     * will use this value to determine the first allowed
		     * starting offset for the following search (to avoid
		     * overlapping results).
		     */

		    int lastTotal = lastOffset;

		    if ((lastBackwardsLineMatch != -1)
			    && (lastBackwardsLineMatch == (lineNum + 1))) {
			lastNonOverlap = lastTotal;
		    }

		    if (info.extendStart < 0) {
			/*
			 * No multi-line match is possible.
			 */

			break;
		    }

		    /*
		     * We may be able to match if given more text. The
		     * following 'while' block handles multi-line regexp
		     * searches.
		     */

		    while (1) {
			prevFullLine = lastTotal;

			/*
			 * Move firstOffset to first possible start.
			 */

			if (!match) {
			    firstOffset += info.extendStart;
			}
			if (firstOffset >= lastOffset) {
			    /*
			     * We're being told that the only possible new
			     * match is starting after the end of the line.
			     * But, that is the next line which we will handle
			     * when we look at that line.
			     */

			    if (!match && !searchSpecPtr->backwards
				    && (firstOffset == 0)) {
				extraLinesSearched = extraLines;
			    }
			    break;
			}

			if (lineNum + extraLines >= searchSpecPtr->numLines) {
			    break;
			}

			/*
			 * Add next line, provided we haven't already done so.
			 */

			if (extraLines > maxExtraLines) {
			    if (searchSpecPtr->addLineProc(lineNum
				    + extraLines, searchSpecPtr, theLine,
				    &lastTotal, &extraLines) == NULL) {
				/*
				 * There are no more acceptable lines, so we
				 * can say we have searched all of these.
				 */

				if (!match && !searchSpecPtr->backwards) {
				    extraLinesSearched = extraLines;
				}
				break;
			    }

			    maxExtraLines = extraLines;
			    if ((lastBackwardsLineMatch != -1)
				    && (lastBackwardsLineMatch
				    == (lineNum + extraLines + 1))) {
				lastNonOverlap = lastTotal;
			    }
			}

			match = Tcl_RegExpExecObj(interp, regexp, theLine,
				firstOffset, 1,
				((firstOffset > 0) ? TCL_REG_NOTBOL : 0));
			if (match < 0) {
			    code = TCL_ERROR;
			    goto searchDone;
			}
			Tcl_RegExpGetInfo(regexp, &info);

			/*
			 * Unfortunately there are bugs in Tcl's regexp
			 * library, which tells us that info.extendStart is
			 * zero when it should not be (should be -1), which
			 * makes our task a bit more complicated here. We
			 * check if there was a match, and the end of the
			 * match leaves an entire extra line unmatched, then
			 * we stop searching. Clearly it still might sometimes
			 * be possible to add more text and match again, but
			 * Tcl's regexp library doesn't tell us that.
			 *
			 * This means we often add and search one more line
			 * than might be necessary if Tcl were able to give us
			 * a correct value of info.extendStart under all
			 * circumstances.
			 */

			if ((match &&
				firstOffset+info.matches[0].end != lastTotal &&
				firstOffset+info.matches[0].end < prevFullLine)
				|| info.extendStart < 0) {
			    break;
			}

			/*
			 * If there is a match, but that match starts after
			 * the end of the first line, then we'll handle that
			 * next time around, when we're actually looking at
			 * that line.
			 */

			if (match && (info.matches[0].start >= lastOffset)) {
			    break;
			}
			if (match && ((firstOffset + info.matches[0].end)
				>= prevFullLine)) {
			    if (extraLines > 0) {
				extraLinesSearched = extraLines - 1;
			    }
			    lastFullLine = prevFullLine;
			}

			/*
			 * The prefix matches, so keep looking.
			 */

			extraLines++;
		    }

		    /*
		     * If we reach here with 'match == 1', we've found a
		     * multi-line match, which we will record in the code
		     * which follows directly else we started a multi-line
		     * match but didn't finish it off, so we go to the next
		     * line.
		     */

		    if (!match) {
			/*
			 * Here is where we could perform an optimisation,
			 * since we have already retrieved the contents of the
			 * next line (perhaps many more), so we shouldn't
			 * really throw it all away and start again. This
			 * could be particularly important for complex regexp
			 * searches.
			 *
			 * This 'break' will take us to just before the
			 * 'nextLine:' below.
			 */

			break;
		    }

		    if (lastBackwardsLineMatch != -1) {
			if ((lineNum + linesSearched + extraLinesSearched)
				== lastBackwardsLineMatch) {
			    /*
			     * Possible overlap or inclusion.
			     */

			    int thisOffset = firstOffset + info.matches[0].end
				    - info.matches[0].start;

			    if (lastNonOverlap != -1) {
				/*
				 * Possible overlap or enclosure.
				 */

				if (thisOffset-lastNonOverlap >=
					lastBackwardsMatchOffset+matchLength){
				    /*
				     * Totally encloses previous match, so
				     * forget the previous match.
				     */

				    lastBackwardsLineMatch = -1;
				} else if ((thisOffset - lastNonOverlap)
					> lastBackwardsMatchOffset) {
				    /*
				     * Overlap. Previous match is ok, and the
				     * current match is only ok if we are
				     * searching with -overlap.
				     */

				    if (searchSpecPtr->overlap) {
					goto recordBackwardsMatch;
				    } else {
					match = 0;
					break;
				    }
				} else {
				    /*
				     * No overlap, although the same line was
				     * reached.
				     */

				    goto recordBackwardsMatch;
				}
			    } else {
				/*
				 * No overlap.
				 */

				goto recordBackwardsMatch;
			    }
			} else if (lineNum+linesSearched+extraLinesSearched
				< lastBackwardsLineMatch) {
			    /*
			     * No overlap.
			     */

			    goto recordBackwardsMatch;
			} else {
			    /*
			     * Totally enclosed.
			     */

			    lastBackwardsLineMatch = -1;
			}
		    }

		} else {
		    /*
		     * Matched in a single line.
		     */

		    if (lastBackwardsLineMatch != -1) {
		    recordBackwardsMatch:
			searchSpecPtr->foundMatchProc(lastBackwardsLineMatch,
				searchSpecPtr, NULL, NULL,
				lastBackwardsMatchOffset, matchLength);
			lastBackwardsLineMatch = -1;
			if (!searchSpecPtr->all) {
			    goto searchDone;
			}
		    }
		}

		firstOffset += info.matches[0].start;
		if (firstOffset >= lastOffset) {
		    break;
		}

		/*
		 * Update our local variables with the match, if we haven't
		 * yet found anything, or if we're doing '-all' or
		 * '-backwards' _and_ this match isn't fully enclosed in the
		 * previous match.
		 */

		if (matchOffset == -1 ||
			((searchSpecPtr->all || searchSpecPtr->backwards)
			&& ((firstOffset < matchOffset)
			|| ((firstOffset + info.matches[0].end
				- info.matches[0].start)
				> (matchOffset + matchLength))))) {

		    matchOffset = firstOffset;
		    matchLength = info.matches[0].end - info.matches[0].start;

		    if (searchSpecPtr->backwards) {
			/*
			 * To get backwards searches in the correct order, we
			 * must store them away here.
			 */

			if (matches == matchNum) {
			    /*
			     * We've run out of space in our normal store, so
			     * we must allocate space for these backwards
			     * matches on the heap.
			     */

			    int *newArray =
				    ckalloc(4 * matchNum * sizeof(int));
			    memcpy(newArray, storeMatch, matchNum*sizeof(int));
			    memcpy(newArray + 2*matchNum, storeLength,
				    matchNum * sizeof(int));
			    if (storeMatch != smArray) {
				ckfree(storeMatch);
			    }
			    matchNum *= 2;
			    storeMatch = newArray;
			    storeLength = newArray + matchNum;
			}
			storeMatch[matches] = matchOffset;
			storeLength[matches] = matchLength;
			matches++;
		    } else {
			/*
			 * Now actually record the match, but only if we are
			 * doing an '-all' search.
			 */

			if (searchSpecPtr->all &&
				!searchSpecPtr->foundMatchProc(lineNum,
				searchSpecPtr, lineInfo, theLine, matchOffset,
				matchLength)) {
			    /*
			     * We reached the end of the search.
			     */

			    goto searchDone;
			}
		    }

		    /*
		     * For forward matches, unless we allow overlaps, we move
		     * this on by the length of the current match so that we
		     * explicitly disallow overlapping matches.
		     */

		    if (matchLength > 0 && !searchSpecPtr->overlap
			    && !searchSpecPtr->backwards) {
			firstOffset += matchLength;
			if (firstOffset >= lastOffset) {
			    /*
			     * Now, we have to be careful not to find
			     * overlapping matches either on the same or
			     * following lines. Assume that if we did find
			     * something, it goes until the last extra line we
			     * added.
			     *
			     * We can break out of the loop, since we know no
			     * more will be found.
			     */

			    alreadySearchOffset = firstOffset - lastFullLine;
			    break;
			}

			/*
			 * We'll add this on again just below.
			 */

			firstOffset --;
		    }
		}

		/*
		 * Move the starting point on, in case we are doing repeated
		 * or backwards searches (for the latter, we actually do
		 * repeated forward searches).
		 */

		firstOffset++;
	    } while (searchSpecPtr->backwards || searchSpecPtr->all);

	    if (matches > 0) {
		/*
		 * Now we have all the matches in our array, but not stored
		 * with 'foundMatchProc' yet.
		 */

		matches--;
		matchOffset = storeMatch[matches];
		matchLength = storeLength[matches];
		while (--matches >= 0) {
		    if (lineNum == searchSpecPtr->stopLine) {
			/*
			 * It appears as if a condition like:
			 *
			 * if (storeMatch[matches]<searchSpecPtr->stopOffset)
			 *	break;
			 *
			 * might be needed here, but no test case has been
			 * found which would exercise such a problem.
			 */
		    }
		    if (storeMatch[matches] + storeLength[matches]
			    >= matchOffset + matchLength) {
			/*
			 * The new match totally encloses the previous one, so
			 * we overwrite the previous one.
			 */

			matchOffset = storeMatch[matches];
			matchLength = storeLength[matches];
			continue;
		    }
		    if (!searchSpecPtr->overlap) {
			if (storeMatch[matches] + storeLength[matches]
				> matchOffset) {
			    continue;
			}
		    }
		    searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr,
			    lineInfo, theLine, matchOffset, matchLength);
		    if (!searchSpecPtr->all) {
			goto searchDone;
		    }
		    matchOffset = storeMatch[matches];
		    matchLength = storeLength[matches];
		}
		if (searchSpecPtr->all && matches > 0) {
		    /*
		     * We only need to do this for the '-all' case, because
		     * just below we will call the foundMatchProc for the
		     * non-all case.
		     */

		    searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr,
			    lineInfo, theLine, matchOffset, matchLength);
		} else {
		    lastBackwardsLineMatch = lineNum;
		    lastBackwardsMatchOffset = matchOffset;
		}
	    }
	}

	/*
	 * If the 'all' flag is set, we will already have stored all matches,
	 * so we just proceed to the next line.
	 *
	 * If not, and there is a match we need to store that information and
	 * we are done.
	 */

	if ((lastBackwardsLineMatch == -1) && (matchOffset >= 0)
		&& !searchSpecPtr->all) {
	    searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr, lineInfo,
		    theLine, matchOffset, matchLength);
	    goto searchDone;
	}

	/*
	 * Go to the next (or previous) line;
	 */

    nextLine:
	linesSearched += extraLinesSearched;

	while (linesSearched-- > 0) {
	    /*
	     * If we have just completed the 'stopLine', we are done.
	     */

	    if (lineNum == searchSpecPtr->stopLine) {
		goto searchDone;
	    }

	    if (searchSpecPtr->backwards) {
		lineNum--;

		if (lastBackwardsLineMatch != -1
			&& ((lineNum < 0)
			|| (lineNum + 2 < lastBackwardsLineMatch))) {
		    searchSpecPtr->foundMatchProc(lastBackwardsLineMatch,
			    searchSpecPtr, NULL, NULL,
			    lastBackwardsMatchOffset, matchLength);
		    lastBackwardsLineMatch = -1;
		    if (!searchSpecPtr->all) {
			goto searchDone;
		    }
		}

		if (lineNum < 0) {
		    lineNum = searchSpecPtr->numLines-1;
		}
		if (!searchSpecPtr->exact) {
		    /*
		     * The 'exact' search loops above are designed to give us
		     * an accurate picture of the number of lines which we can
		     * skip here. For 'regexp' searches, on the other hand,
		     * which can match potentially variable lengths, we cannot
		     * skip multiple lines when searching backwards. Therefore
		     * we only allow one line to be skipped here.
		     */

		    break;
		}
	    } else {
		lineNum++;
		if (lineNum >= searchSpecPtr->numLines) {
		    lineNum = 0;
		}
	    }
	    if (lineNum == searchSpecPtr->startLine && linesSearched > 0) {
		/*
		 * We've just searched all the way round and have gone right
		 * through the start line without finding anything in the last
		 * attempt.
		 */

		break;
	    }
	}

	Tcl_SetObjLength(theLine, 0);
    }
  searchDone:

    if (lastBackwardsLineMatch != -1) {
	searchSpecPtr->foundMatchProc(lastBackwardsLineMatch, searchSpecPtr,
		NULL, NULL, lastBackwardsMatchOffset, matchLength);
    }

    /*
     * Free up the cached line and pattern.
     */

    Tcl_DecrRefCount(theLine);
    Tcl_DecrRefCount(patObj);

    /*
     * Free up any extra space we allocated.
     */

    if (storeMatch != smArray) {
	ckfree(storeMatch);
    }

    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * GetLineStartEnd -
 *
 *	Converts an internal TkTextLine ptr into a Tcl string obj containing
 *	the line number. (Handler for the 'line' configuration option type.)
 *
 * Results:
 *	Tcl_Obj containing the string representation of the line value.
 *
 * Side effects:
 *	Creates a new Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
GetLineStartEnd(
    ClientData clientData,
    Tk_Window tkwin,
    char *recordPtr,		/* Pointer to widget record. */
    int internalOffset)		/* Offset within *recordPtr containing the
				 * line value. */
{
    TkTextLine *linePtr = *(TkTextLine **)(recordPtr + internalOffset);

    if (linePtr == NULL) {
	return Tcl_NewObj();
    }
    return Tcl_NewIntObj(1 + TkBTreeLinesTo(NULL, linePtr));
}

/*
 *----------------------------------------------------------------------
 *
 * SetLineStartEnd --
 *
 *	Converts a Tcl_Obj representing a widget's (start or end) line into a
 *	TkTextLine* value. (Handler for the 'line' configuration option type.)
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	May store the TkTextLine* value into the internal representation
 *	pointer. May change the pointer to the Tcl_Obj to NULL to indicate
 *	that the specified string was empty and that is acceptable.
 *
 *----------------------------------------------------------------------
 */

static int
SetLineStartEnd(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interp; may be used for errors. */
    Tk_Window tkwin,		/* Window for which option is being set. */
    Tcl_Obj **value,		/* Pointer to the pointer to the value object.
				 * We use a pointer to the pointer because we
				 * may need to return a value (NULL). */
    char *recordPtr,		/* Pointer to storage for the widget record. */
    int internalOffset,		/* Offset within *recordPtr at which the
				 * internal value is to be stored. */
    char *oldInternalPtr,	/* Pointer to storage for the old value. */
    int flags)			/* Flags for the option, set Tk_SetOptions. */
{
    TkTextLine *linePtr = NULL;
    char *internalPtr;
    TkText *textPtr = (TkText *) recordPtr;

    if (internalOffset >= 0) {
	internalPtr = recordPtr + internalOffset;
    } else {
	internalPtr = NULL;
    }

    if (flags & TK_OPTION_NULL_OK && ObjectIsEmpty(*value)) {
	*value = NULL;
    } else {
	int line;

	if (Tcl_GetIntFromObj(interp, *value, &line) != TCL_OK) {
	    return TCL_ERROR;
	}
	linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, NULL, line-1);
    }

    if (internalPtr != NULL) {
	*((TkTextLine **) oldInternalPtr) = *((TkTextLine **) internalPtr);
	*((TkTextLine **) internalPtr) = linePtr;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * RestoreLineStartEnd --
 *
 *	Restore a line option value from a saved value. (Handler for the
 *	'line' configuration option type.)
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Restores the old value.
 *
 *----------------------------------------------------------------------
 */

static void
RestoreLineStartEnd(
    ClientData clientData,
    Tk_Window tkwin,
    char *internalPtr,		/* Pointer to storage for value. */
    char *oldInternalPtr)	/* Pointer to old value. */
{
    *(TkTextLine **)internalPtr = *(TkTextLine **)oldInternalPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ObjectIsEmpty --
 *
 *	This function tests whether the string value of an object is empty.
 *
 * Results:
 *	The return value is 1 if the string value of objPtr has length zero,
 *	and 0 otherwise.
 *
 * Side effects:
 *	May cause object shimmering, since this function can force a
 *	conversion to a string object.
 *
 *----------------------------------------------------------------------
 */

static int
ObjectIsEmpty(
    Tcl_Obj *objPtr)		/* Object to test. May be NULL. */
{
    if (objPtr == NULL) {
	return 1;
    }
    if (objPtr->bytes != NULL) {
	return (objPtr->length == 0);
    }
    (void)Tcl_GetString(objPtr);
    return (objPtr->length == 0);
}

/*
 *----------------------------------------------------------------------
 *
 * TkpTesttextCmd --
 *
 *	This function implements the "testtext" command. It provides a set of
 *	functions for testing text widgets and the associated functions in
 *	tkText*.c.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Depends on option; see below.
 *
 *----------------------------------------------------------------------
 */

int
TkpTesttextCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])		/* Argument strings. */
{
    TkText *textPtr;
    size_t len;
    int lineIndex, byteIndex, byteOffset;
    TkTextIndex index;
    char buf[64];
    Tcl_CmdInfo info;

    if (objc < 3) {
	return TCL_ERROR;
    }

    if (Tcl_GetCommandInfo(interp, Tcl_GetString(objv[1]), &info) == 0) {
	return TCL_ERROR;
    }
    textPtr = info.objClientData;
    len = strlen(Tcl_GetString(objv[2]));
    if (strncmp(Tcl_GetString(objv[2]), "byteindex", len) == 0) {
	if (objc != 5) {
	    return TCL_ERROR;
	}
	lineIndex = atoi(Tcl_GetString(objv[3])) - 1;
	byteIndex = atoi(Tcl_GetString(objv[4]));

	TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, lineIndex,
		byteIndex, &index);
    } else if (strncmp(Tcl_GetString(objv[2]), "forwbytes", len) == 0) {
	if (objc != 5) {
	    return TCL_ERROR;
	}
	if (TkTextGetIndex(interp, textPtr, Tcl_GetString(objv[3]), &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	byteOffset = atoi(Tcl_GetString(objv[4]));
	TkTextIndexForwBytes(textPtr, &index, byteOffset, &index);
    } else if (strncmp(Tcl_GetString(objv[2]), "backbytes", len) == 0) {
	if (objc != 5) {
	    return TCL_ERROR;
	}
	if (TkTextGetIndex(interp, textPtr, Tcl_GetString(objv[3]), &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	byteOffset = atoi(Tcl_GetString(objv[4]));
	TkTextIndexBackBytes(textPtr, &index, byteOffset, &index);
    } else {
	return TCL_ERROR;
    }

    TkTextSetMark(textPtr, "insert", &index);
    TkTextPrintIndex(textPtr, &index, buf);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s %d", buf, index.byteIndex));
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */