shared_source/tcl_base/tclhistory.c

/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclhistory.c,v 1.1.1.1 2001/06/13 04:39:28 dtashley Exp $ */

/* 
 * tclHistory.c --
 *
 *      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-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.
 *
 * RCS: @(#) $Id: tclhistory.c,v 1.1.1.1 2001/06/13 04:39:28 dtashley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"


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

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.  TCL_NO_EVAL means
                                 * only record: don't execute command.
                                 * TCL_EVAL_GLOBAL means use Tcl_GlobalEval
                                 * instead of Tcl_Eval. */
{
    register Tcl_Obj *cmdPtr;
    int length = strlen(cmd);
    int result;

    if (length > 0) {
        /*
         * Call Tcl_RecordAndEvalObj to do the actual work.
         */

        cmdPtr = Tcl_NewStringObj(cmd, length);
        Tcl_IncrRefCount(cmdPtr);
        result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);

        /*
         * Move the interpreter's object result to the string result, 
         * then reset the object result.
         */

        Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
                TCL_VOLATILE);

        /*
         * Discard the Tcl object created to hold the command.
         */
        
        Tcl_DecrRefCount(cmdPtr);       
    } else {
        /*
         * An empty string. Just reset the interpreter's result.
         */

        Tcl_ResetResult(interp);
        result = TCL_OK;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_RecordAndEvalObj --
 *
 *      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 standard Tcl return value, the result of
 *      executing the command.
 *
 * Side effects:
 *      The command is recorded and executed.
 *
 *----------------------------------------------------------------------
 */

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 evaluate the
                                 * script in global variable context instead
                                 * of the current procedure. */
{
    int result;
    Tcl_Obj *list[3];
    register Tcl_Obj *objPtr;

    /*
     * Do recording by eval'ing a tcl history command: history add $cmd.
     */

    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_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount(objPtr);

    /*
     * Execute the command.
     */

    result = TCL_OK;
    if (!(flags & TCL_NO_EVAL)) {
        result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL);
    }
    return result;
}


/* $History: tclhistory.c $
 * 
 * *****************  Version 1  *****************
 * User: Dtashley     Date: 1/02/01    Time: 1:30a
 * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
 * Initial check-in.
 */ 

/* End of TCLHISTORY.C */
1	dashley	25	/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclhistory.c,v 1.1.1.1 2001/06/13 04:39:28 dtashley Exp $ */
2
3			/*
4			* tclHistory.c --
5			*
6			* This module and the Tcl library file history.tcl together implement
7			* Tcl command history. Tcl_RecordAndEval(Obj) can be called to record
8			* commands ("events") before they are executed. Commands defined in
9			* history.tcl may be used to perform history substitutions.
10			*
11			* Copyright (c) 1990-1993 The Regents of the University of California.
12			* Copyright (c) 1994-1997 Sun Microsystems, Inc.
13			*
14			* See the file "license.terms" for information on usage and redistribution
15			* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16			*
17			* RCS: @(#) $Id: tclhistory.c,v 1.1.1.1 2001/06/13 04:39:28 dtashley Exp $
18			*/
19
20			#include "tclInt.h"
21			#include "tclPort.h"
22
23
24			/*
25			*----------------------------------------------------------------------
26			*
27			* Tcl_RecordAndEval --
28			*
29			* This procedure adds its command argument to the current list of
30			* recorded events and then executes the command by calling
31			* Tcl_Eval.
32			*
33			* Results:
34			* The return value is a standard Tcl return value, the result of
35			* executing cmd.
36			*
37			* Side effects:
38			* The command is recorded and executed.
39			*
40			*----------------------------------------------------------------------
41			*/
42
43			int
44			Tcl_RecordAndEval(interp, cmd, flags)
45			Tcl_Interp interp; / Token for interpreter in which command
46			* will be executed. */
47			char cmd; / Command to record. */
48			int flags; /* Additional flags. TCL_NO_EVAL means
49			* only record: don't execute command.
50			* TCL_EVAL_GLOBAL means use Tcl_GlobalEval
51			* instead of Tcl_Eval. */
52			{
53			register Tcl_Obj *cmdPtr;
54			int length = strlen(cmd);
55			int result;
56
57			if (length > 0) {
58			/*
59			* Call Tcl_RecordAndEvalObj to do the actual work.
60			*/
61
62			cmdPtr = Tcl_NewStringObj(cmd, length);
63			Tcl_IncrRefCount(cmdPtr);
64			result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
65
66			/*
67			* Move the interpreter's object result to the string result,
68			* then reset the object result.
69			*/
70
71			Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
72			TCL_VOLATILE);
73
74			/*
75			* Discard the Tcl object created to hold the command.
76			*/
77
78			Tcl_DecrRefCount(cmdPtr);
79			} else {
80			/*
81			* An empty string. Just reset the interpreter's result.
82			*/
83
84			Tcl_ResetResult(interp);
85			result = TCL_OK;
86			}
87			return result;
88			}
89
90			/*
91			*----------------------------------------------------------------------
92			*
93			* Tcl_RecordAndEvalObj --
94			*
95			* This procedure adds the command held in its argument object to the
96			* current list of recorded events and then executes the command by
97			* calling Tcl_EvalObj.
98			*
99			* Results:
100			* The return value is a standard Tcl return value, the result of
101			* executing the command.
102			*
103			* Side effects:
104			* The command is recorded and executed.
105			*
106			*----------------------------------------------------------------------
107			*/
108
109			int
110			Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
111			Tcl_Interp interp; / Token for interpreter in which command
112			* will be executed. */
113			Tcl_Obj cmdPtr; / Points to object holding the command to
114			* record and execute. */
115			int flags; /* Additional flags. TCL_NO_EVAL means
116			* record only: don't execute the command.
117			* TCL_EVAL_GLOBAL means evaluate the
118			* script in global variable context instead
119			* of the current procedure. */
120			{
121			int result;
122			Tcl_Obj *list[3];
123			register Tcl_Obj *objPtr;
124
125			/*
126			* Do recording by eval'ing a tcl history command: history add $cmd.
127			*/
128
129			list[0] = Tcl_NewStringObj("history", -1);
130			list[1] = Tcl_NewStringObj("add", -1);
131			list[2] = cmdPtr;
132
133			objPtr = Tcl_NewListObj(3, list);
134			Tcl_IncrRefCount(objPtr);
135			(void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
136			Tcl_DecrRefCount(objPtr);
137
138			/*
139			* Execute the command.
140			*/
141
142			result = TCL_OK;
143			if (!(flags & TCL_NO_EVAL)) {
144			result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL);
145			}
146			return result;
147			}
148
149
150			/* $History: tclhistory.c $
151			*
152			* *************** Version 1 ***************
153			* User: Dtashley Date: 1/02/01 Time: 1:30a
154			* Created in $/IjuScripter, IjuConsole/Source/Tcl Base
155			* Initial check-in.
156			*/
157
158			/* End of TCLHISTORY.C */