source: HiSusy/trunk/Delphes/Delphes-3.0.9/external/tcl/tclHistory.c @ 5

Last change on this file since 5 was 5, checked in by zerwas, 11 years ago

update to Delphes-3.0.9

File size: 4.0 KB
Line 
1/*
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 2008-06-04 13:58:06 demin 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
41int
42Tcl_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
111int
112Tcl_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}
Note: See TracBrowser for help on using the repository browser.