/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclhistory.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclhistory.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 44 - (show annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (7 years, 8 months ago) by dashley
File MIME type: text/plain
File size: 4401 byte(s)
Rename for reorganization.
1 /* $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 */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25