/* 

 * tclUtil.c --

 *

 *	This file contains utility procedures that are used by many Tcl

 *	commands.

 *

 * Copyright (c) 1987-1993 The Regents of the University of California.

 * Copyright (c) 1994-1998 Sun Microsystems, Inc.

 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.

 * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

 *

 * See the file "license.terms" for information on usage and redistribution

 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 *

 *  RCS: @(#) $Id: tclUtil.c,v 1.36.2.8 2007/05/10 18:23:58 dgp Exp $

 */

#include "tclInt.h"

#include "tclPort.h"

#if defined(__SYMBIAN32__) 

#include "tclSymbianGlobals.h"

#endif 

/*

 * The following variable holds the full path name of the binary

 * from which this application was executed, or NULL if it isn't

 * know.  The value of the variable is set by the procedure

 * Tcl_FindExecutable.  The storage space is dynamically allocated.

 */

#if !defined(__SYMBIAN32__) || !defined(__WINSCW__)

char *tclExecutableName = NULL;

char *tclNativeExecutableName = NULL;

#endif

/*

 * The following values are used in the flags returned by Tcl_ScanElement

 * and used by Tcl_ConvertElement.  The value TCL_DONT_USE_BRACES is also

 * defined in tcl.h;  make sure its value doesn't overlap with any of the

 * values below.

 *

 * TCL_DONT_USE_BRACES -	1 means the string mustn't be enclosed in

 *				braces (e.g. it contains unmatched braces,

 *				or ends in a backslash character, or user

 *				just doesn't want braces);  handle all

 *				special characters by adding backslashes.

 * USE_BRACES -			1 means the string contains a special

 *				character that can be handled simply by

 *				enclosing the entire argument in braces.

 * BRACES_UNMATCHED -		1 means that braces aren't properly matched

 *				in the argument.

 */

#define USE_BRACES		2

#define BRACES_UNMATCHED	4

/*

 * The following values determine the precision used when converting

 * floating-point values to strings.  This information is linked to all

 * of the tcl_precision variables in all interpreters via the procedure

 * TclPrecTraceProc.

 */

static char precisionString[10] = "12";

				/* The string value of all the tcl_precision

				 * variables. */

static char precisionFormat[10] = "%.12g";

				/* The format string actually used in calls

				 * to sprintf. */

TCL_DECLARE_MUTEX(precisionMutex)

/*

 * Prototypes for procedures defined later in this file.

 */

static void UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr));

static int SetEndOffsetFromAny _ANSI_ARGS_((Tcl_Interp* interp,

					    Tcl_Obj* objPtr));

/*

 * The following is the Tcl object type definition for an object

 * that represents a list index in the form, "end-offset".  It is

 * used as a performance optimization in TclGetIntForIndex.  The

 * internal rep is an integer, so no memory management is required

 * for it.

 */

Tcl_ObjType tclEndOffsetType = {

    "end-offset",			/* name */

    (Tcl_FreeInternalRepProc*) NULL,    /* freeIntRepProc */

    (Tcl_DupInternalRepProc*) NULL,     /* dupIntRepProc */

    UpdateStringOfEndOffset,		/* updateStringProc */

    SetEndOffsetFromAny    

};

/*

 *----------------------------------------------------------------------

 *

 * TclFindElement --

 *

 *	Given a pointer into a Tcl list, locate the first (or next)

 *	element in the list.

 *

 * Results:

 *	The return value is normally TCL_OK, which means that the

 *	element was successfully located.  If TCL_ERROR is returned

 *	it means that list didn't have proper list structure;

 *	the interp's result contains a more detailed error message.

 *

 *	If TCL_OK is returned, then *elementPtr will be set to point to the

 *	first element of list, and *nextPtr will be set to point to the

 *	character just after any white space following the last character

 *	that's part of the element. If this is the last argument in the

 *	list, then *nextPtr will point just after the last character in the

 *	list (i.e., at the character at list+listLength). If sizePtr is

 *	non-NULL, *sizePtr is filled in with the number of characters in the

 *	element.  If the element is in braces, then *elementPtr will point

 *	to the character after the opening brace and *sizePtr will not

 *	include either of the braces. If there isn't an element in the list,

 *	*sizePtr will be zero, and both *elementPtr and *termPtr will point

 *	just after the last character in the list. Note: this procedure does

 *	NOT collapse backslash sequences.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

int

TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,

	       bracePtr)

    Tcl_Interp *interp;		/* Interpreter to use for error reporting. 

				 * If NULL, then no error message is left

				 * after errors. */

    CONST char *list;		/* Points to the first byte of a string

				 * containing a Tcl list with zero or more

				 * elements (possibly in braces). */

    int listLength;		/* Number of bytes in the list's string. */

    CONST char **elementPtr;	/* Where to put address of first significant

				 * character in first element of list. */

    CONST char **nextPtr;	/* Fill in with location of character just

				 * after all white space following end of

				 * argument (next arg or end of list). */

    int *sizePtr;		/* If non-zero, fill in with size of

				 * element. */

    int *bracePtr;		/* If non-zero, fill in with non-zero/zero

				 * to indicate that arg was/wasn't

				 * in braces. */

