diff options
Diffstat (limited to 'tk8.6/generic/tkText.c')
| -rw-r--r-- | tk8.6/generic/tkText.c | 6912 |
1 files changed, 6912 insertions, 0 deletions
diff --git a/tk8.6/generic/tkText.c b/tk8.6/generic/tkText.c new file mode 100644 index 0000000..5ad527a --- /dev/null +++ b/tk8.6/generic/tkText.c @@ -0,0 +1,6912 @@ +/* + * 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), + TK_OPTION_DONT_SET_DEFAULT, 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), + TK_OPTION_DONT_SET_DEFAULT, 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_OPTION_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), + 0, 0 , TK_TEXT_LINE_GEOMETRY }, + {TK_OPTION_PIXELS, "-spacing2", "spacing2", "Spacing", + DEF_TEXT_SPACING2, -1, Tk_Offset(TkText, spacing2), + 0, 0 , TK_TEXT_LINE_GEOMETRY }, + {TK_OPTION_PIXELS, "-spacing3", "spacing3", "Spacing", + DEF_TEXT_SPACING3, -1, Tk_Offset(TkText, spacing3), + 0, 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), + TK_OPTION_DONT_SET_DEFAULT, 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 GenerateUndoStackEvent(TkText *textPtr); +static void UpdateDirtyFlag(TkSharedText *sharedPtr); +static void RunAfterSyncCmd(ClientData clientData); +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; + } + + 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); + + /* + * 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); + + /* + * 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", "pendingsync", "replace", "scan", "search", + "see", "sync", "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_PENDINGSYNC, TEXT_REPLACE, TEXT_SCAN, + TEXT_SEARCH, TEXT_SEE, TEXT_SYNC, 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, index2; + + 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' (except if this line is elided), and + * then subtract off what came in too much from elided lines, + * also subtract off what we didn't want from 'from' and add + * on what we didn't count from 'to'. + */ + + while (TkTextIndexCmp(&index,indexToPtr) < 0) { + value += TkTextUpdateOneLine(textPtr, index.linePtr, + 0, &index, 0); + } + + index2 = index; + + /* + * Now we need to adjust the count to: + * - subtract off the number of display lines between + * indexToPtr and index2, since we might have skipped past + * indexToPtr, if we have several logical lines in a + * single display line + * - subtract off the number of display lines overcounted + * in the first logical line + * - add on the number of display lines in the last logical + * line + * This logic is still ok if both indexFromPtr and indexToPtr + * are in the same logical line. + */ + + index = *indexToPtr; + index.byteIndex = 0; + while (TkTextIndexCmp(&index,&index2) < 0) { + value -= TkTextUpdateOneLine(textPtr, index.linePtr, + 0, &index, 0); + } + index.linePtr = indexFromPtr->linePtr; + index.byteIndex = 0; + while (1) { + TkTextFindDisplayLineEnd(textPtr, &index, 1, NULL); + if (TkTextIndexCmp(&index,indexFromPtr) >= 0) { + 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 (TkTextIndexCmp(&index,indexToPtr) >= 0) { + 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_PENDINGSYNC: { + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + result = TCL_ERROR; + goto done; + } + Tcl_SetObjResult(interp, + Tcl_NewBooleanObj(TkTextPendingsync(textPtr))); + 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_SYNC: { + if (objc == 4) { + Tcl_Obj *cmd = objv[3]; + const char *option = Tcl_GetString(objv[2]); + if (strncmp(option, "-command", objv[2]->length)) { + Tcl_AppendResult(interp, "wrong option \"", option, "\": should be \"-command\"", NULL); + result = TCL_ERROR; + goto done; + } + Tcl_IncrRefCount(cmd); + if (TkTextPendingsync(textPtr)) { + if (textPtr->afterSyncCmd) { + Tcl_DecrRefCount(textPtr->afterSyncCmd); + } + textPtr->afterSyncCmd = cmd; + } else { + textPtr->afterSyncCmd = cmd; + Tcl_DoWhenIdle(RunAfterSyncCmd, (ClientData) textPtr); + } + break; + } else if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, "?-command command?"); + result = TCL_ERROR; + goto done; + } + if (textPtr->afterSyncCmd) { + Tcl_DecrRefCount(textPtr->afterSyncCmd); + } + textPtr->afterSyncCmd = NULL; + TkTextUpdateLineMetrics(textPtr, 1, + TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr), -1); + 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->afterSyncCmd){ + Tcl_DecrRefCount(textPtr->afterSyncCmd); + textPtr->afterSyncCmd = NULL; + } + 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; + + TkUndoSetMaxDepth(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. + */ + + if (textPtr->selTagPtr->selBorder == NULL) { + textPtr->selTagPtr->border = textPtr->selBorder; + } else { + textPtr->selTagPtr->selBorder = textPtr->selBorder; + } + if (textPtr->selTagPtr->borderWidthPtr != textPtr->selBorderWidthPtr) { + textPtr->selTagPtr->borderWidthPtr = textPtr->selBorderWidthPtr; + textPtr->selTagPtr->borderWidth = textPtr->selBorderWidth; + } + if (textPtr->selTagPtr->selFgColor == NULL) { + textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr; + } else { + textPtr->selTagPtr->selFgColor = 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->selBorder != NULL) + || (textPtr->selTagPtr->reliefString != NULL) + || (textPtr->selTagPtr->bgStipple != None) + || (textPtr->selTagPtr->fgColor != NULL) + || (textPtr->selTagPtr->selFgColor != NULL) + || (textPtr->selTagPtr->fgStipple != None) + || (textPtr->selTagPtr->overstrikeString != NULL) + || (textPtr->selTagPtr->overstrikeColor != NULL) + || (textPtr->selTagPtr->underlineString != NULL) + || (textPtr->selTagPtr->underlineColor != NULL) + || (textPtr->selTagPtr->lMarginColor != NULL) + || (textPtr->selTagPtr->rMarginColor != 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; + int oldCharHeight = textPtr->charHeight; + + 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; + } + if (textPtr->charHeight != oldCharHeight) { + TkBTreeClientRangeChanged(textPtr, textPtr->charHeight); + } + 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; + int canUndo, canRedo; + + /* + * 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); + + canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack); + canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); + + /* + * 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); + } + + if (!canUndo || canRedo) { + GenerateUndoStackEvent(textPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * 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. The idea is + * that a deletion involving a range starting at a line start and + * including the final \n (i.e. index2 is "end") is an attempt to delete + * complete lines, so the \n before the deleted block shall become the new + * final \n. 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>> + */ + + TkSendVirtualEvent(textPtr->tkwin, "Selection", NULL); +} + +/* + *---------------------------------------------------------------------- + * + * 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 { + if (searchSpecPtr->exact) { + leftToScan -= segPtr->size; + } else { + leftToScan -= Tcl_NumUtfChars(segPtr->body.chars, -1); + } + } + 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; + int canRedo = 0; + int canUndo = 0; + + static const char *const editOptionStrings[] = { + "canundo", "canredo", "modified", "redo", "reset", "separator", + "undo", NULL + }; + enum editOptions { + EDIT_CANUNDO, EDIT_CANREDO, 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_CANREDO: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + if (textPtr->sharedTextPtr->undo) { + canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(canRedo)); + break; + case EDIT_CANUNDO: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + if (textPtr->sharedTextPtr->undo) { + canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack); + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(canUndo)); + break; + 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; + } + canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack); + if (TextEditRedo(textPtr)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to redo", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_REDO", NULL); + return TCL_ERROR; + } + canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); + if (!canUndo || !canRedo) { + GenerateUndoStackEvent(textPtr); + } + break; + case EDIT_RESET: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack); + canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); + TkUndoClearStacks(textPtr->sharedTextPtr->undoStack); + if (canUndo || canRedo) { + GenerateUndoStackEvent(textPtr); + } + 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; + } + canRedo = TkUndoCanRedo(textPtr->sharedTextPtr->undoStack); + if (TextEditUndo(textPtr)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to undo", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_UNDO", NULL); + return TCL_ERROR; + } + canUndo = TkUndoCanUndo(textPtr->sharedTextPtr->undoStack); + if (!canRedo || !canUndo) { + GenerateUndoStackEvent(textPtr); + } + 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>> + * for all peers of $textWidget. + * + * Results: + * None + * + * Side effects: + * May force the text window into existence. + * + *---------------------------------------------------------------------- + */ + +static void +GenerateModifiedEvent( + TkText *textPtr) /* Information about text widget. */ +{ + for (textPtr = textPtr->sharedTextPtr->peers; textPtr != NULL; + textPtr = textPtr->next) { + Tk_MakeWindowExist(textPtr->tkwin); + TkSendVirtualEvent(textPtr->tkwin, "Modified", NULL); + } +} + +/* + *---------------------------------------------------------------------- + * + * GenerateUndoStackEvent -- + * + * Send an event that the undo or redo stack became empty or unempty. + * This is equivalent to: + * event generate $textWidget <<UndoStack>> + * for all peers of $textWidget. + * + * Results: + * None + * + * Side effects: + * May force the text window (and all peers) into existence. + * + *---------------------------------------------------------------------- + */ + +static void +GenerateUndoStackEvent( + TkText *textPtr) /* Information about text widget. */ +{ + for (textPtr = textPtr->sharedTextPtr->peers; textPtr != NULL; + textPtr = textPtr->next) { + Tk_MakeWindowExist(textPtr->tkwin); + TkSendVirtualEvent(textPtr->tkwin, "UndoStack", NULL); + } +} + +/* + *---------------------------------------------------------------------- + * + * UpdateDirtyFlag -- + * + * Updates the dirtyness of the text widget + * + * Results: + * None + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +UpdateDirtyFlag( + TkSharedText *sharedTextPtr)/* Information about text widget. */ +{ + int oldDirtyFlag; + + /* + * 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) { + GenerateModifiedEvent(sharedTextPtr->peers); + } +} + +/* + *---------------------------------------------------------------------- + * + * RunAfterSyncCmd -- + * + * This function is called by the event loop and executes the command + * scheduled by [.text sync -command $cmd]. + * + * Results: + * None. + * + * Side effects: + * Anything may happen, depending on $cmd contents. + * + *---------------------------------------------------------------------- + */ + +static void +RunAfterSyncCmd( + ClientData clientData) /* Information about text widget. */ +{ + register TkText *textPtr = (TkText *) clientData; + int code; + + if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) { + /* + * The widget has been deleted. Don't do anything. + */ + + if (--textPtr->refCount == 0) { + ckfree((char *) textPtr); + } + return; + } + + Tcl_Preserve((ClientData) textPtr->interp); + code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd, TCL_EVAL_GLOBAL); + if (code == TCL_ERROR) { + Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)"); + Tcl_BackgroundError(textPtr->interp); + } + Tcl_Release((ClientData) textPtr->interp); + Tcl_DecrRefCount(textPtr->afterSyncCmd); + textPtr->afterSyncCmd = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * 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: + */ |