/*----------------------------------------------------------------------*/
/* tclmagic.c --- Creates the interpreter-wrapped version of magic.	*/
/*									*/
/*   Written by Tim Edwards August 2002					*/
/*									*/
/*   Note that this file is tied to Tcl.  The original version (from	*/
/*   around April 2002) relied on SWIG, the only differences being	*/
/*   as few %{ ... %} boundaries and the replacement of the 		*/
/*   Tclmagic_Init function header with "%init %{", and call the	*/
/*   file "tclmagic.i".  However, the rest of the associated wrapper	*/
/*   code got so dependent on Tcl commands that there is no longer any	*/
/*   point in using SWIG.						*/
/*									*/
/*   When using SWIG, the Makefile requires:				*/
/*									*/
/*	tclmagic.c: tclmagic.i						*/
/*		swig -tcl8 -o tclmagic.c tclmagic.i			*/
/*									*/
/*----------------------------------------------------------------------*/

#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <signal.h>
#include <string.h>

#include "magic/tclmagic.h"
#include "misc/magic.h"   
#include "utils/geometry.h"
#include "tiles/tile.h"  
#include "utils/hash.h"  
#include "utils/dqueue.h"
#include "database/database.h"
#include "windows/windows.h"
#include "commands/commands.h"
#include "utils/utils.h"
#include "textio/textio.h"
#include "textio/txcommands.h"
#include "signals/signals.h"
#include "graphics/graphics.h"
#include "utils/malloc.h" 

/*
 * String containing the version number of magic.  Don't change the string
 * here, nor its format.  It is updated by the Makefile in this directory.
 */

char *MagicVersion = MAGIC_VERSION;
char *MagicCompileTime = MAGIC_DATE;

Tcl_Interp *magicinterp;
Tcl_Interp *consoleinterp;

HashTable txTclTagTable;

/* Forward declarations */

int TerminalInputProc(ClientData, char *, int, int *);
void TxFlushErr();
void TxFlushOut();
void RegisterTkCommands();

/*--------------------------------------------------------------*/
/* Find any tags associated with a command and execute them.	*/
/*--------------------------------------------------------------*/

