/*
 * General NeoSoft Extension Routines
 *
 *
 * $Id: neoXgeneral.c,v 1.1.1.1 1999/03/31 20:34:37 damon Exp $
 *
 */

#include "neo.h"
#include "util_md5.h"


/*
 *----------------------------------------------------------------------
 *
 * Neo_Incr0ObjCmd --
 *
 *	This procedure is invoked to process the "incr0" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
int
Neo_Incr0ObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj   *CONST objv[];
{
    int           value;
    Tcl_Obj      *objectPtr;
    int           increment;

    if ((objc != 2) && (objc != 3))
	return TclX_WrongArgs (interp, objv [0], " varName ?increment?\"");

    /* Get the increment amount.  If it wasn't explicitly specified, set it
     * to 1 */
    if (objc == 3) {
	if (Tcl_GetIntFromObj (interp, objv [2], &increment) != TCL_OK)
	    return TCL_ERROR;
    } else {
	increment = 1;
    }

    /* Does the variable already exist? */
    objectPtr = Tcl_ObjGetVar2 (interp, objv [1], NULL, TCL_PARSE_PART1);
    if (objectPtr == NULL) {

	/* No, create it with a default value of zero plus the increment.
	 * (in other words, the increment.) */

	Tcl_Obj *returnObj;
	Tcl_Obj *incrObj = Tcl_NewIntObj (increment);

	if ((returnObj = 
	    Tcl_ObjSetVar2 (interp, objv [1], (Tcl_Obj *) NULL, incrObj,
	      TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1)) == NULL)
		return TCL_ERROR;

	Tcl_SetObjResult (interp, returnObj);

	return TCL_OK;
    }

    /* It did exist, get the integer value, increment, and set the result */
    if (Tcl_GetIntFromObj (interp, objectPtr, &value) != TCL_OK) 
	return TCL_ERROR;

    if (Tcl_IsShared(objectPtr)) {
	objectPtr = Tcl_DuplicateObj(objectPtr);
    }

    value += increment;
    Tcl_SetIntObj (objectPtr, value);
    Tcl_SetObjResult (interp, objectPtr);
    return TCL_OK; 
}

