tclutil.c

linux系统下的音频通信

	objPtr = objv[i];
	element = TclGetStringFromObj(objPtr, &length);
	if ((element != NULL) && (length > 0)) {
	    allocSize += (length + 1);
	}
    }
    if (allocSize == 0) {
	allocSize = 1;		/* enough for the NULL byte at end */
    }

    /*
     * Allocate storage for the concatenated result. Note that allocSize
     * is one more than the total number of characters, and so includes
     * room for the terminating NULL byte.
     */
    
    concatStr = (char *) ckalloc((unsigned) allocSize);

    /*
     * Now concatenate the elements. Clip white space off the front and back
     * to generate a neater result, and ignore any empty elements. Also put
     * a null byte at the end.
     */

    finalSize = 0;
    if (objc == 0) {
	*concatStr = '\0';
    } else {
	p = concatStr;
        for (i = 0;  i < objc;  i++) {
	    objPtr = objv[i];
	    element = TclGetStringFromObj(objPtr, &elemLength);
	    while ((elemLength > 0) && (isspace(UCHAR(*element)))) {
	         element++;
		 elemLength--;
	    }

	    /*
	     * Trim trailing white space.  But, be careful not to trim
	     * a space character if it is preceded by a backslash: in
	     * this case it could be significant.
	     */

	    while ((elemLength > 0)
		    && isspace(UCHAR(element[elemLength-1]))
		    && ((elemLength < 2) || (element[elemLength-2] != '\\'))) {
		elemLength--;
	    }
	    if (elemLength == 0) {
	         continue;	/* nothing left of this element */
	    }
	    memcpy((VOID *) p, (VOID *) element, (size_t) elemLength);
	    p += elemLength;
	    *p = ' ';
	    p++;
	    finalSize += (elemLength + 1);
        }
        if (p != concatStr) {
	    p[-1] = 0;
	    finalSize -= 1;	/* we overwrote the final ' ' */
        } else {
	    *p = 0;
        }
    }
    
    TclNewObj(objPtr);
    objPtr->bytes  = concatStr;
    objPtr->length = finalSize;
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_StringMatch --
 *
 *	See if a particular string matches a particular pattern.
 *
 * Results:
 *	The return value is 1 if string matches pattern, and
 *	0 otherwise.  The matching operation permits the following
 *	special characters in the pattern: *?\[] (see the manual
 *	entry for details on what these mean).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_StringMatch(string, pattern)
    char *string;		/* String. */
    char *pattern;		/* Pattern, which may contain special
				 * characters. */
{
    char c2;

    while (1) {
	/* See if we're at the end of both the pattern and the string.
	 * If so, we succeeded.  If we're at the end of the pattern
	 * but not at the end of the string, we failed.
	 */
	
	if (*pattern == 0) {
	    if (*string == 0) {
		return 1;
	    } else {
		return 0;
	    }
	}
	if ((*string == 0) && (*pattern != '*')) {
	    return 0;
	}

	/* Check for a "*" as the next pattern character.  It matches
	 * any substring.  We handle this by calling ourselves
	 * recursively for each postfix of string, until either we
	 * match or we reach the end of the string.
	 */
	
	if (*pattern == '*') {
	    pattern += 1;
	    if (*pattern == 0) {
		return 1;
	    }
	    while (1) {
		if (Tcl_StringMatch(string, pattern)) {
		    return 1;
		}
		if (*string == 0) {
		    return 0;
		}
		string += 1;
	    }
	}
    
	/* Check for a "?" as the next pattern character.  It matches
	 * any single character.
	 */

	if (*pattern == '?') {
	    goto thisCharOK;
	}

	/* Check for a "[" as the next pattern character.  It is followed
	 * by a list of characters that are acceptable, or by a range
	 * (two characters separated by "-").
	 */
	
	if (*pattern == '[') {
	    pattern += 1;
	    while (1) {
		if ((*pattern == ']') || (*pattern == 0)) {
		    return 0;
		}
		if (*pattern == *string) {
		    break;
		}
		if (pattern[1] == '-') {
		    c2 = pattern[2];
		    if (c2 == 0) {
			return 0;
		    }
		    if ((*pattern <= *string) && (c2 >= *string)) {
			break;
		    }
		    if ((*pattern >= *string) && (c2 <= *string)) {
			break;
		    }
		    pattern += 2;
		}
		pattern += 1;
	    }
	    while (*pattern != ']') {
		if (*pattern == 0) {
		    pattern--;
		    break;
		}
		pattern += 1;
	    }
	    goto thisCharOK;
	}
    
	/* If the next pattern character is '/', just strip off the '/'
	 * so we do exact matching on the character that follows.
	 */
	
	if (*pattern == '\\') {
	    pattern += 1;
	    if (*pattern == 0) {
		return 0;
	    }
	}

	/* There's no special character.  Just make sure that the next
	 * characters of each string match.
	 */
	
	if (*pattern != *string) {
	    return 0;
	}

	thisCharOK: pattern += 1;
	string += 1;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetResult --
 *
 *	Arrange for "string" to be the Tcl return value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	interp->result is left pointing either to "string" (if "copy" is 0)
 *	or to a copy of string. Also, the object result is reset.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetResult(interp, string, freeProc)
    Tcl_Interp *interp;		/* Interpreter with which to associate the
				 * return value. */
    char *string;		/* Value to be returned.  If NULL, the
				 * result is set to an empty string. */
    Tcl_FreeProc *freeProc;	/* Gives information about the string:
				 * TCL_STATIC, TCL_VOLATILE, or the address
				 * of a Tcl_FreeProc such as free. */
{
    Interp *iPtr = (Interp *) interp;
    int length;
    Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
    char *oldResult = iPtr->result;

    if (string == NULL) {
	iPtr->resultSpace[0] = 0;
	iPtr->result = iPtr->resultSpace;
	iPtr->freeProc = 0;
    } else if (freeProc == TCL_VOLATILE) {
	length = strlen(string);
	if (length > TCL_RESULT_SIZE) {
	    iPtr->result = (char *) ckalloc((unsigned) length+1);
	    iPtr->freeProc = TCL_DYNAMIC;
	} else {
	    iPtr->result = iPtr->resultSpace;
	    iPtr->freeProc = 0;
	}
	strcpy(iPtr->result, string);
    } else {
	iPtr->result = string;
	iPtr->freeProc = freeProc;
    }

    /*
     * If the old result was dynamically-allocated, free it up.  Do it
     * here, rather than at the beginning, in case the new result value
     * was part of the old result value.
     */

    if (oldFreeProc != 0) {
	if ((oldFreeProc == TCL_DYNAMIC)
		|| (oldFreeProc == (Tcl_FreeProc *) free)) {
	    ckfree(oldResult);
	} else {
	    (*oldFreeProc)(oldResult);
	}
    }

    /*
     * Reset the object result since we just set the string result.
     */

    TclResetObjResult(iPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringResult --
 *
 *	Returns an interpreter's result value as a string.
 *
 * Results:
 *	The interpreter's result as a string.
 *
 * Side effects:
 *	If the string result is empty, the object result is moved to the
 *	string result, then the object result is reset.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_GetStringResult(interp)
     Tcl_Interp *interp;	/* Interpreter whose result to return. */
{
    /*
     * If the string result is empty, move the object result to the
     * string result, then reset the object result.
     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
     */
    
    if (*(interp->result) == 0) {
	Tcl_SetResult(interp,
	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
	        TCL_VOLATILE);
    }
    return interp->result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjResult --
 *
 *	Arrange for objPtr to be an interpreter's result value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	interp->objResultPtr is left pointing to the object referenced
 *	by objPtr. The object's reference count is incremented since
 *	there is now a new reference to it. The reference count for any
 *	old objResultPtr value is decremented. Also, the string result
 *	is reset.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetObjResult(interp, objPtr)
    Tcl_Interp *interp;		/* Interpreter with which to associate the
				 * return object value. */
    Tcl_Obj *objPtr;		/* Tcl object to be returned. If NULL, the
				 * obj result is made an empty string
				 * object. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *oldObjResult = iPtr->objResultPtr;

    iPtr->objResultPtr = objPtr;
    Tcl_IncrRefCount(objPtr);	/* since interp result is a reference */

    /*
     * We wait until the end to release the old object result, in case
     * we are setting the result to itself.
     */
    
    TclDecrRefCount(oldObjResult);

    /*
     * Reset the string result since we just set the result object.
     */

    if (iPtr->freeProc != NULL) {
	if ((iPtr->freeProc == TCL_DYNAMIC)
	        || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
	    ckfree(iPtr->result);
	} else {
	    (*iPtr->freeProc)(iPtr->result);
	}
	iPtr->freeProc = 0;
    }
    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetObjResult --
 *
 *	Returns an interpreter's result value as a Tcl object. The object's
 *	reference count is not modified; the caller must do that if it
 *	needs to hold on to a long-term reference to it.
 *
 * Results:
 *	The interpreter's result as an object.
 *
 * Side effects:
 *	If the interpreter has a non-empty string result, the result object
 *	is either empty or stale because some procedure set interp->result
 *	directly. If so, the string result is moved to the result object
 *	then the string result is reset.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_GetObjResult(interp)
    Tcl_Interp *interp;		/* Interpreter whose result to return. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *objResultPtr;
    int length;

    /*
     * If the string result is non-empty, move the string result to the
     * object result, then reset the string result.
     */
    
    if (*(iPtr->result) != 0) {
	TclResetObjResult(iPtr);
	
	objResultPtr = iPtr->objResultPtr;
	length = strlen(iPtr->result);
	TclInitStringRep(objResultPtr, iPtr->result, length);
	
	if (iPtr->freeProc != NULL) {
	    if ((iPtr->freeProc == TCL_DYNAMIC)
	            || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
		ckfree(iPtr->result);
	    } else {
		(*iPtr->freeProc)(iPtr->result);
	    }
	    iPtr->freeProc = 0;
	}
	iPtr->result = iPtr->resultSpace;
	iPtr->resultSpace[0] = 0;
    }
    return iPtr->objResultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendResult --
 *
 *	Append a variable number of strings onto the interpreter's string
 *	result.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The result of the interpreter given by the first argument is
 *	extended by the strings given by the second and following arguments
 *	(up to a terminating NULL argument).
 *
 *	If the string result is empty, the object result is moved to the
 *	string result, then the object result is reset.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
{
    va_list argList;
    Interp *iPtr;
    char *string;
    int newSpace;

    /*
     * If the string result is empty, move the object result to the
     * string result, then reset the object result.
     * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
     */

    iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
    if (*(iPtr->result) == 0) {
	Tcl_SetResult((Tcl_Interp *) iPtr,
	        TclGetStringFromObj(Tcl_GetObjResult((Tcl_Interp *) iPtr),
		        (int *) NULL),
	        TCL_VOLATILE);
    }
    
    /*
     * Scan through all the arguments to see how much space is needed.
     */

    newSpace = 0;
    while (1) {
	string = va_arg(argList, char *);
	if (string == NULL) {
	    break;
	}
	newSpace += strlen(string);
    }
    va_end(argList);

    /*