/* Agent Tcl
 * Bob Gray
 * 25 January 1995
 *
 * *** NOT PART OF THE STANDARD TCL DISTRIBUTION ***
 *
 * tclStateSave.c --
 * 
 *      This file contains a collection of procedures that are used to 
 *      save the state of an executing TCL script.
 *   
 * This is part of the code that is used to capture and restore the interal
 * state of an executing Tcl script. 
 * 
 * Copyright (c) 1995, Robert S. Gray, Dartmouth College
 *
 * See the file "agent.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include <stdio.h>

static int TclSaveVariableTable _ANSI_ARGS_((Tcl_HashTable *table, Tcl_DString * state));
static int TclSaveRefTable _ANSI_ARGS_((Tcl_HashTable *table, Tcl_DString * state));
static int TclSaveVariable _ANSI_ARGS_((char *name, Var *data, Tcl_DString *state));
static int TclSaveCallFrames _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *state));
static int TclSaveProcedure _ANSI_ARGS_((char *name, Proc *procedure, Tcl_DString *state));
static int TclSaveProcedureTable _ANSI_ARGS_((Tcl_HashTable *commands, Tcl_DString *state));
static int TclSaveStack _ANSI_ARGS_((Stack *stack, Tcl_DString *state));
static int TclSaveGlobals _ANSI_ARGS_((Interp *interp, Tcl_DString *state));
static void TclSaveProcedureAsScript _ANSI_ARGS_((char *name, Proc *proc, Tcl_DString *script));
static void TclSaveVariableAsScript _ANSI_ARGS_((char *name, Var *var, Tcl_DString *script));
 
/* TclSaveProcedureTable

   Purpose:

     Input:

    Output:
*/


static int TclSaveProcedure (name, procedure, state)
     char *name;
     Proc *procedure;
     Tcl_DString *state;
{
  Arg *arg;                 /* argument information                */
  char temp[64];            /* scratch array for state information */           

  Tcl_DStringStartSublist (state);
  Tcl_DStringAppendElement (state, name);

  sprintf (temp, "%d", procedure -> refCount);
  Tcl_DStringAppendElement (state, temp);

  Tcl_DStringStartSublist (state);

  for (arg = procedure -> argPtr; arg != NULL; arg = arg -> nextPtr) {

    Tcl_DStringAppendElement (state, arg -> name); 
        
    if (arg -> defValue == NULL) {
      Tcl_DStringAppendElement (state, "_NO_DEFAULT_");
    } else {
      Tcl_DStringAppendElement (state, "_DEFAULT_");
      Tcl_DStringAppendElement (state, arg -> defValue);
    }
  }

  Tcl_DStringEndSublist (state);
  Tcl_DStringAppendElement (state, procedure -> command);
  Tcl_DStringEndSublist (state); 
  return TCL_OK;
}

static int TclSaveProcedureTable (commands, state)
     Tcl_HashTable *commands;
     Tcl_DString *state;
{
  Tcl_HashEntry *entry;     /* an entry in the command hash table  */ 
  Tcl_HashSearch search;    /* the hash table searcher             */
  Command *command;         /* command information                 */

  Tcl_DStringStartSublist (state);

  for (entry = Tcl_FirstHashEntry (commands, &search); entry != NULL; entry = Tcl_NextHashEntry(&search))
  {
    command = (Command *) entry -> clientData;

    if (TclIsProc(command) && !TclIsProcGlued(command)) {
      TclSaveProcedure (entry -> key.string, (Proc *) command -> clientData, state);
    }
  }

  Tcl_DStringEndSublist (state);
  return TCL_OK;
}

/* TclSaveStack

   Purpose:

     Input:

    Output:
*/

