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