diff options
Diffstat (limited to 'contrib/tcl/generic/tclHistory.c')
| -rw-r--r-- | contrib/tcl/generic/tclHistory.c | 1081 |
1 files changed, 69 insertions, 1012 deletions
diff --git a/contrib/tcl/generic/tclHistory.c b/contrib/tcl/generic/tclHistory.c index f6572c7..0419c3d 100644 --- a/contrib/tcl/generic/tclHistory.c +++ b/contrib/tcl/generic/tclHistory.c @@ -1,139 +1,23 @@ /* * tclHistory.c -- * - * This module implements history as an optional addition to Tcl. - * It can be called to record commands ("events") before they are - * executed, and it provides a command that may be used to perform - * history substitutions. + * This module and the Tcl library file history.tcl together implement + * Tcl command history. Tcl_RecordAndEval(Obj) can be called to record + * commands ("events") before they are executed. Commands defined in + * history.tcl may be used to perform history substitutions. * * Copyright (c) 1990-1993 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * SCCS: @(#) tclHistory.c 1.43 97/05/14 13:23:18 + * SCCS: @(#) tclHistory.c 1.47 97/08/04 16:08:17 */ #include "tclInt.h" #include "tclPort.h" -/* - * This history stuff is mostly straightforward, except for one thing - * that makes everything very complicated. Suppose that the following - * commands get executed: - * echo foo - * history redo - * It's important that the history event recorded for the second command - * be "echo foo", not "history redo". Otherwise, if another "history redo" - * command is typed, it will result in infinite recursions on the - * "history redo" command. Thus, the actual recorded history must be - * echo foo - * echo foo - * To do this, the history command revises recorded history as part of - * its execution. In the example above, when "history redo" starts - * execution, the current event is "history redo", but the history - * command arranges for the current event to be changed to "echo foo". - * - * There are three additional complications. The first is that history - * substitution may only be part of a command, as in the following - * command sequence: - * echo foo bar - * echo [history word 3] - * In this case, the second event should be recorded as "echo bar". Only - * part of the recorded event is to be modified. Fortunately, Tcl_Eval - * helps with this by recording (in the evalFirst and evalLast fields of - * the intepreter) the location of the command being executed, so the - * history module can replace exactly the range of bytes corresponding - * to the history substitution command. - * - * The second complication is that there are two ways to revise history: - * replace a command, and replace the result of a command. Consider the - * two examples below: - * format {result is %d} $num | format {result is %d} $num - * print [history redo] | print [history word 3] - * Recorded history for these two cases should be as follows: - * format {result is %d} $num | format {result is %d} $num - * print [format {result is %d} $num] | print $num - * In the left case, the history command was replaced with another command - * to be executed (the brackets were retained), but in the case on the - * right the result of executing the history command was replaced (i.e. - * brackets were replaced too). - * - * The third complication is that there could potentially be many - * history substitutions within a single command, as in: - * echo [history word 3] [history word 2] - * There could even be nested history substitutions, as in: - * history subs abc [history word 2] - * If history revisions were made immediately during each "history" command - * invocations, it would be very difficult to produce the correct cumulative - * effect from several substitutions in the same command. To get around - * this problem, the actual history revision isn't made during the execution - * of the "history" command. Information about the changes is just recorded, - * in xxx records, and the actual changes are made during the next call to - * Tcl_RecordHistory (when we know that execution of the previous command - * has finished). - */ - -/* - * Default space allocation for command strings: - */ - -#define INITIAL_CMD_SIZE 40 - -/* - * Forward declarations for procedures defined later in this file: - */ - -static void DoRevs _ANSI_ARGS_((Interp *iPtr)); -static HistoryEvent * GetEvent _ANSI_ARGS_((Interp *iPtr, char *string)); -static char * GetWords _ANSI_ARGS_((Interp *iPtr, char *command, - char *words)); -static void InitHistory _ANSI_ARGS_((Interp *iPtr)); -static void InsertRev _ANSI_ARGS_((Interp *iPtr, - HistoryRev *revPtr)); -static void MakeSpace _ANSI_ARGS_((HistoryEvent *hPtr, int size)); -static void RevCommand _ANSI_ARGS_((Interp *iPtr, char *string)); -static void RevResult _ANSI_ARGS_((Interp *iPtr, char *string)); -static int SubsAndEval _ANSI_ARGS_((Interp *iPtr, char *cmd, - char *old, char *new)); - -/* - *---------------------------------------------------------------------- - * - * InitHistory -- - * - * Initialize history-related state in an interpreter. - * - * Results: - * None. - * - * Side effects: - * History info is initialized in iPtr. - * - *---------------------------------------------------------------------- - */ - -static void -InitHistory(iPtr) - register Interp *iPtr; /* Interpreter to initialize. */ -{ - int i; - - if (iPtr->numEvents != 0) { - return; - } - iPtr->numEvents = 20; - iPtr->events = (HistoryEvent *) - ckalloc((unsigned) (iPtr->numEvents * sizeof(HistoryEvent))); - for (i = 0; i < iPtr->numEvents; i++) { - iPtr->events[i].command = (char *) ckalloc(INITIAL_CMD_SIZE); - *iPtr->events[i].command = 0; - iPtr->events[i].bytesAvl = INITIAL_CMD_SIZE; - } - iPtr->curEvent = 0; - iPtr->curEventNum = 0; -} /* *---------------------------------------------------------------------- @@ -149,11 +33,7 @@ InitHistory(iPtr) * executing cmd. * * Side effects: - * The command is recorded and executed. In addition, pending history - * revisions are carried out, and information is set up to enable - * Tcl_Eval to identify history command ranges. This procedure also - * initializes history information for the interpreter, if it hasn't - * already been initialized. + * The command is recorded and executed. * *---------------------------------------------------------------------- */ @@ -168,931 +48,108 @@ Tcl_RecordAndEval(interp, cmd, flags) * TCL_EVAL_GLOBAL means use Tcl_GlobalEval * instead of Tcl_Eval. */ { - register Interp *iPtr = (Interp *) interp; - register HistoryEvent *eventPtr; - int length, result; - - if (iPtr->numEvents == 0) { - InitHistory(iPtr); - } - DoRevs(iPtr); - - /* - * Don't record empty commands. - */ - - while (isspace(UCHAR(*cmd))) { - cmd++; - } - if (*cmd == '\0') { - Tcl_ResetResult(interp); - return TCL_OK; - } - - iPtr->curEventNum++; - iPtr->curEvent++; - if (iPtr->curEvent >= iPtr->numEvents) { - iPtr->curEvent = 0; - } - eventPtr = &iPtr->events[iPtr->curEvent]; - - /* - * Chop off trailing newlines before recording the command. - */ - - length = strlen(cmd); - while (cmd[length-1] == '\n') { - length--; - } - MakeSpace(eventPtr, length + 1); - strncpy(eventPtr->command, cmd, (size_t) length); - eventPtr->command[length] = 0; - - /* - * Execute the command. Note: history revision isn't possible after - * a nested call to this procedure, because the event at the top of - * the history list no longer corresponds to what's going on when - * a nested call here returns. Thus, must leave history revision - * disabled when we return. - */ - - result = TCL_OK; - if (!(flags & TCL_NO_EVAL)) { - iPtr->historyFirst = cmd; - iPtr->revDisables = 0; - iPtr->evalFlags = (flags & ~TCL_EVAL_GLOBAL) | TCL_RECORD_BOUNDS; - if (flags & TCL_EVAL_GLOBAL) { - result = Tcl_GlobalEval(interp, cmd); - } else { - result = Tcl_Eval(interp, cmd); - } - } - iPtr->revDisables = 1; - return result; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_HistoryCmd -- - * - * This procedure is invoked to process the "history" Tcl command. - * See the user documentation for details on what it does. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * See the user documentation. - * - *---------------------------------------------------------------------- - */ - - /* ARGSUSED */ -int -Tcl_HistoryCmd(dummy, interp, argc, argv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ -{ - register Interp *iPtr = (Interp *) interp; - register HistoryEvent *eventPtr; - size_t length; - int c; - - if (iPtr->numEvents == 0) { - InitHistory(iPtr); - } - - /* - * If no arguments, treat the same as "history info". - */ - - if (argc == 1) { - goto infoCmd; - } - - c = argv[1][0]; - length = strlen(argv[1]); + register Tcl_Obj *cmdPtr; + int length = strlen(cmd); + int result; - if ((c == 'a') && (strncmp(argv[1], "add", length)) == 0) { - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " add event ?exec?\"", (char *) NULL); - return TCL_ERROR; - } - if (argc == 4) { - if (strncmp(argv[3], "exec", strlen(argv[3])) != 0) { - Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": should be \"exec\"", (char *) NULL); - return TCL_ERROR; - } - return Tcl_RecordAndEval(interp, argv[2], 0); - } - return Tcl_RecordAndEval(interp, argv[2], TCL_NO_EVAL); - } else if ((c == 'c') && (strncmp(argv[1], "change", length)) == 0) { - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " change newValue ?event?\"", (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - eventPtr = &iPtr->events[iPtr->curEvent]; - iPtr->revDisables += 1; - while (iPtr->revPtr != NULL) { - HistoryRev *nextPtr; - - ckfree(iPtr->revPtr->newBytes); - nextPtr = iPtr->revPtr->nextPtr; - ckfree((char *) iPtr->revPtr); - iPtr->revPtr = nextPtr; - } - } else { - eventPtr = GetEvent(iPtr, argv[3]); - if (eventPtr == NULL) { - return TCL_ERROR; - } - } - MakeSpace(eventPtr, (int) strlen(argv[2]) + 1); - strcpy(eventPtr->command, argv[2]); - return TCL_OK; - } else if ((c == 'e') && (strncmp(argv[1], "event", length)) == 0) { - if (argc > 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " event ?event?\"", (char *) NULL); - return TCL_ERROR; - } - eventPtr = GetEvent(iPtr, argc==2 ? "-1" : argv[2]); - if (eventPtr == NULL) { - return TCL_ERROR; - } - RevResult(iPtr, eventPtr->command); - Tcl_SetResult(interp, eventPtr->command, TCL_VOLATILE); - return TCL_OK; - } else if ((c == 'i') && (strncmp(argv[1], "info", length)) == 0) { - int count, indx, i; - char *newline; - - if ((argc != 2) && (argc != 3)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " info ?count?\"", (char *) NULL); - return TCL_ERROR; - } - infoCmd: - if (argc == 3) { - if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) { - return TCL_ERROR; - } - if (count > iPtr->numEvents) { - count = iPtr->numEvents; - } - } else { - count = iPtr->numEvents; - } - newline = ""; - for (i = 0, indx = iPtr->curEvent + 1 + iPtr->numEvents - count; - i < count; i++, indx++) { - char *cur, *next, savedChar; - char serial[20]; - - if (indx >= iPtr->numEvents) { - indx -= iPtr->numEvents; - } - cur = iPtr->events[indx].command; - if (*cur == '\0') { - continue; /* No command recorded here. */ - } - sprintf(serial, "%6d ", iPtr->curEventNum + 1 - (count - i)); - Tcl_AppendResult(interp, newline, serial, (char *) NULL); - newline = "\n"; - - /* - * Tricky formatting here: for multi-line commands, indent - * the continuation lines. - */ + if (length > 0) { + /* + * Call Tcl_RecordAndEvalObj to do the actual work. + */ - while (1) { - next = strchr(cur, '\n'); - if (next == NULL) { - break; - } - next++; - savedChar = *next; - *next = 0; - Tcl_AppendResult(interp, cur, "\t", (char *) NULL); - *next = savedChar; - cur = next; - } - Tcl_AppendResult(interp, cur, (char *) NULL); - } - return TCL_OK; - } else if ((c == 'k') && (strncmp(argv[1], "keep", length)) == 0) { - int count, i, src; - HistoryEvent *events; + TclNewObj(cmdPtr); + TclInitStringRep(cmdPtr, cmd, length); + Tcl_IncrRefCount(cmdPtr); - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " keep number\"", (char *) NULL); - return TCL_ERROR; - } - if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) { - return TCL_ERROR; - } - if ((count <= 0) || (count > 1000)) { - Tcl_AppendResult(interp, "illegal keep count \"", argv[2], - "\"", (char *) NULL); - return TCL_ERROR; - } + result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); /* - * Create a new history array and copy as much existing history - * as possible from the old array. + * Move the interpreter's object result to the string result, + * then reset the object result. + * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS. */ - events = (HistoryEvent *) - ckalloc((unsigned) (count * sizeof(HistoryEvent))); - if (count < iPtr->numEvents) { - src = iPtr->curEvent + 1 - count; - if (src < 0) { - src += iPtr->numEvents; - } - } else { - src = iPtr->curEvent + 1; - } - for (i = 0; i < count; i++, src++) { - if (src >= iPtr->numEvents) { - src = 0; - } - if (i < iPtr->numEvents) { - events[i] = iPtr->events[src]; - iPtr->events[src].command = NULL; - } else { - events[i].command = (char *) ckalloc(INITIAL_CMD_SIZE); - events[i].command[0] = 0; - events[i].bytesAvl = INITIAL_CMD_SIZE; - } - } + Tcl_SetResult(interp, + TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL), + TCL_VOLATILE); /* - * Throw away everything left in the old history array, and - * substitute the new one for the old one. + * Discard the Tcl object created to hold the command. */ - - for (i = 0; i < iPtr->numEvents; i++) { - if (iPtr->events[i].command != NULL) { - ckfree(iPtr->events[i].command); - } - } - ckfree((char *) iPtr->events); - iPtr->events = events; - if (count < iPtr->numEvents) { - iPtr->curEvent = count-1; - } else { - iPtr->curEvent = iPtr->numEvents-1; - } - iPtr->numEvents = count; - return TCL_OK; - } else if ((c == 'n') && (strncmp(argv[1], "nextid", length)) == 0) { - char buf[40]; - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " nextid\"", (char *) NULL); - return TCL_ERROR; - } - TclFormatInt(buf, iPtr->curEventNum+1); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - return TCL_OK; - } else if ((c == 'r') && (strncmp(argv[1], "redo", length)) == 0) { - if (argc > 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " redo ?event?\"", (char *) NULL); - return TCL_ERROR; - } - eventPtr = GetEvent(iPtr, argc==2 ? "-1" : argv[2]); - if (eventPtr == NULL) { - return TCL_ERROR; - } - RevCommand(iPtr, eventPtr->command); - return Tcl_Eval(interp, eventPtr->command); - } else if ((c == 's') && (strncmp(argv[1], "substitute", length)) == 0) { - if ((argc > 5) || (argc < 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " substitute old new ?event?\"", (char *) NULL); - return TCL_ERROR; - } - eventPtr = GetEvent(iPtr, argc==4 ? "-1" : argv[4]); - if (eventPtr == NULL) { - return TCL_ERROR; - } - return SubsAndEval(iPtr, eventPtr->command, argv[2], argv[3]); - } else if ((c == 'w') && (strncmp(argv[1], "words", length)) == 0) { - char *words; - - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " words num-num/pat ?event?\"", (char *) NULL); - return TCL_ERROR; - } - eventPtr = GetEvent(iPtr, argc==3 ? "-1" : argv[3]); - if (eventPtr == NULL) { - return TCL_ERROR; - } - words = GetWords(iPtr, eventPtr->command, argv[2]); - if (words == NULL) { - return TCL_ERROR; - } - RevResult(iPtr, words); - Tcl_SetResult(interp, words, TCL_DYNAMIC); - return TCL_OK; - } - - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be add, change, event, info, keep, nextid, ", - "redo, substitute, or words", (char *) NULL); - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * - * MakeSpace -- - * - * Given a history event, make sure it has enough space for - * a string of a given length (enlarge the string area if - * necessary). - * - * Results: - * None. - * - * Side effects: - * More memory may get allocated. - * - *---------------------------------------------------------------------- - */ - -static void -MakeSpace(hPtr, size) - HistoryEvent *hPtr; - int size; /* # of bytes needed in hPtr. */ -{ - if (hPtr->bytesAvl < size) { - ckfree(hPtr->command); - hPtr->command = (char *) ckalloc((unsigned) size); - hPtr->bytesAvl = size; - } -} - -/* - *---------------------------------------------------------------------- - * - * InsertRev -- - * - * Add a new revision to the list of those pending for iPtr. - * Do it in a way that keeps the revision list sorted in - * increasing order of firstIndex. Also, eliminate revisions - * that are subsets of other revisions. - * - * Results: - * None. - * - * Side effects: - * RevPtr is added to iPtr's revision list. - * - *---------------------------------------------------------------------- - */ - -static void -InsertRev(iPtr, revPtr) - Interp *iPtr; /* Interpreter to use. */ - register HistoryRev *revPtr; /* Revision to add to iPtr's list. */ -{ - register HistoryRev *curPtr; - register HistoryRev *prevPtr; - - for (curPtr = iPtr->revPtr, prevPtr = NULL; curPtr != NULL; - prevPtr = curPtr, curPtr = curPtr->nextPtr) { + Tcl_DecrRefCount(cmdPtr); + } else { /* - * If this revision includes the new one (or vice versa) then - * just eliminate the one that is a subset of the other. + * An empty string. Just reset the interpreter's result. */ - if ((revPtr->firstIndex <= curPtr->firstIndex) - && (revPtr->lastIndex >= curPtr->firstIndex)) { - curPtr->firstIndex = revPtr->firstIndex; - curPtr->lastIndex = revPtr->lastIndex; - curPtr->newSize = revPtr->newSize; - ckfree(curPtr->newBytes); - curPtr->newBytes = revPtr->newBytes; - ckfree((char *) revPtr); - return; - } - if ((revPtr->firstIndex >= curPtr->firstIndex) - && (revPtr->lastIndex <= curPtr->lastIndex)) { - ckfree(revPtr->newBytes); - ckfree((char *) revPtr); - return; - } - - if (revPtr->firstIndex < curPtr->firstIndex) { - break; - } - } - - /* - * Insert revPtr just after prevPtr. - */ - - if (prevPtr == NULL) { - revPtr->nextPtr = iPtr->revPtr; - iPtr->revPtr = revPtr; - } else { - revPtr->nextPtr = prevPtr->nextPtr; - prevPtr->nextPtr = revPtr; - } -} - -/* - *---------------------------------------------------------------------- - * - * RevCommand -- - * - * This procedure is invoked by the "history" command to record - * a command revision. See the comments at the beginning of the - * file for more information about revisions. - * - * Results: - * None. - * - * Side effects: - * Revision information is recorded. - * - *---------------------------------------------------------------------- - */ - -static void -RevCommand(iPtr, string) - register Interp *iPtr; /* Interpreter in which to perform the - * substitution. */ - char *string; /* String to substitute. */ -{ - register HistoryRev *revPtr; - - if ((iPtr->evalFirst == NULL) || (iPtr->revDisables > 0)) { - return; - } - revPtr = (HistoryRev *) ckalloc(sizeof(HistoryRev)); - revPtr->firstIndex = iPtr->evalFirst - iPtr->historyFirst; - revPtr->lastIndex = iPtr->evalLast - iPtr->historyFirst; - revPtr->newSize = strlen(string); - revPtr->newBytes = (char *) ckalloc((unsigned) (revPtr->newSize+1)); - strcpy(revPtr->newBytes, string); - InsertRev(iPtr, revPtr); -} - -/* - *---------------------------------------------------------------------- - * - * RevResult -- - * - * This procedure is invoked by the "history" command to record - * a result revision. See the comments at the beginning of the - * file for more information about revisions. - * - * Results: - * None. - * - * Side effects: - * Revision information is recorded. - * - *---------------------------------------------------------------------- - */ - -static void -RevResult(iPtr, string) - register Interp *iPtr; /* Interpreter in which to perform the - * substitution. */ - char *string; /* String to substitute. */ -{ - register HistoryRev *revPtr; - char *evalFirst, *evalLast; - char *argv[2]; - - if ((iPtr->evalFirst == NULL) || (iPtr->revDisables > 0)) { - return; - } - - /* - * Expand the replacement range to include the brackets that surround - * the command. If there aren't any brackets (i.e. this command was - * invoked at top-level) then don't do any revision. Also, if there - * are several commands in brackets, of which this is just one, - * then don't do any revision. - */ - - evalFirst = iPtr->evalFirst; - evalLast = iPtr->evalLast + 1; - while (1) { - if (evalFirst == iPtr->historyFirst) { - return; - } - evalFirst--; - if (*evalFirst == '[') { - break; - } - if (!isspace(UCHAR(*evalFirst))) { - return; - } - } - if (*evalLast != ']') { - return; - } - - revPtr = (HistoryRev *) ckalloc(sizeof(HistoryRev)); - revPtr->firstIndex = evalFirst - iPtr->historyFirst; - revPtr->lastIndex = evalLast - iPtr->historyFirst; - argv[0] = string; - revPtr->newBytes = Tcl_Merge(1, argv); - revPtr->newSize = strlen(revPtr->newBytes); - InsertRev(iPtr, revPtr); -} - -/* - *---------------------------------------------------------------------- - * - * DoRevs -- - * - * This procedure is called to apply the history revisions that - * have been recorded in iPtr. - * - * Results: - * None. - * - * Side effects: - * The most recent entry in the history for iPtr may be modified. - * - *---------------------------------------------------------------------- - */ - -static void -DoRevs(iPtr) - register Interp *iPtr; /* Interpreter whose history is to - * be modified. */ -{ - register HistoryRev *revPtr; - register HistoryEvent *eventPtr; - char *newCommand, *p; - unsigned int size; - int bytesSeen, count; - - if (iPtr->revPtr == NULL) { - return; - } - - /* - * The revision is done in two passes. The first pass computes the - * amount of space needed for the revised event, and the second pass - * pieces together the new event and frees up the revisions. - */ - - eventPtr = &iPtr->events[iPtr->curEvent]; - size = strlen(eventPtr->command) + 1; - for (revPtr = iPtr->revPtr; revPtr != NULL; revPtr = revPtr->nextPtr) { - size -= revPtr->lastIndex + 1 - revPtr->firstIndex; - size += revPtr->newSize; - } - - newCommand = (char *) ckalloc(size); - p = newCommand; - bytesSeen = 0; - for (revPtr = iPtr->revPtr; revPtr != NULL; ) { - HistoryRev *nextPtr = revPtr->nextPtr; - - count = revPtr->firstIndex - bytesSeen; - if (count > 0) { - strncpy(p, eventPtr->command + bytesSeen, (size_t) count); - p += count; - } - strncpy(p, revPtr->newBytes, (size_t) revPtr->newSize); - p += revPtr->newSize; - bytesSeen = revPtr->lastIndex+1; - ckfree(revPtr->newBytes); - ckfree((char *) revPtr); - revPtr = nextPtr; - } - strcpy(p, eventPtr->command + bytesSeen); - - /* - * Replace the command in the event. - */ - - ckfree(eventPtr->command); - eventPtr->command = newCommand; - eventPtr->bytesAvl = size; - iPtr->revPtr = NULL; -} - -/* - *---------------------------------------------------------------------- - * - * GetEvent -- - * - * Given a textual description of an event (see the manual page - * for legal values) find the corresponding event and return its - * command string. - * - * Results: - * The return value is a pointer to the event named by "string". - * If no such event exists, then NULL is returned and an error - * message is left in iPtr. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static HistoryEvent * -GetEvent(iPtr, string) - register Interp *iPtr; /* Interpreter in which to look. */ - char *string; /* Description of event. */ -{ - int eventNum, index; - register HistoryEvent *eventPtr; - int length; - - /* - * First check for a numeric specification of an event. - */ - - if (isdigit(UCHAR(*string)) || (*string == '-')) { - if (Tcl_GetInt((Tcl_Interp *) iPtr, string, &eventNum) != TCL_OK) { - return NULL; - } - if (eventNum < 0) { - eventNum += iPtr->curEventNum; - } - if (eventNum > iPtr->curEventNum) { - Tcl_AppendResult((Tcl_Interp *) iPtr, "event \"", string, - "\" hasn't occurred yet", (char *) NULL); - return NULL; - } - if ((eventNum <= iPtr->curEventNum-iPtr->numEvents) - || (eventNum <= 0)) { - Tcl_AppendResult((Tcl_Interp *) iPtr, "event \"", string, - "\" is too far in the past", (char *) NULL); - return NULL; - } - index = iPtr->curEvent + (eventNum - iPtr->curEventNum); - if (index < 0) { - index += iPtr->numEvents; - } - return &iPtr->events[index]; - } - - /* - * Next, check for an event that contains the string as a prefix or - * that matches the string in the sense of Tcl_StringMatch. - */ - - length = strlen(string); - for (index = iPtr->curEvent - 1; ; index--) { - if (index < 0) { - index += iPtr->numEvents; - } - if (index == iPtr->curEvent) { - break; - } - eventPtr = &iPtr->events[index]; - if ((strncmp(eventPtr->command, string, (size_t) length) == 0) - || Tcl_StringMatch(eventPtr->command, string)) { - return eventPtr; - } - } - - Tcl_AppendResult((Tcl_Interp *) iPtr, "no event matches \"", string, - "\"", (char *) NULL); - return NULL; -} - -/* - *---------------------------------------------------------------------- - * - * SubsAndEval -- - * - * Generate a new command by making a textual substitution in - * the "cmd" argument. Then execute the new command. - * - * Results: - * The return value is a standard Tcl error. - * - * Side effects: - * History gets revised if the substitution is occurring on - * a recorded command line. Also, the re-executed command - * may produce side-effects. - * - *---------------------------------------------------------------------- - */ - -static int -SubsAndEval(iPtr, cmd, old, new) - register Interp *iPtr; /* Interpreter in which to execute - * new command. */ - char *cmd; /* Command in which to substitute. */ - char *old; /* String to search for in command. */ - char *new; /* Replacement string for "old". */ -{ - char *src, *dst, *newCmd; - int count, oldLength, newLength, length, result; - - /* - * Figure out how much space it will take to hold the - * substituted command (and complain if the old string - * doesn't appear in the original command). - */ - - oldLength = strlen(old); - newLength = strlen(new); - src = cmd; - count = 0; - while (1) { - src = strstr(src, old); - if (src == NULL) { - break; - } - src += oldLength; - count++; - } - if (count == 0) { - Tcl_AppendResult((Tcl_Interp *) iPtr, "\"", old, - "\" doesn't appear in event", (char *) NULL); - return TCL_ERROR; - } - length = strlen(cmd) + count*(newLength - oldLength); - - /* - * Generate a substituted command. - */ - - newCmd = (char *) ckalloc((unsigned) (length + 1)); - dst = newCmd; - while (1) { - src = strstr(cmd, old); - if (src == NULL) { - strcpy(dst, cmd); - break; - } - strncpy(dst, cmd, (size_t) (src-cmd)); - dst += src-cmd; - strcpy(dst, new); - dst += newLength; - cmd = src + oldLength; + Tcl_ResetResult(interp); + result = TCL_OK; } - - RevCommand(iPtr, newCmd); - result = Tcl_Eval((Tcl_Interp *) iPtr, newCmd); - ckfree(newCmd); return result; } /* *---------------------------------------------------------------------- * - * GetWords -- + * Tcl_RecordAndEvalObj -- * - * Given a command string, return one or more words from the - * command string. + * This procedure adds the command held in its argument object to the + * current list of recorded events and then executes the command by + * calling Tcl_EvalObj. * * Results: - * The return value is a pointer to a dynamically-allocated - * string containing the words of command specified by "words". - * If the word specifier has improper syntax then an error - * message is placed in iPtr->result and NULL is returned. + * The return value is a standard Tcl return value, the result of + * executing the command. * * Side effects: - * Memory is allocated. It is the caller's responsibilty to - * free the returned string.. + * The command is recorded and executed. * *---------------------------------------------------------------------- */ -static char * -GetWords(iPtr, command, words) - register Interp *iPtr; /* Tcl interpreter in which to place - * an error message if needed. */ - char *command; /* Command string. */ - char *words; /* Description of which words to extract - * from the command. Either num[-num] or - * a pattern. */ +int +Tcl_RecordAndEvalObj(interp, cmdPtr, flags) + Tcl_Interp *interp; /* Token for interpreter in which command + * will be executed. */ + Tcl_Obj *cmdPtr; /* Points to object holding the command to + * record and execute. */ + int flags; /* Additional flags. TCL_NO_EVAL means + * record only: don't execute the command. + * TCL_EVAL_GLOBAL means use + * Tcl_GlobalEvalObj instead of + * Tcl_EvalObj. */ { - char *result; - char *start, *end, *dst; - register char *next; - int first; /* First word desired. -1 means last word - * only. */ - int last; /* Last word desired. -1 means use everything - * up to the end. */ - int index; /* Index of current word. */ - char *pattern; + Interp *iPtr = (Interp *) interp; + int result; + Tcl_Obj *list[3]; + register Tcl_Obj *objPtr; /* - * Figure out whether we're looking for a numerical range or for - * a pattern. + * Do recording by eval'ing a tcl history command: history add $cmd. */ - pattern = NULL; - first = 0; - last = -1; - if (*words == '$') { - if (words[1] != '\0') { - goto error; - } - first = -1; - } else if (isdigit(UCHAR(*words))) { - first = strtoul(words, &start, 0); - if (*start == 0) { - last = first; - } else if (*start == '-') { - start++; - if (*start == '$') { - start++; - } else if (isdigit(UCHAR(*start))) { - last = strtoul(start, &start, 0); - } else { - goto error; - } - if (*start != 0) { - goto error; - } - } - if ((first > last) && (last != -1)) { - goto error; - } - } else { - pattern = words; - } + list[0] = Tcl_NewStringObj("history", -1); + list[1] = Tcl_NewStringObj("add", -1); + list[2] = cmdPtr; + + objPtr = Tcl_NewListObj(3, list); + Tcl_IncrRefCount(objPtr); + (void) Tcl_GlobalEvalObj(interp, objPtr); + Tcl_DecrRefCount(objPtr); /* - * Scan through the words one at a time, copying those that are - * relevant into the result string. Allocate a result area large - * enough to hold all the words if necessary. + * Execute the command. */ - result = (char *) ckalloc((unsigned) (strlen(command) + 1)); - dst = result; - for (next = command; isspace(UCHAR(*next)); next++) { - /* Empty loop body: just find start of first word. */ - } - for (index = 0; *next != 0; index++) { - start = next; - end = TclWordEnd(next, next + strlen(next), 0, (int *) NULL); - if (*end != 0) { - end++; - for (next = end; isspace(UCHAR(*next)); next++) { - /* Empty loop body: just find start of next word. */ - } - } - if ((first > index) || ((first == -1) && (*next != 0))) { - continue; - } - if ((last != -1) && (last < index)) { - continue; - } - if (pattern != NULL) { - int match; - char savedChar = *end; - - *end = 0; - match = Tcl_StringMatch(start, pattern); - *end = savedChar; - if (!match) { - continue; - } - } - if (dst != result) { - *dst = ' '; - dst++; + result = TCL_OK; + if (!(flags & TCL_NO_EVAL)) { + iPtr->evalFlags = (flags & ~TCL_EVAL_GLOBAL); + if (flags & TCL_EVAL_GLOBAL) { + result = Tcl_GlobalEvalObj(interp, cmdPtr); + } else { + result = Tcl_EvalObj(interp, cmdPtr); } - strncpy(dst, start, (size_t) (end-start)); - dst += end-start; - } - *dst = 0; - - /* - * Check for an out-of-range argument index. - */ - - if ((last >= index) || (first >= index)) { - ckfree(result); - Tcl_AppendResult((Tcl_Interp *) iPtr, "word selector \"", words, - "\" specified non-existent words", (char *) NULL); - return NULL; } return result; - - error: - Tcl_AppendResult((Tcl_Interp *) iPtr, "bad word selector \"", words, - "\": should be num-num or pattern", (char *) NULL); - return NULL; } |
