[25] | 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 of |
---|
| 13 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 14 | * |
---|
| 15 | * RCS: @(#) $Id: tclHistory.c,v 1.10 2007/04/10 14:47:15 dkf Exp $ |
---|
| 16 | */ |
---|
| 17 | |
---|
| 18 | #include "tclInt.h" |
---|
| 19 | |
---|
| 20 | /* |
---|
| 21 | *---------------------------------------------------------------------- |
---|
| 22 | * |
---|
| 23 | * Tcl_RecordAndEval -- |
---|
| 24 | * |
---|
| 25 | * This procedure adds its command argument to the current list of |
---|
| 26 | * recorded events and then executes the command by calling Tcl_Eval. |
---|
| 27 | * |
---|
| 28 | * Results: |
---|
| 29 | * The return value is a standard Tcl return value, the result of |
---|
| 30 | * executing cmd. |
---|
| 31 | * |
---|
| 32 | * Side effects: |
---|
| 33 | * The command is recorded and executed. |
---|
| 34 | * |
---|
| 35 | *---------------------------------------------------------------------- |
---|
| 36 | */ |
---|
| 37 | |
---|
| 38 | int |
---|
| 39 | Tcl_RecordAndEval( |
---|
| 40 | Tcl_Interp *interp, /* Token for interpreter in which command will |
---|
| 41 | * be executed. */ |
---|
| 42 | CONST char *cmd, /* Command to record. */ |
---|
| 43 | int flags) /* Additional flags. TCL_NO_EVAL means only |
---|
| 44 | * record: don't execute command. |
---|
| 45 | * TCL_EVAL_GLOBAL means use Tcl_GlobalEval |
---|
| 46 | * instead of Tcl_Eval. */ |
---|
| 47 | { |
---|
| 48 | register Tcl_Obj *cmdPtr; |
---|
| 49 | int length = strlen(cmd); |
---|
| 50 | int result; |
---|
| 51 | |
---|
| 52 | if (length > 0) { |
---|
| 53 | /* |
---|
| 54 | * Call Tcl_RecordAndEvalObj to do the actual work. |
---|
| 55 | */ |
---|
| 56 | |
---|
| 57 | cmdPtr = Tcl_NewStringObj(cmd, length); |
---|
| 58 | Tcl_IncrRefCount(cmdPtr); |
---|
| 59 | result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); |
---|
| 60 | |
---|
| 61 | /* |
---|
| 62 | * Move the interpreter's object result to the string result, then |
---|
| 63 | * reset the object result. |
---|
| 64 | */ |
---|
| 65 | |
---|
| 66 | (void) Tcl_GetStringResult(interp); |
---|
| 67 | |
---|
| 68 | /* |
---|
| 69 | * Discard the Tcl object created to hold the command. |
---|
| 70 | */ |
---|
| 71 | |
---|
| 72 | Tcl_DecrRefCount(cmdPtr); |
---|
| 73 | } else { |
---|
| 74 | /* |
---|
| 75 | * An empty string. Just reset the interpreter's result. |
---|
| 76 | */ |
---|
| 77 | |
---|
| 78 | Tcl_ResetResult(interp); |
---|
| 79 | result = TCL_OK; |
---|
| 80 | } |
---|
| 81 | return result; |
---|
| 82 | } |
---|
| 83 | |
---|
| 84 | /* |
---|
| 85 | *---------------------------------------------------------------------- |
---|
| 86 | * |
---|
| 87 | * Tcl_RecordAndEvalObj -- |
---|
| 88 | * |
---|
| 89 | * This procedure adds the command held in its argument object to the |
---|
| 90 | * current list of recorded events and then executes the command by |
---|
| 91 | * calling Tcl_EvalObj. |
---|
| 92 | * |
---|
| 93 | * Results: |
---|
| 94 | * The return value is a standard Tcl return value, the result of |
---|
| 95 | * executing the command. |
---|
| 96 | * |
---|
| 97 | * Side effects: |
---|
| 98 | * The command is recorded and executed. |
---|
| 99 | * |
---|
| 100 | *---------------------------------------------------------------------- |
---|
| 101 | */ |
---|
| 102 | |
---|
| 103 | int |
---|
| 104 | Tcl_RecordAndEvalObj( |
---|
| 105 | Tcl_Interp *interp, /* Token for interpreter in which command will |
---|
| 106 | * be executed. */ |
---|
| 107 | Tcl_Obj *cmdPtr, /* Points to object holding the command to |
---|
| 108 | * record and execute. */ |
---|
| 109 | int flags) /* Additional flags. TCL_NO_EVAL means record |
---|
| 110 | * only: don't execute the command. |
---|
| 111 | * TCL_EVAL_GLOBAL means evaluate the script |
---|
| 112 | * in global variable context instead of the |
---|
| 113 | * current procedure. */ |
---|
| 114 | { |
---|
| 115 | int result, call = 1; |
---|
| 116 | Tcl_Obj *list[3]; |
---|
| 117 | register Tcl_Obj *objPtr; |
---|
| 118 | Tcl_CmdInfo info; |
---|
| 119 | |
---|
| 120 | /* |
---|
| 121 | * Do not call [history] if it has been replaced by an empty proc |
---|
| 122 | */ |
---|
| 123 | |
---|
| 124 | result = Tcl_GetCommandInfo(interp, "history", &info); |
---|
| 125 | |
---|
| 126 | if (result && (info.objProc == TclObjInterpProc)) { |
---|
| 127 | Proc *procPtr = (Proc *)(info.objClientData); |
---|
| 128 | call = (procPtr->cmdPtr->compileProc != TclCompileNoOp); |
---|
| 129 | } |
---|
| 130 | |
---|
| 131 | if (call) { |
---|
| 132 | |
---|
| 133 | /* |
---|
| 134 | * Do recording by eval'ing a tcl history command: history add $cmd. |
---|
| 135 | */ |
---|
| 136 | |
---|
| 137 | TclNewLiteralStringObj(list[0], "history"); |
---|
| 138 | TclNewLiteralStringObj(list[1], "add"); |
---|
| 139 | list[2] = cmdPtr; |
---|
| 140 | |
---|
| 141 | objPtr = Tcl_NewListObj(3, list); |
---|
| 142 | Tcl_IncrRefCount(objPtr); |
---|
| 143 | (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); |
---|
| 144 | Tcl_DecrRefCount(objPtr); |
---|
| 145 | |
---|
| 146 | /* |
---|
| 147 | * One possible failure mode above: exceeding a resource limit. |
---|
| 148 | */ |
---|
| 149 | |
---|
| 150 | if (Tcl_LimitExceeded(interp)) { |
---|
| 151 | return TCL_ERROR; |
---|
| 152 | } |
---|
| 153 | } |
---|
| 154 | |
---|
| 155 | /* |
---|
| 156 | * Execute the command. |
---|
| 157 | */ |
---|
| 158 | |
---|
| 159 | result = TCL_OK; |
---|
| 160 | if (!(flags & TCL_NO_EVAL)) { |
---|
| 161 | result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL); |
---|
| 162 | } |
---|
| 163 | return result; |
---|
| 164 | } |
---|
| 165 | |
---|
| 166 | /* |
---|
| 167 | * Local Variables: |
---|
| 168 | * mode: c |
---|
| 169 | * c-basic-offset: 4 |
---|
| 170 | * fill-column: 78 |
---|
| 171 | * End: |
---|
| 172 | */ |
---|