![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tktext.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tk|
Return to tktext.c CVS log | Up to [Micropolis - Activity] / micropolis / src / tk |
1.1 root 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:
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:
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:
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:
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:
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:
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:
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:
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:
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:
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:
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:
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:
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:
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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.