tcliocmd.c

linux系统下的音频通信

		Tcl_GetChannelName(chan), "\": ",
                Tcl_PosixError(interp), (char *) NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_TellCmd --
 *
 *	This procedure is invoked to process the Tcl "tell" command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_TellCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Tcl_Channel chan;			/* The channel to tell on. */
    char buf[40];

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" channelId\"", (char *) NULL);
	return TCL_ERROR;
    }
    /*
     * Try to find a channel with the right name and permissions in
     * the IO channel table of this interpreter.
     */
    
    chan = Tcl_GetChannel(interp, argv[1], NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }
    TclFormatInt(buf, Tcl_Tell(chan));
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CloseObjCmd --
 *
 *	This procedure is invoked to process the Tcl "close" command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May discard queued input; may flush queued output.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_CloseObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    Tcl_Channel chan;			/* The channel to close. */
    int len;				/* Length of error output. */
    char *arg;

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

    arg = Tcl_GetStringFromObj(objv[1], NULL);
    chan = Tcl_GetChannel(interp, arg, NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) {
        /*
         * If there is an error message and it ends with a newline, remove
         * the newline. This is done for command pipeline channels where the
         * error output from the subprocesses is stored in interp->result.
         *
         * NOTE: This is likely to not have any effect on regular error
         * messages produced by drivers during the closing of a channel,
         * because the Tcl convention is that such error messages do not
         * have a terminating newline.
         */

        len = strlen(interp->result);
        if ((len > 0) && (interp->result[len - 1] == '\n')) {
            interp->result[len - 1] = '\0';
        }
        
        return TCL_ERROR;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FconfigureCmd --
 *
 *	This procedure is invoked to process the Tcl "fconfigure" command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May modify the behavior of an IO channel.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_FconfigureCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Tcl_Channel chan;			/* The channel to set a mode on. */
    int i;				/* Iterate over arg-value pairs. */
    Tcl_DString ds;			/* DString to hold result of
                                         * calling Tcl_GetChannelOption. */

    if ((argc < 2) || (((argc % 2) == 1) && (argc != 3))) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " channelId ?optionName? ?value? ?optionName value?...\"",
                (char *) NULL);
        return TCL_ERROR;
    }
    chan = Tcl_GetChannel(interp, argv[1], NULL);
    if (chan == (Tcl_Channel) NULL) {
        return TCL_ERROR;
    }
    if (argc == 2) {
        Tcl_DStringInit(&ds);
        if (Tcl_GetChannelOption(interp, chan, (char *) NULL, &ds) != TCL_OK) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
        }
        Tcl_DStringResult(interp, &ds);
        return TCL_OK;
    }
    if (argc == 3) {
        Tcl_DStringInit(&ds);
        if (Tcl_GetChannelOption(interp, chan, argv[2], &ds) != TCL_OK) {
            Tcl_DStringFree(&ds);
            return TCL_ERROR;
        }
        Tcl_DStringResult(interp, &ds);
        return TCL_OK;
    }
    for (i = 3; i < argc; i += 2) {
        if (Tcl_SetChannelOption(interp, chan, argv[i-1], argv[i]) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EofObjCmd --
 *
 *	This procedure is invoked to process the Tcl "eof" command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Sets interp->result to "0" or "1" depending on whether the
 *	specified channel has an EOF condition.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_EofObjCmd(unused, interp, objc, objv)
    ClientData unused;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    Tcl_Channel chan;			/* The channel to query for EOF. */
    int mode;				/* Mode in which channel is opened. */
    char buf[40];
    char *arg;

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

    arg = Tcl_GetStringFromObj(objv[1], NULL);
    chan = Tcl_GetChannel(interp, arg, &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    TclFormatInt(buf, Tcl_Eof(chan) ? 1 : 0);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ExecCmd --
 *
 *	This procedure is invoked to process the "exec" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_ExecCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
#ifdef MAC_TCL
    Tcl_AppendResult(interp, "exec not implemented under Mac OS",
		(char *)NULL);
    return TCL_ERROR;
#else /* !MAC_TCL */
    int keepNewline, firstWord, background, length, result;
    Tcl_Channel chan;
    Tcl_DString ds;
    int readSoFar, readNow, bufSize;

    /*
     * Check for a leading "-keepnewline" argument.
     */

    keepNewline = 0;
    for (firstWord = 1; (firstWord < argc) && (argv[firstWord][0] == '-');
	  firstWord++) {
	if (strcmp(argv[firstWord], "-keepnewline") == 0) {
	    keepNewline = 1;
	} else if (strcmp(argv[firstWord], "--") == 0) {
	    firstWord++;
	    break;
	} else {
	    Tcl_AppendResult(interp, "bad switch \"", argv[firstWord],
		    "\": must be -keepnewline or --", (char *) NULL);
	    return TCL_ERROR;
	}
    }

    if (argc <= firstWord) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" ?switches? arg ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }

    /*
     * See if the command is to be run in background.
     */

    background = 0;
    if ((argv[argc-1][0] == '&') && (argv[argc-1][1] == 0)) {
	argc--;
	argv[argc] = NULL;
        background = 1;
    }
    
    chan = Tcl_OpenCommandChannel(interp, argc-firstWord,
            argv+firstWord,
	    (background ? 0 : TCL_STDOUT | TCL_STDERR));

    if (chan == (Tcl_Channel) NULL) {
        return TCL_ERROR;
    }

    if (background) {

        /*
         * Get the list of PIDs from the pipeline into interp->result and
         * detach the PIDs (instead of waiting for them).
         */

        TclGetAndDetachPids(interp, chan);
        
        if (Tcl_Close(interp, chan) != TCL_OK) {
            return TCL_ERROR;
        }
        return TCL_OK;
    }

    if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
#define	EXEC_BUFFER_SIZE 4096

        Tcl_DStringInit(&ds);
        readSoFar = 0; bufSize = 0;
        while (1) {
            bufSize += EXEC_BUFFER_SIZE;
            Tcl_DStringSetLength(&ds, bufSize);
            readNow = Tcl_Read(chan, Tcl_DStringValue(&ds) + readSoFar,
                    EXEC_BUFFER_SIZE);
            if (readNow < 0) {
                Tcl_DStringFree(&ds);
		Tcl_AppendResult(interp,
			"error reading output from command: ",
			Tcl_PosixError(interp), (char *) NULL);
                return TCL_ERROR;
            }
            readSoFar += readNow;
            if (readNow < EXEC_BUFFER_SIZE) {
                break;	/* Out of "while (1)" loop. */
            }
        }
        Tcl_DStringSetLength(&ds, readSoFar);
        Tcl_DStringResult(interp, &ds);
    }

    result = Tcl_Close(interp, chan);

    /*
     * If the last character of interp->result is a newline, then remove
     * the newline character (the newline would just confuse things).
     * Special hack: must replace the old terminating null character
     * as a signal to Tcl_AppendResult et al. that we've mucked with
     * the string.
     */
    
    length = strlen(interp->result);
    if (!keepNewline && (length > 0) &&
        (interp->result[length-1] == '\n')) {
        interp->result[length-1] = '\0';
        interp->result[length] = 'x';
    }

    return result;
#endif /* !MAC_TCL */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FblockedObjCmd --
 *
 *	This procedure is invoked to process the Tcl "fblocked" command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Sets interp->result to "0" or "1" depending on whether the
 *	a preceding input operation on the channel would have blocked.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_FblockedObjCmd(unused, interp, objc, objv)
    ClientData unused;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    Tcl_Channel chan;			/* The channel to query for blocked. */
    int mode;				/* Mode in which channel was opened. */
    char buf[40];
    char *arg;

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

    arg = Tcl_GetStringFromObj(objv[1], NULL);
    chan = Tcl_GetChannel(interp, arg, &mode);
    if (chan == (Tcl_Channel) NULL) {
        return TCL_ERROR;
    }
    if ((mode & TCL_READABLE) == 0) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
		Tcl_GetStringFromObj(objv[1], NULL), 
                "\" wasn't opened for reading", (char *) NULL);
        return TCL_ERROR;
    }
        
    TclFormatInt(buf, Tcl_InputBlocked(chan) ? 1 : 0);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenCmd --
 *
 *	This procedure is invoked to process the "open" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_OpenCmd(notUsed, interp, argc, argv)
    ClientData notUsed;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    int pipeline, prot;
    char *modeString;
    Tcl_Channel chan;

    if ((argc < 2) || (argc > 4)) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" fileName ?access? ?permissions?\"", (char *) NULL);
	return TCL_ERROR;
    }
    prot = 0666;
    if (argc == 2) {
	modeString = "r";
    } else {
	modeString = argv[2];
	if (argc == 4) {
	    if (Tcl_GetInt(interp, argv[3], &prot) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
    }

    pipeline = 0;
    if (argv[1][0] == '|') {
	pipeline = 1;
    }

    /*
     * Open the file or create a process pipeline.
     */

    if (!pipeline) {
        chan = Tcl_OpenFileChannel(interp, argv[1], modeString, prot);
    } else {
#ifdef MAC_TCL
	Tcl_AppendResult(interp,
		"command pipelines not supported on Macintosh OS",
		(char *)NULL);
	return TCL_ERROR;
#else
	int mode, seekFlag, cmdArgc;
	char **cmdArgv;

        if (Tcl_SplitList(interp, argv[1]+1, &cmdArgc, &cmdArgv) != TCL_OK) {
            return TCL_ERROR;
        }

        mode = TclGetOpenMode(interp, modeString, &seekFlag);
        if (mode == -1) {
	    chan = NULL;
        } else {
	    int flags = TCL_STDERR | TCL_ENFORCE_MODE;
	    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
		case O_RDONLY:
		    flags |= TCL_STDOUT;
		    break;
		case O_WRONLY:
		    flags |= TCL_STDIN;
		    break;
		case O_RDWR:
		    flags |= (TCL_STDIN | TCL_STDOUT);
		    break;
		default:
		    panic("Tcl_OpenCmd: invalid mode value");
		    break;
	    }
	    chan = Tcl_OpenCommandChannel(interp, cmdArgc, cmdArgv, flags);
	}
        ckfree((char *) cmdArgv);
#endif
    }
    if (chan == (Tcl_Channel) NULL) {
        return TCL_ERROR;
    }
    Tcl_RegisterChannel(interp, chan);
    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);