fix colors on BGR displays

[micropolis] / src / tcl / tclhist.c

/* 
 * 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.
 *
 * Copyright 1990-1991 Regents of the University of California
 * Permission to use, copy, modify, and distribute this
 * software and its documentation for any purpose and without
 * fee is hereby granted, provided that the above copyright
 * notice appear in all copies.  The University of California
 * makes no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without
 * express or implied warranty.
 */

#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclHistory.c,v 1.23 91/10/28 09:11:16 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */

#include "tclint.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             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));
\f
/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitHistory --
 *
 *      Initialize history-related state in an interpreter.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      History info is initialized in iPtr.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_InitHistory(interp)
    Tcl_Interp *interp;         /* Interpreter to initialize. */
{
    register Interp *iPtr = (Interp *) interp;
    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;
    Tcl_CreateCommand((Tcl_Interp *) iPtr, "history", Tcl_HistoryCmd,
            (ClientData) NULL, (void (*)()) NULL);
}
\f
/*
 *----------------------------------------------------------------------
 *
 * Tcl_RecordAndEval --
 *
 *      This procedure adds its command argument to the current list of
 *      recorded events and then executes the command by calling Tcl_Eval.
 *
 * Results:
 *      The return value is a standard Tcl return value, the result of
 *      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.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_RecordAndEval(interp, cmd, flags)
    Tcl_Interp *interp;         /* Token for interpreter in which command
                                 * will be executed. */
    char *cmd;                  /* Command to record. */
    int flags;                  /* Additional flags to pass to Tcl_Eval. 
                                 * TCL_NO_EVAL means only record: don't
                                 * execute command. */
{
    register Interp *iPtr = (Interp *) interp;
    register HistoryEvent *eventPtr;
    int length, result;

    if (iPtr->numEvents == 0) {
        Tcl_InitHistory(interp);
    }
    DoRevs(iPtr);

    /*
     * Don't record empty commands.
     */

    while (isspace(*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, 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;
        result = Tcl_Eval(interp, cmd, flags | TCL_RECORD_BOUNDS,
                (char **) NULL);
    }
    iPtr->revDisables = 1;
    return result;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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;
    int length;
    char c;

    /*
     * If no arguments, treat the same as "history info".
     */

    if (argc == 1) {
        goto infoCmd;
    }

    c = argv[1][0];
    length = strlen(argv[1]);

    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, 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.
             */

            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;

        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;
        }

        /*
         * Create a new history array and copy as much existing history
         * as possible from the old array.
         */

        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;
            }
        }

        /*
         * Throw away everything left in the old history array, and
         * substitute the new one for the old one.
         */

        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) {
        if (argc != 2) {
            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                    " nextid\"", (char *) NULL);
            return TCL_ERROR;
        }
        sprintf(iPtr->result, "%d", iPtr->curEventNum+1);
        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, 0, (char **) NULL);
    } 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);
        iPtr->result = words;
        iPtr->freeProc = (Tcl_FreeProc *) free;
        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;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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;
    }
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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) {
        /*
         * If this revision includes the new one (or vice versa) then
         * just eliminate the one that is a subset of the other.
         */

        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;
    }
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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);
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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(*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);
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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, count);
            p += count;
        }
        strncpy(p, revPtr->newBytes, revPtr->newSize);
        p += revPtr->newSize;
        bytesSeen = revPtr->lastIndex+1;
        ckfree(revPtr->newBytes);
        ckfree((char *) revPtr);
        revPtr = nextPtr;
    }
    if (&p[strlen(&eventPtr->command[bytesSeen]) + 1] >
            &newCommand[size]) {
        printf("Assertion failed!\n");
    }
    strcpy(p, eventPtr->command + bytesSeen);

    /*
     * Replace the command in the event.
     */

    ckfree(eventPtr->command);
    eventPtr->command = newCommand;
    eventPtr->bytesAvl = size;
    iPtr->revPtr = NULL;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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(*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, length) == 0)
                || Tcl_StringMatch(eventPtr->command, string)) {
            return eventPtr;
        }
    }

    Tcl_AppendResult((Tcl_Interp *) iPtr, "no event matches \"", string,
            "\"", (char *) NULL);
    return NULL;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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, src-cmd);
        dst += src-cmd;
        strcpy(dst, new);
        dst += newLength;
        cmd = src + oldLength;
    }

    RevCommand(iPtr, newCmd);
    result = Tcl_Eval((Tcl_Interp *) iPtr, newCmd, 0, (char **) NULL);
    ckfree(newCmd);
    return result;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * GetWords --
 *
 *      Given a command string, return one or more words from the
 *      command string.
 *
 * 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.
 *
 * Side effects:
 *      Memory is allocated.  It is the caller's responsibilty to
 *      free the returned string..
 *
 *----------------------------------------------------------------------
 */

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. */
{
    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;

    /*
     * Figure out whether we're looking for a numerical range or for
     * a pattern.
     */

    pattern = NULL;
    first = 0;
    last = -1;
    if (*words == '$') {
        if (words[1] != '\0') {
            goto error;
        }
        first = -1;
    } else if (isdigit(*words)) {
        first = strtoul(words, &start, 0);
        if (*start == 0) {
            last = first;
        } else if (*start == '-') {
            start++;
            if (*start == '$') {
                start++;
            } else if (isdigit(*start)) {
                last = strtoul(start, &start, 0);
            } else {
                goto error;
            }
            if (*start != 0) {
                goto error;
            }
        }
        if ((first > last) && (last != -1)) {
            goto error;
        }
    } else {
        pattern = words;
    }

    /*
     * 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.
     */

    result = (char *) ckalloc((unsigned) (strlen(command) + 1));
    dst = result;
    for (next = command; isspace(*next); next++) {
        /* Empty loop body:  just find start of first word. */
    }
    for (index = 0; *next != 0; index++) {
        start = next;
        end = TclWordEnd(next, 0);
        for (next = end; isspace(*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++;
        }
        strncpy(dst, start, (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;
}