]> git.zerfleddert.de Git - micropolis/blame - src/tcl/tclhist.c
add ugly sdl_helper to automagically find and enable SDL_mixer
[micropolis] / src / tcl / tclhist.c
CommitLineData
6a5fa4e0
MG
1/*
2 * tclHistory.c --
3 *
4 * This module implements history as an optional addition to Tcl.
5 * It can be called to record commands ("events") before they are
6 * executed, and it provides a command that may be used to perform
7 * history substitutions.
8 *
9 * Copyright 1990-1991 Regents of the University of California
10 * Permission to use, copy, modify, and distribute this
11 * software and its documentation for any purpose and without
12 * fee is hereby granted, provided that the above copyright
13 * notice appear in all copies. The University of California
14 * makes no representations about the suitability of this
15 * software for any purpose. It is provided "as is" without
16 * express or implied warranty.
17 */
18
19#ifndef lint
20static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclHistory.c,v 1.23 91/10/28 09:11:16 ouster Exp $ SPRITE (Berkeley)";
21#endif /* not lint */
22
23#include "tclint.h"
24
25/*
26 * This history stuff is mostly straightforward, except for one thing
27 * that makes everything very complicated. Suppose that the following
28 * commands get executed:
29 * echo foo
30 * history redo
31 * It's important that the history event recorded for the second command
32 * be "echo foo", not "history redo". Otherwise, if another "history redo"
33 * command is typed, it will result in infinite recursions on the
34 * "history redo" command. Thus, the actual recorded history must be
35 * echo foo
36 * echo foo
37 * To do this, the history command revises recorded history as part of
38 * its execution. In the example above, when "history redo" starts
39 * execution, the current event is "history redo", but the history
40 * command arranges for the current event to be changed to "echo foo".
41 *
42 * There are three additional complications. The first is that history
43 * substitution may only be part of a command, as in the following
44 * command sequence:
45 * echo foo bar
46 * echo [history word 3]
47 * In this case, the second event should be recorded as "echo bar". Only
48 * part of the recorded event is to be modified. Fortunately, Tcl_Eval
49 * helps with this by recording (in the evalFirst and evalLast fields of
50 * the intepreter) the location of the command being executed, so the
51 * history module can replace exactly the range of bytes corresponding
52 * to the history substitution command.
53 *
54 * The second complication is that there are two ways to revise history:
55 * replace a command, and replace the result of a command. Consider the
56 * two examples below:
57 * format {result is %d} $num | format {result is %d} $num
58 * print [history redo] | print [history word 3]
59 * Recorded history for these two cases should be as follows:
60 * format {result is %d} $num | format {result is %d} $num
61 * print [format {result is %d} $num] | print $num
62 * In the left case, the history command was replaced with another command
63 * to be executed (the brackets were retained), but in the case on the
64 * right the result of executing the history command was replaced (i.e.
65 * brackets were replaced too).
66 *
67 * The third complication is that there could potentially be many
68 * history substitutions within a single command, as in:
69 * echo [history word 3] [history word 2]
70 * There could even be nested history substitutions, as in:
71 * history subs abc [history word 2]
72 * If history revisions were made immediately during each "history" command
73 * invocations, it would be very difficult to produce the correct cumulative
74 * effect from several substitutions in the same command. To get around
75 * this problem, the actual history revision isn't made during the execution
76 * of the "history" command. Information about the changes is just recorded,
77 * in xxx records, and the actual changes are made during the next call to
78 * Tcl_RecordHistory (when we know that execution of the previous command
79 * has finished).
80 */
81
82/*
83 * Default space allocation for command strings:
84 */
85
86#define INITIAL_CMD_SIZE 40
87
88/*
89 * Forward declarations for procedures defined later in this file:
90 */
91
92static void DoRevs _ANSI_ARGS_((Interp *iPtr));
93static HistoryEvent * GetEvent _ANSI_ARGS_((Interp *iPtr, char *string));
94static char * GetWords _ANSI_ARGS_((Interp *iPtr, char *command,
95 char *words));
96static void InsertRev _ANSI_ARGS_((Interp *iPtr,
97 HistoryRev *revPtr));
98static void MakeSpace _ANSI_ARGS_((HistoryEvent *hPtr, int size));
99static void RevCommand _ANSI_ARGS_((Interp *iPtr, char *string));
100static void RevResult _ANSI_ARGS_((Interp *iPtr, char *string));
101static int SubsAndEval _ANSI_ARGS_((Interp *iPtr, char *cmd,
102 char *old, char *new));
103\f
104/*
105 *----------------------------------------------------------------------
106 *
107 * Tcl_InitHistory --
108 *
109 * Initialize history-related state in an interpreter.
110 *
111 * Results:
112 * None.
113 *
114 * Side effects:
115 * History info is initialized in iPtr.
116 *
117 *----------------------------------------------------------------------
118 */
119
120void
121Tcl_InitHistory(interp)
122 Tcl_Interp *interp; /* Interpreter to initialize. */
123{
124 register Interp *iPtr = (Interp *) interp;
125 int i;
126
127 if (iPtr->numEvents != 0) {
128 return;
129 }
130 iPtr->numEvents = 20;
131 iPtr->events = (HistoryEvent *)
132 ckalloc((unsigned) (iPtr->numEvents * sizeof(HistoryEvent)));
133 for (i = 0; i < iPtr->numEvents; i++) {
134 iPtr->events[i].command = (char *) ckalloc(INITIAL_CMD_SIZE);
135 *iPtr->events[i].command = 0;
136 iPtr->events[i].bytesAvl = INITIAL_CMD_SIZE;
137 }
138 iPtr->curEvent = 0;
139 iPtr->curEventNum = 0;
140 Tcl_CreateCommand((Tcl_Interp *) iPtr, "history", Tcl_HistoryCmd,
141 (ClientData) NULL, (void (*)()) NULL);
142}
143\f
144/*
145 *----------------------------------------------------------------------
146 *
147 * Tcl_RecordAndEval --
148 *
149 * This procedure adds its command argument to the current list of
150 * recorded events and then executes the command by calling Tcl_Eval.
151 *
152 * Results:
153 * The return value is a standard Tcl return value, the result of
154 * executing cmd.
155 *
156 * Side effects:
157 * The command is recorded and executed. In addition, pending history
158 * revisions are carried out, and information is set up to enable
159 * Tcl_Eval to identify history command ranges. This procedure also
160 * initializes history information for the interpreter, if it hasn't
161 * already been initialized.
162 *
163 *----------------------------------------------------------------------
164 */
165
166int
167Tcl_RecordAndEval(interp, cmd, flags)
168 Tcl_Interp *interp; /* Token for interpreter in which command
169 * will be executed. */
170 char *cmd; /* Command to record. */
171 int flags; /* Additional flags to pass to Tcl_Eval.
172 * TCL_NO_EVAL means only record: don't
173 * execute command. */
174{
175 register Interp *iPtr = (Interp *) interp;
176 register HistoryEvent *eventPtr;
177 int length, result;
178
179 if (iPtr->numEvents == 0) {
180 Tcl_InitHistory(interp);
181 }
182 DoRevs(iPtr);
183
184 /*
185 * Don't record empty commands.
186 */
187
188 while (isspace(*cmd)) {
189 cmd++;
190 }
191 if (*cmd == '\0') {
192 Tcl_ResetResult(interp);
193 return TCL_OK;
194 }
195
196 iPtr->curEventNum++;
197 iPtr->curEvent++;
198 if (iPtr->curEvent >= iPtr->numEvents) {
199 iPtr->curEvent = 0;
200 }
201 eventPtr = &iPtr->events[iPtr->curEvent];
202
203 /*
204 * Chop off trailing newlines before recording the command.
205 */
206
207 length = strlen(cmd);
208 while (cmd[length-1] == '\n') {
209 length--;
210 }
211 MakeSpace(eventPtr, length + 1);
212 strncpy(eventPtr->command, cmd, length);
213 eventPtr->command[length] = 0;
214
215 /*
216 * Execute the command. Note: history revision isn't possible after
217 * a nested call to this procedure, because the event at the top of
218 * the history list no longer corresponds to what's going on when
219 * a nested call here returns. Thus, must leave history revision
220 * disabled when we return.
221 */
222
223 result = TCL_OK;
224 if (flags != TCL_NO_EVAL) {
225 iPtr->historyFirst = cmd;
226 iPtr->revDisables = 0;
227 result = Tcl_Eval(interp, cmd, flags | TCL_RECORD_BOUNDS,
228 (char **) NULL);
229 }
230 iPtr->revDisables = 1;
231 return result;
232}
233\f
234/*
235 *----------------------------------------------------------------------
236 *
237 * Tcl_HistoryCmd --
238 *
239 * This procedure is invoked to process the "history" Tcl command.
240 * See the user documentation for details on what it does.
241 *
242 * Results:
243 * A standard Tcl result.
244 *
245 * Side effects:
246 * See the user documentation.
247 *
248 *----------------------------------------------------------------------
249 */
250
251 /* ARGSUSED */
252int
253Tcl_HistoryCmd(dummy, interp, argc, argv)
254 ClientData dummy; /* Not used. */
255 Tcl_Interp *interp; /* Current interpreter. */
256 int argc; /* Number of arguments. */
257 char **argv; /* Argument strings. */
258{
259 register Interp *iPtr = (Interp *) interp;
260 register HistoryEvent *eventPtr;
261 int length;
262 char c;
263
264 /*
265 * If no arguments, treat the same as "history info".
266 */
267
268 if (argc == 1) {
269 goto infoCmd;
270 }
271
272 c = argv[1][0];
273 length = strlen(argv[1]);
274
275 if ((c == 'a') && (strncmp(argv[1], "add", length)) == 0) {
276 if ((argc != 3) && (argc != 4)) {
277 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
278 " add event ?exec?\"", (char *) NULL);
279 return TCL_ERROR;
280 }
281 if (argc == 4) {
282 if (strncmp(argv[3], "exec", strlen(argv[3])) != 0) {
283 Tcl_AppendResult(interp, "bad argument \"", argv[3],
284 "\": should be \"exec\"", (char *) NULL);
285 return TCL_ERROR;
286 }
287 return Tcl_RecordAndEval(interp, argv[2], 0);
288 }
289 return Tcl_RecordAndEval(interp, argv[2], TCL_NO_EVAL);
290 } else if ((c == 'c') && (strncmp(argv[1], "change", length)) == 0) {
291 if ((argc != 3) && (argc != 4)) {
292 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
293 " change newValue ?event?\"", (char *) NULL);
294 return TCL_ERROR;
295 }
296 if (argc == 3) {
297 eventPtr = &iPtr->events[iPtr->curEvent];
298 iPtr->revDisables += 1;
299 while (iPtr->revPtr != NULL) {
300 HistoryRev *nextPtr;
301
302 ckfree(iPtr->revPtr->newBytes);
303 nextPtr = iPtr->revPtr->nextPtr;
304 ckfree((char *) iPtr->revPtr);
305 iPtr->revPtr = nextPtr;
306 }
307 } else {
308 eventPtr = GetEvent(iPtr, argv[3]);
309 if (eventPtr == NULL) {
310 return TCL_ERROR;
311 }
312 }
313 MakeSpace(eventPtr, strlen(argv[2]) + 1);
314 strcpy(eventPtr->command, argv[2]);
315 return TCL_OK;
316 } else if ((c == 'e') && (strncmp(argv[1], "event", length)) == 0) {
317 if (argc > 3) {
318 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
319 " event ?event?\"", (char *) NULL);
320 return TCL_ERROR;
321 }
322 eventPtr = GetEvent(iPtr, argc==2 ? "-1" : argv[2]);
323 if (eventPtr == NULL) {
324 return TCL_ERROR;
325 }
326 RevResult(iPtr, eventPtr->command);
327 Tcl_SetResult(interp, eventPtr->command, TCL_VOLATILE);
328 return TCL_OK;
329 } else if ((c == 'i') && (strncmp(argv[1], "info", length)) == 0) {
330 int count, indx, i;
331 char *newline;
332
333 if ((argc != 2) && (argc != 3)) {
334 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
335 " info ?count?\"", (char *) NULL);
336 return TCL_ERROR;
337 }
338 infoCmd:
339 if (argc == 3) {
340 if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
341 return TCL_ERROR;
342 }
343 if (count > iPtr->numEvents) {
344 count = iPtr->numEvents;
345 }
346 } else {
347 count = iPtr->numEvents;
348 }
349 newline = "";
350 for (i = 0, indx = iPtr->curEvent + 1 + iPtr->numEvents - count;
351 i < count; i++, indx++) {
352 char *cur, *next, savedChar;
353 char serial[20];
354
355 if (indx >= iPtr->numEvents) {
356 indx -= iPtr->numEvents;
357 }
358 cur = iPtr->events[indx].command;
359 if (*cur == '\0') {
360 continue; /* No command recorded here. */
361 }
362 sprintf(serial, "%6d ", iPtr->curEventNum + 1 - (count - i));
363 Tcl_AppendResult(interp, newline, serial, (char *) NULL);
364 newline = "\n";
365
366 /*
367 * Tricky formatting here: for multi-line commands, indent
368 * the continuation lines.
369 */
370
371 while (1) {
372 next = strchr(cur, '\n');
373 if (next == NULL) {
374 break;
375 }
376 next++;
377 savedChar = *next;
378 *next = 0;
379 Tcl_AppendResult(interp, cur, "\t", (char *) NULL);
380 *next = savedChar;
381 cur = next;
382 }
383 Tcl_AppendResult(interp, cur, (char *) NULL);
384 }
385 return TCL_OK;
386 } else if ((c == 'k') && (strncmp(argv[1], "keep", length)) == 0) {
387 int count, i, src;
388 HistoryEvent *events;
389
390 if (argc != 3) {
391 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
392 " keep number\"", (char *) NULL);
393 return TCL_ERROR;
394 }
395 if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
396 return TCL_ERROR;
397 }
398 if ((count <= 0) || (count > 1000)) {
399 Tcl_AppendResult(interp, "illegal keep count \"", argv[2],
400 "\"", (char *) NULL);
401 return TCL_ERROR;
402 }
403
404 /*
405 * Create a new history array and copy as much existing history
406 * as possible from the old array.
407 */
408
409 events = (HistoryEvent *)
410 ckalloc((unsigned) (count * sizeof(HistoryEvent)));
411 if (count < iPtr->numEvents) {
412 src = iPtr->curEvent + 1 - count;
413 if (src < 0) {
414 src += iPtr->numEvents;
415 }
416 } else {
417 src = iPtr->curEvent + 1;
418 }
419 for (i = 0; i < count; i++, src++) {
420 if (src >= iPtr->numEvents) {
421 src = 0;
422 }
423 if (i < iPtr->numEvents) {
424 events[i] = iPtr->events[src];
425 iPtr->events[src].command = NULL;
426 } else {
427 events[i].command = (char *) ckalloc(INITIAL_CMD_SIZE);
428 events[i].command[0] = 0;
429 events[i].bytesAvl = INITIAL_CMD_SIZE;
430 }
431 }
432
433 /*
434 * Throw away everything left in the old history array, and
435 * substitute the new one for the old one.
436 */
437
438 for (i = 0; i < iPtr->numEvents; i++) {
439 if (iPtr->events[i].command != NULL) {
440 ckfree(iPtr->events[i].command);
441 }
442 }
443 ckfree((char *) iPtr->events);
444 iPtr->events = events;
445 if (count < iPtr->numEvents) {
446 iPtr->curEvent = count-1;
447 } else {
448 iPtr->curEvent = iPtr->numEvents-1;
449 }
450 iPtr->numEvents = count;
451 return TCL_OK;
452 } else if ((c == 'n') && (strncmp(argv[1], "nextid", length)) == 0) {
453 if (argc != 2) {
454 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
455 " nextid\"", (char *) NULL);
456 return TCL_ERROR;
457 }
458 sprintf(iPtr->result, "%d", iPtr->curEventNum+1);
459 return TCL_OK;
460 } else if ((c == 'r') && (strncmp(argv[1], "redo", length)) == 0) {
461 if (argc > 3) {
462 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
463 " redo ?event?\"", (char *) NULL);
464 return TCL_ERROR;
465 }
466 eventPtr = GetEvent(iPtr, argc==2 ? "-1" : argv[2]);
467 if (eventPtr == NULL) {
468 return TCL_ERROR;
469 }
470 RevCommand(iPtr, eventPtr->command);
471 return Tcl_Eval(interp, eventPtr->command, 0, (char **) NULL);
472 } else if ((c == 's') && (strncmp(argv[1], "substitute", length)) == 0) {
473 if ((argc > 5) || (argc < 4)) {
474 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
475 " substitute old new ?event?\"", (char *) NULL);
476 return TCL_ERROR;
477 }
478 eventPtr = GetEvent(iPtr, argc==4 ? "-1" : argv[4]);
479 if (eventPtr == NULL) {
480 return TCL_ERROR;
481 }
482 return SubsAndEval(iPtr, eventPtr->command, argv[2], argv[3]);
483 } else if ((c == 'w') && (strncmp(argv[1], "words", length)) == 0) {
484 char *words;
485
486 if ((argc != 3) && (argc != 4)) {
487 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
488 " words num-num/pat ?event?\"", (char *) NULL);
489 return TCL_ERROR;
490 }
491 eventPtr = GetEvent(iPtr, argc==3 ? "-1" : argv[3]);
492 if (eventPtr == NULL) {
493 return TCL_ERROR;
494 }
495 words = GetWords(iPtr, eventPtr->command, argv[2]);
496 if (words == NULL) {
497 return TCL_ERROR;
498 }
499 RevResult(iPtr, words);
500 iPtr->result = words;
501 iPtr->freeProc = (Tcl_FreeProc *) free;
502 return TCL_OK;
503 }
504
505 Tcl_AppendResult(interp, "bad option \"", argv[1],
506 "\": must be add, change, event, info, keep, nextid, ",
507 "redo, substitute, or words", (char *) NULL);
508 return TCL_ERROR;
509}
510\f
511/*
512 *----------------------------------------------------------------------
513 *
514 * MakeSpace --
515 *
516 * Given a history event, make sure it has enough space for
517 * a string of a given length (enlarge the string area if
518 * necessary).
519 *
520 * Results:
521 * None.
522 *
523 * Side effects:
524 * More memory may get allocated.
525 *
526 *----------------------------------------------------------------------
527 */
528
529static void
530MakeSpace(hPtr, size)
531 HistoryEvent *hPtr;
532 int size; /* # of bytes needed in hPtr. */
533{
534 if (hPtr->bytesAvl < size) {
535 ckfree(hPtr->command);
536 hPtr->command = (char *) ckalloc((unsigned) size);
537 hPtr->bytesAvl = size;
538 }
539}
540\f
541/*
542 *----------------------------------------------------------------------
543 *
544 * InsertRev --
545 *
546 * Add a new revision to the list of those pending for iPtr.
547 * Do it in a way that keeps the revision list sorted in
548 * increasing order of firstIndex. Also, eliminate revisions
549 * that are subsets of other revisions.
550 *
551 * Results:
552 * None.
553 *
554 * Side effects:
555 * RevPtr is added to iPtr's revision list.
556 *
557 *----------------------------------------------------------------------
558 */
559
560static void
561InsertRev(iPtr, revPtr)
562 Interp *iPtr; /* Interpreter to use. */
563 register HistoryRev *revPtr; /* Revision to add to iPtr's list. */
564{
565 register HistoryRev *curPtr;
566 register HistoryRev *prevPtr;
567
568 for (curPtr = iPtr->revPtr, prevPtr = NULL; curPtr != NULL;
569 prevPtr = curPtr, curPtr = curPtr->nextPtr) {
570 /*
571 * If this revision includes the new one (or vice versa) then
572 * just eliminate the one that is a subset of the other.
573 */
574
575 if ((revPtr->firstIndex <= curPtr->firstIndex)
576 && (revPtr->lastIndex >= curPtr->firstIndex)) {
577 curPtr->firstIndex = revPtr->firstIndex;
578 curPtr->lastIndex = revPtr->lastIndex;
579 curPtr->newSize = revPtr->newSize;
580 ckfree(curPtr->newBytes);
581 curPtr->newBytes = revPtr->newBytes;
582 ckfree((char *) revPtr);
583 return;
584 }
585 if ((revPtr->firstIndex >= curPtr->firstIndex)
586 && (revPtr->lastIndex <= curPtr->lastIndex)) {
587 ckfree(revPtr->newBytes);
588 ckfree((char *) revPtr);
589 return;
590 }
591
592 if (revPtr->firstIndex < curPtr->firstIndex) {
593 break;
594 }
595 }
596
597 /*
598 * Insert revPtr just after prevPtr.
599 */
600
601 if (prevPtr == NULL) {
602 revPtr->nextPtr = iPtr->revPtr;
603 iPtr->revPtr = revPtr;
604 } else {
605 revPtr->nextPtr = prevPtr->nextPtr;
606 prevPtr->nextPtr = revPtr;
607 }
608}
609\f
610/*
611 *----------------------------------------------------------------------
612 *
613 * RevCommand --
614 *
615 * This procedure is invoked by the "history" command to record
616 * a command revision. See the comments at the beginning of the
617 * file for more information about revisions.
618 *
619 * Results:
620 * None.
621 *
622 * Side effects:
623 * Revision information is recorded.
624 *
625 *----------------------------------------------------------------------
626 */
627
628static void
629RevCommand(iPtr, string)
630 register Interp *iPtr; /* Interpreter in which to perform the
631 * substitution. */
632 char *string; /* String to substitute. */
633{
634 register HistoryRev *revPtr;
635
636 if ((iPtr->evalFirst == NULL) || (iPtr->revDisables > 0)) {
637 return;
638 }
639 revPtr = (HistoryRev *) ckalloc(sizeof(HistoryRev));
640 revPtr->firstIndex = iPtr->evalFirst - iPtr->historyFirst;
641 revPtr->lastIndex = iPtr->evalLast - iPtr->historyFirst;
642 revPtr->newSize = strlen(string);
643 revPtr->newBytes = (char *) ckalloc((unsigned) (revPtr->newSize+1));
644 strcpy(revPtr->newBytes, string);
645 InsertRev(iPtr, revPtr);
646}
647\f
648/*
649 *----------------------------------------------------------------------
650 *
651 * RevResult --
652 *
653 * This procedure is invoked by the "history" command to record
654 * a result revision. See the comments at the beginning of the
655 * file for more information about revisions.
656 *
657 * Results:
658 * None.
659 *
660 * Side effects:
661 * Revision information is recorded.
662 *
663 *----------------------------------------------------------------------
664 */
665
666static void
667RevResult(iPtr, string)
668 register Interp *iPtr; /* Interpreter in which to perform the
669 * substitution. */
670 char *string; /* String to substitute. */
671{
672 register HistoryRev *revPtr;
673 char *evalFirst, *evalLast;
674 char *argv[2];
675
676 if ((iPtr->evalFirst == NULL) || (iPtr->revDisables > 0)) {
677 return;
678 }
679
680 /*
681 * Expand the replacement range to include the brackets that surround
682 * the command. If there aren't any brackets (i.e. this command was
683 * invoked at top-level) then don't do any revision. Also, if there
684 * are several commands in brackets, of which this is just one,
685 * then don't do any revision.
686 */
687
688 evalFirst = iPtr->evalFirst;
689 evalLast = iPtr->evalLast + 1;
690 while (1) {
691 if (evalFirst == iPtr->historyFirst) {
692 return;
693 }
694 evalFirst--;
695 if (*evalFirst == '[') {
696 break;
697 }
698 if (!isspace(*evalFirst)) {
699 return;
700 }
701 }
702 if (*evalLast != ']') {
703 return;
704 }
705
706 revPtr = (HistoryRev *) ckalloc(sizeof(HistoryRev));
707 revPtr->firstIndex = evalFirst - iPtr->historyFirst;
708 revPtr->lastIndex = evalLast - iPtr->historyFirst;
709 argv[0] = string;
710 revPtr->newBytes = Tcl_Merge(1, argv);
711 revPtr->newSize = strlen(revPtr->newBytes);
712 InsertRev(iPtr, revPtr);
713}
714\f
715/*
716 *----------------------------------------------------------------------
717 *
718 * DoRevs --
719 *
720 * This procedure is called to apply the history revisions that
721 * have been recorded in iPtr.
722 *
723 * Results:
724 * None.
725 *
726 * Side effects:
727 * The most recent entry in the history for iPtr may be modified.
728 *
729 *----------------------------------------------------------------------
730 */
731
732static void
733DoRevs(iPtr)
734 register Interp *iPtr; /* Interpreter whose history is to
735 * be modified. */
736{
737 register HistoryRev *revPtr;
738 register HistoryEvent *eventPtr;
739 char *newCommand, *p;
740 unsigned int size;
741 int bytesSeen, count;
742
743 if (iPtr->revPtr == NULL) {
744 return;
745 }
746
747 /*
748 * The revision is done in two passes. The first pass computes the
749 * amount of space needed for the revised event, and the second pass
750 * pieces together the new event and frees up the revisions.
751 */
752
753 eventPtr = &iPtr->events[iPtr->curEvent];
754 size = strlen(eventPtr->command) + 1;
755 for (revPtr = iPtr->revPtr; revPtr != NULL; revPtr = revPtr->nextPtr) {
756 size -= revPtr->lastIndex + 1 - revPtr->firstIndex;
757 size += revPtr->newSize;
758 }
759
760 newCommand = (char *) ckalloc(size);
761 p = newCommand;
762 bytesSeen = 0;
763 for (revPtr = iPtr->revPtr; revPtr != NULL; ) {
764 HistoryRev *nextPtr = revPtr->nextPtr;
765
766 count = revPtr->firstIndex - bytesSeen;
767 if (count > 0) {
768 strncpy(p, eventPtr->command + bytesSeen, count);
769 p += count;
770 }
771 strncpy(p, revPtr->newBytes, revPtr->newSize);
772 p += revPtr->newSize;
773 bytesSeen = revPtr->lastIndex+1;
774 ckfree(revPtr->newBytes);
775 ckfree((char *) revPtr);
776 revPtr = nextPtr;
777 }
778 if (&p[strlen(&eventPtr->command[bytesSeen]) + 1] >
779 &newCommand[size]) {
780 printf("Assertion failed!\n");
781 }
782 strcpy(p, eventPtr->command + bytesSeen);
783
784 /*
785 * Replace the command in the event.
786 */
787
788 ckfree(eventPtr->command);
789 eventPtr->command = newCommand;
790 eventPtr->bytesAvl = size;
791 iPtr->revPtr = NULL;
792}
793\f
794/*
795 *----------------------------------------------------------------------
796 *
797 * GetEvent --
798 *
799 * Given a textual description of an event (see the manual page
800 * for legal values) find the corresponding event and return its
801 * command string.
802 *
803 * Results:
804 * The return value is a pointer to the event named by "string".
805 * If no such event exists, then NULL is returned and an error
806 * message is left in iPtr.
807 *
808 * Side effects:
809 * None.
810 *
811 *----------------------------------------------------------------------
812 */
813
814static HistoryEvent *
815GetEvent(iPtr, string)
816 register Interp *iPtr; /* Interpreter in which to look. */
817 char *string; /* Description of event. */
818{
819 int eventNum, index;
820 register HistoryEvent *eventPtr;
821 int length;
822
823 /*
824 * First check for a numeric specification of an event.
825 */
826
827 if (isdigit(*string) || (*string == '-')) {
828 if (Tcl_GetInt((Tcl_Interp *) iPtr, string, &eventNum) != TCL_OK) {
829 return NULL;
830 }
831 if (eventNum < 0) {
832 eventNum += iPtr->curEventNum;
833 }
834 if (eventNum > iPtr->curEventNum) {
835 Tcl_AppendResult((Tcl_Interp *) iPtr, "event \"", string,
836 "\" hasn't occurred yet", (char *) NULL);
837 return NULL;
838 }
839 if ((eventNum <= iPtr->curEventNum-iPtr->numEvents)
840 || (eventNum <= 0)) {
841 Tcl_AppendResult((Tcl_Interp *) iPtr, "event \"", string,
842 "\" is too far in the past", (char *) NULL);
843 return NULL;
844 }
845 index = iPtr->curEvent + (eventNum - iPtr->curEventNum);
846 if (index < 0) {
847 index += iPtr->numEvents;
848 }
849 return &iPtr->events[index];
850 }
851
852 /*
853 * Next, check for an event that contains the string as a prefix or
854 * that matches the string in the sense of Tcl_StringMatch.
855 */
856
857 length = strlen(string);
858 for (index = iPtr->curEvent - 1; ; index--) {
859 if (index < 0) {
860 index += iPtr->numEvents;
861 }
862 if (index == iPtr->curEvent) {
863 break;
864 }
865 eventPtr = &iPtr->events[index];
866 if ((strncmp(eventPtr->command, string, length) == 0)
867 || Tcl_StringMatch(eventPtr->command, string)) {
868 return eventPtr;
869 }
870 }
871
872 Tcl_AppendResult((Tcl_Interp *) iPtr, "no event matches \"", string,
873 "\"", (char *) NULL);
874 return NULL;
875}
876\f
877/*
878 *----------------------------------------------------------------------
879 *
880 * SubsAndEval --
881 *
882 * Generate a new command by making a textual substitution in
883 * the "cmd" argument. Then execute the new command.
884 *
885 * Results:
886 * The return value is a standard Tcl error.
887 *
888 * Side effects:
889 * History gets revised if the substitution is occurring on
890 * a recorded command line. Also, the re-executed command
891 * may produce side-effects.
892 *
893 *----------------------------------------------------------------------
894 */
895
896static int
897SubsAndEval(iPtr, cmd, old, new)
898 register Interp *iPtr; /* Interpreter in which to execute
899 * new command. */
900 char *cmd; /* Command in which to substitute. */
901 char *old; /* String to search for in command. */
902 char *new; /* Replacement string for "old". */
903{
904 char *src, *dst, *newCmd;
905 int count, oldLength, newLength, length, result;
906
907 /*
908 * Figure out how much space it will take to hold the
909 * substituted command (and complain if the old string
910 * doesn't appear in the original command).
911 */
912
913 oldLength = strlen(old);
914 newLength = strlen(new);
915 src = cmd;
916 count = 0;
917 while (1) {
918 src = strstr(src, old);
919 if (src == NULL) {
920 break;
921 }
922 src += oldLength;
923 count++;
924 }
925 if (count == 0) {
926 Tcl_AppendResult((Tcl_Interp *) iPtr, "\"", old,
927 "\" doesn't appear in event", (char *) NULL);
928 return TCL_ERROR;
929 }
930 length = strlen(cmd) + count*(newLength - oldLength);
931
932 /*
933 * Generate a substituted command.
934 */
935
936 newCmd = (char *) ckalloc((unsigned) (length + 1));
937 dst = newCmd;
938 while (1) {
939 src = strstr(cmd, old);
940 if (src == NULL) {
941 strcpy(dst, cmd);
942 break;
943 }
944 strncpy(dst, cmd, src-cmd);
945 dst += src-cmd;
946 strcpy(dst, new);
947 dst += newLength;
948 cmd = src + oldLength;
949 }
950
951 RevCommand(iPtr, newCmd);
952 result = Tcl_Eval((Tcl_Interp *) iPtr, newCmd, 0, (char **) NULL);
953 ckfree(newCmd);
954 return result;
955}
956\f
957/*
958 *----------------------------------------------------------------------
959 *
960 * GetWords --
961 *
962 * Given a command string, return one or more words from the
963 * command string.
964 *
965 * Results:
966 * The return value is a pointer to a dynamically-allocated
967 * string containing the words of command specified by "words".
968 * If the word specifier has improper syntax then an error
969 * message is placed in iPtr->result and NULL is returned.
970 *
971 * Side effects:
972 * Memory is allocated. It is the caller's responsibilty to
973 * free the returned string..
974 *
975 *----------------------------------------------------------------------
976 */
977
978static char *
979GetWords(iPtr, command, words)
980 register Interp *iPtr; /* Tcl interpreter in which to place
981 * an error message if needed. */
982 char *command; /* Command string. */
983 char *words; /* Description of which words to extract
984 * from the command. Either num[-num] or
985 * a pattern. */
986{
987 char *result;
988 char *start, *end, *dst;
989 register char *next;
990 int first; /* First word desired. -1 means last word
991 * only. */
992 int last; /* Last word desired. -1 means use everything
993 * up to the end. */
994 int index; /* Index of current word. */
995 char *pattern;
996
997 /*
998 * Figure out whether we're looking for a numerical range or for
999 * a pattern.
1000 */
1001
1002 pattern = NULL;
1003 first = 0;
1004 last = -1;
1005 if (*words == '$') {
1006 if (words[1] != '\0') {
1007 goto error;
1008 }
1009 first = -1;
1010 } else if (isdigit(*words)) {
1011 first = strtoul(words, &start, 0);
1012 if (*start == 0) {
1013 last = first;
1014 } else if (*start == '-') {
1015 start++;
1016 if (*start == '$') {
1017 start++;
1018 } else if (isdigit(*start)) {
1019 last = strtoul(start, &start, 0);
1020 } else {
1021 goto error;
1022 }
1023 if (*start != 0) {
1024 goto error;
1025 }
1026 }
1027 if ((first > last) && (last != -1)) {
1028 goto error;
1029 }
1030 } else {
1031 pattern = words;
1032 }
1033
1034 /*
1035 * Scan through the words one at a time, copying those that are
1036 * relevant into the result string. Allocate a result area large
1037 * enough to hold all the words if necessary.
1038 */
1039
1040 result = (char *) ckalloc((unsigned) (strlen(command) + 1));
1041 dst = result;
1042 for (next = command; isspace(*next); next++) {
1043 /* Empty loop body: just find start of first word. */
1044 }
1045 for (index = 0; *next != 0; index++) {
1046 start = next;
1047 end = TclWordEnd(next, 0);
1048 for (next = end; isspace(*next); next++) {
1049 /* Empty loop body: just find start of next word. */
1050 }
1051 if ((first > index) || ((first == -1) && (*next != 0))) {
1052 continue;
1053 }
1054 if ((last != -1) && (last < index)) {
1055 continue;
1056 }
1057 if (pattern != NULL) {
1058 int match;
1059 char savedChar = *end;
1060
1061 *end = 0;
1062 match = Tcl_StringMatch(start, pattern);
1063 *end = savedChar;
1064 if (!match) {
1065 continue;
1066 }
1067 }
1068 if (dst != result) {
1069 *dst = ' ';
1070 dst++;
1071 }
1072 strncpy(dst, start, (end-start));
1073 dst += end-start;
1074 }
1075 *dst = 0;
1076
1077 /*
1078 * Check for an out-of-range argument index.
1079 */
1080
1081 if ((last >= index) || (first >= index)) {
1082 ckfree(result);
1083 Tcl_AppendResult((Tcl_Interp *) iPtr, "word selector \"", words,
1084 "\" specified non-existent words", (char *) NULL);
1085 return NULL;
1086 }
1087 return result;
1088
1089 error:
1090 Tcl_AppendResult((Tcl_Interp *) iPtr, "bad word selector \"", words,
1091 "\": should be num-num or pattern", (char *) NULL);
1092 return NULL;
1093}
Impressum, Datenschutz