static int TclSaveStack (stack, state)
     Stack *stack;
     Tcl_DString *state;
{
  Stack_Element *element;
  char tmp[60]; 
  int i, j;

  Tcl_DStringStartSublist (state); 

  for (i = 0; i <= stack -> top; i++)
  {
    element = stack -> slots[i];
    Tcl_DStringStartSublist (state);

    sprintf (tmp, "%d", element -> flag);
    Tcl_DStringAppendElement (state, tmp);

    sprintf (tmp, "%d", element -> substitution);
    Tcl_DStringAppendElement (state, tmp);

    if (element -> evalFlags & TCL_BRACKET_TERM)
      Tcl_DStringAppendElement (state, "_BRACKET_");
    else
      Tcl_DStringAppendElement (state, "_NO_");

    if (element -> evalFlags & TCL_RECORD_BOUNDS)
      Tcl_DStringAppendElement (state, "_RECORD_");
    else
      Tcl_DStringAppendElement (state, "_NO_");

    if (element -> evalFlags & TCL_ALLOW_EXCEPTIONS)
      Tcl_DStringAppendElement (state, "_EXCEPTION_");
    else
      Tcl_DStringAppendElement (state, "_NO_");

    Tcl_DStringStartSublist (state);
 
    for (j = 0; j < element -> argc; j++)
      Tcl_DStringAppendElement (state, element -> argv[j]); 

    Tcl_DStringAppendElement (state, element -> rest);  
    Tcl_DStringEndSublist (state);
    Tcl_DStringEndSublist (state);
  }

  Tcl_DStringEndSublist (state);
  return TCL_OK;
}

/* TclSaveVariableTable

   Purpose:
  
     Input: 

    Output:
*/

static int TclSaveVariable (name, data, state)
     char *name;
     Var *data;
     Tcl_DString *state;
{
  char temp[32];

	/* don't save if VAR_NO_TRANSFER and no reference count */

  if ((data -> flags & VAR_NO_TRANSFER) && (data -> refCount == 0)) {
	return TCL_OK;
  }

	/* otherwise start the variable entry */

  Tcl_DStringStartSublist (state);

    /* undefined or defined */

  if ((data -> flags & VAR_UNDEFINED) || (data -> flags & VAR_NO_TRANSFER)) {
    Tcl_DStringAppendElement (state, "_UNDEFINED_");
  } else {
    Tcl_DStringAppendElement (state, "_DEFINED_");
  }

    /* name and reference count */
 
  Tcl_DStringAppendElement (state, name);
  sprintf (temp, "%d", data -> refCount);
  Tcl_DStringAppendElement (state, temp);

    /* upvar OR array OR value */
 
  if (data -> flags & VAR_UPVAR) {

    Tcl_DStringAppendElement (state, "_UPVAR_");

	if (data -> value.upvarPtr -> hPtr == NULL) {
	  sprintf (temp, "0");
    } else {
      sprintf (temp, "%ld", data -> value.upvarPtr);
    }

    Tcl_DStringAppendElement (state, temp);

  } else if (data -> flags & VAR_ARRAY) {

    Tcl_DStringAppendElement (state, "_ARRAY_");
 
    if (data -> flags & VAR_NO_TRANSFER) {
      if (TclSaveRefTable (data -> value.tablePtr, state) != TCL_OK) {
 	return TCL_ERROR;
      }
    } else {
      if (TclSaveVariableTable (data -> value.tablePtr, state) != TCL_OK) {
        return TCL_ERROR;
      }
    }
      
  } else {

    Tcl_DStringAppendElement (state, "_VALUE_");

    if ((data -> flags & VAR_UNDEFINED) || (data -> flags & VAR_NO_TRANSFER)) {
      Tcl_DStringAppendElement (state, "");
    } else {
      Tcl_DStringAppendElement (state, data -> value.string);
    }
  }

    /* if the reference count is greater than 0, output a unique id for */
    /* this variable; this is the same value that will appear after the */
    /* _UPVAR_ flag in those variable entries that refer to this one    */

  if (data -> refCount > 0) {
    sprintf (temp, "%ld", data);  
    Tcl_DStringAppendElement (state, temp);
  }
  
  Tcl_DStringEndSublist (state);
  return TCL_OK;
}        

static int TclSaveRefTable (table, state)
     Tcl_HashTable *table;
     Tcl_DString *state;
{
  char temp[32];
  Var *variable;            /* variable information                 */
  Tcl_HashEntry *entry;     /* entry in the hash table              */
  Tcl_HashSearch search;    /* hash table search information        */

  Tcl_DStringStartSublist (state);

     /* loop through every variable  in the variable table */
 
  for (entry = Tcl_FirstHashEntry (table, &search); entry != NULL; entry = Tcl_NextHashEntry (&search))
  {
	variable = (Var *) Tcl_GetHashValue (entry);

      /* save the variable if the ref count is greater than 0 */

	if (variable -> refCount > 0) {

	    /* UNDEFINED since the parent array is glued */

	  Tcl_DStringStartSublist (state);
      Tcl_DStringAppendElement (state, "_UNDEFINED_");

        /* name and reference count */
 
      Tcl_DStringAppendElement (state, entry -> key.string);
      sprintf (temp, "%d", variable -> refCount);
      Tcl_DStringAppendElement (state, temp);

	    /* value */

      Tcl_DStringAppendElement (state, "_VALUE_");
      Tcl_DStringAppendElement (state, "");

		/* UPVAR pointer */

      sprintf (temp, "%ld", variable);  
      Tcl_DStringAppendElement (state, temp);
	  Tcl_DStringEndSublist (state);
    }
  }

  Tcl_DStringEndSublist (state); 
  return TCL_OK;
}