static int TagCallback(interp, tkpath, argc, argv)
    Tcl_Interp *interp;
    char *tkpath;
    int argc;		/* original command's number of arguments */
    char *argv[];	/* original command's argument list */
{
    int argidx, result = TCL_OK;
    char *postcmd, *substcmd, *newcmd, *sptr, *sres;
    char *croot = argv[0];
    HashEntry *entry;
    Tcl_SavedResult state;
    bool reset = FALSE;
    int cmdnum;

    /* Skip over namespace qualifier, if any */

    if (!strncmp(croot, "::", 2)) croot += 2;
    if (!strncmp(croot, "magic::", 7)) croot += 7;

    entry = HashLookOnly(&txTclTagTable, croot);
    postcmd = (entry) ? (char *)HashGetValue(entry) : NULL;

    if (postcmd)
    {
	/* The Tag callback should not increase the command number	*/
	/* sequence, so save it now and restore it before returning.	*/ 
	cmdnum = TxCommandNumber;

	substcmd = (char *)mallocMagic(strlen(postcmd) + 1);
	strcpy(substcmd, postcmd);
	sptr = substcmd;

	/*--------------------------------------------------------------*/
	/* Parse "postcmd" for Tk-substitution escapes			*/
	/* Allowed escapes are:						*/
	/* 	%W	substitute the tk path of the layout window	*/
	/*	%r	substitute the previous Tcl result string	*/
	/*	%R	substitute the previous Tcl result string and	*/
	/*		reset the Tcl result.				*/
	/*	%[0-5]  substitute the argument to the original command	*/
	/*	%%	substitute a single percent character		*/
	/*	%*	(all others) no action: print as-is.		*/
	/*--------------------------------------------------------------*/

	while ((sptr = strchr(sptr, '%')) != NULL)
	{
	    switch (*(sptr + 1))
	    {
		case 'W':

		    /* In the case of the %W escape, first we see if a Tk */
		    /* path has been passed in the argument.  If not, get */
		    /* the window path if there is only one window.       */
		    /* Otherwise, the window is unknown so we substitute  */
		    /* nothing.						  */ 

		    if (tkpath == NULL)
		    {
			MagWindow *w = NULL;
			windCheckOnlyWindow(&w);
			if (w != NULL && !(w->w_flags & WIND_OFFSCREEN))
			{
			    Tk_Window tkwind = (Tk_Window) w->w_grdata;
			    if (tkwind != NULL) tkpath = Tk_PathName(tkwind);
			}
		    }
		    if (tkpath == NULL)
			newcmd = (char *)mallocMagic(strlen(substcmd));
		    else
			newcmd = (char *)mallocMagic(strlen(substcmd) + strlen(tkpath));

		    strcpy(newcmd, substcmd);

		    if (tkpath == NULL)
			strcpy(newcmd + (int)(sptr - substcmd), sptr + 2);
		    else
		    {
			strcpy(newcmd + (int)(sptr - substcmd), tkpath);
			strcat(newcmd, sptr + 2);
		    }
		    freeMagic(substcmd);
		    substcmd = newcmd;
		    sptr = substcmd;
		    break;

		case 'R':
		    reset = TRUE;
		case 'r':
		    sres = Tcl_GetStringResult(magicinterp);
		    newcmd = (char *)mallocMagic(strlen(substcmd)
				+ strlen(sres) + 1);
		    strcpy(newcmd, substcmd);
		    sprintf(newcmd + (int)(sptr - substcmd), "\"%s\"", sres);
		    strcat(newcmd, sptr + 2);
		    freeMagic(substcmd);
		    substcmd = newcmd;
		    sptr = substcmd;

		    break;

		case '0': case '1': case '2': case '3': case '4': case '5':
		    argidx = (int)(*(sptr + 1) - '0');
		    if ((argidx >= 0) && (argidx < argc))
		    {
		        newcmd = (char *)mallocMagic(strlen(substcmd)
				+ strlen(argv[argidx]));
		        strcpy(newcmd, substcmd);
			strcpy(newcmd + (int)(sptr - substcmd), argv[argidx]);
			strcat(newcmd, sptr + 2);
			freeMagic(substcmd);
			substcmd = newcmd;
			sptr = substcmd;
		    }
		    else if (argidx >= argc)
		    {
		        newcmd = (char *)mallocMagic(strlen(substcmd) + 1);
		        strcpy(newcmd, substcmd);
			strcpy(newcmd + (int)(sptr - substcmd), sptr + 2);
			freeMagic(substcmd);
			substcmd = newcmd;
			sptr = substcmd;
		    }
		    else sptr++;
		    break;

		case '%':
		    newcmd = (char *)mallocMagic(strlen(substcmd) + 1);
		    strcpy(newcmd, substcmd);
		    strcpy(newcmd + (int)(sptr - substcmd), sptr + 1);
		    freeMagic(substcmd);
		    substcmd = newcmd;
		    sptr = substcmd;
		    break;

		default:
		    break;
	    }
	}

	/* fprintf(stderr, "Substituted tag callback is \"%s\"\n", substcmd); */
	/* fflush(stderr); */

	Tcl_SaveResult(interp, &state);
	result = Tcl_Eval(interp, substcmd);
	if ((result == TCL_OK) && (reset == FALSE))
	    Tcl_RestoreResult(interp, &state);
	else
	    Tcl_DiscardResult(&state);

	freeMagic(substcmd);
	TxCommandNumber = cmdnum;	/* restore original value */
    }
    return result;
}

/*--------------------------------------------------------------*/
/* Add a command tag callback					*/
/*--------------------------------------------------------------*/

static int AddCommandTag(ClientData clientData,
        Tcl_Interp *interp, int argc, char *argv[])
{
    HashEntry *entry;
    char *hstring;

    if (argc != 2 && argc != 3)
	return TCL_ERROR;

    entry = HashFind(&txTclTagTable, argv[1]);
 
    if (entry == NULL) return TCL_ERROR;

    hstring = (char *)HashGetValue(entry);

    if (argc == 2)
    {
	Tcl_SetResult(magicinterp, hstring, NULL);
	return TCL_OK;
    }

    if (hstring != NULL) FREE(hstring);

    if (strlen(argv[2]) == 0)
    {
	HashSetValue(entry, NULL);
    }
    else
    {
	hstring = StrDup(NULL, argv[2]);
	HashSetValue(entry, hstring);
    }
    return TCL_OK;
}

