Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/misc/volume25/tcl/part21

Text File | 1991-11-15 | 33.0 KB | 1,152 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Karl Lehenbauer)
Subject:  v25i089:  tcl - tool command language, version 6.1, Part21/33
Message-ID: <[e-mail]>
X-Md4-Signature: f88711f2c05879f9ec3562cd22bfd069
Date: Fri, 15 Nov 1991 22:50:08 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Karl Lehenbauer)
Posting-number: Volume 25, Issue 89
Archive-name: tcl/part21
Environment: UNIX

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#        "End of archive 21 (of 33)."
# Contents:  tcl6.1/tclHistory.c
# Wrapped by karl@one on Tue Nov 12 19:44:28 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'tcl6.1/tclHistory.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tcl6.1/tclHistory.c'\"
else
echo shar: Extracting \"'tcl6.1/tclHistory.c'\" \(30514 characters\)
sed "s/^X//" >'tcl6.1/tclHistory.c' <<'END_OF_FILE'
X/*
X * tclHistory.c --
X *
X *    This module implements history as an optional addition to Tcl.
X *    It can be called to record commands ("events") before they are
X *    executed, and it provides a command that may be used to perform
X *    history substitutions.
X *
X * Copyright 1990-1991 Regents of the University of California
X * Permission to use, copy, modify, and distribute this
X * software and its documentation for any purpose and without
X * fee is hereby granted, provided that the above copyright
X * notice appear in all copies.  The University of California
X * makes no representations about the suitability of this
X * software for any purpose.  It is provided "as is" without
X * express or implied warranty.
X */
X
X#ifndef lint
Xstatic char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclHistory.c,v 1.23 91/10/28 09:11:16 ouster Exp $ SPRITE (Berkeley)";
X#endif /* not lint */
X
X#include "tclInt.h"
X
X/*
X * This history stuff is mostly straightforward, except for one thing
X * that makes everything very complicated.  Suppose that the following
X * commands get executed:
X *    echo foo
X *    history redo
X * It's important that the history event recorded for the second command
X * be "echo foo", not "history redo".  Otherwise, if another "history redo"
X * command is typed, it will result in infinite recursions on the
X * "history redo" command.  Thus, the actual recorded history must be
X *    echo foo
X *    echo foo
X * To do this, the history command revises recorded history as part of
X * its execution.  In the example above, when "history redo" starts
X * execution, the current event is "history redo", but the history
X * command arranges for the current event to be changed to "echo foo".
X *
X * There are three additional complications.  The first is that history
X * substitution may only be part of a command, as in the following
X * command sequence:
X *    echo foo bar
X *    echo [history word 3]
X * In this case, the second event should be recorded as "echo bar".  Only
X * part of the recorded event is to be modified.  Fortunately, Tcl_Eval
X * helps with this by recording (in the evalFirst and evalLast fields of
X * the intepreter) the location of the command being executed, so the
X * history module can replace exactly the range of bytes corresponding
X * to the history substitution command.
X *
X * The second complication is that there are two ways to revise history:
X * replace a command, and replace the result of a command.  Consider the
X * two examples below:
X *    format {result is %d} $num       |    format {result is %d} $num
X *    print [history redo]           |    print [history word 3]
X * Recorded history for these two cases should be as follows:
X *    format {result is %d} $num       |    format {result is %d} $num
X *    print [format {result is %d} $num] |    print $num
X * In the left case, the history command was replaced with another command
X * to be executed (the brackets were retained), but in the case on the
X * right the result of executing the history command was replaced (i.e.
X * brackets were replaced too).
X *
X * The third complication is that there could potentially be many
X * history substitutions within a single command, as in:
X *    echo [history word 3] [history word 2]
X * There could even be nested history substitutions, as in:
X *    history subs abc [history word 2]
X * If history revisions were made immediately during each "history" command
X * invocations, it would be very difficult to produce the correct cumulative
X * effect from several substitutions in the same command.  To get around
X * this problem, the actual history revision isn't made during the execution
X * of the "history" command.  Information about the changes is just recorded,
X * in xxx records, and the actual changes are made during the next call to
X * Tcl_RecordHistory (when we know that execution of the previous command
X * has finished).
X */
X
X/*
X * Default space allocation for command strings:
X */
X
X#define INITIAL_CMD_SIZE 40
X
X/*
X * Forward declarations for procedures defined later in this file:
X */
X
Xstatic void        DoRevs _ANSI_ARGS_((Interp *iPtr));
Xstatic HistoryEvent *    GetEvent _ANSI_ARGS_((Interp *iPtr, char *string));
Xstatic char *        GetWords _ANSI_ARGS_((Interp *iPtr, char *command,
X                char *words));
Xstatic void        InsertRev _ANSI_ARGS_((Interp *iPtr,
X                HistoryRev *revPtr));
Xstatic void        MakeSpace _ANSI_ARGS_((HistoryEvent *hPtr, int size));
Xstatic void        RevCommand _ANSI_ARGS_((Interp *iPtr, char *string));
Xstatic void        RevResult _ANSI_ARGS_((Interp *iPtr, char *string));
Xstatic int        SubsAndEval _ANSI_ARGS_((Interp *iPtr, char *cmd,
X                char *old, char *new));
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_InitHistory --
X *
X *    Initialize history-related state in an interpreter.
X *
X * Results:
X *    None.
X *
X * Side effects:
X *    History info is initialized in iPtr.
X *
X *----------------------------------------------------------------------
X */
X
Xvoid
XTcl_InitHistory(interp)
X    Tcl_Interp *interp;        /* Interpreter to initialize. */
X{
X    register Interp *iPtr = (Interp *) interp;
X    int i;
X
X    if (iPtr->numEvents != 0) {
X    return;
X    }
X    iPtr->numEvents = 20;
X    iPtr->events = (HistoryEvent *)
X        ckalloc((unsigned) (iPtr->numEvents * sizeof(HistoryEvent)));
X    for (i = 0; i < iPtr->numEvents; i++) {
X    iPtr->events[i].command = (char *) ckalloc(INITIAL_CMD_SIZE);
X    *iPtr->events[i].command = 0;
X    iPtr->events[i].bytesAvl = INITIAL_CMD_SIZE;
X    }
X    iPtr->curEvent = 0;
X    iPtr->curEventNum = 0;
X    Tcl_CreateCommand((Tcl_Interp *) iPtr, "history", Tcl_HistoryCmd,
X        (ClientData) NULL, (void (*)()) NULL);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_RecordAndEval --
X *
X *    This procedure adds its command argument to the current list of
X *    recorded events and then executes the command by calling Tcl_Eval.
X *
X * Results:
X *    The return value is a standard Tcl return value, the result of
X *    executing cmd.
X *
X * Side effects:
X *    The command is recorded and executed.  In addition, pending history
X *    revisions are carried out, and information is set up to enable
X *    Tcl_Eval to identify history command ranges.  This procedure also
X *    initializes history information for the interpreter, if it hasn't
X *    already been initialized.
X *
X *----------------------------------------------------------------------
X */
X
Xint
XTcl_RecordAndEval(interp, cmd, flags)
X    Tcl_Interp *interp;        /* Token for interpreter in which command
X                 * will be executed. */
X    char *cmd;            /* Command to record. */
X    int flags;            /* Additional flags to pass to Tcl_Eval.
X                 * TCL_NO_EVAL means only record: don't
X                 * execute command. */
X{
X    register Interp *iPtr = (Interp *) interp;
X    register HistoryEvent *eventPtr;
X    int length, result;
X
X    if (iPtr->numEvents == 0) {
X    Tcl_InitHistory(interp);
X    }
X    DoRevs(iPtr);
X
X    /*
X     * Don't record empty commands.
X     */
X
X    while (isspace(*cmd)) {
X    cmd++;
X    }
X    if (*cmd == '\0') {
X    Tcl_ResetResult(interp);
X    return TCL_OK;
X    }
X
X    iPtr->curEventNum++;
X    iPtr->curEvent++;
X    if (iPtr->curEvent >= iPtr->numEvents) {
X    iPtr->curEvent = 0;
X    }
X    eventPtr = &iPtr->events[iPtr->curEvent];
X
X    /*
X     * Chop off trailing newlines before recording the command.
X     */
X
X    length = strlen(cmd);
X    while (cmd[length-1] == '\n') {
X    length--;
X    }
X    MakeSpace(eventPtr, length + 1);
X    strncpy(eventPtr->command, cmd, length);
X    eventPtr->command[length] = 0;
X
X    /*
X     * Execute the command.  Note: history revision isn't possible after
X     * a nested call to this procedure, because the event at the top of
X     * the history list no longer corresponds to what's going on when
X     * a nested call here returns.  Thus, must leave history revision
X     * disabled when we return.
X     */
X
X    result = TCL_OK;
X    if (flags != TCL_NO_EVAL) {
X    iPtr->historyFirst = cmd;
X    iPtr->revDisables = 0;
X    result = Tcl_Eval(interp, cmd, flags | TCL_RECORD_BOUNDS,
X        (char **) NULL);
X    }
X    iPtr->revDisables = 1;
X    return result;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_HistoryCmd --
X *
X *    This procedure is invoked to process the "history" Tcl command.
X *    See the user documentation for details on what it does.
X *
X * Results:
X *    A standard Tcl result.
X *
X * Side effects:
X *    See the user documentation.
X *
X *----------------------------------------------------------------------
X */
X
X    /* ARGSUSED */
Xint
XTcl_HistoryCmd(dummy, interp, argc, argv)
X    ClientData dummy;            /* Not used. */
X    Tcl_Interp *interp;            /* Current interpreter. */
X    int argc;                /* Number of arguments. */
X    char **argv;            /* Argument strings. */
X{
X    register Interp *iPtr = (Interp *) interp;
X    register HistoryEvent *eventPtr;
X    int length;
X    char c;
X
X    /*
X     * If no arguments, treat the same as "history info".
X     */
X
X    if (argc == 1) {
X    goto infoCmd;
X    }
X
X    c = argv[1][0];
X    length = strlen(argv[1]);
X
X    if ((c == 'a') && (strncmp(argv[1], "add", length)) == 0) {
X    if ((argc != 3) && (argc != 4)) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X            " add event ?exec?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    if (argc == 4) {
X        if (strncmp(argv[3], "exec", strlen(argv[3])) != 0) {
X        Tcl_AppendResult(interp, "bad argument \"", argv[3],
X            "\": should be \"exec\"", (char *) NULL);
X        return TCL_ERROR;
X        }
X        return Tcl_RecordAndEval(interp, argv[2], 0);
X    }
X    return Tcl_RecordAndEval(interp, argv[2], TCL_NO_EVAL);
X    } else if ((c == 'c') && (strncmp(argv[1], "change", length)) == 0) {
X    if ((argc != 3) && (argc != 4)) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X            " change newValue ?event?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    if (argc == 3) {
X        eventPtr = &iPtr->events[iPtr->curEvent];
X        iPtr->revDisables += 1;
X        while (iPtr->revPtr != NULL) {
X        HistoryRev *nextPtr;
X
X        ckfree(iPtr->revPtr->newBytes);
X        nextPtr = iPtr->revPtr->nextPtr;
X        ckfree((char *) iPtr->revPtr);
X        iPtr->revPtr = nextPtr;
X        }
X    } else {
X        eventPtr = GetEvent(iPtr, argv[3]);
X        if (eventPtr == NULL) {
X        return TCL_ERROR;
X        }
X    }
X    MakeSpace(eventPtr, strlen(argv[2]) + 1);
X    strcpy(eventPtr->command, argv[2]);
X    return TCL_OK;
X    } else if ((c == 'e') && (strncmp(argv[1], "event", length)) == 0) {
X    if (argc > 3) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X            " event ?event?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    eventPtr = GetEvent(iPtr, argc==2 ? "-1" : argv[2]);
X    if (eventPtr == NULL) {
X        return TCL_ERROR;
X    }
X    RevResult(iPtr, eventPtr->command);
X    Tcl_SetResult(interp, eventPtr->command, TCL_VOLATILE);
X    return TCL_OK;
X    } else if ((c == 'i') && (strncmp(argv[1], "info", length)) == 0) {
X    int count, indx, i;
X    char *newline;
X
X    if ((argc != 2) && (argc != 3)) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X            " info ?count?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    infoCmd:
X    if (argc == 3) {
X        if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
X        return TCL_ERROR;
X        }
X        if (count > iPtr->numEvents) {
X        count = iPtr->numEvents;
X        }
X    } else {
X        count = iPtr->numEvents;
X    }
X    newline = "";
X    for (i = 0, indx = iPtr->curEvent + 1 + iPtr->numEvents - count;
X        i < count; i++, indx++) {
X        char *cur, *next, savedChar;
X        char serial[20];
X
X        if (indx >= iPtr->numEvents) {
X        indx -= iPtr->numEvents;
X        }
X        cur = iPtr->events[indx].command;
X        if (*cur == '\0') {
X        continue;        /* No command recorded here. */
X        }
X        sprintf(serial, "%6d  ", iPtr->curEventNum + 1 - (count - i));
X        Tcl_AppendResult(interp, newline, serial, (char *) NULL);
X        newline = "\n";
X
X        /*
X         * Tricky formatting here:  for multi-line commands, indent
X         * the continuation lines.
X         */
X
X        while (1) {
X        next = strchr(cur, '\n');
X        if (next == NULL) {
X            break;
X        }
X        next++;
X        savedChar = *next;
X        *next = 0;
X        Tcl_AppendResult(interp, cur, "\t", (char *) NULL);
X        *next = savedChar;
X        cur = next;
X        }
X        Tcl_AppendResult(interp, cur, (char *) NULL);
X    }
X    return TCL_OK;
X    } else if ((c == 'k') && (strncmp(argv[1], "keep", length)) == 0) {
X    int count, i, src;
X    HistoryEvent *events;
X
X    if (argc != 3) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X            " keep number\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
X        return TCL_ERROR;
X    }
X    if ((count <= 0) || (count > 1000)) {
X        Tcl_AppendResult(interp, "illegal keep count \"", argv[2],
X            "\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    /*
X     * Create a new history array and copy as much existing history
X     * as possible from the old array.
X     */
X
X    events = (HistoryEvent *)
X        ckalloc((unsigned) (count * sizeof(HistoryEvent)));
X    if (count < iPtr->numEvents) {
X        src = iPtr->curEvent + 1 - count;
X        if (src < 0) {
X        src += iPtr->numEvents;
X        }
X    } else {
X        src = iPtr->curEvent + 1;
X    }
X    for (i = 0; i < count; i++, src++) {
X        if (src >= iPtr->numEvents) {
X        src = 0;
X        }
X        if (i < iPtr->numEvents) {
X        events[i] = iPtr->events[src];
X        iPtr->events[src].command = NULL;
X        } else {
X        events[i].command = (char *) ckalloc(INITIAL_CMD_SIZE);
X        events[i].command[0] = 0;
X        events[i].bytesAvl = INITIAL_CMD_SIZE;
X        }
X    }
X
X    /*
X     * Throw away everything left in the old history array, and
X     * substitute the new one for the old one.
X     */
X
X    for (i = 0; i < iPtr->numEvents; i++) {
X        if (iPtr->events[i].command != NULL) {
X        ckfree(iPtr->events[i].command);
X        }
X    }
X    ckfree((char *) iPtr->events);
X    iPtr->events = events;
X    if (count < iPtr->numEvents) {
X        iPtr->curEvent = count-1;
X    } else {
X        iPtr->curEvent = iPtr->numEvents-1;
X    }
X    iPtr->numEvents = count;
X    return TCL_OK;
X    } else if ((c == 'n') && (strncmp(argv[1], "nextid", length)) == 0) {
X    if (argc != 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X            " nextid\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    sprintf(iPtr->result, "%d", iPtr->curEventNum+1);
X    return TCL_OK;
X    } else if ((c == 'r') && (strncmp(argv[1], "redo", length)) == 0) {
X    if (argc > 3) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X            " redo ?event?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    eventPtr = GetEvent(iPtr, argc==2 ? "-1" : argv[2]);
X    if (eventPtr == NULL) {
X        return TCL_ERROR;
X    }
X    RevCommand(iPtr, eventPtr->command);
X    return Tcl_Eval(interp, eventPtr->command, 0, (char **) NULL);
X    } else if ((c == 's') && (strncmp(argv[1], "substitute", length)) == 0) {
X    if ((argc > 5) || (argc < 4)) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X            " substitute old new ?event?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    eventPtr = GetEvent(iPtr, argc==4 ? "-1" : argv[4]);
X    if (eventPtr == NULL) {
X        return TCL_ERROR;
X    }
X    return SubsAndEval(iPtr, eventPtr->command, argv[2], argv[3]);
X    } else if ((c == 'w') && (strncmp(argv[1], "words", length)) == 0) {
X    char *words;
X
X    if ((argc != 3) && (argc != 4)) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X            " words num-num/pat ?event?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    eventPtr = GetEvent(iPtr, argc==3 ? "-1" : argv[3]);
X    if (eventPtr == NULL) {
X        return TCL_ERROR;
X    }
X    words = GetWords(iPtr, eventPtr->command, argv[2]);
X    if (words == NULL) {
X        return TCL_ERROR;
X    }
X    RevResult(iPtr, words);
X    iPtr->result = words;
X    iPtr->freeProc = (Tcl_FreeProc *) free;
X    return TCL_OK;
X    }
X
X    Tcl_AppendResult(interp, "bad option \"", argv[1],
X        "\": must be add, change, event, info, keep, nextid, ",
X        "redo, substitute, or words", (char *) NULL);
X    return TCL_ERROR;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * MakeSpace --
X *
X *    Given a history event, make sure it has enough space for
X *    a string of a given length (enlarge the string area if
X *    necessary).
X *
X * Results:
X *    None.
X *
X * Side effects:
X *    More memory may get allocated.
X *
X *----------------------------------------------------------------------
X */
X
Xstatic void
XMakeSpace(hPtr, size)
X    HistoryEvent *hPtr;
X    int size;            /* # of bytes needed in hPtr. */
X{
X    if (hPtr->bytesAvl < size) {
X    ckfree(hPtr->command);
X    hPtr->command = (char *) ckalloc((unsigned) size);
X    hPtr->bytesAvl = size;
X    }
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * InsertRev --
X *
X *    Add a new revision to the list of those pending for iPtr.
X *    Do it in a way that keeps the revision list sorted in
X *    increasing order of firstIndex.  Also, eliminate revisions
X *    that are subsets of other revisions.
X *
X * Results:
X *    None.
X *
X * Side effects:
X *    RevPtr is added to iPtr's revision list.
X *
X *----------------------------------------------------------------------
X */
X
Xstatic void
XInsertRev(iPtr, revPtr)
X    Interp *iPtr;            /* Interpreter to use. */
X    register HistoryRev *revPtr;    /* Revision to add to iPtr's list. */
X{
X    register HistoryRev *curPtr;
X    register HistoryRev *prevPtr;
X
X    for (curPtr = iPtr->revPtr, prevPtr = NULL; curPtr != NULL;
X        prevPtr = curPtr, curPtr = curPtr->nextPtr) {
X    /*
X     * If this revision includes the new one (or vice versa) then
X     * just eliminate the one that is a subset of the other.
X     */
X
X    if ((revPtr->firstIndex <= curPtr->firstIndex)
X        && (revPtr->lastIndex >= curPtr->firstIndex)) {
X        curPtr->firstIndex = revPtr->firstIndex;
X        curPtr->lastIndex = revPtr->lastIndex;
X        curPtr->newSize = revPtr->newSize;
X        ckfree(curPtr->newBytes);
X        curPtr->newBytes = revPtr->newBytes;
X        ckfree((char *) revPtr);
X        return;
X    }
X    if ((revPtr->firstIndex >= curPtr->firstIndex)
X        && (revPtr->lastIndex <= curPtr->lastIndex)) {
X        ckfree(revPtr->newBytes);
X        ckfree((char *) revPtr);
X        return;
X    }
X
X    if (revPtr->firstIndex < curPtr->firstIndex) {
X        break;
X    }
X    }
X
X    /*
X     * Insert revPtr just after prevPtr.
X     */
X
X    if (prevPtr == NULL) {
X    revPtr->nextPtr = iPtr->revPtr;
X    iPtr->revPtr = revPtr;
X    } else {
X    revPtr->nextPtr = prevPtr->nextPtr;
X    prevPtr->nextPtr = revPtr;
X    }
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * RevCommand --
X *
X *    This procedure is invoked by the "history" command to record
X *    a command revision.  See the comments at the beginning of the
X *    file for more information about revisions.
X *
X * Results:
X *    None.
X *
X * Side effects:
X *    Revision information is recorded.
X *
X *----------------------------------------------------------------------
X */
X
Xstatic void
XRevCommand(iPtr, string)
X    register Interp *iPtr;    /* Interpreter in which to perform the
X                 * substitution. */
X    char *string;        /* String to substitute. */
X{
X    register HistoryRev *revPtr;
X
X    if ((iPtr->evalFirst == NULL) || (iPtr->revDisables > 0)) {
X    return;
X    }
X    revPtr = (HistoryRev *) ckalloc(sizeof(HistoryRev));
X    revPtr->firstIndex = iPtr->evalFirst - iPtr->historyFirst;
X    revPtr->lastIndex = iPtr->evalLast - iPtr->historyFirst;
X    revPtr->newSize = strlen(string);
X    revPtr->newBytes = (char *) ckalloc((unsigned) (revPtr->newSize+1));
X    strcpy(revPtr->newBytes, string);
X    InsertRev(iPtr, revPtr);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * RevResult --
X *
X *    This procedure is invoked by the "history" command to record
X *    a result revision.  See the comments at the beginning of the
X *    file for more information about revisions.
X *
X * Results:
X *    None.
X *
X * Side effects:
X *    Revision information is recorded.
X *
X *----------------------------------------------------------------------
X */
X
Xstatic void
XRevResult(iPtr, string)
X    register Interp *iPtr;    /* Interpreter in which to perform the
X                 * substitution. */
X    char *string;        /* String to substitute. */
X{
X    register HistoryRev *revPtr;
X    char *evalFirst, *evalLast;
X    char *argv[2];
X
X    if ((iPtr->evalFirst == NULL) || (iPtr->revDisables > 0)) {
X    return;
X    }
X
X    /*
X     * Expand the replacement range to include the brackets that surround
X     * the command.  If there aren't any brackets (i.e. this command was
X     * invoked at top-level) then don't do any revision.  Also, if there
X     * are several commands in brackets, of which this is just one,
X     * then don't do any revision.
X     */
X
X    evalFirst = iPtr->evalFirst;
X    evalLast = iPtr->evalLast + 1;
X    while (1) {
X    if (evalFirst == iPtr->historyFirst) {
X        return;
X    }
X    evalFirst--;
X    if (*evalFirst == '[') {
X        break;
X    }
X    if (!isspace(*evalFirst)) {
X        return;
X    }
X    }
X    if (*evalLast != ']') {
X    return;
X    }
X
X    revPtr = (HistoryRev *) ckalloc(sizeof(HistoryRev));
X    revPtr->firstIndex = evalFirst - iPtr->historyFirst;
X    revPtr->lastIndex = evalLast - iPtr->historyFirst;
X    argv[0] = string;
X    revPtr->newBytes = Tcl_Merge(1, argv);
X    revPtr->newSize = strlen(revPtr->newBytes);
X    InsertRev(iPtr, revPtr);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * DoRevs --
X *
X *    This procedure is called to apply the history revisions that
X *    have been recorded in iPtr.
X *
X * Results:
X *    None.
X *
X * Side effects:
X *    The most recent entry in the history for iPtr may be modified.
X *
X *----------------------------------------------------------------------
X */
X
Xstatic void
XDoRevs(iPtr)
X    register Interp *iPtr;    /* Interpreter whose history is to
X                 * be modified. */
X{
X    register HistoryRev *revPtr;
X    register HistoryEvent *eventPtr;
X    char *newCommand, *p;
X    unsigned int size;
X    int bytesSeen, count;
X
X    if (iPtr->revPtr == NULL) {
X    return;
X    }
X
X    /*
X     * The revision is done in two passes.  The first pass computes the
X     * amount of space needed for the revised event, and the second pass
X     * pieces together the new event and frees up the revisions.
X     */
X
X    eventPtr = &iPtr->events[iPtr->curEvent];
X    size = strlen(eventPtr->command) + 1;
X    for (revPtr = iPtr->revPtr; revPtr != NULL; revPtr = revPtr->nextPtr) {
X    size -= revPtr->lastIndex + 1 - revPtr->firstIndex;
X    size += revPtr->newSize;
X    }
X
X    newCommand = (char *) ckalloc(size);
X    p = newCommand;
X    bytesSeen = 0;
X    for (revPtr = iPtr->revPtr; revPtr != NULL; ) {
X    HistoryRev *nextPtr = revPtr->nextPtr;
X
X    count = revPtr->firstIndex - bytesSeen;
X    if (count > 0) {
X        strncpy(p, eventPtr->command + bytesSeen, count);
X        p += count;
X    }
X    strncpy(p, revPtr->newBytes, revPtr->newSize);
X    p += revPtr->newSize;
X    bytesSeen = revPtr->lastIndex+1;
X    ckfree(revPtr->newBytes);
X    ckfree((char *) revPtr);
X    revPtr = nextPtr;
X    }
X    if (&p[strlen(&eventPtr->command[bytesSeen]) + 1] >
X        &newCommand[size]) {
X    printf("Assertion failed!\n");
X    }
X    strcpy(p, eventPtr->command + bytesSeen);
X
X    /*
X     * Replace the command in the event.
X     */
X
X    ckfree(eventPtr->command);
X    eventPtr->command = newCommand;
X    eventPtr->bytesAvl = size;
X    iPtr->revPtr = NULL;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * GetEvent --
X *
X *    Given a textual description of an event (see the manual page
X *    for legal values) find the corresponding event and return its
X *    command string.
X *
X * Results:
X *    The return value is a pointer to the event named by "string".
X *    If no such event exists, then NULL is returned and an error
X *    message is left in iPtr.
X *
X * Side effects:
X *    None.
X *
X *----------------------------------------------------------------------
X */
X
Xstatic HistoryEvent *
XGetEvent(iPtr, string)
X    register Interp *iPtr;    /* Interpreter in which to look. */
X    char *string;        /* Description of event. */
X{
X    int eventNum, index;
X    register HistoryEvent *eventPtr;
X    int length;
X
X    /*
X     * First check for a numeric specification of an event.
X     */
X
X    if (isdigit(*string) || (*string == '-')) {
X    if (Tcl_GetInt((Tcl_Interp *) iPtr, string, &eventNum) != TCL_OK) {
X        return NULL;
X    }
X    if (eventNum < 0) {
X        eventNum += iPtr->curEventNum;
X        }
X    if (eventNum > iPtr->curEventNum) {
X        Tcl_AppendResult((Tcl_Interp *) iPtr, "event \"", string,
X            "\" hasn't occurred yet", (char *) NULL);
X        return NULL;
X    }
X    if ((eventNum <= iPtr->curEventNum-iPtr->numEvents)
X        || (eventNum <= 0)) {
X        Tcl_AppendResult((Tcl_Interp *) iPtr, "event \"", string,
X            "\" is too far in the past", (char *) NULL);
X        return NULL;
X    }
X    index = iPtr->curEvent + (eventNum - iPtr->curEventNum);
X    if (index < 0) {
X        index += iPtr->numEvents;
X    }
X    return &iPtr->events[index];
X    }
X
X    /*
X     * Next, check for an event that contains the string as a prefix or
X     * that matches the string in the sense of Tcl_StringMatch.
X     */
X
X    length = strlen(string);
X    for (index = iPtr->curEvent - 1; ; index--) {
X    if (index < 0) {
X        index += iPtr->numEvents;
X    }
X    if (index == iPtr->curEvent) {
X        break;
X    }
X    eventPtr = &iPtr->events[index];
X    if ((strncmp(eventPtr->command, string, length) == 0)
X        || Tcl_StringMatch(eventPtr->command, string)) {
X        return eventPtr;
X    }
X    }
X
X    Tcl_AppendResult((Tcl_Interp *) iPtr, "no event matches \"", string,
X        "\"", (char *) NULL);
X    return NULL;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * SubsAndEval --
X *
X *    Generate a new command by making a textual substitution in
X *    the "cmd" argument.  Then execute the new command.
X *
X * Results:
X *    The return value is a standard Tcl error.
X *
X * Side effects:
X *    History gets revised if the substitution is occurring on
X *    a recorded command line.  Also, the re-executed command
X *    may produce side-effects.
X *
X *----------------------------------------------------------------------
X */
X
Xstatic int
XSubsAndEval(iPtr, cmd, old, new)
X    register Interp *iPtr;    /* Interpreter in which to execute
X                 * new command. */
X    char *cmd;            /* Command in which to substitute. */
X    char *old;            /* String to search for in command. */
X    char *new;            /* Replacement string for "old". */
X{
X    char *src, *dst, *newCmd;
X    int count, oldLength, newLength, length, result;
X
X    /*
X     * Figure out how much space it will take to hold the
X     * substituted command (and complain if the old string
X     * doesn't appear in the original command).
X     */
X
X    oldLength = strlen(old);
X    newLength = strlen(new);
X    src = cmd;
X    count = 0;
X    while (1) {
X    src = strstr(src, old);
X    if (src == NULL) {
X        break;
X    }
X    src += oldLength;
X    count++;
X    }
X    if (count == 0) {
X    Tcl_AppendResult((Tcl_Interp *) iPtr, "\"", old,
X        "\" doesn't appear in event", (char *) NULL);
X    return TCL_ERROR;
X    }
X    length = strlen(cmd) + count*(newLength - oldLength);
X
X    /*
X     * Generate a substituted command.
X     */
X
X    newCmd = (char *) ckalloc((unsigned) (length + 1));
X    dst = newCmd;
X    while (1) {
X    src = strstr(cmd, old);
X    if (src == NULL) {
X        strcpy(dst, cmd);
X        break;
X    }
X    strncpy(dst, cmd, src-cmd);
X    dst += src-cmd;
X    strcpy(dst, new);
X    dst += newLength;
X    cmd = src + oldLength;
X    }
X
X    RevCommand(iPtr, newCmd);
X    result = Tcl_Eval((Tcl_Interp *) iPtr, newCmd, 0, (char **) NULL);
X    ckfree(newCmd);
X    return result;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * GetWords --
X *
X *    Given a command string, return one or more words from the
X *    command string.
X *
X * Results:
X *    The return value is a pointer to a dynamically-allocated
X *    string containing the words of command specified by "words".
X *    If the word specifier has improper syntax then an error
X *    message is placed in iPtr->result and NULL is returned.
X *
X * Side effects:
X *    Memory is allocated.  It is the caller's responsibilty to
X *    free the returned string..
X *
X *----------------------------------------------------------------------
X */
X
Xstatic char *
XGetWords(iPtr, command, words)
X    register Interp *iPtr;    /* Tcl interpreter in which to place
X                 * an error message if needed. */
X    char *command;        /* Command string. */
X    char *words;        /* Description of which words to extract
X                 * from the command.  Either num[-num] or
X                 * a pattern. */
X{
X    char *result;
X    char *start, *end, *dst;
X    register char *next;
X    int first;            /* First word desired. -1 means last word
X                 * only. */
X    int last;            /* Last word desired.  -1 means use everything
X                 * up to the end. */
X    int index;            /* Index of current word. */
X    char *pattern;
X
X    /*
X     * Figure out whether we're looking for a numerical range or for
X     * a pattern.
X     */
X
X    pattern = NULL;
X    first = 0;
X    last = -1;
X    if (*words == '$') {
X    if (words[1] != '\0') {
X        goto error;
X    }
X    first = -1;
X    } else if (isdigit(*words)) {
X    first = strtoul(words, &start, 0);
X    if (*start == 0) {
X        last = first;
X    } else if (*start == '-') {
X        start++;
X        if (*start == '$') {
X        start++;
X        } else if (isdigit(*start)) {
X        last = strtoul(start, &start, 0);
X        } else {
X        goto error;
X        }
X        if (*start != 0) {
X        goto error;
X        }
X    }
X    if ((first > last) && (last != -1)) {
X        goto error;
X    }
X    } else {
X    pattern = words;
X    }
X
X    /*
X     * Scan through the words one at a time, copying those that are
X     * relevant into the result string.  Allocate a result area large
X     * enough to hold all the words if necessary.
X     */
X
X    result = (char *) ckalloc((unsigned) (strlen(command) + 1));
X    dst = result;
X    for (next = command; isspace(*next); next++) {
X    /* Empty loop body:  just find start of first word. */
X    }
X    for (index = 0; *next != 0; index++) {
X    start = next;
X    end = TclWordEnd(next, 0);
X    for (next = end; isspace(*next); next++) {
X        /* Empty loop body:  just find start of next word. */
X    }
X    if ((first > index) || ((first == -1) && (*next != 0))) {
X        continue;
X    }
X    if ((last != -1) && (last < index)) {
X        continue;
X    }
X    if (pattern != NULL) {
X        int match;
X        char savedChar = *end;
X
X        *end = 0;
X        match = Tcl_StringMatch(start, pattern);
X        *end = savedChar;
X        if (!match) {
X        continue;
X        }
X    }
X    if (dst != result) {
X        *dst = ' ';
X        dst++;
X    }
X    strncpy(dst, start, (end-start));
X    dst += end-start;
X    }
X    *dst = 0;
X
X    /*
X     * Check for an out-of-range argument index.
X     */
X
X    if ((last >= index) || (first >= index)) {
X    ckfree(result);
X    Tcl_AppendResult((Tcl_Interp *) iPtr, "word selector \"", words,
X        "\" specified non-existent words", (char *) NULL);
X    return NULL;
X    }
X    return result;
X
X    error:
X    Tcl_AppendResult((Tcl_Interp *) iPtr, "bad word selector \"", words,
X        "\":  should be num-num or pattern", (char *) NULL);
X    return NULL;
X}
END_OF_FILE
if test 30514 -ne `wc -c <'tcl6.1/tclHistory.c'`; then
    echo shar: \"'tcl6.1/tclHistory.c'\" unpacked with wrong size!
fi
# end of 'tcl6.1/tclHistory.c'
fi
echo shar: End of archive 21 \(of 33\).
cp /dev/null ark21isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 33 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0

exit 0 # Just in case...
--
Kent Landfield                   INTERNET: [e-mail]
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    [phone]         FAX:      [phone]
Please send comp.sources.misc-related mail to [e-mail].