static int TclSaveVariableTable (table, state)
     Tcl_HashTable *table;
     Tcl_DString *state;
{
  Tcl_HashEntry *entry;     /* entry in the hash table              */
  Tcl_HashSearch search;    /* hash table search information        */
  Tcl_DString upvar_state;  /* UPVARS must appear last in the state */
  Var *variable;            /* variable information                 */

  Tcl_DStringInit (&upvar_state);
  Tcl_DStringStartSublist (state);

     /* loop through every variable  in the variable table */
 
  for (entry = Tcl_FirstHashEntry (table, &search); entry != NULL; entry = Tcl_NextHashEntry (&search))
  {
      /* save the variable */

    variable = (Var *) entry -> clientData;

    if (variable -> flags & VAR_UPVAR) {
      TclSaveVariable (entry -> key.string, variable, &upvar_state);
    } else {
      TclSaveVariable (entry -> key.string, variable, state);
    }
  }

  Tcl_DStringAppend (state, " ", 1); 
  Tcl_DStringAppend (state, Tcl_DStringValue (&upvar_state), -1);
  Tcl_DStringEndSublist (state); 
  Tcl_DStringFree (&upvar_state);
  return TCL_OK;
}

/* TclSaveCallFrames

   Purpose:
  
     Input:

    Output:
*/

static int TclSaveCallFrames (interp, state)
     Tcl_Interp *interp;
     Tcl_DString *state;
{
  Interp *iPtr     = (Interp *) interp;
  CallFrame *frame = iPtr -> framePtr; 
  char temp[10];      

  Tcl_DStringStartSublist (state);

    /* save the level of the current variable frame */

  if (iPtr -> varFramePtr == NULL) {
    sprintf (temp, "0");
  } else {
    sprintf (temp, "%d", iPtr -> varFramePtr -> level);
  }

  Tcl_DStringAppendElement (state, temp);

    /* save the frames */

  while (frame != NULL) {

    Tcl_DStringStartSublist (state);
 
    sprintf (temp, "%d", frame -> varLevel);
    Tcl_DStringAppendElement (state, temp);

    if (frame -> callerVarPtr == NULL) {
      Tcl_DStringAppendElement (state, "0");
    } else {
      sprintf (temp, "%d", frame -> callerVarPtr -> level);
      Tcl_DStringAppendElement (state, temp);
    }

    if (TclSaveVariableTable(&frame -> varTable, state) != TCL_OK) {
      return TCL_ERROR;
    }

    sprintf (temp, "%d", frame -> stackIndex);
    Tcl_DStringAppendElement (state, temp);
    Tcl_DStringEndSublist (state);    
    frame = frame -> callerPtr; 
  }

  Tcl_DStringEndSublist (state);
  return TCL_OK;
}

/* TclSaveGlobals

   Purpose: Save global information 

     Input: iPtr  = the Tcl interpreter
            state = the state string

    Output: The procedure adds the global information to the state string.
            Global information consists of the result and return codes,
            the result and error strings, the error line, the global flags, 
            the numeric format and precision, the command count, and the name
            of the current script.
*/

