tclcmdil.c

linux系统下的音频通信

    }

    /*
     * Make sure the list argument is a list object and get its length and
     * a pointer to its array of element pointers.
     */

    result = Tcl_ListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * Now concatenate strings to form the "joined" result. We append
     * directly into the interpreter's result object.
     */

    resObjPtr = Tcl_GetObjResult(interp);

    for (i = 0;  i < listLen;  i++) {
	bytes = Tcl_GetStringFromObj(elemPtrs[i], &length);
	if (i > 0) {
	    Tcl_AppendToObj(resObjPtr, joinString, joinLength);
	}
	Tcl_AppendToObj(resObjPtr, bytes, length);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LindexObjCmd --
 *
 *	This object-based procedure is invoked to process the "lindex" 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_LindexObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    Tcl_Obj **elemPtrs;
    int listLen, index, result;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "list index");
	return TCL_ERROR;
    }

    /*
     * Convert the first argument to a list if necessary.
     */

    listPtr = objv[1];
    result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * Get the index from objv[2].
     */

    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
	    &index);
    if (result != TCL_OK) {
	return result;
    }
    if ((index < 0) || (index >= listLen)) {
	/*
	 * The index is out of range: the result is an empty string object.
	 */
	
	return TCL_OK;
    }

    /*
     * Make sure listPtr still refers to a list object. It might have been
     * converted to an int above if the argument objects were shared.
     */

    if (listPtr->typePtr != &tclListType) {
	result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
	        &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
    }

    /*
     * Set the interpreter's object result to the index-th list element.
     */

    Tcl_SetObjResult(interp, elemPtrs[index]);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LinsertObjCmd --
 *
 *	This object-based procedure is invoked to process the "linsert" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A new Tcl list object formed by inserting zero or more elements 
 *	into a list.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_LinsertObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    register int objc;		/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    Tcl_Obj *listPtr, *resultPtr;
    Tcl_ObjType *typePtr;
    int index, isDuplicate, len, result;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
	return TCL_ERROR;
    }

    /*
     * Get the index first since, if a conversion to int is needed, it
     * will invalidate the list's internal representation.
     */

    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ INT_MAX,
	    &index);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * If the list object is unshared we can modify it directly. Otherwise
     * we create a copy to modify: this is "copy on write". We create the
     * duplicate directly in the interpreter's object result.
     */
    
    listPtr = objv[1];
    isDuplicate = 0;
    if (Tcl_IsShared(listPtr)) {
	/*
	 * The following code must reflect the logic in Tcl_DuplicateObj()
	 * except that it must duplicate the list object directly into the
	 * interpreter's result.
	 */
	
	Tcl_ResetResult(interp);
	resultPtr = Tcl_GetObjResult(interp);
	typePtr = listPtr->typePtr;
	if (listPtr->bytes == NULL) {
	    resultPtr->bytes = NULL;
	} else if (listPtr->bytes != tclEmptyStringRep) {
	    len = listPtr->length;
	    TclInitStringRep(resultPtr, listPtr->bytes, len);
	}
	if (typePtr != NULL) {
	    if (typePtr->dupIntRepProc == NULL) {
		resultPtr->internalRep = listPtr->internalRep;
		resultPtr->typePtr = typePtr;
	    } else {
		(*typePtr->dupIntRepProc)(listPtr, resultPtr);
	    }
	}
	listPtr = resultPtr;
	isDuplicate = 1;
    }
    
    if ((objc == 4) && (index == INT_MAX)) {
	/*
	 * Special case: insert one element at the end of the list.
	 */

	result = Tcl_ListObjAppendElement(interp, listPtr, objv[3]);
    } else if (objc > 3) {
	result = Tcl_ListObjReplace(interp, listPtr, index, 0,
				    (objc-3), &(objv[3]));
    }
    if (result != TCL_OK) {
	return result;
    }
    
    /*
     * Set the interpreter's object result.
     */

    if (!isDuplicate) {
	Tcl_SetObjResult(interp, listPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjCmd --
 *
 *	This procedure is invoked to process the "list" 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_ListObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    register int objc;			/* Number of arguments. */
    register Tcl_Obj *CONST objv[];	/* The argument objects. */
{
    /*
     * If there are no list elements, the result is an empty object.
     * Otherwise modify the interpreter's result object to be a list object.
     */
    
    if (objc > 1) {
	Tcl_SetListObj(Tcl_GetObjResult(interp), (objc-1), &(objv[1]));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LlengthObjCmd --
 *
 *	This object-based procedure is invoked to process the "llength" 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_LlengthObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    register Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int listLen, result;

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

    result = Tcl_ListObjLength(interp, objv[1], &listLen);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * Set the interpreter's object result to an integer object holding the
     * length. 
     */

    Tcl_SetIntObj(Tcl_GetObjResult(interp), listLen);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LrangeObjCmd --
 *
 *	This procedure is invoked to process the "lrange" 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_LrangeObjCmd(notUsed, interp, objc, objv)
    ClientData notUsed;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    register Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    Tcl_Obj **elemPtrs;
    int listLen, first, last, numElems, result;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
	return TCL_ERROR;
    }

    /*
     * Make sure the list argument is a list object and get its length and
     * a pointer to its array of element pointers.
     */

    listPtr = objv[1];
    result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * Get the first and last indexes.
     */

    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
	    &first);
    if (result != TCL_OK) {
	return result;
    }
    if (first < 0) {
	first = 0;
    }

    result = TclGetIntForIndex(interp, objv[3], /*endValue*/ (listLen - 1),
	    &last);
    if (result != TCL_OK) {
	return result;
    }
    if (last >= listLen) {
	last = (listLen - 1);
    }
    
    if (first > last) {
	return TCL_OK;		/* the result is an empty object */
    }

    /*
     * Make sure listPtr still refers to a list object. It might have been
     * converted to an int above if the argument objects were shared.
     */  

    if (listPtr->typePtr != &tclListType) {
        result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
                &elemPtrs);
        if (result != TCL_OK) {
            return result;
        }
    }

    /*
     * Extract a range of fields. We modify the interpreter's result object
     * to be a list object containing the specified elements.
     */

    numElems = (last - first + 1);
    Tcl_SetListObj(Tcl_GetObjResult(interp), numElems, &(elemPtrs[first]));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LreplaceObjCmd --
 *
 *	This object-based procedure is invoked to process the "lreplace" 
 *	Tcl command. See the user documentation for details on what it does.
 *
 * Results:
 *	A new Tcl list object formed by replacing zero or more elements of
 *	a list.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    register Tcl_Obj *listPtr;
    int createdNewObj, first, last, listLen, numToDelete;
    int firstArgLen, result;
    char *firstArg;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"list first last ?element element ...?");
	return TCL_ERROR;
    }

    /*
     * If the list object is unshared we can modify it directly, otherwise
     * we create a copy to modify: this is "copy on write".
     */
    
    listPtr = objv[1];
    createdNewObj = 0;
    if (Tcl_IsShared(listPtr)) {
	listPtr = Tcl_DuplicateObj(listPtr);
	createdNewObj = 1;
    }
    result = Tcl_ListObjLength(interp, listPtr, &listLen);
    if (resul