tkbind.c

linux系统下的音频通信

 *	Destroy a binding table and free up all its memory.
 *	The caller should not use bindingTable again after
 *	this procedure returns.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is freed.
 *
 *--------------------------------------------------------------
 */

void
Tk_DeleteBindingTable(bindingTable)
    Tk_BindingTable bindingTable;	/* Token for the binding table to
					 * destroy. */
{
    BindingTable *bindPtr = (BindingTable *) bindingTable;
    PatSeq *psPtr, *nextPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    /*
     * Find and delete all of the patterns associated with the binding
     * table.
     */

    for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
		psPtr != NULL; psPtr = nextPtr) {
	    nextPtr = psPtr->nextSeqPtr;
	    psPtr->flags |= MARKED_DELETED;
	    if (psPtr->refCount == 0) {
		if (psPtr->freeProc != NULL) {
		    (*psPtr->freeProc)(psPtr->clientData);
		}
		ckfree((char *) psPtr);
	    }
	}
    }

    /*
     * Clean up the rest of the information associated with the
     * binding table.
     */

    Tcl_DeleteHashTable(&bindPtr->patternTable);
    Tcl_DeleteHashTable(&bindPtr->objectTable);
    ckfree((char *) bindPtr);
}

/*
 *--------------------------------------------------------------
 *
 * Tk_CreateBinding --
 *
 *	Add a binding to a binding table, so that future calls to
 *	Tk_BindEvent may execute the command in the binding.
 *
 * Results:
 *	The return value is 0 if an error occurred while setting
 *	up the binding.  In this case, an error message will be
 *	left in interp->result.  If all went well then the return
 *	value is a mask of the event types that must be made
 *	available to Tk_BindEvent in order to properly detect when
 *	this binding triggers.  This value can be used to determine
 *	what events to select for in a window, for example.
 *
 * Side effects:
 *	An existing binding on the same event sequence may be
 *	replaced.  
 *	The new binding may cause future calls to Tk_BindEvent to
 *	behave differently than they did previously.
 *
 *--------------------------------------------------------------
 */

unsigned long
Tk_CreateBinding(interp, bindingTable, object, eventString, command, append)
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tk_BindingTable bindingTable;
				/* Table in which to create binding. */
    ClientData object;		/* Token for object with which binding is
				 * associated. */
    char *eventString;		/* String describing event sequence that
				 * triggers binding. */
    char *command;		/* Contains Tcl command to execute when
				 * binding triggers. */
    int append;			/* 0 means replace any existing binding for
				 * eventString; 1 means append to that
				 * binding.  If the existing binding is for a
				 * callback function and not a Tcl command
				 * string, the existing binding will always be
				 * replaced. */
{
    BindingTable *bindPtr = (BindingTable *) bindingTable;
    PatSeq *psPtr;
    unsigned long eventMask;
    char *new, *old;

    psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
	    1, 1, &eventMask);
    if (psPtr == NULL) {
	return 0;
    }
    if (psPtr->eventProc == NULL) {
	int new;
	Tcl_HashEntry *hPtr;
	
	/*
	 * This pattern sequence was just created.
	 * Link the pattern into the list associated with the object, so
	 * that if the object goes away, these bindings will all
	 * automatically be deleted.
	 */

	hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
		&new);
	if (new) {
	    psPtr->nextObjPtr = NULL;
	} else {
	    psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
	}
	Tcl_SetHashValue(hPtr, psPtr);
    } else if (psPtr->eventProc != EvalTclBinding) {
	/*
	 * Free existing procedural binding.
	 */

	if (psPtr->freeProc != NULL) {
	    (*psPtr->freeProc)(psPtr->clientData);
	}
	psPtr->clientData = NULL;
	append = 0;
    }

    old = (char *) psPtr->clientData;
    if ((append != 0) && (old != NULL)) {
	int length;

	length = strlen(old) + strlen(command) + 2;
	new = (char *) ckalloc((unsigned) length);
	sprintf(new, "%s\n%s", old, command);
    } else {
	new = (char *) ckalloc((unsigned) strlen(command) + 1);
	strcpy(new, command);
    }
    if (old != NULL) {
	ckfree(old);
    }
    psPtr->eventProc = EvalTclBinding;
    psPtr->freeProc = FreeTclBinding;
    psPtr->clientData = (ClientData) new;
    return eventMask;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkCreateBindingProcedure --
 *
 *	Add a C binding to a binding table, so that future calls to
 *	Tk_BindEvent may callback the procedure in the binding.
 *
 * Results:
 *	The return value is 0 if an error occurred while setting
 *	up the binding.  In this case, an error message will be
 *	left in interp->result.  If all went well then the return
 *	value is a mask of the event types that must be made
 *	available to Tk_BindEvent in order to properly detect when
 *	this binding triggers.  This value can be used to determine
 *	what events to select for in a window, for example.
 *
 * Side effects:
 *	Any existing binding on the same event sequence will be
 *	replaced.  
 *
 *---------------------------------------------------------------------------
 */

