/* Agent Tcl
   Bob Gray
   4 October 1995

   tkBasicCmd.cc

   This file implements the Tcl commands for Agent Tk.
*/

#include "platPorting.h"
#include "suppStrings.h"
#include "agentTclInt.h"
#include "agentTkInt.h"
#include "genMessage.h"
#include "genUtility.h"
#include "tcl.h"
#include "tclUtility.h"
#include "tk.h"
#include "tclLocation.h"
#include "tclMasks.h"

/* agentMainCreateCmd

   Tcl syntax: main create <tk_options>

      Purpose: The procedure creates the main window for the Tk applications.
 
        Input: dummy  = client data (not used)
               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 creates the main window,
*/

int agentMainCreateCmd (ClientData, Tcl_Interp *interp, int argc, char **argv)
{
    int i;
    int result;
    char *saveArgv;
    Tk_Window tkwin;

	/* check the number of command arguments */

    if (argc < 2) {
	Tcl_AppendResult (interp, "wrong # of args: should be \"", argv[0], " create <tk_options>\"", (char *) NULL);
	return TCL_ERROR;
    }

	/* make sure that we do not already have a main window */

    if ((tkwin = Tk_MainWindow(interp)) != NULL) {
	Tcl_SetResult (interp, "main window already exists", TCL_STATIC);
	return TCL_ERROR;
    }

	/* save the current "argv" */

    saveArgv = strcpyWithAlloc (Tcl_GetVar2 (interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY));

	/* add the command options to argv */

    argc -= 2;
    argv += 2;

    for (i = 0; i < argc; i++) {
	(void) Tcl_SetVar2 (interp, "argv", (char *) NULL, argv[i], TCL_APPEND_VALUE | TCL_LIST_ELEMENT | TCL_GLOBAL_ONLY);
    }

	/* initialize; then restore the old argv; then bail */

    result = Tk_Init (interp);

    if (saveArgv != NULL) {
	(void) Tcl_SetVar2 (interp, "argv", (char *) NULL, saveArgv, TCL_GLOBAL_ONLY);
    } else {
	(void) Tcl_UnsetVar2 (interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY);
    }

    return (result);
}

/* agentMainDestroyCmd

   Tcl syntax: main destroy

      Purpose: The procedure destroys the main window for the Tk application.

        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 destroys the main window.
*/

int agentMainDestroyCmd (ClientData, Tcl_Interp *interp, int argc, char **argv)
{
    BOOLEAN okay;
    Tk_Window tkwin;

	/* check the number of arguments */

    okay = e_FALSE;

    if (argc == 2) {

	okay = e_TRUE;

    } else if (argc == 4) {

	if (!strcmp (argv[2], "-interp")) {
	    okay = e_TRUE;
	}
    } 

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

	/* make sure that we have a main window */ 

    if ((tkwin = Tk_MainWindow(interp)) == NULL) {
	Tcl_SetResult (interp, "main window does not exist", TCL_STATIC);
	return TCL_ERROR;
    }

	/* destroy the main window */

    Tk_DestroyWindow (tkwin);
    return TCL_OK;
}
 
/* AgentTk_MainCmd

   Tcl syntax: main create <screen> <class>
               main destroy

      Purpose: The procedure creates or destroys the main window for the 
               Tk application.

        Input: interp = the current interpreter
               dummy  = client data (unused)
               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 if it is unable to create or
               destroy the main window.  Otherwise the procedure returns  
               TCL_OK and creates or destroys the main window.
*/

