From cf597519de1f5e18be3c07e6988cb6e91300ed6e Mon Sep 17 00:00:00 2001 From: vincentdarley Date: Mon, 19 May 2003 13:04:21 +0000 Subject: tip 113 implementation --- ChangeLog | 28 + doc/text.n | 27 +- generic/tkCanvas.c | 6 +- generic/tkInt.h | 7 +- generic/tkTest.c | 8 +- generic/tkText.c | 3569 ++++++++++++++++++++++++++++++------------------- generic/tkText.h | 104 +- generic/tkTextBTree.c | 10 +- generic/tkTextDisp.c | 104 +- generic/tkTextImage.c | 95 +- generic/tkTextIndex.c | 321 ++++- generic/tkTextMark.c | 207 +-- generic/tkTextTag.c | 1340 +++++++++---------- generic/tkTextWind.c | 456 +++---- generic/tkUndo.c | 70 +- generic/tkUndo.h | 25 +- generic/tkWindow.c | 4 +- library/text.tcl | 22 +- tests/text.test | 499 ++++++- tests/textIndex.test | 35 +- tests/textMark.test | 4 +- tests/textTag.test | 15 +- tests/textWind.test | 8 +- 23 files changed, 4336 insertions(+), 2628 deletions(-) diff --git a/ChangeLog b/ChangeLog index dfcdd08..9654dc6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,31 @@ +2003-05-13 Vince Darley + + * doc/text.n + * generic/tkCanvas.c + * generic/tkInt.h + * generic/tkTest.c + * generic/tkText.c + * generic/tkText.h + * generic/tkTextBTree.c + * generic/tkTextDisp.c + * generic/tkTextImage.c + * generic/tkTextIndex.c + * generic/tkTextMark.c + * generic/tkTextTag.c + * generic/tkTextWind.c + * generic/tkUndo.c + * generic/tkUndo.h + * generic/tkWindow.c + * library/text.tcl + * tests/text.test + * tests/textIndex.test + * tests/textMark.test + * tests/textTag.test + * tests/textWind.test: implementation of TIP 113. This adds + multi-line searching and '-all' searching to the text widget. + In addition the changes contain a complete 'objectification' of + the text widget. Includes documentation and new tests. + 2003-05-19 Daniel Steffen * macosx/Wish.pbproj/project.pbxproj: changed tkConfig.sh location diff --git a/doc/text.n b/doc/text.n index 69fb036..e2871d1 100644 --- a/doc/text.n +++ b/doc/text.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: text.n,v 1.15 2003/02/19 18:52:14 mdejong Exp $ +'\" RCS: @(#) $Id: text.n,v 1.16 2003/05/19 13:04:22 vincentdarley Exp $ '\" .so man.macros .TH text n 8.4 Tk "Tk Built-In Commands" @@ -1166,7 +1166,9 @@ This is the default. \fB\-backwards\fR The search will proceed backward through the text, finding the matching range closest to \fIindex\fR whose first character -is before \fIindex\fR. +is before \fIindex\fR. Note that, for a variety of reasons, backwards +searches can be substantially slower than forwards searches, so it is +recommended that performance-critical code use forward searches. .TP \fB\-exact\fR Use exact matching: the characters in the matching range must be @@ -1176,7 +1178,18 @@ This is the default. \fB\-regexp\fR Treat \fIpattern\fR as a regular expression and match it against the text using the rules for regular expressions (see the \fBregexp\fR -command for details). +command for details). The default matching automatically passes +both the \fB\-lineanchor\fR and \fB\-linestop\fR options +to the regexp engine (unless \fB\-nolinestop\fR is used), so that +\fI^$\fR match beginning and end of line, and \fI.\fR, \fI[^\fR +sequences will never match the newline character \fI\n\fR. +.TP +\fB\-nolinestop\fR +This allows +\fI.\fR and \fI[^\fR sequences to match the newline character \fI\n\fR, +which they will otherwise not do (see the \fBregexp\fR +command for details). This option is only meaningful if \fB\-regexp\fR +is also given, and an error will be thrown otherwise. .TP \fB\-nocase\fR Ignore case differences between the pattern and the text. @@ -1189,6 +1202,14 @@ embedded images or windows in the matching range, this is equivalent to the number of characters matched. In either case, the range \fImatchIdx\fR to \fImatchIdx + $count chars\fR will return the entire matched text. .TP +\fB\-all\fR +Find all matches in the given range and return a list of the indices of +the first character of each match. If a \fB\-count\fI varName\fR switch is +given, then \fBvarName\fR is also set to a list containing one element +for each successful match. Note that, even for exact searches, the +elements of this list may be different, if there are embedded images, +windows or hidden text. +.TP \fB\-elide\fR Find elidden (hidden) text as well. By default only displayed text is searched. diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c index 427eb22..0636c5e 100644 --- a/generic/tkCanvas.c +++ b/generic/tkCanvas.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvas.c,v 1.21 2003/02/09 07:48:22 hobbs Exp $ + * RCS: @(#) $Id: tkCanvas.c,v 1.22 2003/05/19 13:04:23 vincentdarley Exp $ */ /* #define USE_OLD_TAG_SEARCH 1 */ @@ -291,7 +291,7 @@ static int FindArea _ANSI_ARGS_((Tcl_Interp *interp, TkCanvas *canvasPtr, Tcl_Obj *CONST *argv, Tk_Uid uid, int enclosed)); static double GridAlign _ANSI_ARGS_((double coord, double spacing)); -static CONST char** GetStringsFromObjs _ANSI_ARGS_((int argc, +CONST char** GetStringsFromObjs _ANSI_ARGS_((int argc, Tcl_Obj *CONST *objv)); static void InitCanvas _ANSI_ARGS_((void)); #ifdef USE_OLD_TAG_SEARCH @@ -5494,7 +5494,7 @@ CanvasSetOrigin(canvasPtr, xOrigin, yOrigin) *---------------------------------------------------------------------- */ /* ARGSUSED */ -static CONST char ** +CONST char ** GetStringsFromObjs(argc, objv) int argc; Tcl_Obj *CONST objv[]; diff --git a/generic/tkInt.h b/generic/tkInt.h index 6bd0f12..8ef78d9 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: $Id: tkInt.h,v 1.57 2003/04/14 23:34:41 mdejong Exp $ + * RCS: $Id: tkInt.h,v 1.58 2003/05/19 13:04:23 vincentdarley Exp $ */ #ifndef _TKINT @@ -1065,8 +1065,9 @@ EXTERN int Tk_SendObjCmd _ANSI_ARGS_((ClientData clientData, EXTERN int Tk_SpinboxObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -EXTERN int Tk_TextCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv)); +EXTERN int Tk_TextObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_TkObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); diff --git a/generic/tkTest.c b/generic/tkTest.c index 5392fa3..0dbbc2b 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTest.c,v 1.21 2002/09/02 19:14:04 hobbs Exp $ + * RCS: @(#) $Id: tkTest.c,v 1.22 2003/05/19 13:04:23 vincentdarley Exp $ */ #include "tkInt.h" @@ -2325,7 +2325,11 @@ TesttextCmd(clientData, interp, argc, argv) if (Tcl_GetCommandInfo(interp, argv[1], &info) == 0) { return TCL_ERROR; } - textPtr = (TkText *) info.clientData; + if (info.isNativeObjectProc) { + textPtr = (TkText *) info.objClientData; + } else { + textPtr = (TkText *) info.clientData; + } len = strlen(argv[2]); if (strncmp(argv[2], "byteindex", len) == 0) { if (argc != 5) { diff --git a/generic/tkText.c b/generic/tkText.c index 6bed713..fbc7083 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkText.c,v 1.33 2003/02/18 21:53:59 hobbs Exp $ + * RCS: @(#) $Id: tkText.c,v 1.34 2003/05/19 13:04:23 vincentdarley Exp $ */ #include "default.h" @@ -30,269 +30,228 @@ #include "tkText.h" /* - * Custom options for handling "-state" + * 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 Tk_CustomOption stateOption = { - (Tk_OptionParseProc *) TkStateParseProc, - TkStatePrintProc, (ClientData) NULL /* only "normal" and "disabled" */ +static char *stateStrings[] = { + "disabled", "normal", (char *) NULL }; /* - * Information used to parse text configuration options: + * 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 Tk_ConfigSpec configSpecs[] = { - {TK_CONFIG_BOOLEAN, "-autoseparators", "autoSeparators", - "AutoSeparators", DEF_TEXT_AUTO_SEPARATORS, - Tk_Offset(TkText, autoSeparators), 0}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_TEXT_BG_COLOR, Tk_Offset(TkText, border), TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-background", "background", "Background", - DEF_TEXT_BG_MONO, Tk_Offset(TkText, border), TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", - DEF_TEXT_BORDER_WIDTH, Tk_Offset(TkText, borderWidth), 0}, - {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", - DEF_TEXT_CURSOR, Tk_Offset(TkText, cursor), TK_CONFIG_NULL_OK}, - {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection", - "ExportSelection", DEF_TEXT_EXPORT_SELECTION, - Tk_Offset(TkText, exportSelection), 0}, - {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, - (char *) NULL, 0, 0}, - {TK_CONFIG_FONT, "-font", "font", "Font", - DEF_TEXT_FONT, Tk_Offset(TkText, tkfont), 0}, - {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", - DEF_TEXT_FG, Tk_Offset(TkText, fgColor), 0}, - {TK_CONFIG_PIXELS, "-height", "height", "Height", - DEF_TEXT_HEIGHT, Tk_Offset(TkText, height), 0}, - {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", - "HighlightBackground", DEF_TEXT_HIGHLIGHT_BG, - Tk_Offset(TkText, highlightBgColorPtr), 0}, - {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", - DEF_TEXT_HIGHLIGHT, Tk_Offset(TkText, highlightColorPtr), 0}, - {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", - "HighlightThickness", - DEF_TEXT_HIGHLIGHT_WIDTH, Tk_Offset(TkText, highlightWidth), 0}, - {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground", - DEF_TEXT_INSERT_BG, Tk_Offset(TkText, insertBorder), 0}, - {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth", - DEF_TEXT_INSERT_BD_COLOR, Tk_Offset(TkText, insertBorderWidth), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth", - DEF_TEXT_INSERT_BD_MONO, Tk_Offset(TkText, insertBorderWidth), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime", - DEF_TEXT_INSERT_OFF_TIME, Tk_Offset(TkText, insertOffTime), 0}, - {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime", - DEF_TEXT_INSERT_ON_TIME, Tk_Offset(TkText, insertOnTime), 0}, - {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", - DEF_TEXT_INSERT_WIDTH, Tk_Offset(TkText, insertWidth), 0}, - {TK_CONFIG_INT, "-maxundo", "maxUndo", "MaxUndo", - DEF_TEXT_MAX_UNDO, Tk_Offset(TkText, maxUndo), 0}, - {TK_CONFIG_PIXELS, "-padx", "padX", "Pad", - DEF_TEXT_PADX, Tk_Offset(TkText, padX), 0}, - {TK_CONFIG_PIXELS, "-pady", "padY", "Pad", - DEF_TEXT_PADY, Tk_Offset(TkText, padY), 0}, - {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", - DEF_TEXT_RELIEF, Tk_Offset(TkText, relief), 0}, - {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground", - DEF_TEXT_SELECT_COLOR, Tk_Offset(TkText, selBorder), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground", - DEF_TEXT_SELECT_MONO, Tk_Offset(TkText, selBorder), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_STRING, "-selectborderwidth", "selectBorderWidth", "BorderWidth", - DEF_TEXT_SELECT_BD_COLOR, Tk_Offset(TkText, selBdString), - TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-selectborderwidth", "selectBorderWidth", "BorderWidth", - DEF_TEXT_SELECT_BD_MONO, Tk_Offset(TkText, selBdString), - TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK}, - {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", - DEF_TEXT_SELECT_FG_COLOR, Tk_Offset(TkText, selFgColorPtr), - TK_CONFIG_COLOR_ONLY}, - {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", - DEF_TEXT_SELECT_FG_MONO, Tk_Offset(TkText, selFgColorPtr), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_BOOLEAN, "-setgrid", "setGrid", "SetGrid", - DEF_TEXT_SET_GRID, Tk_Offset(TkText, setGrid), 0}, - {TK_CONFIG_PIXELS, "-spacing1", "spacing1", "Spacing", - DEF_TEXT_SPACING1, Tk_Offset(TkText, spacing1), - TK_CONFIG_DONT_SET_DEFAULT}, - {TK_CONFIG_PIXELS, "-spacing2", "spacing2", "Spacing", - DEF_TEXT_SPACING2, Tk_Offset(TkText, spacing2), - TK_CONFIG_DONT_SET_DEFAULT}, - {TK_CONFIG_PIXELS, "-spacing3", "spacing3", "Spacing", - DEF_TEXT_SPACING3, Tk_Offset(TkText, spacing3), - TK_CONFIG_DONT_SET_DEFAULT}, - {TK_CONFIG_CUSTOM, "-state", "state", "State", - DEF_TEXT_STATE, Tk_Offset(TkText, state), 0, &stateOption}, - {TK_CONFIG_STRING, "-tabs", "tabs", "Tabs", - DEF_TEXT_TABS, Tk_Offset(TkText, tabOptionString), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", - DEF_TEXT_TAKE_FOCUS, Tk_Offset(TkText, takeFocus), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_BOOLEAN, "-undo", "undo", "Undo", - DEF_TEXT_UNDO, Tk_Offset(TkText, undo), 0}, - {TK_CONFIG_INT, "-width", "width", "Width", - DEF_TEXT_WIDTH, Tk_Offset(TkText, width), 0}, - {TK_CONFIG_CUSTOM, "-wrap", "wrap", "Wrap", - DEF_TEXT_WRAP, Tk_Offset(TkText, wrapMode), 0, &textWrapModeOption}, - {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", - DEF_TEXT_XSCROLL_COMMAND, Tk_Offset(TkText, xScrollCmd), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand", - DEF_TEXT_YSCROLL_COMMAND, Tk_Offset(TkText, yScrollCmd), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, 0} +static char *wrapStrings[] = { + "char", "none", "word", (char *) NULL }; /* - * Boolean variable indicating whether or not special debugging code - * should be executed. - */ - -int tkTextDebug = 0; - -/* - * Custom options for handling "-wrap": + * Information used to parse text configuration options: */ -static int WrapModeParseProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, Tk_Window tkwin, - CONST char *value, char *widgRec, int offset)); -static char * WrapModePrintProc _ANSI_ARGS_((ClientData clientData, - Tk_Window tkwin, char *widgRec, int offset, - Tcl_FreeProc **freeProcPtr)); - -Tk_CustomOption textWrapModeOption = { - WrapModeParseProc, - WrapModePrintProc, - (ClientData) NULL +static Tk_OptionSpec optionSpecs[] = { + {TK_OPTION_BOOLEAN, "-autoseparators", "autoSeparators", + "AutoSeparators", DEF_TEXT_AUTO_SEPARATORS, -1, + Tk_Offset(TkText, autoSeparators), 0, 0, 0}, + {TK_OPTION_BORDER, "-background", "background", "Background", + DEF_TEXT_BG_COLOR, -1, Tk_Offset(TkText, border), + 0, (ClientData) DEF_TEXT_BG_MONO, 0}, + {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-background", 0}, + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + DEF_TEXT_BORDER_WIDTH, -1, Tk_Offset(TkText, borderWidth), + 0, 0, 0}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", + DEF_TEXT_CURSOR, -1, Tk_Offset(TkText, cursor), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection", + "ExportSelection", DEF_TEXT_EXPORT_SELECTION, -1, + Tk_Offset(TkText, exportSelection), 0, 0, 0}, + {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL, + (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + {TK_OPTION_FONT, "-font", "font", "Font", + DEF_TEXT_FONT, -1, Tk_Offset(TkText, tkfont), 0, 0, 0}, + {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, 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_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", + DEF_TEXT_INSERT_WIDTH, -1, Tk_Offset(TkText, insertWidth), + 0, 0, 0}, + {TK_OPTION_INT, "-maxundo", "maxUndo", "MaxUndo", + DEF_TEXT_MAX_UNDO, -1, Tk_Offset(TkText, maxUndo), 0, 0, 0}, + {TK_OPTION_PIXELS, "-padx", "padX", "Pad", + DEF_TEXT_PADX, -1, Tk_Offset(TkText, padX), 0, 0, 0}, + {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, (ClientData) 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, (ClientData) DEF_TEXT_SELECT_BD_MONO, 0}, + {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", + DEF_TEXT_SELECT_FG_COLOR, -1, Tk_Offset(TkText, selFgColorPtr), + 0, (ClientData) DEF_TEXT_SELECT_FG_MONO, 0}, + {TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid", + DEF_TEXT_SET_GRID, -1, Tk_Offset(TkText, setGrid), 0, 0, 0}, + {TK_OPTION_PIXELS, "-spacing1", "spacing1", "Spacing", + DEF_TEXT_SPACING1, -1, Tk_Offset(TkText, spacing1), + TK_OPTION_DONT_SET_DEFAULT, 0 , 0 }, + {TK_OPTION_PIXELS, "-spacing2", "spacing2", "Spacing", + DEF_TEXT_SPACING2, -1, Tk_Offset(TkText, spacing2), + TK_OPTION_DONT_SET_DEFAULT, 0 , 0 }, + {TK_OPTION_PIXELS, "-spacing3", "spacing3", "Spacing", + DEF_TEXT_SPACING3, -1, Tk_Offset(TkText, spacing3), + TK_OPTION_DONT_SET_DEFAULT, 0 , 0 }, + {TK_OPTION_STRING_TABLE, "-state", "state", "State", + DEF_TEXT_STATE, -1, Tk_Offset(TkText, state), + 0, (ClientData) stateStrings, 0}, + {TK_OPTION_STRING, "-tabs", "tabs", "Tabs", + DEF_TEXT_TABS, Tk_Offset(TkText, tabOptionPtr), -1, + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", + DEF_TEXT_TAKE_FOCUS, -1, Tk_Offset(TkText, takeFocus), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BOOLEAN, "-undo", "undo", "Undo", + DEF_TEXT_UNDO, -1, Tk_Offset(TkText, undo), 0, 0 , 0}, + {TK_OPTION_INT, "-width", "width", "Width", + DEF_TEXT_WIDTH, -1, Tk_Offset(TkText, width), 0, 0, 0}, + {TK_OPTION_STRING_TABLE, "-wrap", "wrap", "Wrap", + DEF_TEXT_WRAP, -1, Tk_Offset(TkText, wrapMode), + 0, (ClientData) wrapStrings, 0}, + {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} }; /* - *-------------------------------------------------------------- - * - * WrapModeParseProc -- - * - * This procedure is invoked during option processing to handle - * "-wrap" options for text widgets. - * - * Results: - * A standard Tcl return value. - * - * Side effects: - * The wrap mode for a given item gets replaced by the wrap mode - * indicated in the value argument. - * - *-------------------------------------------------------------- + * 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. */ -static int -WrapModeParseProc(clientData, interp, tkwin, value, widgRec, offset) - ClientData clientData; /* some flags.*/ - Tcl_Interp *interp; /* Used for reporting errors. */ - Tk_Window tkwin; /* Window containing canvas widget. */ - CONST char *value; /* Value of option (list of tag - * names). */ - char *widgRec; /* Pointer to record for item. */ - int offset; /* Offset into item. */ -{ - int c; - size_t length; - - register TkWrapMode *wrapPtr = (TkWrapMode *) (widgRec + offset); - - if(value == NULL || *value == 0) { - *wrapPtr = TEXT_WRAPMODE_NULL; - return TCL_OK; - } +typedef ClientData SearchAddLineProc _ANSI_ARGS_((int lineNum, + struct SearchSpec *searchSpecPtr, + Tcl_Obj *theLine, int *lenPtr)); +typedef int SearchMatchProc _ANSI_ARGS_((int lineNum, + struct SearchSpec *searchSpecPtr, + ClientData clientData, Tcl_Obj *theLine, + int matchOffset, int matchLength)); +typedef int SearchLineIndexProc _ANSI_ARGS_((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 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; - c = value[0]; - length = strlen(value); - - if ((c == 'c') && (strncmp(value, "char", length) == 0)) { - *wrapPtr = TEXT_WRAPMODE_CHAR; - return TCL_OK; - } - if ((c == 'n') && (strncmp(value, "none", length) == 0)) { - *wrapPtr = TEXT_WRAPMODE_NONE; - return TCL_OK; - } - if ((c == 'w') && (strncmp(value, "word", length) == 0)) { - *wrapPtr = TEXT_WRAPMODE_WORD; - return TCL_OK; - } - Tcl_AppendResult(interp, "bad wrap mode \"", value, - "\": must be char, none, or word", - (char *) NULL); - *wrapPtr = TEXT_WRAPMODE_CHAR; - return TCL_ERROR; -} +/* + * The text-widget-independent functions which actually perform + * the search, handling both regexp and exact searches. + */ +static int SearchCore _ANSI_ARGS_((Tcl_Interp *interp, + SearchSpec *searchSpecPtr, Tcl_Obj *patObj)); +static int SearchPerform _ANSI_ARGS_((Tcl_Interp *interp, + SearchSpec *searchSpecPtr, Tcl_Obj *patObj, + Tcl_Obj *fromPtr, Tcl_Obj *toPtr)); /* - *-------------------------------------------------------------- - * - * WrapModePrintProc -- - * - * This procedure is invoked by the Tk configuration code - * to produce a printable string for the "-wrap" configuration - * option for canvas items. - * - * Results: - * The return value is a string describing the state for - * the item referred to by "widgRec". In addition, *freeProcPtr - * is filled in with the address of a procedure to call to free - * the result string when it's no longer needed (or NULL to - * indicate that the string doesn't need to be freed). - * - * Side effects: - * None. - * - *-------------------------------------------------------------- + * Boolean variable indicating whether or not special debugging code + * should be executed. */ -static char * -WrapModePrintProc(clientData, tkwin, widgRec, offset, freeProcPtr) - ClientData clientData; /* Ignored. */ - Tk_Window tkwin; /* Window containing canvas widget. */ - char *widgRec; /* Pointer to record for item. */ - int offset; /* Ignored. */ - Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with - * information about how to reclaim - * storage for return string. */ -{ - register TkWrapMode *wrapPtr = (TkWrapMode *) (widgRec + offset); - - if (*wrapPtr==TEXT_WRAPMODE_CHAR) { - return "char"; - } else if (*wrapPtr==TEXT_WRAPMODE_NONE) { - return "none"; - } else if (*wrapPtr==TEXT_WRAPMODE_WORD) { - return "word"; - } else { - return ""; - } -} +int tkTextDebug = 0; /* * Forward declarations for procedures defined later in this file: */ static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp, - TkText *textPtr, int argc, CONST char **argv, - int flags)); + TkText *textPtr, int objc, Tcl_Obj *CONST objv[])); static int DeleteChars _ANSI_ARGS_((TkText *textPtr, - CONST char *index1String, CONST char *index2String, - TkTextIndex *indexPtr1, TkTextIndex *indexPtr2)); + Tcl_Obj *index1Obj, Tcl_Obj *index2Obj, + CONST TkTextIndex *indexPtr1, + CONST TkTextIndex *indexPtr2)); static void DestroyText _ANSI_ARGS_((char *memPtr)); -static void InsertChars _ANSI_ARGS_((TkText *textPtr, - TkTextIndex *indexPtr, CONST char *string)); +static int InsertChars _ANSI_ARGS_((TkText *textPtr, + TkTextIndex *indexPtr, Tcl_Obj *stringPtr)); static void TextBlinkProc _ANSI_ARGS_((ClientData clientData)); static void TextCmdDeletedProc _ANSI_ARGS_(( ClientData clientData)); @@ -303,27 +262,48 @@ static int TextFetchSelection _ANSI_ARGS_((ClientData clientData, static int TextIndexSortProc _ANSI_ARGS_((CONST VOID *first, CONST VOID *second)); static int TextSearchCmd _ANSI_ARGS_((TkText *textPtr, - Tcl_Interp *interp, int argc, CONST char **argv)); + Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); static int TextEditCmd _ANSI_ARGS_((TkText *textPtr, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TextWidgetCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv)); + Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); +static int TextWidgetObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); static void TextWorldChanged _ANSI_ARGS_(( ClientData instanceData)); static int TextDumpCmd _ANSI_ARGS_((TkText *textPtr, - Tcl_Interp *interp, int argc, CONST char **argv)); + Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); static void DumpLine _ANSI_ARGS_((Tcl_Interp *interp, TkText *textPtr, int what, TkTextLine *linePtr, int start, int end, int lineno, CONST char *command)); static int DumpSegment _ANSI_ARGS_((Tcl_Interp *interp, char *key, char *value, CONST char * command, - TkTextIndex *index, int what)); + CONST TkTextIndex *index, int what)); static int TextEditUndo _ANSI_ARGS_((TkText *textPtr)); static int TextEditRedo _ANSI_ARGS_((TkText *textPtr)); -static void TextGetText _ANSI_ARGS_((TkTextIndex * index1, - TkTextIndex * index2, Tcl_DString *dsPtr)); -static void updateDirtyFlag _ANSI_ARGS_((TkText *textPtr)); +static Tcl_Obj* TextGetText _ANSI_ARGS_((CONST TkTextIndex * index1, + CONST TkTextIndex * index2)); +static void UpdateDirtyFlag _ANSI_ARGS_((TkText *textPtr)); +static void TextPushUndoAction _ANSI_ARGS_((TkText *textPtr, + Tcl_Obj *undoString, int insert, + CONST TkTextIndex *index1Ptr, + CONST TkTextIndex *index2Ptr)); +static int TextSearchIndexInLine _ANSI_ARGS_(( + CONST SearchSpec *searchSpecPtr, + TkTextLine *linePtr, int byteIndex)); + +/* + * 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 procedures @@ -339,7 +319,7 @@ static Tk_ClassProcs textClass = { /* *-------------------------------------------------------------- * - * Tk_TextCmd -- + * Tk_TextObjCmd -- * * This procedure is invoked to process the "text" Tcl command. * See the user documentation for details on what it does. @@ -354,21 +334,21 @@ static Tk_ClassProcs textClass = { */ int -Tk_TextCmd(clientData, interp, argc, argv) +Tk_TextObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with * interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tk_Window tkwin = (Tk_Window) clientData; Tk_Window new; + Tk_OptionTable optionTable; register TkText *textPtr; TkTextIndex startIndex; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " pathName ?options?\"", (char *) NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); return TCL_ERROR; } @@ -376,7 +356,8 @@ Tk_TextCmd(clientData, interp, argc, argv) * Create the window. */ - new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL); + new = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[1]), + (char *) NULL); if (new == NULL) { return TCL_ERROR; } @@ -392,15 +373,15 @@ Tk_TextCmd(clientData, interp, argc, argv) textPtr->tkwin = new; textPtr->display = Tk_Display(new); textPtr->interp = interp; - textPtr->widgetCmd = Tcl_CreateCommand(interp, - Tk_PathName(textPtr->tkwin), TextWidgetCmd, + textPtr->widgetCmd = Tcl_CreateObjCommand(interp, + Tk_PathName(textPtr->tkwin), TextWidgetObjCmd, (ClientData) textPtr, TextCmdDeletedProc); textPtr->tree = TkBTreeCreate(textPtr); Tcl_InitHashTable(&textPtr->tagTable, TCL_STRING_KEYS); Tcl_InitHashTable(&textPtr->markTable, TCL_STRING_KEYS); Tcl_InitHashTable(&textPtr->windowTable, TCL_STRING_KEYS); Tcl_InitHashTable(&textPtr->imageTable, TCL_STRING_KEYS); - textPtr->state = TK_STATE_NORMAL; + textPtr->state = TK_TEXT_STATE_NORMAL; textPtr->relief = TK_RELIEF_FLAT; textPtr->cursor = None; textPtr->charWidth = 1; @@ -417,11 +398,18 @@ Tk_TextCmd(clientData, interp, argc, argv) textPtr->isDirtyIncrement = 1; textPtr->autoSeparators = 1; textPtr->lastEditMode = TK_TEXT_EDIT_OTHER; - + textPtr->tabOptionPtr = NULL; + textPtr->stateEpoch = 0; + textPtr->refCount = 1; + /* * Create the "sel" tag and the "current" and "insert" marks. */ + textPtr->selBorder = NULL; + textPtr->selBorderWidth = 0; + textPtr->selBorderWidthPtr = NULL; + textPtr->selFgColorPtr = NULL; textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel"); textPtr->selTagPtr->reliefString = (char *) ckalloc(sizeof(DEF_TEXT_SELECT_RELIEF)); @@ -430,8 +418,17 @@ Tk_TextCmd(clientData, interp, argc, argv) 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, (ClientData) textPtr); + textPtr->optionTable = optionTable; + Tk_CreateEventHandler(textPtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, TextEventProc, (ClientData) textPtr); @@ -441,19 +438,26 @@ Tk_TextCmd(clientData, interp, argc, argv) TkTextBindProc, (ClientData) textPtr); Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, XA_STRING, TextFetchSelection, (ClientData) textPtr, XA_STRING); - if (ConfigureText(interp, textPtr, argc-2, argv+2, 0) != TCL_OK) { + + 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_SetResult(interp, Tk_PathName(textPtr->tkwin), TCL_STATIC); + Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(textPtr->tkwin), + -1); return TCL_OK; } /* *-------------------------------------------------------------- * - * TextWidgetCmd -- + * TextWidgetObjCmd -- * * This procedure is invoked to process the Tcl command * that corresponds to a text widget. See the user @@ -469,413 +473,494 @@ Tk_TextCmd(clientData, interp, argc, argv) */ static int -TextWidgetCmd(clientData, interp, argc, argv) +TextWidgetObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Information about text widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { register TkText *textPtr = (TkText *) clientData; - int c, result = TCL_OK; - size_t length; - TkTextIndex index1, index2; + int result = TCL_OK; + int index; + + static CONST char *optionStrings[] = { + "bbox", "cget", "compare", "configure", "debug", "delete", + "dlineinfo", "dump", "edit", "get", "image", "index", + "insert", "mark", "scan", "search", "see", "tag", + "window", "xview", "yview", (char *) NULL + }; + enum options { + TEXT_BBOX, TEXT_CGET, TEXT_COMPARE, TEXT_CONFIGURE, TEXT_DEBUG, + TEXT_DELETE, TEXT_DLINEINFO, TEXT_DUMP, TEXT_EDIT, TEXT_GET, + TEXT_IMAGE, TEXT_INDEX, TEXT_INSERT, TEXT_MARK, TEXT_SCAN, + TEXT_SEARCH, TEXT_SEE, TEXT_TAG, TEXT_WINDOW, TEXT_XVIEW, TEXT_YVIEW + }; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + return TCL_ERROR; + } - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option ?arg arg ...?\"", (char *) NULL); + if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, + &index) != TCL_OK) { return TCL_ERROR; } Tcl_Preserve((ClientData) textPtr); - c = argv[1][0]; - length = strlen(argv[1]); - if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) { - int x, y, width, height; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " bbox index\"", (char *) NULL); - result = TCL_ERROR; - goto done; - } - if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) { - result = TCL_ERROR; - goto done; - } - if (TkTextCharBbox(textPtr, &index1, &x, &y, &width, &height) == 0) { - char buf[TCL_INTEGER_SPACE * 4]; + + switch ((enum options) index) { + case TEXT_BBOX: { + int x, y, width, height; + CONST TkTextIndex *indexPtr; - sprintf(buf, "%d %d %d %d", x, y, width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } - } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0) - && (length >= 2)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " cget option\"", - (char *) NULL); - result = TCL_ERROR; - goto done; - } - result = Tk_ConfigureValue(interp, textPtr->tkwin, configSpecs, - (char *) textPtr, argv[2], 0); - } else if ((c == 'c') && (strncmp(argv[1], "compare", length) == 0) - && (length >= 3)) { - int relation, value; - CONST char *p; - - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " compare index1 op index2\"", (char *) NULL); - result = TCL_ERROR; - goto done; - } - if ((TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) - || (TkTextGetIndex(interp, textPtr, argv[4], &index2) - != TCL_OK)) { - result = TCL_ERROR; - goto done; - } - relation = TkTextIndexCmp(&index1, &index2); - p = argv[3]; - if (p[0] == '<') { - value = (relation < 0); - if ((p[1] == '=') && (p[2] == 0)) { - value = (relation <= 0); - } else if (p[1] != 0) { - compareError: - Tcl_AppendResult(interp, "bad comparison operator \"", - argv[3], "\": must be <, <=, ==, >=, >, or !=", - (char *) NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); result = TCL_ERROR; goto done; } - } 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_SetResult(interp, ((value) ? "1" : "0"), TCL_STATIC); - } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) - && (length >= 3)) { - if (argc == 2) { - result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs, - (char *) textPtr, (char *) NULL, 0); - } else if (argc == 3) { - result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs, - (char *) textPtr, argv[2], 0); - } else { - result = ConfigureText(interp, textPtr, argc-2, argv+2, - TK_CONFIG_ARGV_ONLY); - } - } else if ((c == 'd') && (strncmp(argv[1], "debug", length) == 0) - && (length >= 3)) { - if (argc > 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " debug boolean\"", (char *) NULL); - result = TCL_ERROR; - goto done; - } - if (argc == 2) { - Tcl_SetResult(interp, ((tkBTreeDebug) ? "1" : "0"), TCL_STATIC); - } else { - if (Tcl_GetBoolean(interp, argv[2], &tkBTreeDebug) != TCL_OK) { + indexPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]); + if (indexPtr == NULL) { result = TCL_ERROR; goto done; } - tkTextDebug = tkBTreeDebug; + if (TkTextCharBbox(textPtr, indexPtr, &x, &y, + &width, &height) == 0) { + char buf[TCL_INTEGER_SPACE * 4]; + + sprintf(buf, "%d %d %d %d", x, y, width, height); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + } + break; } - } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0) - && (length >= 3)) { - int i; - - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " delete index1 ?index2 ...?\"", (char *) NULL); - result = TCL_ERROR; - goto done; + 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; + } else { + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; + } + } + break; } - if (textPtr->state == TK_STATE_NORMAL) { - if (argc < 5) { - /* - * Simple case requires no predetermination of indices. - */ - result = DeleteChars(textPtr, argv[2], - (argc == 4) ? argv[3] : NULL, NULL, NULL); + 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) { + compareError: + Tcl_AppendResult(interp, "bad comparison operator \"", + Tcl_GetString(objv[3]), + "\": must be <, <=, ==, >=, >, or !=", + (char *) NULL); + result = TCL_ERROR; + goto done; + } + } 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 { - /* - * 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; - - argc -= 2; - argv += 2; - indices = (TkTextIndex *) - ckalloc((argc + 1) * sizeof(TkTextIndex)); - - /* - * First pass verifies that all indices are valid. - */ - for (i = 0; i < argc; i++) { - if (TkTextGetIndex(interp, textPtr, argv[i], - &indices[i]) != TCL_OK) { - result = TCL_ERROR; - ckfree((char *) indices); - goto done; - } + goto compareError; + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); + break; + } + case TEXT_CONFIGURE: { + if (objc <= 3) { + Tcl_Obj* objPtr = Tk_GetOptionInfo(interp, (char *) textPtr, + textPtr->optionTable, + (objc == 3) ? objv[2] : (Tcl_Obj *) NULL, + textPtr->tkwin); + if (objPtr == NULL) { + result = TCL_ERROR; + goto done; + } else { + Tcl_SetObjResult(interp, objPtr); } - /* - * Pad out the pairs evenly to make later code easier. - */ - if (argc & 1) { - indices[i] = indices[i-1]; - TkTextIndexForwChars(&indices[i], 1, &indices[i]); - argc++; + } else { + result = ConfigureText(interp, textPtr, objc-2, objv+2); + } + break; + } + 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; } - useIdx = (char *) ckalloc((unsigned) argc); - memset(useIdx, 0, (unsigned) argc); - /* - * Do a decreasing order sort so that we delete the end - * ranges first to maintain index consistency. - */ - qsort((VOID *) indices, (unsigned) (argc / 2), - 2 * sizeof(TkTextIndex), TextIndexSortProc); - lastStart = NULL; - /* - * Second pass will handle bogus ranges (end < start) and - * overlapping ranges. - */ - for (i = 0; i < argc; i += 2) { - ixStart = &indices[i]; - ixEnd = &indices[i+1]; - if (TkTextIndexCmp(ixEnd, ixStart) <= 0) { - continue; + 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. + */ + result = DeleteChars(textPtr, objv[2], + (objc == 4) ? objv[3] : NULL, NULL, NULL); + } else { + int i; + /* + * 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; + + objc -= 2; + objv += 2; + indices = (TkTextIndex *) + 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((char *) indices); + goto done; + } + indices[i] = *indexPtr; } - if (lastStart) { - if (TkTextIndexCmp(ixStart, lastStart) == 0) { - /* - * Start indices were equal, and the sort placed - * the longest range first, so skip this one. - */ + /* + * Pad out the pairs evenly to make later code easier. + */ + if (objc & 1) { + indices[i] = indices[i-1]; + TkTextIndexForwChars(&indices[i], 1, &indices[i]); + objc++; + } + useIdx = (char *) ckalloc((unsigned) objc); + memset(useIdx, 0, (unsigned) objc); + /* + * Do a decreasing order sort so that we delete the end + * ranges first to maintain index consistency. + */ + qsort((VOID *) 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; - } 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) { + } + 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; } - 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 < argc; i += 2) { - if (useIdx[i]) { - /* - * We don't need to check the return value because all - * indices are preparsed above. - */ - DeleteChars(textPtr, NULL, NULL, - &indices[i], &indices[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. + */ + DeleteChars(textPtr, NULL, NULL, + &indices[i], &indices[i+1]); + } } + ckfree((char *) indices); } - ckfree((char *) indices); } + break; } - } else if ((c == 'd') && (strncmp(argv[1], "dlineinfo", length) == 0) - && (length >= 2)) { - int x, y, width, height, base; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " dlineinfo index\"", (char *) NULL); - result = TCL_ERROR; - goto done; - } - if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) { - result = TCL_ERROR; - goto done; - } - if (TkTextDLineInfo(textPtr, &index1, &x, &y, &width, &height, &base) - == 0) { - char buf[TCL_INTEGER_SPACE * 5]; + case TEXT_DLINEINFO: { + int x, y, width, height, base; + CONST TkTextIndex *indexPtr; - sprintf(buf, "%d %d %d %d %d", x, y, width, height, base); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } - } else if ((c == 'e') && (strncmp(argv[1], "edit", length) == 0)) { - result = TextEditCmd(textPtr, interp, argc, argv); - } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { - Tcl_Obj *objPtr = NULL; - Tcl_DString ds; - int i, found = 0; - - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " get index1 ?index2 ...?\"", (char *) NULL); - result = TCL_ERROR; - goto done; - } - for (i = 2; i < argc; i += 2) { - if (TkTextGetIndex(interp, textPtr, argv[i], &index1) != TCL_OK) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); result = TCL_ERROR; goto done; } - if (i+1 == argc) { - index2 = index1; - TkTextIndexForwChars(&index2, 1, &index2); - } else if (TkTextGetIndex(interp, textPtr, argv[i+1], &index2) - != TCL_OK) { - if (objPtr) { - Tcl_DecrRefCount(objPtr); - } + indexPtr = TkTextGetIndexFromObj(interp, textPtr, objv[2]); + if (indexPtr == NULL) { result = TCL_ERROR; goto done; } - if (TkTextIndexCmp(&index1, &index2) < 0) { - /* - * Place the text in a DString and move it to the result. - * Since this could in principle be a megabyte or more, we - * want to do it efficiently! - */ - TextGetText(&index1, &index2, &ds); - found++; - if (found == 1) { - Tcl_DStringResult(interp, &ds); - } 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_NewStringObj(Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds))); - } - Tcl_DStringFree(&ds); + if (TkTextDLineInfo(textPtr, indexPtr, &x, &y, &width, + &height, &base) == 0) { + char buf[TCL_INTEGER_SPACE * 5]; + + sprintf(buf, "%d %d %d %d %d", x, y, width, height, base); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } + break; } - if (found > 1) { - Tcl_SetObjResult(interp, objPtr); - } - } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0) - && (length >= 3)) { - char buf[200]; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " index index\"", - (char *) NULL); - result = TCL_ERROR; - goto done; - } - if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) { - result = TCL_ERROR; - goto done; - } - TkTextPrintIndex(&index1, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0) - && (length >= 3)) { - int i, j, numTags; - CONST char **tagNames; - TkTextTag **oldTagArrayPtr; - - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], - " insert index chars ?tagList chars tagList ...?\"", - (char *) NULL); - result = TCL_ERROR; - goto done; - } - if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) { - result = TCL_ERROR; - goto done; - } - if (textPtr->state == TK_STATE_NORMAL) { - for (j = 3; j < argc; j += 2) { - InsertChars(textPtr, &index1, argv[j]); - if (argc > (j+1)) { - TkTextIndexForwBytes(&index1, (int) strlen(argv[j]), - &index2); - oldTagArrayPtr = TkBTreeGetTags(&index1, &numTags); - if (oldTagArrayPtr != NULL) { - for (i = 0; i < numTags; i++) { - TkBTreeTag(&index1, &index2, oldTagArrayPtr[i], 0); - } - ckfree((char *) oldTagArrayPtr); + 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; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index1 ?index2 ...?"); + result = TCL_ERROR; + goto done; + } + for (i = 2; i < objc; i += 2) { + CONST TkTextIndex *index1Ptr, *index2Ptr; + TkTextIndex index2; + + index1Ptr = TkTextGetIndexFromObj(interp, textPtr, objv[i]); + if (index1Ptr == NULL) { + if (objPtr) { + Tcl_DecrRefCount(objPtr); } - if (Tcl_SplitList(interp, argv[j+1], &numTags, &tagNames) - != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (i+1 == objc) { + TkTextIndexForwChars(index1Ptr, 1, &index2); + index2Ptr = &index2; + } else { + index2Ptr = TkTextGetIndexFromObj(interp, textPtr, + objv[i+1]); + if (index2Ptr == NULL) { + if (objPtr) { + Tcl_DecrRefCount(objPtr); + } result = TCL_ERROR; goto done; } - for (i = 0; i < numTags; i++) { - TkBTreeTag(&index1, &index2, - TkTextCreateTag(textPtr, tagNames[i]), 1); + } + 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(index1Ptr, index2Ptr); + 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); } - ckfree((char *) tagNames); - index1 = index2; } } + if (found > 1) { + Tcl_SetObjResult(interp, objPtr); + } + break; } - } else if ((c == 'd') && (strncmp(argv[1], "dump", length) == 0)) { - result = TextDumpCmd(textPtr, interp, argc, argv); - } else if ((c == 'i') && (strncmp(argv[1], "image", length) == 0)) { - result = TkTextImageCmd(textPtr, interp, argc, argv); - } else if ((c == 'm') && (strncmp(argv[1], "mark", length) == 0)) { - result = TkTextMarkCmd(textPtr, interp, argc, argv); - } else if ((c == 's') && (strcmp(argv[1], "scan") == 0) && (length >= 2)) { - result = TkTextScanCmd(textPtr, interp, argc, argv); - } else if ((c == 's') && (strcmp(argv[1], "search") == 0) - && (length >= 3)) { - result = TextSearchCmd(textPtr, interp, argc, argv); - } else if ((c == 's') && (strcmp(argv[1], "see") == 0) && (length >= 3)) { - result = TkTextSeeCmd(textPtr, interp, argc, argv); - } else if ((c == 't') && (strcmp(argv[1], "tag") == 0)) { - result = TkTextTagCmd(textPtr, interp, argc, argv); - } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) { - result = TkTextWindowCmd(textPtr, interp, argc, argv); - } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) { - result = TkTextXviewCmd(textPtr, interp, argc, argv); - } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0) - && (length >= 2)) { - result = TkTextYviewCmd(textPtr, interp, argc, argv); - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be bbox, cget, compare, configure, debug, delete, ", - "dlineinfo, dump, edit, get, image, index, insert, mark, ", - "scan, search, see, tag, window, xview, or yview", - (char *) NULL); - result = TCL_ERROR; - } + 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) { + TkTextIndex index1, index2; + int j; + + index1 = *indexPtr; + for (j = 3; 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(textPtr, &index1, objv[j]); + if (objc > (j+1)) { + Tcl_Obj **tagNamePtrs; + TkTextTag **oldTagArrayPtr; + int numTags; + + TkTextIndexForwBytes(&index1, length, &index2); + oldTagArrayPtr = TkBTreeGetTags(&index1, &numTags); + if (oldTagArrayPtr != NULL) { + int i; + for (i = 0; i < numTags; i++) { + TkBTreeTag(&index1, &index2, + oldTagArrayPtr[i], 0); + } + ckfree((char *) oldTagArrayPtr); + } + if (Tcl_ListObjGetElements(interp, objv[j+1], + &numTags, &tagNamePtrs) + != TCL_OK) { + result = TCL_ERROR; + goto done; + } else { + int i; + + for (i = 0; i < numTags; i++) { + TkBTreeTag(&index1, &index2, + TkTextCreateTag(textPtr, + Tcl_GetString(tagNamePtrs[i])), 1); + } + index1 = index2; + } + } + } + } + break; + } + case TEXT_MARK: { + result = TkTextMarkCmd(textPtr, interp, objc, objv); + break; + } + case TEXT_SCAN: { + result = TkTextScanCmd(textPtr, interp, objc, objv); + break; + } + case TEXT_SEARCH: { + result = TextSearchCmd(textPtr, interp, objc, objv); + break; + } + case TEXT_SEE: { + result = TkTextSeeCmd(textPtr, interp, objc, objv); + break; + } + case TEXT_TAG: { + result = TkTextTagCmd(textPtr, interp, objc, objv); + break; + } + case TEXT_WINDOW: { + result = TkTextWindowCmd(textPtr, interp, objc, objv); + break; + } + case TEXT_XVIEW: { + result = TkTextXviewCmd(textPtr, interp, objc, objv); + break; + } + case TEXT_YVIEW: { + result = TkTextYviewCmd(textPtr, interp, objc, objv); + break; + } + } + done: Tcl_Release((ClientData) textPtr); return result; @@ -952,11 +1037,12 @@ DestroyText(memPtr) TkTextTag *tagPtr; /* - * Free up all the stuff that requires special handling, then - * let Tk_FreeOptions handle all the standard option-related - * stuff. Special note: free up display-related information - * before deleting the B-tree, since display-related stuff - * may refer to stuff in the B-tree. + * 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); @@ -983,17 +1069,13 @@ DestroyText(memPtr) } TkUndoFreeStack(textPtr->undoStack); - /* - * NOTE: do NOT free up selBorder, selBdString, or selFgColorPtr: - * they are duplicates of information in the "sel" tag, which was - * freed up as part of deleting the tags above. - */ - - textPtr->selBorder = NULL; - textPtr->selBdString = NULL; - textPtr->selFgColorPtr = NULL; - Tk_FreeOptions(configSpecs, (char *) textPtr, textPtr->display, 0); - ckfree((char *) textPtr); + textPtr->tkwin = NULL; + textPtr->refCount--; + Tcl_DeleteCommandFromToken(textPtr->interp, + textPtr->widgetCmd); + if (textPtr->refCount == 0) { + ckfree((char *) textPtr); + } } /* @@ -1001,7 +1083,7 @@ DestroyText(memPtr) * * ConfigureText -- * - * This procedure is called to process an argv/argc list, plus + * This procedure is called to process an objv/objc list, plus * the Tk option database, in order to configure (or * reconfigure) a text widget. * @@ -1018,18 +1100,18 @@ DestroyText(memPtr) */ static int -ConfigureText(interp, textPtr, argc, argv, flags) +ConfigureText(interp, textPtr, objc, objv) Tcl_Interp *interp; /* Used for error reporting. */ register TkText *textPtr; /* Information about widget; may or may * not already have values for some fields. */ - int argc; /* Number of valid entries in argv. */ - CONST char **argv; /* Arguments. */ - int flags; /* Flags to pass to Tk_ConfigureWidget. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { + Tk_SavedOptions savedOptions; int oldExport = textPtr->exportSelection; - if (Tk_ConfigureWidget(interp, textPtr->tkwin, configSpecs, - argc, argv, (char *) textPtr, flags) != TCL_OK) { + if (Tk_SetOptions(interp, (char*)textPtr, textPtr->optionTable, + objc, objv, textPtr->tkwin, &savedOptions, NULL) != TCL_OK) { return TCL_ERROR; } @@ -1064,11 +1146,12 @@ ConfigureText(interp, textPtr, argc, argv, flags) ckfree((char *) textPtr->tabArrayPtr); textPtr->tabArrayPtr = NULL; } - if (textPtr->tabOptionString != NULL) { + if (textPtr->tabOptionPtr != NULL) { textPtr->tabArrayPtr = TkTextGetTabs(interp, textPtr->tkwin, - textPtr->tabOptionString); + textPtr->tabOptionPtr); if (textPtr->tabArrayPtr == NULL) { Tcl_AddErrorInfo(interp,"\n (while processing -tabs option)"); + Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } } @@ -1082,22 +1165,14 @@ ConfigureText(interp, textPtr, argc, argv, flags) */ textPtr->selTagPtr->border = textPtr->selBorder; - if (textPtr->selTagPtr->bdString != textPtr->selBdString) { - textPtr->selTagPtr->bdString = textPtr->selBdString; - if (textPtr->selBdString != NULL) { - if (Tk_GetPixels(interp, textPtr->tkwin, textPtr->selBdString, - &textPtr->selTagPtr->borderWidth) != TCL_OK) { - return TCL_ERROR; - } - if (textPtr->selTagPtr->borderWidth < 0) { - textPtr->selTagPtr->borderWidth = 0; - } - } + if (textPtr->selTagPtr->borderWidthPtr != textPtr->selBorderWidthPtr) { + textPtr->selTagPtr->borderWidthPtr = textPtr->selBorderWidthPtr; + textPtr->selTagPtr->borderWidth = textPtr->selBorderWidth; } textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr; textPtr->selTagPtr->affectsDisplay = 0; if ((textPtr->selTagPtr->border != NULL) - || (textPtr->selTagPtr->bdString != NULL) + || (textPtr->selTagPtr->borderWidth != 0) || (textPtr->selTagPtr->reliefString != NULL) || (textPtr->selTagPtr->bgStipple != None) || (textPtr->selTagPtr->fgColor != NULL) @@ -1112,7 +1187,7 @@ ConfigureText(interp, textPtr, argc, argv, flags) || (textPtr->selTagPtr->spacing1String != NULL) || (textPtr->selTagPtr->spacing2String != NULL) || (textPtr->selTagPtr->spacing3String != NULL) - || (textPtr->selTagPtr->tabString != NULL) + || (textPtr->selTagPtr->tabStringPtr != NULL) || (textPtr->selTagPtr->underlineString != NULL) || (textPtr->selTagPtr->elideString != NULL) || (textPtr->selTagPtr->wrapMode != TEXT_WRAPMODE_NULL)) { @@ -1163,6 +1238,7 @@ ConfigureText(interp, textPtr, argc, argv, flags) if (textPtr->height <= 0) { textPtr->height = 1; } + Tk_FreeSavedOptions(&savedOptions); TextWorldChanged((ClientData) textPtr); return TCL_OK; } @@ -1180,7 +1256,7 @@ ConfigureText(interp, textPtr, argc, argv, flags) * None. * * Side effects: - * Configures all tags in the Text with a empty argc/argv, for + * 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. * @@ -1259,12 +1335,30 @@ TextEventProc(clientData, eventPtr) } } else if (eventPtr->type == DestroyNotify) { if (textPtr->tkwin != NULL) { + /* + * 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->tkwin = NULL; - Tcl_DeleteCommandFromToken(textPtr->interp, - textPtr->widgetCmd); + Tk_FreeConfigOptions((char *) textPtr, textPtr->optionTable, + textPtr->tkwin); + /* + * We don't delete the associated Tcl command yet, because + * that will cause textPtr->tkWin to be nulled out, and that + * is needed inside DestroyText to clean up certain tags + * which might have been created (e.g. in the text widget + * styles demo). + */ } Tcl_EventuallyFree((ClientData) textPtr, DestroyText); } else if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) { @@ -1345,29 +1439,32 @@ TextCmdDeletedProc(clientData) * "insert" widget command. * * Results: - * None. + * The length of the inserted string. * * Side effects: - * The characters in "string" get added to the text just before + * The characters in "stringPtr" get added to the text just before * the character indicated by "indexPtr". * *---------------------------------------------------------------------- */ -static void -InsertChars(textPtr, indexPtr, string) +static int +InsertChars(textPtr, indexPtr, stringPtr) TkText *textPtr; /* Overall information about text widget. */ - TkTextIndex *indexPtr; /* Where to insert new characters. May be - * modified and/or invalidated. */ - CONST char *string; /* Null-terminated string containing new + 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 lineIndex, resetView, offset; - TkTextIndex newTop; - char indexBuffer[TK_POS_CHARS]; - + int lineIndex, resetView, offset, length; + + CONST char *string = Tcl_GetStringFromObj(stringPtr, &length); + /* * 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 = TkBTreeLineIndex(indexPtr->linePtr); @@ -1375,7 +1472,7 @@ InsertChars(textPtr, indexPtr, string) lineIndex--; TkTextMakeByteIndex(textPtr->tree, 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 @@ -1388,74 +1485,35 @@ InsertChars(textPtr, indexPtr, string) resetView = 1; offset = textPtr->topIndex.byteIndex; if (offset > indexPtr->byteIndex) { - offset += strlen(string); + offset += length; } } TkTextChanged(textPtr, indexPtr, indexPtr); + textPtr->stateEpoch ++; TkBTreeInsertChars(indexPtr, string); /* * Push the insertion on the undo stack */ - if ( textPtr->undo ) { - TkTextIndex toIndex; - - Tcl_DString actionCommand; - Tcl_DString revertCommand; - + if (textPtr->undo) { + TkTextIndex toIndex; + if (textPtr->autoSeparators && textPtr->lastEditMode != TK_TEXT_EDIT_INSERT) { TkUndoInsertUndoSeparator(textPtr->undoStack); } textPtr->lastEditMode = TK_TEXT_EDIT_INSERT; - - Tcl_DStringInit(&actionCommand); - Tcl_DStringInit(&revertCommand); - - Tcl_DStringAppend(&actionCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1); - Tcl_DStringAppend(&actionCommand," insert ",-1); - TkTextPrintIndex(indexPtr,indexBuffer); - Tcl_DStringAppend(&actionCommand,indexBuffer,-1); - Tcl_DStringAppend(&actionCommand," ",-1); - Tcl_DStringAppendElement(&actionCommand,string); - Tcl_DStringAppend(&actionCommand,";",-1); - Tcl_DStringAppend(&actionCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1); - Tcl_DStringAppend(&actionCommand," mark set insert ",-1); - TkTextIndexForwBytes(indexPtr, (int) strlen(string), - &toIndex); - TkTextPrintIndex(&toIndex, indexBuffer); - Tcl_DStringAppend(&actionCommand,indexBuffer,-1); - Tcl_DStringAppend(&actionCommand,"; ",-1); - Tcl_DStringAppend(&actionCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1); - Tcl_DStringAppend(&actionCommand," see insert",-1); - - Tcl_DStringAppend(&revertCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1); - Tcl_DStringAppend(&revertCommand," delete ",-1); - TkTextPrintIndex(indexPtr,indexBuffer); - Tcl_DStringAppend(&revertCommand,indexBuffer,-1); - Tcl_DStringAppend(&revertCommand," ",-1); - TkTextPrintIndex(&toIndex, indexBuffer); - Tcl_DStringAppend(&revertCommand,indexBuffer,-1); - Tcl_DStringAppend(&revertCommand," ;",-1); - Tcl_DStringAppend(&revertCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1); - Tcl_DStringAppend(&revertCommand," mark set insert ",-1); - TkTextPrintIndex(indexPtr,indexBuffer); - Tcl_DStringAppend(&revertCommand,indexBuffer,-1); - Tcl_DStringAppend(&revertCommand,"; ",-1); - Tcl_DStringAppend(&revertCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1); - Tcl_DStringAppend(&revertCommand," see insert",-1); - - TkUndoPushAction(textPtr->undoStack,&actionCommand, &revertCommand); - - Tcl_DStringFree(&actionCommand); - Tcl_DStringFree(&revertCommand); + TkTextIndexForwBytes(indexPtr, length, &toIndex); + TextPushUndoAction(textPtr, stringPtr, 1, indexPtr, &toIndex); } - updateDirtyFlag(textPtr); + + UpdateDirtyFlag(textPtr); if (resetView) { + TkTextIndex newTop; TkTextMakeByteIndex(textPtr->tree, lineIndex, 0, &newTop); TkTextIndexForwBytes(&newTop, offset, &newTop); TkTextSetYView(textPtr, &newTop, 0); @@ -1466,6 +1524,113 @@ InsertChars(textPtr, indexPtr, string) */ textPtr->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 (textPtr, undoString, insert, index1Ptr, index2Ptr) + 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 */ +{ + /* Create the helpers */ + Tcl_Obj *cmdNameObj = Tcl_NewObj(); + Tcl_Obj *seeInsertObj = Tcl_NewObj(); + Tcl_Obj *markSet1InsertObj = Tcl_NewObj(); + Tcl_Obj *markSet2InsertObj = Tcl_NewObj(); + Tcl_Obj *insertCmdObj = Tcl_NewObj(); + Tcl_Obj *deleteCmdObj = Tcl_NewObj(); + + Tcl_Obj *insertCmd = Tcl_NewObj(); + Tcl_Obj *deleteCmd = Tcl_NewObj(); + + /* Get the index positions */ + Tcl_Obj *index1Obj = TkTextNewIndexObj(textPtr, index1Ptr); + Tcl_Obj *index2Obj = TkTextNewIndexObj(textPtr, index2Ptr); + + /* Get the fully qualified name */ + Tcl_GetCommandFullName(textPtr->interp, textPtr->widgetCmd, cmdNameObj); + + /* These need refCounts, because they are used more than once below */ + Tcl_IncrRefCount(cmdNameObj); + Tcl_IncrRefCount(seeInsertObj); + Tcl_IncrRefCount(index1Obj); + Tcl_IncrRefCount(index2Obj); + + Tcl_ListObjAppendElement(NULL, seeInsertObj, cmdNameObj); + Tcl_ListObjAppendElement(NULL, seeInsertObj, Tcl_NewStringObj("see",3)); + Tcl_ListObjAppendElement(NULL, seeInsertObj, Tcl_NewStringObj("insert",6)); + + Tcl_ListObjAppendElement(NULL, markSet1InsertObj, cmdNameObj); + 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, cmdNameObj); + Tcl_ListObjAppendElement(NULL, insertCmdObj, Tcl_NewStringObj("insert",6)); + Tcl_ListObjAppendElement(NULL, insertCmdObj, index1Obj); + /* Only use of 'undoString' */ + Tcl_ListObjAppendElement(NULL, insertCmdObj, undoString); + + Tcl_ListObjAppendElement(NULL, deleteCmdObj, cmdNameObj); + Tcl_ListObjAppendElement(NULL, deleteCmdObj, Tcl_NewStringObj("delete",6)); + Tcl_ListObjAppendElement(NULL, deleteCmdObj, index1Obj); + Tcl_ListObjAppendElement(NULL, deleteCmdObj, index2Obj); + + Tcl_ListObjAppendElement(NULL, insertCmd, insertCmdObj); + Tcl_ListObjAppendElement(NULL, insertCmd, markSet2InsertObj); + Tcl_ListObjAppendElement(NULL, insertCmd, seeInsertObj); + Tcl_ListObjAppendElement(NULL, deleteCmd, deleteCmdObj); + Tcl_ListObjAppendElement(NULL, deleteCmd, markSet1InsertObj); + Tcl_ListObjAppendElement(NULL, deleteCmd, seeInsertObj); + + Tcl_DecrRefCount(cmdNameObj); + Tcl_DecrRefCount(seeInsertObj); + Tcl_DecrRefCount(index1Obj); + Tcl_DecrRefCount(index2Obj); + + /* + * Depending whether the action is to insert or delete, we provide + * the appropriate second and third arguments to TkUndoPushAction. + * (The first is the 'actionCommand', and the second the + * 'revertCommand'). The final '1' says we are providing a list + * of scripts to execute rather than a single script. + */ + if (insert) { + TkUndoPushAction(textPtr->undoStack, insertCmd, deleteCmd, 1); + } else { + TkUndoPushAction(textPtr->undoStack, deleteCmd, insertCmd, 1); + } + } /* @@ -1487,39 +1652,41 @@ InsertChars(textPtr, indexPtr, string) */ static int -DeleteChars(textPtr, index1String, index2String, indexPtr1, indexPtr2) - TkText *textPtr; /* Overall information about text widget. */ - CONST char *index1String; /* String describing location of first - * character to delete. */ - CONST char *index2String; /* String describing location of last - * character to delete. NULL means just - * delete the one character given by - * index1String. */ - TkTextIndex *indexPtr1; /* index describing location of first - * character to delete. */ - TkTextIndex *indexPtr2; /* index describing location of last - * character to delete. NULL means just - * delete the one character given by - * indexPtr1. */ +DeleteChars(textPtr, index1Obj, index2Obj, indexPtr1, indexPtr2) + TkText *textPtr; /* Overall information about text widget. */ + Tcl_Obj *index1Obj; /* Object describing location of first + * character to delete. */ + Tcl_Obj *index2Obj; /* Object describing location of last + * character to delete. NULL means just + * delete the one character given by + * index1Obj. */ + 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. */ { int line1, line2, line, byteIndex, resetView; TkTextIndex index1, index2; - char indexBuffer[TK_POS_CHARS]; /* * Parse the starting and stopping indices. */ - if (index1String != NULL) { - if (TkTextGetIndex(textPtr->interp, textPtr, index1String, &index1) - != TCL_OK) { + if (index1Obj != NULL) { + indexPtr1 = TkTextGetIndexFromObj(textPtr->interp, textPtr, index1Obj); + if (indexPtr1 == NULL) { return TCL_ERROR; } - if (index2String != NULL) { - if (TkTextGetIndex(textPtr->interp, textPtr, index2String, &index2) - != TCL_OK) { + index1 = *indexPtr1; + if (index2Obj != NULL) { + indexPtr2 = TkTextGetIndexFromObj(textPtr->interp, textPtr, + index2Obj); + if (indexPtr2 == NULL) { return TCL_ERROR; } + index2 = *indexPtr2; } else { index2 = index1; TkTextIndexForwChars(&index2, 1, &index2); @@ -1632,10 +1799,8 @@ DeleteChars(textPtr, index1String, index2String, indexPtr1, indexPtr2) */ if (textPtr->undo) { - Tcl_DString ds; - Tcl_DString actionCommand; - Tcl_DString revertCommand; - + Tcl_Obj *get; + if (textPtr->autoSeparators && (textPtr->lastEditMode != TK_TEXT_EDIT_DELETE)) { TkUndoInsertUndoSeparator(textPtr->undoStack); @@ -1643,51 +1808,12 @@ DeleteChars(textPtr, index1String, index2String, indexPtr1, indexPtr2) textPtr->lastEditMode = TK_TEXT_EDIT_DELETE; - Tcl_DStringInit(&actionCommand); - Tcl_DStringInit(&revertCommand); - - Tcl_DStringAppend(&actionCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1); - Tcl_DStringAppend(&actionCommand," delete ",-1); - TkTextPrintIndex(&index1,indexBuffer); - Tcl_DStringAppend(&actionCommand,indexBuffer,-1); - Tcl_DStringAppend(&actionCommand," ",-1); - TkTextPrintIndex(&index2, indexBuffer); - Tcl_DStringAppend(&actionCommand,indexBuffer,-1); - Tcl_DStringAppend(&actionCommand,"; ",-1); - Tcl_DStringAppend(&actionCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1); - Tcl_DStringAppend(&actionCommand," mark set insert ",-1); - TkTextPrintIndex(&index1,indexBuffer); - Tcl_DStringAppend(&actionCommand,indexBuffer,-1); - - Tcl_DStringAppend(&actionCommand,"; ",-1); - Tcl_DStringAppend(&actionCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1); - Tcl_DStringAppend(&actionCommand," see insert",-1); - - TextGetText(&index1, &index2, &ds); - - Tcl_DStringAppend(&revertCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1); - Tcl_DStringAppend(&revertCommand," insert ",-1); - TkTextPrintIndex(&index1,indexBuffer); - Tcl_DStringAppend(&revertCommand,indexBuffer,-1); - Tcl_DStringAppend(&revertCommand," ",-1); - Tcl_DStringAppendElement(&revertCommand,Tcl_DStringValue(&ds)); - Tcl_DStringAppend(&revertCommand,"; ",-1); - Tcl_DStringAppend(&revertCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1); - Tcl_DStringAppend(&revertCommand," mark set insert ",-1); - TkTextPrintIndex(&index2, indexBuffer); - Tcl_DStringAppend(&revertCommand,indexBuffer,-1); - Tcl_DStringAppend(&revertCommand,"; ",-1); - Tcl_DStringAppend(&revertCommand,Tcl_GetCommandName(textPtr->interp,textPtr->widgetCmd),-1); - Tcl_DStringAppend(&revertCommand," see insert",-1); - - TkUndoPushAction(textPtr->undoStack,&actionCommand, &revertCommand); - - Tcl_DStringFree(&actionCommand); - Tcl_DStringFree(&revertCommand); - - } - updateDirtyFlag(textPtr); + get = TextGetText(&index1, &index2); + TextPushUndoAction(textPtr, get, 0, &index1, &index2); + } + UpdateDirtyFlag(textPtr); + textPtr->stateEpoch ++; TkBTreeDeleteChars(&index1, &index2); if (resetView) { TkTextMakeByteIndex(textPtr->tree, line, byteIndex, &index1); @@ -1796,7 +1922,7 @@ TextFetchSelection(clientData, offset, buffer, maxBytes) while (1) { if (maxBytes == 0) { - goto done; + goto fetchDone; } segPtr = TkTextIndexToSeg(&textPtr->selIndex, &offsetInSeg); chunkSize = segPtr->size - offsetInSeg; @@ -1837,7 +1963,7 @@ TextFetchSelection(clientData, offset, buffer, maxBytes) textPtr->selIndex = search.curIndex; } - done: + fetchDone: *buffer = 0; return count; } @@ -1930,7 +2056,7 @@ TextBlinkProc(clientData) TkTextIndex index; int x, y, w, h; - if ((textPtr->state == TK_STATE_DISABLED) || + if ((textPtr->state == TK_TEXT_STATE_DISABLED) || !(textPtr->flags & GOT_FOCUS) || (textPtr->insertOffTime == 0)) { return; } @@ -1969,391 +2095,146 @@ TextBlinkProc(clientData) */ static int -TextSearchCmd(textPtr, interp, argc, argv) +TextSearchCmd(textPtr, interp, objc, objv) TkText *textPtr; /* Information about text widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - int backwards, exact, searchElide, c, i, argsLeft, noCase, leftToScan; - size_t length; - int numLines, startingLine, startingByte, lineNum, firstByte, lastByte; - int code, matchLength, matchByte, passes, stopLine, searchWholeText; - int patLength; - CONST char *arg, *pattern, *varName, *p, *startOfLine; - char buffer[20]; - TkTextIndex index, stopIndex; - Tcl_DString line, patDString; - TkTextSegment *segPtr; - TkTextLine *linePtr; - TkTextIndex curIndex; - Tcl_Obj *patObj = NULL; - Tcl_RegExp regexp = NULL; /* Initialization needed only to - * prevent compiler warning. */ - + int i, argsLeft, code; + SearchSpec searchSpec; + + /* + * 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.numLines = TkBTreeNumLines(textPtr->tree); + searchSpec.clientData = (ClientData)textPtr; + searchSpec.addLineProc = &TextSearchAddNextLine; + searchSpec.foundMatchProc = &TextSearchFoundMatch; + searchSpec.lineIndexProc = &TextSearchGetLineIndex; + /* * Parse switches and other arguments. */ - exact = 1; - searchElide = 0; - curIndex.tree = textPtr->tree; - backwards = 0; - noCase = 0; - varName = NULL; - for (i = 2; i < argc; i++) { - arg = argv[i]; + for (i = 2; i < objc; i++) { + int length; + char c; + + CONST char *arg = Tcl_GetStringFromObj(objv[i],&length); + if (arg[0] != '-') { break; } - length = strlen(arg); if (length < 2) { badSwitch: Tcl_AppendResult(interp, "bad switch \"", arg, - "\": must be --, -backward, -count, -elide, -exact, ", - "-forward, -nocase, or -regexp", (char *) NULL); + "\": must be --, -all, -backward, -count, ", + "-elide, -exact, -forward, -nocase, ", + "-nolinestop, or -regexp", (char *) NULL); return TCL_ERROR; } c = arg[1]; - if ((c == 'b') && (strncmp(argv[i], "-backwards", length) == 0)) { - backwards = 1; - } else if ((c == 'c') && (strncmp(argv[i], "-count", length) == 0)) { - if (i >= (argc-1)) { + if ((c == 'a') && (strncmp(arg, "-all", length) == 0)) { + searchSpec.all = 1; + } else if ((c == 'b') && (strncmp(arg, "-backwards", length) == 0)) { + searchSpec.backwards = 1; + } else if ((c == 'c') && (strncmp(arg, "-count", length) == 0)) { + if (i >= (objc-1)) { Tcl_SetResult(interp, "no value given for \"-count\" option", TCL_STATIC); return TCL_ERROR; } i++; - varName = argv[i]; + /* + * Assumption objv[i] isn't going to disappear on us during + * this procedure, which is fair. + */ + searchSpec.varPtr = objv[i]; } else if ((c == 'e') && (length > 2) - && (strncmp(argv[i], "-exact", length) == 0)) { - exact = 1; + && (strncmp(arg, "-exact", length) == 0)) { + searchSpec.exact = 1; } else if ((c == 'e') && (length > 2) - && (strncmp(argv[i], "-elide", length) == 0)) { - searchElide = 1; - } else if ((c == 'h') && (strncmp(argv[i], "-hidden", length) == 0)) { + && (strncmp(arg, "-elide", length) == 0)) { + searchSpec.searchElide = 1; + } else if ((c == 'h') && (strncmp(arg, "-hidden", length) == 0)) { /* * -hidden is kept around for backwards compatibility with * the dash patch, but -elide is the official option */ - searchElide = 1; - } else if ((c == 'f') && (strncmp(argv[i], "-forwards", length) == 0)) { - backwards = 0; - } else if ((c == 'n') && (strncmp(argv[i], "-nocase", length) == 0)) { - noCase = 1; - } else if ((c == 'r') && (strncmp(argv[i], "-regexp", length) == 0)) { - exact = 0; - } else if ((c == '-') && (strncmp(argv[i], "--", length) == 0)) { + searchSpec.searchElide = 1; + } else if ((c == 'f') && (strncmp(arg, "-forwards", length) == 0)) { + searchSpec.backwards = 0; + } else if ((c == 'n') && (length > 3) + && (strncmp(arg, "-nocase", length) == 0)) { + searchSpec.noCase = 1; + } else if ((c == 'n') && (length > 3) + && (strncmp(arg, "-nolinestop", length) == 0)) { + searchSpec.noLineStop = 1; + } else if ((c == 'r') && (strncmp(arg, "-regexp", length) == 0)) { + searchSpec.exact = 0; + } else if ((c == '-') && (strncmp(arg, "--", length) == 0)) { i++; break; } else { goto badSwitch; } } - argsLeft = argc - (i+2); + argsLeft = objc - (i+2); if ((argsLeft != 0) && (argsLeft != 1)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " search ?switches? pattern index ?stopIndex?\"", - (char *) NULL); + Tcl_WrongNumArgs(interp, 2, objv, + "?switches? pattern index ?stopIndex?"); return TCL_ERROR; } - pattern = argv[i]; - - /* - * Convert the pattern to lower-case if we're supposed to ignore case. - */ - - if (noCase && exact) { - Tcl_DStringInit(&patDString); - Tcl_DStringAppend(&patDString, pattern, -1); - Tcl_UtfToLower(Tcl_DStringValue(&patDString)); - pattern = Tcl_DStringValue(&patDString); - } - - Tcl_DStringInit(&line); - if (TkTextGetIndex(interp, textPtr, argv[i+1], &index) != TCL_OK) { - code = TCL_ERROR; - goto done; - } - numLines = TkBTreeNumLines(textPtr->tree); - startingLine = TkBTreeLineIndex(index.linePtr); - startingByte = index.byteIndex; - if (startingLine >= numLines) { - if (backwards) { - startingLine = TkBTreeNumLines(textPtr->tree) - 1; - startingByte = TkBTreeBytesInLine(TkBTreeFindLine(textPtr->tree, - startingLine)); - } else { - startingLine = 0; - startingByte = 0; - } - } - if (argsLeft == 1) { - if (TkTextGetIndex(interp, textPtr, argv[i+2], &stopIndex) != TCL_OK) { - code = TCL_ERROR; - goto done; - } - stopLine = TkBTreeLineIndex(stopIndex.linePtr); - if (!backwards && (stopLine == numLines)) { - stopLine = numLines-1; - } - searchWholeText = 0; - } else { - stopLine = 0; - searchWholeText = 1; + + if (searchSpec.noLineStop && searchSpec.exact) { + Tcl_SetResult(interp, "the \"-nolinestop\" option requires the \"-regexp\" option to be present", TCL_STATIC); + return TCL_ERROR; } - + /* * Scan through all of the lines of the text circularly, starting - * at the given index. + * 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. */ - matchLength = patLength = 0; /* Only needed to prevent compiler - * warnings. */ - if (exact) { - patLength = strlen(pattern); - } else { - patObj = Tcl_NewStringObj(pattern, -1); - Tcl_IncrRefCount(patObj); - regexp = Tcl_GetRegExpFromObj(interp, patObj, - (noCase ? TCL_REG_NOCASE : 0) | TCL_REG_ADVANCED); - if (regexp == NULL) { + 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 done; + goto cleanup; } } - lineNum = startingLine; - code = TCL_OK; - for (passes = 0; passes < 2; ) { - if (lineNum >= numLines) { - /* - * Don't search the dummy last line of the text. - */ - - goto nextLine; - } - - /* - * Extract the text from the line. If we're doing regular - * expression matching, drop the newline from the line, so - * that "$" can be used to match the end of the line. - */ - - linePtr = TkBTreeFindLine(textPtr->tree, lineNum); - curIndex.linePtr = linePtr; curIndex.byteIndex = 0; - for (segPtr = linePtr->segPtr; segPtr != NULL; - curIndex.byteIndex += segPtr->size, segPtr = segPtr->nextPtr) { - if ((segPtr->typePtr != &tkTextCharType) - || (!searchElide && TkTextIsElided(textPtr, &curIndex))) { - continue; - } - Tcl_DStringAppend(&line, segPtr->body.chars, segPtr->size); - } - if (!exact) { - Tcl_DStringSetLength(&line, Tcl_DStringLength(&line)-1); - } - startOfLine = Tcl_DStringValue(&line); - - /* - * If we're ignoring case, convert the line to lower case. - */ - - if (noCase) { - Tcl_DStringSetLength(&line, - Tcl_UtfToLower(Tcl_DStringValue(&line))); - } - - /* - * Check for matches within the current line. If so, and if we're - * searching backwards, repeat the search to find the last match - * in the line. (Note: The lastByte should include the NULL char - * so we can handle searching for end of line easier.) - */ - - matchByte = -1; - firstByte = 0; - lastByte = Tcl_DStringLength(&line) + 1; - if (lineNum == startingLine) { - int indexInDString; - - /* - * 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. We have to be very - * careful here because there could be embedded windows or - * other things that are not in the extracted line. Rescan - * the original line to compute the index in it of the first - * character. - */ - - indexInDString = startingByte; - for (segPtr = linePtr->segPtr, leftToScan = startingByte; - leftToScan > 0; segPtr = segPtr->nextPtr) { - if (segPtr->typePtr != &tkTextCharType) { - indexInDString -= segPtr->size; - } - leftToScan -= segPtr->size; - } - - passes++; - if ((passes == 1) ^ backwards) { - /* - * Only use the last part of the line. - */ - - firstByte = indexInDString; - if ((firstByte >= Tcl_DStringLength(&line)) - && !((Tcl_DStringLength(&line) == 0) && !exact)) { - goto nextLine; - } - } else { - /* - * Use only the first part of the line. - */ - - lastByte = indexInDString; - } - } - do { - int thisLength; - Tcl_UniChar ch; - - if (exact) { - p = strstr(startOfLine + firstByte, /* INTL: Native. */ - pattern); - if (p == NULL) { - break; - } - i = p - startOfLine; - thisLength = patLength; - } else { - CONST char *start, *end; - int match; - - match = Tcl_RegExpExec(interp, regexp, - startOfLine + firstByte, startOfLine); - if (match < 0) { - code = TCL_ERROR; - goto done; - } - if (!match) { - break; - } - Tcl_RegExpRange(regexp, 0, &start, &end); - i = start - startOfLine; - thisLength = end - start; - } - if (i >= lastByte) { - break; - } - matchByte = i; - matchLength = thisLength; - firstByte = i + Tcl_UtfToUniChar(startOfLine + matchByte, &ch); - } while (backwards); - - /* - * If we found a match then we're done. Make sure that - * the match occurred before the stopping index, if one was - * specified. - */ - - if (matchByte >= 0) { - int numChars; - - /* - * Convert the byte length to a character count. - */ - - numChars = Tcl_NumUtfChars(startOfLine + matchByte, - matchLength); - - /* - * 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. - */ - - curIndex.linePtr = linePtr; curIndex.byteIndex = 0; - for (segPtr = linePtr->segPtr, leftToScan = matchByte; - leftToScan >= 0 && segPtr; segPtr = segPtr->nextPtr) { - if (segPtr->typePtr != &tkTextCharType || \ - (!searchElide && TkTextIsElided(textPtr, &curIndex))) { - matchByte += segPtr->size; - } else { - leftToScan -= segPtr->size; - } - curIndex.byteIndex += segPtr->size; - } - for (leftToScan += matchLength; leftToScan > 0; - segPtr = segPtr->nextPtr) { - if (segPtr->typePtr != &tkTextCharType) { - numChars += segPtr->size; - continue; - } - leftToScan -= segPtr->size; - } - TkTextMakeByteIndex(textPtr->tree, lineNum, matchByte, &index); - if (!searchWholeText) { - if (!backwards && (TkTextIndexCmp(&index, &stopIndex) >= 0)) { - goto done; - } - if (backwards && (TkTextIndexCmp(&index, &stopIndex) < 0)) { - goto done; - } - } - if (varName != NULL) { - sprintf(buffer, "%d", numChars); - if (Tcl_SetVar(interp, varName, buffer, TCL_LEAVE_ERR_MSG) - == NULL) { - code = TCL_ERROR; - goto done; - } - } - TkTextPrintIndex(&index, buffer); - Tcl_SetResult(interp, buffer, TCL_VOLATILE); - goto done; - } - - /* - * Go to the next (or previous) line; - */ - - nextLine: - if (backwards) { - lineNum--; - if (!searchWholeText) { - if (lineNum < stopLine) { - break; - } - } else if (lineNum < 0) { - lineNum = numLines-1; - } - } else { - lineNum++; - if (!searchWholeText) { - if (lineNum > stopLine) { - break; - } - } else if (lineNum >= numLines) { - lineNum = 0; - } - } - Tcl_DStringSetLength(&line, 0); + + /* Set the result */ + if (searchSpec.resPtr != NULL) { + Tcl_SetObjResult(interp, searchSpec.resPtr); + searchSpec.resPtr = NULL; } - done: - Tcl_DStringFree(&line); - if (noCase && exact) { - Tcl_DStringFree(&patDString); + + cleanup: + if (searchSpec.countPtr != NULL) { + Tcl_DecrRefCount(searchSpec.countPtr); } - if (patObj != NULL) { - Tcl_DecrRefCount(patObj); + if (searchSpec.resPtr != NULL) { + Tcl_DecrRefCount(searchSpec.resPtr); } return code; } @@ -2361,140 +2242,499 @@ TextSearchCmd(textPtr, interp, argc, argv) /* *---------------------------------------------------------------------- * - * TkTextGetTabs -- + * TextSearchGetLineIndex -- * - * Parses a string description of a set of tab stops. + * 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: - * 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. + * 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: - * 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. + * None. * *---------------------------------------------------------------------- */ - -TkTextTabArray * -TkTextGetTabs(interp, tkwin, string) - Tcl_Interp *interp; /* Used for error reporting. */ - Tk_Window tkwin; /* Window in which the tabs will be - * used. */ - char *string; /* Description of the tab stops. See - * the text manual entry for details. */ +static int +TextSearchGetLineIndex(interp, objPtr, searchSpecPtr, linePosPtr, offsetPosPtr) + 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 */ { - int argc, i, count, c; - CONST char **argv; - TkTextTabArray *tabArrayPtr; - TkTextTab *tabPtr; - Tcl_UniChar ch; - - if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) { - return NULL; - } - - /* - * First find out how many entries we need to allocate in the - * tab array. - */ - - count = 0; - for (i = 0; i < argc; i++) { - c = argv[i][0]; - if ((c != 'l') && (c != 'r') && (c != 'c') && (c != 'n')) { - count++; - } + CONST TkTextIndex *indexPtr; + int line; + TkText *textPtr = (TkText*)(searchSpecPtr->clientData); + + indexPtr = TkTextGetIndexFromObj(interp, textPtr, objPtr); + if (indexPtr == NULL) { + return TCL_ERROR; } - - /* - * Parse the elements of the list one at a time to fill in the - * array. - */ - - tabArrayPtr = (TkTextTabArray *) ckalloc((unsigned) - (sizeof(TkTextTabArray) + (count-1)*sizeof(TkTextTab))); - tabArrayPtr->numTabs = 0; - for (i = 0, tabPtr = &tabArrayPtr->tabs[0]; i < argc; i++, tabPtr++) { - if (Tk_GetPixels(interp, tkwin, argv[i], &tabPtr->location) - != TCL_OK) { - goto error; - } - tabArrayPtr->numTabs++; - - /* - * See if there is an explicit alignment in the next list - * element. Otherwise just use "left". - */ - - tabPtr->alignment = LEFT; - if ((i+1) == argc) { - continue; - } - Tcl_UtfToUniChar(argv[i+1], &ch); - if (!Tcl_UniCharIsAlpha(ch)) { - continue; - } - i += 1; - c = argv[i][0]; - if ((c == 'l') && (strncmp(argv[i], "left", - strlen(argv[i])) == 0)) { - tabPtr->alignment = LEFT; - } else if ((c == 'r') && (strncmp(argv[i], "right", - strlen(argv[i])) == 0)) { - tabPtr->alignment = RIGHT; - } else if ((c == 'c') && (strncmp(argv[i], "center", - strlen(argv[i])) == 0)) { - tabPtr->alignment = CENTER; - } else if ((c == 'n') && (strncmp(argv[i], - "numeric", strlen(argv[i])) == 0)) { - tabPtr->alignment = NUMERIC; - } else { - Tcl_AppendResult(interp, "bad tab alignment \"", - argv[i], "\": must be left, right, center, or numeric", - (char *) NULL); - goto error; - } + + line = TkBTreeLineIndex(indexPtr->linePtr); + if (line >= searchSpecPtr->numLines) { + TkTextLine *linePtr; + line = searchSpecPtr->numLines-1; + linePtr = TkBTreeFindLine(textPtr->tree, line); + *offsetPosPtr = TextSearchIndexInLine(searchSpecPtr, linePtr, + TkBTreeBytesInLine(linePtr)); + } else { + *offsetPosPtr = TextSearchIndexInLine(searchSpecPtr, + indexPtr->linePtr, indexPtr->byteIndex); } - ckfree((char *) argv); - return tabArrayPtr; + + *linePosPtr = line; - error: - ckfree((char *) tabArrayPtr); - ckfree((char *) argv); - return NULL; + return TCL_OK; } /* *---------------------------------------------------------------------- * - * TextDumpCmd -- + * TextSearchIndexInLine -- * - * 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. + * 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: - * A standard Tcl result. + * The returned index is a utf-8 char* byte index for exact + * searches, and a Unicode character index for regexp searches. * * Side effects: - * Memory is allocated for the result, if needed (standard Tcl result + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TextSearchIndexInLine(searchSpecPtr, linePtr, byteIndex) + 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 = (TkText*)(searchSpecPtr->clientData); + + index = 0; + curIndex.tree = textPtr->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))) { + 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. + * + * Side effects: + * Memory may be allocated or re-allocated for theLine's string + * representation. + * + *---------------------------------------------------------------------- + */ + +static ClientData +TextSearchAddNextLine(lineNum, searchSpecPtr, theLine, lenPtr) + int lineNum; /* Line we must add */ + SearchSpec *searchSpecPtr; /* Search parameters */ + Tcl_Obj *theLine; /* Object to append to */ + int *lenPtr; /* For returning the total length */ +{ + TkTextLine *linePtr; + TkTextIndex curIndex; + TkTextSegment *segPtr; + TkText *textPtr = (TkText*)(searchSpecPtr->clientData); + /* + * Extract the text from the line. + */ + + linePtr = TkBTreeFindLine(textPtr->tree, lineNum); + if (linePtr == NULL) { + return NULL; + } + curIndex.tree = textPtr->tree; + curIndex.linePtr = linePtr; curIndex.byteIndex = 0; + for (segPtr = linePtr->segPtr; segPtr != NULL; + curIndex.byteIndex += segPtr->size, segPtr = segPtr->nextPtr) { + if ((segPtr->typePtr != &tkTextCharType) + || (!searchSpecPtr->searchElide + && TkTextIsElided(textPtr, &curIndex))) { + continue; + } + Tcl_AppendToObj(theLine, segPtr->body.chars, segPtr->size); + } + + /* + * 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) { + Tcl_GetStringFromObj(theLine, lenPtr); + } else { + *lenPtr = Tcl_GetCharLength(theLine); + } + } + return (ClientData)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(lineNum, searchSpecPtr, clientData, theLine, + matchOffset, matchLength) + int lineNum; /* Line on which match was found */ + SearchSpec *searchSpecPtr; /* Search parameters */ + ClientData clientData; /* Token returned by the 'addNextLineProc', + * TextSearchAddNextLine */ + Tcl_Obj *theLine; /* Text from current line */ + 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 = (TkText*)(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; + } + + /* + * 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 = (TkTextLine *)clientData; + curIndex.tree = textPtr->tree; + curIndex.linePtr = linePtr; curIndex.byteIndex = 0; + /* Find the starting point */ + for (segPtr = linePtr->segPtr, leftToScan = matchOffset; + leftToScan >= 0 && segPtr; segPtr = segPtr->nextPtr) { + if (segPtr->typePtr != &tkTextCharType) { + matchOffset += segPtr->size; + } else if (!searchSpecPtr->searchElide + && TkTextIsElided(textPtr, &curIndex)) { + if (searchSpecPtr->exact) { + matchOffset += segPtr->size; + } else { + matchOffset += Tcl_NumUtfChars(segPtr->body.chars, -1); + } + } else { + leftToScan -= segPtr->size; + } + curIndex.byteIndex += segPtr->size; + } + /* Calculate and store the found index in the result */ + if (searchSpecPtr->exact) { + TkTextMakeByteIndex(textPtr->tree, lineNum, + matchOffset, &foundIndex); + } else { + TkTextMakeCharIndex(textPtr->tree, 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(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)) { + 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(interp, tkwin, stringPtr) + Tcl_Interp *interp; /* Used for error reporting. */ + Tk_Window tkwin; /* Window in which the tabs will be + * used. */ + 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; + + /* Map these strings to TkTextTabAlign values */ + + static CONST char *tabOptionStrings[] = { + "left", "right", "center", "numeric", (char *) 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 = (TkTextTabArray *) ckalloc((unsigned) + (sizeof(TkTextTabArray) + (count-1)*sizeof(TkTextTab))); + tabArrayPtr->numTabs = 0; + for (i = 0, tabPtr = &tabArrayPtr->tabs[0]; i < objc; i++, tabPtr++) { + int index; + + if (Tk_GetPixelsFromObj(interp, tkwin, objv[i], &tabPtr->location) + != TCL_OK) { + goto error; + } + 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_GetIndexFromObj(interp, objv[i], tabOptionStrings, + "tab alignment", 0, &index) != TCL_OK) { + goto error; + } + tabPtr->alignment = ((TkTextTabAlign)index); + } + return tabArrayPtr; + + error: + ckfree((char *) 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(textPtr, interp, argc, argv) +TextDumpCmd(textPtr, interp, objc, objv) register TkText *textPtr; /* Information about text widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. Someone else has already + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. Someone else has already * parsed this command enough to know that - * argv[1] is "dump". */ + * objv[1] is "dump". */ { TkTextIndex index1, index2; int arg; @@ -2511,56 +2751,60 @@ TextDumpCmd(textPtr, interp, argc, argv) #define TK_DUMP_ALL (TK_DUMP_TEXT|TK_DUMP_MARK|TK_DUMP_TAG| \ TK_DUMP_WIN|TK_DUMP_IMG) - for (arg=2 ; argv[arg] != (char *) NULL ; arg++) { - size_t len; - if (argv[arg][0] != '-') { + for (arg=2 ; arg < objc ; arg++) { + int len; + char *str = Tcl_GetStringFromObj(objv[arg],&len); + if (str[0] != '-') { break; } - len = strlen(argv[arg]); - if (strncmp("-all", argv[arg], len) == 0) { + if (strncmp("-all", str, len) == 0) { what = TK_DUMP_ALL; - } else if (strncmp("-text", argv[arg], len) == 0) { + } else if (strncmp("-text", str, len) == 0) { what |= TK_DUMP_TEXT; - } else if (strncmp("-tag", argv[arg], len) == 0) { + } else if (strncmp("-tag", str, len) == 0) { what |= TK_DUMP_TAG; - } else if (strncmp("-mark", argv[arg], len) == 0) { + } else if (strncmp("-mark", str, len) == 0) { what |= TK_DUMP_MARK; - } else if (strncmp("-image", argv[arg], len) == 0) { + } else if (strncmp("-image", str, len) == 0) { what |= TK_DUMP_IMG; - } else if (strncmp("-window", argv[arg], len) == 0) { + } else if (strncmp("-window", str, len) == 0) { what |= TK_DUMP_WIN; - } else if (strncmp("-command", argv[arg], len) == 0) { + } else if (strncmp("-command", str, len) == 0) { arg++; - if (arg >= argc) { - Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL); + if (arg >= objc) { + Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), + " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL); return TCL_ERROR; } - command = argv[arg]; + command = Tcl_GetString(objv[arg]); } else { - Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL); + Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), + " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL); return TCL_ERROR; } } - if (arg >= argc) { - Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL); + if (arg >= objc) { + Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), + " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL); return TCL_ERROR; } if (what == 0) { what = TK_DUMP_ALL; } - if (TkTextGetIndex(interp, textPtr, argv[arg], &index1) != TCL_OK) { + if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index1) != TCL_OK) { return TCL_ERROR; } lineno = TkBTreeLineIndex(index1.linePtr); arg++; atEnd = 0; - if (argc == arg) { + if (objc == arg) { TkTextIndexForwChars(&index1, 1, &index2); } else { - if (TkTextGetIndex(interp, textPtr, argv[arg], &index2) != TCL_OK) { + if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index2) != TCL_OK) { return TCL_ERROR; } - if (strncmp(argv[arg], "end", strlen(argv[arg])) == 0) { + if (strncmp(Tcl_GetString(objv[arg]), "end", + strlen(Tcl_GetString(objv[arg]))) == 0) { atEnd = 1; } } @@ -2597,7 +2841,10 @@ TextDumpCmd(textPtr, interp, argc, argv) } /* + *---------------------------------------------------------------------- + * * DumpLine + * * Return information about a given text line from character * position "start" up to, but not including, "end". * @@ -2606,6 +2853,8 @@ TextDumpCmd(textPtr, interp, argc, argv) * * Side effects: * None, but see DumpSegment. + * + *---------------------------------------------------------------------- */ static void DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command) @@ -2694,7 +2943,10 @@ DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command) } /* + *---------------------------------------------------------------------- + * * DumpSegment + * * Either append information about the current segment to the result, * or make a script callback with that information as arguments. * @@ -2703,6 +2955,8 @@ DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command) * * Side effects: * Either evals the callback or appends elements to the result string. + * + *---------------------------------------------------------------------- */ static int DumpSegment(interp, key, value, command, index, what) @@ -2710,10 +2964,10 @@ DumpSegment(interp, key, value, command, index, what) char *key; /* Segment type key */ char *value; /* Segment value */ CONST char *command; /* Script callback */ - TkTextIndex *index; /* index with line/byte position info */ + CONST TkTextIndex *index; /* index with line/byte position info */ int what; /* Look for TK_DUMP_INDEX bit */ { - char buffer[TCL_INTEGER_SPACE*2]; + char buffer[TK_POS_CHARS]; TkTextPrintIndex(index, buffer); if (command == NULL) { Tcl_AppendElement(interp, key); @@ -2736,7 +2990,10 @@ DumpSegment(interp, key, value, command, index, what) } /* + *---------------------------------------------------------------------- + * * TextEditUndo -- + * * undo the last change. * * Results: @@ -2744,11 +3001,13 @@ DumpSegment(interp, key, value, command, index, what) * * Side effects: * None. + * + *---------------------------------------------------------------------- */ static int TextEditUndo(textPtr) - TkText * textPtr; /* Overall information about text widget. */ + TkText *textPtr; /* Overall information about text widget. */ { int status; @@ -2775,7 +3034,10 @@ TextEditUndo(textPtr) } /* + *---------------------------------------------------------------------- + * * TextEditRedo -- + * * redo the last undone change. * * Results: @@ -2783,11 +3045,13 @@ TextEditUndo(textPtr) * * Side effects: * None. + * + *---------------------------------------------------------------------- */ static int TextEditRedo(textPtr) - TkText * textPtr; /* Overall information about text widget. */ + TkText *textPtr; /* Overall information about text widget. */ { int status; @@ -2808,6 +3072,8 @@ TextEditRedo(textPtr) } /* + *---------------------------------------------------------------------- + * * TextEditCmd -- * * Handle the subcommands to "$text edit ...". @@ -2818,130 +3084,158 @@ TextEditRedo(textPtr) * * Side effects: * None. + * + *---------------------------------------------------------------------- */ static int -TextEditCmd(textPtr, interp, argc, argv) +TextEditCmd(textPtr, interp, objc, objv) TkText *textPtr; /* Information about text widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - int c, setModified; - size_t length; - - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " edit option ?arg arg ...?\"", (char *) NULL); + int index; + + static CONST char *editOptionStrings[] = { + "modified", "redo", "reset", "separator", "undo", (char *) NULL + }; + enum editOptions { + EDIT_MODIFIED, EDIT_REDO, EDIT_RESET, EDIT_SEPARATOR, EDIT_UNDO + }; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[2], editOptionStrings, + "edit option", 0, &index) != TCL_OK) { return TCL_ERROR; } - c = argv[2][0]; - length = strlen(argv[2]); - if ((c == 'm') && (strncmp(argv[2], "modified", length) == 0)) { - if (argc == 3) { - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(textPtr->isDirty)); - } else if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " edit modified ?boolean?\"", (char *) NULL); - return TCL_ERROR; - } else { - XEvent event; - if (Tcl_GetBoolean(interp, argv[3], &setModified) != TCL_OK) { - return TCL_ERROR; - } - /* - * Set or reset the dirty info and trigger a Modified event. - */ - if (setModified) { - textPtr->isDirty = 1; - textPtr->modifiedSet = 1; + switch ((enum editOptions)index) { + case EDIT_MODIFIED: { + if (objc == 3) { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(textPtr->isDirty)); + } else if (objc != 4) { + Tcl_WrongNumArgs(interp, 3, objv, "?boolean?"); + return TCL_ERROR; } else { - textPtr->isDirty = 0; - textPtr->modifiedSet = 0; - } + int setModified; + XEvent event; + if (Tcl_GetBooleanFromObj(interp, objv[3], &setModified) + != TCL_OK) { + return TCL_ERROR; + } + /* + * Set or reset the dirty info and trigger a Modified event. + */ - /* - * Send an event that the text was modified. This is equivalent to - * "event generate $textWidget <>" - */ + if (setModified) { + textPtr->isDirty = 1; + textPtr->modifiedSet = 1; + } else { + textPtr->isDirty = 0; + textPtr->modifiedSet = 0; + } - memset((VOID *) &event, 0, sizeof(event)); - event.xany.type = VirtualEvent; - event.xany.serial = NextRequest(Tk_Display(textPtr->tkwin)); - event.xany.send_event = False; - event.xany.window = Tk_WindowId(textPtr->tkwin); - event.xany.display = Tk_Display(textPtr->tkwin); - ((XVirtualEvent *) &event)->name = Tk_GetUid("Modified"); - Tk_HandleEvent(&event); - } - } else if ((c == 'r') && (strncmp(argv[2], "redo", length) == 0) - && (length >= 3)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " edit redo\"", (char *) NULL); - return TCL_ERROR; + /* + * Send an event that the text was modified. This is + * equivalent to "event generate $textWidget <>" + */ + + memset((VOID *) &event, 0, sizeof(event)); + event.xany.type = VirtualEvent; + event.xany.serial = NextRequest(Tk_Display(textPtr->tkwin)); + event.xany.send_event = False; + event.xany.window = Tk_WindowId(textPtr->tkwin); + event.xany.display = Tk_Display(textPtr->tkwin); + ((XVirtualEvent *) &event)->name = Tk_GetUid("Modified"); + Tk_HandleEvent(&event); + } + break; } - if ( TextEditRedo(textPtr) ) { - Tcl_AppendResult(interp, "nothing to redo", (char *) NULL); - return TCL_ERROR; - } - } else if ((c == 'r') && (strncmp(argv[2], "reset", length) == 0) - && (length >= 3)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " edit reset\"", (char *) NULL); - return TCL_ERROR; + case EDIT_REDO: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + if (TextEditRedo(textPtr)) { + Tcl_AppendResult(interp, "nothing to redo", (char *) NULL); + return TCL_ERROR; + } + break; } - TkUndoClearStacks(textPtr->undoStack); - } else if ((c == 's') && (strncmp(argv[2], "separator", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " edit separator\"", (char *) NULL); - return TCL_ERROR; + case EDIT_RESET: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + TkUndoClearStacks(textPtr->undoStack); + break; } - TkUndoInsertUndoSeparator(textPtr->undoStack); - } else if ((c == 'u') && (strncmp(argv[2], "undo", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " edit undo\"", (char *) NULL); - return TCL_ERROR; + case EDIT_SEPARATOR: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + TkUndoInsertUndoSeparator(textPtr->undoStack); + break; } - if ( TextEditUndo(textPtr) ) { - Tcl_AppendResult(interp, "nothing to undo", - (char *) NULL); - return TCL_ERROR; - } - } else { - Tcl_AppendResult(interp, "bad edit option \"", argv[2], - "\": must be modified, redo, reset, separator or undo", - (char *) NULL); - return TCL_ERROR; + case EDIT_UNDO: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + if (TextEditUndo(textPtr)) { + Tcl_AppendResult(interp, "nothing to undo", + (char *) NULL); + return TCL_ERROR; + } + break; + } } - return TCL_OK; } /* + *---------------------------------------------------------------------- + * * TextGetText -- + * * Returns the text from indexPtr1 to indexPtr2, placing that text - * in the Tcl_DString given. That DString should be free or uninitialized. + * 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: - * None. + * Tcl_Obj of string type containing the specified text. * * Side effects: - * Memory will be allocated for the DString. Remember to free it. + * Memory will be allocated for the new object. Remember to free it if + * it isn't going to be stored appropriately. + * + *---------------------------------------------------------------------- */ -static void -TextGetText(indexPtr1,indexPtr2, dsPtr) - TkTextIndex *indexPtr1; - TkTextIndex *indexPtr2; - Tcl_DString *dsPtr; +static Tcl_Obj* +TextGetText(indexPtr1,indexPtr2) + CONST TkTextIndex *indexPtr1; + CONST TkTextIndex *indexPtr2; { TkTextIndex tmpIndex; - Tcl_DStringInit(dsPtr); + Tcl_Obj *resultPtr = Tcl_NewObj(); TkTextMakeByteIndex(indexPtr1->tree, TkBTreeLineIndex(indexPtr1->linePtr), indexPtr1->byteIndex, &tmpIndex); @@ -2954,37 +3248,49 @@ TextGetText(indexPtr1,indexPtr2, dsPtr) segPtr = TkTextIndexToSeg(&tmpIndex, &offset); last = segPtr->size; if (tmpIndex.linePtr == indexPtr2->linePtr) { - int last2; - + /* + * 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; + } else { + int last2; + last2 = indexPtr2->byteIndex - tmpIndex.byteIndex + offset; + if (last2 < last) { + last = last2; + } } } if (segPtr->typePtr == &tkTextCharType) { - Tcl_DStringAppend(dsPtr, segPtr->body.chars + offset, - last - offset); + Tcl_AppendToObj(resultPtr, segPtr->body.chars + offset, + last - offset); } TkTextIndexForwBytes(&tmpIndex, last-offset, &tmpIndex); } } + return resultPtr; } /* - * updateDirtyFlag -- - * increases the dirtyness of the text widget + *---------------------------------------------------------------------- + * + * UpdateDirtyFlag -- + * + * Increases the dirtyness of the text widget * * Results: * None * * Side effects: * None. + * + *---------------------------------------------------------------------- */ -static void updateDirtyFlag (textPtr) +static void +UpdateDirtyFlag (textPtr) TkText *textPtr; /* Information about text widget. */ { int oldDirtyFlag; @@ -3011,3 +3317,540 @@ static void updateDirtyFlag (textPtr) Tk_HandleEvent(&event); } } + +/* + *---------------------------------------------------------------------- + * + * SearchPerform -- + * + * Overall control of search process. Is given a pattern, a + * starting index and an ending index, and attempts to perform a + * search. This procedure 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(interp, searchSpecPtr, patObj, fromPtr, toPtr) + 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) { + 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. 'objv[i]' is the pattern which may be an + * exact string or a regexp pattern depending on the flags set + * above. + */ + + return SearchCore(interp, searchSpecPtr, patObj); +} + +/* + *---------------------------------------------------------------------- + * + * SearchCore -- + * + * The core of the search procedure. This procedure 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(interp, searchSpecPtr, patObj) + 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 */ +{ + int passes; + /* + * For exact searches these are utf-8 char* offsets, for regexp + * searches they are Unicode char offsets + */ + int firstOffset, lastOffset, matchOffset, matchLength; + int lineNum = searchSpecPtr->startLine; + int code = TCL_OK; + Tcl_Obj *theLine; + + /* For regexp searches only */ + Tcl_RegExp regexp = NULL; + /* For exact searches only */ + CONST char *pattern = NULL; + int firstNewLine; + + 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) { + 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_GetStringFromObj(patObj, &matchLength); + 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 = -1; + } else { + firstNewLine = (nl - pattern); + } + } else { + firstNewLine = -1; + 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; + + 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 we 'lastOffset' represents. + */ + + lineInfo = (*searchSpecPtr->addLineProc)(lineNum, searchSpecPtr, + theLine, &lastOffset); + + firstOffset = 0; + 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 >= lastOffset) + && ((lastOffset != 0) || searchSpecPtr->exact)) { + goto nextLine; + } + + firstOffset = searchSpecPtr->startOffset; + } else { + /* + * Use only the first part of the line. + */ + + 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); + + do { + Tcl_UniChar ch; + CONST char *p; + + p = strstr(startOfLine + firstOffset, pattern); + if (p == NULL) { + if (firstNewLine == -1) break; + if (firstNewLine >= (lastOffset - firstOffset)) break; + p = startOfLine + lastOffset - firstNewLine - 1; + if (strncmp(p, pattern, firstNewLine + 1)) { + break; + } else { + int extraLines = 1; + 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) { + int len; + + 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, + &len) == NULL) { + p = NULL; + break; + } + maxExtraLines = extraLines; + } + + startOfLine = Tcl_GetString(theLine); + p = startOfLine + skipFirst; + /* + * Use the fact that 'matchLength = patLength' + * for exact searches + */ + if ((len - skipFirst) >= matchLength) { + /* + * We now have enough text to match, so + * we make a final test and break + * whatever the result + */ + if (strncmp(p, pattern, matchLength)) { + p = NULL; + } + break; + } else { + /* Not enough text yet, but check the prefix */ + if (strncmp(p, pattern, (len - 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; + } + } + firstOffset = p - startOfLine; + if (firstOffset >= lastOffset) { + break; + } + + /* Remember the match */ + matchOffset = firstOffset; + + /* + * Move the starting point one character on from the + * previous match, in case we are doing repeated or + * backwards searches (for the latter, we actually do + * repeated forward searches). + */ + firstOffset += Tcl_UtfToUniChar(startOfLine + matchOffset, &ch); + if (searchSpecPtr->all) { + if (!(*searchSpecPtr->foundMatchProc)(lineNum, + searchSpecPtr, lineInfo, theLine, + matchOffset, matchLength)) { + /* We reached the end of the search */ + goto searchDone; + } + } + } while (searchSpecPtr->backwards || searchSpecPtr->all); + + } else { + + int maxExtraLines = 0; + + do { + Tcl_RegExpInfo info; + int match; + + 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 (!match) { + int extraLines = 1; + int curLen = 0; + + if (info.extendStart < 0) { break; } + + /* + * We may be able to match if given more text. + * The following 'while' block handles multi-line + * exact searches. + */ + while (1) { + /* Move firstOffset to first possible start */ + 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 (!searchSpecPtr->backwards + && (firstOffset == curLen)) { + linesSearched = extraLines + 1; + } + 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, + NULL) == NULL) { + /* + * There are no more acceptable lines, so + * we can say we have searched all of these + */ + if (!searchSpecPtr->backwards) { + linesSearched = extraLines + 1; + } + break; + } + maxExtraLines = extraLines; + } + + 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 (match || (info.extendStart < 0)) { + break; + } + /* 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. + * + * Here is where we could perform an optimisation, + * since we have already retrieved the contents of + * the next line (and many more), so we shouldn't + * really throw it all away and start again. This + * could be particularly important for complex regexp + * searches. + */ + if (!match) { + /* + * This 'break' will take us to + * just before the 'nextLine:' below. + */ + break; + } + } + + firstOffset += info.matches[0].start; + if (firstOffset >= lastOffset) { + break; + } + + /* Remember the match */ + matchOffset = firstOffset; + matchLength = info.matches[0].end - info.matches[0].start; + + /* + * Move the starting point one character on, in case + * we are doing repeated or backwards searches (for the + * latter, we actually do repeated forward searches). + */ + firstOffset++; + if (searchSpecPtr->all) { + if (!(*searchSpecPtr->foundMatchProc)(lineNum, + searchSpecPtr, lineInfo, theLine, + matchOffset, matchLength)) { + /* We reached the end of the search */ + goto searchDone; + } + } + } while (searchSpecPtr->backwards || searchSpecPtr->all); + + } + + /* + * 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 ((matchOffset >= 0) && !searchSpecPtr->all) { + (*searchSpecPtr->foundMatchProc)(lineNum, searchSpecPtr, + lineInfo, theLine, + matchOffset, matchLength); + goto searchDone; + } + + /* + * Go to the next (or previous) line; + */ + + nextLine: + + for (;linesSearched > 0;linesSearched--) { + /* If we have just completed the 'stopLine', we are done */ + if (lineNum == searchSpecPtr->stopLine) { + goto searchDone; + } + + if (searchSpecPtr->backwards) { + lineNum--; + if (lineNum < 0) { + lineNum = searchSpecPtr->numLines-1; + } + } else { + lineNum++; + if (lineNum >= searchSpecPtr->numLines) { + lineNum = 0; + } + } + } + + Tcl_SetObjLength(theLine,0); + } + searchDone: + + /* Free up the cached line and pattern */ + Tcl_DecrRefCount(theLine); + Tcl_DecrRefCount(patObj); + + return code; +} diff --git a/generic/tkText.h b/generic/tkText.h index a8ed021..7521fc5 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkText.h,v 1.13 2002/12/27 23:43:38 davygrvy Exp $ + * RCS: @(#) $Id: tkText.h,v 1.14 2003/05/19 13:04:23 vincentdarley Exp $ */ #ifndef _TKTEXT @@ -31,7 +31,7 @@ /* * Opaque types for structures whose guts are only needed by a single - * file: + * file. */ typedef struct TkTextBTree_ *TkTextBTree; @@ -117,6 +117,8 @@ typedef struct TkTextEmbWindow { int displayed; /* Non-zero means that the window * has been displayed on the screen * recently. */ + Tk_OptionTable optionTable; /* Token representing the + * configuration specifications. */ } TkTextEmbWindow; /* @@ -187,6 +189,7 @@ typedef struct TkTextIndex { * of interest. */ int byteIndex; /* Index within line of desired * character (0 means first one). */ + struct TkText *textPtr; } TkTextIndex; /* @@ -278,12 +281,10 @@ struct TkTextDispChunk { * referred to in other structures. */ -typedef enum { TEXT_WRAPMODE_NULL, TEXT_WRAPMODE_NONE, - TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_WORD +typedef enum { TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_NONE, + TEXT_WRAPMODE_WORD, TEXT_WRAPMODE_NULL } TkWrapMode; -EXTERN Tk_CustomOption textWrapModeOption; - typedef struct TkTextTag { char *name; /* Name of this tag. This field is actually * a pointer to the key from the entry in @@ -311,9 +312,8 @@ typedef struct TkTextTag { Tk_3DBorder border; /* Used for drawing background. NULL means * no value specified here. */ - char *bdString; /* -borderwidth option string (malloc-ed). - * NULL means option not specified. */ int borderWidth; /* Width of 3-D border for background. */ + Tcl_Obj* borderWidthPtr; /* Width of 3-D border for background. */ char *reliefString; /* -relief option string (malloc-ed). * NULL means option not specified. */ int relief; /* 3-D relief for background. */ @@ -371,7 +371,7 @@ typedef struct TkTextTag { int spacing3; /* Extra spacing below last display * line for text line. Only valid if * spacing3String is non-NULL. */ - char *tabString; /* -tabs option string (malloc-ed). + Tcl_Obj *tabStringPtr; /* -tabs option string. * NULL means option not specified. */ struct TkTextTabArray *tabArrayPtr; /* Info about tabs for tag (malloc-ed) @@ -393,6 +393,8 @@ typedef struct TkTextTag { int affectsDisplay; /* Non-zero means that this tag affects the * way information is displayed on the screen * (so need to redisplay if tag changes). */ + Tk_OptionTable optionTable; /* Token representing the configuration + * specifications. */ } TkTextTag; #define TK_TAG_AFFECTS_DISPLAY 0x1 @@ -435,7 +437,9 @@ typedef struct TkTextSearch { } TkTextSearch; /* - * The following data structure describes a single tab stop. + * The following data structure describes a single tab stop. It must be + * kept in sync with the 'tabOptionStrings' array in the function + * 'TkTextGetTabs' */ typedef enum {LEFT, RIGHT, CENTER, NUMERIC} TkTextTabAlign; @@ -464,6 +468,15 @@ typedef enum { } TkTextEditMode; /* + * The following enum is used to define a type for the -state option + * of the Text widget. + */ + +typedef enum { + TK_TEXT_STATE_DISABLED, TK_TEXT_STATE_NORMAL +} TkTextState; + +/* * A data structure of the following type is kept for each text widget that * currently exists for this process: */ @@ -531,7 +544,7 @@ typedef struct TkText { * for the same text line. */ int spacing3; /* Default extra spacing below last display * line for each text line. */ - char *tabOptionString; /* Value of -tabs option string (malloc'ed). */ + Tcl_Obj *tabOptionPtr; /* Value of -tabs option string */ TkTextTabArray *tabArrayPtr; /* Information about tab stops (malloc'ed). * NULL means perform default tabbing @@ -564,8 +577,8 @@ typedef struct TkText { * characters. This is a copy of information * in *cursorTagPtr, so it shouldn't be * explicitly freed. */ - char *selBdString; /* Value of -selectborderwidth option, or NULL - * if not specified (malloc'ed). */ + int selBorderWidth; /* Width of border around selection. */ + Tcl_Obj* selBorderWidthPtr; /* Width of border around selection. */ XColor *selFgColorPtr; /* Foreground color for selected text. * This is a copy of information in * *cursorTagPtr, so it shouldn't be @@ -638,19 +651,29 @@ typedef struct TkText { int flags; /* Miscellaneous flags; see below for * definitions. */ + Tk_OptionTable optionTable; /* Token representing the configuration + * specifications. */ + + int stateEpoch; /* This is incremented each time the widget's + * contents change, and means that any cached + * TkTextIndex objects are no longer valid. */ + int refCount; /* Number of cached TkTextIndex objects + * refering to us */ + /* * Information related to the undo/redo functonality */ - TkUndoRedoStack * undoStack; /* The undo/redo stack */ + TkUndoRedoStack *undoStack; /* The undo/redo stack */ - int undo; /* non zero means the undo/redo behaviour is + int undo; /* Non-zero means the undo/redo behaviour is * enabled */ - int maxUndo; /* The maximum depth of the undo stack expressed - * as the maximum number of compound statements */ + int maxUndo; /* The maximum depth of the undo stack + * expressed as the maximum number of + * compound statements */ - int autoSeparators; /* non zero means the separatorss will be + int autoSeparators; /* Non-zero means the separators will be * inserted automatically */ int modifiedSet; /* Flag indicating that the 'dirtynesss' of @@ -663,10 +686,9 @@ typedef struct TkText { * text widget */ int isDirtyIncrement; /* Amount with which the isDirty flag is - * incremented every edit action - */ + * incremented every edit action */ - TkTextEditMode lastEditMode; /* Keeps track of what the last edit mode was + TkTextEditMode lastEditMode;/* Keeps track of what the last edit mode was */ } TkText; @@ -781,7 +803,7 @@ EXTERN Tk_SegType tkTextToggleOffType; * but shouldn't be used anywhere else in Tk (or by Tk clients): */ -EXTERN int TkBTreeCharTagged _ANSI_ARGS_((TkTextIndex *indexPtr, +EXTERN int TkBTreeCharTagged _ANSI_ARGS_((CONST TkTextIndex *indexPtr, TkTextTag *tagPtr)); EXTERN void TkBTreeCheck _ANSI_ARGS_((TkTextBTree tree)); EXTERN int TkBTreeCharsInLine _ANSI_ARGS_((TkTextLine *linePtr)); @@ -792,7 +814,7 @@ EXTERN void TkBTreeDeleteChars _ANSI_ARGS_((TkTextIndex *index1Ptr, TkTextIndex *index2Ptr)); EXTERN TkTextLine * TkBTreeFindLine _ANSI_ARGS_((TkTextBTree tree, int line)); -EXTERN TkTextTag ** TkBTreeGetTags _ANSI_ARGS_((TkTextIndex *indexPtr, +EXTERN TkTextTag ** TkBTreeGetTags _ANSI_ARGS_((CONST TkTextIndex *indexPtr, int *numTagsPtr)); EXTERN void TkBTreeInsertChars _ANSI_ARGS_((TkTextIndex *indexPtr, CONST char *string)); @@ -820,7 +842,7 @@ EXTERN void TkTextBindProc _ANSI_ARGS_((ClientData clientData, EXTERN void TkTextChanged _ANSI_ARGS_((TkText *textPtr, TkTextIndex *index1Ptr, TkTextIndex *index2Ptr)); EXTERN int TkTextCharBbox _ANSI_ARGS_((TkText *textPtr, - TkTextIndex *indexPtr, int *xPtr, int *yPtr, + CONST TkTextIndex *indexPtr, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr)); EXTERN int TkTextCharLayoutProc _ANSI_ARGS_((TkText *textPtr, TkTextIndex *indexPtr, TkTextSegment *segPtr, @@ -828,7 +850,7 @@ EXTERN int TkTextCharLayoutProc _ANSI_ARGS_((TkText *textPtr, TkWrapMode wrapMode, TkTextDispChunk *chunkPtr)); EXTERN void TkTextCreateDInfo _ANSI_ARGS_((TkText *textPtr)); EXTERN int TkTextDLineInfo _ANSI_ARGS_((TkText *textPtr, - TkTextIndex *indexPtr, int *xPtr, int *yPtr, + CONST TkTextIndex *indexPtr, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr, int *basePtr)); EXTERN TkTextTag * TkTextCreateTag _ANSI_ARGS_((TkText *textPtr, CONST char *tagName)); @@ -838,8 +860,13 @@ EXTERN void TkTextFreeTag _ANSI_ARGS_((TkText *textPtr, EXTERN int TkTextGetIndex _ANSI_ARGS_((Tcl_Interp *interp, TkText *textPtr, CONST char *string, TkTextIndex *indexPtr)); +EXTERN int TkTextGetObjIndex _ANSI_ARGS_((Tcl_Interp *interp, + TkText *textPtr, Tcl_Obj *idxPtr, + TkTextIndex *indexPtr)); +EXTERN CONST TkTextIndex* TkTextGetIndexFromObj _ANSI_ARGS_((Tcl_Interp *interp, + TkText *textPtr, Tcl_Obj *objPtr)); EXTERN TkTextTabArray * TkTextGetTabs _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Window tkwin, char *string)); + Tk_Window tkwin, Tcl_Obj *stringPtr)); EXTERN void TkTextIndexBackBytes _ANSI_ARGS_(( CONST TkTextIndex *srcPtr, int count, TkTextIndex *dstPtr)); @@ -867,12 +894,12 @@ EXTERN TkTextIndex * TkTextMakeCharIndex _ANSI_ARGS_((TkTextBTree tree, int lineIndex, int charIndex, TkTextIndex *indexPtr)); EXTERN int TkTextIsElided _ANSI_ARGS_((TkText *textPtr, - TkTextIndex *indexPtr)); + CONST TkTextIndex *indexPtr)); EXTERN TkTextIndex * TkTextMakeByteIndex _ANSI_ARGS_((TkTextBTree tree, int lineIndex, int byteIndex, TkTextIndex *indexPtr)); EXTERN int TkTextMarkCmd _ANSI_ARGS_((TkText *textPtr, - Tcl_Interp *interp, int argc, CONST char **argv)); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TkTextMarkNameToIndex _ANSI_ARGS_((TkText *textPtr, CONST char *name, TkTextIndex *indexPtr)); EXTERN void TkTextMarkSegToIndex _ANSI_ARGS_((TkText *textPtr, @@ -882,8 +909,10 @@ EXTERN void TkTextPickCurrent _ANSI_ARGS_((TkText *textPtr, XEvent *eventPtr)); EXTERN void TkTextPixelIndex _ANSI_ARGS_((TkText *textPtr, int x, int y, TkTextIndex *indexPtr)); -EXTERN void TkTextPrintIndex _ANSI_ARGS_(( +EXTERN int TkTextPrintIndex _ANSI_ARGS_(( CONST TkTextIndex *indexPtr, char *string)); +EXTERN Tcl_Obj* TkTextNewIndexObj _ANSI_ARGS_((TkText *textPtr, + CONST TkTextIndex *indexPtr)); EXTERN void TkTextRedrawRegion _ANSI_ARGS_((TkText *textPtr, int x, int y, int width, int height)); EXTERN void TkTextRedrawTag _ANSI_ARGS_((TkText *textPtr, @@ -891,9 +920,9 @@ EXTERN void TkTextRedrawTag _ANSI_ARGS_((TkText *textPtr, TkTextTag *tagPtr, int withTag)); EXTERN void TkTextRelayoutWindow _ANSI_ARGS_((TkText *textPtr)); EXTERN int TkTextScanCmd _ANSI_ARGS_((TkText *textPtr, - Tcl_Interp *interp, int argc, CONST char **argv)); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TkTextSeeCmd _ANSI_ARGS_((TkText *textPtr, - Tcl_Interp *interp, int argc, CONST char **argv)); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TkTextSegToOffset _ANSI_ARGS_(( CONST TkTextSegment *segPtr, CONST TkTextLine *linePtr)); @@ -902,19 +931,22 @@ EXTERN TkTextSegment * TkTextSetMark _ANSI_ARGS_((TkText *textPtr, EXTERN void TkTextSetYView _ANSI_ARGS_((TkText *textPtr, TkTextIndex *indexPtr, int pickPlace)); EXTERN int TkTextTagCmd _ANSI_ARGS_((TkText *textPtr, - Tcl_Interp *interp, int argc, CONST char **argv)); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TkTextImageCmd _ANSI_ARGS_((TkText *textPtr, - Tcl_Interp *interp, int argc, CONST char **argv)); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TkTextImageIndex _ANSI_ARGS_((TkText *textPtr, CONST char *name, TkTextIndex *indexPtr)); EXTERN int TkTextWindowCmd _ANSI_ARGS_((TkText *textPtr, - Tcl_Interp *interp, int argc, CONST char **argv)); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TkTextWindowIndex _ANSI_ARGS_((TkText *textPtr, CONST char *name, TkTextIndex *indexPtr)); EXTERN int TkTextXviewCmd _ANSI_ARGS_((TkText *textPtr, - Tcl_Interp *interp, int argc, CONST char **argv)); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TkTextYviewCmd _ANSI_ARGS_((TkText *textPtr, - Tcl_Interp *interp, int argc, CONST char **argv)); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +/* Use a helper from tkCanvas.c */ +EXTERN CONST char** GetStringsFromObjs _ANSI_ARGS_((int argc, + Tcl_Obj *CONST *objv)); # undef TCL_STORAGE_CLASS # define TCL_STORAGE_CLASS DLLIMPORT diff --git a/generic/tkTextBTree.c b/generic/tkTextBTree.c index 4f8ac7d..762d5f3 100644 --- a/generic/tkTextBTree.c +++ b/generic/tkTextBTree.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextBTree.c,v 1.6 2002/08/05 04:30:40 dgp Exp $ + * RCS: @(#) $Id: tkTextBTree.c,v 1.7 2003/05/19 13:04:23 vincentdarley Exp $ */ #include "tkInt.h" @@ -2223,7 +2223,7 @@ TkBTreePrevTag(searchPtr) int TkBTreeCharTagged(indexPtr, tagPtr) - TkTextIndex *indexPtr; /* Indicates a character position at + CONST TkTextIndex *indexPtr; /* Indicates a character position at * which to check for a tag. */ TkTextTag *tagPtr; /* Tag of interest. */ { @@ -2335,7 +2335,7 @@ TkBTreeCharTagged(indexPtr, tagPtr) /* ARGSUSED */ TkTextTag ** TkBTreeGetTags(indexPtr, numTagsPtr) - TkTextIndex *indexPtr; /* Indicates a particular position in + CONST TkTextIndex *indexPtr;/* Indicates a particular position in * the B-tree. */ int *numTagsPtr; /* Store number of tags found at this * location. */ @@ -2452,7 +2452,7 @@ TkBTreeGetTags(indexPtr, numTagsPtr) int TkTextIsElided(textPtr, indexPtr) TkText *textPtr; /* Overall information about text widget. */ - TkTextIndex *indexPtr; /* The character in the text for which + CONST TkTextIndex *indexPtr;/* The character in the text for which * display information is wanted. */ { #define LOTSA_TAGS 1000 @@ -2466,7 +2466,7 @@ TkTextIsElided(textPtr, indexPtr) register Node *nodePtr; register TkTextLine *siblingLinePtr; register TkTextSegment *segPtr; - register TkTextTag *tagPtr; + register TkTextTag *tagPtr = NULL; register int i, index; /* almost always avoid malloc, so stay out of system calls */ diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index c541c32..6c9f7fc 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextDisp.c,v 1.14 2002/11/22 23:25:19 hobbs Exp $ + * RCS: @(#) $Id: tkTextDisp.c,v 1.15 2003/05/19 13:04:23 vincentdarley Exp $ */ #include "tkPort.h" @@ -350,7 +350,7 @@ static void DisplayLineBackground _ANSI_ARGS_((TkText *textPtr, DLine *dlPtr, DLine *prevPtr, Pixmap pixmap)); static void DisplayText _ANSI_ARGS_((ClientData clientData)); static DLine * FindDLine _ANSI_ARGS_((DLine *dlPtr, - TkTextIndex *indexPtr)); + CONST TkTextIndex *indexPtr)); static void FreeDLines _ANSI_ARGS_((TkText *textPtr, DLine *firstPtr, DLine *lastPtr, int unlink)); static void FreeStyle _ANSI_ARGS_((TkText *textPtr, @@ -560,7 +560,8 @@ GetStyle(textPtr, indexPtr) styleValues.border = tagPtr->border; borderPrio = tagPtr->priority; } - if ((tagPtr->bdString != NULL) + if ((tagPtr->borderWidthPtr != NULL) + && (Tcl_GetString(tagPtr->borderWidthPtr)[0] != '\0') && (tagPtr->priority > borderWidthPrio)) { styleValues.borderWidth = tagPtr->borderWidth; borderWidthPrio = tagPtr->priority; @@ -636,7 +637,7 @@ GetStyle(textPtr, indexPtr) styleValues.spacing3 = tagPtr->spacing3; spacing3Prio = tagPtr->priority; } - if ((tagPtr->tabString != NULL) + if ((tagPtr->tabStringPtr != NULL) && (tagPtr->priority > tabPrio)) { styleValues.tabArrayPtr = tagPtr->tabArrayPtr; tabPrio = tagPtr->priority; @@ -1706,7 +1707,7 @@ DisplayDLine(textPtr, dlPtr, prevPtr, pixmap) * to its left. */ - if (textPtr->state == TK_STATE_NORMAL) { + if (textPtr->state == TK_TEXT_STATE_NORMAL) { for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL); chunkPtr = chunkPtr->nextPtr) { x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curPixelOffset; @@ -3295,13 +3296,13 @@ MeasureUp(textPtr, srcPtr, distance, dstPtr) */ int -TkTextSeeCmd(textPtr, interp, argc, argv) +TkTextSeeCmd(textPtr, interp, objc, objv) TkText *textPtr; /* Information about text widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. Someone else has already + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. Someone else has already * parsed this command enough to know that - * argv[1] is "see". */ + * objv[1] is "see". */ { TextDInfo *dInfoPtr = textPtr->dInfoPtr; TkTextIndex index; @@ -3309,12 +3310,12 @@ TkTextSeeCmd(textPtr, interp, argc, argv) DLine *dlPtr; TkTextDispChunk *chunkPtr; - if (argc != 3) { + if (objc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " see index\"", (char *) NULL); + Tcl_GetString(objv[0]), " see index\"", (char *) NULL); return TCL_ERROR; } - if (TkTextGetIndex(interp, textPtr, argv[2], &index) != TCL_OK) { + if (TkTextGetObjIndex(interp, textPtr, objv[2], &index) != TCL_OK) { return TCL_ERROR; } @@ -3428,13 +3429,13 @@ TkTextSeeCmd(textPtr, interp, argc, argv) */ int -TkTextXviewCmd(textPtr, interp, argc, argv) +TkTextXviewCmd(textPtr, interp, objc, objv) TkText *textPtr; /* Information about text widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. Someone else has already + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. Someone else has already * parsed this command enough to know that - * argv[1] is "xview". */ + * objv[1] is "xview". */ { TextDInfo *dInfoPtr = textPtr->dInfoPtr; int type, charsPerPage, count, newOffset; @@ -3444,13 +3445,13 @@ TkTextXviewCmd(textPtr, interp, argc, argv) UpdateDisplayInfo(textPtr); } - if (argc == 2) { + if (objc == 2) { GetXView(interp, textPtr, 0); return TCL_OK; } newOffset = dInfoPtr->newByteOffset; - type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count); + type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count); switch (type) { case TK_SCROLL_ERROR: return TCL_ERROR; @@ -3616,13 +3617,13 @@ ScrollByLines(textPtr, offset) */ int -TkTextYviewCmd(textPtr, interp, argc, argv) +TkTextYviewCmd(textPtr, interp, objc, objv) TkText *textPtr; /* Information about text widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. Someone else has already + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. Someone else has already * parsed this command enough to know that - * argv[1] is "yview". */ + * objv[1] is "yview". */ { TextDInfo *dInfoPtr = textPtr->dInfoPtr; int pickPlace, lineNum, type, bytesInLine; @@ -3638,7 +3639,7 @@ TkTextYviewCmd(textPtr, interp, argc, argv) UpdateDisplayInfo(textPtr); } - if (argc == 2) { + if (objc == 2) { GetYView(interp, textPtr, 0); return TCL_OK; } @@ -3648,21 +3649,22 @@ TkTextYviewCmd(textPtr, interp, argc, argv) */ pickPlace = 0; - if (argv[2][0] == '-') { - switchLength = strlen(argv[2]); + if (Tcl_GetString(objv[2])[0] == '-') { + switchLength = strlen(Tcl_GetString(objv[2])); if ((switchLength >= 2) - && (strncmp(argv[2], "-pickplace", switchLength) == 0)) { + && (strncmp(Tcl_GetString(objv[2]), "-pickplace", switchLength) == 0)) { pickPlace = 1; - if (argc != 4) { + if (objc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " yview -pickplace lineNum|index\"", + Tcl_GetString(objv[0]), + " yview -pickplace lineNum|index\"", (char *) NULL); return TCL_ERROR; } } } - if ((argc == 3) || pickPlace) { - if (Tcl_GetInt(interp, argv[2+pickPlace], &lineNum) == TCL_OK) { + if ((objc == 3) || pickPlace) { + if (Tcl_GetIntFromObj(interp, objv[2+pickPlace], &lineNum) == TCL_OK) { TkTextMakeByteIndex(textPtr->tree, lineNum, 0, &index); TkTextSetYView(textPtr, &index, 0); return TCL_OK; @@ -3673,7 +3675,7 @@ TkTextYviewCmd(textPtr, interp, argc, argv) */ Tcl_ResetResult(interp); - if (TkTextGetIndex(interp, textPtr, argv[2+pickPlace], + if (TkTextGetObjIndex(interp, textPtr, objv[2+pickPlace], &index) != TCL_OK) { return TCL_ERROR; } @@ -3682,10 +3684,10 @@ TkTextYviewCmd(textPtr, interp, argc, argv) } /* - * New syntax: dispatch based on argv[2]. + * New syntax: dispatch based on objv[2]. */ - type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count); + type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count); switch (type) { case TK_SCROLL_ERROR: return TCL_ERROR; @@ -3782,13 +3784,13 @@ TkTextYviewCmd(textPtr, interp, argc, argv) */ int -TkTextScanCmd(textPtr, interp, argc, argv) +TkTextScanCmd(textPtr, interp, objc, objv) register TkText *textPtr; /* Information about text widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. Someone else has already + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. Someone else has already * parsed this command enough to know that - * argv[1] is "scan". */ + * objv[1] is "scan". */ { TextDInfo *dInfoPtr = textPtr->dInfoPtr; TkTextIndex index; @@ -3796,23 +3798,23 @@ TkTextScanCmd(textPtr, interp, argc, argv) Tk_FontMetrics fm; size_t length; - if ((argc != 5) && (argc != 6)) { + if ((objc != 5) && (objc != 6)) { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " scan mark x y\" or \"", - argv[0], " scan dragto x y ?gain?\"", (char *) NULL); + Tcl_GetString(objv[0]), " scan mark x y\" or \"", + Tcl_GetString(objv[0]), " scan dragto x y ?gain?\"", (char *) NULL); return TCL_ERROR; } - if (Tcl_GetInt(interp, argv[3], &x) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) { return TCL_ERROR; } - if (Tcl_GetInt(interp, argv[4], &y) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) { return TCL_ERROR; } - if ((argc == 6) && (Tcl_GetInt(interp, argv[5], &gain) != TCL_OK)) + if ((objc == 6) && (Tcl_GetIntFromObj(interp, objv[5], &gain) != TCL_OK)) return TCL_ERROR; - c = argv[2][0]; - length = strlen(argv[2]); - if ((c == 'd') && (strncmp(argv[2], "dragto", length) == 0)) { + c = Tcl_GetString(objv[2])[0]; + length = strlen(Tcl_GetString(objv[2])); + if ((c == 'd') && (strncmp(Tcl_GetString(objv[2]), "dragto", length) == 0)) { /* * Amplify the difference between the current position and the * mark position to compute how much the view should shift, then @@ -3852,13 +3854,13 @@ TkTextScanCmd(textPtr, interp, argc, argv) dInfoPtr->scanMarkY = y; } } - } else if ((c == 'm') && (strncmp(argv[2], "mark", length) == 0)) { + } else if ((c == 'm') && (strncmp(Tcl_GetString(objv[2]), "mark", length) == 0)) { dInfoPtr->scanMarkIndex = dInfoPtr->newByteOffset; dInfoPtr->scanMarkX = x; dInfoPtr->scanTotalScroll = 0; dInfoPtr->scanMarkY = y; } else { - Tcl_AppendResult(interp, "bad scan option \"", argv[2], + Tcl_AppendResult(interp, "bad scan option \"", Tcl_GetString(objv[2]), "\": must be mark or dragto", (char *) NULL); return TCL_ERROR; } @@ -4051,7 +4053,7 @@ static DLine * FindDLine(dlPtr, indexPtr) register DLine *dlPtr; /* Pointer to first in list of DLines * to search. */ - TkTextIndex *indexPtr; /* Index of desired character. */ + CONST TkTextIndex *indexPtr;/* Index of desired character. */ { TkTextLine *linePtr; @@ -4229,7 +4231,7 @@ TkTextPixelIndex(textPtr, x, y, indexPtr) int TkTextCharBbox(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr) TkText *textPtr; /* Widget record for text widget. */ - TkTextIndex *indexPtr; /* Index of character whose bounding + CONST TkTextIndex *indexPtr;/* Index of character whose bounding * box is desired. */ int *xPtr, *yPtr; /* Filled with character's upper-left * coordinate. */ @@ -4338,7 +4340,7 @@ TkTextCharBbox(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr) int TkTextDLineInfo(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr, basePtr) TkText *textPtr; /* Widget record for text widget. */ - TkTextIndex *indexPtr; /* Index of character whose bounding + CONST TkTextIndex *indexPtr;/* Index of character whose bounding * box is desired. */ int *xPtr, *yPtr; /* Filled with line's upper-left * coordinate. */ diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c index b594aba..7c69f48 100644 --- a/generic/tkTextImage.c +++ b/generic/tkTextImage.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextImage.c,v 1.5 2002/08/05 04:30:40 dgp Exp $ + * RCS: @(#) $Id: tkTextImage.c,v 1.6 2003/05/19 13:04:23 vincentdarley Exp $ */ #include "tk.h" @@ -52,7 +52,7 @@ static void EmbImageBboxProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr)); static int EmbImageConfigure _ANSI_ARGS_((TkText *textPtr, - TkTextSegment *eiPtr, int argc, CONST char **argv)); + TkTextSegment *eiPtr, int objc, Tcl_Obj *CONST objv[])); static int EmbImageDeleteProc _ANSI_ARGS_((TkTextSegment *segPtr, TkTextLine *linePtr, int treeGone)); static void EmbImageDisplayProc _ANSI_ARGS_(( @@ -128,74 +128,70 @@ static Tk_ConfigSpec configSpecs[] = { */ int -TkTextImageCmd(textPtr, interp, argc, argv) +TkTextImageCmd(textPtr, interp, objc, objv) register TkText *textPtr; /* Information about text widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. Someone else has already + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. Someone else has already * parsed this command enough to know that - * argv[1] is "image". */ + * objv[1] is "image". */ { - size_t length; + int length; register TkTextSegment *eiPtr; - - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " image option ?arg arg ...?\"", (char *) NULL); + CONST char *str; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?"); return TCL_ERROR; } - length = strlen(argv[2]); - if ((strncmp(argv[2], "cget", length) == 0) && (length >= 2)) { + str = Tcl_GetStringFromObj(objv[2],&length); + if ((strncmp(str, "cget", length) == 0) && (length >= 2)) { TkTextIndex index; TkTextSegment *eiPtr; - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " image cget index option\"", - (char *) NULL); + if (objc != 5) { + Tcl_WrongNumArgs(interp, 3, objv, "index option"); return TCL_ERROR; } - if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { + if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) { return TCL_ERROR; } eiPtr = TkTextIndexToSeg(&index, (int *) NULL); if (eiPtr->typePtr != &tkTextEmbImageType) { Tcl_AppendResult(interp, "no embedded image at index \"", - argv[3], "\"", (char *) NULL); + Tcl_GetString(objv[3]), "\"", (char *) NULL); return TCL_ERROR; } return Tk_ConfigureValue(interp, textPtr->tkwin, configSpecs, - (char *) &eiPtr->body.ei, argv[4], 0); - } else if ((strncmp(argv[2], "configure", length) == 0) && (length >= 2)) { + (char *) &eiPtr->body.ei, Tcl_GetString(objv[4]), 0); + } else if ((strncmp(str, "configure", length) == 0) && (length >= 2)) { TkTextIndex index; TkTextSegment *eiPtr; - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " image configure index ?option value ...?\"", - (char *) NULL); + if (objc < 4) { + Tcl_WrongNumArgs(interp, 3, objv, "index ?option value ...?"); return TCL_ERROR; } - if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { + if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) { return TCL_ERROR; } eiPtr = TkTextIndexToSeg(&index, (int *) NULL); if (eiPtr->typePtr != &tkTextEmbImageType) { Tcl_AppendResult(interp, "no embedded image at index \"", - argv[3], "\"", (char *) NULL); + Tcl_GetString(objv[3]), "\"", (char *) NULL); return TCL_ERROR; } - if (argc == 4) { + if (objc == 4) { return Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs, (char *) &eiPtr->body.ei, (char *) NULL, 0); - } else if (argc == 5) { + } else if (objc == 5) { return Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs, - (char *) &eiPtr->body.ei, argv[4], 0); + (char *) &eiPtr->body.ei, Tcl_GetString(objv[4]), 0); } else { TkTextChanged(textPtr, &index, &index); - return EmbImageConfigure(textPtr, eiPtr, argc-4, argv+4); + return EmbImageConfigure(textPtr, eiPtr, objc-4, objv+4); } - } else if ((strncmp(argv[2], "create", length) == 0) && (length >= 2)) { + } else if ((strncmp(str, "create", length) == 0) && (length >= 2)) { TkTextIndex index; int lineIndex; @@ -204,13 +200,11 @@ TkTextImageCmd(textPtr, interp, argc, argv) * mark that position for redisplay. */ - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " image create index ?option value ...?\"", - (char *) NULL); + if (objc < 4) { + Tcl_WrongNumArgs(interp, 3, objv, "index ?option value ...?"); return TCL_ERROR; } - if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { + if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) { return TCL_ERROR; } @@ -248,20 +242,19 @@ TkTextImageCmd(textPtr, interp, argc, argv) TkTextChanged(textPtr, &index, &index); TkBTreeLinkSegment(eiPtr, &index); - if (EmbImageConfigure(textPtr, eiPtr, argc-4, argv+4) != TCL_OK) { + if (EmbImageConfigure(textPtr, eiPtr, objc-4, objv+4) != TCL_OK) { TkTextIndex index2; TkTextIndexForwChars(&index, 1, &index2); TkBTreeDeleteChars(&index, &index2); return TCL_ERROR; } - } else if (strncmp(argv[2], "names", length) == 0) { + } else if (strncmp(str, "names", length) == 0) { Tcl_HashSearch search; Tcl_HashEntry *hPtr; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " image names\"", (char *) NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } for (hPtr = Tcl_FirstHashEntry(&textPtr->imageTable, &search); @@ -270,7 +263,7 @@ TkTextImageCmd(textPtr, interp, argc, argv) Tcl_GetHashKey(&textPtr->markTable, hPtr)); } } else { - Tcl_AppendResult(interp, "bad image option \"", argv[2], + Tcl_AppendResult(interp, "bad image option \"", str, "\": must be cget, configure, create, or names", (char *) NULL); return TCL_ERROR; @@ -284,7 +277,7 @@ TkTextImageCmd(textPtr, interp, argc, argv) * EmbImageConfigure -- * * This procedure is called to handle configuration options - * for an embedded image, using an argc/argv list. + * for an embedded image, using an objc/objv list. * * Results: * The return value is a standard Tcl result. If TCL_ERROR is @@ -298,12 +291,12 @@ TkTextImageCmd(textPtr, interp, argc, argv) */ static int -EmbImageConfigure(textPtr, eiPtr, argc, argv) +EmbImageConfigure(textPtr, eiPtr, objc, objv) TkText *textPtr; /* Information about text widget that * contains embedded image. */ TkTextSegment *eiPtr; /* Embedded image to be configured. */ - int argc; /* Number of strings in argv. */ - CONST char **argv; /* Array of strings describing configuration + int objc; /* Number of strings in objv. */ + Tcl_Obj *CONST objv[]; /* Array of strings describing configuration * options. */ { Tk_Image image; @@ -315,12 +308,16 @@ EmbImageConfigure(textPtr, eiPtr, argc, argv) int count = 0; /* The counter for picking a unique name */ int conflict = 0; /* True if we have a name conflict */ unsigned int len; /* length of image name */ - + CONST char **argv; + + argv = GetStringsFromObjs(objc, objv); if (Tk_ConfigureWidget(textPtr->interp, textPtr->tkwin, configSpecs, - argc, argv, (char *) &eiPtr->body.ei,TK_CONFIG_ARGV_ONLY) + objc, argv, (char *) &eiPtr->body.ei,TK_CONFIG_ARGV_ONLY) != TCL_OK) { + if (argv) ckfree((char *) argv); return TCL_ERROR; } + if (argv) ckfree((char *) argv); /* * Create the image. Save the old image around and don't free it diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index 26576ed..cb8cbea 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextIndex.c,v 1.6 2002/08/05 04:30:40 dgp Exp $ + * RCS: @(#) $Id: tkTextIndex.c,v 1.7 2003/05/19 13:04:23 vincentdarley Exp $ */ #include "default.h" @@ -32,6 +32,244 @@ static CONST char * ForwBack _ANSI_ARGS_((CONST char *string, TkTextIndex *indexPtr)); static CONST char * StartEnd _ANSI_ARGS_((CONST char *string, TkTextIndex *indexPtr)); +static int GetIndex _ANSI_ARGS_((Tcl_Interp *interp, + TkText *textPtr, CONST char *string, + TkTextIndex *indexPtr, int *canCachePtr)); + + +static void DupTextIndexInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr)); +static void FreeTextIndexInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr)); +static int SetTextIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); +static void UpdateStringOfTextIndex _ANSI_ARGS_((Tcl_Obj *objPtr)); + +#define GET_TEXTINDEX(objPtr) \ + ((TkTextIndex *) (objPtr)->internalRep.twoPtrValue.ptr1) +#define GET_INDEXEPOCH(objPtr) \ + ((int) (objPtr)->internalRep.twoPtrValue.ptr2) +#define SET_TEXTINDEX(objPtr, indexPtr) \ + (objPtr)->internalRep.twoPtrValue.ptr1 = (VOID*) (indexPtr) +#define SET_INDEXEPOCH(objPtr, epoch) \ + (objPtr)->internalRep.twoPtrValue.ptr2 = (VOID*) (epoch) +/* + * Define the 'textindex' object type, which Tk uses to represent + * indices in text widgets internally. + */ +Tcl_ObjType tclTextIndexType = { + "textindex", /* name */ + FreeTextIndexInternalRep, /* freeIntRepProc */ + DupTextIndexInternalRep, /* dupIntRepProc */ + NULL, /* updateStringProc */ + SetTextIndexFromAny /* setFromAnyProc */ +}; + +static void +FreeTextIndexInternalRep(indexObjPtr) + Tcl_Obj *indexObjPtr; /* TextIndex object with internal rep to free. */ +{ + TkTextIndex *indexPtr = GET_TEXTINDEX(indexObjPtr); + if (indexPtr->textPtr != NULL) { + if (--indexPtr->textPtr->refCount == 0) { + /* The text widget has been deleted and we need to free it now */ + ckfree((char *) (indexPtr->textPtr)); + } + } + ckfree((char*)indexPtr); +} + +static void +DupTextIndexInternalRep(srcPtr, copyPtr) + Tcl_Obj *srcPtr; /* TextIndex obj with internal rep to copy. */ + Tcl_Obj *copyPtr; /* TextIndex obj with internal rep to set. */ +{ + int epoch; + TkTextIndex *dupIndexPtr, *indexPtr; + dupIndexPtr = (TkTextIndex*) ckalloc(sizeof(TkTextIndex)); + indexPtr = GET_TEXTINDEX(srcPtr); + epoch = GET_INDEXEPOCH(srcPtr); + + dupIndexPtr->tree = indexPtr->tree; + dupIndexPtr->linePtr = indexPtr->linePtr; + dupIndexPtr->byteIndex = indexPtr->byteIndex; + + SET_TEXTINDEX(copyPtr, dupIndexPtr); + SET_INDEXEPOCH(copyPtr, epoch); +} + +/* + * This will not be called except by TkTextNewIndexObj below. + * This is because if a TkTextIndex is no longer valid, it is + * not possible to regenerate the string representation. + */ +static void +UpdateStringOfTextIndex(objPtr) + Tcl_Obj *objPtr; +{ + char buffer[TK_POS_CHARS]; + register int len; + + CONST TkTextIndex *indexPtr = GET_TEXTINDEX(objPtr); + + len = TkTextPrintIndex(indexPtr, buffer); + + objPtr->bytes = ckalloc((unsigned) len + 1); + strcpy(objPtr->bytes, buffer); + objPtr->length = len; +} + +static int +SetTextIndexFromAny(interp, objPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr; /* The object to convert. */ +{ + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "can't convert value to textindex except via TkTextGetIndexFromObj API", + -1); + return TCL_ERROR; +} + +/* + *--------------------------------------------------------------------------- + * + * MakeObjIndex -- + * + * This procedure generates a Tcl_Obj description of an index, + * suitable for reading in again later. If the 'textPtr' is NULL + * then we still generate an index object, but it's internal + * description is deemed non-cacheable, and therefore effectively + * useless (apart from as a temporary memory storage). This is used + * for indices whose meaning is very temporary (like @0,0 or the + * name of a mark or tag). The mapping from such strings/objects to + * actual TkTextIndex pointers is not stable to minor text widget + * changes which we do not track (we track insertions/deletions). + * + * Results: + * A pointer to an allocated TkTextIndex which will be freed + * automatically when the Tcl_Obj is used for other purposes. + * + * Side effects: + * A small amount of memory is allocated. + * + *--------------------------------------------------------------------------- + */ +static TkTextIndex* +MakeObjIndex(textPtr, objPtr, origPtr) + TkText *textPtr; /* Information about text widget. */ + Tcl_Obj *objPtr; /* Object containing description of position. */ + CONST TkTextIndex *origPtr; /* Pointer to index. */ +{ + TkTextIndex *indexPtr = (TkTextIndex*) ckalloc(sizeof(TkTextIndex)); + + indexPtr->tree = origPtr->tree; + indexPtr->linePtr = origPtr->linePtr; + indexPtr->byteIndex = origPtr->byteIndex; + SET_TEXTINDEX(objPtr, indexPtr); + objPtr->typePtr = &tclTextIndexType; + indexPtr->textPtr = textPtr; + + if (textPtr != NULL) { + textPtr->refCount++; + SET_INDEXEPOCH(objPtr, textPtr->stateEpoch); + } else { + SET_INDEXEPOCH(objPtr, 0); + } + return indexPtr; +} + +CONST TkTextIndex* +TkTextGetIndexFromObj(interp, textPtr, objPtr) + Tcl_Interp *interp; /* Use this for error reporting. */ + TkText *textPtr; /* Information about text widget. */ + Tcl_Obj *objPtr; /* Object containing description of position. */ +{ + TkTextIndex index; + TkTextIndex *indexPtr = NULL; + int cache; + + if (objPtr->typePtr == &tclTextIndexType) { + int epoch; + + indexPtr = GET_TEXTINDEX(objPtr); + epoch = GET_INDEXEPOCH(objPtr); + + if (epoch == textPtr->stateEpoch) { + if (indexPtr->textPtr == textPtr) { + return indexPtr; + } + } + } + + /* + * The object is either not an index type or referred to a different + * text widget, or referred to the correct widget, but it is out of + * date (text has been added/deleted since). + */ + + if (GetIndex(interp, textPtr, Tcl_GetString(objPtr), + &index, &cache) != TCL_OK) { + return NULL; + } + + if (objPtr->typePtr != NULL) { + if (objPtr->bytes == NULL) { + objPtr->typePtr->updateStringProc(objPtr); + } + if ((objPtr->typePtr->freeIntRepProc) != NULL) { + (*objPtr->typePtr->freeIntRepProc)(objPtr); + } + } + + if (cache) { + return MakeObjIndex(textPtr, objPtr, &index); + } else { + return MakeObjIndex(NULL, objPtr, &index); + } +} + +/* + *--------------------------------------------------------------------------- + * + * TkTextNewIndexObj -- + * + * This procedure generates a Tcl_Obj description of an index, + * suitable for reading in again later. The index generated is + * effectively stable to all except insertion/deletion operations on + * the widget. + * + * Results: + * A new Tcl_Obj with refCount zero. + * + * Side effects: + * A small amount of memory is allocated. + * + *--------------------------------------------------------------------------- + */ + +Tcl_Obj* +TkTextNewIndexObj(textPtr, indexPtr) + TkText *textPtr; /* text widget for this index */ + CONST TkTextIndex *indexPtr; /* Pointer to index. */ +{ + Tcl_Obj *retVal; + + retVal = Tcl_NewObj(); + retVal->bytes = NULL; + + /* + * Assumption that the above call returns an object with + * retVal->typePtr == NULL + */ + MakeObjIndex(textPtr, retVal, indexPtr); + + /* + * Unfortunately, it isn't possible for us to regenerate the + * string representation so we have to create it here, while we + * can be sure the contents of the index are still valid. + */ + UpdateStringOfTextIndex(retVal); + return retVal; +} /* *--------------------------------------------------------------------------- @@ -294,6 +532,34 @@ TkTextSegToOffset(segPtr, linePtr) /* *--------------------------------------------------------------------------- * + * TkTextGetObjIndex -- + * + * Simpler wrapper around the string based function, but could be + * enhanced with a new object type in the future. + * + * Results: + * see TkTextGetIndex + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +int +TkTextGetObjIndex(interp, textPtr, idxObj, indexPtr) + Tcl_Interp *interp; /* Use this for error reporting. */ + TkText *textPtr; /* Information about text widget. */ + Tcl_Obj *idxObj; /* Object containing textual description + * of position. */ + TkTextIndex *indexPtr; /* Index structure to fill in. */ +{ + return GetIndex(interp, textPtr, Tcl_GetString(idxObj), indexPtr, NULL); +} + +/* + *--------------------------------------------------------------------------- + * * TkTextGetIndex -- * * Given a string, return the index that is described. @@ -317,6 +583,41 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) CONST char *string; /* Textual description of position. */ TkTextIndex *indexPtr; /* Index structure to fill in. */ { + return GetIndex(interp, textPtr, string, indexPtr, NULL); +} + +/* + *--------------------------------------------------------------------------- + * + * GetIndex -- + * + * Given a string, return the index that is described. + * + * Results: + * The return value is a standard Tcl return result. If TCL_OK is + * returned, then everything went well and the index at *indexPtr is + * filled in; otherwise TCL_ERROR is returned and an error message + * is left in the interp's result. + * + * If *canCachePtr is non-NULL, and everything went well, the + * integer it points to is set to 1 if the indexPtr is something + * which can be cached, and zero otherwise. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static int +GetIndex(interp, textPtr, string, indexPtr, canCachePtr) + Tcl_Interp *interp; /* Use this for error reporting. */ + TkText *textPtr; /* Information about text widget. */ + CONST char *string; /* Textual description of position. */ + TkTextIndex *indexPtr; /* Index structure to fill in. */ + int *canCachePtr; /* Pointer to integer to store whether + * we can cache the index (or NULL) */ +{ char *p, *end, *endOfBase; Tcl_HashEntry *hPtr; TkTextTag *tagPtr; @@ -326,7 +627,8 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) char c; CONST char *cp; Tcl_DString copy; - + int canCache = 0; + /* *--------------------------------------------------------------------- * Stage 1: check to see if the index consists of nothing but a mark @@ -337,7 +639,7 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) */ if (TkTextMarkNameToIndex(textPtr, string, indexPtr) == TCL_OK) { - return TCL_OK; + goto done; } /* @@ -443,6 +745,7 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) endOfBase = end; } TkTextMakeCharIndex(textPtr->tree, lineIndex, charIndex, indexPtr); + canCache = 1; goto gotBase; } @@ -474,6 +777,7 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, indexPtr); + canCache = 1; goto gotBase; } else { /* @@ -532,6 +836,10 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) } } Tcl_DStringFree(©); + done: + if (canCachePtr != NULL) { + *canCachePtr = canCache; + } return TCL_OK; error: @@ -551,7 +859,8 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) * for reading in again later. * * Results: - * The characters pointed to by string are modified. + * The characters pointed to by string are modified. Returns the + * number of characters in the string. * * Side effects: * None. @@ -559,7 +868,7 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) *--------------------------------------------------------------------------- */ -void +int TkTextPrintIndex(indexPtr, string) CONST TkTextIndex *indexPtr;/* Pointer to index. */ char *string; /* Place to store the position. Must have @@ -586,7 +895,7 @@ TkTextPrintIndex(indexPtr, string) } else { charIndex += numBytes; } - sprintf(string, "%d.%d", TkBTreeLineIndex(indexPtr->linePtr) + 1, + return sprintf(string, "%d.%d", TkBTreeLineIndex(indexPtr->linePtr) + 1, charIndex); } diff --git a/generic/tkTextMark.c b/generic/tkTextMark.c index 4378112..8c17e4c 100644 --- a/generic/tkTextMark.c +++ b/generic/tkTextMark.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextMark.c,v 1.6 2002/08/05 04:30:40 dgp Exp $ + * RCS: @(#) $Id: tkTextMark.c,v 1.7 2003/05/19 13:04:23 vincentdarley Exp $ */ #include "tkInt.h" @@ -95,122 +95,139 @@ Tk_SegType tkTextLeftMarkType = { */ int -TkTextMarkCmd(textPtr, interp, argc, argv) +TkTextMarkCmd(textPtr, interp, objc, objv) register TkText *textPtr; /* Information about text widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. Someone else has already + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. Someone else has already * parsed this command enough to know that - * argv[1] is "mark". */ + * objv[1] is "mark". */ { - int c, i; - size_t length; Tcl_HashEntry *hPtr; TkTextSegment *markPtr; Tcl_HashSearch search; TkTextIndex index; Tk_SegType *newTypePtr; - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " mark option ?arg arg ...?\"", (char *) NULL); + int optionIndex; + + static CONST char *markOptionStrings[] = { + "gravity", "names", "next", "previous", "set", + "unset", (char *) NULL + }; + enum markOptions { + MARK_GRAVITY, MARK_NAMES, MARK_NEXT, MARK_PREVIOUS, + MARK_SET, MARK_UNSET + }; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?"); return TCL_ERROR; } - c = argv[2][0]; - length = strlen(argv[2]); - if ((c == 'g') && (strncmp(argv[2], "gravity", length) == 0)) { - if (argc < 4 || argc > 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " mark gravity markName ?gravity?\"", - (char *) NULL); - return TCL_ERROR; - } - hPtr = Tcl_FindHashEntry(&textPtr->markTable, argv[3]); - if (hPtr == NULL) { - Tcl_AppendResult(interp, "there is no mark named \"", - argv[3], "\"", (char *) NULL); - return TCL_ERROR; - } - markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); - if (argc == 4) { - if (markPtr->typePtr == &tkTextRightMarkType) { - Tcl_SetResult(interp, "right", TCL_STATIC); + if (Tcl_GetIndexFromObj(interp, objv[2], markOptionStrings, + "mark option", 0, &optionIndex) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum markOptions)optionIndex) { + case MARK_GRAVITY: { + char c; + int length; + char *str; + + if (objc < 4 || objc > 5) { + Tcl_WrongNumArgs(interp, 3, objv, "markName ?gravity?"); + return TCL_ERROR; + } + hPtr = Tcl_FindHashEntry(&textPtr->markTable, Tcl_GetString(objv[3])); + if (hPtr == NULL) { + Tcl_AppendResult(interp, "there is no mark named \"", + Tcl_GetString(objv[3]), "\"", (char *) NULL); + return TCL_ERROR; + } + markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); + if (objc == 4) { + if (markPtr->typePtr == &tkTextRightMarkType) { + Tcl_SetResult(interp, "right", TCL_STATIC); + } else { + Tcl_SetResult(interp, "left", TCL_STATIC); + } + return TCL_OK; + } + str = Tcl_GetStringFromObj(objv[4],&length); + c = str[0]; + if ((c == 'l') && (strncmp(str, "left", length) == 0)) { + newTypePtr = &tkTextLeftMarkType; + } else if ((c == 'r') && (strncmp(str, "right", length) == 0)) { + newTypePtr = &tkTextRightMarkType; } else { - Tcl_SetResult(interp, "left", TCL_STATIC); + Tcl_AppendResult(interp, "bad mark gravity \"", str, + "\": must be left or right", (char *) NULL); + return TCL_ERROR; } - return TCL_OK; - } - length = strlen(argv[4]); - c = argv[4][0]; - if ((c == 'l') && (strncmp(argv[4], "left", length) == 0)) { - newTypePtr = &tkTextLeftMarkType; - } else if ((c == 'r') && (strncmp(argv[4], "right", length) == 0)) { - newTypePtr = &tkTextRightMarkType; - } else { - Tcl_AppendResult(interp, "bad mark gravity \"", - argv[4], "\": must be left or right", (char *) NULL); - return TCL_ERROR; - } - TkTextMarkSegToIndex(textPtr, markPtr, &index); - TkBTreeUnlinkSegment(textPtr->tree, markPtr, - markPtr->body.mark.linePtr); - markPtr->typePtr = newTypePtr; - TkBTreeLinkSegment(markPtr, &index); - } else if ((c == 'n') && (strncmp(argv[2], "names", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " mark names\"", (char *) NULL); - return TCL_ERROR; + TkTextMarkSegToIndex(textPtr, markPtr, &index); + TkBTreeUnlinkSegment(textPtr->tree, markPtr, + markPtr->body.mark.linePtr); + markPtr->typePtr = newTypePtr; + TkBTreeLinkSegment(markPtr, &index); + break; } - for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendElement(interp, - Tcl_GetHashKey(&textPtr->markTable, hPtr)); - } - } else if ((c == 'n') && (strncmp(argv[2], "next", length) == 0)) { - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " mark next index\"", (char *) NULL); - return TCL_ERROR; + case MARK_NAMES: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + Tcl_AppendElement(interp, + Tcl_GetHashKey(&textPtr->markTable, hPtr)); + } + break; } - return MarkFindNext(interp, textPtr, argv[3]); - } else if ((c == 'p') && (strncmp(argv[2], "previous", length) == 0)) { - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " mark previous index\"", (char *) NULL); - return TCL_ERROR; + case MARK_NEXT: { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 3, objv, "index"); + return TCL_ERROR; + } + return MarkFindNext(interp, textPtr, Tcl_GetString(objv[3])); } - return MarkFindPrev(interp, textPtr, argv[3]); - } else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) { - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " mark set markName index\"", (char *) NULL); - return TCL_ERROR; + case MARK_PREVIOUS: { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 3, objv, "index"); + return TCL_ERROR; + } + return MarkFindPrev(interp, textPtr, Tcl_GetString(objv[3])); } - if (TkTextGetIndex(interp, textPtr, argv[4], &index) != TCL_OK) { - return TCL_ERROR; + case MARK_SET: { + if (objc != 5) { + Tcl_WrongNumArgs(interp, 3, objv, "markName index"); + return TCL_ERROR; + } + if (TkTextGetObjIndex(interp, textPtr, objv[4], &index) != TCL_OK) { + return TCL_ERROR; + } + TkTextSetMark(textPtr, Tcl_GetString(objv[3]), &index); + return TCL_OK; } - TkTextSetMark(textPtr, argv[3], &index); - } else if ((c == 'u') && (strncmp(argv[2], "unset", length) == 0)) { - for (i = 3; i < argc; i++) { - hPtr = Tcl_FindHashEntry(&textPtr->markTable, argv[i]); - if (hPtr != NULL) { - markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); - if ((markPtr == textPtr->insertMarkPtr) - || (markPtr == textPtr->currentMarkPtr)) { - continue; + case MARK_UNSET: { + int i; + for (i = 3; i < objc; i++) { + hPtr = Tcl_FindHashEntry(&textPtr->markTable, Tcl_GetString(objv[i])); + if (hPtr != NULL) { + markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); + if ((markPtr == textPtr->insertMarkPtr) + || (markPtr == textPtr->currentMarkPtr)) { + continue; + } + TkBTreeUnlinkSegment(textPtr->tree, markPtr, + markPtr->body.mark.linePtr); + Tcl_DeleteHashEntry(hPtr); + ckfree((char *) markPtr); } - TkBTreeUnlinkSegment(textPtr->tree, markPtr, - markPtr->body.mark.linePtr); - Tcl_DeleteHashEntry(hPtr); - ckfree((char *) markPtr); } + break; } - } else { - Tcl_AppendResult(interp, "bad mark option \"", argv[2], - "\": must be gravity, names, next, previous, set, or unset", - (char *) NULL); - return TCL_ERROR; + } return TCL_OK; } diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index 81fc5cb..fa8a2b9 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextTag.c,v 1.8 2002/08/05 04:30:40 dgp Exp $ + * RCS: @(#) $Id: tkTextTag.c,v 1.9 2003/05/19 13:04:24 vincentdarley Exp $ */ #include "default.h" @@ -19,54 +19,64 @@ #include "tkInt.h" #include "tkText.h" -static Tk_ConfigSpec tagConfigSpecs[] = { - {TK_CONFIG_BORDER, "-background", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, border), TK_CONFIG_NULL_OK}, - {TK_CONFIG_BITMAP, "-bgstipple", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, bgStipple), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-borderwidth", (char *) NULL, (char *) NULL, - "0", Tk_Offset(TkTextTag, bdString), - TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-elide", (char *) NULL, (char *) NULL, - "0", Tk_Offset(TkTextTag, elideString), - TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK}, - {TK_CONFIG_BITMAP, "-fgstipple", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, fgStipple), TK_CONFIG_NULL_OK}, - {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, tkfont), TK_CONFIG_NULL_OK}, - {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, fgColor), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-justify", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, justifyString), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-lmargin1", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, lMargin1String), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-lmargin2", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, lMargin2String), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-offset", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, offsetString), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-overstrike", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, overstrikeString), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-relief", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, reliefString), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-rmargin", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, rMarginString), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-spacing1", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, spacing1String), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-spacing2", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, spacing2String), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-spacing3", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, spacing3String), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-tabs", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, tabString), TK_CONFIG_NULL_OK}, - {TK_CONFIG_STRING, "-underline", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, underlineString), - TK_CONFIG_NULL_OK}, - {TK_CONFIG_CUSTOM, "-wrap", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextTag, wrapMode), - TK_CONFIG_NULL_OK, &textWrapModeOption}, - {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, 0} +/* + * The 'TkWrapMode' enum in tkText.h is used to define a type for the + * -wrap option of tags in a Text widget. These values are used as + * indices into the string table below. Tags are allowed an empty wrap + * value, but the widget as a whole is not. + */ + +static char *wrapStrings[] = { + "char", "none", "word", "", (char *) NULL +}; + +static Tk_OptionSpec tagOptionSpecs[] = { + {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, border), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BITMAP, "-bgstipple", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, bgStipple), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-borderwidth", (char *) NULL, (char *) NULL, + "0", Tk_Offset(TkTextTag, borderWidthPtr), Tk_Offset(TkTextTag, borderWidth), + TK_OPTION_DONT_SET_DEFAULT|TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-elide", (char *) NULL, (char *) NULL, + "0", -1, Tk_Offset(TkTextTag, elideString), + TK_OPTION_DONT_SET_DEFAULT|TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_BITMAP, "-fgstipple", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, fgStipple), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_FONT, "-font", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, tkfont), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_COLOR, "-foreground", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, fgColor), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-justify", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, justifyString), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-lmargin1", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, lMargin1String), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-lmargin2", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, lMargin2String), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-offset", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, offsetString), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-overstrike", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, overstrikeString), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-relief", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, reliefString), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-rmargin", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, rMarginString), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-spacing1", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, spacing1String), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-spacing2", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, spacing2String), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-spacing3", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, spacing3String), TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-tabs", (char *) NULL, (char *) NULL, + (char *) NULL, Tk_Offset(TkTextTag, tabStringPtr), -1, TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING, "-underline", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, underlineString), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_STRING_TABLE, "-wrap", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextTag, wrapMode), + TK_OPTION_NULL_OK, (ClientData) wrapStrings, 0}, + {TK_OPTION_END} }; /* @@ -76,7 +86,7 @@ static Tk_ConfigSpec tagConfigSpecs[] = { static void ChangeTagPriority _ANSI_ARGS_((TkText *textPtr, TkTextTag *tagPtr, int prio)); static TkTextTag * FindTag _ANSI_ARGS_((Tcl_Interp *interp, - TkText *textPtr, CONST char *tagName)); + TkText *textPtr, Tcl_Obj *tagName)); static void SortTags _ANSI_ARGS_((int numTags, TkTextTag **tagArrayPtr)); static int TagSortProc _ANSI_ARGS_((CONST VOID *first, @@ -101,684 +111,697 @@ static int TagSortProc _ANSI_ARGS_((CONST VOID *first, */ int -TkTextTagCmd(textPtr, interp, argc, argv) +TkTextTagCmd(textPtr, interp, objc, objv) register TkText *textPtr; /* Information about text widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. Someone else has already + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. Someone else has already * parsed this command enough to know that - * argv[1] is "tag". */ + * objv[1] is "tag". */ { - int c, i, addTag; - size_t length; - char *fullOption; + int optionIndex; + + static CONST char *tagOptionStrings[] = { + "add", "bind", "cget", "configure", "delete", "lower", + "names", "nextrange", "prevrange", "raise", "ranges", + "remove", (char *) NULL + }; + enum tagOptions { + TAG_ADD, TAG_BIND, TAG_CGET, TAG_CONFIGURE, TAG_DELETE, + TAG_LOWER, TAG_NAMES, TAG_NEXTRANGE, TAG_PREVRANGE, + TAG_RAISE, TAG_RANGES, TAG_REMOVE + }; + + int i; register TkTextTag *tagPtr; TkTextIndex first, last, index1, index2; - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " tag option ?arg arg ...?\"", (char *) NULL); + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?"); return TCL_ERROR; } - c = argv[2][0]; - length = strlen(argv[2]); - if ((c == 'a') && (strncmp(argv[2], "add", length) == 0)) { - fullOption = "add"; - addTag = 1; - - addAndRemove: - if (argc < 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " tag ", fullOption, - " tagName index1 ?index2 index1 index2 ...?\"", - (char *) NULL); - return TCL_ERROR; - } - tagPtr = TkTextCreateTag(textPtr, argv[3]); - for (i = 4; i < argc; i += 2) { - if (TkTextGetIndex(interp, textPtr, argv[i], &index1) != TCL_OK) { + + if (Tcl_GetIndexFromObj(interp, objv[2], tagOptionStrings, + "tag option", 0, &optionIndex) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum tagOptions)optionIndex) { + case TAG_ADD: + case TAG_REMOVE: { + int addTag; + if (((enum tagOptions)optionIndex) == TAG_ADD) { + addTag = 1; + } else { + addTag = 0; + } + if (objc < 5) { + Tcl_WrongNumArgs(interp, 3, objv, + "tagName index1 ?index2 index1 index2 ...?"); return TCL_ERROR; } - if (argc > (i+1)) { - if (TkTextGetIndex(interp, textPtr, argv[i+1], &index2) - != TCL_OK) { + tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3])); + for (i = 4; i < objc; i += 2) { + if (TkTextGetObjIndex(interp, textPtr, objv[i], &index1) != TCL_OK) { return TCL_ERROR; } - if (TkTextIndexCmp(&index1, &index2) >= 0) { - return TCL_OK; + if (objc > (i+1)) { + if (TkTextGetObjIndex(interp, textPtr, objv[i+1], &index2) + != TCL_OK) { + return TCL_ERROR; + } + if (TkTextIndexCmp(&index1, &index2) >= 0) { + return TCL_OK; + } + } else { + index2 = index1; + TkTextIndexForwChars(&index2, 1, &index2); } - } else { - index2 = index1; - TkTextIndexForwChars(&index2, 1, &index2); - } - - if (tagPtr->affectsDisplay) { - TkTextRedrawTag(textPtr, &index1, &index2, tagPtr, !addTag); - } else { - /* - * Still need to trigger enter/leave events on tags that - * have changed. - */ - TkTextEventuallyRepick(textPtr); - } - TkBTreeTag(&index1, &index2, tagPtr, addTag); + if (tagPtr->affectsDisplay) { + TkTextRedrawTag(textPtr, &index1, &index2, tagPtr, !addTag); + } else { + /* + * Still need to trigger enter/leave events on tags that + * have changed. + */ - /* - * If the tag is "sel" then grab the selection if we're supposed - * to export it and don't already have it. Also, invalidate - * partially-completed selection retrievals. - */ + TkTextEventuallyRepick(textPtr); + } + TkBTreeTag(&index1, &index2, tagPtr, addTag); - if (tagPtr == textPtr->selTagPtr) { - XEvent event; /* - * Send an event that the selection changed. - * This is equivalent to - * "event generate $textWidget <>" + * If the tag is "sel" then grab the selection if we're supposed + * to export it and don't already have it. Also, invalidate + * partially-completed selection retrievals. */ - memset((VOID *) &event, 0, sizeof(event)); - event.xany.type = VirtualEvent; - event.xany.serial = NextRequest(Tk_Display(textPtr->tkwin)); - event.xany.send_event = False; - event.xany.window = Tk_WindowId(textPtr->tkwin); - event.xany.display = Tk_Display(textPtr->tkwin); - ((XVirtualEvent *) &event)->name = Tk_GetUid("Selection"); - Tk_HandleEvent(&event); - - if (addTag && textPtr->exportSelection - && !(textPtr->flags & GOT_SELECTION)) { - Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, - TkTextLostSelection, (ClientData) textPtr); - textPtr->flags |= GOT_SELECTION; + if (tagPtr == textPtr->selTagPtr) { + XEvent event; + /* + * Send an event that the selection changed. + * This is equivalent to + * "event generate $textWidget <>" + */ + + memset((VOID *) &event, 0, sizeof(event)); + event.xany.type = VirtualEvent; + event.xany.serial = NextRequest(Tk_Display(textPtr->tkwin)); + event.xany.send_event = False; + event.xany.window = Tk_WindowId(textPtr->tkwin); + event.xany.display = Tk_Display(textPtr->tkwin); + ((XVirtualEvent *) &event)->name = Tk_GetUid("Selection"); + Tk_HandleEvent(&event); + + if (addTag && textPtr->exportSelection + && !(textPtr->flags & GOT_SELECTION)) { + Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, + TkTextLostSelection, (ClientData) textPtr); + textPtr->flags |= GOT_SELECTION; + } + textPtr->abortSelections = 1; } - textPtr->abortSelections = 1; } + break; } - } else if ((c == 'b') && (strncmp(argv[2], "bind", length) == 0)) { - if ((argc < 4) || (argc > 6)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " tag bind tagName ?sequence? ?command?\"", - (char *) NULL); - return TCL_ERROR; - } - tagPtr = TkTextCreateTag(textPtr, argv[3]); + case TAG_BIND: { + if ((objc < 4) || (objc > 6)) { + Tcl_WrongNumArgs(interp, 3, objv, "tagName ?sequence? ?command?"); + return TCL_ERROR; + } + tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3])); - /* - * Make a binding table if the widget doesn't already have - * one. - */ + /* + * Make a binding table if the widget doesn't already have + * one. + */ - if (textPtr->bindingTable == NULL) { - textPtr->bindingTable = Tk_CreateBindingTable(interp); - } + if (textPtr->bindingTable == NULL) { + textPtr->bindingTable = Tk_CreateBindingTable(interp); + } - if (argc == 6) { - int append = 0; - unsigned long mask; + if (objc == 6) { + int append = 0; + unsigned long mask; + char *fifth = Tcl_GetString(objv[5]); - if (argv[5][0] == 0) { - return Tk_DeleteBinding(interp, textPtr->bindingTable, - (ClientData) tagPtr, argv[4]); - } - if (argv[5][0] == '+') { - argv[5]++; - append = 1; + if (fifth[0] == 0) { + return Tk_DeleteBinding(interp, textPtr->bindingTable, + (ClientData) tagPtr, Tcl_GetString(objv[4])); + } + if (fifth[0] == '+') { + fifth++; + append = 1; + } + mask = Tk_CreateBinding(interp, textPtr->bindingTable, + (ClientData) tagPtr, Tcl_GetString(objv[4]), + fifth, append); + if (mask == 0) { + return TCL_ERROR; + } + if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask + |Button2MotionMask|Button3MotionMask|Button4MotionMask + |Button5MotionMask|ButtonPressMask|ButtonReleaseMask + |EnterWindowMask|LeaveWindowMask|KeyPressMask + |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) { + Tk_DeleteBinding(interp, textPtr->bindingTable, + (ClientData) tagPtr, Tcl_GetString(objv[4])); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "requested illegal events; ", + "only key, button, motion, enter, leave, and virtual ", + "events may be used", (char *) NULL); + return TCL_ERROR; + } + } else if (objc == 5) { + CONST char *command; + + command = Tk_GetBinding(interp, textPtr->bindingTable, + (ClientData) tagPtr, Tcl_GetString(objv[4])); + if (command == NULL) { + CONST char *string = Tcl_GetStringResult(interp); + + /* + * Ignore missing binding errors. This is a special hack + * that relies on the error message returned by FindSequence + * in tkBind.c. + */ + + if (string[0] != '\0') { + return TCL_ERROR; + } else { + Tcl_ResetResult(interp); + } + } else { + Tcl_SetResult(interp, (char *) command, TCL_STATIC); + } + } else { + Tk_GetAllBindings(interp, textPtr->bindingTable, + (ClientData) tagPtr); } - mask = Tk_CreateBinding(interp, textPtr->bindingTable, - (ClientData) tagPtr, argv[4], argv[5], append); - if (mask == 0) { + break; + } + case TAG_CGET: { + if (objc != 5) { + Tcl_WrongNumArgs(interp, 1, objv, "tag cget tagName option"); return TCL_ERROR; + } else { + Tcl_Obj *objPtr; + + tagPtr = FindTag(interp, textPtr, objv[3]); + if (tagPtr == NULL) { + return TCL_ERROR; + } + objPtr = Tk_GetOptionValue(interp, (char *) tagPtr, + tagPtr->optionTable, objv[4], textPtr->tkwin); + if (objPtr == NULL) { + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, objPtr); + return TCL_OK; + } } - if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask - |Button2MotionMask|Button3MotionMask|Button4MotionMask - |Button5MotionMask|ButtonPressMask|ButtonReleaseMask - |EnterWindowMask|LeaveWindowMask|KeyPressMask - |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) { - Tk_DeleteBinding(interp, textPtr->bindingTable, - (ClientData) tagPtr, argv[4]); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "requested illegal events; ", - "only key, button, motion, enter, leave, and virtual ", - "events may be used", (char *) NULL); + break; + } + case TAG_CONFIGURE: { + if (objc < 4) { + Tcl_WrongNumArgs(interp, 3, objv, "tagName ?option? ?value? ?option value ...?"); return TCL_ERROR; } - } else if (argc == 5) { - CONST char *command; - - command = Tk_GetBinding(interp, textPtr->bindingTable, - (ClientData) tagPtr, argv[4]); - if (command == NULL) { - CONST char *string = Tcl_GetStringResult(interp); - - /* - * Ignore missing binding errors. This is a special hack - * that relies on the error message returned by FindSequence - * in tkBind.c. - */ - - if (string[0] != '\0') { + tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3])); + if (objc <= 5) { + Tcl_Obj* objPtr = Tk_GetOptionInfo(interp, (char *) tagPtr, + tagPtr->optionTable, + (objc == 5) ? objv[4] : (Tcl_Obj *) NULL, + textPtr->tkwin); + if (objPtr == NULL) { return TCL_ERROR; } else { - Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, objPtr); + return TCL_OK; } } else { - Tcl_SetResult(interp, (char *) command, TCL_STATIC); - } - } else { - Tk_GetAllBindings(interp, textPtr->bindingTable, - (ClientData) tagPtr); - } - } else if ((c == 'c') && (strncmp(argv[2], "cget", length) == 0) - && (length >= 2)) { - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " tag cget tagName option\"", - (char *) NULL); - return TCL_ERROR; - } - tagPtr = FindTag(interp, textPtr, argv[3]); - if (tagPtr == NULL) { - return TCL_ERROR; - } - return Tk_ConfigureValue(interp, textPtr->tkwin, tagConfigSpecs, - (char *) tagPtr, argv[4], 0); - } else if ((c == 'c') && (strncmp(argv[2], "configure", length) == 0) - && (length >= 2)) { - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " tag configure tagName ?option? ?value? ", - "?option value ...?\"", (char *) NULL); - return TCL_ERROR; - } - tagPtr = TkTextCreateTag(textPtr, argv[3]); - if (argc == 4) { - return Tk_ConfigureInfo(interp, textPtr->tkwin, tagConfigSpecs, - (char *) tagPtr, (char *) NULL, 0); - } else if (argc == 5) { - return Tk_ConfigureInfo(interp, textPtr->tkwin, tagConfigSpecs, - (char *) tagPtr, argv[4], 0); - } else { - int result; + int result = TCL_OK; - result = Tk_ConfigureWidget(interp, textPtr->tkwin, tagConfigSpecs, - argc-4, argv+4, (char *) tagPtr, 0); - /* - * Some of the configuration options, like -underline - * and -justify, require additional translation (this is - * needed because we need to distinguish a particular value - * of an option from "unspecified"). - */ - - if (tagPtr->bdString != NULL) { - if (Tk_GetPixels(interp, textPtr->tkwin, tagPtr->bdString, - &tagPtr->borderWidth) != TCL_OK) { + if (Tk_SetOptions(interp, (char*)tagPtr, tagPtr->optionTable, + objc-4, objv+4, textPtr->tkwin, NULL, NULL) != TCL_OK) { return TCL_ERROR; } + /* + * Some of the configuration options, like -underline + * and -justify, require additional translation (this is + * needed because we need to distinguish a particular value + * of an option from "unspecified"). + */ + if (tagPtr->borderWidth < 0) { tagPtr->borderWidth = 0; } - } - if (tagPtr->reliefString != NULL) { - if (Tk_GetRelief(interp, tagPtr->reliefString, - &tagPtr->relief) != TCL_OK) { - return TCL_ERROR; + if (tagPtr->reliefString != NULL) { + if (Tk_GetRelief(interp, tagPtr->reliefString, + &tagPtr->relief) != TCL_OK) { + return TCL_ERROR; + } } - } - if (tagPtr->justifyString != NULL) { - if (Tk_GetJustify(interp, tagPtr->justifyString, - &tagPtr->justify) != TCL_OK) { - return TCL_ERROR; + if (tagPtr->justifyString != NULL) { + if (Tk_GetJustify(interp, tagPtr->justifyString, + &tagPtr->justify) != TCL_OK) { + return TCL_ERROR; + } } - } - if (tagPtr->lMargin1String != NULL) { - if (Tk_GetPixels(interp, textPtr->tkwin, - tagPtr->lMargin1String, &tagPtr->lMargin1) != TCL_OK) { - return TCL_ERROR; + if (tagPtr->lMargin1String != NULL) { + if (Tk_GetPixels(interp, textPtr->tkwin, + tagPtr->lMargin1String, &tagPtr->lMargin1) != TCL_OK) { + return TCL_ERROR; + } } - } - if (tagPtr->lMargin2String != NULL) { - if (Tk_GetPixels(interp, textPtr->tkwin, - tagPtr->lMargin2String, &tagPtr->lMargin2) != TCL_OK) { - return TCL_ERROR; + if (tagPtr->lMargin2String != NULL) { + if (Tk_GetPixels(interp, textPtr->tkwin, + tagPtr->lMargin2String, &tagPtr->lMargin2) != TCL_OK) { + return TCL_ERROR; + } } - } - if (tagPtr->offsetString != NULL) { - if (Tk_GetPixels(interp, textPtr->tkwin, tagPtr->offsetString, - &tagPtr->offset) != TCL_OK) { - return TCL_ERROR; + if (tagPtr->offsetString != NULL) { + if (Tk_GetPixels(interp, textPtr->tkwin, tagPtr->offsetString, + &tagPtr->offset) != TCL_OK) { + return TCL_ERROR; + } } - } - if (tagPtr->overstrikeString != NULL) { - if (Tcl_GetBoolean(interp, tagPtr->overstrikeString, - &tagPtr->overstrike) != TCL_OK) { - return TCL_ERROR; + if (tagPtr->overstrikeString != NULL) { + if (Tcl_GetBoolean(interp, tagPtr->overstrikeString, + &tagPtr->overstrike) != TCL_OK) { + return TCL_ERROR; + } } - } - if (tagPtr->rMarginString != NULL) { - if (Tk_GetPixels(interp, textPtr->tkwin, - tagPtr->rMarginString, &tagPtr->rMargin) != TCL_OK) { - return TCL_ERROR; + if (tagPtr->rMarginString != NULL) { + if (Tk_GetPixels(interp, textPtr->tkwin, + tagPtr->rMarginString, &tagPtr->rMargin) != TCL_OK) { + return TCL_ERROR; + } } - } - if (tagPtr->spacing1String != NULL) { - if (Tk_GetPixels(interp, textPtr->tkwin, - tagPtr->spacing1String, &tagPtr->spacing1) != TCL_OK) { - return TCL_ERROR; + if (tagPtr->spacing1String != NULL) { + if (Tk_GetPixels(interp, textPtr->tkwin, + tagPtr->spacing1String, &tagPtr->spacing1) != TCL_OK) { + return TCL_ERROR; + } + if (tagPtr->spacing1 < 0) { + tagPtr->spacing1 = 0; + } } - if (tagPtr->spacing1 < 0) { - tagPtr->spacing1 = 0; + if (tagPtr->spacing2String != NULL) { + if (Tk_GetPixels(interp, textPtr->tkwin, + tagPtr->spacing2String, &tagPtr->spacing2) != TCL_OK) { + return TCL_ERROR; + } + if (tagPtr->spacing2 < 0) { + tagPtr->spacing2 = 0; + } } - } - if (tagPtr->spacing2String != NULL) { - if (Tk_GetPixels(interp, textPtr->tkwin, - tagPtr->spacing2String, &tagPtr->spacing2) != TCL_OK) { - return TCL_ERROR; + if (tagPtr->spacing3String != NULL) { + if (Tk_GetPixels(interp, textPtr->tkwin, + tagPtr->spacing3String, &tagPtr->spacing3) != TCL_OK) { + return TCL_ERROR; + } + if (tagPtr->spacing3 < 0) { + tagPtr->spacing3 = 0; + } } - if (tagPtr->spacing2 < 0) { - tagPtr->spacing2 = 0; + if (tagPtr->tabArrayPtr != NULL) { + ckfree((char *) tagPtr->tabArrayPtr); + tagPtr->tabArrayPtr = NULL; } - } - if (tagPtr->spacing3String != NULL) { - if (Tk_GetPixels(interp, textPtr->tkwin, - tagPtr->spacing3String, &tagPtr->spacing3) != TCL_OK) { - return TCL_ERROR; + if (tagPtr->tabStringPtr != NULL) { + tagPtr->tabArrayPtr = TkTextGetTabs(interp, textPtr->tkwin, + tagPtr->tabStringPtr); + if (tagPtr->tabArrayPtr == NULL) { + return TCL_ERROR; + } + } + if (tagPtr->underlineString != NULL) { + if (Tcl_GetBoolean(interp, tagPtr->underlineString, + &tagPtr->underline) != TCL_OK) { + return TCL_ERROR; + } } - if (tagPtr->spacing3 < 0) { - tagPtr->spacing3 = 0; + if (tagPtr->elideString != NULL) { + if (Tcl_GetBoolean(interp, tagPtr->elideString, + &tagPtr->elide) != TCL_OK) { + return TCL_ERROR; + } } + + /* + * If the "sel" tag was changed, be sure to mirror information + * from the tag back into the text widget record. NOTE: we + * don't have to free up information in the widget record + * before overwriting it, because it was mirrored in the tag + * and hence freed when the tag field was overwritten. + */ + + if (tagPtr == textPtr->selTagPtr) { + textPtr->selBorder = tagPtr->border; + textPtr->selBorderWidth = tagPtr->borderWidth; + textPtr->selBorderWidthPtr = tagPtr->borderWidthPtr; + textPtr->selFgColorPtr = tagPtr->fgColor; + } + tagPtr->affectsDisplay = 0; + if ((tagPtr->border != NULL) + || (tagPtr->reliefString != NULL) + || (tagPtr->bgStipple != None) + || (tagPtr->fgColor != NULL) || (tagPtr->tkfont != None) + || (tagPtr->fgStipple != None) + || (tagPtr->justifyString != NULL) + || (tagPtr->lMargin1String != NULL) + || (tagPtr->lMargin2String != NULL) + || (tagPtr->offsetString != NULL) + || (tagPtr->overstrikeString != NULL) + || (tagPtr->rMarginString != NULL) + || (tagPtr->spacing1String != NULL) + || (tagPtr->spacing2String != NULL) + || (tagPtr->spacing3String != NULL) + || (tagPtr->tabStringPtr != NULL) + || (tagPtr->underlineString != NULL) + || (tagPtr->elideString != NULL) + || (tagPtr->wrapMode != TEXT_WRAPMODE_NULL)) { + tagPtr->affectsDisplay = 1; + } + TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, + (TkTextIndex *) NULL, tagPtr, 1); + return result; } - if (tagPtr->tabArrayPtr != NULL) { - ckfree((char *) tagPtr->tabArrayPtr); - tagPtr->tabArrayPtr = NULL; + break; + } + case TAG_DELETE: { + Tcl_HashEntry *hPtr; + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 3, objv, "tagName ?tagName ...?"); + return TCL_ERROR; } - if (tagPtr->tabString != NULL) { - tagPtr->tabArrayPtr = TkTextGetTabs(interp, textPtr->tkwin, - tagPtr->tabString); - if (tagPtr->tabArrayPtr == NULL) { - return TCL_ERROR; + for (i = 3; i < objc; i++) { + hPtr = Tcl_FindHashEntry(&textPtr->tagTable, Tcl_GetString(objv[i])); + if (hPtr == NULL) { + continue; } - } - if (tagPtr->underlineString != NULL) { - if (Tcl_GetBoolean(interp, tagPtr->underlineString, - &tagPtr->underline) != TCL_OK) { - return TCL_ERROR; + tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr); + if (tagPtr == textPtr->selTagPtr) { + continue; + } + if (tagPtr->affectsDisplay) { + TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, + (TkTextIndex *) NULL, tagPtr, 1); + } + TkTextMakeByteIndex(textPtr->tree, 0, 0, &first); + TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), + 0, &last), + TkBTreeTag(&first, &last, tagPtr, 0); + + if (tagPtr == textPtr->selTagPtr) { + XEvent event; + /* + * Send an event that the selection changed. + * This is equivalent to + * "event generate $textWidget <>" + */ + + memset((VOID *) &event, 0, sizeof(event)); + event.xany.type = VirtualEvent; + event.xany.serial = NextRequest(Tk_Display(textPtr->tkwin)); + event.xany.send_event = False; + event.xany.window = Tk_WindowId(textPtr->tkwin); + event.xany.display = Tk_Display(textPtr->tkwin); + ((XVirtualEvent *) &event)->name = Tk_GetUid("Selection"); + Tk_HandleEvent(&event); + } + + Tcl_DeleteHashEntry(hPtr); + if (textPtr->bindingTable != NULL) { + Tk_DeleteAllBindings(textPtr->bindingTable, + (ClientData) tagPtr); } + + /* + * Update the tag priorities to reflect the deletion of this tag. + */ + + ChangeTagPriority(textPtr, tagPtr, textPtr->numTags-1); + textPtr->numTags -= 1; + TkTextFreeTag(textPtr, tagPtr); + } + break; + } + case TAG_LOWER: { + TkTextTag *tagPtr2; + int prio; + + if ((objc != 4) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 3, objv, "tagName ?belowThis?"); + return TCL_ERROR; } - if (tagPtr->elideString != NULL) { - if (Tcl_GetBoolean(interp, tagPtr->elideString, - &tagPtr->elide) != TCL_OK) { + tagPtr = FindTag(interp, textPtr, objv[3]); + if (tagPtr == NULL) { + return TCL_ERROR; + } + if (objc == 5) { + tagPtr2 = FindTag(interp, textPtr, objv[4]); + if (tagPtr2 == NULL) { return TCL_ERROR; } + if (tagPtr->priority < tagPtr2->priority) { + prio = tagPtr2->priority - 1; + } else { + prio = tagPtr2->priority; + } + } else { + prio = 0; } + ChangeTagPriority(textPtr, tagPtr, prio); + TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL, + tagPtr, 1); + break; + } + case TAG_NAMES: { + TkTextTag **arrayPtr; + int arraySize; - /* - * If the "sel" tag was changed, be sure to mirror information - * from the tag back into the text widget record. NOTE: we - * don't have to free up information in the widget record - * before overwriting it, because it was mirrored in the tag - * and hence freed when the tag field was overwritten. - */ - - if (tagPtr == textPtr->selTagPtr) { - textPtr->selBorder = tagPtr->border; - textPtr->selBdString = tagPtr->bdString; - textPtr->selFgColorPtr = tagPtr->fgColor; + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 3, objv, "?index?"); + return TCL_ERROR; } - tagPtr->affectsDisplay = 0; - if ((tagPtr->border != NULL) - || (tagPtr->bdString != NULL) - || (tagPtr->reliefString != NULL) - || (tagPtr->bgStipple != None) - || (tagPtr->fgColor != NULL) || (tagPtr->tkfont != None) - || (tagPtr->fgStipple != None) - || (tagPtr->justifyString != NULL) - || (tagPtr->lMargin1String != NULL) - || (tagPtr->lMargin2String != NULL) - || (tagPtr->offsetString != NULL) - || (tagPtr->overstrikeString != NULL) - || (tagPtr->rMarginString != NULL) - || (tagPtr->spacing1String != NULL) - || (tagPtr->spacing2String != NULL) - || (tagPtr->spacing3String != NULL) - || (tagPtr->tabString != NULL) - || (tagPtr->underlineString != NULL) - || (tagPtr->elideString != NULL) - || (tagPtr->wrapMode != TEXT_WRAPMODE_NULL)) { - tagPtr->affectsDisplay = 1; + if (objc == 3) { + Tcl_HashSearch search; + Tcl_HashEntry *hPtr; + + arrayPtr = (TkTextTag **) ckalloc((unsigned) + (textPtr->numTags * sizeof(TkTextTag *))); + for (i = 0, hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search); + hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) { + arrayPtr[i] = (TkTextTag *) Tcl_GetHashValue(hPtr); + } + arraySize = textPtr->numTags; + } else { + if (TkTextGetObjIndex(interp, textPtr, objv[3], &index1) + != TCL_OK) { + return TCL_ERROR; + } + arrayPtr = TkBTreeGetTags(&index1, &arraySize); + if (arrayPtr == NULL) { + return TCL_OK; + } } - TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, - (TkTextIndex *) NULL, tagPtr, 1); - return result; - } - } else if ((c == 'd') && (strncmp(argv[2], "delete", length) == 0)) { - Tcl_HashEntry *hPtr; - - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " tag delete tagName tagName ...\"", - (char *) NULL); - return TCL_ERROR; + SortTags(arraySize, arrayPtr); + for (i = 0; i < arraySize; i++) { + tagPtr = arrayPtr[i]; + Tcl_AppendElement(interp, tagPtr->name); + } + ckfree((char *) arrayPtr); + break; } - for (i = 3; i < argc; i++) { - hPtr = Tcl_FindHashEntry(&textPtr->tagTable, argv[i]); - if (hPtr == NULL) { - continue; + case TAG_NEXTRANGE: { + TkTextSearch tSearch; + char position[TK_POS_CHARS]; + + if ((objc != 5) && (objc != 6)) { + Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?"); + return TCL_ERROR; } - tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr); - if (tagPtr == textPtr->selTagPtr) { - continue; + tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, objv[3]); + if (tagPtr == NULL) { + return TCL_OK; } - if (tagPtr->affectsDisplay) { - TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, - (TkTextIndex *) NULL, tagPtr, 1); + if (TkTextGetObjIndex(interp, textPtr, objv[4], &index1) != TCL_OK) { + return TCL_ERROR; } - TkTextMakeByteIndex(textPtr->tree, 0, 0, &first); TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), - 0, &last), - TkBTreeTag(&first, &last, tagPtr, 0); + 0, &last); + if (objc == 5) { + index2 = last; + } else if (TkTextGetObjIndex(interp, textPtr, objv[5], &index2) + != TCL_OK) { + return TCL_ERROR; + } + + /* + * The search below is a bit tricky. Rather than use the B-tree + * facilities to stop the search at index2, let it search up + * until the end of the file but check for a position past index2 + * ourselves. The reason for doing it this way is that we only + * care whether the *start* of the range is before index2; once + * we find the start, we don't want TkBTreeNextTag to abort the + * search because the end of the range is after index2. + */ + + TkBTreeStartSearch(&index1, &last, tagPtr, &tSearch); + if (TkBTreeCharTagged(&index1, tagPtr)) { + TkTextSegment *segPtr; + int offset; - if (tagPtr == textPtr->selTagPtr) { - XEvent event; /* - * Send an event that the selection changed. - * This is equivalent to - * "event generate $textWidget <>" + * The first character is tagged. See if there is an + * on-toggle just before the character. If not, then + * skip to the end of this tagged range. */ - memset((VOID *) &event, 0, sizeof(event)); - event.xany.type = VirtualEvent; - event.xany.serial = NextRequest(Tk_Display(textPtr->tkwin)); - event.xany.send_event = False; - event.xany.window = Tk_WindowId(textPtr->tkwin); - event.xany.display = Tk_Display(textPtr->tkwin); - ((XVirtualEvent *) &event)->name = Tk_GetUid("Selection"); - Tk_HandleEvent(&event); + for (segPtr = index1.linePtr->segPtr, offset = index1.byteIndex; + offset >= 0; + offset -= segPtr->size, segPtr = segPtr->nextPtr) { + if ((offset == 0) && (segPtr->typePtr == &tkTextToggleOnType) + && (segPtr->body.toggle.tagPtr == tagPtr)) { + goto gotStart; + } + } + if (!TkBTreeNextTag(&tSearch)) { + return TCL_OK; + } } - Tcl_DeleteHashEntry(hPtr); - if (textPtr->bindingTable != NULL) { - Tk_DeleteAllBindings(textPtr->bindingTable, - (ClientData) tagPtr); - } - /* - * Update the tag priorities to reflect the deletion of this tag. + * Find the start of the tagged range. */ - ChangeTagPriority(textPtr, tagPtr, textPtr->numTags-1); - textPtr->numTags -= 1; - TkTextFreeTag(textPtr, tagPtr); - } - } else if ((c == 'l') && (strncmp(argv[2], "lower", length) == 0)) { - TkTextTag *tagPtr2; - int prio; - - if ((argc != 4) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " tag lower tagName ?belowThis?\"", - (char *) NULL); - return TCL_ERROR; - } - tagPtr = FindTag(interp, textPtr, argv[3]); - if (tagPtr == NULL) { - return TCL_ERROR; - } - if (argc == 5) { - tagPtr2 = FindTag(interp, textPtr, argv[4]); - if (tagPtr2 == NULL) { - return TCL_ERROR; + if (!TkBTreeNextTag(&tSearch)) { + return TCL_OK; } - if (tagPtr->priority < tagPtr2->priority) { - prio = tagPtr2->priority - 1; - } else { - prio = tagPtr2->priority; + gotStart: + if (TkTextIndexCmp(&tSearch.curIndex, &index2) >= 0) { + return TCL_OK; } - } else { - prio = 0; - } - ChangeTagPriority(textPtr, tagPtr, prio); - TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL, - tagPtr, 1); - } else if ((c == 'n') && (strncmp(argv[2], "names", length) == 0) - && (length >= 2)) { - TkTextTag **arrayPtr; - int arraySize; - - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " tag names ?index?\"", - (char *) NULL); - return TCL_ERROR; + TkTextPrintIndex(&tSearch.curIndex, position); + Tcl_AppendElement(interp, position); + TkBTreeNextTag(&tSearch); + TkTextPrintIndex(&tSearch.curIndex, position); + Tcl_AppendElement(interp, position); + break; } - if (argc == 3) { - Tcl_HashSearch search; - Tcl_HashEntry *hPtr; + case TAG_PREVRANGE: { + TkTextSearch tSearch; + char position1[TK_POS_CHARS]; + char position2[TK_POS_CHARS]; - arrayPtr = (TkTextTag **) ckalloc((unsigned) - (textPtr->numTags * sizeof(TkTextTag *))); - for (i = 0, hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search); - hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) { - arrayPtr[i] = (TkTextTag *) Tcl_GetHashValue(hPtr); - } - arraySize = textPtr->numTags; - } else { - if (TkTextGetIndex(interp, textPtr, argv[3], &index1) - != TCL_OK) { + if ((objc != 5) && (objc != 6)) { + Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?"); return TCL_ERROR; } - arrayPtr = TkBTreeGetTags(&index1, &arraySize); - if (arrayPtr == NULL) { + tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, objv[3]); + if (tagPtr == NULL) { return TCL_OK; } - } - SortTags(arraySize, arrayPtr); - for (i = 0; i < arraySize; i++) { - tagPtr = arrayPtr[i]; - Tcl_AppendElement(interp, tagPtr->name); - } - ckfree((char *) arrayPtr); - } else if ((c == 'n') && (strncmp(argv[2], "nextrange", length) == 0) - && (length >= 2)) { - TkTextSearch tSearch; - char position[TK_POS_CHARS]; - - if ((argc != 5) && (argc != 6)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " tag nextrange tagName index1 ?index2?\"", - (char *) NULL); - return TCL_ERROR; - } - tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, argv[3]); - if (tagPtr == NULL) { - return TCL_OK; - } - if (TkTextGetIndex(interp, textPtr, argv[4], &index1) != TCL_OK) { - return TCL_ERROR; - } - TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), - 0, &last); - if (argc == 5) { - index2 = last; - } else if (TkTextGetIndex(interp, textPtr, argv[5], &index2) - != TCL_OK) { - return TCL_ERROR; - } - - /* - * The search below is a bit tricky. Rather than use the B-tree - * facilities to stop the search at index2, let it search up - * until the end of the file but check for a position past index2 - * ourselves. The reason for doing it this way is that we only - * care whether the *start* of the range is before index2; once - * we find the start, we don't want TkBTreeNextTag to abort the - * search because the end of the range is after index2. - */ - - TkBTreeStartSearch(&index1, &last, tagPtr, &tSearch); - if (TkBTreeCharTagged(&index1, tagPtr)) { - TkTextSegment *segPtr; - int offset; + if (TkTextGetObjIndex(interp, textPtr, objv[4], &index1) != TCL_OK) { + return TCL_ERROR; + } + if (objc == 5) { + TkTextMakeByteIndex(textPtr->tree, 0, 0, &index2); + } else if (TkTextGetObjIndex(interp, textPtr, objv[5], &index2) + != TCL_OK) { + return TCL_ERROR; + } /* - * The first character is tagged. See if there is an - * on-toggle just before the character. If not, then - * skip to the end of this tagged range. + * The search below is a bit weird. The previous toggle can be + * either an on or off toggle. If it is an on toggle, then we + * need to turn around and search forward for the end toggle. + * Otherwise we keep searching backwards. */ - for (segPtr = index1.linePtr->segPtr, offset = index1.byteIndex; - offset >= 0; - offset -= segPtr->size, segPtr = segPtr->nextPtr) { - if ((offset == 0) && (segPtr->typePtr == &tkTextToggleOnType) - && (segPtr->body.toggle.tagPtr == tagPtr)) { - goto gotStart; - } + TkBTreeStartSearchBack(&index1, &index2, tagPtr, &tSearch); + + if (!TkBTreePrevTag(&tSearch)) { + return TCL_OK; } - if (!TkBTreeNextTag(&tSearch)) { - return TCL_OK; + if (tSearch.segPtr->typePtr == &tkTextToggleOnType) { + TkTextPrintIndex(&tSearch.curIndex, position1); + TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), + 0, &last); + TkBTreeStartSearch(&tSearch.curIndex, &last, tagPtr, &tSearch); + TkBTreeNextTag(&tSearch); + TkTextPrintIndex(&tSearch.curIndex, position2); + } else { + TkTextPrintIndex(&tSearch.curIndex, position2); + TkBTreePrevTag(&tSearch); + if (TkTextIndexCmp(&tSearch.curIndex, &index2) < 0) { + return TCL_OK; + } + TkTextPrintIndex(&tSearch.curIndex, position1); } + Tcl_AppendElement(interp, position1); + Tcl_AppendElement(interp, position2); + break; } + case TAG_RAISE: { + TkTextTag *tagPtr2; + int prio; - /* - * Find the start of the tagged range. - */ - - if (!TkBTreeNextTag(&tSearch)) { - return TCL_OK; - } - gotStart: - if (TkTextIndexCmp(&tSearch.curIndex, &index2) >= 0) { - return TCL_OK; - } - TkTextPrintIndex(&tSearch.curIndex, position); - Tcl_AppendElement(interp, position); - TkBTreeNextTag(&tSearch); - TkTextPrintIndex(&tSearch.curIndex, position); - Tcl_AppendElement(interp, position); - } else if ((c == 'p') && (strncmp(argv[2], "prevrange", length) == 0) - && (length >= 2)) { - TkTextSearch tSearch; - char position1[TK_POS_CHARS]; - char position2[TK_POS_CHARS]; - - if ((argc != 5) && (argc != 6)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " tag prevrange tagName index1 ?index2?\"", - (char *) NULL); - return TCL_ERROR; - } - tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, argv[3]); - if (tagPtr == NULL) { - return TCL_OK; - } - if (TkTextGetIndex(interp, textPtr, argv[4], &index1) != TCL_OK) { - return TCL_ERROR; - } - if (argc == 5) { - TkTextMakeByteIndex(textPtr->tree, 0, 0, &index2); - } else if (TkTextGetIndex(interp, textPtr, argv[5], &index2) - != TCL_OK) { - return TCL_ERROR; - } - - /* - * The search below is a bit weird. The previous toggle can be - * either an on or off toggle. If it is an on toggle, then we - * need to turn around and search forward for the end toggle. - * Otherwise we keep searching backwards. - */ - - TkBTreeStartSearchBack(&index1, &index2, tagPtr, &tSearch); - - if (!TkBTreePrevTag(&tSearch)) { - return TCL_OK; - } - if (tSearch.segPtr->typePtr == &tkTextToggleOnType) { - TkTextPrintIndex(&tSearch.curIndex, position1); - TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), - 0, &last); - TkBTreeStartSearch(&tSearch.curIndex, &last, tagPtr, &tSearch); - TkBTreeNextTag(&tSearch); - TkTextPrintIndex(&tSearch.curIndex, position2); - } else { - TkTextPrintIndex(&tSearch.curIndex, position2); - TkBTreePrevTag(&tSearch); - if (TkTextIndexCmp(&tSearch.curIndex, &index2) < 0) { - return TCL_OK; + if ((objc != 4) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 3, objv, "tagName ?aboveThis?"); + return TCL_ERROR; } - TkTextPrintIndex(&tSearch.curIndex, position1); - } - Tcl_AppendElement(interp, position1); - Tcl_AppendElement(interp, position2); - } else if ((c == 'r') && (strncmp(argv[2], "raise", length) == 0) - && (length >= 3)) { - TkTextTag *tagPtr2; - int prio; - - if ((argc != 4) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " tag raise tagName ?aboveThis?\"", - (char *) NULL); - return TCL_ERROR; - } - tagPtr = FindTag(interp, textPtr, argv[3]); - if (tagPtr == NULL) { - return TCL_ERROR; - } - if (argc == 5) { - tagPtr2 = FindTag(interp, textPtr, argv[4]); - if (tagPtr2 == NULL) { + tagPtr = FindTag(interp, textPtr, objv[3]); + if (tagPtr == NULL) { return TCL_ERROR; } - if (tagPtr->priority <= tagPtr2->priority) { - prio = tagPtr2->priority; + if (objc == 5) { + tagPtr2 = FindTag(interp, textPtr, objv[4]); + if (tagPtr2 == NULL) { + return TCL_ERROR; + } + if (tagPtr->priority <= tagPtr2->priority) { + prio = tagPtr2->priority; + } else { + prio = tagPtr2->priority + 1; + } } else { - prio = tagPtr2->priority + 1; + prio = textPtr->numTags-1; } - } else { - prio = textPtr->numTags-1; - } - ChangeTagPriority(textPtr, tagPtr, prio); - TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL, - tagPtr, 1); - } else if ((c == 'r') && (strncmp(argv[2], "ranges", length) == 0) - && (length >= 3)) { - TkTextSearch tSearch; - char position[TK_POS_CHARS]; - - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " tag ranges tagName\"", (char *) NULL); - return TCL_ERROR; - } - tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, argv[3]); - if (tagPtr == NULL) { - return TCL_OK; - } - TkTextMakeByteIndex(textPtr->tree, 0, 0, &first); - TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), - 0, &last); - TkBTreeStartSearch(&first, &last, tagPtr, &tSearch); - if (TkBTreeCharTagged(&first, tagPtr)) { - TkTextPrintIndex(&first, position); - Tcl_AppendElement(interp, position); + ChangeTagPriority(textPtr, tagPtr, prio); + TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL, + tagPtr, 1); + break; } - while (TkBTreeNextTag(&tSearch)) { - TkTextPrintIndex(&tSearch.curIndex, position); - Tcl_AppendElement(interp, position); + case TAG_RANGES: { + TkTextSearch tSearch; + char position[TK_POS_CHARS]; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 3, objv, "tagName"); + return TCL_ERROR; + } + tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, objv[3]); + if (tagPtr == NULL) { + return TCL_OK; + } + TkTextMakeByteIndex(textPtr->tree, 0, 0, &first); + TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), + 0, &last); + TkBTreeStartSearch(&first, &last, tagPtr, &tSearch); + if (TkBTreeCharTagged(&first, tagPtr)) { + TkTextPrintIndex(&first, position); + Tcl_AppendElement(interp, position); + } + while (TkBTreeNextTag(&tSearch)) { + TkTextPrintIndex(&tSearch.curIndex, position); + Tcl_AppendElement(interp, position); + } + break; } - } else if ((c == 'r') && (strncmp(argv[2], "remove", length) == 0) - && (length >= 2)) { - fullOption = "remove"; - addTag = 0; - goto addAndRemove; - } else { - Tcl_AppendResult(interp, "bad tag option \"", argv[2], - "\": must be add, bind, cget, configure, delete, lower, ", - "names, nextrange, raise, ranges, or remove", - (char *) NULL); - return TCL_ERROR; } return TCL_OK; } @@ -826,8 +849,8 @@ TkTextCreateTag(textPtr, tagName) tagPtr->tagRootPtr = NULL; tagPtr->priority = textPtr->numTags; tagPtr->border = NULL; - tagPtr->bdString = NULL; tagPtr->borderWidth = 0; + tagPtr->borderWidthPtr = NULL; tagPtr->reliefString = NULL; tagPtr->relief = TK_RELIEF_FLAT; tagPtr->bgStipple = None; @@ -852,7 +875,7 @@ TkTextCreateTag(textPtr, tagName) tagPtr->spacing2 = 0; tagPtr->spacing3String = NULL; tagPtr->spacing3 = 0; - tagPtr->tabString = NULL; + tagPtr->tabStringPtr = NULL; tagPtr->tabArrayPtr = NULL; tagPtr->underlineString = NULL; tagPtr->underline = 0; @@ -862,6 +885,7 @@ TkTextCreateTag(textPtr, tagName) tagPtr->affectsDisplay = 0; textPtr->numTags++; Tcl_SetHashValue(hPtr, tagPtr); + tagPtr->optionTable = Tk_CreateOptionTable(textPtr->interp, tagOptionSpecs); return tagPtr; } @@ -890,16 +914,16 @@ FindTag(interp, textPtr, tagName) * if NULL, then don't record an error * message. */ TkText *textPtr; /* Widget in which tag is being used. */ - CONST char *tagName; /* Name of desired tag. */ + Tcl_Obj *tagName; /* Name of desired tag. */ { Tcl_HashEntry *hPtr; - hPtr = Tcl_FindHashEntry(&textPtr->tagTable, tagName); + hPtr = Tcl_FindHashEntry(&textPtr->tagTable, Tcl_GetString(tagName)); if (hPtr != NULL) { return (TkTextTag *) Tcl_GetHashValue(hPtr); } if (interp != NULL) { - Tcl_AppendResult(interp, "tag \"", tagName, + Tcl_AppendResult(interp, "tag \"", Tcl_GetString(tagName), "\" isn't defined in text widget", (char *) NULL); } return NULL; @@ -927,61 +951,13 @@ TkTextFreeTag(textPtr, tagPtr) TkText *textPtr; /* Info about overall widget. */ register TkTextTag *tagPtr; /* Tag being deleted. */ { - if (tagPtr->border != None) { - Tk_Free3DBorder(tagPtr->border); - } - if (tagPtr->bdString != NULL) { - ckfree(tagPtr->bdString); - } - if (tagPtr->reliefString != NULL) { - ckfree(tagPtr->reliefString); - } - if (tagPtr->bgStipple != None) { - Tk_FreeBitmap(textPtr->display, tagPtr->bgStipple); - } - if (tagPtr->fgColor != None) { - Tk_FreeColor(tagPtr->fgColor); - } - Tk_FreeFont(tagPtr->tkfont); - if (tagPtr->fgStipple != None) { - Tk_FreeBitmap(textPtr->display, tagPtr->fgStipple); - } - if (tagPtr->justifyString != NULL) { - ckfree(tagPtr->justifyString); - } - if (tagPtr->lMargin1String != NULL) { - ckfree(tagPtr->lMargin1String); - } - if (tagPtr->lMargin2String != NULL) { - ckfree(tagPtr->lMargin2String); - } - if (tagPtr->offsetString != NULL) { - ckfree(tagPtr->offsetString); - } - if (tagPtr->overstrikeString != NULL) { - ckfree(tagPtr->overstrikeString); - } - if (tagPtr->rMarginString != NULL) { - ckfree(tagPtr->rMarginString); - } - if (tagPtr->spacing1String != NULL) { - ckfree(tagPtr->spacing1String); - } - if (tagPtr->spacing2String != NULL) { - ckfree(tagPtr->spacing2String); - } - if (tagPtr->spacing3String != NULL) { - ckfree(tagPtr->spacing3String); - } - if (tagPtr->tabString != NULL) { - ckfree(tagPtr->tabString); - } + /* Let Tk do most of the hard work for us */ + Tk_FreeConfigOptions((char *) tagPtr, tagPtr->optionTable, + textPtr->tkwin); + /* This associated information is managed by us */ if (tagPtr->tabArrayPtr != NULL) { ckfree((char *) tagPtr->tabArrayPtr); } - if (tagPtr->underlineString != NULL) { - ckfree(tagPtr->underlineString); - } ckfree((char *) tagPtr); } diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c index 6137b14..cc0449e 100644 --- a/generic/tkTextWind.c +++ b/generic/tkTextWind.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextWind.c,v 1.6 2002/08/05 04:30:40 dgp Exp $ + * RCS: @(#) $Id: tkTextWind.c,v 1.7 2003/05/19 13:04:24 vincentdarley Exp $ */ #include "tk.h" @@ -35,15 +35,6 @@ static Tk_GeomMgr textGeomType = { }; /* - * Definitions for alignment values: - */ - -#define ALIGN_BOTTOM 0 -#define ALIGN_CENTER 1 -#define ALIGN_TOP 2 -#define ALIGN_BASELINE 3 - -/* * Macro that determines the size of an embedded window segment: */ @@ -54,12 +45,6 @@ static Tk_GeomMgr textGeomType = { * Prototypes for procedures defined in this file: */ -static int AlignParseProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, Tk_Window tkwin, - CONST char *value, char *widgRec, int offset)); -static char * AlignPrintProc _ANSI_ARGS_((ClientData clientData, - Tk_Window tkwin, char *widgRec, int offset, - Tcl_FreeProc **freeProcPtr)); static TkTextSegment * EmbWinCleanupProc _ANSI_ARGS_((TkTextSegment *segPtr, TkTextLine *linePtr)); static void EmbWinCheckProc _ANSI_ARGS_((TkTextSegment *segPtr, @@ -69,7 +54,7 @@ static void EmbWinBboxProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr)); static int EmbWinConfigure _ANSI_ARGS_((TkText *textPtr, - TkTextSegment *ewPtr, int argc, CONST char **argv)); + TkTextSegment *ewPtr, int objc, Tcl_Obj *CONST objv[])); static void EmbWinDelayedUnmap _ANSI_ARGS_(( ClientData clientData)); static int EmbWinDeleteProc _ANSI_ARGS_((TkTextSegment *segPtr, @@ -104,32 +89,41 @@ static Tk_SegType tkTextEmbWindowType = { }; /* + * Definitions for alignment values: + */ + +static char *alignStrings[] = { + "baseline", "bottom", "center", "top", (char *) NULL +}; + +typedef enum { + ALIGN_BASELINE, ALIGN_BOTTOM, ALIGN_CENTER, ALIGN_TOP +} alignMode; + +/* * Information used for parsing window configuration options: */ -static Tk_CustomOption alignOption = {AlignParseProc, AlignPrintProc, - (ClientData) NULL}; - -static Tk_ConfigSpec configSpecs[] = { - {TK_CONFIG_CUSTOM, "-align", (char *) NULL, (char *) NULL, - "center", 0, TK_CONFIG_DONT_SET_DEFAULT, &alignOption}, - {TK_CONFIG_STRING, "-create", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextEmbWindow, create), - TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK}, - {TK_CONFIG_INT, "-padx", (char *) NULL, (char *) NULL, - "0", Tk_Offset(TkTextEmbWindow, padX), - TK_CONFIG_DONT_SET_DEFAULT}, - {TK_CONFIG_INT, "-pady", (char *) NULL, (char *) NULL, - "0", Tk_Offset(TkTextEmbWindow, padY), - TK_CONFIG_DONT_SET_DEFAULT}, - {TK_CONFIG_BOOLEAN, "-stretch", (char *) NULL, (char *) NULL, - "0", Tk_Offset(TkTextEmbWindow, stretch), - TK_CONFIG_DONT_SET_DEFAULT}, - {TK_CONFIG_WINDOW, "-window", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(TkTextEmbWindow, tkwin), - TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK}, - {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, 0} +static Tk_OptionSpec optionSpecs[] = { + {TK_OPTION_STRING_TABLE, "-align", (char *) NULL, (char *) NULL, + "center", -1, Tk_Offset(TkTextEmbWindow, align), + 0, (ClientData) alignStrings, 0}, + {TK_OPTION_STRING, "-create", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextEmbWindow, create), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_PIXELS, "-padx", (char *) NULL, (char *) NULL, + "0", -1, Tk_Offset(TkTextEmbWindow, padX), + 0, 0, 0}, + {TK_OPTION_PIXELS, "-pady", (char *) NULL, (char *) NULL, + "0", -1, Tk_Offset(TkTextEmbWindow, padY), + 0, 0, 0}, + {TK_OPTION_BOOLEAN, "-stretch", (char *) NULL, (char *) NULL, + "0", -1, Tk_Offset(TkTextEmbWindow, stretch), + 0, 0, 0}, + {TK_OPTION_WINDOW, "-window", (char *) NULL, (char *) NULL, + (char *) NULL, -1, Tk_Offset(TkTextEmbWindow, tkwin), + TK_OPTION_NULL_OK, 0, 0}, + {TK_OPTION_END} }; /* @@ -151,152 +145,171 @@ static Tk_ConfigSpec configSpecs[] = { */ int -TkTextWindowCmd(textPtr, interp, argc, argv) +TkTextWindowCmd(textPtr, interp, objc, objv) register TkText *textPtr; /* Information about text widget. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. Someone else has already + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. Someone else has already * parsed this command enough to know that - * argv[1] is "window". */ + * objv[1] is "window". */ { - size_t length; + int optionIndex; + + static CONST char *windOptionStrings[] = { + "cget", "configure", "create", "names", (char *) NULL + }; + enum windOptions { + WIND_CGET, WIND_CONFIGURE, WIND_CREATE, WIND_NAMES + }; + register TkTextSegment *ewPtr; - if (argc < 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " window option ?arg arg ...?\"", (char *) NULL); + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?"); return TCL_ERROR; } - length = strlen(argv[2]); - if ((strncmp(argv[2], "cget", length) == 0) && (length >= 2)) { - TkTextIndex index; - TkTextSegment *ewPtr; - - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " window cget index option\"", - (char *) NULL); - return TCL_ERROR; - } - if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { - return TCL_ERROR; - } - ewPtr = TkTextIndexToSeg(&index, (int *) NULL); - if (ewPtr->typePtr != &tkTextEmbWindowType) { - Tcl_AppendResult(interp, "no embedded window at index \"", - argv[3], "\"", (char *) NULL); - return TCL_ERROR; - } - return Tk_ConfigureValue(interp, textPtr->tkwin, configSpecs, - (char *) &ewPtr->body.ew, argv[4], 0); - } else if ((strncmp(argv[2], "configure", length) == 0) && (length >= 2)) { - TkTextIndex index; - TkTextSegment *ewPtr; - - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " window configure index ?option value ...?\"", - (char *) NULL); - return TCL_ERROR; - } - if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { - return TCL_ERROR; - } - ewPtr = TkTextIndexToSeg(&index, (int *) NULL); - if (ewPtr->typePtr != &tkTextEmbWindowType) { - Tcl_AppendResult(interp, "no embedded window at index \"", - argv[3], "\"", (char *) NULL); - return TCL_ERROR; - } - if (argc == 4) { - return Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs, - (char *) &ewPtr->body.ew, (char *) NULL, 0); - } else if (argc == 5) { - return Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs, - (char *) &ewPtr->body.ew, argv[4], 0); - } else { - TkTextChanged(textPtr, &index, &index); - return EmbWinConfigure(textPtr, ewPtr, argc-4, argv+4); + if (Tcl_GetIndexFromObj(interp, objv[2], windOptionStrings, + "window option", 0, &optionIndex) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum windOptions)optionIndex) { + case WIND_CGET: { + TkTextIndex index; + TkTextSegment *ewPtr; + Tcl_Obj *objPtr; + + if (objc != 5) { + Tcl_WrongNumArgs(interp, 3, objv, "index option"); + return TCL_ERROR; + } + if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) { + return TCL_ERROR; + } + ewPtr = TkTextIndexToSeg(&index, (int *) NULL); + if (ewPtr->typePtr != &tkTextEmbWindowType) { + Tcl_AppendResult(interp, "no embedded window at index \"", + Tcl_GetString(objv[3]), "\"", (char *) NULL); + return TCL_ERROR; + } + objPtr = Tk_GetOptionValue(interp, (char *) &ewPtr->body.ew, + ewPtr->body.ew.optionTable, objv[4], textPtr->tkwin); + if (objPtr == NULL) { + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, objPtr); + return TCL_OK; + } + break; } - } else if ((strncmp(argv[2], "create", length) == 0) && (length >= 2)) { - TkTextIndex index; - int lineIndex; - - /* - * Add a new window. Find where to put the new window, and - * mark that position for redisplay. - */ + case WIND_CONFIGURE: { + TkTextIndex index; + TkTextSegment *ewPtr; - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " window create index ?option value ...?\"", - (char *) NULL); - return TCL_ERROR; - } - if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { - return TCL_ERROR; + if (objc < 4) { + Tcl_WrongNumArgs(interp, 3, objv, "index ?option value ...?"); + return TCL_ERROR; + } + if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) { + return TCL_ERROR; + } + ewPtr = TkTextIndexToSeg(&index, (int *) NULL); + if (ewPtr->typePtr != &tkTextEmbWindowType) { + Tcl_AppendResult(interp, "no embedded window at index \"", + Tcl_GetString(objv[3]), "\"", (char *) NULL); + return TCL_ERROR; + } + if (objc <= 5) { + Tcl_Obj* objPtr = Tk_GetOptionInfo(interp, (char *) &ewPtr->body.ew, + ewPtr->body.ew.optionTable, + (objc == 5) ? objv[4] : (Tcl_Obj *) NULL, + textPtr->tkwin); + if (objPtr == NULL) { + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, objPtr); + return TCL_OK; + } + } else { + TkTextChanged(textPtr, &index, &index); + return EmbWinConfigure(textPtr, ewPtr, objc-4, objv+4); + } + break; } + case WIND_CREATE: { + TkTextIndex index; + int lineIndex; - /* - * Don't allow insertions on the last (dummy) line of the text. - */ - - lineIndex = TkBTreeLineIndex(index.linePtr); - if (lineIndex == TkBTreeNumLines(textPtr->tree)) { - lineIndex--; - TkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, &index); - } + /* + * Add a new window. Find where to put the new window, and + * mark that position for redisplay. + */ - /* - * Create the new window segment and initialize it. - */ + if (objc < 4) { + Tcl_WrongNumArgs(interp, 3, objv, "index ?option value ...?"); + return TCL_ERROR; + } + if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) { + return TCL_ERROR; + } - ewPtr = (TkTextSegment *) ckalloc(EW_SEG_SIZE); - ewPtr->typePtr = &tkTextEmbWindowType; - ewPtr->size = 1; - ewPtr->body.ew.textPtr = textPtr; - ewPtr->body.ew.linePtr = NULL; - ewPtr->body.ew.tkwin = NULL; - ewPtr->body.ew.create = NULL; - ewPtr->body.ew.align = ALIGN_CENTER; - ewPtr->body.ew.padX = ewPtr->body.ew.padY = 0; - ewPtr->body.ew.stretch = 0; - ewPtr->body.ew.chunkCount = 0; - ewPtr->body.ew.displayed = 0; + /* + * Don't allow insertions on the last (dummy) line of the text. + */ + + lineIndex = TkBTreeLineIndex(index.linePtr); + if (lineIndex == TkBTreeNumLines(textPtr->tree)) { + lineIndex--; + TkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, &index); + } - /* - * Link the segment into the text widget, then configure it (delete - * it again if the configuration fails). - */ + /* + * Create the new window segment and initialize it. + */ - TkTextChanged(textPtr, &index, &index); - TkBTreeLinkSegment(ewPtr, &index); - if (EmbWinConfigure(textPtr, ewPtr, argc-4, argv+4) != TCL_OK) { - TkTextIndex index2; + ewPtr = (TkTextSegment *) ckalloc(EW_SEG_SIZE); + ewPtr->typePtr = &tkTextEmbWindowType; + ewPtr->size = 1; + ewPtr->body.ew.textPtr = textPtr; + ewPtr->body.ew.linePtr = NULL; + ewPtr->body.ew.tkwin = NULL; + ewPtr->body.ew.create = NULL; + ewPtr->body.ew.align = ALIGN_CENTER; + ewPtr->body.ew.padX = ewPtr->body.ew.padY = 0; + ewPtr->body.ew.stretch = 0; + ewPtr->body.ew.chunkCount = 0; + ewPtr->body.ew.displayed = 0; + ewPtr->body.ew.optionTable = Tk_CreateOptionTable(interp, optionSpecs); + /* + * Link the segment into the text widget, then configure it (delete + * it again if the configuration fails). + */ - TkTextIndexForwChars(&index, 1, &index2); - TkBTreeDeleteChars(&index, &index2); - return TCL_ERROR; - } - } else if (strncmp(argv[2], "names", length) == 0) { - Tcl_HashSearch search; - Tcl_HashEntry *hPtr; + TkTextChanged(textPtr, &index, &index); + TkBTreeLinkSegment(ewPtr, &index); + if (EmbWinConfigure(textPtr, ewPtr, objc-4, objv+4) != TCL_OK) { + TkTextIndex index2; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " window names\"", (char *) NULL); - return TCL_ERROR; + TkTextIndexForwChars(&index, 1, &index2); + TkBTreeDeleteChars(&index, &index2); + return TCL_ERROR; + } + break; } - for (hPtr = Tcl_FirstHashEntry(&textPtr->windowTable, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendElement(interp, - Tcl_GetHashKey(&textPtr->markTable, hPtr)); + case WIND_NAMES: { + Tcl_HashSearch search; + Tcl_HashEntry *hPtr; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + for (hPtr = Tcl_FirstHashEntry(&textPtr->windowTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + Tcl_AppendElement(interp, + Tcl_GetHashKey(&textPtr->markTable, hPtr)); + } + break; } - } else { - Tcl_AppendResult(interp, "bad window option \"", argv[2], - "\": must be cget, configure, create, or names", - (char *) NULL); - return TCL_ERROR; } return TCL_OK; } @@ -307,7 +320,7 @@ TkTextWindowCmd(textPtr, interp, argc, argv) * EmbWinConfigure -- * * This procedure is called to handle configuration options - * for an embedded window, using an argc/argv list. + * for an embedded window, using an objc/objv list. * * Results: * The return value is a standard Tcl result. If TCL_ERROR is @@ -322,12 +335,12 @@ TkTextWindowCmd(textPtr, interp, argc, argv) */ static int -EmbWinConfigure(textPtr, ewPtr, argc, argv) +EmbWinConfigure(textPtr, ewPtr, objc, objv) TkText *textPtr; /* Information about text widget that * contains embedded window. */ TkTextSegment *ewPtr; /* Embedded window to be configured. */ - int argc; /* Number of strings in argv. */ - CONST char **argv; /* Array of strings describing configuration + int objc; /* Number of strings in objv. */ + Tcl_Obj *CONST objv[]; /* Array of objects describing configuration * options. */ { Tk_Window oldWindow; @@ -335,9 +348,9 @@ EmbWinConfigure(textPtr, ewPtr, argc, argv) int new; oldWindow = ewPtr->body.ew.tkwin; - if (Tk_ConfigureWidget(textPtr->interp, textPtr->tkwin, configSpecs, - argc, argv, (char *) &ewPtr->body.ew, TK_CONFIG_ARGV_ONLY) - != TCL_OK) { + if (Tk_SetOptions(textPtr->interp, (char*)&ewPtr->body.ew, + ewPtr->body.ew.optionTable, + objc, objv, textPtr->tkwin, NULL, NULL) != TCL_OK) { return TCL_ERROR; } if (oldWindow != ewPtr->body.ew.tkwin) { @@ -414,99 +427,6 @@ EmbWinConfigure(textPtr, ewPtr, argc, argv) /* *-------------------------------------------------------------- * - * AlignParseProc -- - * - * This procedure is invoked by Tk_ConfigureWidget during - * option processing to handle "-align" options for embedded - * windows. - * - * Results: - * A standard Tcl return value. - * - * Side effects: - * The alignment for the embedded window may change. - * - *-------------------------------------------------------------- - */ - - /* ARGSUSED */ -static int -AlignParseProc(clientData, interp, tkwin, value, widgRec, offset) - ClientData clientData; /* Not used.*/ - Tcl_Interp *interp; /* Used for reporting errors. */ - Tk_Window tkwin; /* Window for text widget. */ - CONST char *value; /* Value of option. */ - char *widgRec; /* Pointer to TkTextEmbWindow - * structure. */ - int offset; /* Offset into item (ignored). */ -{ - register TkTextEmbWindow *embPtr = (TkTextEmbWindow *) widgRec; - - if (strcmp(value, "baseline") == 0) { - embPtr->align = ALIGN_BASELINE; - } else if (strcmp(value, "bottom") == 0) { - embPtr->align = ALIGN_BOTTOM; - } else if (strcmp(value, "center") == 0) { - embPtr->align = ALIGN_CENTER; - } else if (strcmp(value, "top") == 0) { - embPtr->align = ALIGN_TOP; - } else { - Tcl_AppendResult(interp, "bad alignment \"", value, - "\": must be baseline, bottom, center, or top", - (char *) NULL); - return TCL_ERROR; - } - return TCL_OK; -} - -/* - *-------------------------------------------------------------- - * - * AlignPrintProc -- - * - * This procedure is invoked by the Tk configuration code - * to produce a printable string for the "-align" configuration - * option for embedded windows. - * - * Results: - * The return value is a string describing the embedded - * window's current alignment. - * - * Side effects: - * None. - * - *-------------------------------------------------------------- - */ - - /* ARGSUSED */ -static char * -AlignPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr) - ClientData clientData; /* Ignored. */ - Tk_Window tkwin; /* Window for text widget. */ - char *widgRec; /* Pointer to TkTextEmbWindow - * structure. */ - int offset; /* Ignored. */ - Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with - * information about how to reclaim - * storage for return string. */ -{ - switch (((TkTextEmbWindow *) widgRec)->align) { - case ALIGN_BASELINE: - return "baseline"; - case ALIGN_BOTTOM: - return "bottom"; - case ALIGN_CENTER: - return "center"; - case ALIGN_TOP: - return "top"; - default: - return "??"; - } -} - -/* - *-------------------------------------------------------------- - * * EmbWinStructureProc -- * * This procedure is invoked by the Tk event loop whenever @@ -678,8 +598,8 @@ EmbWinDeleteProc(ewPtr, linePtr, treeGone) Tk_DestroyWindow(ewPtr->body.ew.tkwin); } Tcl_CancelIdleCall(EmbWinDelayedUnmap, (ClientData) ewPtr); - Tk_FreeOptions(configSpecs, (char *) &ewPtr->body.ew, - ewPtr->body.ew.textPtr->display, 0); + Tk_FreeConfigOptions((char *) &ewPtr->body.ew, ewPtr->body.ew.optionTable, + ewPtr->body.ew.tkwin); ckfree((char *) ewPtr); return 0; } diff --git a/generic/tkUndo.c b/generic/tkUndo.c index eb6f07b..e543cac 100644 --- a/generic/tkUndo.c +++ b/generic/tkUndo.c @@ -8,11 +8,14 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUndo.c,v 1.1 2002/06/21 23:09:55 hobbs Exp $ + * RCS: @(#) $Id: tkUndo.c,v 1.2 2003/05/19 13:04:24 vincentdarley Exp $ */ #include "tkUndo.h" +static int UndoScriptsEvaluate _ANSI_ARGS_ ((Tcl_Interp *interp, + Tcl_Obj *objPtr, TkUndoAtomType type)); + /* * TkUndoPushStack @@ -112,7 +115,9 @@ void TkUndoClearStack ( stack ) /* * TkUndoPushAction * Push a new elem on the stack identified by stack. - * action and revert are given through Tcl_DStrings + * action and revert are given through Tcl_Obj's to which + * we will retain a reference. (So they can be passed in + * with a zero refCount if desired). * * Results: * None @@ -121,20 +126,25 @@ void TkUndoClearStack ( stack ) * None. */ -void TkUndoPushAction ( stack, actionScript, revertScript ) - TkUndoRedoStack * stack; /* An Undo or Redo stack */ - Tcl_DString * actionScript; /* The script to get the action (redo) */ - Tcl_DString * revertScript; /* The script to revert the action (undo) */ +void TkUndoPushAction ( stack, actionScript, revertScript, isList ) + TkUndoRedoStack *stack; /* An Undo or Redo stack */ + Tcl_Obj *actionScript; /* The script to get the action (redo) */ + Tcl_Obj *revertScript; /* The script to revert the action (undo) */ + int isList; /* Are the given objects lists of scripts? */ { TkUndoAtom * atom; atom = (TkUndoAtom *) ckalloc(sizeof(TkUndoAtom)); - atom->type = TK_UNDO_ACTION; + if (isList) { + atom->type = TK_UNDO_ACTION_LIST; + } else { + atom->type = TK_UNDO_ACTION; + } - atom->apply = Tcl_NewStringObj(Tcl_DStringValue(actionScript),Tcl_DStringLength(actionScript)); + atom->apply = actionScript; Tcl_IncrRefCount(atom->apply); - atom->revert = Tcl_NewStringObj(Tcl_DStringValue(revertScript),Tcl_DStringLength(revertScript)); + atom->revert = revertScript; Tcl_IncrRefCount(atom->revert); TkUndoPushStack(&(stack->undoStack), atom); @@ -333,7 +343,7 @@ int TkUndoRevert ( stack ) } while ( elem && (elem->type != TK_UNDO_SEPARATOR) ) { - Tcl_EvalObjEx(stack->interp,elem->revert,TCL_EVAL_GLOBAL); + UndoScriptsEvaluate(stack->interp,elem->revert,elem->type); TkUndoPushStack(&(stack->redoStack),elem); elem = TkUndoPopStack(&(stack->undoStack)); @@ -347,7 +357,6 @@ int TkUndoRevert ( stack ) return TCL_OK; } - /* * TkUndoApply -- @@ -383,7 +392,7 @@ int TkUndoApply ( stack ) } while ( elem && (elem->type != TK_UNDO_SEPARATOR) ) { - Tcl_EvalObjEx(stack->interp,elem->apply,TCL_EVAL_GLOBAL); + UndoScriptsEvaluate(stack->interp,elem->apply,elem->type); TkUndoPushStack(&(stack->undoStack), elem); elem = TkUndoPopStack(&(stack->redoStack)); @@ -398,3 +407,40 @@ int TkUndoApply ( stack ) return TCL_OK; } + +/* + * UndoScriptsEvaluate -- + * Execute either a single script, or a set of scripts + * + * Results: + * A TCL status code + * + * Side effects: + * None. + */ +static int +UndoScriptsEvaluate(interp, objPtr, type) + Tcl_Interp *interp; + Tcl_Obj *objPtr; + TkUndoAtomType type; +{ + if (type == TK_UNDO_ACTION_LIST) { + int objc; + Tcl_Obj **objv; + int res, i; + res = Tcl_ListObjGetElements(interp, objPtr, &objc, &objv); + if (res != TCL_OK) { + return res; + } + for (i=0;i= insert]} { - set oldSeparator [$w cget -autoseparators] - if { $oldSeparator } { - $w configure -autoseparators 0 - $w edit separator - set compound 1 - } - $w delete sel.first sel.last + if {[llength [set range [$w tag ranges sel]]]} { + if {[$w compare [lindex $range 0] <= insert] \ + && [$w compare [lindex $range end] >= insert]} { + set oldSeparator [$w cget -autoseparators] + if { $oldSeparator } { + $w configure -autoseparators 0 + $w edit separator + set compound 1 + } + $w delete [lindex $range 0] [lindex $range end] } } $w insert insert $s diff --git a/tests/text.test b/tests/text.test index 08e0b0f..f3d5772 100644 --- a/tests/text.test +++ b/tests/text.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: text.test,v 1.20 2003/04/01 21:06:52 dgp Exp $ +# RCS: @(#) $Id: text.test,v 1.21 2003/05/19 13:04:24 vincentdarley Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -219,7 +219,7 @@ test text-6.13 {TextWidgetCmd procedure, "compare" option} { } {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}} test text-6.14 {TextWidgetCmd procedure, "compare" option} { list [catch {.t co 1.0 z 1.2} msg] $msg -} {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} +} {1 {ambiguous option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} # "configure" option is already covered above @@ -228,7 +228,7 @@ test text-7.1 {TextWidgetCmd procedure, "debug" option} { } {1 {wrong # args: should be ".t debug boolean"}} test text-7.2 {TextWidgetCmd procedure, "debug" option} { list [catch {.t de 0 1} msg] $msg -} {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} +} {1 {ambiguous option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} test text-7.3 {TextWidgetCmd procedure, "debug" option} { .t debug true .t deb @@ -388,7 +388,7 @@ test text-10.2 {TextWidgetCmd procedure, "index" option} { } {1 {wrong # args: should be ".t index index"}} test text-10.3 {TextWidgetCmd procedure, "index" option} { list [catch {.t in a b} msg] $msg -} {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} +} {1 {ambiguous option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}} test text-10.4 {TextWidgetCmd procedure, "index" option} { list [catch {.t index @xyz} msg] $msg } {1 {bad text index "@xyz"}} @@ -451,7 +451,7 @@ test text-11.10 {TextWidgetCmd procedure, "insert" option} { test text-12.1 {ConfigureText procedure} { list [catch {.t2 configure -state foobar} msg] $msg -} {1 {bad state value "foobar": must be normal or disabled}} +} {1 {bad state "foobar": must be disabled or normal}} test text-12.2 {ConfigureText procedure} { .t2 configure -spacing1 -2 -spacing2 1 -spacing3 1 list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3] @@ -479,7 +479,7 @@ test text-12.6 {ConfigureText procedure} { } {} test text-12.7 {ConfigureText procedure} { list [catch {.t2 configure -wrap bogus} msg] $msg -} {1 {bad wrap mode "bogus": must be char, none, or word}} +} {1 {bad wrap "bogus": must be char, none, or word}} test text-12.8 {ConfigureText procedure} { .t2 configure -selectborderwidth 17 -selectforeground #332211 \ -selectbackground #abc @@ -932,10 +932,13 @@ test text-19.3 {TkTextLostSelection procedure} { .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" test text-20.1 {TextSearchCmd procedure, argument parsing} { list [catch {.t search -} msg] $msg -} {1 {bad switch "-": must be --, -backward, -count, -elide, -exact, -forward, -nocase, or -regexp}} +} {1 {bad switch "-": must be --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, or -regexp}} test text-20.2 {TextSearchCmd procedure, -backwards option} { .t search -backwards xyz 1.4 } {1.1} +test text-20.2.1 {TextSearchCmd procedure, -all option} { + .t search -all xyz 1.4 +} {1.5 3.0 3.5 1.1} test text-20.3 {TextSearchCmd procedure, -forwards option} { .t search -forwards xyz 1.4 } {1.5} @@ -955,9 +958,19 @@ test text-20.7 {TextSearchCmd procedure, -count option} { test text-20.8 {TextSearchCmd procedure, -nocase option} { list [.t search -nocase BaR 1.1] [.t search BaR 1.1] } {2.13 2.23} -test text-20.9 {TextSearchCmd procedure, -nocase option} { - .t search -n BaR 1.1 +test text-20.9 {TextSearchCmd procedure, -n ambiguous option} { + list [catch {.t search -n BaR 1.1} msg] $msg +} {1 {bad switch "-n": must be --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, or -regexp}} +test text-20.9.1 {TextSearchCmd procedure, -nocase option} { + .t search -noc BaR 1.1 } {2.13} +test text-20.9.2 {TextSearchCmd procedure, -nolinestop option} { + list [catch {.t search -nolinestop BaR 1.1} msg] $msg +} {1 {the "-nolinestop" option requires the "-regexp" option to be present}} +test text-20.9.3 {TextSearchCmd procedure, -nolinestop option} { + set msg "" + list [.t search -nolinestop -regexp -count msg e.*o 1.1] $msg +} {1.14 32} test text-20.10 {TextSearchCmd procedure, -- option} { .t search -- -forward 1.0 } {2.4} @@ -1006,15 +1019,15 @@ test text-20.23 {TextSearchCmd procedure, extract line contents} { test text-20.24 {TextSearchCmd procedure, stripping newlines} { .t search the\n 1.0 } {1.12} -test text-20.25 {TextSearchCmd procedure, stripping newlines} { +test text-20.25 {TextSearchCmd procedure, handling newlines} { .t search -regexp the\n 1.0 -} {} +} {1.12} test text-20.26 {TextSearchCmd procedure, stripping newlines} { .t search -regexp {the$} 1.0 } {1.12} -test text-20.27 {TextSearchCmd procedure, stripping newlines} { +test text-20.27 {TextSearchCmd procedure, handling newlines} { .t search -regexp \n 1.0 -} {} +} {1.15} test text-20.28 {TextSearchCmd procedure, line case conversion} { list [.t search -nocase bar 2.18] [.t search bar 2.18] } {2.23 2.13} @@ -1241,7 +1254,463 @@ test text-20.72 {TextSearchCmd, -regexp -nocase searches} { destroy .t set res } 1.0 - +test text-20.73 {TextSearchCmd, hidden text and start index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search bar 1.3 +} 1.3 +test text-20.74 {TextSearchCmd, hidden text shouldn't influence start index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.0 1.2 + .t2 search bar 1.3 +} 1.3 +test text-20.75 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + list [.t2 search -count foo foar 1.3] $foo +} {1.0 6} +test text-20.76 {TextSearchCmd, hidden text and start index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -regexp bar 1.3 +} 1.3 +test text-20.77 {TextSearchCmd, hidden text shouldn't influence start index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.0 1.2 + .t2 search -regexp bar 1.3 +} 1.3 +test text-20.78 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + list [.t2 search -regexp -count foo foar 1.3] $foo +} {1.0 6} + +test text-20.78.1 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + list [.t2 search -count foo foar 1.3] $foo +} {1.0 6} + +test text-20.78.2 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + .t2 tag add hidden 2.2 2.4 + list [.t2 search -regexp -all -count foo foar 1.3] $foo +} {{2.0 3.0 1.0} {6 4 6}} + +test text-20.78.3 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + .t2 tag add hidden 2.2 2.4 + list [.t2 search -all -count foo foar 1.3] $foo +} {{2.0 3.0 1.0} {6 4 6}} + +test text-20.79 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -count foo foobar\nfoo 1.0] $foo +} {1.0 10} + +test text-20.80 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -count foo bar\nfoo 1.0] $foo +} {1.3 7} + +test text-20.81 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -count foo \nfoo 1.0] $foo +} {1.6 4} + +test text-20.82 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -count foo bar\nfoobar\nfoo 1.0] $foo +} {1.3 14} + +test text-20.83 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -count foo bar\nfoobar\nfoobanearly 1.0 +} {} + +test text-20.84 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -regexp -count foo foobar\nfoo 1.0] $foo +} {1.0 10} + +test text-20.85 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -regexp -count foo bar\nfoo 1.0] $foo +} {1.3 7} + +test text-20.86 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -regexp -count foo \nfoo 1.0] $foo +} {1.6 4} + +test text-20.87 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -regexp -count foo bar\nfoobar\nfoo 1.0] $foo +} {1.3 14} + +test text-20.88 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -regexp -count foo bar\nfoobar\nfoobanearly 1.0 +} {} + +test text-20.89 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfaoobar\nfoobar" + .t2 search -regexp -count foo bar\nfoo 1.0 +} {2.4} + +test text-20.90 {TextSearchCmd, multiline matching end of window} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfaoobar\nfoobar" + .t2 search -regexp -count foo bar\nfoobar\n\n 1.0 +} {} + +test text-20.91 {TextSearchCmd, multiline matching end of window} { + deleteWindows + pack [text .t2] + .t2 search "\n\n" 1.0 +} {} + +test text-20.92 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -count foo foobar\nfoo end] $foo +} {2.0 10} + +test text-20.93 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -count foo bar\nfoo 1.0] $foo +} {2.3 7} + +test text-20.94 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -count foo \nfoo 1.0] $foo +} {2.6 4} + +test text-20.95 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -count foo bar\nfoobar\nfoo 1.0] $foo +} {1.3 14} + +test text-20.96 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -backwards -count foo bar\nfoobar\nfoobanearly 1.0 +} {} + +test text-20.97 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo foobar\nfoo 1.0] $foo +} {2.0 10} + +test text-20.98 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo bar\nfoo 1.0] $foo +} {2.3 7} + +test text-20.99 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo \nfoo 1.0] $foo +} {2.6 4} + +test text-20.100 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo bar\nfoobar\nfoo 1.0] $foo +} {1.3 14} + +test text-20.101 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -backwards -regexp -count foo bar\nfoobar\nfoobanearly 1.0 +} {} + +test text-20.102 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfaoobar\nfoobar" + .t2 search -backwards -regexp -count foo bar\nfoo 1.0 +} {2.4} + +test text-20.103 {TextSearchCmd, multiline matching end of window} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfaoobar\nfoobar" + .t2 search -backwards -regexp -count foo bar\nfoobar\n\n 1.0 +} {} + +test text-20.104 {TextSearchCmd, multiline matching end of window} { + deleteWindows + pack [text .t2] + .t2 search -backwards "\n\n" 1.0 +} {} + +test text-20.105 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 { Tcl_Obj *objPtr)); +static Tcl_Obj* FSNormalizeAbsolutePath + _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} + set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" + append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" + append markExpr "\[ \n\t\r\]*\\()" + .t2 search -forwards -regexp $markExpr 1.41 end +} {} + +test text-20.106 {TextSearchCmd, multiline regexp matching} { + # Practical example which crashes Tk, but only after the + # search is complete. This is memory corruption caused by + # a bug in Tcl's handling of string objects. + # (Tcl bug 635200) + deleteWindows + pack [text .t2] + .t2 insert 1.0 {static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); +static Tcl_Obj* FSNormalizeAbsolutePath + _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} + set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" + append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" + append markExpr "\[ \n\t\r\]*\\()" + .t2 search -forwards -regexp $markExpr 1.41 end +} {} + +test text-20.107 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 { +static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); +static Tcl_Obj* FSNormalizeAbsolutePath + _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} + set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" + append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" + append markExpr "\[ \n\t\r\]*\\()" + .t2 search -backwards -all -regexp $markExpr end +} {2.0} + +test text-20.108 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -all -regexp -count foo bar\nfoo 1.0 +} {1.3 2.3} + +test text-20.109 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -all -backwards -regexp -count foo bar\nfoo 1.0 +} {2.3 1.3} + +test text-20.110 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -- "blah" 3.3 1.3 +} {} + +test text-20.111 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -backwards -- "blah" 1.3 3.3 +} {} + +test text-20.112 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -backwards -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0 +} {1.31} + +test text-20.113 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -regexp -- "\[\]\")\}\[(\{\]" 1.30 "1.0 lineend" +} {1.31} + +test text-20.114 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -backwards -all -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0 +} {1.3 1.29 1.31} + +test text-20.115 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -all -regexp -- "\[\]\")\}\[(\{\]" 1.0 "1.0 lineend" +} {1.3 1.29 1.31} + +test text-20.116 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -backwards -- "\{" "1.32" 1.0 +} {1.31} + +test text-20.117 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -- "\{" 1.30 "1.0 lineend" +} {1.31} + +test text-20.118 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 { + +void +Tcl_SetObjLength(objPtr, length) + register Tcl_Obj *objPtr; /* Pointer to object. This object must + * not currently be shared. */ + register int length; /* Number of bytes desired for string + * representation of object, not including + * terminating null byte. */ +\{ + char *new; +} + set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" + append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" + append markExpr "\[ \n\t\r\]*\\()" + .t2 search -all -regexp -- $markExpr 1.0 +} {4.0} + +test text-20.119 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + set markExpr {^[a-z]+} + # This should not match, and should not wrap + .t2 search -regexp -- $markExpr end end +} {} + +test text-20.120 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + set markExpr {^[a-z]+} + # This should not match, and should not wrap + .t2 search -regexp -- $markExpr end+10c end +} {} + +test text-20.121 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + set markExpr {^[a-z]+} + # This should not match, and should not wrap + .t2 search -regexp -backwards -- $markExpr 1.0 1.0 +} {} + +test text-20.122 {TextSearchCmd, regexp linestop} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + .t2 search -regexp -- {i.*x} 1.0 +} {2.6} + +test text-20.123 {TextSearchCmd, multiline regexp nolinestop matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + .t2 search -regexp -nolinestop -- {i.*x} 1.0 +} {1.1} + +test text-20.124 {TextSearchCmd, regexp linestop} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + .t2 search -regexp -all -- {i.*x} 1.0 +} {2.6} + +test text-20.125 {TextSearchCmd, multiline regexp nolinestop matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + .t2 search -regexp -all -nolinestop -- {i.*x} 1.0 +} {1.1 1.7 2.6} + +test text-20.126 {TextSearchCmd, stop at end of line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " \t\n last line of text" + .t2 search -regexp -nolinestop -- {[^ \t]} 1.0 +} {1.3} + +test text-20.126 {TextSearchCmd, stop at end of line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " \t\n last line of text" + .t2 search -regexp -- {[^ \t]} 1.0 +} {2.3} + deleteWindows text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 pack .t2 @@ -1450,7 +1919,7 @@ test text-25.1 {TextEditCmd procedure, argument parsing} { test text-25.2 {TextEditCmd procedure, argument parsing} { list [catch {.t edit gorp} msg] $msg -} {1 {bad edit option "gorp": must be modified, redo, reset, separator or undo}} +} {1 {bad edit option "gorp": must be modified, redo, reset, separator, or undo}} test text-25.3 {TextEditUndo procedure, undoing changes} { catch {destroy .t} diff --git a/tests/textIndex.test b/tests/textIndex.test index a80af7c..0f9a468 100644 --- a/tests/textIndex.test +++ b/tests/textIndex.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textIndex.test,v 1.8 2003/04/01 21:06:54 dgp Exp $ +# RCS: @(#) $Id: textIndex.test,v 1.9 2003/05/19 13:04:24 vincentdarley Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -654,7 +654,6 @@ test testIndex-16.1 {TkTextPrintIndex} { catch {destroy $t} } 0 - test testIndex-16.2 {TkTextPrintIndex} { set t [text .t2] $t insert end \n @@ -664,6 +663,38 @@ test testIndex-16.2 {TkTextPrintIndex} { catch {destroy $t} } 0 +test testIndex-17.1 {Object indices} { + set res {} + set t [text .t2 -height 20] + for {set i 0} {$i < 100} {incr i} { + $t insert end $i\n + } + pack $t + update + set idx @0,0 + lappend res $idx [$t index $idx] + $t yview scroll 2 pages + lappend res $idx [$t index $idx] + catch {destroy $t} + unset i + unset idx + list $res +} {{@0,0 1.0 @0,0 37.0}} + +test testIndex-18.1 {Object indices don't cache mark names} { + set res {} + text .t2 + .t2 insert 1.0 1234\n1234\n1234 + set pos "insert" + lappend res [.t2 index $pos] + .t2 mark set $pos 3.0 + lappend res [.t2 index $pos] + .t2 mark set $pos 1.0 + lappend res [.t2 index $pos] + catch {destroy .t2} + set res +} {3.4 3.0 1.0} + # cleanup rename textimage {} catch {destroy .t} diff --git a/tests/textMark.test b/tests/textMark.test index 14cfa5e..70886af 100644 --- a/tests/textMark.test +++ b/tests/textMark.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textMark.test,v 1.6 2003/04/01 21:06:54 dgp Exp $ +# RCS: @(#) $Id: textMark.test,v 1.7 2003/05/19 13:04:24 vincentdarley Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -79,7 +79,7 @@ test textMark-2.1 {TkTextMarkCmd - "names" option} courier12 { } {1 {wrong # args: should be ".t mark names"}} .t mark unset x test textMark-2.2 {TkTextMarkCmd - "names" option} courier12 { - lsort [.t mark n] + lsort [.t mark na] } {current insert} test textMark-2.3 {TkTextMarkCmd - "names" option} courier12 { .t mark set a 1.1 diff --git a/tests/textTag.test b/tests/textTag.test index d30f7a8..6a60142 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textTag.test,v 1.7 2003/04/01 21:06:55 dgp Exp $ +# RCS: @(#) $Id: textTag.test,v 1.8 2003/05/19 13:04:24 vincentdarley Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -101,7 +101,7 @@ test textTag-2.1 {TkTextTagCmd - "add" option} courier12 { } {1 {wrong # args: should be ".t tag option ?arg arg ...?"}} test textTag-2.2 {TkTextTagCmd - "add" option} courier12 { list [catch {.t tag gorp} msg] $msg -} {1 {bad tag option "gorp": must be add, bind, cget, configure, delete, lower, names, nextrange, raise, ranges, or remove}} +} {1 {bad tag option "gorp": must be add, bind, cget, configure, delete, lower, names, nextrange, prevrange, raise, ranges, or remove}} test textTag-2.3 {TkTextTagCmd - "add" option} courier12 { list [catch {.t tag add foo} msg] $msg } {1 {wrong # args: should be ".t tag add tagName index1 ?index2 index1 index2 ...?"}} @@ -313,7 +313,7 @@ test textTag-5.22 {TkTextTagCmd - "configure" option} courier12 { test textTag-6.1 {TkTextTagCmd - "delete" option} courier12 { list [catch {.t tag delete} msg] $msg -} {1 {wrong # args: should be ".t tag delete tagName tagName ..."}} +} {1 {wrong # args: should be ".t tag delete tagName ?tagName ...?"}} test textTag-6.2 {TkTextTagCmd - "delete" option} courier12 { list [catch {.t tag delete zork} msg] $msg } {0 {}} @@ -761,6 +761,15 @@ test textTag-16.7 {TkTextPickCurrent procedure} courier12 { .t index current } {3.1} +test textTag-17.1 {insert procedure inserts tags} { + .t delete 1.0 end + # Objectification of the text widget had a problem + # with inserting tags when using 'end'. Check that + # bug has been fixed. + .t insert end abcd {x} \n {} efgh {y} \n {} + .t dump -tag 1.0 end +} {tagon x 1.0 tagoff x 1.4 tagon y 2.0 tagoff y 2.4} + catch {destroy .t} # cleanup diff --git a/tests/textWind.test b/tests/textWind.test index dbe5f26..f2aed08 100644 --- a/tests/textWind.test +++ b/tests/textWind.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textWind.test,v 1.6 2003/04/01 21:06:55 dgp Exp $ +# RCS: @(#) $Id: textWind.test,v 1.7 2003/05/19 13:04:24 vincentdarley Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -18,7 +18,7 @@ tcltest::loadTestedCommands option add *Text.borderWidth 2 option add *Text.highlightThickness 2 if {$tcl_platform(platform) == "windows"} { - option add *Text.font {Courier -14} + option add *Text.font {Courier -12} } else { option add *Text.font {Courier -12} } @@ -191,7 +191,7 @@ test textWind-2.19 {TkTextWindowCmd procedure} { } {1 {unknown option "-gorp"} 1 1.0 1} test textWind-2.20 {TkTextWindowCmd procedure} { list [catch {.t window c} msg] $msg -} {1 {bad window option "c": must be cget, configure, create, or names}} +} {1 {ambiguous window option "c": must be cget, configure, create, or names}} destroy .f test textWind-2.21 {TkTextWindowCmd procedure, "names" option} { list [catch {.t window names foo} msg] $msg @@ -308,7 +308,7 @@ test textWind-4.5 {AlignParseProc and AlignPrintProc procedures} { .t window configure 1.0 -align top list [catch {.t window configure 1.0 -align gorp} msg] $msg \ [.t window configure 1.0 -align] -} {1 {bad alignment "gorp": must be baseline, bottom, center, or top} {-align {} {} center top}} +} {1 {bad align "gorp": must be baseline, bottom, center, or top} {-align {} {} center top}} test textWind-5.1 {EmbWinStructureProc procedure} {fonts} { .t delete 1.0 end -- cgit v0.12