]>
Commit | Line | Data |
---|---|---|
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 | |
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(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 | ||
166 | int | |
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. */ | |
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 */ | |
252 | int | |
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. */ | |
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 | ||
529 | static void | |
530 | MakeSpace(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 | ||
560 | static void | |
561 | InsertRev(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 | ||
628 | static void | |
629 | RevCommand(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 | ||
666 | static void | |
667 | RevResult(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 | ||
732 | static void | |
733 | DoRevs(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 | ||
814 | static HistoryEvent * | |
815 | GetEvent(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 | ||
896 | static int | |
897 | SubsAndEval(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 | ||
978 | static char * | |
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 | |
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 | } |