通讯编程

开发平台：

Visual C++

tkBind.c：源码内容

/*
* There's a percent sequence here. Process it.
*/
number = 0;
string = "??";
switch (before[1]) {
case '#':
number = eventPtr->xany.serial;
goto doNumber;
case 'a':
if (flags & CONFIG) {
TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
string = numStorage;
}
goto doString;
case 'b':
if (flags & BUTTON) {
number = eventPtr->xbutton.button;
goto doNumber;
}
goto doString;
case 'c':
if (flags & EXPOSE) {
number = eventPtr->xexpose.count;
goto doNumber;
}
goto doString;
case 'd':
if (flags & (CROSSING|FOCUS)) {
if (flags & FOCUS) {
number = eventPtr->xfocus.detail;
} else {
number = eventPtr->xcrossing.detail;
}
string = TkFindStateString(notifyDetail, number);
} else if (flags & CONFIGREQ) {
if (eventPtr->xconfigurerequest.value_mask & CWStackMode) {
string = TkFindStateString(configureRequestDetail,
eventPtr->xconfigurerequest.detail);
} else {
string = "";
}
}
goto doString;
case 'f':
if (flags & CROSSING) {
number = eventPtr->xcrossing.focus;
goto doNumber;
}
goto doString;
case 'h':
if (flags & EXPOSE) {
number = eventPtr->xexpose.height;
} else if (flags & (CONFIG)) {
number = eventPtr->xconfigure.height;
} else if (flags & CREATE) {
number = eventPtr->xcreatewindow.height;
} else if (flags & CONFIGREQ) {
number = eventPtr->xconfigurerequest.height;
} else if (flags & RESIZEREQ) {
number = eventPtr->xresizerequest.height;
} else {
goto doString;
}
goto doNumber;
case 'i':
if (flags & CREATE) {
TkpPrintWindowId(numStorage, eventPtr->xcreatewindow.window);
} else if (flags & CONFIGREQ) {
TkpPrintWindowId(numStorage, eventPtr->xconfigurerequest.window);
} else if (flags & MAPREQ) {
TkpPrintWindowId(numStorage, eventPtr->xmaprequest.window);
} else {
TkpPrintWindowId(numStorage, eventPtr->xany.window);
}
string = numStorage;
goto doString;
case 'k':
if (flags & KEY) {
number = eventPtr->xkey.keycode;
goto doNumber;
}
goto doString;
case 'm':
if (flags & CROSSING) {
number = eventPtr->xcrossing.mode;
string = TkFindStateString(notifyMode, number);
} else if (flags & FOCUS) {
number = eventPtr->xfocus.mode;
string = TkFindStateString(notifyMode, number);
}
goto doString;
case 'o':
if (flags & CREATE) {
number = eventPtr->xcreatewindow.override_redirect;
} else if (flags & MAP) {
number = eventPtr->xmap.override_redirect;
} else if (flags & REPARENT) {
number = eventPtr->xreparent.override_redirect;
} else if (flags & CONFIG) {
number = eventPtr->xconfigure.override_redirect;
} else {
goto doString;
}
goto doNumber;
case 'p':
if (flags & CIRC) {
string = TkFindStateString(circPlace, eventPtr->xcirculate.place);
} else if (flags & CIRCREQ) {
string = TkFindStateString(circPlace, eventPtr->xcirculaterequest.place);
}
goto doString;
case 's':
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
number = eventPtr->xkey.state;
} else if (flags & CROSSING) {
number = eventPtr->xcrossing.state;
} else if (flags & PROP) {
string = TkFindStateString(propNotify,
eventPtr->xproperty.state);
goto doString;
} else if (flags & VISIBILITY) {
string = TkFindStateString(visNotify,
eventPtr->xvisibility.state);
goto doString;
} else {
goto doString;
}
goto doNumber;
case 't':
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
number = (int) eventPtr->xkey.time;
} else if (flags & CROSSING) {
number = (int) eventPtr->xcrossing.time;
} else if (flags & PROP) {
number = (int) eventPtr->xproperty.time;
} else {
goto doString;
}
goto doNumber;
case 'v':
number = eventPtr->xconfigurerequest.value_mask;
goto doNumber;
case 'w':
if (flags & EXPOSE) {
number = eventPtr->xexpose.width;
} else if (flags & CONFIG) {
number = eventPtr->xconfigure.width;
} else if (flags & CREATE) {
number = eventPtr->xcreatewindow.width;
} else if (flags & CONFIGREQ) {
number = eventPtr->xconfigurerequest.width;
} else if (flags & RESIZEREQ) {
number = eventPtr->xresizerequest.width;
} else {
goto doString;
}
goto doNumber;
case 'x':
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
number = eventPtr->xkey.x;
} else if (flags & CROSSING) {
number = eventPtr->xcrossing.x;
} else if (flags & EXPOSE) {
number = eventPtr->xexpose.x;
} else if (flags & (CREATE|CONFIG|GRAVITY)) {
number = eventPtr->xcreatewindow.x;
} else if (flags & REPARENT) {
number = eventPtr->xreparent.x;
} else if (flags & CREATE) {
number = eventPtr->xcreatewindow.x;
} else if (flags & CONFIGREQ) {
number = eventPtr->xconfigurerequest.x;
} else {
goto doString;
}
goto doNumber;
case 'y':
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
number = eventPtr->xkey.y;
} else if (flags & EXPOSE) {
number = eventPtr->xexpose.y;
} else if (flags & (CREATE|CONFIG|GRAVITY)) {
number = eventPtr->xcreatewindow.y;
} else if (flags & REPARENT) {
number = eventPtr->xreparent.y;
} else if (flags & CROSSING) {
number = eventPtr->xcrossing.y;
} else if (flags & CREATE) {
number = eventPtr->xcreatewindow.y;
} else if (flags & CONFIGREQ) {
number = eventPtr->xconfigurerequest.y;
} else {
goto doString;
}
goto doNumber;
case 'A':
if (flags & KEY) {
Tcl_DStringFree(&buf);
string = TkpGetString(winPtr, eventPtr, &buf);
}
goto doString;
case 'B':
if (flags & CREATE) {
number = eventPtr->xcreatewindow.border_width;
} else if (flags & CONFIGREQ) {
number = eventPtr->xconfigurerequest.border_width;
} else if (flags & CONFIG) {
number = eventPtr->xconfigure.border_width;
} else {
goto doString;
}
goto doNumber;
case 'D':
/*
* This is used only by the MouseWheel event.
*/
if (flags & KEY) {
number = eventPtr->xkey.keycode;
goto doNumber;
}
goto doString;
case 'E':
number = (int) eventPtr->xany.send_event;
goto doNumber;
case 'K':
if (flags & KEY) {
char *name;
name = TkKeysymToString(keySym);
if (name != NULL) {
string = name;
}
}
goto doString;
case 'N':
if (flags & KEY) {
number = (int) keySym;
goto doNumber;
}
goto doString;
case 'P':
if (flags & PROP) {
string = Tk_GetAtomName((Tk_Window) winPtr, eventPtr->xproperty.atom);
}
goto doString;
case 'R':
if (flags & KEY_BUTTON_MOTION_CROSSING) {
TkpPrintWindowId(numStorage, eventPtr->xkey.root);
string = numStorage;
}
goto doString;
case 'S':
if (flags & KEY_BUTTON_MOTION_CROSSING) {
TkpPrintWindowId(numStorage, eventPtr->xkey.subwindow);
string = numStorage;
}
goto doString;
case 'T':
number = eventPtr->type;
goto doNumber;
case 'W': {
Tk_Window tkwin;
tkwin = Tk_IdToWindow(eventPtr->xany.display,
eventPtr->xany.window);
if (tkwin != NULL) {
string = Tk_PathName(tkwin);
} else {
string = "??";
}
goto doString;
}
case 'X':
if (flags & KEY_BUTTON_MOTION_CROSSING) {
Tk_Window tkwin;
int x, y;
int width, height;
number = eventPtr->xkey.x_root;
tkwin = Tk_IdToWindow(eventPtr->xany.display,
eventPtr->xany.window);
if (tkwin != NULL) {
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
number -= x;
}
goto doNumber;
}
goto doString;
case 'Y':
if (flags & KEY_BUTTON_MOTION_CROSSING) {
Tk_Window tkwin;
int x, y;
int width, height;
number = eventPtr->xkey.y_root;
tkwin = Tk_IdToWindow(eventPtr->xany.display,
eventPtr->xany.window);
if (tkwin != NULL) {
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
number -= y;
}
goto doNumber;
}
goto doString;
default:
numStorage[0] = before[1];
numStorage[1] = '';
string = numStorage;
goto doString;
}
doNumber:
sprintf(numStorage, "%d", number);
string = numStorage;
doString:
spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
length = Tcl_DStringLength(dsPtr);
Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
spaceNeeded = Tcl_ConvertElement(string,
Tcl_DStringValue(dsPtr) + length,
cvtFlags | TCL_DONT_USE_BRACES);
Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
before += 2;
}
Tcl_DStringFree(&buf);
}
/*
*----------------------------------------------------------------------
*
* ChangeScreen --
*
* This procedure is invoked whenever the current screen changes
* in an application. It invokes a Tcl procedure named
* "tk::ScreenChanged", passing it the screen name as argument.
* tk::ScreenChanged does things like making the tk::Priv variable
* point to an array for the current display.
*
* Results:
* None.
*
* Side effects:
* Depends on what tk::ScreenChanged does. If an error occurs
* them bgerror will be invoked.
*
*----------------------------------------------------------------------
*/
static void
ChangeScreen(interp, dispName, screenIndex)
Tcl_Interp *interp; /* Interpreter in which to invoke
* command. */
char *dispName; /* Name of new display. */
int screenIndex; /* Index of new screen. */
{
Tcl_DString cmd;
int code;
char screen[TCL_INTEGER_SPACE];
Tcl_DStringInit(&cmd);
Tcl_DStringAppend(&cmd, "tk::ScreenChanged ", 18);
Tcl_DStringAppend(&cmd, dispName, -1);
sprintf(screen, ".%d", screenIndex);
Tcl_DStringAppend(&cmd, screen, -1);
code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd),
TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
Tcl_AddErrorInfo(interp,
"n (changing screen in event binding)");
Tcl_BackgroundError(interp);
}
}
/*
*----------------------------------------------------------------------
*
* Tk_EventCmd --
*
* This procedure is invoked to process the "event" Tcl command.
* It is used to define and generate events.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
int
Tk_EventObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int index;
Tk_Window tkwin;
VirtualEventTable *vetPtr;
TkBindInfo bindInfo;
static CONST char *optionStrings[] = {
"add", "delete", "generate", "info",
NULL
};
enum options {
EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO
};
tkwin = (Tk_Window) clientData;
bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case EVENT_ADD: {
int i;
char *name, *event;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv,
"virtual sequence ?sequence ...?");
return TCL_ERROR;
}
name = Tcl_GetStringFromObj(objv[2], NULL);
for (i = 3; i < objc; i++) {
event = Tcl_GetStringFromObj(objv[i], NULL);
if (CreateVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
return TCL_ERROR;
}
}
break;
}
case EVENT_DELETE: {
int i;
char *name, *event;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv,
"virtual ?sequence sequence ...?");
return TCL_ERROR;
}
name = Tcl_GetStringFromObj(objv[2], NULL);
if (objc == 3) {
return DeleteVirtualEvent(interp, vetPtr, name, NULL);
}
for (i = 3; i < objc; i++) {
event = Tcl_GetStringFromObj(objv[i], NULL);
if (DeleteVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
return TCL_ERROR;
}
}
break;
}
case EVENT_GENERATE: {
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv, "window event ?options?");
return TCL_ERROR;
}
return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2);
}
case EVENT_INFO: {
if (objc == 2) {
GetAllVirtualEvents(interp, vetPtr);
return TCL_OK;
} else if (objc == 3) {
return GetVirtualEvent(interp, vetPtr,
Tcl_GetStringFromObj(objv[2], NULL));
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?virtual?");
return TCL_ERROR;
}
}
}
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
* InitVirtualEventTable --
*
* Given storage for a virtual event table, set up the fields to
* prepare a new domain in which virtual events may be defined.
*
* Results:
* None.
*
* Side effects:
* *vetPtr is now initialized.
*
*---------------------------------------------------------------------------
*/
static void
InitVirtualEventTable(vetPtr)
VirtualEventTable *vetPtr; /* Pointer to virtual event table. Memory
* is supplied by the caller. */
{
Tcl_InitHashTable(&vetPtr->patternTable,
sizeof(PatternTableKey) / sizeof(int));
Tcl_InitHashTable(&vetPtr->nameTable, TCL_ONE_WORD_KEYS);
}
/*
*---------------------------------------------------------------------------
*
* DeleteVirtualEventTable --
*
* Delete the contents of a virtual event table. The caller is
* responsible for freeing any memory used by the table itself.
*
* Results:
* None.
*
* Side effects:
* Memory is freed.
*
*---------------------------------------------------------------------------
*/
static void
DeleteVirtualEventTable(vetPtr)
VirtualEventTable *vetPtr; /* The virtual event table to delete. */
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
PatSeq *psPtr, *nextPtr;
hPtr = Tcl_FirstHashEntry(&vetPtr->patternTable, &search);
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
for ( ; psPtr != NULL; psPtr = nextPtr) {
nextPtr = psPtr->nextSeqPtr;
ckfree((char *) psPtr->voPtr);
ckfree((char *) psPtr);
}
}
Tcl_DeleteHashTable(&vetPtr->patternTable);
hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
ckfree((char *) Tcl_GetHashValue(hPtr));
}
Tcl_DeleteHashTable(&vetPtr->nameTable);
}
/*
*----------------------------------------------------------------------
*
* CreateVirtualEvent --
*
* Add a new definition for a virtual event. If the virtual event
* is already defined, the new definition augments those that
* already exist.
*
* Results:
* The return value is TCL_ERROR if an error occured while
* creating the virtual binding. In this case, an error message
* will be left in the interp's result. If all went well then the
* return value is TCL_OK.
*
* Side effects:
* The virtual event may cause future calls to Tk_BindEvent to
* behave differently than they did previously.
*
*----------------------------------------------------------------------
*/
static int
CreateVirtualEvent(interp, vetPtr, virtString, eventString)
Tcl_Interp *interp; /* Used for error reporting. */
VirtualEventTable *vetPtr;/* Table in which to augment virtual event. */
char *virtString; /* Name of new virtual event. */
char *eventString; /* String describing physical event that
* triggers virtual event. */
{
PatSeq *psPtr;
int dummy;
Tcl_HashEntry *vhPtr;
unsigned long eventMask;
PhysicalsOwned *poPtr;
VirtualOwners *voPtr;
Tk_Uid virtUid;
virtUid = GetVirtualEventUid(interp, virtString);
if (virtUid == NULL) {
return TCL_ERROR;
}
/*
* Find/create physical event
*/
psPtr = FindSequence(interp, &vetPtr->patternTable, NULL, eventString,
1, 0, &eventMask);
if (psPtr == NULL) {
return TCL_ERROR;
}
/*
* Find/create virtual event.
*/
vhPtr = Tcl_CreateHashEntry(&vetPtr->nameTable, virtUid, &dummy);
/*
* Make virtual event own the physical event.
*/
poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
if (poPtr == NULL) {
poPtr = (PhysicalsOwned *) ckalloc(sizeof(PhysicalsOwned));
poPtr->numOwned = 0;
} else {
/*
* See if this virtual event is already defined for this physical
* event and just return if it is.
*/
int i;
for (i = 0; i < poPtr->numOwned; i++) {
if (poPtr->patSeqs[i] == psPtr) {
return TCL_OK;
}
}
poPtr = (PhysicalsOwned *) ckrealloc((char *) poPtr,
sizeof(PhysicalsOwned) + poPtr->numOwned * sizeof(PatSeq *));
}
Tcl_SetHashValue(vhPtr, (ClientData) poPtr);
poPtr->patSeqs[poPtr->numOwned] = psPtr;
poPtr->numOwned++;
/*
* Make physical event so it can trigger the virtual event.
*/
voPtr = psPtr->voPtr;
if (voPtr == NULL) {
voPtr = (VirtualOwners *) ckalloc(sizeof(VirtualOwners));
voPtr->numOwners = 0;
} else {
voPtr = (VirtualOwners *) ckrealloc((char *) voPtr,
sizeof(VirtualOwners)
+ voPtr->numOwners * sizeof(Tcl_HashEntry *));
}
psPtr->voPtr = voPtr;
voPtr->owners[voPtr->numOwners] = vhPtr;
voPtr->numOwners++;
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* DeleteVirtualEvent --
*
* Remove the definition of a given virtual event. If the
* event string is NULL, all definitions of the virtual event
* will be removed. Otherwise, just the specified definition
* of the virtual event will be removed.
*
* Results:
* The result is a standard Tcl return value. If an error
* occurs then the interp's result will contain an error message.
* It is not an error to attempt to delete a virtual event that
* does not exist or a definition that does not exist.
*
* Side effects:
* The virtual event given by virtString may be removed from the
* virtual event table.
*
*--------------------------------------------------------------
*/
static int
DeleteVirtualEvent(interp, vetPtr, virtString, eventString)
Tcl_Interp *interp; /* Used for error reporting. */
VirtualEventTable *vetPtr;/* Table in which to delete event. */
char *virtString; /* String describing event sequence that
* triggers binding. */
char *eventString; /* The event sequence that should be deleted,
* or NULL to delete all event sequences for
* the entire virtual event. */
{
int iPhys;
Tk_Uid virtUid;
Tcl_HashEntry *vhPtr;
PhysicalsOwned *poPtr;
PatSeq *eventPSPtr;
virtUid = GetVirtualEventUid(interp, virtString);
if (virtUid == NULL) {
return TCL_ERROR;
}
vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
if (vhPtr == NULL) {
return TCL_OK;
}
poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
eventPSPtr = NULL;
if (eventString != NULL) {
unsigned long eventMask;
/*
* Delete only the specific physical event associated with the
* virtual event. If the physical event doesn't already exist, or
* the virtual event doesn't own that physical event, return w/o
* doing anything.
*/
eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL,
eventString, 0, 0, &eventMask);
if (eventPSPtr == NULL) {
CONST char *string;
string = Tcl_GetStringResult(interp);
return (string[0] != '') ? TCL_ERROR : TCL_OK;
}
}
for (iPhys = poPtr->numOwned; --iPhys >= 0; ) {
PatSeq *psPtr = poPtr->patSeqs[iPhys];
if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) {
int iVirt;
VirtualOwners *voPtr;
/*
* Remove association between this physical event and the given
* virtual event that it triggers.
*/
voPtr = psPtr->voPtr;
for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
if (voPtr->owners[iVirt] == vhPtr) {
break;
}
}
if (iVirt == voPtr->numOwners) {
panic("DeleteVirtualEvent: couldn't find owner");
}
voPtr->numOwners--;
if (voPtr->numOwners == 0) {
/*
* Removed last reference to this physical event, so
* remove it from physical->virtual map.
*/
PatSeq *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("DeleteVirtualEvent couldn't find on hash chain");
}
if (prevPtr->nextSeqPtr == psPtr) {
prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
break;
}
}
}
ckfree((char *) psPtr->voPtr);
ckfree((char *) psPtr);
} else {
/*
* This physical event still triggers some other virtual
* event(s). Consolidate the list of virtual owners for
* this physical event so it no longer triggers the
* given virtual event.
*/
voPtr->owners[iVirt] = voPtr->owners[voPtr->numOwners];
}
/*
* Now delete the virtual event's reference to the physical
* event.
*/
poPtr->numOwned--;
if (eventPSPtr != NULL && poPtr->numOwned != 0) {
/*
* Just deleting this one physical event. Consolidate list
* of owned physical events and return.
*/
poPtr->patSeqs[iPhys] = poPtr->patSeqs[poPtr->numOwned];
return TCL_OK;
}
}
}
if (poPtr->numOwned == 0) {
/*
* All the physical events for this virtual event were deleted,
* either because there was only one associated physical event or
* because the caller was deleting the entire virtual event. Now
* the virtual event itself should be deleted.
*/
ckfree((char *) poPtr);
Tcl_DeleteHashEntry(vhPtr);
}
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
* GetVirtualEvent --
*
* Return the list of physical events that can invoke the
* given virtual event.
*
* Results:
* The return value is TCL_OK and the interp's result is filled with the
* string representation of the physical events associated with the
* virtual event; if there are no physical events for the given virtual
* event, the interp's result is filled with and empty string. If the
* virtual event string is improperly formed, then TCL_ERROR is
* returned and an error message is left in the interp's result.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
static int
GetVirtualEvent(interp, vetPtr, virtString)
Tcl_Interp *interp; /* Interpreter for reporting. */
VirtualEventTable *vetPtr;/* Table in which to look for event. */
char *virtString; /* String describing virtual event. */
{
Tcl_HashEntry *vhPtr;
Tcl_DString ds;
int iPhys;
PhysicalsOwned *poPtr;
Tk_Uid virtUid;
virtUid = GetVirtualEventUid(interp, virtString);
if (virtUid == NULL) {
return TCL_ERROR;
}
vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
if (vhPtr == NULL) {
return TCL_OK;
}
Tcl_DStringInit(&ds);
poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) {
Tcl_DStringSetLength(&ds, 0);
GetPatternString(poPtr->patSeqs[iPhys], &ds);
Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
}
Tcl_DStringFree(&ds);
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* GetAllVirtualEvents --
*
* Return a list that contains the names of all the virtual
* event defined.
*
* Results:
* There is no return value. The interp's result is modified to
* hold a Tcl list with one entry for each virtual event in
* nameTable.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
static void
GetAllVirtualEvents(interp, vetPtr)
Tcl_Interp *interp; /* Interpreter returning result. */
VirtualEventTable *vetPtr;/* Table containing events. */
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_DString ds;
Tcl_DStringInit(&ds);
hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
Tcl_DStringSetLength(&ds, 0);
Tcl_DStringAppend(&ds, "<<", 2);
Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1);
Tcl_DStringAppend(&ds, ">>", 2);
Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
}
Tcl_DStringFree(&ds);
}
/*
*---------------------------------------------------------------------------
*
* HandleEventGenerate --
*
* Helper function for the "event generate" command. Generate and
* process an XEvent, constructed from information parsed from the
* event description string and its optional arguments.
*
* argv[0] contains name of the target window.
* argv[1] contains pattern string for one event (e.g, <Control-v>).
* argv[2..argc-1] contains -field/option pairs for specifying
* additional detail in the generated event.
*
* Either virtual or physical events can be generated this way.
* The event description string must contain the specification
* for only one event.
*
* Results:
* None.
*
* Side effects:
* When constructing the event,
* event.xany.serial is filled with the current X serial number.
* event.xany.window is filled with the target window.
* event.xany.display is filled with the target window's display.
* Any other fields in eventPtr which are not specified by the pattern
* string or the optional arguments, are set to 0.
*
* The event may be handled sychronously or asynchronously, depending
* on the value specified by the optional "-when" option. The
* default setting is synchronous.
*
*---------------------------------------------------------------------------
*/
static int
HandleEventGenerate(interp, mainWin, objc, objv)
Tcl_Interp *interp; /* Interp for errors return and name lookup. */
Tk_Window mainWin; /* Main window associated with interp. */
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
XEvent event;
CONST char *p;
char *name, *windowName;
int count, flags, synch, i, number, warp;
Tcl_QueuePosition pos;
Pattern pat;
Tk_Window tkwin, tkwin2;
TkWindow *mainPtr;
unsigned long eventMask;
static CONST char *fieldStrings[] = {
"-when", "-above", "-borderwidth", "-button",
"-count", "-delta", "-detail", "-focus",
"-height",
"-keycode", "-keysym", "-mode", "-override",
"-place", "-root", "-rootx", "-rooty",
"-sendevent", "-serial", "-state", "-subwindow",
"-time", "-warp", "-width", "-window",
"-x", "-y", NULL
};
enum field {
EVENT_WHEN, EVENT_ABOVE, EVENT_BORDER, EVENT_BUTTON,
EVENT_COUNT, EVENT_DELTA, EVENT_DETAIL, EVENT_FOCUS,
EVENT_HEIGHT,
EVENT_KEYCODE, EVENT_KEYSYM, EVENT_MODE, EVENT_OVERRIDE,
EVENT_PLACE, EVENT_ROOT, EVENT_ROOTX, EVENT_ROOTY,
EVENT_SEND, EVENT_SERIAL, EVENT_STATE, EVENT_SUBWINDOW,
EVENT_TIME, EVENT_WARP, EVENT_WIDTH, EVENT_WINDOW,
EVENT_X, EVENT_Y
};
windowName = Tcl_GetStringFromObj(objv[0], NULL);
if (!windowName[0]) {
tkwin = mainWin;
} else if (NameToWindow(interp, mainWin, objv[0], &tkwin) != TCL_OK) {
return TCL_ERROR;
}
mainPtr = (TkWindow *) mainWin;
if ((tkwin == NULL)
|| (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
char *name;
name = Tcl_GetStringFromObj(objv[0], NULL);
Tcl_AppendResult(interp, "window id "", name,
"" doesn't exist in this application", (char *) NULL);
return TCL_ERROR;
}
name = Tcl_GetStringFromObj(objv[1], NULL);
p = name;
eventMask = 0;
count = ParseEventDescription(interp, &p, &pat, &eventMask);
if (count == 0) {
return TCL_ERROR;
}
if (count != 1) {
Tcl_SetResult(interp, "Double or Triple modifier not allowed",
TCL_STATIC);
return TCL_ERROR;
}
if (*p != '') {
Tcl_SetResult(interp, "only one event specification allowed",
TCL_STATIC);
return TCL_ERROR;
}
memset((VOID *) &event, 0, sizeof(event));
event.xany.type = pat.eventType;
event.xany.serial = NextRequest(Tk_Display(tkwin));
event.xany.send_event = False;
if (windowName[0]) {
event.xany.window = Tk_WindowId(tkwin);
} else {
event.xany.window = RootWindow(Tk_Display(tkwin), Tk_ScreenNumber(tkwin));
}
event.xany.display = Tk_Display(tkwin);
flags = flagArray[event.xany.type];
if (flags & DESTROY) {
/*
* Event DesotryNotify should be generated by destroying
* the window.
*/
Tk_DestroyWindow(tkwin);
return TCL_OK;
}
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
event.xkey.state = pat.needMods;
if ((flags & KEY) && (event.xany.type != MouseWheelEvent)) {
TkpSetKeycodeAndState(tkwin, pat.detail.keySym, &event);
} else if (flags & BUTTON) {
event.xbutton.button = pat.detail.button;
} else if (flags & VIRTUAL) {
((XVirtualEvent *) &event)->name = pat.detail.name;
}
}
if (flags & (CREATE|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
event.xcreatewindow.window = event.xany.window;
}
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
event.xkey.x_root = -1;
event.xkey.y_root = -1;
}
/*
* Process the remaining arguments to fill in additional fields
* of the event.
*/
synch = 1;
warp = 0;
pos = TCL_QUEUE_TAIL;
for (i = 2; i < objc; i += 2) {
Tcl_Obj *optionPtr, *valuePtr;
int index;
optionPtr = objv[i];
valuePtr = objv[i + 1];
if (Tcl_GetIndexFromObj(interp, optionPtr, fieldStrings, "option",
TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (objc & 1) {
/*
* This test occurs after Tcl_GetIndexFromObj() so that
* "event generate <Button> -xyz" will return the error message
* that "-xyz" is a bad option, rather than that the value
* for "-xyz" is missing.
*/
Tcl_AppendResult(interp, "value for "",
Tcl_GetStringFromObj(optionPtr, NULL), "" missing",
(char *) NULL);
return TCL_ERROR;
}
switch ((enum field) index) {
case EVENT_WARP: {
if (Tcl_GetBooleanFromObj(interp, valuePtr, &warp) != TCL_OK) {
return TCL_ERROR;
}
if (!(flags & (KEY_BUTTON_MOTION_VIRTUAL))) {
goto badopt;
}
break;
}
case EVENT_WHEN: {
pos = (Tcl_QueuePosition) TkFindStateNumObj(interp, optionPtr,
queuePosition, valuePtr);
if ((int) pos < -1) {
return TCL_ERROR;
}
synch = 0;
if ((int) pos == -1) {
synch = 1;
}
break;
}
case EVENT_ABOVE: {
if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
return TCL_ERROR;
}
if (flags & CONFIG) {
event.xconfigure.above = Tk_WindowId(tkwin2);
} else {
goto badopt;
}
break;
}
case EVENT_BORDER: {
if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & (CREATE|CONFIG)) {
event.xcreatewindow.border_width = number;
} else {
goto badopt;
}
break;
}
case EVENT_BUTTON: {
if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & BUTTON) {
event.xbutton.button = number;
} else {
goto badopt;
}
break;
}
case EVENT_COUNT: {
if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & EXPOSE) {
event.xexpose.count = number;
} else {
goto badopt;
}
break;
}
case EVENT_DELTA: {
if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) {
event.xkey.keycode = number;
} else {
goto badopt;
}
break;
}
case EVENT_DETAIL: {
number = TkFindStateNumObj(interp, optionPtr, notifyDetail,
valuePtr);
if (number < 0) {
return TCL_ERROR;
}
if (flags & FOCUS) {
event.xfocus.detail = number;
} else if (flags & CROSSING) {
event.xcrossing.detail = number;
} else {
goto badopt;
}
break;
}
case EVENT_FOCUS: {
if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & CROSSING) {
event.xcrossing.focus = number;
} else {
goto badopt;
}
break;
}
case EVENT_HEIGHT: {
if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & EXPOSE) {
event.xexpose.height = number;
} else if (flags & CONFIG) {
event.xconfigure.height = number;
} else {
goto badopt;
}
break;
}
case EVENT_KEYCODE: {
if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) {
event.xkey.keycode = number;
} else {
goto badopt;
}
break;
}
case EVENT_KEYSYM: {
KeySym keysym;
char *value;
value = Tcl_GetStringFromObj(valuePtr, NULL);
keysym = TkStringToKeysym(value);
if (keysym == NoSymbol) {
Tcl_AppendResult(interp, "unknown keysym "", value, """,
(char *) NULL);
return TCL_ERROR;
}
TkpSetKeycodeAndState(tkwin, keysym, &event);
if (event.xkey.keycode == 0) {
Tcl_AppendResult(interp, "no keycode for keysym "", value,
""", (char *) NULL);
return TCL_ERROR;
}
if (!(flags & KEY) || (event.xkey.type == MouseWheelEvent)) {
goto badopt;
}
break;
}
case EVENT_MODE: {
number = TkFindStateNumObj(interp, optionPtr, notifyMode,
valuePtr);
if (number < 0) {
return TCL_ERROR;
}
if (flags & CROSSING) {
event.xcrossing.mode = number;
} else if (flags & FOCUS) {
event.xfocus.mode = number;
} else {
goto badopt;
}
break;
}
case EVENT_OVERRIDE: {
if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & CREATE) {
event.xcreatewindow.override_redirect = number;
} else if (flags & MAP) {
event.xmap.override_redirect = number;
} else if (flags & REPARENT) {
event.xreparent.override_redirect = number;
} else if (flags & CONFIG) {
event.xconfigure.override_redirect = number;
} else {
goto badopt;
}
break;
}
case EVENT_PLACE: {
number = TkFindStateNumObj(interp, optionPtr, circPlace,
valuePtr);
if (number < 0) {
return TCL_ERROR;
}
if (flags & CIRC) {
event.xcirculate.place = number;
} else {
goto badopt;
}
break;
}
case EVENT_ROOT: {
if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
return TCL_ERROR;
}
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
event.xkey.root = Tk_WindowId(tkwin2);
} else {
goto badopt;
}
break;
}
case EVENT_ROOTX: {
if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
event.xkey.x_root = number;
} else {
goto badopt;
}
break;
}
case EVENT_ROOTY: {
if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
event.xkey.y_root = number;
} else {
goto badopt;
}
break;
}
case EVENT_SEND: {
CONST char *value;
value = Tcl_GetStringFromObj(valuePtr, NULL);
if (isdigit(UCHAR(value[0]))) {
/*
* Allow arbitrary integer values for the field; they
* are needed by a few of the tests in the Tk test suite.
*/
if (Tcl_GetIntFromObj(interp, valuePtr, &number)
!= TCL_OK) {
return TCL_ERROR;
}
} else {
if (Tcl_GetBooleanFromObj(interp, valuePtr, &number)
!= TCL_OK) {
return TCL_ERROR;
}
}
event.xany.send_event = number;
break;
}
case EVENT_SERIAL: {
if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
event.xany.serial = number;
break;
}
case EVENT_STATE: {
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
if (Tcl_GetIntFromObj(interp, valuePtr, &number)
!= TCL_OK) {
return TCL_ERROR;
}
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
event.xkey.state = number;
} else {
event.xcrossing.state = number;
}
} else if (flags & VISIBILITY) {
number = TkFindStateNumObj(interp, optionPtr, visNotify,
valuePtr);
if (number < 0) {
return TCL_ERROR;
}
event.xvisibility.state = number;
} else {
goto badopt;
}
break;
}
case EVENT_SUBWINDOW: {
if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
return TCL_ERROR;
}
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
event.xkey.subwindow = Tk_WindowId(tkwin2);
} else {
goto badopt;
}
break;
}
case EVENT_TIME: {
if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
event.xkey.time = (Time) number;
} else if (flags & PROP) {
event.xproperty.time = (Time) number;
} else {
goto badopt;
}
break;
}
case EVENT_WIDTH: {
if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
!= TCL_OK) {
return TCL_ERROR;
}
if (flags & EXPOSE) {
event.xexpose.width = number;
} else if (flags & (CREATE|CONFIG)) {
event.xcreatewindow.width = number;
} else {
goto badopt;
}
break;
}
case EVENT_WINDOW: {
if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
return TCL_ERROR;
}
if (flags & (CREATE|UNMAP|MAP|REPARENT|CONFIG
|GRAVITY|CIRC)) {
event.xcreatewindow.window = Tk_WindowId(tkwin2);
} else {
goto badopt;
}
break;
}
case EVENT_X: {
if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
!= TCL_OK) {
return TCL_ERROR;
}
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
event.xkey.x = number;
/*
* Only modify rootx as well if it hasn't been changed.
*/
if (event.xkey.x_root == -1) {
int rootX, rootY;
Tk_GetRootCoords(tkwin, &rootX, &rootY);
event.xkey.x_root = rootX + number;
}
} else if (flags & EXPOSE) {
event.xexpose.x = number;
} else if (flags & (CREATE|CONFIG|GRAVITY)) {
event.xcreatewindow.x = number;
} else if (flags & REPARENT) {
event.xreparent.x = number;
} else {
goto badopt;
}
break;
}
case EVENT_Y: {
if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
!= TCL_OK) {
return TCL_ERROR;
}
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
event.xkey.y = number;
/*
* Only modify rooty as well if it hasn't been changed.
*/
if (event.xkey.y_root == -1) {
int rootX, rootY;
Tk_GetRootCoords(tkwin, &rootX, &rootY);
event.xkey.y_root = rootY + number;
}
} else if (flags & EXPOSE) {
event.xexpose.y = number;
} else if (flags & (CREATE|CONFIG|GRAVITY)) {
event.xcreatewindow.y = number;
} else if (flags & REPARENT) {
event.xreparent.y = number;
} else {
goto badopt;
}
break;
}
}
continue;
badopt:
Tcl_AppendResult(interp, name, " event doesn't accept "",
Tcl_GetStringFromObj(optionPtr, NULL), "" option", NULL);
return TCL_ERROR;
}
if (synch != 0) {
Tk_HandleEvent(&event);
} else {
Tk_QueueWindowEvent(&event, pos);
}
/*
* We only allow warping if the window is mapped
*/
if ((warp != 0) && Tk_IsMapped(tkwin)) {
TkDisplay *dispPtr;
dispPtr = TkGetDisplay(event.xmotion.display);
if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) {
Tcl_DoWhenIdle(DoWarp, (ClientData) dispPtr);
dispPtr->flags |= TK_DISPLAY_IN_WARP;
}
dispPtr->warpWindow = event.xany.window;
dispPtr->warpX = event.xkey.x;
dispPtr->warpY = event.xkey.y;
}
Tcl_ResetResult(interp);
return TCL_OK;
}
static int
NameToWindow(interp, mainWin, objPtr, tkwinPtr)
Tcl_Interp *interp; /* Interp for error return and name lookup. */
Tk_Window mainWin; /* Main window of application. */
Tcl_Obj *objPtr; /* Contains name or id string of window. */
Tk_Window *tkwinPtr; /* Filled with token for window. */
{
char *name;
Tk_Window tkwin;
Window id;
name = Tcl_GetStringFromObj(objPtr, NULL);
if (name[0] == '.') {
tkwin = Tk_NameToWindow(interp, name, mainWin);
if (tkwin == NULL) {
return TCL_ERROR;
}
*tkwinPtr = tkwin;
} else {
/*
* Check for the winPtr being valid, even if it looks ok to
* TkpScanWindowId. [Bug #411307]
*/
if ((TkpScanWindowId(NULL, name, &id) != TCL_OK) ||
((*tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), id))
== NULL)) {
Tcl_AppendResult(interp, "bad window name/identifier "",
name, """, (char *) NULL);
return TCL_ERROR;
}
}
return TCL_OK;
}
/*
*-------------------------------------------------------------------------
*
* DoWarp --
*
* Perform Warping of X pointer. Executed as an idle handler only.
*
* Results:
* None
*
* Side effects:
* X Pointer will move to a new location.
*
*-------------------------------------------------------------------------
*/
static void
DoWarp(clientData)
ClientData clientData;
{
TkDisplay *dispPtr = (TkDisplay *) clientData;
XWarpPointer(dispPtr->display, (Window) None, (Window) dispPtr->warpWindow,
0, 0, 0, 0, (int) dispPtr->warpX, (int) dispPtr->warpY);
XForceScreenSaver(dispPtr->display, ScreenSaverReset);
dispPtr->flags &= ~TK_DISPLAY_IN_WARP;
}
/*
*-------------------------------------------------------------------------
*
* GetVirtualEventUid --
*
* Determine if the given string is in the proper format for a
* virtual event.
*
* Results:
* The return value is NULL if the virtual event string was
* not in the proper format. In this case, an error message
* will be left in the interp's result. Otherwise the return
* value is a Tk_Uid that represents the virtual event.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
static Tk_Uid
GetVirtualEventUid(interp, virtString)
Tcl_Interp *interp;
char *virtString;
{
Tk_Uid uid;
int length;
length = strlen(virtString);
if (length < 5 || virtString[0] != '<' || virtString[1] != '<' ||
virtString[length - 2] != '>' || virtString[length - 1] != '>') {
Tcl_AppendResult(interp, "virtual event "", virtString,
"" is badly formed", (char *) NULL);
return NULL;
}
virtString[length - 2] = '';
uid = Tk_GetUid(virtString + 2);
virtString[length - 2] = '>';
return uid;
}
/*
*----------------------------------------------------------------------
*
* FindSequence --
*
* Find the entry in the pattern table that corresponds to a
* particular pattern string, and return a pointer to that
* entry.
*
* Results:
* The return value is normally a pointer to the PatSeq
* in patternTable that corresponds to eventString. If an error
* was found while parsing eventString, or if "create" is 0 and
* no pattern sequence previously existed, then NULL is returned
* and the interp's result contains a message describing the problem.
* If no pattern sequence previously existed for eventString, then
* a new one is created with a NULL command field. In a successful
* return, *maskPtr is filled in with a mask of the event types
* on which the pattern sequence depends.
*
* Side effects:
* A new pattern sequence may be allocated.
*
*----------------------------------------------------------------------
*/
static PatSeq *
FindSequence(interp, patternTablePtr, object, eventString, create,
allowVirtual, maskPtr)
Tcl_Interp *interp; /* Interpreter to use for error
* reporting. */
Tcl_HashTable *patternTablePtr; /* Table to use for lookup. */
ClientData object; /* For binding table, token for object with
* which binding is associated.
* For virtual event table, NULL. */
CONST char *eventString; /* String description of pattern to
* match on. See user documentation
* for details. */
int create; /* 0 means don't create the entry if
* it doesn't already exist. Non-zero
* means create. */
int allowVirtual; /* 0 means that virtual events are not
* allowed in the sequence. Non-zero
* otherwise. */
unsigned long *maskPtr; /* *maskPtr is filled in with the event
* types on which this pattern sequence
* depends. */
{
Pattern pats[EVENT_BUFFER_SIZE];
int numPats, virtualFound;
CONST char *p;
Pattern *patPtr;
PatSeq *psPtr;
Tcl_HashEntry *hPtr;
int flags, count, new;
size_t sequenceSize;
unsigned long eventMask;
PatternTableKey key;
/*
*-------------------------------------------------------------
* Step 1: parse the pattern string to produce an array
* of Patterns. The array is generated backwards, so
* that the lowest-indexed pattern corresponds to the last
* event that must occur.
*-------------------------------------------------------------
*/
p = eventString;
flags = 0;
eventMask = 0;
virtualFound = 0;
patPtr = &pats[EVENT_BUFFER_SIZE-1];
for (numPats = 0; numPats < EVENT_BUFFER_SIZE; numPats++, patPtr--) {
while (isspace(UCHAR(*p))) {
p++;
}
if (*p == '') {
break;
}
count = ParseEventDescription(interp, &p, patPtr, &eventMask);
if (count == 0) {
return NULL;
}
if (eventMask & VirtualEventMask) {
if (allowVirtual == 0) {
Tcl_SetResult(interp,
"virtual event not allowed in definition of another virtual event",
TCL_STATIC);
return NULL;
}
virtualFound = 1;
}
/*
* Replicate events for DOUBLE, TRIPLE, QUADRUPLE.
*/
while ((count-- > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
flags |= PAT_NEARBY;
patPtr[-1] = patPtr[0];
patPtr--;
numPats++;
}
}
/*
*-------------------------------------------------------------
* Step 2: find the sequence in the binding table if it exists,
* and add a new sequence to the table if it doesn't.
*-------------------------------------------------------------
*/
if (numPats == 0) {
Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC);
return NULL;
}
if ((numPats > 1) && (virtualFound != 0)) {
Tcl_SetResult(interp, "virtual events may not be composed",
TCL_STATIC);
return NULL;
}
patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
memset(&key, 0, sizeof(key));
key.object = object;
key.type = patPtr->eventType;
key.detail = patPtr->detail;
hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &new);
sequenceSize = numPats*sizeof(Pattern);
if (!new) {
for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
psPtr = psPtr->nextSeqPtr) {
if ((numPats == psPtr->numPats)
&& ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY))
&& (memcmp((char *) patPtr, (char *) psPtr->pats,
sequenceSize) == 0)) {
goto done;
}
}
}
if (!create) {
if (new) {
Tcl_DeleteHashEntry(hPtr);
}
/*
* No binding exists for the sequence, so return an empty error.
* This is a special error that the caller will check for in order
* to silently ignore this case. This is a hack that maintains
* backward compatibility for Tk_GetBinding but the various "bind"
* commands silently ignore missing bindings.
*/
return NULL;
}
psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
+ (numPats-1)*sizeof(Pattern)));
psPtr->numPats = numPats;
psPtr->eventProc = NULL;
psPtr->freeProc = NULL;
psPtr->clientData = NULL;
psPtr->flags = flags;
psPtr->refCount = 0;
psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
psPtr->hPtr = hPtr;
psPtr->voPtr = NULL;
psPtr->nextObjPtr = NULL;
Tcl_SetHashValue(hPtr, psPtr);
memcpy((VOID *) psPtr->pats, (VOID *) patPtr, sequenceSize);
done:
*maskPtr = eventMask;
return psPtr;
}
/*
*---------------------------------------------------------------------------
*
* ParseEventDescription --
*
* Fill Pattern buffer with information about event from
* event string.
*
* Results:
* Leaves error message in interp and returns 0 if there was an
* error due to a badly formed event string. Returns 1 if proper
* event was specified, 2 if Double modifier was used in event
* string, or 3 if Triple was used.
*
* Side effects:
* On exit, eventStringPtr points to rest of event string (after the
* closing '>', so that this procedure can be called repeatedly to
* parse all the events in the entire sequence.
*
*---------------------------------------------------------------------------
*/
static int
ParseEventDescription(interp, eventStringPtr, patPtr,
eventMaskPtr)
Tcl_Interp *interp; /* For error messages. */
CONST char **eventStringPtr;/* On input, holds a pointer to start of
* event string. On exit, gets pointer to
* rest of string after parsed event. */
Pattern *patPtr; /* Filled with the pattern parsed from the
* event string. */
unsigned long *eventMaskPtr;/* Filled with event mask of matched event. */
{
char *p;
unsigned long eventMask;
int count, eventFlags;
#define FIELD_SIZE 48
char field[FIELD_SIZE];
Tcl_HashEntry *hPtr;
Tcl_DString copy;
Tcl_DStringInit(&copy);
p = Tcl_DStringAppend(&copy, *eventStringPtr, -1);
patPtr->eventType = -1;
patPtr->needMods = 0;
patPtr->detail.clientData = 0;
eventMask = 0;
count = 1;
/*
* Handle simple ASCII characters.
*/
if (*p != '<') {
char string[2];
patPtr->eventType = KeyPress;
eventMask = KeyPressMask;
string[0] = *p;
string[1] = 0;
patPtr->detail.keySym = TkStringToKeysym(string);
if (patPtr->detail.keySym == NoSymbol) {
if (isprint(UCHAR(*p))) {
patPtr->detail.keySym = *p;
} else {
char buf[64];
sprintf(buf, "bad ASCII character 0x%x", (unsigned char) *p);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
count = 0;
goto done;
}
}
p++;
goto end;
}
/*
* A fancier event description. This can be either a virtual event
* or a physical event.
*
* A virtual event description consists of:
*
* 1. double open angle brackets.
* 2. virtual event name.
* 3. double close angle brackets.
*
* A physical event description consists of:
*
* 1. open angle bracket.
* 2. any number of modifiers, each followed by spaces
* or dashes.
* 3. an optional event name.
* 4. an option button or keysym name. Either this or
* item 3 *must* be present; if both are present
* then they are separated by spaces or dashes.
* 5. a close angle bracket.
*/
p++;
if (*p == '<') {
/*
* This is a virtual event: soak up all the characters up to
* the next '>'.
*/
char *field = p + 1;
p = strchr(field, '>');
if (p == field) {
Tcl_SetResult(interp, "virtual event "<<>>" is badly formed",
TCL_STATIC);
count = 0;
goto done;
}
if ((p == NULL) || (p[1] != '>')) {
Tcl_SetResult(interp, "missing ">" in virtual binding",
TCL_STATIC);
count = 0;
goto done;
}
*p = '';
patPtr->eventType = VirtualEvent;
eventMask = VirtualEventMask;
patPtr->detail.name = Tk_GetUid(field);
*p = '>';
p += 2;
goto end;
}
while (1) {
ModInfo *modPtr;
p = GetField(p, field, FIELD_SIZE);
if (*p == '>') {
/*
* This solves the problem of, e.g., <Control-M> being
* misinterpreted as Control + Meta + missing keysym
* instead of Control + KeyPress + M.
*/
break;
}
hPtr = Tcl_FindHashEntry(&modTable, field);
if (hPtr == NULL) {
break;
}
modPtr = (ModInfo *) Tcl_GetHashValue(hPtr);
patPtr->needMods |= modPtr->mask;
if (modPtr->flags & (MULT_CLICKS)) {
int i = modPtr->flags & MULT_CLICKS;
count = 2;
while (i >>= 1) count++;
}
while ((*p == '-') || isspace(UCHAR(*p))) {
p++;
}
}
eventFlags = 0;
hPtr = Tcl_FindHashEntry(&eventTable, field);
if (hPtr != NULL) {
EventInfo *eiPtr;
eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
patPtr->eventType = eiPtr->type;
eventFlags = flagArray[eiPtr->type];
eventMask = eiPtr->eventMask;
while ((*p == '-') || isspace(UCHAR(*p))) {
p++;
}
p = GetField(p, field, FIELD_SIZE);
}
if (*field != '') {
if ((*field >= '1') && (*field <= '5') && (field[1] == '')) {
if (eventFlags == 0) {
patPtr->eventType = ButtonPress;
eventMask = ButtonPressMask;
} else if (eventFlags & KEY) {
goto getKeysym;
} else if ((eventFlags & BUTTON) == 0) {
Tcl_AppendResult(interp, "specified button "", field,
"" for non-button event", (char *) NULL);
count = 0;
goto done;
}
patPtr->detail.button = (*field - '0');
} else {
getKeysym:
patPtr->detail.keySym = TkStringToKeysym(field);
if (patPtr->detail.keySym == NoSymbol) {
Tcl_AppendResult(interp, "bad event type or keysym "",
field, """, (char *) NULL);
count = 0;
goto done;
}
if (eventFlags == 0) {
patPtr->eventType = KeyPress;
eventMask = KeyPressMask;
} else if ((eventFlags & KEY) == 0) {
Tcl_AppendResult(interp, "specified keysym "", field,
"" for non-key event", (char *) NULL);
count = 0;
goto done;
}
}
} else if (eventFlags == 0) {
Tcl_SetResult(interp, "no event type or button # or keysym",
TCL_STATIC);
count = 0;
goto done;
}
while ((*p == '-') || isspace(UCHAR(*p))) {
p++;
}
if (*p != '>') {
while (*p != '') {
p++;
if (*p == '>') {
Tcl_SetResult(interp,
"extra characters after detail in binding",
TCL_STATIC);
count = 0;
goto done;
}
}
Tcl_SetResult(interp, "missing ">" in binding", TCL_STATIC);
count = 0;
goto done;
}
p++;
end:
*eventStringPtr += (p - Tcl_DStringValue(&copy));
*eventMaskPtr |= eventMask;
done:
Tcl_DStringFree(&copy);
return count;
}
/*
*----------------------------------------------------------------------
*
* GetField --
*
* Used to parse pattern descriptions. Copies up to
* size characters from p to copy, stopping at end of
* string, space, "-", ">", or whenever size is
* exceeded.
*
* Results:
* The return value is a pointer to the character just
* after the last one copied (usually "-" or space or
* ">", but could be anything if size was exceeded).
* Also places NULL-terminated string (up to size
* character, including NULL), at copy.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static char *
GetField(p, copy, size)
char *p; /* Pointer to part of pattern. */
char *copy; /* Place to copy field. */
int size; /* Maximum number of characters to
* copy. */
{
while ((*p != '') && !isspace(UCHAR(*p)) && (*p != '>')
&& (*p != '-') && (size > 1)) {
*copy = *p;
p++;
copy++;
size--;
}
*copy = '';
return p;
}
/*
*---------------------------------------------------------------------------
*
* GetPatternString --
*
* Produce a string version of the given event, for displaying to
* the user.
*
* Results:
* The string is left in dsPtr.
*
* Side effects:
* It is the caller's responsibility to initialize the DString before
* and to free it after calling this procedure.
*
*---------------------------------------------------------------------------
*/
static void
GetPatternString(psPtr, dsPtr)
PatSeq *psPtr;
Tcl_DString *dsPtr;
{
Pattern *patPtr;
char c, buffer[TCL_INTEGER_SPACE];
int patsLeft, needMods;
ModInfo *modPtr;
EventInfo *eiPtr;
/*
* The order of the patterns in the sequence is backwards from the order
* in which they must be output.
*/
for (patsLeft = psPtr->numPats, patPtr = &psPtr->pats[psPtr->numPats - 1];
patsLeft > 0; patsLeft--, patPtr--) {
/*
* Check for simple case of an ASCII character.
*/
if ((patPtr->eventType == KeyPress)
&& ((psPtr->flags & PAT_NEARBY) == 0)
&& (patPtr->needMods == 0)
&& (patPtr->detail.keySym < 128)
&& isprint(UCHAR(patPtr->detail.keySym))
&& (patPtr->detail.keySym != '<')
&& (patPtr->detail.keySym != ' ')) {
c = (char) patPtr->detail.keySym;
Tcl_DStringAppend(dsPtr, &c, 1);
continue;
}
/*
* Check for virtual event.
*/
if (patPtr->eventType == VirtualEvent) {
Tcl_DStringAppend(dsPtr, "<<", 2);
Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1);
Tcl_DStringAppend(dsPtr, ">>", 2);
continue;
}
/*
* It's a more general event specification. First check
* for "Double", "Triple", "Quadruple", then modifiers,
* then event type, then keysym or button detail.
*/
Tcl_DStringAppend(dsPtr, "<", 1);
if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1)
&& (memcmp((char *) patPtr, (char *) (patPtr-1),
sizeof(Pattern)) == 0)) {
patsLeft--;
patPtr--;
if ((patsLeft > 1) && (memcmp((char *) patPtr,
(char *) (patPtr-1), sizeof(Pattern)) == 0)) {
patsLeft--;
patPtr--;
if ((patsLeft > 1) && (memcmp((char *) patPtr,
(char *) (patPtr-1), sizeof(Pattern)) == 0)) {
patsLeft--;
patPtr--;
Tcl_DStringAppend(dsPtr, "Quadruple-", 10);
} else {
Tcl_DStringAppend(dsPtr, "Triple-", 7);
}
} else {
Tcl_DStringAppend(dsPtr, "Double-", 7);
}
}
for (needMods = patPtr->needMods, modPtr = modArray;
needMods != 0; modPtr++) {
if (modPtr->mask & needMods) {
needMods &= ~modPtr->mask;
Tcl_DStringAppend(dsPtr, modPtr->name, -1);
Tcl_DStringAppend(dsPtr, "-", 1);
}
}
for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
if (eiPtr->type == patPtr->eventType) {
Tcl_DStringAppend(dsPtr, eiPtr->name, -1);
if (patPtr->detail.clientData != 0) {
Tcl_DStringAppend(dsPtr, "-", 1);
}
break;
}
}
if (patPtr->detail.clientData != 0) {
if ((patPtr->eventType == KeyPress)
|| (patPtr->eventType == KeyRelease)) {
char *string;
string = TkKeysymToString(patPtr->detail.keySym);
if (string != NULL) {
Tcl_DStringAppend(dsPtr, string, -1);
}
} else {
sprintf(buffer, "%d", patPtr->detail.button);
Tcl_DStringAppend(dsPtr, buffer, -1);
}
}
Tcl_DStringAppend(dsPtr, ">", 1);
}
}
/*
*---------------------------------------------------------------------------
*
* EvalTclBinding --
*
* The procedure that is invoked by Tk_BindEvent when a Tcl binding
* is fired.
*
* Results:
* A standard Tcl result code, the result of globally evaluating the
* percent-substitued binding string.
*
* Side effects:
* Normal side effects due to eval.
*
*---------------------------------------------------------------------------
*/
static void
FreeTclBinding(clientData)
ClientData clientData;
{
ckfree((char *) clientData);
}
/*
*----------------------------------------------------------------------
*
* TkStringToKeysym --
*
* This procedure finds the keysym associated with a given keysym
* name.
*
* Results:
* The return value is the keysym that corresponds to name, or
* NoSymbol if there is no such keysym.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
KeySym
TkStringToKeysym(name)
char *name; /* Name of a keysym. */
{
#ifdef REDO_KEYSYM_LOOKUP
Tcl_HashEntry *hPtr;
KeySym keysym;
hPtr = Tcl_FindHashEntry(&keySymTable, name);
if (hPtr != NULL) {
return (KeySym) Tcl_GetHashValue(hPtr);
}
if (strlen(name) == 1) {
keysym = (KeySym) (unsigned char) name[0];
if (TkKeysymToString(keysym) != NULL) {
return keysym;
}
}
#endif /* REDO_KEYSYM_LOOKUP */
return XStringToKeysym(name);
}
/*
*----------------------------------------------------------------------
*
* TkKeysymToString --
*
* This procedure finds the keysym name associated with a given
* keysym.
*
* Results:
* The return value is a pointer to a static string containing
* the name of the given keysym, or NULL if there is no known name.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
char *
TkKeysymToString(keysym)
KeySym keysym;
{
#ifdef REDO_KEYSYM_LOOKUP
Tcl_HashEntry *hPtr;
hPtr = Tcl_FindHashEntry(&nameTable, (char *)keysym);
if (hPtr != NULL) {
return (char *) Tcl_GetHashValue(hPtr);
}
#endif /* REDO_KEYSYM_LOOKUP */
return XKeysymToString(keysym);
}
/*
*----------------------------------------------------------------------
*
* TkCopyAndGlobalEval --
*
* This procedure makes a copy of a script then passes to Tcl
* to evaluate it. It's used in situations where the execution of
* a command may cause the original command string to be reallocated.
*
* Results:
* Returns the result of evaluating script, including both a standard
* Tcl completion code and a string in the interp's result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TkCopyAndGlobalEval(interp, script)
Tcl_Interp *interp; /* Interpreter in which to evaluate
* script. */
char *script; /* Script to evaluate. */
{
Tcl_DString buffer;
int code;
Tcl_DStringInit(&buffer);
Tcl_DStringAppend(&buffer, script, -1);
code = Tcl_EvalEx(interp, Tcl_DStringValue(&buffer),
Tcl_DStringLength(&buffer), TCL_EVAL_GLOBAL);
Tcl_DStringFree(&buffer);
return code;
}