1 /*
2  * tkText.c --
3  *
4  *	This module provides a big chunk of the implementation of
5  *	multi-line editable text widgets for Tk.  Among other things,
6  *	it provides the Tcl command interfaces to text widgets and
7  *	the display code.  The B-tree representation of text is
8  *	implemented elsewhere.
9  *
10  * Copyright (c) 1992-1994 The Regents of the University of California.
11  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
12  *
13  * See the file "license.terms" for information on usage and redistribution
14  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15  *
16  * SCCS: @(#) tkText.c 1.91 96/05/16 13:19:58
17  */
18 
19 #include "tkInt.h"
20 #include "tkDefault.h"
21 
22 #ifdef MAC_TCL
23 #define Style TkStyle
24 #define DInfo TkDInfo
25 #endif
26 
27 #include "tkText.h"
28 
29 /*
30  * Information used to parse text configuration options:
31  */
32 
33 static Tk_ConfigSpec configSpecs[] = {
34     {TK_CONFIG_BORDER, "-background", "background", "Background",
35 	DEF_TEXT_BG_COLOR, Tk_Offset(TkText, border), TK_CONFIG_COLOR_ONLY},
36     {TK_CONFIG_BORDER, "-background", "background", "Background",
37 	DEF_TEXT_BG_MONO, Tk_Offset(TkText, border), TK_CONFIG_MONO_ONLY},
38     {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
39 	(char *) NULL, 0, 0},
40     {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
41 	(char *) NULL, 0, 0},
42     {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
43 	DEF_TEXT_BORDER_WIDTH, Tk_Offset(TkText, borderWidth), 0},
44     {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
45 	DEF_TEXT_CURSOR, Tk_Offset(TkText, cursor), TK_CONFIG_NULL_OK},
46     {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
47 	"ExportSelection", DEF_TEXT_EXPORT_SELECTION,
48 	Tk_Offset(TkText, exportSelection), 0},
49     {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
50 	(char *) NULL, 0, 0},
51     {TK_CONFIG_FONT, "-font", "font", "Font",
52 	DEF_TEXT_FONT, Tk_Offset(TkText, fontPtr), 0},
53     {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
54 	DEF_TEXT_FG, Tk_Offset(TkText, fgColor), 0},
55     {TK_CONFIG_PIXELS, "-height", "height", "Height",
56 	DEF_TEXT_HEIGHT, Tk_Offset(TkText, height), 0},
57     {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
58 	"HighlightBackground", DEF_TEXT_HIGHLIGHT_BG,
59 	Tk_Offset(TkText, highlightBgColorPtr), 0},
60     {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
61 	DEF_TEXT_HIGHLIGHT, Tk_Offset(TkText, highlightColorPtr), 0},
62     {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
63 	"HighlightThickness",
64 	DEF_TEXT_HIGHLIGHT_WIDTH, Tk_Offset(TkText, highlightWidth), 0},
65     {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
66 	DEF_TEXT_INSERT_BG, Tk_Offset(TkText, insertBorder), 0},
67     {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
68 	DEF_TEXT_INSERT_BD_COLOR, Tk_Offset(TkText, insertBorderWidth),
69 	TK_CONFIG_COLOR_ONLY},
70     {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
71 	DEF_TEXT_INSERT_BD_MONO, Tk_Offset(TkText, insertBorderWidth),
72 	TK_CONFIG_MONO_ONLY},
73     {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
74 	DEF_TEXT_INSERT_OFF_TIME, Tk_Offset(TkText, insertOffTime), 0},
75     {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
76 	DEF_TEXT_INSERT_ON_TIME, Tk_Offset(TkText, insertOnTime), 0},
77     {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
78 	DEF_TEXT_INSERT_WIDTH, Tk_Offset(TkText, insertWidth), 0},
79     {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
80 	DEF_TEXT_PADX, Tk_Offset(TkText, padX), 0},
81     {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
82 	DEF_TEXT_PADY, Tk_Offset(TkText, padY), 0},
83     {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
84 	DEF_TEXT_RELIEF, Tk_Offset(TkText, relief), 0},
85     {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
86 	DEF_TEXT_SELECT_COLOR, Tk_Offset(TkText, selBorder),
87 	TK_CONFIG_COLOR_ONLY},
88     {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
89 	DEF_TEXT_SELECT_MONO, Tk_Offset(TkText, selBorder),
90 	TK_CONFIG_MONO_ONLY},
91     {TK_CONFIG_STRING, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
92 	DEF_TEXT_SELECT_BD_COLOR, Tk_Offset(TkText, selBdString),
93 	TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
94     {TK_CONFIG_STRING, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
95 	DEF_TEXT_SELECT_BD_MONO, Tk_Offset(TkText, selBdString),
96 	TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
97     {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
98 	DEF_TEXT_SELECT_FG_COLOR, Tk_Offset(TkText, selFgColorPtr),
99 	TK_CONFIG_COLOR_ONLY},
100     {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
101 	DEF_TEXT_SELECT_FG_MONO, Tk_Offset(TkText, selFgColorPtr),
102 	TK_CONFIG_MONO_ONLY},
103     {TK_CONFIG_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
104 	DEF_TEXT_SET_GRID, Tk_Offset(TkText, setGrid), 0},
105     {TK_CONFIG_PIXELS, "-spacing1", "spacing1", "Spacing",
106 	DEF_TEXT_SPACING1, Tk_Offset(TkText, spacing1),
107 	TK_CONFIG_DONT_SET_DEFAULT},
108     {TK_CONFIG_PIXELS, "-spacing2", "spacing2", "Spacing",
109 	DEF_TEXT_SPACING2, Tk_Offset(TkText, spacing2),
110 	TK_CONFIG_DONT_SET_DEFAULT},
111     {TK_CONFIG_PIXELS, "-spacing3", "spacing3", "Spacing",
112 	DEF_TEXT_SPACING3, Tk_Offset(TkText, spacing3),
113 	TK_CONFIG_DONT_SET_DEFAULT},
114     {TK_CONFIG_UID, "-state", "state", "State",
115 	DEF_TEXT_STATE, Tk_Offset(TkText, state), 0},
116     {TK_CONFIG_STRING, "-tabs", "tabs", "Tabs",
117 	DEF_TEXT_TABS, Tk_Offset(TkText, tabOptionString), TK_CONFIG_NULL_OK},
118     {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
119 	DEF_TEXT_TAKE_FOCUS, Tk_Offset(TkText, takeFocus),
120 	TK_CONFIG_NULL_OK},
121     {TK_CONFIG_INT, "-width", "width", "Width",
122 	DEF_TEXT_WIDTH, Tk_Offset(TkText, width), 0},
123     {TK_CONFIG_UID, "-wrap", "wrap", "Wrap",
124 	DEF_TEXT_WRAP, Tk_Offset(TkText, wrapMode), 0},
125     {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
126 	DEF_TEXT_XSCROLL_COMMAND, Tk_Offset(TkText, xScrollCmd),
127 	TK_CONFIG_NULL_OK},
128     {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
129 	DEF_TEXT_YSCROLL_COMMAND, Tk_Offset(TkText, yScrollCmd),
130 	TK_CONFIG_NULL_OK},
131     {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
132 	(char *) NULL, 0, 0}
133 };
134 
135 /*
136  * Tk_Uid's used to represent text states:
137  */
138 
139 Tk_Uid tkTextCharUid = NULL;
140 Tk_Uid tkTextDisabledUid = NULL;
141 Tk_Uid tkTextNoneUid = NULL;
142 Tk_Uid tkTextNormalUid = NULL;
143 Tk_Uid tkTextWordUid = NULL;
144 
145 /*
146  * Boolean variable indicating whether or not special debugging code
147  * should be executed.
148  */
149 
150 int tkTextDebug = 0;
151 
152 /*
153  * Forward declarations for procedures defined later in this file:
154  */
155 
156 static int		ConfigureText _ANSI_ARGS_((Tcl_Interp *interp,
157 			    TkText *textPtr, int argc, char **argv, int flags));
158 static int		DeleteChars _ANSI_ARGS_((TkText *textPtr,
159 			    char *index1String, char *index2String));
160 static void		DestroyText _ANSI_ARGS_((char *memPtr));
161 static void		InsertChars _ANSI_ARGS_((TkText *textPtr,
162 			    TkTextIndex *indexPtr, char *string));
163 static void		TextBlinkProc _ANSI_ARGS_((ClientData clientData));
164 static void		TextCmdDeletedProc _ANSI_ARGS_((
165 			    ClientData clientData));
166 static void		TextEventProc _ANSI_ARGS_((ClientData clientData,
167 			    XEvent *eventPtr));
168 static int		TextFetchSelection _ANSI_ARGS_((ClientData clientData,
169 			    int offset, char *buffer, int maxBytes));
170 static int		TextSearchCmd _ANSI_ARGS_((TkText *textPtr,
171 			    Tcl_Interp *interp, int argc, char **argv));
172 static int		TextWidgetCmd _ANSI_ARGS_((ClientData clientData,
173 			    Tcl_Interp *interp, int argc, char **argv));
174 static int		TextDumpCmd _ANSI_ARGS_((TkText *textPtr,
175 			    Tcl_Interp *interp, int argc, char **argv));
176 static void		DumpLine _ANSI_ARGS_((Tcl_Interp *interp,
177 			    TkText *textPtr, int what, TkTextLine *linePtr,
178 			    int start, int end, int lineno, char *command));
179 static int		DumpSegment _ANSI_ARGS_((Tcl_Interp *interp, char *key,
180 			    char *value, char * command, int lineno, int offset,
181 			    int what));
182 
183 
184 /*
185  *--------------------------------------------------------------
186  *
187  * Tk_TextCmd --
188  *
189  *	This procedure is invoked to process the "text" Tcl command.
190  *	See the user documentation for details on what it does.
191  *
192  * Results:
193  *	A standard Tcl result.
194  *
195  * Side effects:
196  *	See the user documentation.
197  *
198  *--------------------------------------------------------------
199  */
200 
201 int
Tk_TextCmd(clientData,interp,argc,argv)202 Tk_TextCmd(clientData, interp, argc, argv)
203     ClientData clientData;	/* Main window associated with
204 				 * interpreter. */
205     Tcl_Interp *interp;		/* Current interpreter. */
206     int argc;			/* Number of arguments. */
207     char **argv;		/* Argument strings. */
208 {
209     Tk_Window tkwin = (Tk_Window) clientData;
210     Tk_Window new;
211     register TkText *textPtr;
212     TkTextIndex startIndex;
213 
214     if (argc < 2) {
215 	Tcl_AppendResult(interp, "wrong # args: should be \"",
216 		argv[0], " pathName ?options?\"", (char *) NULL);
217 	return TCL_ERROR;
218     }
219 
220     /*
221      * Perform once-only initialization:
222      */
223 
224     if (tkTextNormalUid == NULL) {
225 	tkTextCharUid = Tk_GetUid("char");
226 	tkTextDisabledUid = Tk_GetUid("disabled");
227 	tkTextNoneUid = Tk_GetUid("none");
228 	tkTextNormalUid = Tk_GetUid("normal");
229 	tkTextWordUid = Tk_GetUid("word");
230     }
231 
232     /*
233      * Create the window.
234      */
235 
236     new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
237     if (new == NULL) {
238 	return TCL_ERROR;
239     }
240 
241     textPtr = (TkText *) ckalloc(sizeof(TkText));
242     textPtr->tkwin = new;
243     textPtr->display = Tk_Display(new);
244     textPtr->interp = interp;
245     textPtr->widgetCmd = Tcl_CreateCommand(interp,
246 	    Tk_PathName(textPtr->tkwin), TextWidgetCmd,
247 	    (ClientData) textPtr, TextCmdDeletedProc);
248     textPtr->tree = TkBTreeCreate(textPtr);
249     Tcl_InitHashTable(&textPtr->tagTable, TCL_STRING_KEYS);
250     textPtr->numTags = 0;
251     Tcl_InitHashTable(&textPtr->markTable, TCL_STRING_KEYS);
252     Tcl_InitHashTable(&textPtr->windowTable, TCL_STRING_KEYS);
253     textPtr->state = tkTextNormalUid;
254     textPtr->border = NULL;
255     textPtr->borderWidth = 0;
256     textPtr->padX = 0;
257     textPtr->padY = 0;
258     textPtr->relief = TK_RELIEF_FLAT;
259     textPtr->highlightWidth = 0;
260     textPtr->highlightBgColorPtr = NULL;
261     textPtr->highlightColorPtr = NULL;
262     textPtr->cursor = None;
263     textPtr->fgColor = NULL;
264     textPtr->fontPtr = NULL;
265     textPtr->charWidth = 1;
266     textPtr->spacing1 = 0;
267     textPtr->spacing2 = 0;
268     textPtr->spacing3 = 0;
269     textPtr->tabOptionString = NULL;
270     textPtr->tabArrayPtr = NULL;
271     textPtr->wrapMode = tkTextCharUid;
272     textPtr->width = 0;
273     textPtr->height = 0;
274     textPtr->setGrid = 0;
275     textPtr->prevWidth = Tk_Width(new);
276     textPtr->prevHeight = Tk_Height(new);
277     TkTextCreateDInfo(textPtr);
278     TkTextMakeIndex(textPtr->tree, 0, 0, &startIndex);
279     TkTextSetYView(textPtr, &startIndex, 0);
280     textPtr->selTagPtr = NULL;
281     textPtr->selBorder = NULL;
282     textPtr->selBdString = NULL;
283     textPtr->selFgColorPtr = NULL;
284     textPtr->exportSelection = 1;
285     textPtr->abortSelections = 0;
286     textPtr->insertMarkPtr = NULL;
287     textPtr->insertBorder = NULL;
288     textPtr->insertWidth = 0;
289     textPtr->insertBorderWidth = 0;
290     textPtr->insertOnTime = 0;
291     textPtr->insertOffTime = 0;
292     textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
293     textPtr->bindingTable = NULL;
294     textPtr->currentMarkPtr = NULL;
295     textPtr->pickEvent.type = LeaveNotify;
296     textPtr->pickEvent.xcrossing.x = 0;
297     textPtr->pickEvent.xcrossing.y = 0;
298     textPtr->numCurTags = 0;
299     textPtr->curTagArrayPtr = NULL;
300     textPtr->takeFocus = NULL;
301     textPtr->xScrollCmd = NULL;
302     textPtr->yScrollCmd = NULL;
303     textPtr->flags = 0;
304 
305     /*
306      * Create the "sel" tag and the "current" and "insert" marks.
307      */
308 
309     textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel");
310     textPtr->selTagPtr->reliefString = (char *) ckalloc(7);
311     strcpy(textPtr->selTagPtr->reliefString, "raised");
312     textPtr->selTagPtr->relief = TK_RELIEF_RAISED;
313     textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &startIndex);
314     textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &startIndex);
315 
316     Tk_SetClass(new, "Text");
317     Tk_CreateEventHandler(textPtr->tkwin,
318 	    ExposureMask|StructureNotifyMask|FocusChangeMask,
319 	    TextEventProc, (ClientData) textPtr);
320     Tk_CreateEventHandler(textPtr->tkwin, KeyPressMask|KeyReleaseMask
321 	    |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
322 	    |LeaveWindowMask|PointerMotionMask, TkTextBindProc,
323 	    (ClientData) textPtr);
324     Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, XA_STRING,
325 	    TextFetchSelection, (ClientData) textPtr, XA_STRING);
326     if (ConfigureText(interp, textPtr, argc-2, argv+2, 0) != TCL_OK) {
327 	Tk_DestroyWindow(textPtr->tkwin);
328 	return TCL_ERROR;
329     }
330     interp->result = Tk_PathName(textPtr->tkwin);
331 
332     return TCL_OK;
333 }
334 
335 /*
336  *--------------------------------------------------------------
337  *
338  * TextWidgetCmd --
339  *
340  *	This procedure is invoked to process the Tcl command
341  *	that corresponds to a text widget.  See the user
342  *	documentation for details on what it does.
343  *
344  * Results:
345  *	A standard Tcl result.
346  *
347  * Side effects:
348  *	See the user documentation.
349  *
350  *--------------------------------------------------------------
351  */
352 
353 static int
TextWidgetCmd(clientData,interp,argc,argv)354 TextWidgetCmd(clientData, interp, argc, argv)
355     ClientData clientData;	/* Information about text widget. */
356     Tcl_Interp *interp;		/* Current interpreter. */
357     int argc;			/* Number of arguments. */
358     char **argv;		/* Argument strings. */
359 {
360     register TkText *textPtr = (TkText *) clientData;
361     int result = TCL_OK;
362     size_t length;
363     int c;
364     TkTextIndex index1, index2;
365 
366     if (argc < 2) {
367 	Tcl_AppendResult(interp, "wrong # args: should be \"",
368 		argv[0], " option ?arg arg ...?\"", (char *) NULL);
369 	return TCL_ERROR;
370     }
371     Tcl_Preserve((ClientData) textPtr);
372     c = argv[1][0];
373     length = strlen(argv[1]);
374     if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
375 	int x, y, width, height;
376 
377 	if (argc != 3) {
378 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
379 		    argv[0], " bbox index\"", (char *) NULL);
380 	    result = TCL_ERROR;
381 	    goto done;
382 	}
383 	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
384 	    result = TCL_ERROR;
385 	    goto done;
386 	}
387 	if (TkTextCharBbox(textPtr, &index1, &x, &y, &width, &height) == 0) {
388 	    sprintf(interp->result, "%d %d %d %d", x, y, width, height);
389 	}
390     } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
391 	    && (length >= 2)) {
392 	if (argc != 3) {
393 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
394 		    argv[0], " cget option\"",
395 		    (char *) NULL);
396 	    result = TCL_ERROR;
397 	    goto done;
398 	}
399 	result = Tk_ConfigureValue(interp, textPtr->tkwin, configSpecs,
400 		(char *) textPtr, argv[2], 0);
401     } else if ((c == 'c') && (strncmp(argv[1], "compare", length) == 0)
402 	    && (length >= 3)) {
403 	int relation, value;
404 	char *p;
405 
406 	if (argc != 5) {
407 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
408 		    argv[0], " compare index1 op index2\"", (char *) NULL);
409 	    result = TCL_ERROR;
410 	    goto done;
411 	}
412 	if ((TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK)
413 		|| (TkTextGetIndex(interp, textPtr, argv[4], &index2)
414 		!= TCL_OK)) {
415 	    result = TCL_ERROR;
416 	    goto done;
417 	}
418 	relation = TkTextIndexCmp(&index1, &index2);
419 	p = argv[3];
420 	if (p[0] == '<') {
421 		value = (relation < 0);
422 	    if ((p[1] == '=') && (p[2] == 0)) {
423 		value = (relation <= 0);
424 	    } else if (p[1] != 0) {
425 		compareError:
426 		Tcl_AppendResult(interp, "bad comparison operator \"",
427 			argv[3], "\": must be <, <=, ==, >=, >, or !=",
428 			(char *) NULL);
429 		result = TCL_ERROR;
430 		goto done;
431 	    }
432 	} else if (p[0] == '>') {
433 		value = (relation > 0);
434 	    if ((p[1] == '=') && (p[2] == 0)) {
435 		value = (relation >= 0);
436 	    } else if (p[1] != 0) {
437 		goto compareError;
438 	    }
439 	} else if ((p[0] == '=') && (p[1] == '=') && (p[2] == 0)) {
440 	    value = (relation == 0);
441 	} else if ((p[0] == '!') && (p[1] == '=') && (p[2] == 0)) {
442 	    value = (relation != 0);
443 	} else {
444 	    goto compareError;
445 	}
446 	interp->result = (value) ? "1" : "0";
447     } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
448 	    && (length >= 3)) {
449 	if (argc == 2) {
450 	    result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
451 		    (char *) textPtr, (char *) NULL, 0);
452 	} else if (argc == 3) {
453 	    result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
454 		    (char *) textPtr, argv[2], 0);
455 	} else {
456 	    result = ConfigureText(interp, textPtr, argc-2, argv+2,
457 		    TK_CONFIG_ARGV_ONLY);
458 	}
459     } else if ((c == 'd') && (strncmp(argv[1], "debug", length) == 0)
460 	    && (length >= 3)) {
461 	if (argc > 3) {
462 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
463 		    argv[0], " debug boolean\"", (char *) NULL);
464 	    result = TCL_ERROR;
465 	    goto done;
466 	}
467 	if (argc == 2) {
468 	    interp->result = (tkBTreeDebug) ? "1" : "0";
469 	} else {
470 	    if (Tcl_GetBoolean(interp, argv[2], &tkBTreeDebug) != TCL_OK) {
471 		result = TCL_ERROR;
472 		goto done;
473 	    }
474 	    tkTextDebug = tkBTreeDebug;
475 	}
476     } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
477 	    && (length >= 3)) {
478 	if ((argc != 3) && (argc != 4)) {
479 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
480 		    argv[0], " delete index1 ?index2?\"", (char *) NULL);
481 	    result = TCL_ERROR;
482 	    goto done;
483 	}
484 	if (textPtr->state == tkTextNormalUid) {
485 	    result = DeleteChars(textPtr, argv[2],
486 		    (argc == 4) ? argv[3] : (char *) NULL);
487 	}
488     } else if ((c == 'd') && (strncmp(argv[1], "dlineinfo", length) == 0)
489 	    && (length >= 2)) {
490 	int x, y, width, height, base;
491 
492 	if (argc != 3) {
493 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
494 		    argv[0], " dlineinfo index\"", (char *) NULL);
495 	    result = TCL_ERROR;
496 	    goto done;
497 	}
498 	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
499 	    result = TCL_ERROR;
500 	    goto done;
501 	}
502 	if (TkTextDLineInfo(textPtr, &index1, &x, &y, &width, &height, &base)
503 		== 0) {
504 	    sprintf(interp->result, "%d %d %d %d %d", x, y, width,
505 		    height, base);
506 	}
507     } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
508 	if ((argc != 3) && (argc != 4)) {
509 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
510 		    argv[0], " get index1 ?index2?\"", (char *) NULL);
511 	    result = TCL_ERROR;
512 	    goto done;
513 	}
514 	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
515 	    result = TCL_ERROR;
516 	    goto done;
517 	}
518 	if (argc == 3) {
519 	    index2 = index1;
520 	    TkTextIndexForwChars(&index2, 1, &index2);
521 	} else if (TkTextGetIndex(interp, textPtr, argv[3], &index2)
522 		!= TCL_OK) {
523 	    result = TCL_ERROR;
524 	    goto done;
525 	}
526 	if (TkTextIndexCmp(&index1, &index2) >= 0) {
527 	    goto done;
528 	}
529 	while (1) {
530 	    int offset, last, savedChar;
531 	    TkTextSegment *segPtr;
532 
533 	    segPtr = TkTextIndexToSeg(&index1, &offset);
534 	    last = segPtr->size;
535 	    if (index1.linePtr == index2.linePtr) {
536 		int last2;
537 
538 		if (index2.charIndex == index1.charIndex) {
539 		    break;
540 		}
541 		last2 = index2.charIndex - index1.charIndex + offset;
542 		if (last2 < last) {
543 		    last = last2;
544 		}
545 	    }
546 	    if (segPtr->typePtr == &tkTextCharType) {
547 		savedChar = segPtr->body.chars[last];
548 		segPtr->body.chars[last] = 0;
549 		Tcl_AppendResult(interp, segPtr->body.chars + offset,
550 			(char *) NULL);
551 		segPtr->body.chars[last] = savedChar;
552 	    }
553 	    TkTextIndexForwChars(&index1, last-offset, &index1);
554 	}
555     } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
556 	    && (length >= 3)) {
557 	if (argc != 3) {
558 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
559 		    argv[0], " index index\"",
560 		    (char *) NULL);
561 	    result = TCL_ERROR;
562 	    goto done;
563 	}
564 	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
565 	    result = TCL_ERROR;
566 	    goto done;
567 	}
568 	TkTextPrintIndex(&index1, interp->result);
569     } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
570 	    && (length >= 3)) {
571 	int i, j, numTags;
572 	char **tagNames;
573 	TkTextTag **oldTagArrayPtr;
574 
575 	if (argc < 4) {
576 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
577 		    argv[0],
578 		    " insert index chars ?tagList chars tagList ...?\"",
579 		    (char *) NULL);
580 	    result = TCL_ERROR;
581 	    goto done;
582 	}
583 	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
584 	    result = TCL_ERROR;
585 	    goto done;
586 	}
587 	if (textPtr->state == tkTextNormalUid) {
588 	    for (j = 3;  j < argc; j += 2) {
589 		InsertChars(textPtr, &index1, argv[j]);
590 		if (argc > (j+1)) {
591 		    TkTextIndexForwChars(&index1, (int) strlen(argv[j]),
592 			    &index2);
593 		    oldTagArrayPtr = TkBTreeGetTags(&index1, &numTags);
594 		    if (oldTagArrayPtr != NULL) {
595 			for (i = 0; i < numTags; i++) {
596 			    TkBTreeTag(&index1, &index2, oldTagArrayPtr[i], 0);
597 			}
598 			ckfree((char *) oldTagArrayPtr);
599 		    }
600 		    if (Tcl_SplitList(interp, argv[j+1], &numTags, &tagNames)
601 			    != TCL_OK) {
602 			result = TCL_ERROR;
603 			goto done;
604 		    }
605 		    for (i = 0; i < numTags; i++) {
606 			TkBTreeTag(&index1, &index2,
607 				TkTextCreateTag(textPtr, tagNames[i]), 1);
608 		    }
609 		    ckfree((char *) tagNames);
610 		    index1 = index2;
611 		}
612 	    }
613 	}
614     } else if ((c == 'd') && (strncmp(argv[1], "dump", length) == 0)) {
615 	result = TextDumpCmd(textPtr, interp, argc, argv);
616     } else if ((c == 'm') && (strncmp(argv[1], "mark", length) == 0)) {
617 	result = TkTextMarkCmd(textPtr, interp, argc, argv);
618     } else if ((c == 's') && (strcmp(argv[1], "scan") == 0) && (length >= 2)) {
619 	result = TkTextScanCmd(textPtr, interp, argc, argv);
620     } else if ((c == 's') && (strcmp(argv[1], "search") == 0)
621 	    && (length >= 3)) {
622 	result = TextSearchCmd(textPtr, interp, argc, argv);
623     } else if ((c == 's') && (strcmp(argv[1], "see") == 0) && (length >= 3)) {
624 	result = TkTextSeeCmd(textPtr, interp, argc, argv);
625     } else if ((c == 't') && (strcmp(argv[1], "tag") == 0)) {
626 	result = TkTextTagCmd(textPtr, interp, argc, argv);
627     } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
628 	result = TkTextWindowCmd(textPtr, interp, argc, argv);
629     } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
630 	result = TkTextXviewCmd(textPtr, interp, argc, argv);
631     } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)
632 	    && (length >= 2)) {
633 	result = TkTextYviewCmd(textPtr, interp, argc, argv);
634     } else {
635 	Tcl_AppendResult(interp, "bad option \"", argv[1],
636 		"\": must be bbox, cget, compare, configure, debug, delete, ",
637 		"dlineinfo, get, index, insert, mark, scan, search, see, ",
638 		"tag, window, xview, or yview",
639 		(char *) NULL);
640 	result = TCL_ERROR;
641     }
642 
643     done:
644     Tcl_Release((ClientData) textPtr);
645     return result;
646 }
647 
648 /*
649  *----------------------------------------------------------------------
650  *
651  * DestroyText --
652  *
653  *	This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
654  *	to clean up the internal structure of a text at a safe time
655  *	(when no-one is using it anymore).
656  *
657  * Results:
658  *	None.
659  *
660  * Side effects:
661  *	Everything associated with the text is freed up.
662  *
663  *----------------------------------------------------------------------
664  */
665 
666 static void
DestroyText(memPtr)667 DestroyText(memPtr)
668     char *memPtr;		/* Info about text widget. */
669 {
670     register TkText *textPtr = (TkText *) memPtr;
671     Tcl_HashSearch search;
672     Tcl_HashEntry *hPtr;
673     TkTextTag *tagPtr;
674 
675     /*
676      * Free up all the stuff that requires special handling, then
677      * let Tk_FreeOptions handle all the standard option-related
678      * stuff.  Special note:  free up display-related information
679      * before deleting the B-tree, since display-related stuff
680      * may refer to stuff in the B-tree.
681      */
682 
683     TkTextFreeDInfo(textPtr);
684     TkBTreeDestroy(textPtr->tree);
685     for (hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search);
686 	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
687 	tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
688 	TkTextFreeTag(textPtr, tagPtr);
689     }
690     Tcl_DeleteHashTable(&textPtr->tagTable);
691     for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search);
692 	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
693 	ckfree((char *) Tcl_GetHashValue(hPtr));
694     }
695     Tcl_DeleteHashTable(&textPtr->markTable);
696     if (textPtr->tabArrayPtr != NULL) {
697 	ckfree((char *) textPtr->tabArrayPtr);
698     }
699     if (textPtr->insertBlinkHandler != NULL) {
700 	Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
701     }
702     if (textPtr->bindingTable != NULL) {
703 	Tk_DeleteBindingTable(textPtr->bindingTable);
704     }
705 
706     /*
707      * NOTE: do NOT free up selBorder, selBdString, or selFgColorPtr:
708      * they are duplicates of information in the "sel" tag, which was
709      * freed up as part of deleting the tags above.
710      */
711 
712     textPtr->selBorder = NULL;
713     textPtr->selBdString = NULL;
714     textPtr->selFgColorPtr = NULL;
715     Tk_FreeOptions(configSpecs, (char *) textPtr, textPtr->display, 0);
716     ckfree((char *) textPtr);
717 }
718 
719 /*
720  *----------------------------------------------------------------------
721  *
722  * ConfigureText --
723  *
724  *	This procedure is called to process an argv/argc list, plus
725  *	the Tk option database, in order to configure (or
726  *	reconfigure) a text widget.
727  *
728  * Results:
729  *	The return value is a standard Tcl result.  If TCL_ERROR is
730  *	returned, then interp->result contains an error message.
731  *
732  * Side effects:
733  *	Configuration information, such as text string, colors, font,
734  *	etc. get set for textPtr;  old resources get freed, if there
735  *	were any.
736  *
737  *----------------------------------------------------------------------
738  */
739 
740 static int
ConfigureText(interp,textPtr,argc,argv,flags)741 ConfigureText(interp, textPtr, argc, argv, flags)
742     Tcl_Interp *interp;		/* Used for error reporting. */
743     register TkText *textPtr;	/* Information about widget;  may or may
744 				 * not already have values for some fields. */
745     int argc;			/* Number of valid entries in argv. */
746     char **argv;		/* Arguments. */
747     int flags;			/* Flags to pass to Tk_ConfigureWidget. */
748 {
749     int oldExport = textPtr->exportSelection;
750     int charHeight;
751 
752     if (Tk_ConfigureWidget(interp, textPtr->tkwin, configSpecs,
753 	    argc, argv, (char *) textPtr, flags) != TCL_OK) {
754 	return TCL_ERROR;
755     }
756 
757     /*
758      * A few other options also need special processing, such as parsing
759      * the geometry and setting the background from a 3-D border.
760      */
761 
762     if ((textPtr->state != tkTextNormalUid)
763 	    && (textPtr->state != tkTextDisabledUid)) {
764 	Tcl_AppendResult(interp, "bad state value \"", textPtr->state,
765 		"\": must be normal or disabled", (char *) NULL);
766 	textPtr->state = tkTextNormalUid;
767 	return TCL_ERROR;
768     }
769 
770     if ((textPtr->wrapMode != tkTextCharUid)
771 	    && (textPtr->wrapMode != tkTextNoneUid)
772 	    && (textPtr->wrapMode != tkTextWordUid)) {
773 	Tcl_AppendResult(interp, "bad wrap mode \"", textPtr->wrapMode,
774 		"\": must be char, none, or word", (char *) NULL);
775 	textPtr->wrapMode = tkTextCharUid;
776 	return TCL_ERROR;
777     }
778 
779     Tk_SetBackgroundFromBorder(textPtr->tkwin, textPtr->border);
780 
781     /*
782      * Don't allow negative spacings.
783      */
784 
785     if (textPtr->spacing1 < 0) {
786 	textPtr->spacing1 = 0;
787     }
788     if (textPtr->spacing2 < 0) {
789 	textPtr->spacing2 = 0;
790     }
791     if (textPtr->spacing3 < 0) {
792 	textPtr->spacing3 = 0;
793     }
794 
795     /*
796      * Parse tab stops.
797      */
798 
799     if (textPtr->tabArrayPtr != NULL) {
800 	ckfree((char *) textPtr->tabArrayPtr);
801 	textPtr->tabArrayPtr = NULL;
802     }
803     if (textPtr->tabOptionString != NULL) {
804 	textPtr->tabArrayPtr = TkTextGetTabs(interp, textPtr->tkwin,
805 		textPtr->tabOptionString);
806 	if (textPtr->tabArrayPtr == NULL) {
807 	    Tcl_AddErrorInfo(interp,"\n    (while processing -tabs option)");
808 	    return TCL_ERROR;
809 	}
810     }
811 
812     /*
813      * Make sure that configuration options are properly mirrored
814      * between the widget record and the "sel" tags.  NOTE: we don't
815      * have to free up information during the mirroring;  old
816      * information was freed when it was replaced in the widget
817      * record.
818      */
819 
820     textPtr->selTagPtr->border = textPtr->selBorder;
821     if (textPtr->selTagPtr->bdString != textPtr->selBdString) {
822 	textPtr->selTagPtr->bdString = textPtr->selBdString;
823 	if (textPtr->selBdString != NULL) {
824 	    if (Tk_GetPixels(interp, textPtr->tkwin, textPtr->selBdString,
825 		    &textPtr->selTagPtr->borderWidth) != TCL_OK) {
826 		return TCL_ERROR;
827 	    }
828 	    if (textPtr->selTagPtr->borderWidth < 0) {
829 		textPtr->selTagPtr->borderWidth = 0;
830 	    }
831 	}
832     }
833     textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr;
834     textPtr->selTagPtr->affectsDisplay = 0;
835     if ((textPtr->selTagPtr->border != NULL)
836 	    || (textPtr->selTagPtr->bdString != NULL)
837 	    || (textPtr->selTagPtr->reliefString != NULL)
838 	    || (textPtr->selTagPtr->bgStipple != None)
839 	    || (textPtr->selTagPtr->fgColor != NULL)
840 	    || (textPtr->selTagPtr->fontPtr != None)
841 	    || (textPtr->selTagPtr->fgStipple != None)
842 	    || (textPtr->selTagPtr->justifyString != NULL)
843 	    || (textPtr->selTagPtr->lMargin1String != NULL)
844 	    || (textPtr->selTagPtr->lMargin2String != NULL)
845 	    || (textPtr->selTagPtr->offsetString != NULL)
846 	    || (textPtr->selTagPtr->overstrikeString != NULL)
847 	    || (textPtr->selTagPtr->rMarginString != NULL)
848 	    || (textPtr->selTagPtr->spacing1String != NULL)
849 	    || (textPtr->selTagPtr->spacing2String != NULL)
850 	    || (textPtr->selTagPtr->spacing3String != NULL)
851 	    || (textPtr->selTagPtr->tabString != NULL)
852 	    || (textPtr->selTagPtr->underlineString != NULL)
853 	    || (textPtr->selTagPtr->wrapMode != NULL)) {
854 	textPtr->selTagPtr->affectsDisplay = 1;
855     }
856     TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL,
857 	    textPtr->selTagPtr, 1);
858 
859     /*
860      * Claim the selection if we've suddenly started exporting it and there
861      * are tagged characters.
862      */
863 
864     if (textPtr->exportSelection && (!oldExport)) {
865 	TkTextSearch search;
866 	TkTextIndex first, last;
867 
868 	TkTextMakeIndex(textPtr->tree, 0, 0, &first);
869 	TkTextMakeIndex(textPtr->tree,
870 		TkBTreeNumLines(textPtr->tree), 0, &last);
871 	TkBTreeStartSearch(&first, &last, textPtr->selTagPtr, &search);
872 	if (TkBTreeCharTagged(&first, textPtr->selTagPtr)
873 		|| TkBTreeNextTag(&search)) {
874 	    Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, TkTextLostSelection,
875 		    (ClientData) textPtr);
876 	    textPtr->flags |= GOT_SELECTION;
877 	}
878     }
879 
880     /*
881      * Register the desired geometry for the window, and arrange for
882      * the window to be redisplayed.
883      */
884 
885     if (textPtr->width <= 0) {
886 	textPtr->width = 1;
887     }
888     if (textPtr->height <= 0) {
889 	textPtr->height = 1;
890     }
891     textPtr->charWidth = XTextWidth(textPtr->fontPtr, "0", 1);
892     if (textPtr->charWidth <= 0) {
893 	textPtr->charWidth = 1;
894     }
895     charHeight = (textPtr->fontPtr->ascent + textPtr->fontPtr->descent);
896     Tk_GeometryRequest(textPtr->tkwin,
897 	    textPtr->width * textPtr->charWidth + 2*textPtr->borderWidth
898 		    + 2*textPtr->padX + 2*textPtr->highlightWidth,
899 	    textPtr->height * charHeight + 2*textPtr->borderWidth
900 		    + 2*textPtr->padY + 2*textPtr->highlightWidth);
901     Tk_SetInternalBorder(textPtr->tkwin,
902 	    textPtr->borderWidth + textPtr->highlightWidth);
903     if (textPtr->setGrid) {
904 	Tk_SetGrid(textPtr->tkwin, textPtr->width, textPtr->height,
905 		textPtr->charWidth, charHeight);
906     } else {
907 	Tk_UnsetGrid(textPtr->tkwin);
908     }
909 
910     TkTextRelayoutWindow(textPtr);
911     return TCL_OK;
912 }
913 
914 /*
915  *--------------------------------------------------------------
916  *
917  * TextEventProc --
918  *
919  *	This procedure is invoked by the Tk dispatcher on
920  *	structure changes to a text.  For texts with 3D
921  *	borders, this procedure is also invoked for exposures.
922  *
923  * Results:
924  *	None.
925  *
926  * Side effects:
927  *	When the window gets deleted, internal structures get
928  *	cleaned up.  When it gets exposed, it is redisplayed.
929  *
930  *--------------------------------------------------------------
931  */
932 
933 static void
TextEventProc(clientData,eventPtr)934 TextEventProc(clientData, eventPtr)
935     ClientData clientData;	/* Information about window. */
936     register XEvent *eventPtr;	/* Information about event. */
937 {
938     register TkText *textPtr = (TkText *) clientData;
939     TkTextIndex index, index2;
940 
941     if (eventPtr->type == Expose) {
942 	TkTextRedrawRegion(textPtr, eventPtr->xexpose.x,
943 		eventPtr->xexpose.y, eventPtr->xexpose.width,
944 		eventPtr->xexpose.height);
945     } else if (eventPtr->type == ConfigureNotify) {
946 	if ((textPtr->prevWidth != Tk_Width(textPtr->tkwin))
947 		|| (textPtr->prevHeight != Tk_Height(textPtr->tkwin))) {
948 	    TkTextRelayoutWindow(textPtr);
949 	    textPtr->prevWidth = Tk_Width(textPtr->tkwin);
950 	    textPtr->prevHeight = Tk_Height(textPtr->tkwin);
951 	}
952     } else if (eventPtr->type == DestroyNotify) {
953 	if (textPtr->tkwin != NULL) {
954 	    if (textPtr->setGrid) {
955 		Tk_UnsetGrid(textPtr->tkwin);
956 	    }
957 	    textPtr->tkwin = NULL;
958 	    Tcl_DeleteCommand(textPtr->interp,
959 		    Tcl_GetCommandName(textPtr->interp,
960 		    textPtr->widgetCmd));
961 	}
962 	Tcl_EventuallyFree((ClientData) textPtr, DestroyText);
963     } else if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
964 	if (eventPtr->xfocus.detail != NotifyInferior) {
965 	    Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
966 	    if (eventPtr->type == FocusIn) {
967 		textPtr->flags |= GOT_FOCUS | INSERT_ON;
968 		if (textPtr->insertOffTime != 0) {
969 		    textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
970 			    textPtr->insertOnTime, TextBlinkProc,
971 			    (ClientData) textPtr);
972 		}
973 	    } else {
974 		textPtr->flags &= ~(GOT_FOCUS | INSERT_ON);
975 		textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
976 	    }
977 	    TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
978 	    TkTextIndexForwChars(&index, 1, &index2);
979 	    TkTextChanged(textPtr, &index, &index2);
980 	    if (textPtr->highlightWidth > 0) {
981 		TkTextRedrawRegion(textPtr, 0, 0, textPtr->highlightWidth,
982 			textPtr->highlightWidth);
983 	    }
984 	}
985     }
986 }
987 
988 /*
989  *----------------------------------------------------------------------
990  *
991  * TextCmdDeletedProc --
992  *
993  *	This procedure is invoked when a widget command is deleted.  If
994  *	the widget isn't already in the process of being destroyed,
995  *	this command destroys it.
996  *
997  * Results:
998  *	None.
999  *
1000  * Side effects:
1001  *	The widget is destroyed.
1002  *
1003  *----------------------------------------------------------------------
1004  */
1005 
1006 static void
TextCmdDeletedProc(clientData)1007 TextCmdDeletedProc(clientData)
1008     ClientData clientData;	/* Pointer to widget record for widget. */
1009 {
1010     TkText *textPtr = (TkText *) clientData;
1011     Tk_Window tkwin = textPtr->tkwin;
1012 
1013     /*
1014      * This procedure could be invoked either because the window was
1015      * destroyed and the command was then deleted (in which case tkwin
1016      * is NULL) or because the command was deleted, and then this procedure
1017      * destroys the widget.
1018      */
1019 
1020     if (tkwin != NULL) {
1021 	if (textPtr->setGrid) {
1022 	    Tk_UnsetGrid(textPtr->tkwin);
1023 	}
1024 	textPtr->tkwin = NULL;
1025 	Tk_DestroyWindow(tkwin);
1026     }
1027 }
1028 
1029 /*
1030  *----------------------------------------------------------------------
1031  *
1032  * InsertChars --
1033  *
1034  *	This procedure implements most of the functionality of the
1035  *	"insert" widget command.
1036  *
1037  * Results:
1038  *	None.
1039  *
1040  * Side effects:
1041  *	The characters in "string" get added to the text just before
1042  *	the character indicated by "indexPtr".
1043  *
1044  *----------------------------------------------------------------------
1045  */
1046 
1047 static void
InsertChars(textPtr,indexPtr,string)1048 InsertChars(textPtr, indexPtr, string)
1049     TkText *textPtr;		/* Overall information about text widget. */
1050     TkTextIndex *indexPtr;	/* Where to insert new characters.  May be
1051 				 * modified and/or invalidated. */
1052     char *string;		/* Null-terminated string containing new
1053 				 * information to add to text. */
1054 {
1055     int lineIndex, resetView, offset;
1056     TkTextIndex newTop;
1057 
1058     /*
1059      * Don't allow insertions on the last (dummy) line of the text.
1060      */
1061 
1062     lineIndex = TkBTreeLineIndex(indexPtr->linePtr);
1063     if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
1064 	lineIndex--;
1065 	TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, indexPtr);
1066     }
1067 
1068     /*
1069      * Notify the display module that lines are about to change, then do
1070      * the insertion.  If the insertion occurs on the top line of the
1071      * widget (textPtr->topIndex), then we have to recompute topIndex
1072      * after the insertion, since the insertion could invalidate it.
1073      */
1074 
1075     resetView = offset = 0;
1076     if (indexPtr->linePtr == textPtr->topIndex.linePtr) {
1077 	resetView = 1;
1078 	offset = textPtr->topIndex.charIndex;
1079 	if (offset > indexPtr->charIndex) {
1080 	    offset += strlen(string);
1081 	}
1082     }
1083     TkTextChanged(textPtr, indexPtr, indexPtr);
1084     TkBTreeInsertChars(indexPtr, string);
1085     if (resetView) {
1086 	TkTextMakeIndex(textPtr->tree, lineIndex, 0, &newTop);
1087 	TkTextIndexForwChars(&newTop, offset, &newTop);
1088 	TkTextSetYView(textPtr, &newTop, 0);
1089     }
1090 
1091     /*
1092      * Invalidate any selection retrievals in progress.
1093      */
1094 
1095     textPtr->abortSelections = 1;
1096 }
1097 
1098 /*
1099  *----------------------------------------------------------------------
1100  *
1101  * DeleteChars --
1102  *
1103  *	This procedure implements most of the functionality of the
1104  *	"delete" widget command.
1105  *
1106  * Results:
1107  *	Returns a standard Tcl result, and leaves an error message
1108  *	in textPtr->interp if there is an error.
1109  *
1110  * Side effects:
1111  *	Characters get deleted from the text.
1112  *
1113  *----------------------------------------------------------------------
1114  */
1115 
1116 static int
DeleteChars(textPtr,index1String,index2String)1117 DeleteChars(textPtr, index1String, index2String)
1118     TkText *textPtr;		/* Overall information about text widget. */
1119     char *index1String;		/* String describing location of first
1120 				 * character to delete. */
1121     char *index2String;		/* String describing location of last
1122 				 * character to delete.  NULL means just
1123 				 * delete the one character given by
1124 				 * index1String. */
1125 {
1126     int line1, line2, line, charIndex, resetView;
1127     TkTextIndex index1, index2;
1128 
1129     /*
1130      * Parse the starting and stopping indices.
1131      */
1132 
1133     if (TkTextGetIndex(textPtr->interp, textPtr, index1String, &index1)
1134 	    != TCL_OK) {
1135 	return TCL_ERROR;
1136     }
1137     if (index2String != NULL) {
1138 	if (TkTextGetIndex(textPtr->interp, textPtr, index2String, &index2)
1139 		!= TCL_OK) {
1140 	    return TCL_ERROR;
1141 	}
1142     } else {
1143 	index2 = index1;
1144 	TkTextIndexForwChars(&index2, 1, &index2);
1145     }
1146 
1147     /*
1148      * Make sure there's really something to delete.
1149      */
1150 
1151     if (TkTextIndexCmp(&index1, &index2) >= 0) {
1152 	return TCL_OK;
1153     }
1154 
1155     /*
1156      * The code below is ugly, but it's needed to make sure there
1157      * is always a dummy empty line at the end of the text.  If the
1158      * final newline of the file (just before the dummy line) is being
1159      * deleted, then back up index to just before the newline.  If
1160      * there is a newline just before the first character being deleted,
1161      * then back up the first index too, so that an even number of lines
1162      * gets deleted.  Furthermore, remove any tags that are present on
1163      * the newline that isn't going to be deleted after all (this simulates
1164      * deleting the newline and then adding a "clean" one back again).
1165      */
1166 
1167     line1 = TkBTreeLineIndex(index1.linePtr);
1168     line2 = TkBTreeLineIndex(index2.linePtr);
1169     if (line2 == TkBTreeNumLines(textPtr->tree)) {
1170 	TkTextTag **arrayPtr;
1171 	int arraySize, i;
1172 	TkTextIndex oldIndex2;
1173 
1174 	oldIndex2 = index2;
1175 	TkTextIndexBackChars(&oldIndex2, 1, &index2);
1176 	line2--;
1177 	if ((index1.charIndex == 0) && (line1 != 0)) {
1178 	    TkTextIndexBackChars(&index1, 1, &index1);
1179 	    line1--;
1180 	}
1181 	arrayPtr = TkBTreeGetTags(&index2, &arraySize);
1182 	if (arrayPtr != NULL) {
1183 	    for (i = 0; i < arraySize; i++) {
1184 		TkBTreeTag(&index2, &oldIndex2, arrayPtr[i], 0);
1185 	    }
1186 	    ckfree((char *) arrayPtr);
1187 	}
1188     }
1189 
1190     /*
1191      * Tell the display what's about to happen so it can discard
1192      * obsolete display information, then do the deletion.  Also,
1193      * if the deletion involves the top line on the screen, then
1194      * we have to reset the view (the deletion will invalidate
1195      * textPtr->topIndex).  Compute what the new first character
1196      * will be, then do the deletion, then reset the view.
1197      */
1198 
1199     TkTextChanged(textPtr, &index1, &index2);
1200     resetView = line = charIndex = 0;
1201     if (TkTextIndexCmp(&index2, &textPtr->topIndex) >= 0) {
1202 	if (TkTextIndexCmp(&index1, &textPtr->topIndex) <= 0) {
1203 	    /*
1204 	     * Deletion range straddles topIndex: use the beginning
1205 	     * of the range as the new topIndex.
1206 	     */
1207 
1208 	    resetView = 1;
1209 	    line = line1;
1210 	    charIndex = index1.charIndex;
1211 	} else if (index1.linePtr == textPtr->topIndex.linePtr) {
1212 	    /*
1213 	     * Deletion range starts on top line but after topIndex.
1214 	     * Use the current topIndex as the new one.
1215 	     */
1216 
1217 	    resetView = 1;
1218 	    line = line1;
1219 	    charIndex = textPtr->topIndex.charIndex;
1220 	}
1221     } else if (index2.linePtr == textPtr->topIndex.linePtr) {
1222 	/*
1223 	 * Deletion range ends on top line but before topIndex.
1224 	 * Figure out what will be the new character index for
1225 	 * the character currently pointed to by topIndex.
1226 	 */
1227 
1228 	resetView = 1;
1229 	line = line2;
1230 	charIndex = textPtr->topIndex.charIndex;
1231 	if (index1.linePtr != index2.linePtr) {
1232 	    charIndex -= index2.charIndex;
1233 	} else {
1234 	    charIndex -= (index2.charIndex - index1.charIndex);
1235 	}
1236     }
1237     TkBTreeDeleteChars(&index1, &index2);
1238     if (resetView) {
1239 	TkTextMakeIndex(textPtr->tree, line, charIndex, &index1);
1240 	TkTextSetYView(textPtr, &index1, 0);
1241     }
1242 
1243     /*
1244      * Invalidate any selection retrievals in progress.
1245      */
1246 
1247     textPtr->abortSelections = 1;
1248 
1249     return TCL_OK;
1250 }
1251 
1252 /*
1253  *----------------------------------------------------------------------
1254  *
1255  * TextFetchSelection --
1256  *
1257  *	This procedure is called back by Tk when the selection is
1258  *	requested by someone.  It returns part or all of the selection
1259  *	in a buffer provided by the caller.
1260  *
1261  * Results:
1262  *	The return value is the number of non-NULL bytes stored
1263  *	at buffer.  Buffer is filled (or partially filled) with a
1264  *	NULL-terminated string containing part or all of the selection,
1265  *	as given by offset and maxBytes.
1266  *
1267  * Side effects:
1268  *	None.
1269  *
1270  *----------------------------------------------------------------------
1271  */
1272 
1273 static int
TextFetchSelection(clientData,offset,buffer,maxBytes)1274 TextFetchSelection(clientData, offset, buffer, maxBytes)
1275     ClientData clientData;		/* Information about text widget. */
1276     int offset;				/* Offset within selection of first
1277 					 * character to be returned. */
1278     char *buffer;			/* Location in which to place
1279 					 * selection. */
1280     int maxBytes;			/* Maximum number of bytes to place
1281 					 * at buffer, not including terminating
1282 					 * NULL character. */
1283 {
1284     register TkText *textPtr = (TkText *) clientData;
1285     TkTextIndex eof;
1286     int count, chunkSize, offsetInSeg;
1287     TkTextSearch search;
1288     TkTextSegment *segPtr;
1289 
1290     if (!textPtr->exportSelection) {
1291 	return -1;
1292     }
1293 
1294     /*
1295      * Find the beginning of the next range of selected text.  Note:  if
1296      * the selection is being retrieved in multiple pieces (offset != 0)
1297      * and some modification has been made to the text that affects the
1298      * selection then reject the selection request (make 'em start over
1299      * again).
1300      */
1301 
1302     if (offset == 0) {
1303 	TkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->selIndex);
1304 	textPtr->abortSelections = 0;
1305     } else if (textPtr->abortSelections) {
1306 	return 0;
1307     }
1308     TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &eof);
1309     TkBTreeStartSearch(&textPtr->selIndex, &eof, textPtr->selTagPtr, &search);
1310     if (!TkBTreeCharTagged(&textPtr->selIndex, textPtr->selTagPtr)) {
1311 	if (!TkBTreeNextTag(&search)) {
1312 	    if (offset == 0) {
1313 		return -1;
1314 	    } else {
1315 		return 0;
1316 	    }
1317 	}
1318 	textPtr->selIndex = search.curIndex;
1319     }
1320 
1321     /*
1322      * Each iteration through the outer loop below scans one selected range.
1323      * Each iteration through the inner loop scans one segment in the
1324      * selected range.
1325      */
1326 
1327     count = 0;
1328     while (1) {
1329 	/*
1330 	 * Find the end of the current range of selected text.
1331 	 */
1332 
1333 	if (!TkBTreeNextTag(&search)) {
1334 	    panic("TextFetchSelection couldn't find end of range");
1335 	}
1336 
1337 	/*
1338 	 * Copy information from character segments into the buffer
1339 	 * until either we run out of space in the buffer or we get
1340 	 * to the end of this range of text.
1341 	 */
1342 
1343 	while (1) {
1344 	    if (maxBytes == 0) {
1345 		goto done;
1346 	    }
1347 	    segPtr = TkTextIndexToSeg(&textPtr->selIndex, &offsetInSeg);
1348 	    chunkSize = segPtr->size - offsetInSeg;
1349 	    if (chunkSize > maxBytes) {
1350 		chunkSize = maxBytes;
1351 	    }
1352 	    if (textPtr->selIndex.linePtr == search.curIndex.linePtr) {
1353 		int leftInRange;
1354 
1355 		leftInRange = search.curIndex.charIndex
1356 			- textPtr->selIndex.charIndex;
1357 		if (leftInRange < chunkSize) {
1358 		    chunkSize = leftInRange;
1359 		    if (chunkSize <= 0) {
1360 			break;
1361 		    }
1362 		}
1363 	    }
1364 	    if (segPtr->typePtr == &tkTextCharType) {
1365 		memcpy((VOID *) buffer, (VOID *) (segPtr->body.chars
1366 			+ offsetInSeg), (size_t) chunkSize);
1367 		buffer += chunkSize;
1368 		maxBytes -= chunkSize;
1369 		count += chunkSize;
1370 	    }
1371 	    TkTextIndexForwChars(&textPtr->selIndex, chunkSize,
1372 		    &textPtr->selIndex);
1373 	}
1374 
1375 	/*
1376 	 * Find the beginning of the next range of selected text.
1377 	 */
1378 
1379 	if (!TkBTreeNextTag(&search)) {
1380 	    break;
1381 	}
1382 	textPtr->selIndex = search.curIndex;
1383     }
1384 
1385     done:
1386     *buffer = 0;
1387     return count;
1388 }
1389 
1390 /*
1391  *----------------------------------------------------------------------
1392  *
1393  * TkTextLostSelection --
1394  *
1395  *	This procedure is called back by Tk when the selection is
1396  *	grabbed away from a text widget.
1397  *
1398  * Results:
1399  *	None.
1400  *
1401  * Side effects:
1402  *	The "sel" tag is cleared from the window.
1403  *
1404  *----------------------------------------------------------------------
1405  */
1406 
1407 void
TkTextLostSelection(clientData)1408 TkTextLostSelection(clientData)
1409     ClientData clientData;		/* Information about text widget. */
1410 {
1411     register TkText *textPtr = (TkText *) clientData;
1412     TkTextIndex start, end;
1413 
1414     if (!textPtr->exportSelection) {
1415 	return;
1416     }
1417 
1418     /*
1419      * Just remove the "sel" tag from everything in the widget.
1420      */
1421 
1422     TkTextMakeIndex(textPtr->tree, 0, 0, &start);
1423     TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &end);
1424     TkTextRedrawTag(textPtr, &start, &end, textPtr->selTagPtr, 1);
1425     TkBTreeTag(&start, &end, textPtr->selTagPtr, 0);
1426     textPtr->flags &= ~GOT_SELECTION;
1427 }
1428 
1429 /*
1430  *----------------------------------------------------------------------
1431  *
1432  * TextBlinkProc --
1433  *
1434  *	This procedure is called as a timer handler to blink the
1435  *	insertion cursor off and on.
1436  *
1437  * Results:
1438  *	None.
1439  *
1440  * Side effects:
1441  *	The cursor gets turned on or off, redisplay gets invoked,
1442  *	and this procedure reschedules itself.
1443  *
1444  *----------------------------------------------------------------------
1445  */
1446 
1447 static void
TextBlinkProc(clientData)1448 TextBlinkProc(clientData)
1449     ClientData clientData;	/* Pointer to record describing text. */
1450 {
1451     register TkText *textPtr = (TkText *) clientData;
1452     TkTextIndex index, index2;
1453 
1454     if (!(textPtr->flags & GOT_FOCUS) || (textPtr->insertOffTime == 0)) {
1455 	return;
1456     }
1457     if (textPtr->flags & INSERT_ON) {
1458 	textPtr->flags &= ~INSERT_ON;
1459 	textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
1460 		textPtr->insertOffTime, TextBlinkProc, (ClientData) textPtr);
1461     } else {
1462 	textPtr->flags |= INSERT_ON;
1463 	textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
1464 		textPtr->insertOnTime, TextBlinkProc, (ClientData) textPtr);
1465     }
1466     TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
1467     TkTextIndexForwChars(&index, 1, &index2);
1468     TkTextChanged(textPtr, &index, &index2);
1469 }
1470 
1471 /*
1472  *----------------------------------------------------------------------
1473  *
1474  * TextSearchCmd --
1475  *
1476  *	This procedure is invoked to process the "search" widget command
1477  *	for text widgets.  See the user documentation for details on what
1478  *	it does.
1479  *
1480  * Results:
1481  *	A standard Tcl result.
1482  *
1483  * Side effects:
1484  *	See the user documentation.
1485  *
1486  *----------------------------------------------------------------------
1487  */
1488 
1489 static int
TextSearchCmd(textPtr,interp,argc,argv)1490 TextSearchCmd(textPtr, interp, argc, argv)
1491     TkText *textPtr;		/* Information about text widget. */
1492     Tcl_Interp *interp;		/* Current interpreter. */
1493     int argc;			/* Number of arguments. */
1494     char **argv;		/* Argument strings. */
1495 {
1496     int backwards, exact, c, i, argsLeft, noCase, leftToScan;
1497     size_t length;
1498     int numLines, startingLine, startingChar, lineNum, firstChar, lastChar;
1499     int code, matchLength, matchChar, passes, stopLine, searchWholeText;
1500     int patLength;
1501     char *arg, *pattern, *varName, *p, *startOfLine;
1502     char buffer[20];
1503     TkTextIndex index, stopIndex;
1504     Tcl_DString line, patDString;
1505     TkTextSegment *segPtr;
1506     TkTextLine *linePtr;
1507     Tcl_RegExp regexp = NULL;		/* Initialization needed only to
1508 					 * prevent compiler warning. */
1509 
1510     /*
1511      * Parse switches and other arguments.
1512      */
1513 
1514     exact = 1;
1515     backwards = 0;
1516     noCase = 0;
1517     varName = NULL;
1518     for (i = 2; i < argc; i++) {
1519 	arg = argv[i];
1520 	if (arg[0] != '-') {
1521 	    break;
1522 	}
1523 	length = strlen(arg);
1524 	if (length < 2) {
1525 	    badSwitch:
1526 	    Tcl_AppendResult(interp, "bad switch \"", arg,
1527 		    "\": must be -forward, -backward, -exact, -regexp, ",
1528 		    "-nocase, -count, or --", (char *) NULL);
1529 	    return TCL_ERROR;
1530 	}
1531 	c = arg[1];
1532 	if ((c == 'b') && (strncmp(argv[i], "-backwards", length) == 0)) {
1533 	    backwards = 1;
1534 	} else if ((c == 'c') && (strncmp(argv[i], "-count", length) == 0)) {
1535 	    if (i >= (argc-1)) {
1536 		interp->result = "no value given for \"-count\" option";
1537 		return TCL_ERROR;
1538 	    }
1539 	    i++;
1540 	    varName = argv[i];
1541 	} else if ((c == 'e') && (strncmp(argv[i], "-exact", length) == 0)) {
1542 	    exact = 1;
1543 	} else if ((c == 'f') && (strncmp(argv[i], "-forwards", length) == 0)) {
1544 	    backwards = 0;
1545 	} else if ((c == 'n') && (strncmp(argv[i], "-nocase", length) == 0)) {
1546 	    noCase = 1;
1547 	} else if ((c == 'r') && (strncmp(argv[i], "-regexp", length) == 0)) {
1548 	    exact = 0;
1549 	} else if ((c == '-') && (strncmp(argv[i], "--", length) == 0)) {
1550 	    i++;
1551 	    break;
1552 	} else {
1553 	    goto badSwitch;
1554 	}
1555     }
1556     argsLeft = argc - (i+2);
1557     if ((argsLeft != 0) && (argsLeft != 1)) {
1558 	Tcl_AppendResult(interp, "wrong # args: should be \"",
1559 		argv[0], " search ?switches? pattern index ?stopIndex?",
1560 		(char *) NULL);
1561 	return TCL_ERROR;
1562     }
1563     pattern = argv[i];
1564 
1565     /*
1566      * Convert the pattern to lower-case if we're supposed to ignore case.
1567      */
1568 
1569     if (noCase) {
1570 	Tcl_DStringInit(&patDString);
1571 	Tcl_DStringAppend(&patDString, pattern, -1);
1572 	pattern = Tcl_DStringValue(&patDString);
1573 	for (p = pattern; *p != 0; p++) {
1574 	    if (isupper(UCHAR(*p))) {
1575 		*p = tolower(UCHAR(*p));
1576 	    }
1577 	}
1578     }
1579 
1580     if (TkTextGetIndex(interp, textPtr, argv[i+1], &index) != TCL_OK) {
1581 	return TCL_ERROR;
1582     }
1583     numLines = TkBTreeNumLines(textPtr->tree);
1584     startingLine = TkBTreeLineIndex(index.linePtr);
1585     startingChar = index.charIndex;
1586     if (startingLine >= numLines) {
1587 	if (backwards) {
1588 	    startingLine = TkBTreeNumLines(textPtr->tree) - 1;
1589 	    startingChar = TkBTreeCharsInLine(TkBTreeFindLine(textPtr->tree,
1590 		    startingLine));
1591 	} else {
1592 	    startingLine = 0;
1593 	    startingChar = 0;
1594 	}
1595     }
1596     if (argsLeft == 1) {
1597 	if (TkTextGetIndex(interp, textPtr, argv[i+2], &stopIndex) != TCL_OK) {
1598 	    return TCL_ERROR;
1599 	}
1600 	stopLine = TkBTreeLineIndex(stopIndex.linePtr);
1601 	if (!backwards && (stopLine == numLines)) {
1602 	    stopLine = numLines-1;
1603 	}
1604 	searchWholeText = 0;
1605     } else {
1606 	stopLine = 0;
1607 	searchWholeText = 1;
1608     }
1609 
1610     /*
1611      * Scan through all of the lines of the text circularly, starting
1612      * at the given index.
1613      */
1614 
1615     matchLength = patLength = 0;	/* Only needed to prevent compiler
1616 					 * warnings. */
1617     if (exact) {
1618 	patLength = strlen(pattern);
1619     } else {
1620 	regexp = Tcl_RegExpCompile(interp, pattern);
1621 	if (regexp == NULL) {
1622 	    return TCL_ERROR;
1623 	}
1624     }
1625     lineNum = startingLine;
1626     code = TCL_OK;
1627     Tcl_DStringInit(&line);
1628     for (passes = 0; passes < 2; ) {
1629 	if (lineNum >= numLines) {
1630 	    /*
1631 	     * Don't search the dummy last line of the text.
1632 	     */
1633 
1634 	    goto nextLine;
1635 	}
1636 
1637 	/*
1638 	 * Extract the text from the line.  If we're doing regular
1639 	 * expression matching, drop the newline from the line, so
1640 	 * that "$" can be used to match the end of the line.
1641 	 */
1642 
1643 	linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
1644 	for (segPtr = linePtr->segPtr; segPtr != NULL;
1645 		segPtr = segPtr->nextPtr) {
1646 	    if (segPtr->typePtr != &tkTextCharType) {
1647 		continue;
1648 	    }
1649 	    Tcl_DStringAppend(&line, segPtr->body.chars, segPtr->size);
1650 	}
1651 	if (!exact) {
1652 	    Tcl_DStringSetLength(&line, Tcl_DStringLength(&line)-1);
1653 	}
1654 	startOfLine = Tcl_DStringValue(&line);
1655 
1656 	/*
1657 	 * If we're ignoring case, convert the line to lower case.
1658 	 */
1659 
1660 	if (noCase) {
1661 	    for (p = Tcl_DStringValue(&line); *p != 0; p++) {
1662 		if (isupper(UCHAR(*p))) {
1663 		    *p = tolower(UCHAR(*p));
1664 		}
1665 	    }
1666 	}
1667 
1668 	/*
1669 	 * Check for matches within the current line.  If so, and if we're
1670 	 * searching backwards, repeat the search to find the last match
1671 	 * in the line.
1672 	 */
1673 
1674 	matchChar = -1;
1675 	firstChar = 0;
1676 	lastChar = INT_MAX;
1677 	if (lineNum == startingLine) {
1678 	    int indexInDString;
1679 
1680 	    /*
1681 	     * The starting line is tricky: the first time we see it
1682 	     * we check one part of the line, and the second pass through
1683 	     * we check the other part of the line.  We have to be very
1684 	     * careful here because there could be embedded windows or
1685 	     * other things that are not in the extracted line.  Rescan
1686 	     * the original line to compute the index in it of the first
1687 	     * character.
1688 	     */
1689 
1690 	    indexInDString = startingChar;
1691 	    for (segPtr = linePtr->segPtr, leftToScan = startingChar;
1692 		    leftToScan > 0; segPtr = segPtr->nextPtr) {
1693 		if (segPtr->typePtr != &tkTextCharType) {
1694 		    indexInDString -= segPtr->size;
1695 		}
1696 		leftToScan -= segPtr->size;
1697 	    }
1698 
1699 	    passes++;
1700 	    if ((passes == 1) ^ backwards) {
1701 		/*
1702 		 * Only use the last part of the line.
1703 		 */
1704 
1705 		firstChar = indexInDString;
1706 		if (firstChar >= Tcl_DStringLength(&line)) {
1707 		    goto nextLine;
1708 		}
1709 	    } else {
1710 		/*
1711 		 * Use only the first part of the line.
1712 		 */
1713 
1714 		lastChar = indexInDString;
1715 	    }
1716 	}
1717 	do {
1718 	    int thisLength;
1719 	    if (exact) {
1720 		p = strstr(startOfLine + firstChar, pattern);
1721 		if (p == NULL) {
1722 		    break;
1723 		}
1724 		i = p - startOfLine;
1725 		thisLength = patLength;
1726 	    } else {
1727 		char *start, *end;
1728 		int match;
1729 
1730 		match = Tcl_RegExpExec(interp, regexp,
1731 			startOfLine + firstChar, startOfLine);
1732 		if (match < 0) {
1733 		    code = TCL_ERROR;
1734 		    goto done;
1735 		}
1736 		if (!match) {
1737 		    break;
1738 		}
1739 		Tcl_RegExpRange(regexp, 0, &start, &end);
1740 		i = start - startOfLine;
1741 		thisLength = end - start;
1742 	    }
1743 	    if (i >= lastChar) {
1744 		break;
1745 	    }
1746 	    matchChar = i;
1747 	    matchLength = thisLength;
1748 	    firstChar = matchChar+1;
1749 	} while (backwards);
1750 
1751 	/*
1752 	 * If we found a match then we're done.  Make sure that
1753 	 * the match occurred before the stopping index, if one was
1754 	 * specified.
1755 	 */
1756 
1757 	if (matchChar >= 0) {
1758 	    /*
1759 	     * The index information returned by the regular expression
1760 	     * parser only considers textual information:  it doesn't
1761 	     * account for embedded windows or any other non-textual info.
1762 	     * Scan through the line's segments again to adjust both
1763 	     * matchChar and matchCount.
1764 	     */
1765 
1766 	    for (segPtr = linePtr->segPtr, leftToScan = matchChar;
1767 		    leftToScan >= 0; segPtr = segPtr->nextPtr) {
1768 		if (segPtr->typePtr != &tkTextCharType) {
1769 		    matchChar += segPtr->size;
1770 		    continue;
1771 		}
1772 		leftToScan -= segPtr->size;
1773 	    }
1774 	    for (leftToScan += matchLength; leftToScan > 0;
1775 		    segPtr = segPtr->nextPtr) {
1776 		if (segPtr->typePtr != &tkTextCharType) {
1777 		    matchLength += segPtr->size;
1778 		    continue;
1779 		}
1780 		leftToScan -= segPtr->size;
1781 	    }
1782 	    TkTextMakeIndex(textPtr->tree, lineNum, matchChar, &index);
1783 	    if (!searchWholeText) {
1784 		if (!backwards && (TkTextIndexCmp(&index, &stopIndex) >= 0)) {
1785 		    goto done;
1786 		}
1787 		if (backwards && (TkTextIndexCmp(&index, &stopIndex) < 0)) {
1788 		    goto done;
1789 		}
1790 	    }
1791 	    if (varName != NULL) {
1792 		sprintf(buffer, "%d", matchLength);
1793 		if (Tcl_SetVar(interp, varName, buffer, TCL_LEAVE_ERR_MSG)
1794 			== NULL) {
1795 		    code = TCL_ERROR;
1796 		    goto done;
1797 		}
1798 	    }
1799 	    TkTextPrintIndex(&index, interp->result);
1800 	    goto done;
1801 	}
1802 
1803 	/*
1804 	 * Go to the next (or previous) line;
1805 	 */
1806 
1807 	nextLine:
1808 	if (backwards) {
1809 	    lineNum--;
1810 	    if (!searchWholeText) {
1811 		if (lineNum < stopLine) {
1812 		    break;
1813 		}
1814 	    } else if (lineNum < 0) {
1815 		lineNum = numLines-1;
1816 	    }
1817 	} else {
1818 	    lineNum++;
1819 	    if (!searchWholeText) {
1820 		if (lineNum > stopLine) {
1821 		    break;
1822 		}
1823 	    } else if (lineNum >= numLines) {
1824 		lineNum = 0;
1825 	    }
1826 	}
1827 	Tcl_DStringSetLength(&line, 0);
1828     }
1829     done:
1830     Tcl_DStringFree(&line);
1831     if (noCase) {
1832 	Tcl_DStringFree(&patDString);
1833     }
1834     return code;
1835 }
1836 
1837 /*
1838  *----------------------------------------------------------------------
1839  *
1840  * TkTextGetTabs --
1841  *
1842  *	Parses a string description of a set of tab stops.
1843  *
1844  * Results:
1845  *	The return value is a pointer to a malloc'ed structure holding
1846  *	parsed information about the tab stops.  If an error occurred
1847  *	then the return value is NULL and an error message is left in
1848  *	interp->result.
1849  *
1850  * Side effects:
1851  *	Memory is allocated for the structure that is returned.  It is
1852  *	up to the caller to free this structure when it is no longer
1853  *	needed.
1854  *
1855  *----------------------------------------------------------------------
1856  */
1857 
1858 TkTextTabArray *
TkTextGetTabs(interp,tkwin,string)1859 TkTextGetTabs(interp, tkwin, string)
1860     Tcl_Interp *interp;			/* Used for error reporting. */
1861     Tk_Window tkwin;			/* Window in which the tabs will be
1862 					 * used. */
1863     char *string;			/* Description of the tab stops.  See
1864 					 * the text manual entry for details. */
1865 {
1866     int argc, i, count, c;
1867     char **argv;
1868     TkTextTabArray *tabArrayPtr;
1869     TkTextTab *tabPtr;
1870 
1871     if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
1872 	return NULL;
1873     }
1874 
1875     /*
1876      * First find out how many entries we need to allocate in the
1877      * tab array.
1878      */
1879 
1880     count = 0;
1881     for (i = 0; i < argc; i++) {
1882 	c = argv[i][0];
1883 	if ((c != 'l') && (c != 'r') && (c != 'c') && (c != 'n')) {
1884 	    count++;
1885 	}
1886     }
1887 
1888     /*
1889      * Parse the elements of the list one at a time to fill in the
1890      * array.
1891      */
1892 
1893     tabArrayPtr = (TkTextTabArray *) ckalloc((unsigned)
1894 	    (sizeof(TkTextTabArray) + (count-1)*sizeof(TkTextTab)));
1895     tabArrayPtr->numTabs = 0;
1896     for (i = 0, tabPtr = &tabArrayPtr->tabs[0]; i  < argc; i++, tabPtr++) {
1897 	if (Tk_GetPixels(interp, tkwin, argv[i], &tabPtr->location)
1898 		!= TCL_OK) {
1899 	    goto error;
1900 	}
1901 	tabArrayPtr->numTabs++;
1902 
1903 	/*
1904 	 * See if there is an explicit alignment in the next list
1905 	 * element.  Otherwise just use "left".
1906 	 */
1907 
1908 	tabPtr->alignment = LEFT;
1909 	if ((i+1) == argc) {
1910 	    continue;
1911 	}
1912 	c = UCHAR(argv[i+1][0]);
1913 	if (!isalpha(c)) {
1914 	    continue;
1915 	}
1916 	i += 1;
1917 	if ((c == 'l') && (strncmp(argv[i], "left",
1918 		strlen(argv[i])) == 0)) {
1919 	    tabPtr->alignment = LEFT;
1920 	} else if ((c == 'r') && (strncmp(argv[i], "right",
1921 		strlen(argv[i])) == 0)) {
1922 	    tabPtr->alignment = RIGHT;
1923 	} else if ((c == 'c') && (strncmp(argv[i], "center",
1924 		strlen(argv[i])) == 0)) {
1925 	    tabPtr->alignment = CENTER;
1926 	} else if ((c == 'n') && (strncmp(argv[i],
1927 		"numeric", strlen(argv[i])) == 0)) {
1928 	    tabPtr->alignment = NUMERIC;
1929 	} else {
1930 	    Tcl_AppendResult(interp, "bad tab alignment \"",
1931 		    argv[i], "\": must be left, right, center, or numeric",
1932 		    (char *) NULL);
1933 	    goto error;
1934 	}
1935     }
1936     ckfree((char *) argv);
1937     return tabArrayPtr;
1938 
1939     error:
1940     ckfree((char *) tabArrayPtr);
1941     ckfree((char *) argv);
1942     return NULL;
1943 }
1944 
1945 /*
1946  *----------------------------------------------------------------------
1947  *
1948  * TextDumpCmd --
1949  *
1950  *	Return information about the text, tags, marks, and embedded windows
1951  *	in a text widget.  See the man page for the description of the
1952  *	text dump operation for all the details.
1953  *
1954  * Results:
1955  *	A standard Tcl result.
1956  *
1957  * Side effects:
1958  *	Memory is allocated for the result, if needed (standard Tcl result
1959  *	side effects).
1960  *
1961  *----------------------------------------------------------------------
1962  */
1963 
1964 static int
TextDumpCmd(textPtr,interp,argc,argv)1965 TextDumpCmd(textPtr, interp, argc, argv)
1966     register TkText *textPtr;	/* Information about text widget. */
1967     Tcl_Interp *interp;		/* Current interpreter. */
1968     int argc;			/* Number of arguments. */
1969     char **argv;		/* Argument strings.  Someone else has already
1970 				 * parsed this command enough to know that
1971 				 * argv[1] is "dump". */
1972 {
1973     TkTextIndex index1, index2;
1974     int arg;
1975     int lineno;			/* Current line number */
1976     int what = 0;		/* bitfield to select segment types */
1977     int atEnd;			/* True if dumping up to logical end */
1978     TkTextLine *linePtr;
1979     char *command = NULL;	/* Script callback to apply to segments */
1980 #define TK_DUMP_TEXT	0x1
1981 #define TK_DUMP_MARK	0x2
1982 #define TK_DUMP_TAG	0x4
1983 #define TK_DUMP_WIN	0x8
1984 #define TK_DUMP_ALL	(TK_DUMP_TEXT|TK_DUMP_MARK|TK_DUMP_TAG|TK_DUMP_WIN)
1985 
1986     for (arg=2 ; argv[arg] != (char *) NULL ; arg++) {
1987 	size_t len;
1988 	if (argv[arg][0] != '-') {
1989 	    break;
1990 	}
1991 	len = strlen(argv[arg]);
1992 	if (strncmp("-all", argv[arg], len) == 0) {
1993 	    what = TK_DUMP_ALL;
1994 	} else if (strncmp("-text", argv[arg], len) == 0) {
1995 	    what |= TK_DUMP_TEXT;
1996 	} else if (strncmp("-tag", argv[arg], len) == 0) {
1997 	    what |= TK_DUMP_TAG;
1998 	} else if (strncmp("-mark", argv[arg], len) == 0) {
1999 	    what |= TK_DUMP_MARK;
2000 	} else if (strncmp("-window", argv[arg], len) == 0) {
2001 	    what |= TK_DUMP_WIN;
2002 	} else if (strncmp("-command", argv[arg], len) == 0) {
2003 	    arg++;
2004 	    if (arg >= argc) {
2005 		Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -text -mark -tag -window? ?-command script? index ?index2?", NULL);
2006 		return TCL_ERROR;
2007 	    }
2008 	    command = argv[arg];
2009 	} else {
2010 	    Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -text -mark -tag -window? ?-command script? index ?index2?", NULL);
2011 	    return TCL_ERROR;
2012 	}
2013     }
2014     if (arg >= argc) {
2015 	Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -text -mark -tag -window? ?-command script? index ?index2?", NULL);
2016 	return TCL_ERROR;
2017     }
2018     if (what == 0) {
2019 	what = TK_DUMP_ALL;
2020     }
2021     if (TkTextGetIndex(interp, textPtr, argv[arg], &index1) != TCL_OK) {
2022 	return TCL_ERROR;
2023     }
2024     lineno = TkBTreeLineIndex(index1.linePtr) + 1;
2025     arg++;
2026     atEnd = 0;
2027     if (argc == arg) {
2028 	TkTextIndexForwChars(&index1, 1, &index2);
2029     } else {
2030 	if (TkTextGetIndex(interp, textPtr, argv[arg], &index2) != TCL_OK) {
2031 	    return TCL_ERROR;
2032 	}
2033 	if (strncmp(argv[arg], "end", strlen(argv[arg])) == 0) {
2034 	    atEnd = 1;
2035 	}
2036     }
2037     if (TkTextIndexCmp(&index1, &index2) >= 0) {
2038 	return TCL_OK;
2039     }
2040     if (index1.linePtr == index2.linePtr) {
2041 	DumpLine(interp, textPtr, what, index1.linePtr,
2042 	    index1.charIndex, index2.charIndex, lineno, command);
2043     } else {
2044 	DumpLine(interp, textPtr, what, index1.linePtr,
2045 		index1.charIndex, 32000000, lineno, command);
2046 	linePtr = index1.linePtr;
2047 	while ((linePtr = TkBTreeNextLine(linePtr)) != (TkTextLine *)NULL) {
2048 	    lineno++;
2049 	    if (linePtr == index2.linePtr) {
2050 		break;
2051 	    }
2052 	    DumpLine(interp, textPtr, what, linePtr, 0, 32000000,
2053 		    lineno, command);
2054 	}
2055 	DumpLine(interp, textPtr, what, index2.linePtr, 0,
2056 		index2.charIndex, lineno, command);
2057     }
2058     /*
2059      * Special case to get the leftovers hiding at the end mark.
2060      */
2061     if (atEnd) {
2062 	DumpLine(interp, textPtr, what & ~TK_DUMP_TEXT, index2.linePtr,
2063 		0, 1, lineno, command);
2064 
2065     }
2066     return TCL_OK;
2067 }
2068 
2069 /*
2070  * DumpLine
2071  * 	Return information about a given text line from character
2072  *	position "start" up to, but not including, "end".
2073  *
2074  * Results:
2075  *	A standard Tcl result.
2076  *
2077  * Side effects:
2078  *	None, but see DumpSegment.
2079  */
2080 static void
DumpLine(interp,textPtr,what,linePtr,start,end,lineno,command)2081 DumpLine(interp, textPtr, what, linePtr, start, end, lineno, command)
2082     Tcl_Interp *interp;
2083     TkText *textPtr;
2084     int what;			/* bit flags to select segment types */
2085     TkTextLine *linePtr;	/* The current line */
2086     int start, end;		/* Character range to dump */
2087     int lineno;			/* Line number for indices dump */
2088     char *command;		/* Script to apply to the segment */
2089 {
2090     int offset;
2091     TkTextSegment *segPtr;
2092     /*
2093      * Must loop through line looking at its segments.
2094      * character
2095      * toggleOn, toggleOff
2096      * mark
2097      * window
2098      */
2099     for (offset = 0, segPtr = linePtr->segPtr ;
2100 	    (offset < end) && (segPtr != (TkTextSegment *)NULL) ;
2101 	    offset += segPtr->size, segPtr = segPtr->nextPtr) {
2102 	if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) &&
2103 		(offset + segPtr->size > start)) {
2104 	    char savedChar;			/* Last char used in the seg */
2105 	    int last = segPtr->size;		/* Index of savedChar */
2106 	    int first = 0;			/* Index of first char in seg */
2107 	    if (offset + segPtr->size > end) {
2108 		last = end - offset;
2109 	    }
2110 	    if (start > offset) {
2111 		first = start - offset;
2112 	    }
2113 	    savedChar = segPtr->body.chars[last];
2114 	    segPtr->body.chars[last] = '\0';
2115 	    DumpSegment(interp, "text", segPtr->body.chars + first,
2116 		    command, lineno, offset + first, what);
2117 	    segPtr->body.chars[last] = savedChar;
2118 	} else if ((offset >= start)) {
2119 	    if ((what & TK_DUMP_MARK) && (segPtr->typePtr->name[0] == 'm')) {
2120 		TkTextMark *markPtr = (TkTextMark *)&segPtr->body;
2121 		char *name = Tcl_GetHashKey(&textPtr->markTable, markPtr->hPtr);
2122 		DumpSegment(interp, "mark", name,
2123 			command, lineno, offset, what);
2124 	    } else if ((what & TK_DUMP_TAG) &&
2125 			(segPtr->typePtr == &tkTextToggleOnType)) {
2126 		DumpSegment(interp, "tagon",
2127 			segPtr->body.toggle.tagPtr->name,
2128 			command, lineno, offset, what);
2129 	    } else if ((what & TK_DUMP_TAG) &&
2130 			(segPtr->typePtr == &tkTextToggleOffType)) {
2131 		DumpSegment(interp, "tagoff",
2132 			segPtr->body.toggle.tagPtr->name,
2133 			command, lineno, offset, what);
2134 	    } else if ((what & TK_DUMP_WIN) &&
2135 			(segPtr->typePtr->name[0] == 'w')) {
2136 		TkTextEmbWindow *ewPtr = (TkTextEmbWindow *)&segPtr->body;
2137 		char *pathname;
2138 		if (ewPtr->tkwin == (Tk_Window) NULL) {
2139 		    pathname = "";
2140 		} else {
2141 		    pathname = Tk_PathName(ewPtr->tkwin);
2142 		}
2143 		DumpSegment(interp, "window", pathname,
2144 			command, lineno, offset, what);
2145 	    }
2146 	}
2147     }
2148 }
2149 
2150 /*
2151  * DumpSegment
2152  *	Either append information about the current segment to the result,
2153  *	or make a script callback with that information as arguments.
2154  *
2155  * Results:
2156  *	None
2157  *
2158  * Side effects:
2159  *	Either evals the callback or appends elements to the result string.
2160  */
2161 static int
DumpSegment(interp,key,value,command,lineno,offset,what)2162 DumpSegment(interp, key, value, command, lineno, offset, what)
2163     Tcl_Interp *interp;
2164     char *key;			/* Segment type key */
2165     char *value;		/* Segment value */
2166     char *command;		/* Script callback */
2167     int lineno;			/* Line number for indices dump */
2168     int offset;			/* Character position */
2169     int what;			/* Look for TK_DUMP_INDEX bit */
2170 {
2171     char buffer[30];
2172     sprintf(buffer, "%d.%d", lineno, offset);
2173     if (command == (char *) NULL) {
2174 	Tcl_AppendElement(interp, key);
2175 	Tcl_AppendElement(interp, value);
2176 	Tcl_AppendElement(interp, buffer);
2177 	return TCL_OK;
2178     } else {
2179 	char *argv[4];
2180 	char *list;
2181 	int result;
2182 	argv[0] = key;
2183 	argv[1] = value;
2184 	argv[2] = buffer;
2185 	argv[3] = (char *) NULL;
2186 	list = Tcl_Merge(3, argv);
2187 	result = Tcl_VarEval(interp, command, " ", list, (char *) NULL);
2188 	ckfree(list);
2189 	return result;
2190     }
2191 }
2192 
2193