/*--------------------------------------*/
/* Main startup procedure		*/
/*--------------------------------------*/
 
static int _magic_start(ClientData clientData,
        Tcl_Interp *interp, int argc, char *argv[])
{
    int result;
    Tcl_ChannelType *inChannel;

    /* Is magic being executed in a slave interpreter? */

    if ((consoleinterp = Tcl_GetMaster(interp)) == NULL)
	consoleinterp = interp;

    /* Did we start in the same interpreter as we initialized? */
    if (magicinterp != interp)
    {
	TxError("Warning:  Switching interpreters.  Tcl-magic is not set up "
		"to handle this.\n");
	magicinterp = interp;
    }
    TxPrintf("Starting magic under Tcl interpreter\n");

    if (mainInitBeforeArgs(argc, argv) != 0) goto magicfatal;
    if (mainDoArgs(argc, argv) != 0) goto magicfatal;

    if (TxTkConsole)
	TxPrintf("Using Tk console window\n");
    else
	TxPrintf("Using the terminal as the console.\n");
    TxFlushOut();

    if (mainInitAfterArgs() != 0) goto magicfatal;

    TxResetTerminal();

    if (TxTkConsole)
    {
	Tcl_Eval(consoleinterp, "tkcon set ::tkcon::OPT(showstatusbar) 1");
	TxSetPrompt('%');
    }
    else
    {
	/* Use the terminal.				  */
	/* Replace the input proc for stdin with our own. */

	inChannel = Tcl_GetChannelType(Tcl_GetStdChannel(TCL_STDIN));
	inChannel->inputProc = TerminalInputProc;
    }

    return TCL_OK;

magicfatal:
    TxResetTerminal();
    Tcl_SetResult(interp, "Magic startup encountered a fatal error.", NULL);
    return TCL_ERROR;
}

/*--------------------------------------------------------------*/
/* Dispatch a command from Tcl					*/
/* See TxTclDispatch() in textio/txCommands.c			*/
/*--------------------------------------------------------------*/

static int _tcl_dispatch(ClientData clientData,
        Tcl_Interp *interp, int argc, char *argv[])
{
    TxTclDispatch(clientData, argc, argv);
    return TagCallback(interp, NULL, argc, argv);
}

/*--------------------------------------------------------------*/
/* Dispatch a window-related command.  The first argument is	*/
/* the window to which the command should be directed, so we	*/
/* determine which window this is, set "TxCurCommand" values	*/
/* to point to the window, then dispatch the command.		*/
/*--------------------------------------------------------------*/

static int _tk_dispatch(ClientData clientData,
        Tcl_Interp *interp, int argc, char *argv[])
{
    int id;
    char *tkpath;
    char *arg0;

    if (GrWindowIdPtr)
    {
	id = (*GrWindowIdPtr)(argv[0]);

	/* Find the bottommost point of the window? */
	/* Probably not necessary.  Need to clear the scrollbar, though. */
	TxSetPoint(20, 20, id);
	arg0 = argv[0];
	argc--;
	argv++;
    }
    TxTclDispatch(clientData, argc, argv);

    /* Get pathname of window and pass to TagCallback */
    return TagCallback(interp, arg0, argc, argv);
}

/*--------------------------------------------------------------*/
/* Set up a window to use commands via _tk_dispatch		*/
/*--------------------------------------------------------------*/

void
MakeWindowCommand(char *wname)
{
    Tcl_CreateCommand(magicinterp, wname, _tk_dispatch,
		(ClientData)NULL, (Tcl_CmdDeleteProc *) NULL);
}

/*--------------------------------------------------------------*/
/* Tk version of TxDialog					*/
/*--------------------------------------------------------------*/

