]> cvs.zerfleddert.de Git - micropolis/blob - src/tk/tktext.c
Fixes for compilation with gcc 15
[micropolis] / src / tk / tktext.c
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 1992 Regents of the University of California.
11 * Permission to use, copy, modify, and distribute this
12 * software and its documentation for any purpose and without
13 * fee is hereby granted, provided that the above copyright
14 * notice appear in all copies. The University of California
15 * makes no representations about the suitability of this
16 * software for any purpose. It is provided "as is" without
17 * express or implied warranty.
18 */
19
20 #ifndef lint
21 static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkText.c,v 1.23 92/08/14 14:45:44 ouster Exp $ SPRITE (Berkeley)";
22 #endif
23
24 #include "default.h"
25 #include "tkconfig.h"
26 #include "tk.h"
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_INT, "-height", "height", "Height",
56 DEF_TEXT_HEIGHT, Tk_Offset(TkText, height), 0},
57 {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
58 DEF_TEXT_INSERT_BG, Tk_Offset(TkText, insertBorder), 0},
59 {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
60 DEF_TEXT_INSERT_BD_COLOR, Tk_Offset(TkText, insertBorderWidth),
61 TK_CONFIG_COLOR_ONLY},
62 {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
63 DEF_TEXT_INSERT_BD_MONO, Tk_Offset(TkText, insertBorderWidth),
64 TK_CONFIG_MONO_ONLY},
65 {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
66 DEF_TEXT_INSERT_OFF_TIME, Tk_Offset(TkText, insertOffTime), 0},
67 {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
68 DEF_TEXT_INSERT_ON_TIME, Tk_Offset(TkText, insertOnTime), 0},
69 {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
70 DEF_TEXT_INSERT_WIDTH, Tk_Offset(TkText, insertWidth), 0},
71 {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
72 DEF_TEXT_PADX, Tk_Offset(TkText, padX), 0},
73 {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
74 DEF_TEXT_PADY, Tk_Offset(TkText, padY), 0},
75 {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
76 DEF_TEXT_RELIEF, Tk_Offset(TkText, relief), 0},
77 {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
78 DEF_ENTRY_SELECT_COLOR, Tk_Offset(TkText, selBorder),
79 TK_CONFIG_COLOR_ONLY},
80 {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
81 DEF_TEXT_SELECT_MONO, Tk_Offset(TkText, selBorder),
82 TK_CONFIG_MONO_ONLY},
83 {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
84 DEF_TEXT_SELECT_BD_COLOR, Tk_Offset(TkText, selBorderWidth),
85 TK_CONFIG_COLOR_ONLY},
86 {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
87 DEF_TEXT_SELECT_BD_MONO, Tk_Offset(TkText, selBorderWidth),
88 TK_CONFIG_MONO_ONLY},
89 {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
90 DEF_TEXT_SELECT_FG_COLOR, Tk_Offset(TkText, selFgColorPtr),
91 TK_CONFIG_COLOR_ONLY},
92 {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
93 DEF_TEXT_SELECT_FG_MONO, Tk_Offset(TkText, selFgColorPtr),
94 TK_CONFIG_MONO_ONLY},
95 {TK_CONFIG_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
96 DEF_TEXT_SET_GRID, Tk_Offset(TkText, setGrid), 0},
97 {TK_CONFIG_UID, "-state", "state", "State",
98 DEF_TEXT_STATE, Tk_Offset(TkText, state), 0},
99 {TK_CONFIG_INT, "-width", "width", "Width",
100 DEF_TEXT_WIDTH, Tk_Offset(TkText, width), 0},
101 {TK_CONFIG_UID, "-wrap", "wrap", "Wrap",
102 DEF_TEXT_WRAP, Tk_Offset(TkText, wrapMode), 0},
103 {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
104 DEF_TEXT_YSCROLL_COMMAND, Tk_Offset(TkText, yScrollCmd),
105 TK_CONFIG_NULL_OK},
106 {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
107 (char *) NULL, 0, 0}
108 };
109
110 /*
111 * The following definition specifies the maximum number of characters
112 * needed in a string to hold a position specifier.
113 */
114
115 #define POS_CHARS 30
116
117 /*
118 * Tk_Uid's used to represent text states:
119 */
120
121 Tk_Uid tkTextCharUid = NULL;
122 Tk_Uid tkTextDisabledUid = NULL;
123 Tk_Uid tkTextNoneUid = NULL;
124 Tk_Uid tkTextNormalUid = NULL;
125 Tk_Uid tkTextWordUid = NULL;
126
127 /*
128 * Forward declarations for procedures defined later in this file:
129 */
130
131 static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp,
132 TkText *textPtr, int argc, char **argv, int flags));
133 static void DeleteChars _ANSI_ARGS_((TkText *textPtr, int line1,
134 int ch1, int line2, int ch2));
135 static void DestroyText _ANSI_ARGS_((ClientData clientData));
136 static void InsertChars _ANSI_ARGS_((TkText *textPtr, int line,
137 int ch, char *string));
138 static void TextBlinkProc _ANSI_ARGS_((ClientData clientData));
139 static void TextEventProc _ANSI_ARGS_((ClientData clientData,
140 XEvent *eventPtr));
141 static int TextFetchSelection _ANSI_ARGS_((ClientData clientData,
142 int offset, char *buffer, int maxBytes));
143 static void TextFocusProc _ANSI_ARGS_((ClientData clientData,
144 int gotFocus));
145 static int TextMarkCmd _ANSI_ARGS_((TkText *textPtr,
146 Tcl_Interp *interp, int argc, char **argv));
147 static int TextScanCmd _ANSI_ARGS_((TkText *textPtr,
148 Tcl_Interp *interp, int argc, char **argv));
149 static int TextWidgetCmd _ANSI_ARGS_((ClientData clientData,
150 Tcl_Interp *interp, int argc, char **argv));
151 \f
152 /*
153 *--------------------------------------------------------------
154 *
155 * Tk_TextCmd --
156 *
157 * This procedure is invoked to process the "text" Tcl command.
158 * See the user documentation for details on what it does.
159 *
160 * Results:
161 * A standard Tcl result.
162 *
163 * Side effects:
164 * See the user documentation.
165 *
166 *--------------------------------------------------------------
167 */
168
169 int
170 Tk_TextCmd(
171 ClientData clientData, /* Main window associated with
172 * interpreter. */
173 Tcl_Interp *interp, /* Current interpreter. */
174 int argc, /* Number of arguments. */
175 char **argv /* Argument strings. */
176 )
177 {
178 Tk_Window tkwin = (Tk_Window) clientData;
179 Tk_Window new;
180 register TkText *textPtr;
181
182 if (argc < 2) {
183 Tcl_AppendResult(interp, "wrong # args: should be \"",
184 argv[0], " pathName ?options?\"", (char *) NULL);
185 return TCL_ERROR;
186 }
187
188 /*
189 * Perform once-only initialization:
190 */
191
192 if (tkTextNormalUid == NULL) {
193 tkTextCharUid = Tk_GetUid("char");
194 tkTextDisabledUid = Tk_GetUid("disabled");
195 tkTextNoneUid = Tk_GetUid("none");
196 tkTextNormalUid = Tk_GetUid("normal");
197 tkTextWordUid = Tk_GetUid("word");
198 }
199
200 /*
201 * Create the window.
202 */
203
204 new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
205 if (new == NULL) {
206 return TCL_ERROR;
207 }
208
209 textPtr = (TkText *) ckalloc(sizeof(TkText));
210 textPtr->tkwin = new;
211 textPtr->interp = interp;
212 textPtr->tree = TkBTreeCreate();
213 Tcl_InitHashTable(&textPtr->tagTable, TCL_STRING_KEYS);
214 textPtr->numTags = 0;
215 Tcl_InitHashTable(&textPtr->markTable, TCL_STRING_KEYS);
216 textPtr->state = tkTextNormalUid;
217 textPtr->border = NULL;
218 textPtr->cursor = None;
219 textPtr->fgColor = NULL;
220 textPtr->fontPtr = NULL;
221 textPtr->prevWidth = Tk_Width(new);
222 textPtr->prevHeight = Tk_Height(new);
223 textPtr->topLinePtr = NULL;
224 // Moved down so flags were set right.
225 // TkTextCreateDInfo(textPtr);
226 // TkTextSetView(textPtr, 0, 0);
227 textPtr->selBorder = NULL;
228 textPtr->selFgColorPtr = NULL;
229 textPtr->exportSelection = 1;
230 textPtr->selOffset = -1;
231 textPtr->insertAnnotPtr = NULL;
232 textPtr->insertBorder = NULL;
233 textPtr->insertBlinkHandler = (Tk_TimerToken) NULL;
234 textPtr->bindingTable = NULL;
235 textPtr->pickEvent.type = LeaveNotify;
236 textPtr->yScrollCmd = NULL;
237 textPtr->scanMarkLine = 0;
238 textPtr->scanMarkY = 0;
239 textPtr->flags = 0;
240 textPtr->updateTimerToken = 0; // Added by Don to optimize rapid updates.
241 TkTextCreateDInfo(textPtr);
242 TkTextSetView(textPtr, 0, 0);
243
244 /*
245 * Create the "sel" tag and the "current" and "insert" marks.
246 */
247
248 textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel");
249 textPtr->selTagPtr->relief = TK_RELIEF_RAISED;
250 textPtr->currentAnnotPtr = TkTextSetMark(textPtr, "current", 0, 0);
251 textPtr->insertAnnotPtr = TkTextSetMark(textPtr, "insert", 0, 0);
252
253 Tk_SetClass(new, "Text");
254 Tk_CreateEventHandler(textPtr->tkwin, ExposureMask|StructureNotifyMask,
255 TextEventProc, (ClientData) textPtr);
256 Tk_CreateEventHandler(textPtr->tkwin, KeyPressMask|KeyReleaseMask
257 |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
258 |LeaveWindowMask|PointerMotionMask, TkTextBindProc,
259 (ClientData) textPtr);
260 Tk_CreateSelHandler(textPtr->tkwin, XA_STRING, TextFetchSelection,
261 (ClientData) textPtr, XA_STRING);
262 Tcl_CreateCommand(interp, Tk_PathName(textPtr->tkwin),
263 TextWidgetCmd, (ClientData) textPtr, (void (*)(int *)) NULL);
264 if (ConfigureText(interp, textPtr, argc-2, argv+2, 0) != TCL_OK) {
265 Tk_DestroyWindow(textPtr->tkwin);
266 return TCL_ERROR;
267 }
268 Tk_CreateFocusHandler(textPtr->tkwin, TextFocusProc, (ClientData) textPtr);
269 interp->result = Tk_PathName(textPtr->tkwin);
270
271 return TCL_OK;
272 }
273 \f
274 /*
275 *--------------------------------------------------------------
276 *
277 * TextWidgetCmd --
278 *
279 * This procedure is invoked to process the Tcl command
280 * that corresponds to a text widget. See the user
281 * documentation for details on what it does.
282 *
283 * Results:
284 * A standard Tcl result.
285 *
286 * Side effects:
287 * See the user documentation.
288 *
289 *--------------------------------------------------------------
290 */
291
292 static int
293 TextWidgetCmd(
294 ClientData clientData, /* Information about text widget. */
295 Tcl_Interp *interp, /* Current interpreter. */
296 int argc, /* Number of arguments. */
297 char **argv /* Argument strings. */
298 )
299 {
300 register TkText *textPtr = (TkText *) clientData;
301 int result = TCL_OK;
302 int length;
303 char c;
304 int line1, line2, ch1, ch2;
305
306 if (argc < 2) {
307 Tcl_AppendResult(interp, "wrong # args: should be \"",
308 argv[0], " option ?arg arg ...?\"", (char *) NULL);
309 return TCL_ERROR;
310 }
311 Tk_Preserve((ClientData) textPtr);
312 c = argv[1][0];
313 length = strlen(argv[1]);
314 if ((c == 'c') && (strncmp(argv[1], "compare", length) == 0)
315 && (length >= 3)) {
316 int less, equal, greater, value;
317 char *p;
318
319 if (argc != 5) {
320 Tcl_AppendResult(interp, "wrong # args: should be \"",
321 argv[0], " compare index1 op index2\"", (char *) NULL);
322 result = TCL_ERROR;
323 goto done;
324 }
325 if ((TkTextGetIndex(interp, textPtr, argv[2], &line1, &ch1) != TCL_OK)
326 || (TkTextGetIndex(interp, textPtr, argv[4], &line2, &ch2)
327 != TCL_OK)) {
328 result = TCL_ERROR;
329 goto done;
330 }
331 less = equal = greater = 0;
332 if (line1 < line2) {
333 less = 1;
334 } else if (line1 > line2) {
335 greater = 1;
336 } else {
337 if (ch1 < ch2) {
338 less = 1;
339 } else if (ch1 > ch2) {
340 greater = 1;
341 } else {
342 equal = 1;
343 }
344 }
345 p = argv[3];
346 if (p[0] == '<') {
347 value = less;
348 if ((p[1] == '=') && (p[2] == 0)) {
349 value = less || equal;
350 } else if (p[1] != 0) {
351 compareError:
352 Tcl_AppendResult(interp, "bad comparison operator \"",
353 argv[3], "\": must be <, <=, ==, >=, >, or !=",
354 (char *) NULL);
355 result = TCL_ERROR;
356 goto done;
357 }
358 } else if (p[0] == '>') {
359 value = greater;
360 if ((p[1] == '=') && (p[2] == 0)) {
361 value = greater || equal;
362 } else if (p[1] != 0) {
363 goto compareError;
364 }
365 } else if ((p[0] == '=') && (p[1] == '=') && (p[2] == 0)) {
366 value = equal;
367 } else if ((p[0] == '!') && (p[1] == '=') && (p[2] == 0)) {
368 value = !equal;
369 } else {
370 goto compareError;
371 }
372 interp->result = (value) ? "1" : "0";
373 } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
374 && (length >= 3)) {
375 if (argc == 2) {
376 result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
377 (char *) textPtr, (char *) NULL, 0);
378 } else if (argc == 3) {
379 result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
380 (char *) textPtr, argv[2], 0);
381 } else {
382 result = ConfigureText(interp, textPtr, argc-2, argv+2,
383 TK_CONFIG_ARGV_ONLY);
384 }
385 } else if ((c == 'd') && (strncmp(argv[1], "debug", length) == 0)
386 && (length >= 3)) {
387 if (argc > 3) {
388 Tcl_AppendResult(interp, "wrong # args: should be \"",
389 argv[0], " debug ?on|off?\"", (char *) NULL);
390 result = TCL_ERROR;
391 goto done;
392 }
393 if (argc == 2) {
394 interp->result = (tkBTreeDebug) ? "on" : "off";
395 } else {
396 if (Tcl_GetBoolean(interp, argv[2], &tkBTreeDebug) != TCL_OK) {
397 result = TCL_ERROR;
398 goto done;
399 }
400 }
401 } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
402 && (length >= 3)) {
403 if ((argc != 3) && (argc != 4)) {
404 Tcl_AppendResult(interp, "wrong # args: should be \"",
405 argv[0], " delete index1 ?index2?\"", (char *) NULL);
406 result = TCL_ERROR;
407 goto done;
408 }
409 if (TkTextGetIndex(interp, textPtr, argv[2], &line1, &ch1) != TCL_OK) {
410 result = TCL_ERROR;
411 goto done;
412 }
413 if (argc == 3) {
414 line2 = line1;
415 ch2 = ch1+1;
416 } else if (TkTextGetIndex(interp, textPtr, argv[3], &line2, &ch2)
417 != TCL_OK) {
418 result = TCL_ERROR;
419 goto done;
420 }
421 if (textPtr->state == tkTextNormalUid) {
422 DeleteChars(textPtr, line1, ch1, line2, ch2);
423 }
424 } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
425 register TkTextLine *linePtr;
426
427 if ((argc != 3) && (argc != 4)) {
428 Tcl_AppendResult(interp, "wrong # args: should be \"",
429 argv[0], " get index1 ?index2?\"", (char *) NULL);
430 result = TCL_ERROR;
431 goto done;
432 }
433 if (TkTextGetIndex(interp, textPtr, argv[2], &line1, &ch1) != TCL_OK) {
434 result = TCL_ERROR;
435 goto done;
436 }
437 if (argc == 3) {
438 line2 = line1;
439 ch2 = ch1+1;
440 } else if (TkTextGetIndex(interp, textPtr, argv[3], &line2, &ch2)
441 != TCL_OK) {
442 result = TCL_ERROR;
443 goto done;
444 }
445 if (line1 < 0) {
446 line1 = 0;
447 ch1 = 0;
448 }
449 for (linePtr = TkBTreeFindLine(textPtr->tree, line1);
450 (linePtr != NULL) && (line1 <= line2);
451 linePtr = TkBTreeNextLine(linePtr), line1++, ch1 = 0) {
452 int savedChar, last;
453
454 if (line1 == line2) {
455 last = ch2;
456 if (last > linePtr->numBytes) {
457 last = linePtr->numBytes;
458 }
459 } else {
460 last = linePtr->numBytes;
461 }
462 if (ch1 >= last) {
463 continue;
464 }
465 savedChar = linePtr->bytes[last];
466 linePtr->bytes[last] = 0;
467 Tcl_AppendResult(interp, linePtr->bytes+ch1, (char *) NULL);
468 linePtr->bytes[last] = savedChar;
469 }
470 } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
471 && (length >= 3)) {
472 if (argc != 3) {
473 Tcl_AppendResult(interp, "wrong # args: should be \"",
474 argv[0], " index index\"",
475 (char *) NULL);
476 result = TCL_ERROR;
477 goto done;
478 }
479 if (TkTextGetIndex(interp, textPtr, argv[2], &line1, &ch1) != TCL_OK) {
480 result = TCL_ERROR;
481 goto done;
482 }
483 TkTextPrintIndex(line1, ch1, interp->result);
484 } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
485 && (length >= 3)) {
486 if (argc != 4) {
487 Tcl_AppendResult(interp, "wrong # args: should be \"",
488 argv[0], " insert index chars ?chars ...?\"",
489 (char *) NULL);
490 result = TCL_ERROR;
491 goto done;
492 }
493 if (TkTextGetIndex(interp, textPtr, argv[2], &line1, &ch1) != TCL_OK) {
494 result = TCL_ERROR;
495 goto done;
496 }
497 if (textPtr->state == tkTextNormalUid) {
498 InsertChars(textPtr, line1, ch1, argv[3]);
499 }
500 } else if ((c == 'm') && (strncmp(argv[1], "mark", length) == 0)) {
501 result = TextMarkCmd(textPtr, interp, argc, argv);
502 } else if ((c == 's') && (strcmp(argv[1], "scan") == 0)) {
503 result = TextScanCmd(textPtr, interp, argc, argv);
504 } else if ((c == 't') && (strcmp(argv[1], "tag") == 0)) {
505 result = TkTextTagCmd(textPtr, interp, argc, argv);
506 } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)) {
507 int numLines, pickPlace;
508
509 if (argc < 3) {
510 yviewSyntax:
511 Tcl_AppendResult(interp, "wrong # args: should be \"",
512 argv[0], " yview ?-pickplace? lineNum|index\"",
513 (char *) NULL);
514 result = TCL_ERROR;
515 goto done;
516 }
517 pickPlace = 0;
518 if (argv[2][0] == '-') {
519 int switchLength;
520
521 switchLength = strlen(argv[2]);
522 if ((switchLength >= 2)
523 && (strncmp(argv[2], "-pickplace", switchLength) == 0)) {
524 pickPlace = 1;
525 }
526 }
527 if ((pickPlace+3) != argc) {
528 goto yviewSyntax;
529 }
530 if (Tcl_GetInt(interp, argv[2+pickPlace], &line1) != TCL_OK) {
531 Tcl_ResetResult(interp);
532 if (TkTextGetIndex(interp, textPtr, argv[2+pickPlace],
533 &line1, &ch1) != TCL_OK) {
534 result = TCL_ERROR;
535 goto done;
536 }
537 }
538 numLines = TkBTreeNumLines(textPtr->tree);
539 if (line1 >= numLines) {
540 line1 = numLines-1;
541 }
542 if (line1 < 0) {
543 line1 = 0;
544 }
545 TkTextSetView(textPtr, line1, pickPlace);
546 } else {
547 Tcl_AppendResult(interp, "bad option \"", argv[1],
548 "\": must be compare, configure, debug, delete, get, ",
549 "index, insert, mark, scan, tag, or yview",
550 (char *) NULL);
551 result = TCL_ERROR;
552 }
553
554 done:
555 Tk_Release((ClientData) textPtr);
556 return result;
557 }
558 \f
559 /*
560 *----------------------------------------------------------------------
561 *
562 * DestroyText --
563 *
564 * This procedure is invoked by Tk_EventuallyFree or Tk_Release
565 * to clean up the internal structure of a text at a safe time
566 * (when no-one is using it anymore).
567 *
568 * Results:
569 * None.
570 *
571 * Side effects:
572 * Everything associated with the text is freed up.
573 *
574 *----------------------------------------------------------------------
575 */
576
577 static void
578 DestroyText(
579 ClientData clientData /* Info about text widget. */
580 )
581 {
582 register TkText *textPtr = (TkText *) clientData;
583 Tcl_HashSearch search;
584 Tcl_HashEntry *hPtr;
585 TkTextTag *tagPtr;
586
587 TkBTreeDestroy(textPtr->tree);
588 for (hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search);
589 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
590 tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
591 TkTextFreeTag(tagPtr);
592 }
593 Tcl_DeleteHashTable(&textPtr->tagTable);
594 for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search);
595 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
596 ckfree((char *) Tcl_GetHashValue(hPtr));
597 }
598 Tcl_DeleteHashTable(&textPtr->markTable);
599 if (textPtr->border != NULL) {
600 Tk_Free3DBorder(textPtr->border);
601 }
602 if (textPtr->cursor != None) {
603 Tk_FreeCursor(textPtr->cursor);
604 }
605 if (textPtr->fgColor != NULL) {
606 Tk_FreeColor(textPtr->fgColor);
607 }
608 if (textPtr->fontPtr != NULL) {
609 Tk_FreeFontStruct(textPtr->fontPtr);
610 }
611 TkTextFreeDInfo(textPtr);
612
613 /*
614 * NOTE: do NOT free up selBorder or selFgColorPtr: they are
615 * duplicates of information in the "sel" tag, which was freed
616 * up as part of deleting the tags above.
617 */
618
619 if (textPtr->insertBorder != NULL) {
620 Tk_Free3DBorder(textPtr->insertBorder);
621 }
622 if (textPtr->insertBlinkHandler != NULL) {
623 Tk_DeleteTimerHandler(textPtr->insertBlinkHandler);
624 }
625 if (textPtr->updateTimerToken != NULL) {
626 Tk_DeleteTimerHandler(textPtr->updateTimerToken);
627 textPtr->updateTimerToken = 0;
628 }
629 if (textPtr->bindingTable != NULL) {
630 Tk_DeleteBindingTable(textPtr->bindingTable);
631 }
632 if (textPtr->yScrollCmd != NULL) {
633 ckfree(textPtr->yScrollCmd);
634 }
635 ckfree((char *) textPtr);
636 }
637 \f
638 /*
639 *----------------------------------------------------------------------
640 *
641 * ConfigureText --
642 *
643 * This procedure is called to process an argv/argc list, plus
644 * the Tk option database, in order to configure (or
645 * reconfigure) a text widget.
646 *
647 * Results:
648 * The return value is a standard Tcl result. If TCL_ERROR is
649 * returned, then interp->result contains an error message.
650 *
651 * Side effects:
652 * Configuration information, such as text string, colors, font,
653 * etc. get set for textPtr; old resources get freed, if there
654 * were any.
655 *
656 *----------------------------------------------------------------------
657 */
658
659 static int
660 ConfigureText (
661 Tcl_Interp *interp, /* Used for error reporting. */
662 register TkText *textPtr, /* Information about widget; may or may
663 * not already have values for some fields. */
664 int argc, /* Number of valid entries in argv. */
665 char **argv, /* Arguments. */
666 int flags /* Flags to pass to Tk_ConfigureWidget. */
667 )
668 {
669 int oldExport = textPtr->exportSelection;
670 int charWidth, charHeight;
671
672 if (Tk_ConfigureWidget(interp, textPtr->tkwin, configSpecs,
673 argc, argv, (char *) textPtr, flags) != TCL_OK) {
674 return TCL_ERROR;
675 }
676
677 /*
678 * A few other options also need special processing, such as parsing
679 * the geometry and setting the background from a 3-D border.
680 */
681
682 if ((textPtr->state != tkTextNormalUid)
683 && (textPtr->state != tkTextDisabledUid)) {
684 Tcl_AppendResult(interp, "bad state value \"", textPtr->state,
685 "\": must be normal or disabled", (char *) NULL);
686 textPtr->state = tkTextNormalUid;
687 return TCL_ERROR;
688 }
689
690 if ((textPtr->wrapMode != tkTextCharUid)
691 && (textPtr->wrapMode != tkTextNoneUid)
692 && (textPtr->wrapMode != tkTextWordUid)) {
693 Tcl_AppendResult(interp, "bad wrap mode \"", textPtr->state,
694 "\": must be char, none, or word", (char *) NULL);
695 textPtr->wrapMode = tkTextCharUid;
696 return TCL_ERROR;
697 }
698
699 Tk_SetBackgroundFromBorder(textPtr->tkwin, textPtr->border);
700 Tk_SetInternalBorder(textPtr->tkwin, textPtr->borderWidth);
701 Tk_GeometryRequest(textPtr->tkwin, 200, 100);
702
703 /*
704 * Make sure that configuration options are properly mirrored
705 * between the widget record and the "sel" tags. NOTE: we don't
706 * have to free up information during the mirroring; old
707 * information was freed when it was replaced in the widget
708 * record.
709 */
710
711 textPtr->selTagPtr->border = textPtr->selBorder;
712 textPtr->selTagPtr->borderWidth = textPtr->selBorderWidth;
713 textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr;
714
715 /*
716 * Claim the selection if we've suddenly started exporting it and there
717 * are tagged characters.
718 */
719
720 if (textPtr->exportSelection && (!oldExport)) {
721 TkTextSearch search;
722
723 TkBTreeStartSearch(textPtr->tree, 0, 0, TkBTreeNumLines(textPtr->tree),
724 0, textPtr->selTagPtr, &search);
725 if (TkBTreeNextTag(&search)) {
726 Tk_OwnSelection(textPtr->tkwin, TkTextLostSelection,
727 (ClientData) textPtr);
728 textPtr->flags |= GOT_SELECTION;
729 }
730 }
731
732 /*
733 * Register the desired geometry for the window, and arrange for
734 * the window to be redisplayed.
735 */
736
737 if (textPtr->width <= 0) {
738 textPtr->width = 1;
739 }
740 if (textPtr->height <= 0) {
741 textPtr->height = 1;
742 }
743 charWidth = XTextWidth(textPtr->fontPtr, "0", 1);
744 charHeight = (textPtr->fontPtr->ascent + textPtr->fontPtr->descent);
745 Tk_GeometryRequest(textPtr->tkwin,
746 textPtr->width * charWidth + 2*textPtr->borderWidth
747 + 2*textPtr->padX,
748 textPtr->height * charHeight + 2*textPtr->borderWidth
749 + 2*textPtr->padX);
750 Tk_SetInternalBorder(textPtr->tkwin, textPtr->borderWidth);
751 if (textPtr->setGrid) {
752 Tk_SetGrid(textPtr->tkwin, textPtr->width, textPtr->height,
753 charWidth, charHeight);
754 }
755
756 TkTextRelayoutWindow(textPtr);
757 return TCL_OK;
758 }
759 \f
760 /*
761 *--------------------------------------------------------------
762 *
763 * TextEventProc --
764 *
765 * This procedure is invoked by the Tk dispatcher on
766 * structure changes to a text. For texts with 3D
767 * borders, this procedure is also invoked for exposures.
768 *
769 * Results:
770 * None.
771 *
772 * Side effects:
773 * When the window gets deleted, internal structures get
774 * cleaned up. When it gets exposed, it is redisplayed.
775 *
776 *--------------------------------------------------------------
777 */
778
779 static void
780 TextEventProc(
781 ClientData clientData, /* Information about window. */
782 register XEvent *eventPtr /* Information about event. */
783 )
784 {
785 register TkText *textPtr = (TkText *) clientData;
786
787 if (eventPtr->type == Expose) {
788 TkTextRedrawRegion(textPtr, eventPtr->xexpose.x,
789 eventPtr->xexpose.y, eventPtr->xexpose.width,
790 eventPtr->xexpose.height);
791 } else if (eventPtr->type == ConfigureNotify) {
792 if ((textPtr->prevWidth != Tk_Width(textPtr->tkwin))
793 || (textPtr->prevHeight != Tk_Height(textPtr->tkwin))) {
794 TkTextRelayoutWindow(textPtr);
795 }
796 } else if (eventPtr->type == DestroyNotify) {
797 Tcl_DeleteCommand(textPtr->interp, Tk_PathName(textPtr->tkwin));
798 textPtr->tkwin = NULL;
799 Tk_EventuallyFree((ClientData) textPtr, DestroyText);
800 }
801 }
802 \f
803 /*
804 *----------------------------------------------------------------------
805 *
806 * InsertChars --
807 *
808 * This procedure implements most of the functionality of the
809 * "insert" widget command.
810 *
811 * Results:
812 * None.
813 *
814 * Side effects:
815 * The characters in "string" get added to the text just before
816 * the character indicated by "line" and "ch".
817 *
818 *----------------------------------------------------------------------
819 */
820
821 static void
822 InsertChars (
823 TkText *textPtr, /* Overall information about text widget. */
824 int line,
825 int ch, /* Identifies character just before which
826 * new information is to be inserted. */
827 char *string /* Null-terminated string containing new
828 * information to add to text. */
829 )
830 {
831 register TkTextLine *linePtr;
832
833 /*
834 * Locate the line where the insertion will occur.
835 */
836
837 linePtr = TkTextRoundIndex(textPtr, &line, &ch);
838
839 /*
840 * Notify the display module that lines are about to change, then do
841 * the insertion.
842 */
843
844 TkTextLinesChanged(textPtr, line, line);
845 TkBTreeInsertChars(textPtr->tree, linePtr, ch, string);
846
847 /*
848 * If the line containing the insertion point was textPtr->topLinePtr,
849 * we must reset this pointer since the line structure was re-allocated.
850 */
851
852 if (linePtr == textPtr->topLinePtr) {
853 TkTextSetView(textPtr, line, 0);
854 }
855
856 /*
857 * Invalidate any selection retrievals in progress.
858 */
859
860 textPtr->selOffset = -1;
861 }
862 \f
863 /*
864 *----------------------------------------------------------------------
865 *
866 * DeleteChars --
867 *
868 * This procedure implements most of the functionality of the
869 * "delete" widget command.
870 *
871 * Results:
872 * None.
873 *
874 * Side effects:
875 * None.
876 *
877 *----------------------------------------------------------------------
878 */
879
880 static void
881 DeleteChars (
882 TkText *textPtr, /* Overall information about text widget. */
883 int line1,
884 int ch1, /* Position of first character to delete. */
885 int line2,
886 int ch2 /* Position of character just after last
887 * one to delete. */
888 )
889 {
890 register TkTextLine *line1Ptr, *line2Ptr;
891 int numLines, topLine;
892
893 /*
894 * The loop below is needed because a LeaveNotify event may be
895 * generated on the current charcter if it's about to be deleted.
896 * If this happens, then the bindings that trigger could modify
897 * the text, invalidating the range information computed here.
898 * So, go back and recompute all the range information after
899 * synthesizing a leave event.
900 */
901
902 while (1) {
903
904 /*
905 * Locate the starting and ending lines for the deletion and adjust
906 * the endpoints if necessary to ensure that they are within valid
907 * ranges. Adjust the deletion range if necessary to ensure that the
908 * text (and each invidiual line) always ends in a newline.
909 */
910
911 numLines = TkBTreeNumLines(textPtr->tree);
912 line1Ptr = TkTextRoundIndex(textPtr, &line1, &ch1);
913 if (line2 < 0) {
914 return;
915 } else if (line2 >= numLines) {
916 line2 = numLines-1;
917 line2Ptr = TkBTreeFindLine(textPtr->tree, line2);
918 ch2 = line2Ptr->numBytes;
919 } else {
920 line2Ptr = TkBTreeFindLine(textPtr->tree, line2);
921 if (ch2 < 0) {
922 ch2 = 0;
923 }
924 }
925
926 /*
927 * If the deletion range ends after the last character of a line,
928 * do one of three things:
929 *
930 * (a) if line2Ptr isn't the last line of the text, just adjust the
931 * ending point to be just before the 0th character of the next
932 * line.
933 * (b) if ch1 is at the beginning of a line, then adjust line1Ptr and
934 * ch1 to point just after the last character of the previous line.
935 * (c) otherwise, adjust ch2 so the final newline isn't deleted.
936 */
937
938 if (ch2 >= line2Ptr->numBytes) {
939 if (line2 < (numLines-1)) {
940 line2++;
941 line2Ptr = TkBTreeNextLine(line2Ptr);
942 ch2 = 0;
943 } else {
944 ch2 = line2Ptr->numBytes-1;
945 if ((ch1 == 0) && (line1 > 0)) {
946 line1--;
947 line1Ptr = TkBTreeFindLine(textPtr->tree, line1);
948 ch1 = line1Ptr->numBytes;
949 ch2 = line2Ptr->numBytes;
950 } else {
951 ch2 = line2Ptr->numBytes-1;
952 }
953 }
954 }
955
956 if ((line1 > line2) || ((line1 == line2) && (ch1 >= ch2))) {
957 return;
958 }
959
960 /*
961 * If the current character is within the range being deleted,
962 * unpick it and synthesize a leave event for its tags, then
963 * go back and recompute the range ends.
964 */
965
966 if (!(textPtr->flags & IN_CURRENT)) {
967 break;
968 }
969 if ((textPtr->currentAnnotPtr->linePtr == line1Ptr)
970 && (textPtr->currentAnnotPtr->ch < ch1)) {
971 break;
972 }
973 if ((textPtr->currentAnnotPtr->linePtr == line2Ptr)
974 && (textPtr->currentAnnotPtr->ch >= ch2)) {
975 break;
976 }
977 if (line2 > (line1+1)) {
978 int currentLine;
979
980 currentLine = TkBTreeLineIndex(textPtr->currentAnnotPtr->linePtr);
981 if ((currentLine <= line1) || (currentLine >= line2)) {
982 break;
983 }
984 }
985 TkTextUnpickCurrent(textPtr);
986 }
987
988 /*
989 * Tell the display what's about to happen so it can discard
990 * obsolete display information, then do the deletion. Also,
991 * check to see if textPtr->topLinePtr is in the range of
992 * characters deleted. If so, call the display module to reset
993 * it after doing the deletion.
994 */
995
996 topLine = TkBTreeLineIndex(textPtr->topLinePtr);
997 TkTextLinesChanged(textPtr, line1, line2);
998 TkBTreeDeleteChars(textPtr->tree, line1Ptr, ch1, line2Ptr, ch2);
999 if ((topLine >= line1) && (topLine <= line2)) {
1000 numLines = TkBTreeNumLines(textPtr->tree);
1001 TkTextSetView(textPtr, (line1 > (numLines-1)) ? (numLines-1) : line1,
1002 0);
1003 }
1004
1005 /*
1006 * Invalidate any selection retrievals in progress.
1007 */
1008
1009 textPtr->selOffset = -1;
1010 }
1011 \f
1012 /*
1013 *----------------------------------------------------------------------
1014 *
1015 * TextFetchSelection --
1016 *
1017 * This procedure is called back by Tk when the selection is
1018 * requested by someone. It returns part or all of the selection
1019 * in a buffer provided by the caller.
1020 *
1021 * Results:
1022 * The return value is the number of non-NULL bytes stored
1023 * at buffer. Buffer is filled (or partially filled) with a
1024 * NULL-terminated string containing part or all of the selection,
1025 * as given by offset and maxBytes.
1026 *
1027 * Side effects:
1028 * None.
1029 *
1030 *----------------------------------------------------------------------
1031 */
1032
1033 static int
1034 TextFetchSelection(
1035 ClientData clientData, /* Information about text widget. */
1036 int offset, /* Offset within selection of first
1037 * character to be returned. */
1038 char *buffer, /* Location in which to place
1039 * selection. */
1040 int maxBytes /* Maximum number of bytes to place
1041 * at buffer, not including terminating
1042 * NULL character. */
1043 )
1044 {
1045 register TkText *textPtr = (TkText *) clientData;
1046 register TkTextLine *linePtr;
1047 int count, chunkSize;
1048 TkTextSearch search;
1049
1050 if (!textPtr->exportSelection) {
1051 return -1;
1052 }
1053
1054 /*
1055 * Find the beginning of the next range of selected text. Note: if
1056 * the selection is being retrieved in multiple pieces (offset != 0)
1057 * and some modification has been made to the text that affects the
1058 * selection (textPtr->selOffset != offset) then reject the selection
1059 * request (make 'em start over again).
1060 */
1061
1062 if (offset == 0) {
1063 textPtr->selLine = 0;
1064 textPtr->selCh = 0;
1065 textPtr->selOffset = 0;
1066 } else if (textPtr->selOffset != offset) {
1067 return 0;
1068 }
1069 TkBTreeStartSearch(textPtr->tree, textPtr->selLine, textPtr->selCh+1,
1070 TkBTreeNumLines(textPtr->tree), 0, textPtr->selTagPtr, &search);
1071 if (!TkBTreeCharTagged(search.linePtr, textPtr->selCh,
1072 textPtr->selTagPtr)) {
1073 if (!TkBTreeNextTag(&search)) {
1074 if (offset == 0) {
1075 return -1;
1076 } else {
1077 return 0;
1078 }
1079 }
1080 textPtr->selLine = search.line1;
1081 textPtr->selCh = search.ch1;
1082 }
1083
1084 /*
1085 * Each iteration through the outer loop below scans one selected range.
1086 * Each iteration through the nested loop scans one line in the
1087 * selected range.
1088 */
1089
1090 count = 0;
1091 while (1) {
1092 linePtr = search.linePtr;
1093
1094 /*
1095 * Find the end of the current range of selected text.
1096 */
1097
1098 if (!TkBTreeNextTag(&search)) {
1099 panic("TextFetchSelection couldn't find end of range");
1100 }
1101
1102 /*
1103 * Copy information from text lines into the buffer until
1104 * either we run out of space in the buffer or we get to
1105 * the end of this range of text.
1106 */
1107
1108 while (1) {
1109 chunkSize = ((linePtr == search.linePtr) ? search.ch1
1110 : linePtr->numBytes) - textPtr->selCh;
1111 if (chunkSize > maxBytes) {
1112 chunkSize = maxBytes;
1113 }
1114 memcpy((VOID *) buffer, (VOID *) (linePtr->bytes + textPtr->selCh),
1115 chunkSize);
1116 buffer += chunkSize;
1117 maxBytes -= chunkSize;
1118 count += chunkSize;
1119 textPtr->selOffset += chunkSize;
1120 if (maxBytes == 0) {
1121 textPtr->selCh += chunkSize;
1122 goto done;
1123 }
1124 if (linePtr == search.linePtr) {
1125 break;
1126 }
1127 textPtr->selCh = 0;
1128 textPtr->selLine++;
1129 linePtr = TkBTreeNextLine(linePtr);
1130 }
1131
1132 /*
1133 * Find the beginning of the next range of selected text.
1134 */
1135
1136 if (!TkBTreeNextTag(&search)) {
1137 break;
1138 }
1139 textPtr->selLine = search.line1;
1140 textPtr->selCh = search.ch1;
1141 }
1142
1143 done:
1144 *buffer = 0;
1145 return count;
1146 }
1147 \f
1148 /*
1149 *----------------------------------------------------------------------
1150 *
1151 * TkTextLostSelection --
1152 *
1153 * This procedure is called back by Tk when the selection is
1154 * grabbed away from a text widget.
1155 *
1156 * Results:
1157 * None.
1158 *
1159 * Side effects:
1160 * The "sel" tag is cleared from the window.
1161 *
1162 *----------------------------------------------------------------------
1163 */
1164
1165 void
1166 TkTextLostSelection(
1167 ClientData clientData /* Information about text widget. */
1168 )
1169 {
1170 register TkText *textPtr = (TkText *) clientData;
1171
1172 if (!textPtr->exportSelection) {
1173 return;
1174 }
1175
1176 /*
1177 * Just remove the "sel" tag from everything in the widget.
1178 */
1179
1180 TkTextRedrawTag(textPtr, 0, 0, TkBTreeNumLines(textPtr->tree),
1181 0, textPtr->selTagPtr, 1);
1182 TkBTreeTag(textPtr->tree, 0, 0, TkBTreeNumLines(textPtr->tree),
1183 0, textPtr->selTagPtr, 0);
1184 textPtr->flags &= ~GOT_SELECTION;
1185 }
1186 \f
1187 /*
1188 *--------------------------------------------------------------
1189 *
1190 * TextMarkCmd --
1191 *
1192 * This procedure is invoked to process the "mark" options of
1193 * the widget command for text widgets. See the user documentation
1194 * for details on what it does.
1195 *
1196 * Results:
1197 * A standard Tcl result.
1198 *
1199 * Side effects:
1200 * See the user documentation.
1201 *
1202 *--------------------------------------------------------------
1203 */
1204
1205 static int
1206 TextMarkCmd (
1207 register TkText *textPtr, /* Information about text widget. */
1208 Tcl_Interp *interp, /* Current interpreter. */
1209 int argc, /* Number of arguments. */
1210 char **argv /* Argument strings. Someone else has already
1211 * parsed this command enough to know that
1212 * argv[1] is "mark". */
1213 )
1214 {
1215 int length, line, ch, i;
1216 char c;
1217 Tcl_HashEntry *hPtr;
1218 TkAnnotation *markPtr;
1219 Tcl_HashSearch search;
1220
1221 if (argc < 3) {
1222 Tcl_AppendResult(interp, "wrong # args: should be \"",
1223 argv[0], " mark option ?arg arg ...?\"", (char *) NULL);
1224 return TCL_ERROR;
1225 }
1226 c = argv[2][0];
1227 length = strlen(argv[2]);
1228 if ((c == 'n') && (strncmp(argv[2], "names", length) == 0)) {
1229 if (argc != 3) {
1230 Tcl_AppendResult(interp, "wrong # args: should be \"",
1231 argv[0], " mark names\"", (char *) NULL);
1232 return TCL_ERROR;
1233 }
1234 for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search);
1235 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
1236 Tcl_AppendElement(interp,
1237 Tcl_GetHashKey(&textPtr->markTable, hPtr), 0);
1238 }
1239 } else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) {
1240 if (argc != 5) {
1241 Tcl_AppendResult(interp, "wrong # args: should be \"",
1242 argv[0], " mark set markName index\"", (char *) NULL);
1243 return TCL_ERROR;
1244 }
1245 if (TkTextGetIndex(interp, textPtr, argv[4], &line, &ch) != TCL_OK) {
1246 return TCL_ERROR;
1247 }
1248 TkTextSetMark(textPtr, argv[3], line, ch);
1249 } else if ((c == 'u') && (strncmp(argv[2], "unset", length) == 0)) {
1250 if (argc < 4) {
1251 Tcl_AppendResult(interp, "wrong # args: should be \"",
1252 argv[0], " mark unset markName ?markName ...?\"",
1253 (char *) NULL);
1254 return TCL_ERROR;
1255 }
1256 for (i = 3; i < argc; i++) {
1257 hPtr = Tcl_FindHashEntry(&textPtr->markTable, argv[i]);
1258 if (hPtr != NULL) {
1259 markPtr = (TkAnnotation *) Tcl_GetHashValue(hPtr);
1260 if (markPtr == textPtr->insertAnnotPtr) {
1261 interp->result = "can't delete \"insert\" mark";
1262 return TCL_ERROR;
1263 }
1264 if (markPtr == textPtr->currentAnnotPtr) {
1265 interp->result = "can't delete \"current\" mark";
1266 return TCL_ERROR;
1267 }
1268 TkBTreeRemoveAnnotation(markPtr);
1269 Tcl_DeleteHashEntry(hPtr);
1270 ckfree((char *) markPtr);
1271 }
1272 }
1273 } else {
1274 Tcl_AppendResult(interp, "bad mark option \"", argv[2],
1275 "\": must be names, set, or unset",
1276 (char *) NULL);
1277 return TCL_ERROR;
1278 }
1279 return TCL_OK;
1280 }
1281 \f
1282 /*
1283 *----------------------------------------------------------------------
1284 *
1285 * TkTextSetMark --
1286 *
1287 * Set a mark to a particular position, creating a new mark if
1288 * one doesn't already exist.
1289 *
1290 * Results:
1291 * The return value is a pointer to the mark that was just set.
1292 *
1293 * Side effects:
1294 * A new mark is created, or an existing mark is moved.
1295 *
1296 *----------------------------------------------------------------------
1297 */
1298
1299 TkAnnotation *
1300 TkTextSetMark (
1301 TkText *textPtr, /* Text widget in which to create mark. */
1302 char *name, /* Name of mark to set. */
1303 int line, /* Index of line at which to place mark. */
1304 int ch /* Index of character within line at which
1305 * to place mark. */
1306 )
1307 {
1308 Tcl_HashEntry *hPtr;
1309 TkAnnotation *markPtr;
1310 int new;
1311
1312 hPtr = Tcl_CreateHashEntry(&textPtr->markTable, name, &new);
1313 markPtr = (TkAnnotation *) Tcl_GetHashValue(hPtr);
1314 if (!new) {
1315 /*
1316 * If this is the insertion point that's being moved, be sure
1317 * to force a display update at the old position.
1318 */
1319
1320 if (markPtr == textPtr->insertAnnotPtr) {
1321 int oldLine;
1322
1323 oldLine = TkBTreeLineIndex(markPtr->linePtr);
1324 TkTextLinesChanged(textPtr, oldLine, oldLine);
1325 }
1326 TkBTreeRemoveAnnotation(markPtr);
1327 } else {
1328 markPtr = (TkAnnotation *) ckalloc(sizeof(TkAnnotation));
1329 markPtr->type = TK_ANNOT_MARK;
1330 markPtr->info.hPtr = hPtr;
1331 Tcl_SetHashValue(hPtr, markPtr);
1332 }
1333 if (line < 0) {
1334 line = 0;
1335 markPtr->ch = 0;
1336 } else if (ch < 0) {
1337 markPtr->ch = 0;
1338 } else {
1339 markPtr->ch = ch;
1340 }
1341 markPtr->linePtr = TkBTreeFindLine(textPtr->tree, line);
1342 if (markPtr->linePtr == NULL) {
1343 line = TkBTreeNumLines(textPtr->tree)-1;
1344 markPtr->linePtr = TkBTreeFindLine(textPtr->tree, line);
1345 markPtr->ch = markPtr->linePtr->numBytes-1;
1346 } else {
1347 if (markPtr->ch >= markPtr->linePtr->numBytes) {
1348 TkTextLine *nextLinePtr;
1349
1350 nextLinePtr = TkBTreeNextLine(markPtr->linePtr);
1351 if (nextLinePtr == NULL) {
1352 markPtr->ch = markPtr->linePtr->numBytes-1;
1353 } else {
1354 markPtr->linePtr = nextLinePtr;
1355 line++;
1356 markPtr->ch = 0;
1357 }
1358 }
1359 }
1360 TkBTreeAddAnnotation(markPtr);
1361
1362 /*
1363 * If the mark is the insertion cursor, then update the screen at the
1364 * mark's new location.
1365 */
1366
1367 if (markPtr == textPtr->insertAnnotPtr) {
1368 TkTextLinesChanged(textPtr, line, line);
1369 }
1370 return markPtr;
1371 }
1372 \f
1373 /*
1374 *----------------------------------------------------------------------
1375 *
1376 * TextBlinkProc --
1377 *
1378 * This procedure is called as a timer handler to blink the
1379 * insertion cursor off and on.
1380 *
1381 * Results:
1382 * None.
1383 *
1384 * Side effects:
1385 * The cursor gets turned on or off, redisplay gets invoked,
1386 * and this procedure reschedules itself.
1387 *
1388 *----------------------------------------------------------------------
1389 */
1390
1391 static void
1392 TextBlinkProc(
1393 ClientData clientData /* Pointer to record describing text. */
1394 )
1395 {
1396 register TkText *textPtr = (TkText *) clientData;
1397 int lineNum;
1398
1399 if (!(textPtr->flags & GOT_FOCUS) || (textPtr->insertOffTime == 0)) {
1400 return;
1401 }
1402 if (textPtr->flags & INSERT_ON) {
1403 textPtr->flags &= ~INSERT_ON;
1404 textPtr->insertBlinkHandler = Tk_CreateTimerHandler(
1405 textPtr->insertOffTime, TextBlinkProc, (ClientData) textPtr);
1406 } else {
1407 textPtr->flags |= INSERT_ON;
1408 textPtr->insertBlinkHandler = Tk_CreateTimerHandler(
1409 textPtr->insertOnTime, TextBlinkProc, (ClientData) textPtr);
1410 }
1411 lineNum = TkBTreeLineIndex(textPtr->insertAnnotPtr->linePtr);
1412 TkTextLinesChanged(textPtr, lineNum, lineNum);
1413 }
1414 \f
1415 /*
1416 *----------------------------------------------------------------------
1417 *
1418 * TextFocusProc --
1419 *
1420 * This procedure is called whenever the entry gets or loses the
1421 * input focus. It's also called whenever the window is reconfigured
1422 * while it has the focus.
1423 *
1424 * Results:
1425 * None.
1426 *
1427 * Side effects:
1428 * The cursor gets turned on or off.
1429 *
1430 *----------------------------------------------------------------------
1431 */
1432
1433 static void
1434 TextFocusProc(
1435 ClientData clientData, /* Pointer to structure describing text. */
1436 int gotFocus /* 1 means window is getting focus, 0 means
1437 * it's losing it. */
1438 )
1439 {
1440 register TkText *textPtr = (TkText *) clientData;
1441 int lineNum;
1442
1443 Tk_DeleteTimerHandler(textPtr->insertBlinkHandler);
1444 if (gotFocus) {
1445 textPtr->flags |= GOT_FOCUS | INSERT_ON;
1446 if (textPtr->insertOffTime != 0) {
1447 textPtr->insertBlinkHandler = Tk_CreateTimerHandler(
1448 textPtr->insertOnTime, TextBlinkProc,
1449 (ClientData) textPtr);
1450 }
1451 } else {
1452 textPtr->flags &= ~(GOT_FOCUS | INSERT_ON);
1453 textPtr->insertBlinkHandler = (Tk_TimerToken) NULL;
1454 }
1455 lineNum = TkBTreeLineIndex(textPtr->insertAnnotPtr->linePtr);
1456 TkTextLinesChanged(textPtr, lineNum, lineNum);
1457 }
1458 \f
1459 /*
1460 *--------------------------------------------------------------
1461 *
1462 * TextScanCmd --
1463 *
1464 * This procedure is invoked to process the "scan" options of
1465 * the widget command for text widgets. See the user documentation
1466 * for details on what it does.
1467 *
1468 * Results:
1469 * A standard Tcl result.
1470 *
1471 * Side effects:
1472 * See the user documentation.
1473 *
1474 *--------------------------------------------------------------
1475 */
1476
1477 static int
1478 TextScanCmd (
1479 register TkText *textPtr, /* Information about text widget. */
1480 Tcl_Interp *interp, /* Current interpreter. */
1481 int argc, /* Number of arguments. */
1482 char **argv /* Argument strings. Someone else has already
1483 * parsed this command enough to know that
1484 * argv[1] is "tag". */
1485 )
1486 {
1487 int length, y, line, lastLine;
1488 char c;
1489
1490 if (argc != 4) {
1491 Tcl_AppendResult(interp, "wrong # args: should be \"",
1492 argv[0], " scan mark|dragto y\"", (char *) NULL);
1493 return TCL_ERROR;
1494 }
1495 if (Tcl_GetInt(interp, argv[3], &y) != TCL_OK) {
1496 return TCL_ERROR;
1497 }
1498 c = argv[2][0];
1499 length = strlen(argv[2]);
1500 if ((c == 'd') && (strncmp(argv[2], "dragto", length) == 0)) {
1501 /*
1502 * Amplify the difference between the current y position and the
1503 * mark position to compute how many lines up or down the view
1504 * should shift, then update the mark position to correspond to
1505 * the new view. If we run off the top or bottom of the text,
1506 * reset the mark point so that the current position continues
1507 * to correspond to the edge of the window. This means that the
1508 * picture will start dragging as soon as the mouse reverses
1509 * direction (without this reset, might have to slide mouse a
1510 * long ways back before the picture starts moving again).
1511 */
1512
1513 line = textPtr->scanMarkLine + (10*(textPtr->scanMarkY - y))
1514 / (textPtr->fontPtr->ascent + textPtr->fontPtr->descent);
1515 lastLine = TkBTreeNumLines(textPtr->tree) - 1;
1516 if (line < 0) {
1517 textPtr->scanMarkLine = line = 0;
1518 textPtr->scanMarkY = y;
1519 } else if (line > lastLine) {
1520 textPtr->scanMarkLine = line = lastLine;
1521 textPtr->scanMarkY = y;
1522 }
1523 TkTextSetView(textPtr, line, 0);
1524 } else if ((c == 'm') && (strncmp(argv[2], "mark", length) == 0)) {
1525 textPtr->scanMarkLine = TkBTreeLineIndex(textPtr->topLinePtr);
1526 textPtr->scanMarkY = y;
1527 } else {
1528 Tcl_AppendResult(interp, "bad scan option \"", argv[2],
1529 "\": must be mark or dragto", (char *) NULL);
1530 return TCL_ERROR;
1531 }
1532 return TCL_OK;
1533 }
Impressum, Datenschutz