unsigned long
TkCreateBindingProcedure(interp, bindingTable, object, eventString,
	eventProc, freeProc, clientData)
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tk_BindingTable bindingTable;
				/* Table in which to create binding. */
    ClientData object;		/* Token for object with which binding is
				 * associated. */
    char *eventString;		/* String describing event sequence that
				 * triggers binding. */
    TkBindEvalProc *eventProc;	/* Procedure to invoke when binding
				 * triggers.  Must not be NULL. */
    TkBindFreeProc *freeProc;	/* Procedure to invoke when binding is
				 * freed.  May be NULL for no procedure. */
    ClientData clientData;	/* Arbitrary ClientData to pass to eventProc
				 * and freeProc. */
{
    BindingTable *bindPtr = (BindingTable *) bindingTable;
    PatSeq *psPtr;
    unsigned long eventMask;

    psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
	    1, 1, &eventMask);
    if (psPtr == NULL) {
	return 0;
    }
    if (psPtr->eventProc == NULL) {
	int new;
	Tcl_HashEntry *hPtr;
	
	/*
	 * This pattern sequence was just created.
	 * Link the pattern into the list associated with the object, so
	 * that if the object goes away, these bindings will all
	 * automatically be deleted.
	 */

	hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
		&new);
	if (new) {
	    psPtr->nextObjPtr = NULL;
	} else {
	    psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
	}
	Tcl_SetHashValue(hPtr, psPtr);
    } else {

	/*
	 * Free existing callback.
	 */

	if (psPtr->freeProc != NULL) {
	    (*psPtr->freeProc)(psPtr->clientData);
	}
    }

    psPtr->eventProc = eventProc;
    psPtr->freeProc = freeProc;
    psPtr->clientData = clientData;
    return eventMask;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_DeleteBinding --
 *
 *	Remove an event binding from a binding table.
 *
 * Results:
 *	The result is a standard Tcl return value.  If an error
 *	occurs then interp->result will contain an error message.
 *
 * Side effects:
 *	The binding given by object and eventString is removed
 *	from bindingTable.
 *
 *--------------------------------------------------------------
 */

int
Tk_DeleteBinding(interp, bindingTable, object, eventString)
    Tcl_Interp *interp;			/* Used for error reporting. */
    Tk_BindingTable bindingTable;	/* Table in which to delete binding. */
    ClientData object;			/* Token for object with which binding
					 * is associated. */
    char *eventString;			/* String describing event sequence
					 * that triggers binding. */
{
    BindingTable *bindPtr = (BindingTable *) bindingTable;
    PatSeq *psPtr, *prevPtr;
    unsigned long eventMask;
    Tcl_HashEntry *hPtr;

    psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
	    0, 1, &eventMask);
    if (psPtr == NULL) {
	Tcl_ResetResult(interp);
	return TCL_OK;
    }

    /*
     * Unlink the binding from the list for its object, then from the
     * list for its pattern.
     */

    hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
    if (hPtr == NULL) {
	panic("Tk_DeleteBinding couldn't find object table entry");
    }
    prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
    if (prevPtr == psPtr) {
	Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
    } else {
	for ( ; ; prevPtr = prevPtr->nextObjPtr) {
	    if (prevPtr == NULL) {
		panic("Tk_DeleteBinding couldn't find on object list");
	    }
	    if (prevPtr->nextObjPtr == psPtr) {
		prevPtr->nextObjPtr = psPtr->nextObjPtr;
		break;
	    }
	}
    }
    prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
    if (prevPtr == psPtr) {
	if (psPtr->nextSeqPtr == NULL) {
	    Tcl_DeleteHashEntry(psPtr->hPtr);
	} else {
	    Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
	}
    } else {
	for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
	    if (prevPtr == NULL) {
		panic("Tk_DeleteBinding couldn't find on hash chain");
	    }
	    if (prevPtr->nextSeqPtr == psPtr) {
		prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
		break;
	    }
	}
    }

    psPtr->flags |= MARKED_DELETED;
    if (psPtr->refCount == 0) {
	if (psPtr->freeProc != NULL) {
	    (*psPtr->freeProc)(psPtr->clientData);
	}
	ckfree((char *) psPtr);
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetBinding --
 *
 *	Return the command associated with a given event string.
 *
 * Results:
 *	The return value is a pointer to the command string
 *	associated with eventString for object in the domain
 *	given by bindingTable.  If there is no binding for
 *	eventString, or if eventString is improperly formed,
 *	then NULL is returned and an error message is left in
 *	interp->result.  The return value is semi-static:  it
 *	will persist until the binding is changed or deleted.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

char *
Tk_GetBinding(interp, bindingTable, object, eventString)
    Tcl_Interp *interp;			/* Interpreter for error reporting. */
    Tk_BindingTable bindingTable;	/* Table in which to look for
					 * binding. */
    ClientData object;			/* Token for object with which binding
					 * is associated. */
    char *eventString;			/* String describing event sequence
					 * that triggers binding. */
{
    BindingTable *bindPtr = (BindingTable *) bindingTable;
    PatSeq *psPtr;
    unsigned long eventMask;

    psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
	    0, 1, &eventMask);
    if (psPtr == NULL) {
	return NULL;
    }
    if (psPtr->eventProc == EvalTclBinding) {
	return (char *) psPtr->clientData;
    }
    return "";
}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetAllBindings --
 *
 *	Return a list of event strings for all the bindings
 *	associated with a given object.
 *
 * Results:
 *	There is no return value.  Interp->result is modified to
 *	hold a Tcl list with one entry for each binding associated
 *	with object in bindingTable.  Each entry in the list
 *	contains the event string associated with one binding.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

void
Tk_GetAllBindings(interp, bindingTable, object)
    Tcl_Interp *interp;			/* Interpreter returning result or
					 * error. */
    Tk_BindingTable bindingTable;	/* Table in which to look for
					 * bindings. */
    ClientData object;			/* Token for object. */

{
    BindingTable *bindPtr = (BindingTable *) bindingTable;
    PatSeq *psPtr;
    Tcl_HashEntry *hPtr;