tclcmdmz.c

linux系统下的音频通信

	    string2 = Tcl_GetStringFromObj(objv[3], &length2);

	    length = (length1 < length2) ? length1 : length2;
	    match = memcmp(string1, string2, (unsigned) length);
	    if (match == 0) {
	        match = length1 - length2;
	    }
	    Tcl_SetIntObj(resultPtr, (match > 0) ? 1 : (match < 0) ? -1 : 0);
	    break;
	}
	case STR_FIRST: {
	    register char *p, *end;
	    int match;

	    if (objc != 4) {
	        badFirstLastArgs:
	        Tcl_WrongNumArgs(interp, 2, objv, "string1 string2");
		return TCL_ERROR;
	    }

	    match = -1;
	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
	    if (length1 > 0) {
		end = string2 + length2 - length1 + 1;
		for (p = string2;  p < end;  p++) {
		  /*
		   * Scan forward to find the first character.
		   */
		    
		  p = memchr(p, *string1, (unsigned) (end - p));
		  if (p == NULL) {
		      break;
		  }
		  if (memcmp(string1, p, (unsigned) length1) == 0) {
		      match = p - string2;
		      break;
		  }
		}
	    }
	    Tcl_SetIntObj(resultPtr, match);
	    break;
	}
	case STR_INDEX: {
	    int index;

	    if (objc != 4) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string charIndex");
		return TCL_ERROR;
	    }

	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((index >= 0) && (index < length1)) {
	        Tcl_SetStringObj(resultPtr, string1 + index, 1);
	    }
	    break;
	}
	case STR_LAST: {
	    register char *p;
	    int match;

	    if (objc != 4) {
	        goto badFirstLastArgs;
	    }

	    match = -1;
	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
	    if (length1 > 0) {
		for (p = string2 + length2 - length1;  p >= string2;  p--) {
		    /*
		     * Scan backwards to find the first character.
		     */
		    
		    while ((p != string2) && (*p != *string1)) {
			p--;
		    }
		    if (memcmp(string1, p, (unsigned) length1) == 0) {
			match = p - string2;
			break;
		    }
		}
	    }
	    Tcl_SetIntObj(resultPtr, match);
	    break;
	}
	case STR_LENGTH: {
	    if (objc != 3) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string");
		return TCL_ERROR;
	    }

	    (void) Tcl_GetStringFromObj(objv[2], &length1);
	    Tcl_SetIntObj(resultPtr, length1);
	    break;
	}
	case STR_MATCH: {
	    if (objc != 4) {
	        Tcl_WrongNumArgs(interp, 2, objv, "pattern string");
		return TCL_ERROR;
	    }

	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    string2 = Tcl_GetStringFromObj(objv[3], &length2);
	    Tcl_SetBooleanObj(resultPtr, Tcl_StringMatch(string2, string1));
	    break;
	}
	case STR_RANGE: {
	    int first, last;

	    if (objc != 5) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string first last");
		return TCL_ERROR;
	    }

	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    if (TclGetIntForIndex(interp, objv[3], length1 - 1,
		    &first) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (TclGetIntForIndex(interp, objv[4], length1 - 1,
		    &last) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (first < 0) {
		first = 0;
	    }
	    if (last >= length1 - 1) {
		last = length1 - 1;
	    }
	    if (last >= first) {
	        Tcl_SetStringObj(resultPtr, string1 + first, last - first + 1);
	    }
	    break;
	}
	case STR_TOLOWER: {
	    register char *p, *end;

	    if (objc != 3) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string");
		return TCL_ERROR;
	    }

	    string1 = Tcl_GetStringFromObj(objv[2], &length1);

	    /*
	     * Since I know resultPtr is not a shared object, I can reach
	     * in and diddle the bytes in its string rep to convert them in
	     * place to lower case.
	     */

	    Tcl_SetStringObj(resultPtr, string1, length1);
	    string1 = Tcl_GetStringFromObj(resultPtr, &length1);
	    end = string1 + length1;
	    for (p = string1; p < end; p++) {
		if (isupper(UCHAR(*p))) {
		    *p = (char) tolower(UCHAR(*p));
		}
	    }
	    break;
	}
	case STR_TOUPPER: {
	    register char *p, *end;

	    if (objc != 3) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string");
		return TCL_ERROR;
	    }

	    string1 = Tcl_GetStringFromObj(objv[2], &length1);

	    /*
	     * Since I know resultPtr is not a shared object, I can reach
	     * in and diddle the bytes in its string rep to convert them in
	     * place to upper case.
	     */

	    Tcl_SetStringObj(resultPtr, string1, length1);
	    string1 = Tcl_GetStringFromObj(resultPtr, &length1);
	    end = string1 + length1;
	    for (p = string1; p < end; p++) {
		if (islower(UCHAR(*p))) {
		    *p = (char) toupper(UCHAR(*p));
		}
	    }
	    break;
	}
	case STR_TRIM: {
	    char ch;
	    register char *p, *end;
	    char *check, *checkEnd;

	    left = 1;
	    right = 1;

	    trim:
	    if (objc == 4) {
		string2 = Tcl_GetStringFromObj(objv[3], &length2);
	    } else if (objc == 3) {
		string2 = " \t\n\r";
		length2 = strlen(string2);
	    } else {
	        Tcl_WrongNumArgs(interp, 2, objv, "string ?chars?");
		return TCL_ERROR;
	    }
	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    checkEnd = string2 + length2;

	    if (left) {
		end = string1 + length1;
		for (p = string1; p < end; p++) {
		    ch = *p;
		    for (check = string2; ; check++) {
			if (check >= checkEnd) {
			    p = end;
			    break;
			}
			if (ch == *check) {
			    length1--;
			    string1++;
			    break;
			}
		    }
		}
	    }
	    if (right) {
	        end = string1;
		for (p = string1 + length1; p > end; ) {
		    p--;
		    ch = *p;
		    for (check = string2; ; check++) {
		        if (check >= checkEnd) {
			    p = end;
			    break;
			}
			if (ch == *check) {
			    length1--;
			    break;
			}
		    }
		}
	    }
	    Tcl_SetStringObj(resultPtr, string1, length1);
	    break;
	}
	case STR_TRIMLEFT: {
	    left = 1;
	    right = 0;
	    goto trim;
	}
	case STR_TRIMRIGHT: {
	    left = 0;
	    right = 1;
	    goto trim;
	}
	case STR_WORDEND: {
	    int cur, c;
	    
	    if (objc != 4) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string index");
		return TCL_ERROR;
	    }

	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
	        return TCL_ERROR;
	    }
	    if (index < 0) {
		index = 0;
	    }
	    cur = length1;
	    if (index < length1) {
		for (cur = index; cur < length1; cur++) {
		    c = UCHAR(string1[cur]);
		    if (!isalnum(c) && (c != '_')) {
			break;
		    }
		}
		if (cur == index) {
		    cur = index + 1;
		}
	    }
	    Tcl_SetIntObj(resultPtr, cur);
	    break;
	}
	case STR_WORDSTART: {
	    int cur, c;
	    
	    if (objc != 4) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string index");
		return TCL_ERROR;
	    }

	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (index >= length1) {
		index = length1 - 1;
	    }
	    cur = 0;
	    if (index > 0) {
	        for (cur = index; cur >= 0; cur--) {
		    c = UCHAR(string1[cur]);
		    if (!isalnum(c) && (c != '_')) {
			break;
		    }
		}
		if (cur != index) {
		    cur += 1;
		}
	    }
	    Tcl_SetIntObj(resultPtr, cur);
	    break;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SubstCmd --
 *
 *	This procedure is invoked to process the "subst" Tcl command.
 *	See the user documentation for details on what it does.  This
 *	command is an almost direct copy of an implementation by
 *	Andrew Payne.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_SubstCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_DString result;
    char *p, *old, *value;
    int code, count, doVars, doCmds, doBackslashes, i;
    size_t length;
    char c;

    /*
     * Parse command-line options.
     */

    doVars = doCmds = doBackslashes = 1;
    for (i = 1; i < (argc-1); i++) {
	p = argv[i];
	if (*p != '-') {
	    break;
	}
	length = strlen(p);
	if (length < 4) {
	    badSwitch:
	    Tcl_AppendResult(interp, "bad switch \"", p,
		    "\": must be -nobackslashes, -nocommands, ",
		    "or -novariables", (char *) NULL);
	    return TCL_ERROR;
	}
	if ((p[3] == 'b') && (strncmp(p, "-nobackslashes", length) == 0)) {
	    doBackslashes = 0;
	} else if ((p[3] == 'c') && (strncmp(p, "-nocommands", length) == 0)) {
	    doCmds = 0;
	} else if ((p[3] == 'v') && (strncmp(p, "-novariables", length) == 0)) {
	    doVars = 0;
	} else {
	    goto badSwitch;
	}
    }
    if (i != (argc-1)) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" ?-nobackslashes? ?-nocommands? ?-novariables? string\"",
		(char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Scan through the string one character at a time, performing
     * command, variable, and backslash substitutions.
     */

    Tcl_DStringInit(&result);
    old = p = argv[i];
    while (*p != 0) {
	switch (*p) {
	    case '\\':
		if (doBackslashes) {
		    if (p != old) {
			Tcl_DStringAppend(&result, old, p-old);
		    }
		    c = Tcl_Backslash(p, &count);
		    Tcl_DStringAppend(&result, &c, 1);
		    p += count;
		    old = p;
		} else {
		    p++;
		}
		break;

	    case '$':
		if (doVars) {
		    if (p != old) {
			Tcl_DStringAppend(&result, old, p-old);
		    }
		    value = Tcl_ParseVar(interp, p, &p);
		    if (value == NULL) {
			Tcl_DStringFree(&result);
			return TCL_ERROR;
		    }
		    Tcl_DStringAppend(&result, value, -1);
		    old = p;
		} else {
		    p++;
		}
		break;

	    case '[':
		if (doCmds) {
		    if (p != old) {
			Tcl_DStringAppend(&result, old, p-old);
		    }
		    iPtr->evalFlags = TCL_BRACKET_TERM;
		    code = Tcl_Eval(interp, p+1);
		    if (code == TCL_ERROR) {
			Tcl_DStringFree(&result);
			return code;
		    }
		    old = p = (p+1 + iPtr->termOffset+1);
		    Tcl_DStringAppend(&result, iPtr->result, -1);
		    Tcl_ResetResult(interp);
		} else {
		    p++;
		}
		break;

	    default:
		p++;
		break;
	}
    }
    if (p != old) {
	Tcl_DStringAppend(&result, old, p-old);
    }
    Tcl_DStringResult(interp, &result);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SwitchObjCmd --
 *
 *	This object-based procedure is invoked to process the "switch" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_SwitchObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
#define EXACT	0
#define GLOB	1
#define REGEXP	2
    int switchObjc, index;
    Tcl_Obj *CONST *switchObjv;
    Tcl_Obj *patternObj, *bodyObj;
    char *string, *pattern, *body;
    int splitObjs, length, patternLen, i, code, mode, matched, bodyIdx;
    static char *switches[] =
	    {"-exact", "-glob", "-regexp", "--", (char *) NULL};

    switchObjc = objc-1;
    switchObjv = objv+1;
    mode = EXACT;

    while (switchObjc > 0) {
	string = Tcl_GetStringFromObj(switchObjv[0], &length);
	if (*string != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, switchObjv[0], switches,
		"option", 0, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	    case 0:			/* -exact */
		mode = EXACT;
		break;
	    case 1:			/* -glob */
		mode = GLOB;
		break;
	    case 2:			/* -regexp */
		mode = REGEXP;
		break;
	    case 3:			/* -- */
		switchObjc--;
		switchObjv++;
		goto doneWithSwitches;
	}
	switchObjc--;
	switchObjv++;
    }

    doneWithSwitches:
    if (switchObjc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?switches? string pattern body ... ?default body?");
	return TCL_ERROR;
    }
    
    string = Tcl_GetStringFromObj(switchObjv[0], &length);
    switchObjc--;
    switchObjv++;

    /*
     * If all of the pattern/command pairs are lumped into a single
     * argument, split them out again.
     */

    splitObjs = 0;