OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [generic/] [tclHistory.c] - Blame information for rev 1765

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.