tkunixsend.c

linux系统下的音频通信

	c = argv[i][1];
	length = strlen(argv[i]);
	if ((c == 'a') && (strncmp(argv[i], "-async", length) == 0)) {
	    async = 1;
	    i++;
	} else if ((c == 'd') && (strncmp(argv[i], "-displayof",
		length) == 0)) {
	    winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[i+1],
		    (Tk_Window) winPtr);
	    if (winPtr == NULL) {
		return TCL_ERROR;
	    }
	    i += 2;
	} else if (strcmp(argv[i], "--") == 0) {
	    i++;
	    break;
	} else {
	    Tcl_AppendResult(interp, "bad option \"", argv[i],
		    "\": must be -async, -displayof, or --", (char *) NULL);
	    return TCL_ERROR;
	}
    }

    if (argc < (i+2)) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" ?options? interpName arg ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    destName = argv[i];
    firstArg = i+1;

    dispPtr = winPtr->dispPtr;
    if (dispPtr->commTkwin == NULL) {
	SendInit(interp, winPtr->dispPtr);
    }

    /*
     * See if the target interpreter is local.  If so, execute
     * the command directly without going through the X server.
     * The only tricky thing is passing the result from the target
     * interpreter to the invoking interpreter.  Watch out:  they
     * could be the same!
     */

    for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) {
	if ((riPtr->dispPtr != dispPtr)
		|| (strcmp(riPtr->name, destName) != 0)) {
	    continue;
	}
	Tcl_Preserve((ClientData) riPtr);
        localInterp = riPtr->interp;
        Tcl_Preserve((ClientData) localInterp);
	if (firstArg == (argc-1)) {
	    result = Tcl_GlobalEval(localInterp, argv[firstArg]);
	} else {
	    Tcl_DStringInit(&request);
	    Tcl_DStringAppend(&request, argv[firstArg], -1);
	    for (i = firstArg+1; i < argc; i++) {
		Tcl_DStringAppend(&request, " ", 1);
		Tcl_DStringAppend(&request, argv[i], -1);
	    }
	    result = Tcl_GlobalEval(localInterp, Tcl_DStringValue(&request));
	    Tcl_DStringFree(&request);
	}
	if (interp != localInterp) {
	    if (result == TCL_ERROR) {

		/*
		 * An error occurred, so transfer error information from the
		 * destination interpreter back to our interpreter.  Must clear
		 * interp's result before calling Tcl_AddErrorInfo, since
		 * Tcl_AddErrorInfo will store the interp's result in errorInfo
		 * before appending riPtr's $errorInfo;  we've already got
		 * everything we need in riPtr's $errorInfo.
		 */

		Tcl_ResetResult(interp);
		Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp,
			"errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
		Tcl_SetVar2(interp, "errorCode", (char *) NULL,
			Tcl_GetVar2(localInterp, "errorCode", (char *) NULL,
			TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY);
	    }
            if (localInterp->freeProc != TCL_STATIC) {
                interp->result = localInterp->result;
                interp->freeProc = localInterp->freeProc;
                localInterp->freeProc = TCL_STATIC;
            } else {
                Tcl_SetResult(interp, localInterp->result, TCL_VOLATILE);
            }
            Tcl_ResetResult(localInterp);
	}
	Tcl_Release((ClientData) riPtr);
        Tcl_Release((ClientData) localInterp);
	return result;
    }

    /*
     * Bind the interpreter name to a communication window.
     */

    regPtr = RegOpen(interp, winPtr->dispPtr, 0);
    commWindow = RegFindName(regPtr, destName);
    RegClose(regPtr);
    if (commWindow == None) {
	Tcl_AppendResult(interp, "no application named \"",
		destName, "\"", (char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Send the command to the target interpreter by appending it to the
     * comm window in the communication window.
     */

    tkSendSerial++;
    Tcl_DStringInit(&request);
    Tcl_DStringAppend(&request, "\0c\0-n ", 6);
    Tcl_DStringAppend(&request, destName, -1);
    if (!async) {
	sprintf(buffer, "%x %d",
		(unsigned int) Tk_WindowId(dispPtr->commTkwin),
		tkSendSerial);
	Tcl_DStringAppend(&request, "\0-r ", 4);
	Tcl_DStringAppend(&request, buffer, -1);
    }
    Tcl_DStringAppend(&request, "\0-s ", 4);
    Tcl_DStringAppend(&request, argv[firstArg], -1);
    for (i = firstArg+1; i < argc; i++) {
	Tcl_DStringAppend(&request, " ", 1);
	Tcl_DStringAppend(&request, argv[i], -1);
    }
    (void) AppendPropCarefully(dispPtr->display, commWindow,
	    dispPtr->commProperty, Tcl_DStringValue(&request),
	    Tcl_DStringLength(&request) + 1,
	    (async) ? (PendingCommand *) NULL : &pending);
    Tcl_DStringFree(&request);
    if (async) {
	/*
	 * This is an asynchronous send:  return immediately without
	 * waiting for a response.
	 */

	return TCL_OK;
    }

    /*
     * Register the fact that we're waiting for a command to complete
     * (this is needed by SendEventProc and by AppendErrorProc to pass
     * back the command's results).  Set up a timeout handler so that
     * we can check during long sends to make sure that the destination
     * application is still alive.
     */

    pending.serial = tkSendSerial;
    pending.dispPtr = dispPtr;
    pending.target = destName;
    pending.commWindow = commWindow;
    pending.interp = interp;
    pending.result = NULL;
    pending.errorInfo = NULL;
    pending.errorCode = NULL;
    pending.gotResponse = 0;
    pending.nextPtr = pendingCommands;
    pendingCommands = &pending;

    /*
     * Enter a loop processing X events until the result comes
     * in or the target is declared to be dead.  While waiting
     * for a result, look only at send-related events so that
     * the send is synchronous with respect to other events in
     * the application.
     */

    prevRestrictProc = Tk_RestrictEvents(SendRestrictProc,
	    (ClientData) NULL, &prevArg);
    TclpGetTime(&timeout);
    timeout.sec += 2;
    while (!pending.gotResponse) {
	if (!TkUnixDoOneXEvent(&timeout)) {
	    /*
	     * An unusually long amount of time has elapsed during the
	     * processing of a sent command.  Check to make sure that the
	     * target application still exists.  If it does, reset the timeout.
	     */

	    if (!ValidateName(pending.dispPtr, pending.target,
		    pending.commWindow, 0)) {
		char *msg;
		if (ValidateName(pending.dispPtr, pending.target,
			pending.commWindow, 1)) {
		    msg = "target application died or uses a Tk version before 4.0";
		} else {
		    msg = "target application died";
		}
		pending.code = TCL_ERROR;
		pending.result = (char *) ckalloc((unsigned) (strlen(msg) + 1));
		strcpy(pending.result, msg);
		pending.gotResponse = 1;
	    } else {
		TclpGetTime(&timeout);
		timeout.sec += 2;
	    }
	}
    }
    (void) Tk_RestrictEvents(prevRestrictProc, prevArg, &prevArg);

    /*
     * Unregister the information about the pending command
     * and return the result.
     */

    if (pendingCommands != &pending) {
	panic("Tk_SendCmd: corrupted send stack");
    }
    pendingCommands = pending.nextPtr;
    if (pending.errorInfo != NULL) {
	/*
	 * Special trick: must clear the interp's result before calling
	 * Tcl_AddErrorInfo, since Tcl_AddErrorInfo will store the interp's
	 * result in errorInfo before appending pending.errorInfo;  we've
	 * already got everything we need in pending.errorInfo.
	 */

	Tcl_ResetResult(interp);
	Tcl_AddErrorInfo(interp, pending.errorInfo);
	ckfree(pending.errorInfo);
    }
    if (pending.errorCode != NULL) {
	Tcl_SetVar2(interp, "errorCode", (char *) NULL, pending.errorCode,
		TCL_GLOBAL_ONLY);
	ckfree(pending.errorCode);
    }
    Tcl_SetResult(interp, pending.result, TCL_DYNAMIC);
    return pending.code;
}

/*
 *----------------------------------------------------------------------
 *
 * TkGetInterpNames --
 *
 *	This procedure is invoked to fetch a list of all the
 *	interpreter names currently registered for the display
 *	of a particular window.
 *
 * Results:
 *	A standard Tcl return value.  Interp->result will be set
 *	to hold a list of all the interpreter names defined for
 *	tkwin's display.  If an error occurs, then TCL_ERROR
 *	is returned and interp->result will hold an error message.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TkGetInterpNames(interp, tkwin)
    Tcl_Interp *interp;		/* Interpreter for returning a result. */
    Tk_Window tkwin;		/* Window whose display is to be used
				 * for the lookup. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    char *p, *entry, *entryName;
    NameRegistry *regPtr;
    Window commWindow;
    int count;
    unsigned int id;

    /*
     * Read the registry property, then scan through all of its entries.
     * Validate each entry to be sure that its application still exists.
     */

    regPtr = RegOpen(interp, winPtr->dispPtr, 1);
    for (p = regPtr->property; (p-regPtr->property) < (int) regPtr->propLength; ) {
	entry = p;
	if (sscanf(p,  "%x",(unsigned int *) &id) != 1) {
	    commWindow =  None;
	} else {
	    commWindow = id;
	}
	while ((*p != 0) && (!isspace(UCHAR(*p)))) {
	    p++;
	}
	if (*p != 0) {
	    p++;
	}
	entryName = p;
	while (*p != 0) {
	    p++;
	}
	p++;
	if (ValidateName(winPtr->dispPtr, entryName, commWindow, 1)) {
	    /*
	     * The application still exists; add its name to the result.
	     */

	    Tcl_AppendElement(interp, entryName);
	} else {
	    /*
	     * This name is bogus (perhaps the application died without
	     * cleaning up its entry in the registry?).  Delete the name.
	     */

	    count = regPtr->propLength - (p - regPtr->property);
	    if (count > 0)  {
		char *src, *dst;

		for (src = p, dst = entry; count > 0; src++, dst++, count--) {
		    *dst = *src;
		}
	    }
	    regPtr->propLength -= p - entry;
	    regPtr->modified = 1;
	    p = entry;
	}
    }
    RegClose(regPtr);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * SendInit --
 *
 *	This procedure is called to initialize the
 *	communication channels for sending commands and
 *	receiving results.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets up various data structures and windows.
 *
 *--------------------------------------------------------------
 */

static int
SendInit(interp, dispPtr)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting
				 * (no errors are ever returned, but the
				 * interpreter is needed anyway). */
    TkDisplay *dispPtr;		/* Display to initialize. */
{
    XSetWindowAttributes atts;

    /*
     * Create the window used for communication, and set up an
     * event handler for it.
     */

    dispPtr->commTkwin = Tk_CreateWindow(interp, (Tk_Window) NULL,
	    "_comm", DisplayString(dispPtr->display));
    if (dispPtr->commTkwin == NULL) {
	panic("Tk_CreateWindow failed in SendInit!");
    }
    atts.override_redirect = True;
    Tk_ChangeWindowAttributes(dispPtr->commTkwin,
	    CWOverrideRedirect, &atts);
    Tk_CreateEventHandler(dispPtr->commTkwin, PropertyChangeMask,
	    SendEventProc, (ClientData) dispPtr);
    Tk_MakeWindowExist(dispPtr->commTkwin);

    /*
     * Get atoms used as property names.
     */

    dispPtr->commProperty = Tk_InternAtom(dispPtr->commTkwin, "Comm");
    dispPtr->registryProperty = Tk_InternAtom(dispPtr->commTkwin,
	    "InterpRegistry");
    dispPtr->appNameProperty = Tk_InternAtom(dispPtr->commTkwin,
	    "TK_APPLICATION");

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * SendEventProc --
 *
 *	This procedure is invoked automatically by the toolkit
 *	event manager when a property changes on the communication
 *	window.  This procedure reads the property and handles
 *	command requests and responses.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If there are command requests in the property, they
 *	are executed.  If there are responses in the property,
 *	their information is saved for the (ostensibly waiting)
 *	"send" commands. The property is deleted.
 *
 *--------------------------------------------------------------
 */

static void
SendEventProc(clientData, eventPtr)
    ClientData clientData;	/* Display information. */	
    XEvent *eventPtr;		/* Information about event. */
{
    TkDisplay *dispPtr = (TkDisplay *) clientData;
    char *propInfo;
    register char *p;
    int result, actualFormat;
    unsigned long numItems, bytesAfter;
    Atom actualType;
    Tcl_Interp *remoteInterp;	/* Interp in which to execute the command. */

    if ((eventPtr->xproperty.atom != dispPtr->commProperty)
	    || (eventPtr->xproperty.state != PropertyNewValue)) {
	return;
    }

    /*
     * Read the comm property and delete it.
     */

    propInfo = NULL;
    result = XGetWindowProperty(dispPtr->display,
	    Tk_WindowId(dispPtr->commTkwin),
	    dispPtr->commProperty, 0, MAX_PROP_WORDS, True,
	    XA_STRING, &actualType, &actualFormat,
	    &numItems, &bytesAfter, (unsigned char **) &propInfo);

    /*
     * If the property doesn't exist or is improperly formed
     * then ignore it.
     */

    if ((result != Success) || (actualType != XA_STRING)
	    || (actualFormat != 8)) {
	if (propInfo != NULL) {
	    XFree(propInfo);
	}
	return;
    }

    /*
     * Several commands and results could arrive in the property at
     * one time;  each iteration through the outer loop handles a
     * single command or result.
     */

    for (p = propInfo; (p-propInfo) < (int) numItems; ) {
	/*
	 * Ignore leading NULLs; each command or result starts with a
	 * NULL so that no matter how badly formed a preceding command
	 * is, we'll be able to tell that a new command/result is
	 * starting.
	 */

	if (*p == 0) {
	    p++;
	    continue;
	}