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