int
Neo_MD5ObjCmd (clientData, interp, objc, objv)
    ClientData  clientData;
    Tcl_Interp *interp;
    int         objc;
    Tcl_Obj   **objv;
{
    char *digest;
 
    if (objc != 2) {
        Tcl_SetResult(interp, "usage: md5 string", TCL_STATIC);
        return TCL_ERROR;
    }
    digest = md5(Tcl_GetStringFromObj(objv[1], (int*)NULL));
    Tcl_SetObjResult(interp, Tcl_NewStringObj(digest, -1));
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * Neo_SetdefaultObjCmd --
 *
 *	This procedure is invoked to process the "setdefault" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
int
Neo_SetdefaultObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj   *CONST objv[];
{
    Tcl_Obj *objectPtr;

    if (objc != 3)
	return TclX_WrongArgs (interp, objv [0], 
		" varName value");

    /* If the variable already exists, we are done. */
    objectPtr = Tcl_ObjGetVar2 (interp, objv [1], NULL, 0);
    if (objectPtr != NULL) return TCL_OK;

    /* It didn't, create the variable and make it contain the value passed */
    if (Tcl_ObjSetVar2 (interp, objv [1], (Tcl_Obj *) NULL, objv [2],
	    TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1) == NULL)
		return TCL_ERROR;
    Tcl_IncrRefCount (objv [2]);
    return TCL_OK;
}


/* 
 * Find the next unique element of a sortedlist.
 *
 * Side Effects:  index is updated.
 */
Tcl_Obj *Neo_nextUniqueElement (listObjPtrPtr, indexPtr, nElements)
Tcl_Obj         **listObjPtrPtr;
int             *indexPtr;
int              nElements;
{
    char        *thisString;
    char        *lastString;

    int          thisStringLength;
    int          lastStringLength;

    /* It's the first element of the list, an easy case as
     * we can't have seen this element already, so for sure
     * it's a winner (tho' matching dups may follow)
     */
    if (*indexPtr == 0 && nElements > 0) {
	return listObjPtrPtr[*indexPtr++];
    }

    while (1) {
	/* Nothing (or nothing more) in list?  We're done.  Return NULL */
	if (*indexPtr >= nElements) {
	    return NULL;
	}

	/* It's not the first element.  If it doesn't match the preceding
	 * one, let it fly.
	 */
	thisString = Tcl_GetStringFromObj (listObjPtrPtr[*indexPtr], &thisStringLength);
	lastString = Tcl_GetStringFromObj (listObjPtrPtr[*indexPtr - 1], &lastStringLength);

	if (!STREQU (thisString, lastString)) {
	    return listObjPtrPtr[*indexPtr++];
	}

	/* It did match the preceding one, just increment the pointer.
	 */
	indexPtr++;
    }
    /* NOTREACHED */
}


/*
 *----------------------------------------------------------------------
 *
 * Neo_Intersect3ObjCmd --
 *
 *	This procedure is invoked to process the "intersect3" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
int
Neo_Intersect3ObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj   *CONST objv[];
{
    Tcl_Obj        *inFirstList;
    Tcl_Obj        *inBothLists;
    Tcl_Obj        *inLastList;

    Tcl_Obj       **firstListObjv;
    int             firstListObjc;

    Tcl_Obj       **lastListObjv;
    int             lastListObjc;

    char           *firstString;
    char           *lastString;

    int             firstStringLength;
    int             lastStringLength;

    int             firstIndex;
    int             lastIndex;

    Tcl_Obj        *firstListElement;
    Tcl_Obj        *lastListElement;

    if (objc != 3)
	return TclX_WrongArgs (interp, objv [0], 
		" list1 list2");

    /* 
     * Convert the two lists into list objects.
     */

    if (Tcl_ListObjGetElements (interp, 
				objv [1], 
				&firstListObjc, 
				&firstListObjv) == TCL_ERROR) {
	return TCL_ERROR;
    }
	
    if (Tcl_ListObjGetElements (interp, 
				objv [2], 
				&lastListObjc, 
				&lastListObjv) == TCL_ERROR) {
	return TCL_ERROR;
    }
	
    /*
     * Create new object-style lists for the three output lists.
     */

    inFirstList = Tcl_NewListObj (0, NULL);
    inBothLists = Tcl_NewListObj (0, NULL);
    inLastList = Tcl_NewListObj (0, NULL);

    /* The code below encompasses about 90% of the cobol code
     * ever written...
     */
    firstIndex = 0;
    lastIndex = 0;

    firstListElement = Neo_nextUniqueElement (firstListObjv, &firstIndex, firstListObjc);
    lastListElement = Neo_nextUniqueElement (lastListObjv, &lastIndex, lastListObjc);
    while (1) {
	/* Is the first list done? */
	if (firstListElement == NULL) {

	    /* Yes, is the second list done? */
	    if (lastListElement == NULL) {
		/* Yes, the merge has completed. */
		break;
	    }

	    /* First list is done, but the second one is not...
	     * Copy the remainder of the second list to
	     * the inLastList list, and then we're done.
	     */
	     do {
		 Tcl_ListObjAppendElement (interp, inLastList, lastListElement);
	     } while ((lastListElement = Neo_nextUniqueElement (lastListObjv, &lastIndex, lastListObjc)) != NULL);
	     break;
	}

	/* Is the second list done? */
	if (lastListElement == NULL) {
	    /* Second list is done, but the first one is not...
	     * Copy the remainder of the first list to the
	     * inFirstList list, and then we're done.
	     */
	     do {
		 Tcl_ListObjAppendElement (interp, inFirstList, firstListElement);
	     } while ((firstListElement = Neo_nextUniqueElement (firstListObjv, &firstIndex, firstListObjc)) != NULL);
	     break;
	}

	/* Neither the first nor the second lists are done.
	 */
	firstString = Tcl_GetStringFromObj (firstListElement, &firstStringLength);
	lastString = Tcl_GetStringFromObj (lastListElement, &lastStringLength);
	switch (strcmp (firstString, lastString)) {
	    /* in first but not second */
	    case -1:
		Tcl_ListObjAppendElement (interp, inFirstList, firstListElement);
		firstListElement = Neo_nextUniqueElement (firstListObjv, &firstIndex, firstListObjc);
		break;

            /* in both */
	    case 0:
		Tcl_ListObjAppendElement (interp, inBothLists, firstListElement);
		firstListElement = Neo_nextUniqueElement (firstListObjv, &firstIndex, firstListObjc);
		lastListElement = Neo_nextUniqueElement (lastListObjv, &lastIndex, lastListObjc);
		break;

	    case 1:
		Tcl_ListObjAppendElement (interp, inLastList, lastListElement);
		lastListElement = Neo_nextUniqueElement (lastListObjv, &lastIndex, lastListObjc);
		break;
	}

    }

    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * Neo_ObjectObjCmd --
 *
 *	This procedure is invoked to process the "object" Neo command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
int
Neo_ObjectObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj   *CONST objv[];
{
    Tcl_Obj *objectPtr;
    char    *subString;
    Tcl_Obj *resultPtr = Tcl_GetObjResult (interp);

    if (objc < 2 || objc > 4) {
      err:
	return TclX_WrongArgs (interp, objv [0], "subcommand [arg]");
    }

    subString = Tcl_GetStringFromObj (objv [1], NULL);

    if (STREQU (subString, "types")) {
	if (objc != 2) goto err;

	return (Tcl_AppendAllObjTypes (interp, resultPtr));
    }

    if (STREQU (subString, "type")) {
	Tcl_Obj *objp = objv[2];

	if (objc != 3) goto err;

	if (objp->typePtr == NULL) {
	    return TCL_OK;
	}

	Tcl_SetStringObj (resultPtr, objp->typePtr->name, -1);
	return TCL_OK;
    }

    if (STREQU (subString, "convert")) {
	char          *typeName;
        Tcl_Obj       *objp = objv[2];
	Tcl_ObjType   *typeObjType;

       if (objc != 4) goto err;

       typeName = Tcl_GetStringFromObj (objv [3], NULL);

       if ((typeObjType = Tcl_GetObjType (typeName)) == NULL) {
	   Tcl_AddObjErrorInfo (interp, "unknown type '", -1);
	   Tcl_AddObjErrorInfo (interp, typeName, -1);
	   Tcl_AddObjErrorInfo (interp, "'", 1);
	   return TCL_ERROR;
       }

       if (Tcl_ConvertToType (interp, objp, typeObjType) == TCL_ERROR) {
	   Tcl_AddObjErrorInfo (interp, "while converting type", 1);
	   return TCL_ERROR;
       }
       return TCL_OK;
    }

    Tcl_SetStringObj (resultPtr, "bad # arg", -1);
    return TCL_ERROR;
}


/*
 *----------------------------------------------------------------------
 *
 * Neo_QuoteSqlObjCmd --
 *
 *	This procedure is invoked to process the "quote_sql" Neo command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
int
Neo_QuoteSqlObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj   *CONST objv[];
{
    char      *thisString;
    char      *stringPtr;
    char      *destPtr;
    char      *newStringPtr;
    int        idx;
    int        thisStringLength;
    int        newStringLength;
    int        needsQuoting = 0;
    Tcl_Obj   *newStringObj;

    if (objc != 2)
	return TclX_WrongArgs (interp, objv [0], "value");

    thisString = Tcl_GetStringFromObj (objv[1], &thisStringLength);

    newStringLength = thisStringLength * 2 + 3;
    newStringObj = Tcl_NewObj();
    Tcl_SetObjLength (newStringObj, newStringLength);
    newStringPtr = Tcl_GetStringFromObj (newStringObj, NULL);

    *newStringPtr = '\'';

    for (idx = 0, stringPtr = thisString, destPtr = newStringPtr + 1; 
	 idx < thisStringLength;
	 idx++, stringPtr++, destPtr++) {

	 switch (*stringPtr) {
	    case '\\':
	    case '\'':
		 *destPtr++ = '\\';
		 *destPtr = *stringPtr;
		 break;

	    case '\n':
		 *destPtr++ = '\\';
		 *destPtr = 'n';
		 break;

	    default:
		*destPtr = *stringPtr;
		break;
	 }
    }
    *destPtr++ = '\'';
    Tcl_SetObjLength (newStringObj, (destPtr - newStringPtr));
    Tcl_SetObjResult (interp, newStringObj);
    return TCL_OK;
}

int
Neo_initGeneral (interp)
Tcl_Interp	*interp;
{
    Tcl_CreateObjCommand (interp, "md5",
	Neo_MD5ObjCmd, (ClientData)0,
	(Tcl_CmdDeleteProc*)NULL);

    Tcl_CreateObjCommand (interp, "incr0",
	Neo_Incr0ObjCmd, (ClientData)0, 
	(Tcl_CmdDeleteProc*) NULL);

    Tcl_CreateObjCommand (interp, "setdefault",
	Neo_SetdefaultObjCmd, (ClientData)0, 
	(Tcl_CmdDeleteProc*) NULL);

    Tcl_CreateObjCommand (interp, "_intersect3",
	Neo_Intersect3ObjCmd, (ClientData)0, 
	(Tcl_CmdDeleteProc*) NULL);

    Tcl_CreateObjCommand (interp, "object",
	Neo_ObjectObjCmd, (ClientData)0, 
	(Tcl_CmdDeleteProc*) NULL);

    Tcl_CreateObjCommand (interp, "quote_sql",
	Neo_QuoteSqlObjCmd, (ClientData)0, 
	(Tcl_CmdDeleteProc*) NULL);

    return TCL_OK;
}