static int TclSaveGlobals (iPtr, state)
     Interp *iPtr;
     Tcl_DString *state;
{
  char temp[60];
  Tcl_DStringStartSublist (state);
 
    /*  1. result code */
 
  sprintf (temp, "%d", iPtr -> resultCode);             
  Tcl_DStringAppendElement (state, temp);

    /*  2. return code */

  sprintf (temp, "%d", iPtr -> returnCode);             
  Tcl_DStringAppendElement (state, temp);

    /*  3. result */

  if (iPtr -> result == NULL) {
    Tcl_DStringAppendElement (state, "_NO_RESULT_");
  } else {
    Tcl_DStringAppendElement (state, "_RESULT_");
    Tcl_DStringAppendElement (state, iPtr -> result);  
  }

    /*  4. error info */

  if (iPtr -> errorInfo == NULL) {
    Tcl_DStringAppendElement (state, "_NO_INFO_");
  } else {
    Tcl_DStringAppendElement (state, "_INFO_");
    Tcl_DStringAppendElement (state, iPtr -> errorInfo);
  }

    /*  5. error code */

  if (iPtr -> errorCode == NULL) {
    Tcl_DStringAppendElement (state, "_NO_CODE_");
  } else {
    Tcl_DStringAppendElement (state, "_CODE_");
    Tcl_DStringAppendElement (state, iPtr -> errorCode);
  }

    /*  6. error line */

  sprintf (temp, "%d", iPtr -> errorLine);              
  Tcl_DStringAppendElement (state, temp);      

    /*  7. DELETED            flag */
    /*  8. ERR_IN_PROGRESS    flag */
    /*  9. ERR_ALREADY_LOGGED flag */
    /* 10. ERROR_CODE_SET     flag */

  if (iPtr -> flags & DELETED) {
    Tcl_DStringAppendElement (state, "_DELETED_");
  } else {
    Tcl_DStringAppendElement (state, "_NO_");
  }

  if (iPtr -> flags & ERR_IN_PROGRESS) {
    Tcl_DStringAppendElement (state, "_ERR_IN_PROGRESS_");
  } else {
    Tcl_DStringAppendElement (state, "_NO_");
  }

  if (iPtr -> flags & ERR_ALREADY_LOGGED) {
    Tcl_DStringAppendElement (state, "_ERR_ALREADY_LOGGED_");
  } else {
    Tcl_DStringAppendElement (state, "_NO_");
  }

  if (iPtr -> flags & ERROR_CODE_SET) {
    Tcl_DStringAppendElement (state, "_ERROR_CODE_SET_");
  } else {
    Tcl_DStringAppendElement (state, "_NO_");
  }

    /* 11. filename of the current script */
 
  if (iPtr -> scriptFile == NULL) {
    Tcl_DStringAppendElement (state, "_NO_SCRIPT_");
  } else {
    Tcl_DStringAppendElement (state, "_SCRIPT_");
    Tcl_DStringAppendElement (state, iPtr -> scriptFile);
  }

    /* 12. format string     */
    /* 13. numeric precision */
  
  Tcl_DStringAppendElement (state, iPtr -> pdFormat);
  sprintf (temp, "%d", iPtr -> pdPrec);
  Tcl_DStringAppendElement (state, temp);
 
    /* 14. command count */

  sprintf (temp, "%d", iPtr -> cmdCount);
  Tcl_DStringAppendElement (state, temp);

    /* 15. noEval flag */

  sprintf (temp, "%d", iPtr -> noEval);
  Tcl_DStringAppendElement (state, temp);
  Tcl_DStringEndSublist (state); 
  return TCL_OK;
}
  
/* Tcl_SaveState

   Purpose:

     Input:
  
    Output:  
*/

