home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / generic / tclHistory.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  4.0 KB  |  156 lines  |  [TEXT/CWIE]
  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.  * SCCS: @(#) tclHistory.c 1.47 97/08/04 16:08:17
  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. }
  156.