summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tkCanvas.c6
-rw-r--r--generic/tkInt.h7
-rw-r--r--generic/tkTest.c8
-rw-r--r--generic/tkText.c3397
-rw-r--r--generic/tkText.h104
-rw-r--r--generic/tkTextBTree.c10
-rw-r--r--generic/tkTextDisp.c104
-rw-r--r--generic/tkTextImage.c95
-rw-r--r--generic/tkTextIndex.c321
-rw-r--r--generic/tkTextMark.c207
-rw-r--r--generic/tkTextTag.c1340
-rw-r--r--generic/tkTextWind.c456
-rw-r--r--generic/tkUndo.c70
-rw-r--r--generic/tkUndo.h25
-rw-r--r--generic/tkWindow.c4
15 files changed, 3652 insertions, 2502 deletions
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,393 +2095,512 @@ 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.
- */
+
+ /* Set the result */
+ if (searchSpec.resPtr != NULL) {
+ Tcl_SetObjResult(interp, searchSpec.resPtr);
+ searchSpec.resPtr = NULL;
+ }
+
+ cleanup:
+ if (searchSpec.countPtr != NULL) {
+ Tcl_DecrRefCount(searchSpec.countPtr);
+ }
+ if (searchSpec.resPtr != NULL) {
+ Tcl_DecrRefCount(searchSpec.resPtr);
+ }
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextSearchGetLineIndex --
+ *
+ * Extract a row, text offset index position from an objPtr
+ *
+ * This means we ignore any embedded windows/images and
+ * elidden text (unless we are searching that).
+ *
+ * Results:
+ * Standard Tcl error code (with a message in the interpreter
+ * on error conditions).
+ *
+ * The offset placed in offsetPosPtr is a utf-8 char* byte index for
+ * exact searches, and a Unicode character index for regexp
+ * searches.
+ *
+ * The line number should start at zero (searches which wrap
+ * around assume the first line is numbered 0).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TextSearchGetLineIndex(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 */
+{
+ CONST TkTextIndex *indexPtr;
+ int line;
+ TkText *textPtr = (TkText*)(searchSpecPtr->clientData);
+
+ indexPtr = TkTextGetIndexFromObj(interp, textPtr, objPtr);
+ if (indexPtr == NULL) {
+ return TCL_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);
+ }
+
+ *linePosPtr = line;
- goto nextLine;
- }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextSearchIndexInLine --
+ *
+ * Find textual index of 'byteIndex' in the searchable
+ * characters of 'linePtr'.
+ *
+ * This means we ignore any embedded windows/images and
+ * elidden text (unless we are searching that).
+ *
+ * Results:
+ * The returned index is a utf-8 char* byte index for exact
+ * searches, and a Unicode character index for regexp searches.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * 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.
- */
+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);
- 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;
+ 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);
+ }
}
- Tcl_DStringAppend(&line, segPtr->body.chars, segPtr->size);
- }
- if (!exact) {
- Tcl_DStringSetLength(&line, Tcl_DStringLength(&line)-1);
}
- startOfLine = Tcl_DStringValue(&line);
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * If we're ignoring case, convert the line to lower case.
- */
+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.
+ */
- if (noCase) {
- Tcl_DStringSetLength(&line,
- Tcl_UtfToLower(Tcl_DStringValue(&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.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * 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.
- */
+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);
- indexInDString = startingByte;
- for (segPtr = linePtr->segPtr, leftToScan = startingByte;
- leftToScan > 0; segPtr = segPtr->nextPtr) {
- if (segPtr->typePtr != &tkTextCharType) {
- indexInDString -= segPtr->size;
- }
- leftToScan -= segPtr->size;
- }
+ 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.
+ */
- passes++;
- if ((passes == 1) ^ backwards) {
- /*
- * Only use the last part of the line.
- */
+ 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.
+ */
- firstByte = indexInDString;
- if ((firstByte >= Tcl_DStringLength(&line))
- && !((Tcl_DStringLength(&line) == 0) && !exact)) {
- goto nextLine;
- }
+ 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 {
- /*
- * Use only the first part of the line.
- */
-
- lastByte = indexInDString;
+ matchOffset += Tcl_NumUtfChars(segPtr->body.chars, -1);
}
+ } else {
+ leftToScan -= segPtr->size;
}
- 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.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;
- 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;
- }
+ 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 {
- lineNum++;
- if (!searchWholeText) {
- if (lineNum > stopLine) {
- break;
- }
- } else if (lineNum >= numLines) {
- lineNum = 0;
- }
+ leftToScan -= Tcl_NumUtfChars(segPtr->body.chars, -1);
}
- Tcl_DStringSetLength(&line, 0);
- }
- done:
- Tcl_DStringFree(&line);
- if (noCase && exact) {
- Tcl_DStringFree(&patDString);
}
- if (patObj != NULL) {
- Tcl_DecrRefCount(patObj);
+ /*
+ * 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 code;
+ return 1;
}
/*
@@ -2380,20 +2625,27 @@ TextSearchCmd(textPtr, interp, argc, argv)
*/
TkTextTabArray *
-TkTextGetTabs(interp, tkwin, string)
+TkTextGetTabs(interp, tkwin, stringPtr)
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. */
+ Tcl_Obj *stringPtr; /* Description of the tab stops.
+ * See the text manual entry for
+ * details. */
{
- int argc, i, count, c;
- CONST char **argv;
+ int objc, i, count;
+ Tcl_Obj **objv;
TkTextTabArray *tabArrayPtr;
TkTextTab *tabPtr;
Tcl_UniChar ch;
- if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
+ /* 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;
}
@@ -2403,8 +2655,8 @@ TkTextGetTabs(interp, tkwin, string)
*/
count = 0;
- for (i = 0; i < argc; i++) {
- c = argv[i][0];
+ for (i = 0; i < objc; i++) {
+ char c = Tcl_GetString(objv[i])[0];
if ((c != 'l') && (c != 'r') && (c != 'c') && (c != 'n')) {
count++;
}
@@ -2418,8 +2670,10 @@ TkTextGetTabs(interp, tkwin, string)
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)
+ 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;
}
@@ -2431,40 +2685,26 @@ TkTextGetTabs(interp, tkwin, string)
*/
tabPtr->alignment = LEFT;
- if ((i+1) == argc) {
+ if ((i+1) == objc) {
continue;
}
- Tcl_UtfToUniChar(argv[i+1], &ch);
+ /* 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;
- 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);
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], tabOptionStrings,
+ "tab alignment", 0, &index) != TCL_OK) {
goto error;
}
+ tabPtr->alignment = ((TkTextTabAlign)index);
}
- ckfree((char *) argv);
return tabArrayPtr;
error:
ckfree((char *) tabArrayPtr);
- ckfree((char *) argv);
return NULL;
}
@@ -2488,13 +2728,13 @@ TkTextGetTabs(interp, tkwin, string)
*/
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 <<Modified>>"
- */
+ 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 <<Modified>>"
+ */
+
+ 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(&copy);
+ 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 <<Selection>>"
+ * 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 <<Selection>>"
+ */
+
+ 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 <<Selection>>"
+ */
+
+ 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 <<Selection>>"
+ * 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<objc;i++) {
+ res = Tcl_EvalObjEx(interp, objv[i], TCL_EVAL_GLOBAL);
+ if (res != TCL_OK) {
+ return res;
+ }
+ }
+ return res;
+ } else {
+ return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
+ }
+}
+
diff --git a/generic/tkUndo.h b/generic/tkUndo.h
index 4776b3d..9b072e6 100644
--- a/generic/tkUndo.h
+++ b/generic/tkUndo.h
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkUndo.h,v 1.1 2002/06/21 23:09:55 hobbs Exp $
+ * RCS: @(#) $Id: tkUndo.h,v 1.2 2003/05/19 13:04:24 vincentdarley Exp $
*/
#ifndef _TKUNDO
@@ -28,26 +28,29 @@
typedef enum {
TK_UNDO_SEPARATOR, /* Marker */
- TK_UNDO_ACTION /* Command */
+ TK_UNDO_ACTION, /* Command */
+ TK_UNDO_ACTION_LIST /* Command list */
} TkUndoAtomType;
/* struct defining the basic undo/redo stack element */
typedef struct TkUndoAtom {
- TkUndoAtomType type; /* The type that will trigger the
- * required action*/
- Tcl_Obj * apply; /* Command to apply the action that was taken */
- Tcl_Obj * revert; /* The command to undo the action */
+ TkUndoAtomType type; /* The type that will trigger the
+ * required action*/
+ Tcl_Obj *apply; /* Command to apply the action that
+ * was taken */
+ Tcl_Obj *revert; /* The command to undo the action */
struct TkUndoAtom * next; /* Pointer to the next element in the
- * stack */
+ * stack */
} TkUndoAtom;
/* struct defining the basic undo/redo stack element */
typedef struct TkUndoRedoStack {
- TkUndoAtom * undoStack; /* The undo stack */
- TkUndoAtom * redoStack; /* The redo stack */
- Tcl_Interp * interp ; /* The interpreter in which to execute the revert and apply scripts */
+ TkUndoAtom * undoStack; /* The undo stack */
+ TkUndoAtom * redoStack; /* The redo stack */
+ Tcl_Interp * interp ; /* The interpreter in which to execute
+ * the revert and apply scripts */
int maxdepth;
int depth;
} TkUndoRedoStack;
@@ -78,7 +81,7 @@ EXTERN void TkUndoFreeStack _ANSI_ARGS_((TkUndoRedoStack * stack));
EXTERN void TkUndoInsertUndoSeparator _ANSI_ARGS_((TkUndoRedoStack * stack));
EXTERN void TkUndoPushAction _ANSI_ARGS_((TkUndoRedoStack * stack,
- Tcl_DString * actionScript, Tcl_DString * revertScript));
+ Tcl_Obj *actionScript, Tcl_Obj *revertScript, int isList));
EXTERN int TkUndoRevert _ANSI_ARGS_((TkUndoRedoStack * stack));
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index c1e6499..401130b 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.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: tkWindow.c,v 1.56 2003/01/28 20:39:17 jenglish Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.57 2003/05/19 13:04:24 vincentdarley Exp $
*/
#include "tkPort.h"
@@ -168,7 +168,7 @@ static TkCmd commands[] = {
{"scale", NULL, Tk_ScaleObjCmd, 1, 0},
{"scrollbar", Tk_ScrollbarCmd, NULL, 1, 1},
{"spinbox", NULL, Tk_SpinboxObjCmd, 1, 0},
- {"text", Tk_TextCmd, NULL, 1, 1},
+ {"text", NULL, Tk_TextObjCmd, 1, 1},
{"toplevel", NULL, Tk_ToplevelObjCmd, 0, 0},
/*
generated by cgit v0.12 at 2024-11-23 11:15:11 (GMT)