/* 
 * main.c --
 *
 *	This file contains the main program for "wish", a windowing
 *	shell based on Tk and Tcl.  It also provides a template that
 *	can be used as the basis for main programs for other Tk
 *	applications.
 *
 * Copyright (c) 1990-1993 The Regents of the University of California.
 * All rights reserved.
 *
 * Permission is hereby granted, without written agreement and without
 * license or royalty fees, to use, copy, modify, and distribute this
 * software and its documentation for any purpose, provided that the
 * above copyright notice and the following two paragraphs appear in
 * all copies of this software.
 * 
 * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
 * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
 * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
 * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
 * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
 * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
 * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
 * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
 */

#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkMain.c,v 1.99 93/11/11 09:35:24 ouster Exp $ SPRITE (Berkeley)";
#endif

#include <stdio.h>
#include <stdlib.h>
#include <tcl.h>
#include <tk.h>



#if (TK_MINOR_VERSION==0 && TK_MAJOR_VERSION==4)
#define TkCreateMainWindow Tk_CreateMainWindow
#endif


/*-------------------------------------------------------------------*/
#include <unistd.h>
#include <sys/types.h>
#include <signal.h>
#include <errno.h>

#include "guis.h"
struct connection_state *dsfd;
/*-------------------------------------------------------------------*/

/*
 * Declarations for various library procedures and variables (don't want
 * to include tkInt.h or tkConfig.h here, because people might copy this
 * file out of the Tk source directory to make their own modified versions).
 */

/* extern void		exit _ANSI_ARGS_((int status)); */
extern int		isatty _ANSI_ARGS_((int fd));
/*
extern int		read _ANSI_ARGS_((int fd, char *buf, size_t size));
*/
extern char *		strrchr _ANSI_ARGS_((CONST char *string, int c));

/*
 * Global variables used by the main program:
 */

static Tk_Window mainWindow;	/* The main window for the application.  If
				 * NULL then the application no longer
				 * exists. */
static Tcl_Interp *interp;	/* Interpreter for this application. */
char *tcl_RcFileName;		/* Name of a user-specific startup script
				 * to source if the application is being run
				 * interactively (e.g. "~/.wishrc").  Set
				 * by Tcl_AppInit.  NULL means don't source
				 * anything ever. */
static Tcl_DString command;	/* Used to assemble lines of terminal input
				 * into Tcl commands. */
static int tty;			/* Non-zero means standard input is a
				 * terminal-like device.  Zero means it's
				 * a file. */
static char errorExitCmd[] = "exit 1";

/*
 * Command-line options:
 */

static int synchronize = 0;
static char *fileName = NULL;
static char *name = NULL;
static char *display = NULL;
static char *geometry = NULL;
int debug = 0;

void guiCreateCommand _ANSI_ARGS_((int idLispObject, int iSlot , char *arglist));

dfprintf(fp,s,x0,x1,x2,x3,x4,x5)
     char *s;
     FILE *fp;
     int x0,x1,x2,x3,x4,x5;
{if (debug)
   {fprintf(fp,"\nguis:");
    fprintf(fp,s,x0,x1,x2,x3,x4,x5);
    fflush(stderr);
  }
}

#define CMD_SIZE 4000
#define SIGNAL_ERROR TCL_signal_error

TCL_signal_error(x)
     char *x;
{char buf[300] ;
 sprintf("error %s",x);
 Tcl_Eval(interp,buf);
 dfprintf(x);
}



static Tk_ArgvInfo argTable[] = {
    {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
	"File from which to read commands"},
    {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
	"Initial geometry for window"},
    {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
	"Display to use"},
    {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
	"Name to use for application"},
    {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
	"Use synchronous mode for display server"},
    {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
	(char *) NULL}
};

/*
 * Declaration for Tcl command procedure to create demo widget.  This
 * procedure is only invoked if SQUARE_DEMO is defined.
 */

extern int SquareCmd _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, int argc, char *argv[]));

/*
 * Forward declarations for procedures defined later in this file:
 */

static void		StdinProc _ANSI_ARGS_((ClientData clientData,
			    int mask));

