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