/* Agent Tcl
 * Bob Gray
 * 25 January 1995
 *
 * *** NOT PART OF THE STANDARD TCL DISTRIBUTION ***
 *
 * This is part of the code that is used to capture and restore the interal
 * state of an executing Tcl script. 
 * 
 * tclState.c --
 *
 *    This file contains the procedures that are used to set, examine and
 *    unset the state variables.
 *  
 * 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"

static char scratch[32];
static char name[32];

char *set_state_variable (interp, name, newValue)
     Tcl_Interp *interp;
     char *name;
     char *newValue;
{
  register Interp *iptr = (Interp *) interp;

  sprintf (scratch, "%d", iptr -> execution_stack.top);
  return (Tcl_SetVar2 (interp, scratch, name, newValue, TCL_STATE_VARIABLE));
}

char *get_state_variable (interp, name)
     Tcl_Interp *interp;
     char *name;
{
  register Interp *iptr = (Interp *) interp;

  sprintf (scratch, "%d", iptr -> execution_stack.top);
  return (Tcl_GetVar2 (interp, scratch, name, TCL_STATE_VARIABLE));
}

int unset_all_state_variables (interp)
     Tcl_Interp *interp;
{
  register Interp *iptr = (Interp *) interp;

  sprintf (scratch, "%d", iptr -> execution_stack.top);
  return (Tcl_UnsetVar2  (interp, scratch, (char *) NULL, TCL_STATE_VARIABLE));
}

int unset_subst_state (interp, n, level)
     Tcl_Interp *interp;
     int n;
     int level;
{
  register int i;
  register int resultCode = TCL_OK;
  register Interp *iptr = (Interp *) interp;

  sprintf (scratch, "%d", level);

  for (i = 1; i <= n; i++) {

    sprintf (name, "%d", i);

    if (Tcl_UnsetVar2 (interp, scratch, name, TCL_STATE_VARIABLE) != TCL_OK) {
      resultCode = TCL_ERROR;
    }
  }

  return (resultCode);
}

#ifdef TCL_STATE_HANDLERS

void
Tcl_RegisterState (interp,proc,data)
    Tcl_Interp *interp;
    Tcl_StateProc *proc;
    ClientData data;
{
    int i;
    StateHandler *newSlots;
    StateHandlerList *handlers;
    Interp *iPtr = (Interp *) interp;

	/* get the handlers */

    handlers = &iPtr -> handlers;
 
	/* expand the handler list if necessary */

    if (handlers->n >= handlers->n_slots) {

	handlers->n_slots = handlers->n_slots << 1;
	newSlots = (StateHandler *) ckalloc ((unsigned) handlers->n_slots * sizeof(StateHandler)); 

    	for (i = 0; i < handlers->n; i++) {
	    newSlots[i].proc = handlers->slots[i].proc;
	    newSlots[i].data = handlers->slots[i].data;
	}  

	ckfree ((void *) handlers->slots);
	handlers->slots = newSlots; 
    }

	/* add the new state handler */

    handlers->slots[handlers->n].proc = proc;
    handlers->slots[handlers->n].data = data; 
    handlers->n += 1;
}

/* Tcl_GetState

   Purpose: See if there is a state information available for an extension

     Input: interp = the current interpreter
		     (struct Tcl_Interp *)

	    name   = symbolic name of the extension
		     (char *)

    Output: The procedure returns NULL if there is no state information for the given
	    extension.  Otherwise the procedure returns a pointer to the corresponding
            EXTENSION_STATE.
*/

EXTENSION_STATE *Tcl_GetState (Tcl_Interp *interp, char *name)
{
    Tcl_HashEntry *hPtr;
    Interp *iPtr = (Interp *) interp;

	/* look for the hash entry */

    if ((hPtr = Tcl_FindHashEntry (&iPtr -> extenState, name)) == NULL) {
	return ((EXTENSION_STATE *) NULL);
    }

    return ((EXTENSION_STATE *) Tcl_GetHashValue (hPtr));
}

/* Tcl_RemoveState

   Purpose: Remove the state information associated with an extension

     Input: interp = the Tcl interpreter
		     (struct Tcl_Interp *)

	    name   = symbolic name of the extension
		     (char *)

    Output: The procedure returns TCL_ERROR if there is no state information for the
	    given extension.  Otherwise the procedure returns TCL_OK and delets the
	    state information.
*/

int Tcl_RemoveState (Tcl_Interp *interp, char *name)
{
    Tcl_HashEntry *hPtr;
    Interp *iPtr = (Interp *) interp;
    EXTENSION_STATE *extension;

	/* look for the hash entry */

    if ((hPtr = Tcl_FindHashEntry (&iPtr -> extenState, name)) == NULL) {
	return TCL_ERROR;
    }

	/* get the EXTENSION_STATE structure and remove the entry */

    extension = ((EXTENSION_STATE *) Tcl_GetHashValue (hPtr));
    Tcl_DeleteHashEntry (hPtr);  

	/* remove the pieces of the extension */

    if (extension -> name != NULL) {
	ckfree ((char *) extension -> name);
    }

    Tcl_DStringFree (&extension -> error);
    Tcl_DStringFree (&extension -> state);
    ckfree ((char *) extension);
    return TCL_OK;
}

#endif   /* TCL_STATE_HANDLERS */
