tclhistory.c

tcl源码详细资料

#ifndef EXCLUDE_TCL

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

#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));

/*
 *----------------------------------------------------------------------
 *
 * 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, (Tcl_CmdDeleteProc *) NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * 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;
}

/*
 *----------------------------------------------------------------------
 *
 * 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) {
	long count;
	int 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) {
	long count;
	int 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;
}

/*
 *----------------------------------------------------------------------
 *
 * 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.