int
TxDialog(prompt, responses, defresp)
    char *prompt;
    char *(responses[]);
    int defresp;
{
    Tcl_Obj *objPtr;
    int code, result, pos;
    char *evalstr, *newstr;

    /* Ensure that use of TxPrintString doesn't overwrite the	*/
    /* value of prompt my making a copy of it.			*/

    newstr = StrDup(NULL, prompt);
    evalstr = TxPrintString("tk_dialog .dialog \"Dialog\""
	" \"%s\" {} %d ", newstr, defresp);
    FREE(newstr);

    for (pos = 0; responses[pos] != 0; pos++)
    {
	newstr = StrDup(NULL, evalstr);
	evalstr = TxPrintString("%s \"%s\" ", newstr,
		responses[pos]);
	FREE(newstr);
    }

    Tcl_Eval(magicinterp, evalstr);
    objPtr = Tcl_GetObjResult(magicinterp);
    result = Tcl_GetIntFromObj(magicinterp, objPtr, &code);

    if (result == TCL_OK) return code;
    else return -1;
}

/*--------------------------------------------------------------*/
/* TxUseMore and TxStopMore are dummy functions, although they	*/
/* could be used to set up a top-level window containing the	*/
/* result (redefine "puts" to write to the window).		*/
/*--------------------------------------------------------------*/

void
TxUseMore()
{
}

/*--------------------------------------------------------------*/

void
TxStopMore()
{
}

/*--------------------------------------------------------------*/
/* Set the prompt, if we are using the TkCon console		*/
/*--------------------------------------------------------------*/

extern char txPromptChar;

void
TxSetPrompt(ch)
    char ch;
{   
    Tcl_SavedResult state;
    char promptline[16];

    if (TxTkConsole)
    {
	sprintf(promptline, "replaceprompt %c", ch);
	Tcl_SaveResult(consoleinterp, &state);
	Tcl_Eval(consoleinterp, promptline);
	Tcl_RestoreResult(consoleinterp, &state);
    }
}   

/*--------------------------------------------------------------*/
/* Get a line from stdin (Tcl replacement for Tx function)	*/
/*--------------------------------------------------------------*/

char *
TxGetLinePfix(dest, maxChars, prefix)
    char *dest;
    int maxChars;
    char *prefix;
{
    Tcl_Obj *objPtr;
    int charsStored, length;
    char *string;

    if (TxTkConsole)
    {
	/* Use dialog function (must be defined!) */
	Tcl_Eval(magicinterp, "magic::dialog \"prefix\"\n");
    }
    else
    {
	if (prefix != NULL)
	{
	    TxPrintf("%s", prefix);
	    TxFlushOut();
	}
	Tcl_Eval(magicinterp, "gets stdin");
    }

    objPtr = Tcl_GetObjResult(magicinterp);
    string = Tcl_GetStringFromObj(objPtr, &length);
    if (length > maxChars) length = maxChars;
    strcpy(dest, string);

    return dest;
}

/*--------------------------------------------------------------*/
/* Parse a file.  This is a skeleton version of the TxDispatch	*/
/* routine in textio/txCommands.c				*/
/*--------------------------------------------------------------*/

void
TxDispatch(f)
    FILE *f;	/* Under Tcl, we never call this with NULL */
{
    if (f == NULL)
    {
	TxError("Error:  TxDispatch(NULL) was called\n");
    }
    while (!feof(f))
    {
	if (SigInterruptPending)
	{
	    TxError("Read-in of file aborted.\n");
	    SigInterruptPending = FALSE;
	    return;
	}
	txGetFileCommand(f, NULL);
    }
}

/*--------------------------------------------------------------*/
/* Send a command line which was collected by magic's TxEvent	*/
/* handler to the interpreter's event queue.			*/
/*--------------------------------------------------------------*/

void
TxParseString(str, q, event)
    char *str;
    caddr_t q;		/* unused */
    caddr_t event;	/* always NULL (ignored) */
{
    char *reply;

    Tcl_Eval(magicinterp, str);

    reply = Tcl_GetStringResult(magicinterp);

    if (strlen(reply) > 0)
	TxPrintf("%s: %s\n", str, reply);
}

/*--------------------------------------------------------------*/
/* Replacement for TxFlush():  use Tcl interpreter		*/
/*    If we just call "flush", _tcl_dispatch gets called, and	*/
/*    bad things will happen.					*/
/*--------------------------------------------------------------*/

