OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [tags/] [start/] [insight/] [tk/] [generic/] [tkText.c] - Blame information for rev 1765

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.