int AgentTk_MainCmd (ClientData dummy, Tcl_Interp *interp, int argc, char **argv)
{
    int i;
    int returnCode;
    Tcl_Interp *targetInterp;

	/* check the number of arguments */

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

	/* pull out the target interpreter */

    targetInterp = interp;

    for (i = 2; i < argc; i++) {

	if (!strcmp (argv[i], "-interp")) {

	    if (++i >= argc) {
		Tcl_AppendResult (interp, "\"-interp\" option takes a slave interpreter", (char *) NULL);
		return TCL_ERROR;
	    }

	    if ((targetInterp = Tcl_GetSlave (interp, argv[i])) == NULL) {
		Tcl_AppendResult (interp, "\"", argv[i], "\" is not a valid slave interpreter", (char *) NULL);
	 	return TCL_ERROR;
	    }

	    break;
	}
    }

	/* perform the appropriate operation */

    if (!strcmp (argv[1], "create")) {
	returnCode = agentMainCreateCmd (dummy, targetInterp, argc, argv);
    } else if (!strcmp (argv[1], "destroy")) {
	returnCode = agentMainDestroyCmd (dummy, targetInterp, argc, argv);
    } else {
	Tcl_AppendResult (targetInterp, "unknown option \"", argv[1], "\": should be \"create\" or \"destroy\"", (char *) NULL);
	returnCode = TCL_ERROR;
    }

    if (interp != targetInterp) {
	Tcl_TransferResult (interp, targetInterp);
    }
	
    return (returnCode);
}

/* AgentTk_Init

   Purpose: Add the "main" command to a interpreter

     Input: interp  = the interpreter

    Output: The procedure adds the "main" command to the interpreter.
*/

static char *defaultLibraryDir = TK_LIBRARY;

static char initScript[] =
"proc tclInit {} {\n\
    global tk_library tcl_version tcl_patchLevel env\n\
    rename tclInit {}\n\
    set dirs {}\n\
    if [info exists env(TK_LIBRARY)] {\n\
	lappend dirs $env(TK_LIBRARY)\n\
    }\n\
    lappend dirs $tk_library\n\
    foreach i $dirs {\n\
	set tk_library $i\n\
	if ![file exists $i/tksafety.tcl] {\n\
	    continue\n\
	}\n\
	uplevel #0 [list source $i/tksafety.tcl]\n\
	return\n\
    }\n\
    set msg \"Can't find a usable tksafety.tcl in the following directories: \n\"\n\
    append msg \"    $dirs\n\"\n\
    append msg \"This probably means that Agent Tcl wasn't installed properly.\n\"\n\
    error $msg\n\
}\n\
tclInit";

int AgentTk_Init (Tcl_Interp *interp)
{
	/* assertions */

    assert (interp != NULL);

	/* get the master interpreter -- this could be NULL */

    Tcl_Interp *masterInterp = Tcl_GetMaster (interp);

	/* initialize */

    if (masterInterp == NULL) {

	Tcl_CreateCommand (interp, "main", AgentTk_MainCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

    } else {

	char *libDir;
	char *argv[1];

	    /* set the tk_library, tk_version and tk_patchLevel variables */

	libDir = Tcl_GetVar(masterInterp, "tk_library", TCL_GLOBAL_ONLY);

	if (libDir == NULL) {
	    Tcl_SetVar(masterInterp, "tk_library", defaultLibraryDir, TCL_GLOBAL_ONLY);
	    Tcl_GlueVar(masterInterp, "tk_library", TCL_GLOBAL_ONLY);
	}

        Tcl_SetVar (masterInterp, "tk_patchLevel", TK_PATCH_LEVEL, TCL_GLOBAL_ONLY);
        Tcl_GlueVar (masterInterp, "tk_patchLevel", TCL_GLOBAL_ONLY);
        Tcl_SetVar (masterInterp, "tk_version", TK_VERSION, TCL_GLOBAL_ONLY);
        Tcl_GlueVar (masterInterp, "tk_version", TCL_GLOBAL_ONLY);

	    /* get the slave path */

	int code = Tcl_GetInterpPath (masterInterp, interp);
	assert (code == TCL_OK);
	argv[0] = strcpyWithAlloc (masterInterp -> result);

	    /* initialize the kernel interpreter */

	if (Tcl_GlobalEval (masterInterp, initScript) != TCL_OK) {
	    Tcl_TransferResult (interp, masterInterp);
	    Tcl_AddErrorInfo (interp, "\n    (\"master\" initialization)");
	    return TCL_ERROR;
	}

	Tcl_CreateCommand (masterInterp, "main", AgentTk_MainCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

	    /* finally create the alias from the user interpreter into the kernel */

	(void) Tcl_CreateAlias (interp, "main", masterInterp, "kernelMain", 1, argv);
	delete (argv[0]);
    }

    return TCL_OK;
}