Tcl_DString *Tcl_SaveState (interp, error)
     Tcl_Interp *interp;
     Tcl_DString *error;
{
  Interp *iptr;
  Stack *stack;
  Tcl_DString *state;
  Stack_Element *element;
#ifdef TCL_STATE_HANDLERS
  int i;
  int code;
  ClientData data;
  Tcl_StateProc *proc;
  EXTENSION_STATE *extension;
#endif

    /* get the stack element */

  iptr    = (Interp *) interp;
  stack   = &iptr -> execution_stack;
  element = stack -> slots[stack -> top];

    /* check that the state can be saved */

  if (!(element -> commandFlags & TCL_INTERRUPT)) {
    Tcl_DStringAppend (error, ":script is not interruptable", -1);
    return NULL;
  }

    /* store the state */

  state = (Tcl_DString *) ckalloc ((unsigned long) sizeof(Tcl_DString));
  Tcl_DStringInit (state);

  if (TclSaveVariableTable (&iptr -> globalTable, state) != TCL_OK) {
    Tcl_DStringAppend (error, ":unable to save global variables ", -1);
    Tcl_DStringFree (state);
    ckfree ((char *) state);
    return NULL;
  }

  if (TclSaveCallFrames (interp, state) != TCL_OK) {
    Tcl_DStringAppend (error, ":unable to store call frames ", -1);
    Tcl_DStringFree (state);
    ckfree ((char *) state);
    return NULL;
  }
  
  if (TclSaveProcedureTable (&iptr -> commandTable, state) != TCL_OK) {
    Tcl_DStringAppend (error, ":unable to store proccedires ", -1);
    Tcl_DStringFree (state);
    ckfree ((char *) state);
    return NULL;
  }

  if (TclSaveStack (&iptr -> execution_stack, state) != TCL_OK) {
    Tcl_DStringAppend (error, ":unable to store execution stack: ", -1);
    Tcl_DStringFree (state);
    ckfree ((char *) state);
    return NULL;
  }

  if (TclSaveGlobals (iptr, state) != TCL_OK) {
    Tcl_DStringAppend (error, ":unable to save global information ", -1);
    Tcl_DStringFree (state);
    ckfree ((char *) state);
    return NULL;
  }

  if (TclSaveVariableTable (&iptr -> stateTable, state) != TCL_OK) {
    Tcl_DStringAppend (error, ":unable to save state variables", -1);
    Tcl_DStringFree (state);
    ckfree ((char *) state);
    return NULL;
  }

#ifdef TCL_STATE_HANDLERS

    /* save the state of each extension that has registered a state handler */

  if (iptr -> handlers.n != 0) {

    extension = (EXTENSION_STATE *) ckalloc ((unsigned) sizeof(EXTENSION_STATE));
    extension -> name = NULL;
    Tcl_DStringInit (&extension -> state);
    Tcl_DStringInit (&extension -> error);

    for (i = 0; i < iptr -> handlers.n; i++) {

      proc = iptr -> handlers.slots[i].proc;
      data = iptr -> handlers.slots[i].data;

      if ((code = (*proc)(interp, data, extension)) != TCL_OK) {
	Tcl_DStringAppend (error, Tcl_DStringValue(&extension -> error), -1);
        Tcl_DStringFree (state);
        ckfree ((char *) state);
        return NULL;
      } else {
        char temp[16];
        Tcl_DStringStartSublist (state);
        Tcl_DStringAppendElement (state, extension -> name);
	sprintf (temp, "%d", extension -> major);
	Tcl_DStringAppendElement (state, temp);
	sprintf (temp, "%d", extension -> minor);
	Tcl_DStringAppendElement (state, temp);
	sprintf (temp, "%s", (extension -> type == TCL_ALPHA) ? "ALPHA" : (extension -> type == TCL_BETA) ? "BETA" : "PRODUCTION");
	Tcl_DStringAppendElement (state, temp);
	Tcl_DStringAppendElement (state, Tcl_DStringValue(&extension -> state));
	Tcl_DStringEndSublist (state);
      }

      Tcl_DStringFree (&extension -> state);
      Tcl_DStringFree (&extension -> error);
    }

    ckfree ((void *) extension);
  }

#endif   /* TCL_STATE_HANDLERS */

  return state;
}

/* Tcl_SaveProcedureAsScript

   Purpose: Save a procedure as a Tcl script

     Input: name = name of the procedure
            proc = procedure arguments and body

    Output: The procedure saves the procedure as a Tcl script and appends the
            script to the dynamic string "script".
*/

static void TclSaveProcedureAsScript (name, proc, script)
     char *name;
     Proc *proc;
     Tcl_DString *script;
{
  Arg *arg;  /* pointer to a procedure argument */

    /* PROC and procedure name */

  Tcl_DStringAppendElement (script, "proc");
  Tcl_DStringAppendElement (script, name);

    /* the arguments */

  Tcl_DStringStartSublist (script);

  for (arg = proc -> argPtr; arg != NULL; arg = arg -> nextPtr) {
    if (arg -> defValue == NULL) {
      Tcl_DStringAppendElement (script, arg -> name);
    } else {
      Tcl_DStringStartSublist (script);
      Tcl_DStringAppendElement (script, arg -> name);
      Tcl_DStringAppendElement (script, arg -> defValue);
      Tcl_DStringEndSublist (script);
    }
  }

  Tcl_DStringEndSublist (script);

    /* the procedure body */

  Tcl_DStringAppendElement (script, proc -> command);
  Tcl_DStringAppend (script, "\n", 1); 
}