{

    CONST char *p = list;

    CONST char *elemStart;	/* Points to first byte of first element. */

    CONST char *limit;		/* Points just after list's last byte. */

    int openBraces = 0;		/* Brace nesting level during parse. */

    int inQuotes = 0;

    int size = 0;		/* lint. */

    int numChars;

    CONST char *p2;

    /*

     * Skim off leading white space and check for an opening brace or

     * quote. We treat embedded NULLs in the list as bytes belonging to

     * a list element.

     */

    limit = (list + listLength);

    while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */

	p++;

    }

    if (p == limit) {		/* no element found */

	elemStart = limit;

	goto done;

    }

    if (*p == '{') {

	openBraces = 1;

	p++;

    } else if (*p == '"') {

	inQuotes = 1;

	p++;

    }

    elemStart = p;

    if (bracePtr != 0) {

	*bracePtr = openBraces;

    }

    /*

     * Find element's end (a space, close brace, or the end of the string).

     */

    while (p < limit) {

	switch (*p) {

	    /*

	     * Open brace: don't treat specially unless the element is in

	     * braces. In this case, keep a nesting count.

	     */

	    case '{':

		if (openBraces != 0) {

		    openBraces++;

		}

		break;

	    /*

	     * Close brace: if element is in braces, keep nesting count and

	     * quit when the last close brace is seen.

	     */

	    case '}':

		if (openBraces > 1) {

		    openBraces--;

		} else if (openBraces == 1) {

		    size = (p - elemStart);

		    p++;

		    if ((p >= limit)

			    || isspace(UCHAR(*p))) { /* INTL: ISO space. */

			goto done;

		    }

		    /*

		     * Garbage after the closing brace; return an error.

		     */

		    if (interp != NULL) {

			char buf[100];

			p2 = p;

			while ((p2 < limit)

				&& (!isspace(UCHAR(*p2))) /* INTL: ISO space. */

			        && (p2 < p+20)) {

			    p2++;

			}

			sprintf(buf,

				"list element in braces followed by \"%.*s\" instead of space",

				(int) (p2-p), p);

			Tcl_SetResult(interp, buf, TCL_VOLATILE);

		    }

		    return TCL_ERROR;

		}

		break;

	    /*

	     * Backslash:  skip over everything up to the end of the

	     * backslash sequence.

	     */

	    case '\\': {

		Tcl_UtfBackslash(p, &numChars, NULL);

		p += (numChars - 1);

		break;

	    }

	    /*

	     * Space: ignore if element is in braces or quotes; otherwise

	     * terminate element.

	     */

	    case ' ':

	    case '\f':

	    case '\n':

	    case '\r':

	    case '\t':

	    case '\v':

		if ((openBraces == 0) && !inQuotes) {

		    size = (p - elemStart);

		    goto done;

		}

		break;

	    /*

	     * Double-quote: if element is in quotes then terminate it.

	     */

	    case '"':

		if (inQuotes) {

		    size = (p - elemStart);

		    p++;

		    if ((p >= limit)

			    || isspace(UCHAR(*p))) { /* INTL: ISO space */

			goto done;

		    }

		    /*

		     * Garbage after the closing quote; return an error.

		     */

		    if (interp != NULL) {

			char buf[100];

			p2 = p;

			while ((p2 < limit)

				&& (!isspace(UCHAR(*p2))) /* INTL: ISO space */

				 && (p2 < p+20)) {

			    p2++;

			}

			sprintf(buf,

				"list element in quotes followed by \"%.*s\" %s",

				(int) (p2-p), p, "instead of space");

			Tcl_SetResult(interp, buf, TCL_VOLATILE);

		    }

		    return TCL_ERROR;

		}

		break;

	}

	p++;

    }

    /*

     * End of list: terminate element.

     */

    if (p == limit) {

	if (openBraces != 0) {

	    if (interp != NULL) {

		Tcl_SetResult(interp, "unmatched open brace in list",

			TCL_STATIC);

	    }

	    return TCL_ERROR;

	} else if (inQuotes) {

	    if (interp != NULL) {

		Tcl_SetResult(interp, "unmatched open quote in list",

			TCL_STATIC);

	    }

	    return TCL_ERROR;

	}

	size = (p - elemStart);

    }

    done:

    while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */

	p++;

    }

    *elementPtr = elemStart;

    *nextPtr = p;

    if (sizePtr != 0) {

	*sizePtr = size;

    }

    return TCL_OK;

}

