tkunixsend.c

linux系统下的音频通信

	if ((*p == 'c') && (p[1] == 0)) {
	    Window commWindow;
	    char *interpName, *script, *serial, *end;
	    Tcl_DString reply;
	    RegisteredInterp *riPtr;

	    /*
	     *----------------------------------------------------------
	     * This is an incoming command from some other application.
	     * Iterate over all of its options.  Stop when we reach
	     * the end of the property or something that doesn't look
	     * like an option.
	     *----------------------------------------------------------
	     */

	    p += 2;
	    interpName = NULL;
	    commWindow = None;
	    serial = "";
	    script = NULL;
	    while (((p-propInfo) < (int) numItems) && (*p == '-')) {
		switch (p[1]) {
		    case 'r':
			commWindow = (Window) strtoul(p+2, &end, 16);
			if ((end == p+2) || (*end != ' ')) {
			    commWindow = None;
			} else {
			    p = serial = end+1;
			}
			break;
		    case 'n':
			if (p[2] == ' ') {
			    interpName = p+3;
			}
			break;
		    case 's':
			if (p[2] == ' ') {
			    script = p+3;
			}
			break;
		}
		while (*p != 0) {
		    p++;
		}
		p++;
	    }

	    if ((script == NULL) || (interpName == NULL)) {
		continue;
	    }

	    /*
	     * Initialize the result property, so that we're ready at any
	     * time if we need to return an error.
	     */

	    if (commWindow != None) {
		Tcl_DStringInit(&reply);
		Tcl_DStringAppend(&reply, "\0r\0-s ", 6);
		Tcl_DStringAppend(&reply, serial, -1);
		Tcl_DStringAppend(&reply, "\0-r ", 4);
	    }

	    if (!ServerSecure(dispPtr)) {
		if (commWindow != None) {
		    Tcl_DStringAppend(&reply, "X server insecure (must use xauth-style authorization); command ignored", -1);
		}
		result = TCL_ERROR;
		goto returnResult;
	    }

	    /*
	     * Locate the application, then execute the script.
	     */

	    for (riPtr = registry; ; riPtr = riPtr->nextPtr) {
		if (riPtr == NULL) {
		    if (commWindow != None) {
			Tcl_DStringAppend(&reply,
				"receiver never heard of interpreter \"", -1);
			Tcl_DStringAppend(&reply, interpName, -1);
			Tcl_DStringAppend(&reply, "\"", 1);
		    }
		    result = TCL_ERROR;
		    goto returnResult;
		}
		if (strcmp(riPtr->name, interpName) == 0) {
		    break;
		}
	    }
	    Tcl_Preserve((ClientData) riPtr);

            /*
             * We must protect the interpreter because the script may
             * enter another event loop, which might call Tcl_DeleteInterp.
             */

            remoteInterp = riPtr->interp;
            Tcl_Preserve((ClientData) remoteInterp);

            result = Tcl_GlobalEval(remoteInterp, script);

            /*
             * The call to Tcl_Release may have released the interpreter
             * which will cause the "send" command for that interpreter
             * to be deleted. The command deletion callback will set the
             * riPtr->interp field to NULL, hence the check below for NULL.
             */

	    if (commWindow != None) {
		Tcl_DStringAppend(&reply, remoteInterp->result, -1);
		if (result == TCL_ERROR) {
		    char *varValue;
    
		    varValue = Tcl_GetVar2(remoteInterp, "errorInfo",
			    (char *) NULL, TCL_GLOBAL_ONLY);
		    if (varValue != NULL) {
			Tcl_DStringAppend(&reply, "\0-i ", 4);
			Tcl_DStringAppend(&reply, varValue, -1);
		    }
		    varValue = Tcl_GetVar2(remoteInterp, "errorCode",
			    (char *) NULL, TCL_GLOBAL_ONLY);
		    if (varValue != NULL) {
			Tcl_DStringAppend(&reply, "\0-e ", 4);
			Tcl_DStringAppend(&reply, varValue, -1);
		    }
		}
	    }
            Tcl_Release((ClientData) remoteInterp);
	    Tcl_Release((ClientData) riPtr);

	    /*
	     * Return the result to the sender if a commWindow was
	     * specified (if none was specified then this is an asynchronous
	     * call).  Right now reply has everything but the completion
	     * code, but it needs the NULL to terminate the current option.
	     */

	    returnResult:
	    if (commWindow != None) {
		if (result != TCL_OK) {
		    char buffer[20];
    
		    sprintf(buffer, "%d", result);
		    Tcl_DStringAppend(&reply, "\0-c ", 4);
		    Tcl_DStringAppend(&reply, buffer, -1);
		}
		(void) AppendPropCarefully(dispPtr->display, commWindow,
			dispPtr->commProperty, Tcl_DStringValue(&reply),
			Tcl_DStringLength(&reply) + 1,
			(PendingCommand *) NULL);
		XFlush(dispPtr->display);
		Tcl_DStringFree(&reply);
	    }
	} else if ((*p == 'r') && (p[1] == 0)) {
	    int serial, code, gotSerial;
	    char *errorInfo, *errorCode, *resultString;
	    PendingCommand *pcPtr;

	    /*
	     *----------------------------------------------------------
	     * This is a reply to some command that we sent out.  Iterate
	     * over all of its options.  Stop when we reach the end of the
	     * property or something that doesn't look like an option.
	     *----------------------------------------------------------
	     */

	    p += 2;
	    code = TCL_OK;
	    gotSerial = 0;
	    errorInfo = NULL;
	    errorCode = NULL;
	    resultString = "";
	    while (((p-propInfo) < (int) numItems) && (*p == '-')) {
		switch (p[1]) {
		    case 'c':
			if (sscanf(p+2, " %d", &code) != 1) {
			    code = TCL_OK;
			}
			break;
		    case 'e':
			if (p[2] == ' ') {
			    errorCode = p+3;
			}
			break;
		    case 'i':
			if (p[2] == ' ') {
			    errorInfo = p+3;
			}
			break;
		    case 'r':
			if (p[2] == ' ') {
			    resultString = p+3;
			}
			break;
		    case 's':
			if (sscanf(p+2, " %d", &serial) == 1) {
			    gotSerial = 1;
			}
			break;
		}
		while (*p != 0) {
		    p++;
		}
		p++;
	    }

	    if (!gotSerial) {
		continue;
	    }

	    /*
	     * Give the result information to anyone who's
	     * waiting for it.
	     */

	    for (pcPtr = pendingCommands; pcPtr != NULL;
		    pcPtr = pcPtr->nextPtr) {
		if ((serial != pcPtr->serial) || (pcPtr->result != NULL)) {
		    continue;
		}
		pcPtr->code = code;
		if (resultString != NULL) {
		    pcPtr->result = (char *) ckalloc((unsigned)
			    (strlen(resultString) + 1));
		    strcpy(pcPtr->result, resultString);
		}
		if (code == TCL_ERROR) {
		    if (errorInfo != NULL) {
			pcPtr->errorInfo = (char *) ckalloc((unsigned)
				(strlen(errorInfo) + 1));
			strcpy(pcPtr->errorInfo, errorInfo);
		    }
		    if (errorCode != NULL) {
			pcPtr->errorCode = (char *) ckalloc((unsigned)
				(strlen(errorCode) + 1));
			strcpy(pcPtr->errorCode, errorCode);
		    }
		}
		pcPtr->gotResponse = 1;
		break;
	    }
	} else {
	    /*
	     * Didn't recognize this thing.  Just skip through the next
	     * null character and try again.
	     */

	    while (*p != 0) {
		p++;
	    }
	    p++;
	}
    }
    XFree(propInfo);
}

