/[dtapublic]/projs/trunk/shared_source/c_tk_base_7_5_w_mods/tktext.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tktext.c

Parent Directory Parent Directory | Revision Log Revision Log


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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25