[2] | 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 | *
|
---|
| 26 | * Tcl_RecordAndEval --
|
---|
| 27 | *
|
---|
| 28 | * This procedure adds its command argument to the current list of
|
---|
| 29 | * recorded events and then executes the command by calling
|
---|
| 30 | * Tcl_Eval.
|
---|
| 31 | *
|
---|
| 32 | * Results:
|
---|
| 33 | * The return value is a standard Tcl return value, the result of
|
---|
| 34 | * executing cmd.
|
---|
| 35 | *
|
---|
| 36 | * Side effects:
|
---|
| 37 | * The command is recorded and executed.
|
---|
| 38 | *
|
---|
| 39 | *----------------------------------------------------------------------
|
---|
| 40 | */
|
---|
| 41 |
|
---|
| 42 | int
|
---|
| 43 | Tcl_RecordAndEval(interp, cmd, flags)
|
---|
| 44 | Tcl_Interp *interp; /* Token for interpreter in which command
|
---|
| 45 | * will be executed. */
|
---|
| 46 | char *cmd; /* Command to record. */
|
---|
| 47 | int flags; /* Additional flags. TCL_NO_EVAL means
|
---|
| 48 | * only record: don't execute command.
|
---|
| 49 | * TCL_EVAL_GLOBAL means use Tcl_GlobalEval
|
---|
| 50 | * instead of Tcl_Eval. */
|
---|
| 51 | {
|
---|
| 52 | register Tcl_Obj *cmdPtr;
|
---|
| 53 | int length = strlen(cmd);
|
---|
| 54 | int result;
|
---|
| 55 |
|
---|
| 56 | if (length > 0) {
|
---|
| 57 | /*
|
---|
| 58 | * Call Tcl_RecordAndEvalObj to do the actual work.
|
---|
| 59 | */
|
---|
| 60 |
|
---|
| 61 | TclNewObj(cmdPtr);
|
---|
| 62 | TclInitStringRep(cmdPtr, cmd, length);
|
---|
| 63 | Tcl_IncrRefCount(cmdPtr);
|
---|
| 64 |
|
---|
| 65 | result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
|
---|
| 66 |
|
---|
| 67 | /*
|
---|
| 68 | * Move the interpreter's object result to the string result,
|
---|
| 69 | * then reset the object result.
|
---|
| 70 | * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
|
---|
| 71 | */
|
---|
| 72 |
|
---|
| 73 | Tcl_SetResult(interp,
|
---|
| 74 | TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
|
---|
| 75 | TCL_VOLATILE);
|
---|
| 76 |
|
---|
| 77 | /*
|
---|
| 78 | * Discard the Tcl object created to hold the command.
|
---|
| 79 | */
|
---|
| 80 |
|
---|
| 81 | Tcl_DecrRefCount(cmdPtr);
|
---|
| 82 | } else {
|
---|
| 83 | /*
|
---|
| 84 | * An empty string. Just reset the interpreter's result.
|
---|
| 85 | */
|
---|
| 86 |
|
---|
| 87 | Tcl_ResetResult(interp);
|
---|
| 88 | result = TCL_OK;
|
---|
| 89 | }
|
---|
| 90 | return result;
|
---|
| 91 | }
|
---|
| 92 | |
---|
| 93 |
|
---|
| 94 | /*
|
---|
| 95 | *----------------------------------------------------------------------
|
---|
| 96 | *
|
---|
| 97 | * Tcl_RecordAndEvalObj --
|
---|
| 98 | *
|
---|
| 99 | * This procedure adds the command held in its argument object to the
|
---|
| 100 | * current list of recorded events and then executes the command by
|
---|
| 101 | * calling Tcl_EvalObj.
|
---|
| 102 | *
|
---|
| 103 | * Results:
|
---|
| 104 | * The return value is a standard Tcl return value, the result of
|
---|
| 105 | * executing the command.
|
---|
| 106 | *
|
---|
| 107 | * Side effects:
|
---|
| 108 | * The command is recorded and executed.
|
---|
| 109 | *
|
---|
| 110 | *----------------------------------------------------------------------
|
---|
| 111 | */
|
---|
| 112 |
|
---|
| 113 | int
|
---|
| 114 | Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
|
---|
| 115 | Tcl_Interp *interp; /* Token for interpreter in which command
|
---|
| 116 | * will be executed. */
|
---|
| 117 | Tcl_Obj *cmdPtr; /* Points to object holding the command to
|
---|
| 118 | * record and execute. */
|
---|
| 119 | int flags; /* Additional flags. TCL_NO_EVAL means
|
---|
| 120 | * record only: don't execute the command.
|
---|
| 121 | * TCL_EVAL_GLOBAL means use
|
---|
| 122 | * Tcl_GlobalEvalObj instead of
|
---|
| 123 | * Tcl_EvalObj. */
|
---|
| 124 | {
|
---|
| 125 | Interp *iPtr = (Interp *) interp;
|
---|
| 126 | int result;
|
---|
| 127 | Tcl_Obj *list[3];
|
---|
| 128 | register Tcl_Obj *objPtr;
|
---|
| 129 |
|
---|
| 130 | /*
|
---|
| 131 | * Do recording by eval'ing a tcl history command: history add $cmd.
|
---|
| 132 | */
|
---|
| 133 |
|
---|
| 134 | list[0] = Tcl_NewStringObj("history", -1);
|
---|
| 135 | list[1] = Tcl_NewStringObj("add", -1);
|
---|
| 136 | list[2] = cmdPtr;
|
---|
| 137 |
|
---|
| 138 | objPtr = Tcl_NewListObj(3, list);
|
---|
| 139 | Tcl_IncrRefCount(objPtr);
|
---|
| 140 | (void) Tcl_GlobalEvalObj(interp, objPtr);
|
---|
| 141 | Tcl_DecrRefCount(objPtr);
|
---|
| 142 |
|
---|
| 143 | /*
|
---|
| 144 | * Execute the command.
|
---|
| 145 | */
|
---|
| 146 |
|
---|
| 147 | result = TCL_OK;
|
---|
| 148 | if (!(flags & TCL_NO_EVAL)) {
|
---|
| 149 | iPtr->evalFlags = (flags & ~TCL_EVAL_GLOBAL);
|
---|
| 150 | if (flags & TCL_EVAL_GLOBAL) {
|
---|
| 151 | result = Tcl_GlobalEvalObj(interp, cmdPtr);
|
---|
| 152 | } else {
|
---|
| 153 | result = Tcl_EvalObj(interp, cmdPtr);
|
---|
| 154 | }
|
---|
| 155 | }
|
---|
| 156 | return result;
|
---|
| 157 | }
|
---|