void
TxFlushErr()
{
    Tcl_SavedResult state;

    Tcl_SaveResult(magicinterp, &state);
    Tcl_Eval(magicinterp, "::flush stderr");
    Tcl_RestoreResult(magicinterp, &state);
}

/*--------------------------------------------------------------*/

void
TxFlushOut()
{
    Tcl_SavedResult state;

    Tcl_SaveResult(magicinterp, &state);
    Tcl_Eval(magicinterp, "::flush stdout");
    Tcl_RestoreResult(magicinterp, &state);
}

/*--------------------------------------------------------------*/

void
TxFlush()
{
    TxFlushOut();
    TxFlushErr();
}

/*--------------------------------------------------------------*/
/* Tcl_printf() replaces vfprintf() for use by every Tx output	*/
/* function (namely, TxError() for stderr and TxPrintf() for	*/
/* stdout).  It changes the result to a Tcl "puts" call, which	*/
/* can be changed inside Tcl, as, for example, by TkCon.	*/
/*--------------------------------------------------------------*/

int
Tcl_printf(f, fmt, args)
    FILE *f;
    char *fmt;
    va_list args;
{
    static char outstr[128] = "puts -nonewline std";
    char *outptr, *bigstr = NULL, *finalstr = NULL;
    int i, nchars, result, escapes = 0, limit;
    Tcl_Interp *printinterp = (TxTkConsole) ? consoleinterp : magicinterp;

    strcpy (outstr + 19, (f == stderr) ? "err \"" : "out \"");

    outptr = outstr;
    nchars = vsnprintf(outptr + 24, 102, fmt, args);
    if (nchars >= 102)
    {
	bigstr = Tcl_Alloc(nchars + 26);
	strncpy(bigstr, outptr, 24);
	outptr = bigstr;
	vsnprintf(outptr + 24, nchars + 2, fmt, args);
    }
    else if (nchars == -1) nchars = 126;

    for (i = 24; *(outptr + i) != '\0'; i++)
	if (*(outptr + i) == '\"' || *(outptr + i) == '[' ||
	    	*(outptr + i) == ']' || *(outptr + i) == '\\')
	    escapes++;

    if (escapes > 0)
    {
	finalstr = Tcl_Alloc(nchars + escapes + 26);
	strncpy(finalstr, outptr, 24);
	escapes = 0;
	for (i = 24; *(outptr + i) != '\0'; i++)
	{
	    if (*(outptr + i) == '\"' || *(outptr + i) == '[' ||
	    		*(outptr + i) == ']' || *(outptr + i) == '\\')
	    {
	        *(finalstr + i + escapes) = '\\';
		escapes++;
	    }
	    *(finalstr + i + escapes) = *(outptr + i);
	}
        outptr = finalstr;
    }

    *(outptr + 24 + nchars + escapes) = '\"';
    *(outptr + 25 + nchars + escapes) = '\0';

    result = Tcl_Eval(printinterp, outptr);

    if (bigstr != NULL) Tcl_Free(bigstr);
    if (finalstr != NULL) Tcl_Free(finalstr);

    return result;
}
    
/*--------------------------------------------------------------*/
/* Tcl_escape() takes a string as input and produces a string	*/
/* in which characters are escaped as necessary to make them	*/
/* printable from Tcl.  The new string is allocated by		*/
/* Tcl_Alloc() which needs to be free'd with Tcl_Free().	*/
/*--------------------------------------------------------------*/

char *
Tcl_escape(instring)
    char *instring;
{
    char *newstr;
    int nchars = 0;
    int escapes = 0;
    int i;

    for (i = 0; *(instring + i) != '\0'; i++)
    {
	nchars++;
	if (*(instring + i) == '\"' || *(instring + i) == '[' ||
	    	*(instring + i) == ']')
	    escapes++;
    }

    newstr = Tcl_Alloc(nchars + escapes + 1);
    escapes = 0;
    for (i = 0; *(instring + i) != '\0'; i++)
    {
	if (*(instring + i) == '\"' || *(instring + i) == '[' ||
	    		*(instring + i) == ']')
	{
	        *(newstr + i + escapes) = '\\';
		escapes++;
	}
	*(newstr + i + escapes) = *(instring + i);
    }
    *(newstr + i + escapes) = '\0';
    return newstr;
}