/*

 *----------------------------------------------------------------------

 *

 * TclCopyAndCollapse --

 *

 *	Copy a string and eliminate any backslashes that aren't in braces.

 *

 * Results:

 *	Count characters get copied from src to	dst. Along the way, if

 *	backslash sequences are found outside braces, the backslashes are

 *	eliminated in the copy. After scanning count chars from source, a

 *	null character is placed at the end of dst.  Returns the number

 *	of characters that got copied.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

int

TclCopyAndCollapse(count, src, dst)

    int count;			/* Number of characters to copy from src. */

    CONST char *src;		/* Copy from here... */

    char *dst;			/* ... to here. */

{

    register char c;

    int numRead;

    int newCount = 0;

    int backslashCount;

    for (c = *src;  count > 0;  src++, c = *src, count--) {

	if (c == '\\') {

	    backslashCount = Tcl_UtfBackslash(src, &numRead, dst);

	    dst += backslashCount;

	    newCount += backslashCount;

	    src += numRead-1;

	    count -= numRead-1;

	} else {

	    *dst = c;

	    dst++;

	    newCount++;

	}

    }

    *dst = 0;

    return newCount;

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_SplitList --

 *

 *	Splits a list up into its constituent fields.

 *

 * Results

 *	The return value is normally TCL_OK, which means that

 *	the list was successfully split up.  If TCL_ERROR is

 *	returned, it means that "list" didn't have proper list

 *	structure;  the interp's result will contain a more detailed

 *	error message.

 *

 *	*argvPtr will be filled in with the address of an array

 *	whose elements point to the elements of list, in order.

 *	*argcPtr will get filled in with the number of valid elements

 *	in the array.  A single block of memory is dynamically allocated

 *	to hold both the argv array and a copy of the list (with

 *	backslashes and braces removed in the standard way).

 *	The caller must eventually free this memory by calling free()

 *	on *argvPtr.  Note:  *argvPtr and *argcPtr are only modified

 *	if the procedure returns normally.

 *

 * Side effects:

 *	Memory is allocated.

 *

 *----------------------------------------------------------------------

 */

EXPORT_C int

Tcl_SplitList(interp, list, argcPtr, argvPtr)

    Tcl_Interp *interp;		/* Interpreter to use for error reporting. 

				 * If NULL, no error message is left. */

    CONST char *list;		/* Pointer to string with list structure. */

    int *argcPtr;		/* Pointer to location to fill in with

				 * the number of elements in the list. */

    CONST char ***argvPtr;	/* Pointer to place to store pointer to

				 * array of pointers to list elements. */

{

    CONST char **argv;

    CONST char *l;

    char *p;

    int length, size, i, result, elSize, brace;

    CONST char *element;

    /*

     * Figure out how much space to allocate.  There must be enough

     * space for both the array of pointers and also for a copy of

     * the list.  To estimate the number of pointers needed, count

     * the number of space characters in the list.

     */

    for (size = 2, l = list; *l != 0; l++) {

	if (isspace(UCHAR(*l))) { /* INTL: ISO space. */

	    size++;

	    /* Consecutive space can only count as a single list delimiter */

	    while (1) {

		char next = *(l + 1);

		if (next == '\0') {

		    break;

		}

		++l;

		if (isspace(UCHAR(next))) {

		    continue;

		}

		break;

	    }

	}

    }

    length = l - list;

    argv = (CONST char **) ckalloc((unsigned)

	    ((size * sizeof(char *)) + length + 1));

    for (i = 0, p = ((char *) argv) + size*sizeof(char *);

	    *list != 0;  i++) {

	CONST char *prevList = list;

	result = TclFindElement(interp, list, length, &element,

				&list, &elSize, &brace);

	length -= (list - prevList);

	if (result != TCL_OK) {

	    ckfree((char *) argv);

	    return result;

	}

	if (*element == 0) {

	    break;

	}

	if (i >= size) {

	    ckfree((char *) argv);

	    if (interp != NULL) {

		Tcl_SetResult(interp, "internal error in Tcl_SplitList",

			TCL_STATIC);

	    }

	    return TCL_ERROR;

	}

	argv[i] = p;

	if (brace) {

	    memcpy((VOID *) p, (VOID *) element, (size_t) elSize);

	    p += elSize;

	    *p = 0;

	    p++;

	} else {

	    TclCopyAndCollapse(elSize, element, p);

	    p += elSize+1;

	}

    }

    argv[i] = NULL;

    *argvPtr = argv;

    *argcPtr = i;

    return TCL_OK;

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_ScanElement --

 *

 *	This procedure is a companion procedure to Tcl_ConvertElement.

 *	It scans a string to see what needs to be done to it (e.g. add

 *	backslashes or enclosing braces) to make the string into a

 *	valid Tcl list element.

 *

 * Results:

 *	The return value is an overestimate of the number of characters

 *	that will be needed by Tcl_ConvertElement to produce a valid

 *	list element from string.  The word at *flagPtr is filled in

 *	with a value needed by Tcl_ConvertElement when doing the actual

 *	conversion.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

EXPORT_C int