/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *	Main program for Wish.
 *
 * Results:
 *	None. This procedure never returns (it exits the process when
 *	it's done
 *
 * Side effects:
 *	This procedure initializes the wish world and then starts
 *	interpreting commands;  almost anything could happen, depending
 *	on the script being interpreted.
 *
 *----------------------------------------------------------------------
 */
/*
int
main(argc, argv)
*/
void
TkX_Wish (argc, argv)
    int argc;				/* Number of arguments. */
    char **argv;			/* Array of argument strings. */
{
    char *args, *p, *msg;
    char buf[20];
    int code;

    interp = Tcl_CreateInterp();
#ifdef TCL_MEM_DEBUG
    Tcl_InitMemory(interp);
#endif

    /*
     * Parse command-line arguments.
     */

    if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
	    != TCL_OK) {
	fprintf(stderr, "%s\n", interp->result);
	exit(1);
    }
    if (name == NULL) {
	if (fileName != NULL) {
	    p = fileName;
	} else {
	    p = argv[0];
	}
	name = strrchr(p, '/');
	if (name != NULL) {
	    name++;
	} else {
	    name = p;
	}
    }

    /*
     * If a display was specified, put it into the DISPLAY
     * environment variable so that it will be available for
     * any sub-processes created by us.
     */

    if (display != NULL) {
	Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
    }

    /*
     * Initialize the Tk application.
     */

    mainWindow = TkCreateMainWindow(interp, display, name, "Tk"); 
    if (mainWindow == NULL) {
	fprintf(stderr, "%s\n", interp->result);
	exit(1);
    }
    if (synchronize) {
	XSynchronize(Tk_Display(mainWindow), True);
    }
    Tk_GeometryRequest(mainWindow, 200, 200);
    Tk_UnmapWindow(mainWindow);

    /*
     * Make command-line arguments available in the Tcl variables "argc"
     * and "argv".  Also set the "geometry" variable from the geometry
     * specified on the command line.
     */

    args = Tcl_Merge(argc-1, argv+1);
    Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
    ckfree(args);
    sprintf(buf, "%d", argc-1);
    Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
	    TCL_GLOBAL_ONLY);
    if (geometry != NULL) {
	Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
    }

    /*
     * Set the "tcl_interactive" variable.
     */

    tty = isatty(dsfd->fd);
    Tcl_SetVar(interp, "tcl_interactive",
	    ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);

    /*
     * Add a few application-specific commands to the application's
     * interpreter.
     */

#ifdef SQUARE_DEMO
    Tcl_CreateCommand(interp, "square", SquareCmd, (ClientData) mainWindow,
	    (void (*)()) NULL);
#endif

    /*
     * Invoke application-specific initialization.
     */

    if (Tcl_AppInit(interp) != TCL_OK) {
	fprintf(stderr, "Tcl_AppInit failed: %s\n", interp->result);
    }

    /*
     * Set the geometry of the main window, if requested.
     */

    if (geometry != NULL) {
	code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
	if (code != TCL_OK) {
	    fprintf(stderr, "%s\n", interp->result);
	}
    }

    /*
     * Invoke the script specified on the command line, if any.
     */

    if (fileName != NULL) {
	code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
	if (code != TCL_OK) {
	    goto error;
	}
	tty = 0;
    } else {
	/*
	 * Commands will come from standard input, so set up an event
	 * handler for standard input.  If the input device is aEvaluate the
	 * .rc file, if one has been specified, set up an event handler
	 * for standard input, and print a prompt if the input
	 * device is a terminal.
	 */

	if (tcl_RcFileName != NULL) {
	    Tcl_DString buffer;
	    char *fullName;
	    FILE *f;
    
	    fullName = Tcl_TildeSubst(interp, tcl_RcFileName, &buffer);
	    if (fullName == NULL) {
		fprintf(stderr, "%s\n", interp->result);
	    } else {
		f = fopen(fullName, "r");
		if (f != NULL) {
		    code = Tcl_EvalFile(interp, fullName);
		    if (code != TCL_OK) {
			fprintf(stderr, "%s\n", interp->result);
		    }
		    fclose(f);
		}
	    }
	    Tcl_DStringFree(&buffer);
	}

	dfprintf(stderr, "guis : Creating file handler for %d\n", dsfd->fd);
	
	Tk_CreateFileHandler(dsfd->fd, TK_READABLE, StdinProc, (ClientData) 0);
    }
    fflush(stdout);
    Tcl_DStringInit(&command);

    /*
     * Loop infinitely, waiting for commands to execute.  When there
     * are no windows left, Tk_MainLoop returns and we exit.
     */

    Tk_MainLoop();

    /*
     * Don't exit directly, but rather invoke the Tcl "exit" command.
     * This gives the application the opportunity to redefine "exit"
     * to do additional cleanup.
     */

    Tcl_Eval(interp, "exit");
    exit(1);

error:
    msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    if (msg == NULL) {
	msg = interp->result;
    }
    dfprintf(stderr, "%s\n", msg);
    Tcl_Eval(interp, errorExitCmd);
    return;			/* Needed only to prevent compiler warnings. */
}

static char *being_set_by_lisp;

char *
tell_lisp_var_changed(
                clientData,
               interp,
               name1,
               name2,
                flags)

          ClientData clientData;
               Tcl_Interp *interp;
               char *name1;
               char *name2;
               int flags;     
     