/*
 *--------------------------------------------------------------
 *
 * AppendPropCarefully --
 *
 *	Append a given property to a given window, but set up
 *	an X error handler so that if the append fails this
 *	procedure can return an error code rather than having
 *	Xlib panic.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The given property on the given window is appended to.
 *	If this operation fails and if pendingPtr is non-NULL,
 *	then the pending operation is marked as complete with
 *	an error.
 *
 *--------------------------------------------------------------
 */

static void
AppendPropCarefully(display, window, property, value, length, pendingPtr)
    Display *display;		/* Display on which to operate. */
    Window window;		/* Window whose property is to
				 * be modified. */
    Atom property;		/* Name of property. */
    char *value;		/* Characters to append to property. */
    int length;			/* Number of bytes to append. */
    PendingCommand *pendingPtr;	/* Pending command to mark complete
				 * if an error occurs during the
				 * property op.  NULL means just
				 * ignore the error. */
{
    Tk_ErrorHandler handler;

    handler = Tk_CreateErrorHandler(display, -1, -1, -1, AppendErrorProc,
	(ClientData) pendingPtr);
    XChangeProperty(display, window, property, XA_STRING, 8,
	    PropModeAppend, (unsigned char *) value, length);
    Tk_DeleteErrorHandler(handler);
}