/* Tcl_SaveProcedureList

   Purpose: Save a set of procedures as a Tcl script

     Input: interp         = the current interpreter
            numProcedures  = number of procedures
            procedureNames = names of the procedures

    Output: The procedure returns TCL_ERROR and sets the interpreter result to
            an appropriate error message on error.  Otherwise the procedure
	    returns TCL_OK, saves the set of procedures as a Tcl script and
            appends this script to the dynamic string "script".
*/
 
int Tcl_SaveProcedureList (interp, numProcedures, procedureNames, script)
     Tcl_Interp *interp;
     int numProcedures;
     char **procedureNames;
     Tcl_DString *script;
{
  Interp *iPtr = (Interp *) interp;
  Tcl_HashEntry *entry;
  Command *command;
  register int i;

    /* save the arguments and body of each procedure */

  for (i = 0; i < numProcedures; i++)
  {
    if ((entry = Tcl_FindHashEntry (&iPtr -> commandTable, procedureNames[i])) == NULL) {
      Tcl_AppendResult (interp, "command \"", procedureNames[i], "\" does NOT exist", (char *) NULL);
      return TCL_ERROR;
    }

    command = (Command *) entry -> clientData;

    if (!TclIsProc(command)) {
      Tcl_AppendResult (interp, "command \"", procedureNames[i], "\" is NOT a Tcl procedure", (char *) NULL);
      return TCL_ERROR;
    } else if (TclIsProcGlued(command)) {
      Tcl_AppendResult (interp, "procedure \"", procedureNames[i], "\" is IMMOBILE", (char *) NULL);
      return TCL_ERROR;
    }

    TclSaveProcedureAsScript (entry -> key.string, (Proc *) command -> clientData, script);   
  }

  return TCL_OK;
}

/* Tcl_SaveVariableAsScript

   Purpose: Save a variable as a Tcl script

     Input: name = name of the variable
            var  = variable information
           
    Output: The procedure saves the variable as a Tcl script and appends the
            script to the dynamic string "script".
*/

static void TclSaveVariableAsScript (name, var, script)
     char *name;
     Var *var;
     Tcl_DString *script;
{
  Tcl_HashTable *table;
  Tcl_HashEntry *entry;
  Tcl_HashSearch search;
  Var *element;

  if (var -> flags & VAR_ARRAY) {

      /* save an array */

    table = var -> value.tablePtr;
   
    for (entry = Tcl_FirstHashEntry (table, &search); entry != NULL; entry = Tcl_NextHashEntry (&search)) {
      
         /* save the array element */

      element = (Var *) entry -> clientData;

      if (!(element -> flags & VAR_UNDEFINED) && !TclIsVarGlued(element)) {
        Tcl_DStringAppendElement (script, "set");
        Tcl_DStringStartSublist (script);
        Tcl_DStringAppend (script, name, strlen(name));
        Tcl_DStringAppend (script, "(", 1);
        Tcl_DStringAppend (script, entry -> key.string, strlen(entry -> key.string));
        Tcl_DStringAppend (script, ")", 1);
        Tcl_DStringEndSublist (script);
        Tcl_DStringAppendElement (script, element -> value.string);
        Tcl_DStringAppend (script, "\n", 1);  
      }
    }
  } else {

     /* save a scalar */

   Tcl_DStringAppendElement (script, "set");
   Tcl_DStringAppendElement (script, name);
   Tcl_DStringAppendElement (script, var -> value.string);
   Tcl_DStringAppend (script, "\n", 1);  
  }
}

/* Tcl_SaveVariableList

   Purpose: Save a set of variables as a Tcl script

     Input: interp        = the current interpreter
            numVariables  = number of variables
            variableNames = names of the variables

    Output: The procedure returns TCL_ERROR and sets the interpreter result to
	    an appropriate error message on error.  Otherwise the procedure
            returns TCL_OK, saves the set of variables as a Tcl script and
            appends this script to the dynamic string "script".
*/

