* *	This procedure is invoked to process the "return" Tcl command. *	See the user documentation for details on what it does. * * Results: *	A standard Tcl result. * * Side effects: *	See the user documentation. * *---------------------------------------------------------------------- */	/* ARGSUSED */intTcl_ReturnCmd(dummy, interp, argc, argv)    ClientData dummy;			/* Not used. */    Tcl_Interp *interp;			/* Current interpreter. */    int argc;				/* Number of arguments. */    char **argv;			/* Argument strings. */{    if (argc > 2) {	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],		" ?value?\"", (char *) NULL);	return TCL_ERROR;    }    if (argc == 2) {	Tcl_SetResult(interp, argv[1], TCL_VOLATILE);    }    return TCL_RETURN;}/* *---------------------------------------------------------------------- * * Tcl_ScanCmd -- * *	This procedure is invoked to process the "scan" Tcl command. *	See the user documentation for details on what it does. * * Results: *	A standard Tcl result. * * Side effects: *	See the user documentation. * *---------------------------------------------------------------------- */	/* ARGSUSED */intTcl_ScanCmd(dummy, interp, argc, argv)    ClientData dummy;			/* Not used. */    Tcl_Interp *interp;			/* Current interpreter. */    int argc;				/* Number of arguments. */    char **argv;			/* Argument strings. */{    int arg1Length;			/* Number of bytes in argument to be					 * scanned.  This gives an upper limit					 * on string field sizes. */#   define MAX_FIELDS 20    typedef struct {	char fmt;			/* Format for field. */	int size;			/* How many bytes to allow for					 * field. */	char *location;			/* Where field will be stored. */    } Field;    Field fields[MAX_FIELDS];		/* Info about all the fields in the					 * format string. */    register Field *curField;    int numFields = 0;			/* Number of fields actually					 * specified. */    int suppress;			/* Current field is assignment-					 * suppressed. */    int totalSize = 0;			/* Number of bytes needed to store					 * all results combined. */    char *results;			/* Where scanned output goes.  */    int numScanned;			/* sscanf's result. */    register char *fmt;    int i, widthSpecified;    if (argc < 3) {	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],		" string format ?varName varName ...?\"", (char *) NULL);	return TCL_ERROR;    }    /*     * This procedure operates in four stages:     * 1. Scan the format string, collecting information about each field.     * 2. Allocate an array to hold all of the scanned fields.     * 3. Call sscanf to do all the dirty work, and have it store the     *    parsed fields in the array.     * 4. Pick off the fields from the array and assign them to variables.     */    arg1Length = (strlen(argv[1]) + 4) & ~03;    for (fmt = argv[2]; *fmt != 0; fmt++) {	if (*fmt != '%') {	    continue;	}	fmt++;	if (*fmt == '*') {	    suppress = 1;	    fmt++;	} else {	    suppress = 0;	}	widthSpecified = 0;	while (isdigit(*fmt)) {	    widthSpecified = 1;	    fmt++;	}	if (suppress) {	    continue;	}	if (numFields == MAX_FIELDS) {	    interp->result = "too many fields to scan";	    return TCL_ERROR;	}	curField = &fields[numFields];	numFields++;	switch (*fmt) {	    case 'D':	    case 'O':	    case 'X':	    case 'd':	    case 'o':	    case 'x':		curField->fmt = 'd';		curField->size = sizeof(int);		break;	    case 's':		curField->fmt = 's';		curField->size = arg1Length;		break;	    case 'c':                if (widthSpecified) {                    interp->result =                          "field width may not be specified in %c conversion";                    return TCL_ERROR;                }		curField->fmt = 'c';		curField->size = sizeof(int);		break;	    case 'E':	    case 'F':		curField->fmt = 'F';		curField->size = sizeof(double);		break;	    case 'e':	    case 'f':		curField->fmt = 'f';		curField->size = sizeof(float);		break;	    case '[':		curField->fmt = 's';		curField->size = arg1Length;		do {		    fmt++;		} while (*fmt != ']');		break;	    default:		sprintf(interp->result, "bad scan conversion character \"%c\"",			*fmt);		return TCL_ERROR;	}	totalSize += curField->size;    }    if (numFields != (argc-3)) {	interp->result =		"different numbers of variable names and field specifiers";	return TCL_ERROR;    }    /*     * Step 2:     */    results = (char *) ckalloc((unsigned) totalSize);    for (i = 0, totalSize = 0, curField = fields;	    i < numFields; i++, curField++) {	curField->location = results + totalSize;	totalSize += curField->size;    }    /*     * Fill in the remaining fields with NULL;  the only purpose of     * this is to keep some memory analyzers, like Purify, from     * complaining.     */    for ( ; i < MAX_FIELDS; i++, curField++) {	curField->location = NULL;    }    /*     * Step 3:     */    numScanned = sscanf(argv[1], argv[2],	    fields[0].location, fields[1].location, fields[2].location,	    fields[3].location, fields[4].location, fields[5].location,	    fields[6].location, fields[7].location, fields[8].location,	    fields[9].location, fields[10].location, fields[11].location,	    fields[12].location, fields[13].location, fields[14].location,	    fields[15].location, fields[16].location, fields[17].location,	    fields[18].location, fields[19].location);    /*     * Step 4:     */    if (numScanned < numFields) {	numFields = numScanned;    }    for (i = 0, curField = fields; i < numFields; i++, curField++) {	switch (curField->fmt) {	    char string[120];	    case 'd':		sprintf(string, "%d", *((int *) curField->location));		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {		    storeError:		    Tcl_AppendResult(interp,			    "couldn't set variable \"", argv[i+3], "\"",			    (char *) NULL);		    ckfree((char *) results);		    return TCL_ERROR;		}		break;	    case 'c':		sprintf(string, "%d", *((char *) curField->location) & 0xff);		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {		    goto storeError;		}		break;	    case 's':		if (Tcl_SetVar(interp, argv[i+3], curField->location, 0)			== NULL) {		    goto storeError;		}		break;	    case 'F':		sprintf(string, "%g", *((double *) curField->location));		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {		    goto storeError;		}		break;	    case 'f':		sprintf(string, "%g", *((float *) curField->location));		if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {		    goto storeError;		}		break;	}    }    ckfree(results);    sprintf(interp->result, "%d", numScanned);    return TCL_OK;}/* *---------------------------------------------------------------------- * * Tcl_SplitCmd -- * *	This procedure is invoked to process the "split" Tcl command. *	See the user documentation for details on what it does. * * Results: *	A standard Tcl result. * * Side effects: *	See the user documentation. * *---------------------------------------------------------------------- */	/* ARGSUSED */intTcl_SplitCmd(dummy, interp, argc, argv)    ClientData dummy;			/* Not used. */    Tcl_Interp *interp;			/* Current interpreter. */    int argc;				/* Number of arguments. */    char **argv;			/* Argument strings. */{    char *splitChars;    register char *p, *p2;    char *elementStart;    if (argc == 2) {	splitChars = " \n\t\r";    } else if (argc == 3) {	splitChars = argv[2];    } else {	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],		" string ?splitChars?\"", (char *) NULL);	return TCL_ERROR;    }    /*     * Handle the special case of splitting on every character.     */    if (*splitChars == 0) {	char string[2];	string[1] = 0;	for (p = argv[1]; *p != 0; p++) {	    string[0] = *p;	    Tcl_AppendElement(interp, string, 0);	}	return TCL_OK;    }    /*     * Normal case: split on any of a given set of characters.     * Discard instances of the split characters.     */    for (p = elementStart = argv[1]; *p != 0; p++) {	char c = *p;	for (p2 = splitChars; *p2 != 0; p2++) {	    if (*p2 == c) {		*p = 0;		Tcl_AppendElement(interp, elementStart, 0);		*p = c;		elementStart = p+1;		break;	    }	}    }    if (p != argv[1]) {	Tcl_AppendElement(interp, elementStart, 0);    }    return TCL_OK;}/* *---------------------------------------------------------------------- * * Tcl_StringCmd -- * *	This procedure is invoked to process the "string" Tcl command. *	See the user documentation for details on what it does. * * Results: *	A standard Tcl result. * * Side effects: *	See the user documentation. * *---------------------------------------------------------------------- */	/* ARGSUSED */intTcl_StringCmd(dummy, interp, argc, argv)    ClientData dummy;			/* Not used. */    Tcl_Interp *interp;			/* Current interpreter. */    int argc;				/* Number of arguments. */    char **argv;			/* Argument strings. */{    int length;    register char *p, c;    int match;    int first;    int left = 0, right = 0;    if (argc < 2) {	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],		" option arg ?arg ...?\"", (char *) NULL);	return TCL_ERROR;    }    c = argv[1][0];    length = strlen(argv[1]);    if ((c == 'c') && (strncmp(argv[1], "compare", length) == 0)) {	if (argc != 4) {	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],		    " compare string1 string2\"", (char *) NULL);	    return TCL_ERROR;	}	match = strcmp(argv[2], argv[3]);	if (match > 0) {	    interp->result = "1";	} else if (match < 0) {	    interp->result = "-1";	} else {	    interp->result = "0";	}	return TCL_OK;    } else if ((c == 'f') && (strncmp(argv[1], "first", length) == 0)) {	if (argc != 4) {	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],		    " first string1 string2\"", (char *) NULL);	    return TCL_ERROR;	}	first = 1;	firstLast:	match = -1;	c = *argv[2];	length = strlen(argv[2]);	for (p = argv[3]; *p != 0; p++) {	    if (*p != c) {		continue;	    }	    if (strncmp(argv[2], p, length) == 0) {		match = p-argv[3];		if (first) {		    break;		}	    }	}	sprintf(interp->result, "%d", match);	return TCL_OK;    } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)) {	long index;	if (argc != 4) {	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],		    " index string charIndex\"", (char *) NULL);	    return TCL_ERROR;	}	if (Tcl_GetInt(interp, argv[3], &index) != TCL_OK) {	    return TCL_ERROR;	}	if ((index >= 0) && (index < strlen(argv[2]))) {	    interp->result[0] = argv[2][index];	    interp->result[1] = 0;	}	return TCL_OK;    } else if ((c == 'l') && (strncmp(argv[1], "last", length) == 0)	    && (length >= 2)) {	if (argc != 4) {	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],		    " last string1 string2\"", (char *) NULL);	    return TCL_ERROR;	}	first = 0;	goto firstLast;    } else if ((c == 'l') && (strncmp(argv[1], "length", length) == 0)	    && (length >= 2)) {	if (argc != 3) {	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],		    " length string\"", (char *) NULL);	    return TCL_ERROR;	}	sprintf(interp->result, "%d", strlen(argv[2]));	return TCL_OK;    } else if ((c == 'm') && (strncmp(argv[1], "match", length) == 0)) {	if (argc != 4) {	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],		    " match pattern string\"", (char *) NULL);	    return TCL_ERROR;	}	if (Tcl_StringMatch(argv[3], argv[2]) != 0) {	    interp->result = "1";	} else {	    interp->result = "0";	}	return TCL_OK;    } else if ((c == 'r') && (strncmp(argv[1], "range", length) == 0)) {	long first, last;	int stringLength;	if (argc != 5) {	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],		    " range string first last\"", (char *) NULL);