{

  if (being_set_by_lisp == 0)
    { char *val = Tcl_GetVar2(interp,name1,name2, TCL_GLOBAL_ONLY);
      char buf[3];
      STORE_3BYTES(buf,(int) clientData);
      if(sock_write_str2(dsfd,   m_set_lisp_loc, buf, 3 ,
				 val, strlen(val))
		 < 0)
		{		/* what do we want to do if the write failed */}
	      
    if (parent > 0)  kill(parent, SIGUSR1);
    }
  else
  /* avoid going back to lisp if it is lisp that is doing the setting! */
    if (strcmp(being_set_by_lisp,name1))
      { fprintf(stderr,"recursive setting of vars %s??",name1);}
  /* normal */
  return 0;
}


/*
 *----------------------------------------------------------------------
 *
 * StdinProc --
 *
 *	This procedure is invoked by the event dispatcher whenever
 *	standard input becomes readable.  It grabs the next line of
 *	input characters, adds them to a command being assembled, and
 *	executes the command if it's complete.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Could be almost arbitrary, depending on the command that's
 *	typed.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
static void
StdinProc(clientData, mask)
     ClientData clientData;		/* Not used. */
     int mask;				/* Not used. */
{
  int fNotDone;
  char *cmd;
  int code, count;
  struct message_header *msg;
  char buf[0x4000];
  msg = (struct message_header *) buf;

  /*
   * Disable the stdin file handler while evaluating the command;
   * otherwise if the command re-enters the event loop we might
   * process commands from stdin before the current command is
   * finished.  Among other things, this will trash the text of the
   * command being evaluated.
   */
  dfprintf(stderr, "\nguis : Disabling file handler for %d\n", dsfd->fd);

/*  Tk_CreateFileHandler(dsfd->fd, 0, StdinProc, (ClientData) 0); */

  do
    { 
      char *p;

      msg = guiParseMsg1(dsfd,buf,sizeof(buf));

      if (msg == NULL)
	{
	  /*dfprintf(stderr, "Yoo !!! Empty command\n"); */
	  if (debug)perror("zero message");
	  Tk_CreateFileHandler(dsfd->fd, TK_READABLE, StdinProc, (ClientData) 0);
	  return;
	}

      /* Need to switch to table lookup */
      switch (msg->type){
      case m_create_command:
	  {
	    int idLispObject;
	    int iSlot;
	    char *arglist;
	    int matches;
	    GET_3BYTES(msg->body,iSlot);
	    guiCreateCommand(0, iSlot, &(msg->body[3]));
	  }
	  break;
	case  m_tcl_command :
	case m_tcl_command_wait_response:
	  count = strlen(msg->body);
	  cmd = Tcl_DStringAppend(&command, msg->body, count);

	  code = Tcl_RecordAndEval(interp, cmd, 0);

	  if (msg->type == m_tcl_command_wait_response
	      || code)
	    {
	      unsigned char buf[4];
	      unsigned char *p = buf;
	      int cb;
	      /*header */
	      *p++ = (code ? '1' : '0');
	      bcopy(msg->msg_id,p,3);
	      /* end header */
	      if(sock_write_str2(dsfd, m_reply, buf, 4 ,
				 interp->result, strlen(interp->result))
		 < 0)
		{		/* what do we want to do if the write failed */}
	      
	      if (msg->type == m_tcl_command_wait_response)
		{ /* parent is waiting so dong signal */ ;}
	      else
		if (parent> 0)kill(parent, SIGUSR1);
	    }

	  Tcl_DStringFree(&command);
	  break;
	case m_tcl_clear_connection:
	  /* we are stuck... */
	  {
	    Tcl_DStringInit(&command);
	    Tcl_DStringFree(&command);
	    fSclear_connection(dsfd);
	  }
	  break;
	case m_tcl_set_text_variable:
	  { int n = strlen(msg->body);
	    if(being_set_by_lisp) fprintf(stderr,"recursive set %d?");
	    /* avoid a trace on this set!! */
	    
	    being_set_by_lisp = msg->body;
	    Tcl_SetVar2(interp,msg->body,0,msg->body+n+1,
			TCL_GLOBAL_ONLY);
	    being_set_by_lisp = 0;
	     }
	  break;

	case m_tcl_link_text_variable:
	  {int i;
	   char buf[30];
	   GET_3BYTES(msg->body,i);
	   Tcl_TraceVar2(interp,msg->body+3 ,0,
			   TCL_TRACE_WRITES
			   | TCL_TRACE_UNSETS
			   | TCL_GLOBAL_ONLY
			   , tell_lisp_var_changed, (ClientData) i);
	 }
	   break;

	case m_tcl_unlink_text_variable:
	  {int i;
	   char buf[30];
	   GET_3BYTES(msg->body,i);
	   Tcl_UntraceVar2(interp,msg->body+3 ,0,
			   TCL_TRACE_WRITES
			   | TCL_TRACE_UNSETS
			   | TCL_GLOBAL_ONLY
			   , tell_lisp_var_changed, (ClientData) i);
	 }
	  break;

	default :
	  dfprintf(stderr, "Error !!! Unknown command %d\n"
		   , msg->type);
	}
    prompt:
      fNotDone = fScheck_dsfd_for_input(dsfd,0);
      
      if (fNotDone > 0)
	{
	  dfprintf(stderr, "\nguis : in StdinProc, not done, executed %s"
		  ,  msg->body);

	}
    } while (fNotDone > 0);


  /* Tk_CreateFileHandler(dsfd->fd, TK_READABLE, StdinProc, (ClientData) 0); */
  if ((void *)msg != (void *) buf)
    free ((void *) msg);
}