/*
 * The procedure below is invoked if an error occurs during
 * the XChangeProperty operation above.
 */

	/* ARGSUSED */
static int
AppendErrorProc(clientData, errorPtr)
    ClientData clientData;	/* Command to mark complete, or NULL. */
    XErrorEvent *errorPtr;	/* Information about error. */
{
    PendingCommand *pendingPtr = (PendingCommand *) clientData;
    register PendingCommand *pcPtr;

    if (pendingPtr == NULL) {
	return 0;
    }

    /*
     * Make sure this command is still pending.
     */

    for (pcPtr = pendingCommands; pcPtr != NULL;
	    pcPtr = pcPtr->nextPtr) {
	if ((pcPtr == pendingPtr) && (pcPtr->result == NULL)) {
	    pcPtr->result = (char *) ckalloc((unsigned)
		    (strlen(pcPtr->target) + 50));
	    sprintf(pcPtr->result, "no application named \"%s\"",
		    pcPtr->target);
	    pcPtr->code = TCL_ERROR;
	    pcPtr->gotResponse = 1;
	    break;
	}
    }
    return 0;
}

/*
 *--------------------------------------------------------------
 *
 * DeleteProc --
 *
 *	This procedure is invoked by Tcl when the "send" command
 *	is deleted in an interpreter.  It unregisters the interpreter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The interpreter given by riPtr is unregistered.
 *
 *--------------------------------------------------------------
 */

static void
DeleteProc(clientData)
    ClientData clientData;	/* Info about registration, passed
				 * as ClientData. */
{
    RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
    register RegisteredInterp *riPtr2;
    NameRegistry *regPtr;

    regPtr = RegOpen(riPtr->interp, riPtr->dispPtr, 1);
    RegDeleteName(regPtr, riPtr->name);
    RegClose(regPtr);

    if (registry == riPtr) {
	registry = riPtr->nextPtr;
    } else {
	for (riPtr2 = registry; riPtr2 != NULL;
		riPtr2 = riPtr2->nextPtr) {
	    if (riPtr2->nextPtr == riPtr) {
		riPtr2->nextPtr = riPtr->nextPtr;
		break;
	    }
	}
    }
    ckfree((char *) riPtr->name);
    riPtr->interp = NULL;
    UpdateCommWindow(riPtr->dispPtr);
    Tcl_EventuallyFree((ClientData) riPtr, TCL_DYNAMIC);
}

/*
 *----------------------------------------------------------------------
 *
 * SendRestrictProc --
 *
 *	This procedure filters incoming events when a "send" command
 *	is outstanding.  It defers all events except those containing
 *	send commands and results.
 *
 * Results:
 *	False is returned except for property-change events on a
 *	commWindow.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
static Tk_RestrictAction
SendRestrictProc(clientData, eventPtr)
    ClientData clientData;		/* Not used. */
    register XEvent *eventPtr;		/* Event that just arrived. */
{
    TkDisplay *dispPtr;

    if (eventPtr->type != PropertyNotify) {
	return TK_DEFER_EVENT;
    }
    for (dispPtr = tkDisplayList; dispPtr != NULL; dispPtr = dispPtr->nextPtr) {
	if ((eventPtr->xany.display == dispPtr->display)
		&& (eventPtr->xproperty.window
		== Tk_WindowId(dispPtr->commTkwin))) {
	    return TK_PROCESS_EVENT;
	}
    }
    return TK_DEFER_EVENT;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateCommWindow --
 *
 *	This procedure updates the list of application names stored
 *	on our commWindow.  It is typically called when interpreters
 *	are registered and unregistered.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The TK_APPLICATION property on the comm window is updated.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateCommWindow(dispPtr)
    TkDisplay *dispPtr;		/* Display whose commWindow is to be
				 * updated. */
{
    Tcl_DString names;
    RegisteredInterp *riPtr;

    Tcl_DStringInit(&names);
    for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) {
	Tcl_DStringAppendElement(&names, riPtr->name);
    }
    XChangeProperty(dispPtr->display, Tk_WindowId(dispPtr->commTkwin),
	    dispPtr->appNameProperty, XA_STRING, 8, PropModeReplace,
	    (unsigned char *) Tcl_DStringValue(&names),
	    Tcl_DStringLength(&names));
    Tcl_DStringFree(&names);
}