]>
cvs.zerfleddert.de Git - micropolis/blob - src/tcl/tclhist.c
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.
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.
20 static char rcsid
[] = "$Header: /user6/ouster/tcl/RCS/tclHistory.c,v 1.23 91/10/28 09:11:16 ouster Exp $ SPRITE (Berkeley)";
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:
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
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".
42 * There are three additional complications. The first is that history
43 * substitution may only be part of a command, as in the following
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.
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
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).
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
83 * Default space allocation for command strings:
86 #define INITIAL_CMD_SIZE 40
89 * Forward declarations for procedures defined later in this file:
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
,
96 static void InsertRev
_ANSI_ARGS_((Interp
*iPtr
,
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));
105 *----------------------------------------------------------------------
109 * Initialize history-related state in an interpreter.
115 * History info is initialized in iPtr.
117 *----------------------------------------------------------------------
121 Tcl_InitHistory(interp
)
122 Tcl_Interp
*interp
; /* Interpreter to initialize. */
124 register Interp
*iPtr
= (Interp
*) interp
;
127 if (iPtr
->numEvents
!= 0) {
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
;
139 iPtr
->curEventNum
= 0;
140 Tcl_CreateCommand((Tcl_Interp
*) iPtr
, "history", Tcl_HistoryCmd
,
141 (ClientData
) NULL
, (void (*)()) NULL
);
145 *----------------------------------------------------------------------
147 * Tcl_RecordAndEval --
149 * This procedure adds its command argument to the current list of
150 * recorded events and then executes the command by calling Tcl_Eval.
153 * The return value is a standard Tcl return value, the result of
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.
163 *----------------------------------------------------------------------
167 Tcl_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. */
175 register Interp
*iPtr
= (Interp
*) interp
;
176 register HistoryEvent
*eventPtr
;
179 if (iPtr
->numEvents
== 0) {
180 Tcl_InitHistory(interp
);
185 * Don't record empty commands.
188 while (isspace(*cmd
)) {
192 Tcl_ResetResult(interp
);
198 if (iPtr
->curEvent
>= iPtr
->numEvents
) {
201 eventPtr
= &iPtr
->events
[iPtr
->curEvent
];
204 * Chop off trailing newlines before recording the command.
207 length
= strlen(cmd
);
208 while (cmd
[length
-1] == '\n') {
211 MakeSpace(eventPtr
, length
+ 1);
212 strncpy(eventPtr
->command
, cmd
, length
);
213 eventPtr
->command
[length
] = 0;
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.
224 if (flags
!= TCL_NO_EVAL
) {
225 iPtr
->historyFirst
= cmd
;
226 iPtr
->revDisables
= 0;
227 result
= Tcl_Eval(interp
, cmd
, flags
| TCL_RECORD_BOUNDS
,
230 iPtr
->revDisables
= 1;
235 *----------------------------------------------------------------------
239 * This procedure is invoked to process the "history" Tcl command.
240 * See the user documentation for details on what it does.
243 * A standard Tcl result.
246 * See the user documentation.
248 *----------------------------------------------------------------------
253 Tcl_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. */
259 register Interp
*iPtr
= (Interp
*) interp
;
260 register HistoryEvent
*eventPtr
;
265 * If no arguments, treat the same as "history info".
273 length
= strlen(argv
[1]);
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
);
282 if (strncmp(argv
[3], "exec", strlen(argv
[3])) != 0) {
283 Tcl_AppendResult(interp
, "bad argument \"", argv
[3],
284 "\": should be \"exec\"", (char *) NULL
);
287 return Tcl_RecordAndEval(interp
, argv
[2], 0);
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
);
297 eventPtr
= &iPtr
->events
[iPtr
->curEvent
];
298 iPtr
->revDisables
+= 1;
299 while (iPtr
->revPtr
!= NULL
) {
302 ckfree(iPtr
->revPtr
->newBytes
);
303 nextPtr
= iPtr
->revPtr
->nextPtr
;
304 ckfree((char *) iPtr
->revPtr
);
305 iPtr
->revPtr
= nextPtr
;
308 eventPtr
= GetEvent(iPtr
, argv
[3]);
309 if (eventPtr
== NULL
) {
313 MakeSpace(eventPtr
, strlen(argv
[2]) + 1);
314 strcpy(eventPtr
->command
, argv
[2]);
316 } else if ((c
== 'e') && (strncmp(argv
[1], "event", length
)) == 0) {
318 Tcl_AppendResult(interp
, "wrong # args: should be \"", argv
[0],
319 " event ?event?\"", (char *) NULL
);
322 eventPtr
= GetEvent(iPtr
, argc
==2 ? "-1" : argv
[2]);
323 if (eventPtr
== NULL
) {
326 RevResult(iPtr
, eventPtr
->command
);
327 Tcl_SetResult(interp
, eventPtr
->command
, TCL_VOLATILE
);
329 } else if ((c
== 'i') && (strncmp(argv
[1], "info", length
)) == 0) {
333 if ((argc
!= 2) && (argc
!= 3)) {
334 Tcl_AppendResult(interp
, "wrong # args: should be \"", argv
[0],
335 " info ?count?\"", (char *) NULL
);
340 if (Tcl_GetInt(interp
, argv
[2], &count
) != TCL_OK
) {
343 if (count
> iPtr
->numEvents
) {
344 count
= iPtr
->numEvents
;
347 count
= iPtr
->numEvents
;
350 for (i
= 0, indx
= iPtr
->curEvent
+ 1 + iPtr
->numEvents
- count
;
351 i
< count
; i
++, indx
++) {
352 char *cur
, *next
, savedChar
;
355 if (indx
>= iPtr
->numEvents
) {
356 indx
-= iPtr
->numEvents
;
358 cur
= iPtr
->events
[indx
].command
;
360 continue; /* No command recorded here. */
362 sprintf(serial
, "%6d ", iPtr
->curEventNum
+ 1 - (count
- i
));
363 Tcl_AppendResult(interp
, newline
, serial
, (char *) NULL
);
367 * Tricky formatting here: for multi-line commands, indent
368 * the continuation lines.
372 next
= strchr(cur
, '\n');
379 Tcl_AppendResult(interp
, cur
, "\t", (char *) NULL
);
383 Tcl_AppendResult(interp
, cur
, (char *) NULL
);
386 } else if ((c
== 'k') && (strncmp(argv
[1], "keep", length
)) == 0) {
388 HistoryEvent
*events
;
391 Tcl_AppendResult(interp
, "wrong # args: should be \"", argv
[0],
392 " keep number\"", (char *) NULL
);
395 if (Tcl_GetInt(interp
, argv
[2], &count
) != TCL_OK
) {
398 if ((count
<= 0) || (count
> 1000)) {
399 Tcl_AppendResult(interp
, "illegal keep count \"", argv
[2],
400 "\"", (char *) NULL
);
405 * Create a new history array and copy as much existing history
406 * as possible from the old array.
409 events
= (HistoryEvent
*)
410 ckalloc((unsigned) (count
* sizeof(HistoryEvent
)));
411 if (count
< iPtr
->numEvents
) {
412 src
= iPtr
->curEvent
+ 1 - count
;
414 src
+= iPtr
->numEvents
;
417 src
= iPtr
->curEvent
+ 1;
419 for (i
= 0; i
< count
; i
++, src
++) {
420 if (src
>= iPtr
->numEvents
) {
423 if (i
< iPtr
->numEvents
) {
424 events
[i
] = iPtr
->events
[src
];
425 iPtr
->events
[src
].command
= NULL
;
427 events
[i
].command
= (char *) ckalloc(INITIAL_CMD_SIZE
);
428 events
[i
].command
[0] = 0;
429 events
[i
].bytesAvl
= INITIAL_CMD_SIZE
;
434 * Throw away everything left in the old history array, and
435 * substitute the new one for the old one.
438 for (i
= 0; i
< iPtr
->numEvents
; i
++) {
439 if (iPtr
->events
[i
].command
!= NULL
) {
440 ckfree(iPtr
->events
[i
].command
);
443 ckfree((char *) iPtr
->events
);
444 iPtr
->events
= events
;
445 if (count
< iPtr
->numEvents
) {
446 iPtr
->curEvent
= count
-1;
448 iPtr
->curEvent
= iPtr
->numEvents
-1;
450 iPtr
->numEvents
= count
;
452 } else if ((c
== 'n') && (strncmp(argv
[1], "nextid", length
)) == 0) {
454 Tcl_AppendResult(interp
, "wrong # args: should be \"", argv
[0],
455 " nextid\"", (char *) NULL
);
458 sprintf(iPtr
->result
, "%d", iPtr
->curEventNum
+1);
460 } else if ((c
== 'r') && (strncmp(argv
[1], "redo", length
)) == 0) {
462 Tcl_AppendResult(interp
, "wrong # args: should be \"", argv
[0],
463 " redo ?event?\"", (char *) NULL
);
466 eventPtr
= GetEvent(iPtr
, argc
==2 ? "-1" : argv
[2]);
467 if (eventPtr
== NULL
) {
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
);
478 eventPtr
= GetEvent(iPtr
, argc
==4 ? "-1" : argv
[4]);
479 if (eventPtr
== NULL
) {
482 return SubsAndEval(iPtr
, eventPtr
->command
, argv
[2], argv
[3]);
483 } else if ((c
== 'w') && (strncmp(argv
[1], "words", length
)) == 0) {
486 if ((argc
!= 3) && (argc
!= 4)) {
487 Tcl_AppendResult(interp
, "wrong # args: should be \"", argv
[0],
488 " words num-num/pat ?event?\"", (char *) NULL
);
491 eventPtr
= GetEvent(iPtr
, argc
==3 ? "-1" : argv
[3]);
492 if (eventPtr
== NULL
) {
495 words
= GetWords(iPtr
, eventPtr
->command
, argv
[2]);
499 RevResult(iPtr
, words
);
500 iPtr
->result
= words
;
501 iPtr
->freeProc
= (Tcl_FreeProc
*) free
;
505 Tcl_AppendResult(interp
, "bad option \"", argv
[1],
506 "\": must be add, change, event, info, keep, nextid, ",
507 "redo, substitute, or words", (char *) NULL
);
512 *----------------------------------------------------------------------
516 * Given a history event, make sure it has enough space for
517 * a string of a given length (enlarge the string area if
524 * More memory may get allocated.
526 *----------------------------------------------------------------------
530 MakeSpace(hPtr
, size
)
532 int size
; /* # of bytes needed in hPtr. */
534 if (hPtr
->bytesAvl
< size
) {
535 ckfree(hPtr
->command
);
536 hPtr
->command
= (char *) ckalloc((unsigned) size
);
537 hPtr
->bytesAvl
= size
;
542 *----------------------------------------------------------------------
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.
555 * RevPtr is added to iPtr's revision list.
557 *----------------------------------------------------------------------
561 InsertRev(iPtr
, revPtr
)
562 Interp
*iPtr
; /* Interpreter to use. */
563 register HistoryRev
*revPtr
; /* Revision to add to iPtr's list. */
565 register HistoryRev
*curPtr
;
566 register HistoryRev
*prevPtr
;
568 for (curPtr
= iPtr
->revPtr
, prevPtr
= NULL
; curPtr
!= NULL
;
569 prevPtr
= curPtr
, curPtr
= curPtr
->nextPtr
) {
571 * If this revision includes the new one (or vice versa) then
572 * just eliminate the one that is a subset of the other.
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
);
585 if ((revPtr
->firstIndex
>= curPtr
->firstIndex
)
586 && (revPtr
->lastIndex
<= curPtr
->lastIndex
)) {
587 ckfree(revPtr
->newBytes
);
588 ckfree((char *) revPtr
);
592 if (revPtr
->firstIndex
< curPtr
->firstIndex
) {
598 * Insert revPtr just after prevPtr.
601 if (prevPtr
== NULL
) {
602 revPtr
->nextPtr
= iPtr
->revPtr
;
603 iPtr
->revPtr
= revPtr
;
605 revPtr
->nextPtr
= prevPtr
->nextPtr
;
606 prevPtr
->nextPtr
= revPtr
;
611 *----------------------------------------------------------------------
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.
623 * Revision information is recorded.
625 *----------------------------------------------------------------------
629 RevCommand(iPtr
, string
)
630 register Interp
*iPtr
; /* Interpreter in which to perform the
632 char *string
; /* String to substitute. */
634 register HistoryRev
*revPtr
;
636 if ((iPtr
->evalFirst
== NULL
) || (iPtr
->revDisables
> 0)) {
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
);
649 *----------------------------------------------------------------------
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.
661 * Revision information is recorded.
663 *----------------------------------------------------------------------
667 RevResult(iPtr
, string
)
668 register Interp
*iPtr
; /* Interpreter in which to perform the
670 char *string
; /* String to substitute. */
672 register HistoryRev
*revPtr
;
673 char *evalFirst
, *evalLast
;
676 if ((iPtr
->evalFirst
== NULL
) || (iPtr
->revDisables
> 0)) {
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.
688 evalFirst
= iPtr
->evalFirst
;
689 evalLast
= iPtr
->evalLast
+ 1;
691 if (evalFirst
== iPtr
->historyFirst
) {
695 if (*evalFirst
== '[') {
698 if (!isspace(*evalFirst
)) {
702 if (*evalLast
!= ']') {
706 revPtr
= (HistoryRev
*) ckalloc(sizeof(HistoryRev
));
707 revPtr
->firstIndex
= evalFirst
- iPtr
->historyFirst
;
708 revPtr
->lastIndex
= evalLast
- iPtr
->historyFirst
;
710 revPtr
->newBytes
= Tcl_Merge(1, argv
);
711 revPtr
->newSize
= strlen(revPtr
->newBytes
);
712 InsertRev(iPtr
, revPtr
);
716 *----------------------------------------------------------------------
720 * This procedure is called to apply the history revisions that
721 * have been recorded in iPtr.
727 * The most recent entry in the history for iPtr may be modified.
729 *----------------------------------------------------------------------
734 register Interp
*iPtr
; /* Interpreter whose history is to
737 register HistoryRev
*revPtr
;
738 register HistoryEvent
*eventPtr
;
739 char *newCommand
, *p
;
741 int bytesSeen
, count
;
743 if (iPtr
->revPtr
== NULL
) {
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.
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
;
760 newCommand
= (char *) ckalloc(size
);
763 for (revPtr
= iPtr
->revPtr
; revPtr
!= NULL
; ) {
764 HistoryRev
*nextPtr
= revPtr
->nextPtr
;
766 count
= revPtr
->firstIndex
- bytesSeen
;
768 strncpy(p
, eventPtr
->command
+ bytesSeen
, count
);
771 strncpy(p
, revPtr
->newBytes
, revPtr
->newSize
);
772 p
+= revPtr
->newSize
;
773 bytesSeen
= revPtr
->lastIndex
+1;
774 ckfree(revPtr
->newBytes
);
775 ckfree((char *) revPtr
);
778 if (&p
[strlen(&eventPtr
->command
[bytesSeen
]) + 1] >
780 printf("Assertion failed!\n");
782 strcpy(p
, eventPtr
->command
+ bytesSeen
);
785 * Replace the command in the event.
788 ckfree(eventPtr
->command
);
789 eventPtr
->command
= newCommand
;
790 eventPtr
->bytesAvl
= size
;
795 *----------------------------------------------------------------------
799 * Given a textual description of an event (see the manual page
800 * for legal values) find the corresponding event and return its
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.
811 *----------------------------------------------------------------------
814 static HistoryEvent
*
815 GetEvent(iPtr
, string
)
816 register Interp
*iPtr
; /* Interpreter in which to look. */
817 char *string
; /* Description of event. */
820 register HistoryEvent
*eventPtr
;
824 * First check for a numeric specification of an event.
827 if (isdigit(*string
) || (*string
== '-')) {
828 if (Tcl_GetInt((Tcl_Interp
*) iPtr
, string
, &eventNum
) != TCL_OK
) {
832 eventNum
+= iPtr
->curEventNum
;
834 if (eventNum
> iPtr
->curEventNum
) {
835 Tcl_AppendResult((Tcl_Interp
*) iPtr
, "event \"", string
,
836 "\" hasn't occurred yet", (char *) NULL
);
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
);
845 index
= iPtr
->curEvent
+ (eventNum
- iPtr
->curEventNum
);
847 index
+= iPtr
->numEvents
;
849 return &iPtr
->events
[index
];
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.
857 length
= strlen(string
);
858 for (index
= iPtr
->curEvent
- 1; ; index
--) {
860 index
+= iPtr
->numEvents
;
862 if (index
== iPtr
->curEvent
) {
865 eventPtr
= &iPtr
->events
[index
];
866 if ((strncmp(eventPtr
->command
, string
, length
) == 0)
867 || Tcl_StringMatch(eventPtr
->command
, string
)) {
872 Tcl_AppendResult((Tcl_Interp
*) iPtr
, "no event matches \"", string
,
873 "\"", (char *) NULL
);
878 *----------------------------------------------------------------------
882 * Generate a new command by making a textual substitution in
883 * the "cmd" argument. Then execute the new command.
886 * The return value is a standard Tcl error.
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.
893 *----------------------------------------------------------------------
897 SubsAndEval(iPtr
, cmd
, old
, new)
898 register Interp
*iPtr
; /* Interpreter in which to execute
900 char *cmd
; /* Command in which to substitute. */
901 char *old
; /* String to search for in command. */
902 char *new; /* Replacement string for "old". */
904 char *src
, *dst
, *newCmd
;
905 int count
, oldLength
, newLength
, length
, result
;
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).
913 oldLength
= strlen(old
);
914 newLength
= strlen(new);
918 src
= strstr(src
, old
);
926 Tcl_AppendResult((Tcl_Interp
*) iPtr
, "\"", old
,
927 "\" doesn't appear in event", (char *) NULL
);
930 length
= strlen(cmd
) + count
*(newLength
- oldLength
);
933 * Generate a substituted command.
936 newCmd
= (char *) ckalloc((unsigned) (length
+ 1));
939 src
= strstr(cmd
, old
);
944 strncpy(dst
, cmd
, src
-cmd
);
948 cmd
= src
+ oldLength
;
951 RevCommand(iPtr
, newCmd
);
952 result
= Tcl_Eval((Tcl_Interp
*) iPtr
, newCmd
, 0, (char **) NULL
);
958 *----------------------------------------------------------------------
962 * Given a command string, return one or more words from the
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.
972 * Memory is allocated. It is the caller's responsibilty to
973 * free the returned string..
975 *----------------------------------------------------------------------
979 GetWords(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
988 char *start
, *end
, *dst
;
990 int first
; /* First word desired. -1 means last word
992 int last
; /* Last word desired. -1 means use everything
994 int index
; /* Index of current word. */
998 * Figure out whether we're looking for a numerical range or for
1005 if (*words
== '$') {
1006 if (words
[1] != '\0') {
1010 } else if (isdigit(*words
)) {
1011 first
= strtoul(words
, &start
, 0);
1014 } else if (*start
== '-') {
1016 if (*start
== '$') {
1018 } else if (isdigit(*start
)) {
1019 last
= strtoul(start
, &start
, 0);
1027 if ((first
> last
) && (last
!= -1)) {
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.
1040 result
= (char *) ckalloc((unsigned) (strlen(command
) + 1));
1042 for (next
= command
; isspace(*next
); next
++) {
1043 /* Empty loop body: just find start of first word. */
1045 for (index
= 0; *next
!= 0; index
++) {
1047 end
= TclWordEnd(next
, 0);
1048 for (next
= end
; isspace(*next
); next
++) {
1049 /* Empty loop body: just find start of next word. */
1051 if ((first
> index
) || ((first
== -1) && (*next
!= 0))) {
1054 if ((last
!= -1) && (last
< index
)) {
1057 if (pattern
!= NULL
) {
1059 char savedChar
= *end
;
1062 match
= Tcl_StringMatch(start
, pattern
);
1068 if (dst
!= result
) {
1072 strncpy(dst
, start
, (end
-start
));
1078 * Check for an out-of-range argument index.
1081 if ((last
>= index
) || (first
>= index
)) {
1083 Tcl_AppendResult((Tcl_Interp
*) iPtr
, "word selector \"", words
,
1084 "\" specified non-existent words", (char *) NULL
);
1090 Tcl_AppendResult((Tcl_Interp
*) iPtr
, "bad word selector \"", words
,
1091 "\": should be num-num or pattern", (char *) NULL
);