/* ----------------------------------------------------------------- */
typedef struct _ClientDataLispObject {
  int id;
  int iSlot;
  char *arglist;
} ClientDataLispObject;

static int
TclGenericCommandProcedure( clientData,
			   pinterp,
			    argc, argv)
     ClientData clientData;
     Tcl_Interp *pinterp;
     int argc;
     char *argv[];
{
  char szCmd[CMD_SIZE];
  ClientDataLispObject *pcdlo = (ClientDataLispObject *)clientData;
  int cb;
  char *q = szCmd;
  char *p = pcdlo->arglist;

  STORE_3BYTES(q,(pcdlo->iSlot));
  q += 3;
  if (p == 0)
    { char *arg = (argc > 1 ? argv[1] : "");
      int m = strlen(arg);
      if (m > CMD_SIZE -50)
	SIGNAL_ERROR("too big command");
      bcopy(arg,q,m);
      q += m ;}
  else
    { int i,n;
      *q++ = '(';
      n = strlen(p);
      for (i=1; i< argc; i++)
	{ if (i < n && p[i]=='s')   { *q++ = '"';}
	  strcpy(q,argv[i]);
	  q+= strlen(argv[i]);
	  if (i < n && p[i]=='s')   { *q++ = '"';}
	}
      *q++ = ')';
    }
  *q = 0;
     
  dfprintf(stderr, "TclGenericCommandProcedure : %s\n"
	  , szCmd
	  );

  if (sock_write_str2(dsfd,m_call, "",0, szCmd, q-szCmd) == -1)
    {
      dfprintf(stderr,
      "Error\t(TclGenericCommandProcedure) !!!\n\tFailed to write [%s] to socket %d (%d) cb=%d\n"
	      , szCmd, dsfd->fd, errno, cb);

    }
  if (parent > 0)kill(parent, SIGUSR1);
  return TCL_OK;
}



void
guiCreateCommand( idLispObject,  iSlot , arglist)
     int idLispObject; int iSlot ; char *arglist;
{
  char szNameCmdProc[2000],*c;
  ClientDataLispObject *pcdlo;

  sprintf(szNameCmdProc, "callback_%d",iSlot);

  pcdlo = (ClientDataLispObject *)malloc(sizeof(ClientDataLispObject));
  pcdlo->id = idLispObject;
  pcdlo->iSlot = iSlot;
  if (arglist[0] == 0)
    { pcdlo->arglist = 0;}
  else
  {c= malloc(strlen(arglist)+1);
   strcpy(c,arglist);
   pcdlo->arglist = c;}
  Tcl_CreateCommand(interp
		    , szNameCmdProc, TclGenericCommandProcedure
		    , (ClientData *)pcdlo, free);
  dfprintf(stderr, "TCL creating callback : %s\n", szNameCmdProc);

/*  guiBindCallback(szNameCmdProc, szTclObject, szModifier,arglist); */
}

/*
int
guiBindCallback(char *szNameCmdProc, char *szTclObject, char *szModifier,char* arglist)
{
  int code;
  char szCmd[2000];

  sprintf(szCmd, "bind %s %s {%s %s}"
	  , szTclObject
	  , szModifier
	  , szNameCmdProc
	  , (arglist ? arglist : "")
	  );
  dfprintf(stderr, "TCL BIND : %s\n", szCmd);

  code = Tcl_Eval(interp, szCmd);
  if (code != TCL_OK)
    {
      dfprintf(stderr, "TCL Error int bind : %s\n", interp->result);

    }
  return code;
}
*/
void
guiDeleteCallback(szCallback)
     char *szCallback;
{
  dfprintf(stderr, "Tcl Deleting command : %s\n", szCallback);

  Tcl_DeleteCommand(interp, szCallback);
}

/*  */