int Tcl_SaveVariableList (interp, numVariables, variableNames, script)
     Tcl_Interp *interp;
     int numVariables;
     char **variableNames;
     Tcl_DString *script;
{
  Var *variable;
  Interp *iPtr = (Interp *) interp;
  Tcl_HashEntry *entry;
  Tcl_HashTable *table;
  register int i;

    /* select the appropriate table */

  if (iPtr -> varFramePtr == NULL) {
    table = &iPtr -> globalTable;
  } else {
    table = &iPtr -> varFramePtr -> varTable;
  }

    /* save each variable */

  for (i = 0; i < numVariables; i++) {
    if ((entry = Tcl_FindHashEntry (table, variableNames[i])) == NULL)
    {
      Tcl_AppendResult (interp, "can't read \"", variableNames[i], "\": no such variable", (char *) NULL);
      return TCL_ERROR;
    }

    variable = (Var *) entry -> clientData;

    while (variable -> flags & VAR_UPVAR) {
      variable = variable -> value.upvarPtr;
    }

    if (variable -> flags & VAR_UNDEFINED) {
      Tcl_AppendResult (interp, "can't read \"", variableNames[i], "\": no such variable", (char *) NULL);
      return TCL_ERROR;
    }

    if (TclIsVarGlued (variable)) {
      Tcl_AppendResult (interp, "variable \"", variableNames[i], "\" is IMMOBILE", (char *) NULL);
      return TCL_ERROR;
    }

    TclSaveVariableAsScript (entry -> key.string, variable, script);
  }

  return TCL_OK;
}

int Tcl_SavestateCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp *interp;
     int argc;
     char **argv;
{
  Tcl_DString *state;
  Tcl_DString error;
  Tcl_DStringInit (&error);

  if (argc != 1)
  {
    Tcl_AppendResult (interp, "wrong # of args: should be \"", argv[0], "\"", (char *) NULL);
    return TCL_ERROR;
  }  

  if ((state = Tcl_SaveState (interp, &error)) == NULL)
  {
    Tcl_AppendResult (interp, Tcl_DStringValue(&error), (char *) NULL); 
    return TCL_ERROR;
  }

  Tcl_DStringResult (interp, state);
  ckfree ((char *) state);
  return TCL_OK;
}

/* Tcl_SaveProcsCmd

   Tcl syntax: saveprocs proc [proc proc ...]

      Purpose: Save a set of procedures as a Tcl script

        Input: dummy  = client data (unused)
               interp = the current interpreter
               argc   = the number of command arguments
               argv   = the command arguments

       Output: The procedure returns TCL_ERROR and sets the interpreter result
               to an appropriate error message on error.  Otherwise the
               procedure returns TCL_OK and sets the interpreter result to a
               Tcl script that contains a "proc" definition for each procedure.
*/
 
int Tcl_SaveprocsCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp *interp;
     int argc;
     char **argv;
{
  Tcl_DString script;

    /* check the number of arguments */

  if (argc <= 1) {
    Tcl_AppendResult (interp, "wrong # of args: should be \"saveprocs procname ...\"", (char *) NULL);
    return TCL_ERROR;
  }

    /* set up the dynmaic string */

  Tcl_DStringInit (&script);

  if (Tcl_SaveProcedureList (interp, argc - 1, argv + 1, &script) != TCL_OK) {
    Tcl_AppendResult (interp, ": unable to save procedures", (char *) NULL);
    Tcl_DStringFree (&script);
    return TCL_ERROR;
  }

  Tcl_DStringResult (interp, &script);
  Tcl_DStringFree (&script);
  return TCL_OK;
}

/* Tcl_SavevarsCmd

   Tcl syntax: savevars var [var var ...]

      Purpose: Save a set of variables as a Tcl script

        Input: dummy  = client data (unused)
               interp = the current interpreter
               argc   = number of command arguments
               argv   = the command arguments

       Output: The procedure returns TCL_ERROR and sets the interpreter
               result to an appropriate error message on error.  Otherwise
               the procedure returns TCL_OK and sets the interpreter result
               to a Tcl script that contains one or more set statements for
               each listed variable.
*/
    
int Tcl_SavevarsCmd (clientData, interp, argc, argv)
     ClientData clientData;
     Tcl_Interp *interp;
     int argc;
     char **argv;
{
  Tcl_DString script;

    /* check the number of arguments */

  if (argc <= 1) {
    Tcl_AppendResult (interp, "wrong # of args: should be \"savevars varname ...\"", (char *) NULL);
    return TCL_ERROR;
  }

    /* save the variables */

  Tcl_DStringInit (&script);

  if (Tcl_SaveVariableList (interp, argc - 1, argv + 1, &script) != TCL_OK) {
    Tcl_AppendResult (interp, ": unable to save variables", (char *) NULL);
    Tcl_DStringFree (&script);
    return TCL_ERROR;
  }

  Tcl_DStringResult (interp, &script);
  Tcl_DStringFree (&script);
  return TCL_OK;
}