/*--------------------------------------------------------------*/
/* Provide input to Tcl from outside the terminal window by	*/
/* stacking the "stdin" channel.				*/
/*--------------------------------------------------------------*/

typedef struct {
    Tcl_Channel channel;	/* This is all the info we need */
    int fd;
} FileState;

/*--------------------------------------------------------------*/

int
TerminalInputProc(instanceData, buf, toRead, errorCodePtr)
    ClientData instanceData;
    char *buf;
    int toRead;
    int *errorCodePtr;
{
    FileState *fsPtr = (FileState *) instanceData;
    int bytesRead, i, tlen;
    char *locbuf;

    *errorCodePtr = 0;

    TxInputRedirect = False;
    if (TxBuffer != NULL) {
       tlen = strlen(TxBuffer);
       if (tlen < toRead) {
          strcpy(buf, TxBuffer);
	  Tcl_Free(TxBuffer);
	  TxBuffer = NULL;
	  return tlen;
       }
       else {
	  strncpy(buf, TxBuffer, toRead);
	  locbuf = Tcl_Alloc(tlen - toRead + 1);
	  strcpy(locbuf, TxBuffer + toRead);
	  Tcl_Free(TxBuffer);
	  TxBuffer = locbuf;
	  return toRead;
       }
    }

    bytesRead = read(fsPtr->fd, buf, (size_t) toRead);
    if (bytesRead > -1)
	return bytesRead;

    *errorCodePtr = errno;
    return -1;
}

/*--------------------------------------------------------------*/

int
Tclmagic_Init(interp)
    Tcl_Interp *interp;
{
    extern char *windCommands[];
    int n;
    char keyword[100];
    char *kwptr = keyword + 7;
    char *cadhome;

    /* Sanity check! */
    if (interp == NULL) return TCL_ERROR;

    /* Remember the interpreter */
    magicinterp = interp;

    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) return TCL_ERROR;

    /* Set initial command structure, so that magic doesn't	 */
    /* fault when running commands before magic::start is called */

    TxCurCommand.tx_p.p_x = 20;
    TxCurCommand.tx_p.p_y = 20;
    TxCurCommand.tx_wid = WIND_UNKNOWN_WINDOW;

    /* Use namespace to avoid conflicts with existing commands */
    strcpy(keyword, "magic::");

    for (n = 0; CmdLongCommands[n] != NULL; n++)
    {
	sscanf(CmdLongCommands[n], "%s ", kwptr); /* get first word */
	Tcl_CreateCommand(interp, keyword, _tcl_dispatch,
			(ClientData)NULL, (Tcl_CmdDeleteProc *) NULL);
    }
    for (n = 0; windCommands[n] != NULL; n++)
    {
	sscanf(windCommands[n], "%s ", kwptr); /* get first word */
	Tcl_CreateCommand(interp, keyword, _tcl_dispatch,
			(ClientData)NULL, (Tcl_CmdDeleteProc *) NULL);
    }

    /* Start command */
    Tcl_CreateCommand(interp, "magic::start", _magic_start,
			(ClientData)NULL, (Tcl_CmdDeleteProc *) NULL);

    /* Extra commands provided by the Tk graphics routines	*/
    /* (See graphics/grTkCommon.c)				*/

    RegisterTkCommands(interp);

    /* Initialize the command-tag callback feature */

    HashInit(&txTclTagTable, 10, HT_STRINGKEYS);
    Tcl_CreateCommand(interp, "magic::tag", AddCommandTag,
			(ClientData)NULL, (Tcl_CmdDeleteProc *) NULL);

    /* Add the magic TCL directory to the Tcl library search path */

    Tcl_Eval(interp, "lappend auto_path " TCL_DIR );

    /* Export the namespace commands */

    Tcl_Eval(interp, "namespace eval magic namespace export *");

    /* Set $CAD_HOME as a Tcl variable */

    cadhome = getenv("CAD_HOME");
    if (cadhome == NULL) cadhome = CAD_DIR;

    Tcl_SetVar(interp, "CAD_HOME", cadhome, TCL_GLOBAL_ONLY);

    Tcl_PkgProvide(interp, "Tclmagic", "7.2");
    return TCL_OK;
}
