/* * tkBind.c (CTk) -- * * This file provides procedures that associate Tcl commands * with X events or sequences of X events. * * Copyright (c) 1989-1994 The Regents of the University of California. * Copyright (c) 1994-1995 Sun Microsystems, Inc. * Copyright (c) 1995 Cleveland Clinic Foundation * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * @(#) $Id: ctk.shar,v 1.50 1996/01/15 14:47:16 andrewm Exp andrewm $ */ #include "tkPort.h" #include "tkInt.h" #ifdef HAVE_CURSES_H # include #elif defined(HAVE_CURSES_CURSES_H) # include #elif defined(HAVE_CURSES_NCURSES_H) # include #elif defined(HAVE_NCURSES_NCURSES_H) # include #endif /* * The structure below represents a binding table. A binding table * represents a domain in which event bindings may occur. It includes * a space of objects relative to which events occur (usually windows, * but not always), a history of recent events in the domain, and * a set of mappings that associate particular Tcl commands with sequences * of events in the domain. Multiple binding tables may exist at once, * either because there are multiple applications open, or because there * are multiple domains within an application with separate event * bindings for each (for example, each canvas widget has a separate * binding table for associating events with the items in the canvas). * * Note: it is probably a bad idea to reduce EVENT_BUFFER_SIZE much * below 30. To see this, consider a triple mouse button click while * the Shift key is down (and auto-repeating). There may be as many * as 3 auto-repeat events after each mouse button press or release * (see the first large comment block within Tk_BindEvent for more on * this), for a total of 20 events to cover the three button presses * and two intervening releases. If you reduce EVENT_BUFFER_SIZE too * much, shift multi-clicks will be lost. * */ #define EVENT_BUFFER_SIZE 30 typedef struct BindingTable { XEvent eventRing[EVENT_BUFFER_SIZE];/* Circular queue of recent events * (higher indices are for more recent * events). */ int detailRing[EVENT_BUFFER_SIZE]; /* "Detail" information (keySym or * button or 0) for each entry in * eventRing. */ int curEvent; /* Index in eventRing of most recent * event. Newer events have higher * indices. */ Tcl_HashTable patternTable; /* Used to map from an event to a list * of patterns that may match that * event. Keys are PatternTableKey * structs, values are (PatSeq *). */ Tcl_HashTable objectTable; /* Used to map from an object to a list * of patterns associated with that * object. Keys are ClientData, * values are (PatSeq *). */ Tcl_Interp *interp; /* Interpreter in which commands are * executed. */ } BindingTable; /* * Structures of the following form are used as keys in the patternTable * for a binding table: */ typedef struct PatternTableKey { ClientData object; /* Identifies object (or class of objects) * relative to which event occurred. For * example, in the widget binding table for * an application this is the path name of * a widget, or a widget class, or "all". */ int type; /* Type of event (from X). */ int detail; /* Additional information, such as * keysym or button, or 0 if nothing * additional.*/ } PatternTableKey; /* * The following structure defines a pattern, which is matched * against X events as part of the process of converting X events * into Tcl commands. */ typedef struct Pattern { int eventType; /* Type of X event, e.g. ButtonPress. */ int needMods; /* Mask of modifiers that must be * present (0 means no modifiers are * required). */ int detail; /* Additional information that must * match event. Normally this is 0, * meaning no additional information * must match. For KeyPress and * KeyRelease events, a keySym may * be specified to select a * particular keystroke (0 means any * keystrokes). For button events, * specifies a particular button (0 * means any buttons are OK). */ } Pattern; /* * The structure below defines a pattern sequence, which consists * of one or more patterns. In order to trigger, a pattern * sequence must match the most recent X events (first pattern * to most recent event, next pattern to next event, and so on). */ typedef struct PatSeq { int numPats; /* Number of patterns in sequence * (usually 1). */ char *command; /* Command to invoke when this * pattern sequence matches (malloc-ed). */ int flags; /* Miscellaneous flag values; see * below for definitions. */ struct PatSeq *nextSeqPtr; /* Next in list of all pattern * sequences that have the same * initial pattern. NULL means * end of list. */ Tcl_HashEntry *hPtr; /* Pointer to hash table entry for * the initial pattern. This is the * head of the list of which nextSeqPtr * forms a part. */ ClientData object; /* Identifies object with which event is * associated (e.g. window). */ struct PatSeq *nextObjPtr; /* Next in list of all pattern * sequences for the same object * (NULL for end of list). Needed to * implement Tk_DeleteAllBindings. */ Pattern pats[1]; /* Array of "numPats" patterns. Only * one element is declared here but * in actuality enough space will be * allocated for "numPats" patterns. * To match, pats[0] must match event * n, pats[1] must match event n-1, * etc. */ } PatSeq; /* * Flag values for PatSeq structures: * * PAT_NEARBY 1 means that all of the events matching * this sequence must occur with nearby X * and Y mouse coordinates and close in time. * This is typically used to restrict multiple * button presses. */ #define PAT_NEARBY 1 /* * Constants that define how close together two events must be * in milliseconds or pixels to meet the PAT_NEARBY constraint: */ #define NEARBY_PIXELS 5 #define NEARBY_MS 500 /* * The data structure and hash table below are used to map from * textual keysym names to keysym numbers. This structure is * present here because the corresponding X procedures are * ridiculously slow. */ typedef struct { char *name; /* Name of keysym. */ KeySym value; /* Numeric identifier for keysym. */ } KeySymInfo; static KeySymInfo keyArray[] = { #ifndef lint #include "ks_names.h" #endif {(char *) NULL, 0} }; static Tcl_HashTable keySymTable; /* Hashed form of above structure. */ static int initialized = 0; /* * A hash table is kept to map from the string names of event * modifiers to information about those modifiers. The structure * for storing this information, and the hash table built at * initialization time, are defined below. */ typedef struct { char *name; /* Name of modifier. */ int mask; /* Button/modifier mask value, * such as Button1Mask. */ int flags; /* Various flags; see below for * definitions. */ } ModInfo; /* * Flags for ModInfo structures: * * DOUBLE - Non-zero means duplicate this event, * e.g. for double-clicks. * TRIPLE - Non-zero means triplicate this event, * e.g. for triple-clicks. */ #define DOUBLE 1 #define TRIPLE 2 /* * The following special modifier mask bits are defined, to indicate * logical modifiers such as Meta and Alt that may float among the * actual modifier bits. */ #define META_MASK (AnyModifier<<1) #define ALT_MASK (AnyModifier<<2) static ModInfo modArray[] = { {"Control", ControlMask, 0}, {"Shift", ShiftMask, 0}, {"Lock", LockMask, 0}, {"Meta", META_MASK, 0}, {"M", META_MASK, 0}, {"Alt", ALT_MASK, 0}, {"B1", Button1Mask, 0}, {"Button1", Button1Mask, 0}, {"B2", Button2Mask, 0}, {"Button2", Button2Mask, 0}, {"B3", Button3Mask, 0}, {"Button3", Button3Mask, 0}, {"B4", Button4Mask, 0}, {"Button4", Button4Mask, 0}, {"B5", Button5Mask, 0}, {"Button5", Button5Mask, 0}, {"Mod1", Mod1Mask, 0}, {"M1", Mod1Mask, 0}, {"Mod2", Mod2Mask, 0}, {"M2", Mod2Mask, 0}, {"Mod3", Mod3Mask, 0}, {"M3", Mod3Mask, 0}, {"Mod4", Mod4Mask, 0}, {"M4", Mod4Mask, 0}, {"Mod5", Mod5Mask, 0}, {"M5", Mod5Mask, 0}, {"Double", 0, DOUBLE}, {"Triple", 0, TRIPLE}, {"Any", 0, 0}, /* Ignored: historical relic. */ {NULL, 0, 0} }; static Tcl_HashTable modTable; /* * This module also keeps a hash table mapping from event names * to information about those events. The structure, an array * to use to initialize the hash table, and the hash table are * all defined below. */ typedef struct { char *name; /* Name of event. */ int type; /* Event type for X, such as * ButtonPress. */ int eventMask; /* Mask bits (for XSelectInput) * for this event type. */ } EventInfo; /* * Note: some of the masks below are an OR-ed combination of * several masks. This is necessary because X doesn't report * up events unless you also ask for down events. Also, X * doesn't report button state in motion events unless you've * asked about button events. */ static EventInfo eventArray[] = { {"Motion", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {"Button", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {"ButtonPress", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {"ButtonRelease", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {"Colormap", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {"Enter", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {"Leave", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {"Expose", CTK_EXPOSE_EVENT, CTK_EXPOSE_EVENT_MASK}, {"FocusIn", CTK_FOCUS_EVENT, CTK_FOCUS_EVENT_MASK}, {"FocusOut", CTK_UNFOCUS_EVENT, CTK_FOCUS_EVENT_MASK}, {"Key", CTK_KEY_EVENT, CTK_KEY_EVENT_MASK}, {"KeyPress", CTK_KEY_EVENT, CTK_KEY_EVENT_MASK}, {"KeyRelease", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {"Property", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {"Circulate", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {"Configure", CTK_MAP_EVENT, CTK_MAP_EVENT_MASK}, {"Destroy", CTK_DESTROY_EVENT, CTK_DESTROY_EVENT_MASK}, {"Gravity", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {"Map", CTK_MAP_EVENT, CTK_MAP_EVENT_MASK}, {"Reparent", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {"Unmap", CTK_UNMAP_EVENT, CTK_MAP_EVENT_MASK}, {"Visibility", CTK_UNSUPPORTED_EVENT, CTK_UNSUPPORTED_EVENT_MASK}, {(char *) NULL, 0, 0} }; static Tcl_HashTable eventTable; /* * Prototypes for local procedures defined in this file: */ static void ChangeScreen _ANSI_ARGS_((Tcl_Interp *interp, char *dispName)); static void ExpandPercents _ANSI_ARGS_((TkWindow *winPtr, char *before, XEvent *eventPtr, KeySym keySym, Tcl_DString *dsPtr)); static PatSeq * FindSequence _ANSI_ARGS_((Tcl_Interp *interp, BindingTable *bindPtr, ClientData object, char *eventString, int create, unsigned long *maskPtr)); static char * GetField _ANSI_ARGS_((char *p, char *copy, int size)); static PatSeq * MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr, BindingTable *bindPtr, PatSeq *psPtr)); /* *-------------------------------------------------------------- * * Tk_CreateBindingTable -- * * Set up a new domain in which event bindings may be created. * * Results: * The return value is a token for the new table, which must * be passed to procedures like Tk_CreatBinding. * * Side effects: * Memory is allocated for the new table. * *-------------------------------------------------------------- */ Tk_BindingTable Tk_CreateBindingTable(interp) Tcl_Interp *interp; /* Interpreter to associate with the binding * table: commands are executed in this * interpreter. */ { register BindingTable *bindPtr; int i; /* * If this is the first time a binding table has been created, * initialize the global data structures. */ if (!initialized) { register KeySymInfo *kPtr; register Tcl_HashEntry *hPtr; register ModInfo *modPtr; register EventInfo *eiPtr; int dummy; initialized = 1; Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS); for (kPtr = keyArray; kPtr->name != NULL; kPtr++) { hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy); Tcl_SetHashValue(hPtr, kPtr->value); } Tcl_InitHashTable(&modTable, TCL_STRING_KEYS); for (modPtr = modArray; modPtr->name != NULL; modPtr++) { hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy); Tcl_SetHashValue(hPtr, modPtr); } Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS); for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy); Tcl_SetHashValue(hPtr, eiPtr); } } /* * Create and initialize a new binding table. */ bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable)); for (i = 0; i < EVENT_BUFFER_SIZE; i++) { bindPtr->eventRing[i].type = -1; } bindPtr->curEvent = 0; Tcl_InitHashTable(&bindPtr->patternTable, sizeof(PatternTableKey)/sizeof(int)); Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS); bindPtr->interp = interp; return (Tk_BindingTable) bindPtr; } /* *-------------------------------------------------------------- * * Tk_DeleteBindingTable -- * * 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; ckfree((char *) psPtr->command); 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: * 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. */ { BindingTable *bindPtr = (BindingTable *) bindingTable; register PatSeq *psPtr; unsigned long eventMask; psPtr = FindSequence(interp, bindPtr, object, eventString, 1, &eventMask); if (psPtr == NULL) { if (eventMask) { Tcl_ResetResult(interp); } return eventMask; } if (append && (psPtr->command != NULL)) { int length; char *new; length = strlen(psPtr->command) + strlen(command) + 2; new = (char *) ckalloc((unsigned) length); sprintf(new, "%s\n%s", psPtr->command, command); ckfree((char *) psPtr->command); psPtr->command = new; } else { if (psPtr->command != NULL) { ckfree((char *) psPtr->command); } psPtr->command = (char *) ckalloc((unsigned) (strlen(command) + 1)); strcpy(psPtr->command, command); } 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; register PatSeq *psPtr, *prevPtr; unsigned long eventMask; Tcl_HashEntry *hPtr; psPtr = FindSequence(interp, bindPtr, object, eventString, 0, &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; } } } ckfree((char *) psPtr->command); 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; register PatSeq *psPtr; unsigned long eventMask; psPtr = FindSequence(interp, bindPtr, object, eventString, 0, &eventMask); if (psPtr == NULL) { return NULL; } return psPtr->command; } /* *-------------------------------------------------------------- * * 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; register PatSeq *psPtr; register Pattern *patPtr; Tcl_HashEntry *hPtr; Tcl_DString ds; char c, buffer[10]; int patsLeft, needMods; register ModInfo *modPtr; register EventInfo *eiPtr; hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); if (hPtr == NULL) { return; } Tcl_DStringInit(&ds); for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = psPtr->nextObjPtr) { Tcl_DStringSetLength(&ds, 0); /* * For each binding, output information about each of the * patterns in its sequence. 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 == CTK_KEY_EVENT) && (patPtr->needMods == 0) && (patPtr->detail < 128) && isprint(UCHAR(patPtr->detail)) && (patPtr->detail != '<') && (patPtr->detail != ' ')) { c = patPtr->detail; Tcl_DStringAppend(&ds, &c, 1); continue; } /* * It's a more general event specification. First check * for "Double" or "Triple", then modifiers, then event type, * then keysym or button detail. */ Tcl_DStringAppend(&ds, "<", 1); 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(&ds, "Triple-", 7); } else { Tcl_DStringAppend(&ds, "Double-", 7); } } for (needMods = patPtr->needMods, modPtr = modArray; needMods != 0; modPtr++) { if (modPtr->mask & needMods) { needMods &= ~modPtr->mask; Tcl_DStringAppend(&ds, modPtr->name, -1); Tcl_DStringAppend(&ds, "-", 1); } } for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { if (eiPtr->type == patPtr->eventType) { Tcl_DStringAppend(&ds, eiPtr->name, -1); if (patPtr->detail != 0) { Tcl_DStringAppend(&ds, "-", 1); } break; } } if (patPtr->detail != 0) { if (patPtr->eventType == CTK_KEY_EVENT) { register KeySymInfo *kPtr; for (kPtr = keyArray; kPtr->name != NULL; kPtr++) { if (patPtr->detail == (int) kPtr->value) { Tcl_DStringAppend(&ds, kPtr->name, -1); break; } } } else { sprintf(buffer, "%d", patPtr->detail); Tcl_DStringAppend(&ds, buffer, -1); } } Tcl_DStringAppend(&ds, ">", 1); } Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); } Tcl_DStringFree(&ds); } /* *-------------------------------------------------------------- * * Tk_DeleteAllBindings -- * * Remove all bindings associated with a given object in a * given binding table. * * Results: * All bindings associated with object are removed from * bindingTable. * * Side effects: * None. * *-------------------------------------------------------------- */ void Tk_DeleteAllBindings(bindingTable, object) Tk_BindingTable bindingTable; /* Table in which to delete * bindings. */ ClientData object; /* Token for object. */ { BindingTable *bindPtr = (BindingTable *) bindingTable; register PatSeq *psPtr, *prevPtr; PatSeq *nextPtr; Tcl_HashEntry *hPtr; hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); if (hPtr == NULL) { return; } for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = nextPtr) { nextPtr = psPtr->nextObjPtr; /* * Be sure to remove each binding from its hash chain in the * pattern table. If this is the last pattern in the chain, * then delete the hash entry too. */ 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_DeleteAllBindings couldn't find on hash chain"); } if (prevPtr->nextSeqPtr == psPtr) { prevPtr->nextSeqPtr = psPtr->nextSeqPtr; break; } } } ckfree((char *) psPtr->command); ckfree((char *) psPtr); } Tcl_DeleteHashEntry(hPtr); } /* *-------------------------------------------------------------- * * Tk_BindEvent -- * * This procedure is invoked to process an X event. The * event is added to those recorded for the binding table. * Then each of the objects at *objectPtr is checked in * order to see if it has a binding that matches the recent * events. If so, that binding is invoked and the rest of * objects are skipped. * * Results: * None. * * Side effects: * Depends on the command associated with the matching * binding. * *-------------------------------------------------------------- */ void Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) Tk_BindingTable bindingTable; /* Table in which to look for * bindings. */ XEvent *eventPtr; /* What actually happened. */ Tk_Window tkwin; /* Window on display where event * occurred (needed in order to * locate display information). */ int numObjects; /* Number of objects at *objectPtr. */ ClientData *objectPtr; /* Array of one or more objects * to check for a matching binding. */ { BindingTable *bindPtr = (BindingTable *) bindingTable; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; TkMainInfo *mainPtr; TkDisplay *oldDispPtr; XEvent *ringPtr; PatSeq *matchPtr; PatternTableKey key; Tcl_HashEntry *hPtr; int detail, code; Tcl_Interp *interp; Tcl_DString scripts, savedResult; char *p, *end; /* * Add the new event to the ring of saved events for the * binding table. Two tricky points: */ bindPtr->curEvent++; if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) { bindPtr->curEvent = 0; } ringPtr = &bindPtr->eventRing[bindPtr->curEvent]; memcpy((VOID *) ringPtr, (VOID *) eventPtr, sizeof(XEvent)); detail = 0; bindPtr->detailRing[bindPtr->curEvent] = 0; if (ringPtr->type == CTK_KEY_EVENT) { detail = ringPtr->u.key.sym; } bindPtr->detailRing[bindPtr->curEvent] = detail; /* * Loop over all the objects, finding the binding script for each * one. Append all of the binding scripts, with %-sequences expanded, * to "scripts", with null characters separating the scripts for * each object. */ Tcl_DStringInit(&scripts); for ( ; numObjects > 0; numObjects--, objectPtr++) { /* * Match the new event against those recorded in the * pattern table, saving the longest matching pattern. * For events with details (button and key events) first * look for a binding for the specific key or button. * If none is found, then look for a binding for all * keys or buttons (detail of 0). */ matchPtr = NULL; key.object = *objectPtr; key.type = ringPtr->type; key.detail = detail; hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key); if (hPtr != NULL) { matchPtr = MatchPatterns(dispPtr, bindPtr, (PatSeq *) Tcl_GetHashValue(hPtr)); } if ((detail != 0) && (matchPtr == NULL)) { key.detail = 0; hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key); if (hPtr != NULL) { matchPtr = MatchPatterns(dispPtr, bindPtr, (PatSeq *) Tcl_GetHashValue(hPtr)); } } if (matchPtr != NULL) { ExpandPercents((TkWindow *) tkwin, matchPtr->command, eventPtr, (KeySym) detail, &scripts); Tcl_DStringAppend(&scripts, "", 1); } } /* * Now go back through and evaluate the script for each object, * in order, dealing with "break" and "continue" exceptions * appropriately. * * There are two tricks here: * 1. Bindings can be invoked from in the middle of Tcl commands, * where interp->result is significant (for example, a widget * might be deleted because of an error in creating it, so the * result contains an error message that is eventually going to * be returned by the creating command). To preserve the result, * we save it in a dynamic string. * 2. The binding's action can potentially delete the binding, * so bindPtr may not point to anything valid once the action * completes. Thus we have to save bindPtr->interp in a * local variable in order to restore the result. * 3. When the screen changes, must invoke a Tcl script to update * Tcl level information such as tkPriv. */ mainPtr = ((TkWindow *) tkwin)->mainPtr; oldDispPtr = mainPtr->curDispPtr; interp = bindPtr->interp; Tcl_DStringInit(&savedResult); Tcl_DStringGetResult(interp, &savedResult); p = Tcl_DStringValue(&scripts); end = p + Tcl_DStringLength(&scripts); while (p != end) { if (dispPtr != mainPtr->curDispPtr) { mainPtr->curDispPtr = dispPtr; ChangeScreen(interp, dispPtr->name); } mainPtr->bindingDepth += 1; Tcl_AllowExceptions(interp); code = Tcl_GlobalEval(interp, p); mainPtr->bindingDepth -= 1; if (code != TCL_OK) { if (code == TCL_CONTINUE) { /* * Do nothing: just go on to the next script. */ } else if (code == TCL_BREAK) { break; } else { Tcl_AddErrorInfo(interp, "\n (command bound to event)"); Tcl_BackgroundError(interp); break; } } /* * Skip over the current script and its terminating null character. */ while (*p != 0) { p++; } p++; } if (mainPtr->bindingDepth == 0 && mainPtr->refCount == 0) { TkDeleteMain(mainPtr); } else if ((mainPtr->bindingDepth != 0) && (oldDispPtr != mainPtr->curDispPtr)) { /* * Some other binding script is currently executing, but its * screen is no longer current. Change the current display * back again. */ mainPtr->curDispPtr = oldDispPtr; ChangeScreen(interp, oldDispPtr->name); } Tcl_DStringResult(interp, &savedResult); Tcl_DStringFree(&scripts); } /* *---------------------------------------------------------------------- * * ChangeScreen -- * * This procedure is invoked whenever the current screen changes * in an application. It invokes a Tcl procedure named * "tkScreenChanged", passing it the screen name as argument. * tkScreenChanged does things like making the tkPriv variable * point to an array for the current display. * * Results: * None. * * Side effects: * Depends on what tkScreenChanged does. If an error occurs * them tkError will be invoked. * *---------------------------------------------------------------------- */ static void ChangeScreen(interp, dispName) Tcl_Interp *interp; /* Interpreter in which to invoke * command. */ char *dispName; /* Name of new display. */ { Tcl_DString cmd; int code; Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, "tkScreenChanged ", 16); Tcl_DStringAppend(&cmd, dispName, -1); code = Tcl_GlobalEval(interp, Tcl_DStringValue(&cmd)); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (changing screen in event binding)"); Tcl_BackgroundError(interp); } } /* *---------------------------------------------------------------------- * * FindSequence -- * * Find the entry in a binding 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, or if the pattern * includes events not supported by CTk (like button presses) * then NULL is returned and interp->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. If an error occurs, then *maskPtr is set * to zero, and if the pattern contains unsupported events * then *maskPtr is set to CTK_UNSUPPORTED_EVENT_MASK. * * Side effects: * A new pattern sequence may be created. * *---------------------------------------------------------------------- */ static PatSeq * FindSequence(interp, bindPtr, object, eventString, create, maskPtr) Tcl_Interp *interp; /* Interpreter to use for error * reporting. */ BindingTable *bindPtr; /* Table to use for lookup. */ ClientData object; /* Token for object(s) with which binding * is associated. */ 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. */ unsigned long *maskPtr; /* *maskPtr is filled in with the event * types on which this pattern sequence * depends. */ { Pattern pats[EVENT_BUFFER_SIZE]; int numPats; register char *p; register Pattern *patPtr; register PatSeq *psPtr; register Tcl_HashEntry *hPtr; #define FIELD_SIZE 48 char field[FIELD_SIZE]; int flags, count, new; size_t sequenceSize; unsigned long eventMask; PatternTableKey key; char error_buffer[100]; /* *------------------------------------------------------------- * 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; for (numPats = 0, patPtr = &pats[EVENT_BUFFER_SIZE-1]; numPats < EVENT_BUFFER_SIZE; numPats++, patPtr--) { patPtr->eventType = -1; patPtr->needMods = 0; patPtr->detail = 0; while (isspace(UCHAR(*p))) { p++; } if (*p == '\0') { break; } /* * Handle simple ASCII characters. */ if (*p != '<') { char string[2]; patPtr->eventType = CTK_KEY_EVENT; eventMask |= CTK_KEY_EVENT_MASK; string[0] = *p; string[1] = 0; hPtr = Tcl_FindHashEntry(&keySymTable, string); if (hPtr != NULL) { patPtr->detail = (int) Tcl_GetHashValue(hPtr); } else { if (isprint(UCHAR(*p))) { patPtr->detail = *p; } else { sprintf(error_buffer, "bad ASCII character 0x%x", (unsigned char) *p); Tcl_SetResult(interp, error_buffer, TCL_VOLATILE); goto error; } } p++; continue; } /* * A fancier event description. Must consist 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. */ count = 1; p++; while (1) { register ModInfo *modPtr; p = GetField(p, field, FIELD_SIZE); hPtr = Tcl_FindHashEntry(&modTable, field); if (hPtr == NULL) { break; } modPtr = (ModInfo *) Tcl_GetHashValue(hPtr); patPtr->needMods |= modPtr->mask; if (modPtr->flags & (DOUBLE|TRIPLE)) { flags |= PAT_NEARBY; if (modPtr->flags & DOUBLE) { count = 2; } else { count = 3; } } while ((*p == '-') || isspace(UCHAR(*p))) { p++; } } hPtr = Tcl_FindHashEntry(&eventTable, field); if (hPtr != NULL) { register EventInfo *eiPtr; eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr); if (eiPtr->type == CTK_UNSUPPORTED_EVENT) { goto unsupported; } patPtr->eventType = eiPtr->type; eventMask |= eiPtr->eventMask; while ((*p == '-') || isspace(UCHAR(*p))) { p++; } p = GetField(p, field, FIELD_SIZE); } if (*field != '\0') { if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) { if (patPtr->eventType == -1) { /* * Button press pattern. */ goto unsupported; } else if (patPtr->eventType == CTK_KEY_EVENT) { goto getKeysym; } else { Tcl_AppendResult(interp, "specified button \"", field, "\" for non-button event", (char *) NULL); goto error; } } else { getKeysym: hPtr = Tcl_FindHashEntry(&keySymTable, (char *) field); if (hPtr == NULL) { Tcl_AppendResult(interp, "bad event type or keysym \"", field, "\"", (char *) NULL); goto error; } patPtr->detail = (int) Tcl_GetHashValue(hPtr); if (patPtr->eventType == -1) { patPtr->eventType = CTK_KEY_EVENT; eventMask |= CTK_KEY_EVENT_MASK; } else if (patPtr->eventType != CTK_KEY_EVENT) { Tcl_AppendResult(interp, "specified keysym \"", field, "\" for non-key event", (char *) NULL); goto error; } } } else if (patPtr->eventType == -1) { Tcl_SetResult(interp, "no event type or button # or keysym", TCL_STATIC); goto error; } while ((*p == '-') || isspace(UCHAR(*p))) { p++; } if (*p != '>') { Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC); goto error; } p++; /* * Replicate events for DOUBLE and TRIPLE. */ if ((count > 1) && (numPats < EVENT_BUFFER_SIZE-1)) { patPtr[-1] = patPtr[0]; patPtr--; numPats++; if ((count == 3) && (numPats < EVENT_BUFFER_SIZE-1)) { 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); goto error; } patPtr = &pats[EVENT_BUFFER_SIZE-numPats]; key.object = object; key.type = patPtr->eventType; key.detail = patPtr->detail; hPtr = Tcl_CreateHashEntry(&bindPtr->patternTable, (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); } Tcl_AppendResult(interp, "no binding exists for \"", eventString, "\"", (char *) NULL); goto error; } psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq) + (numPats-1)*sizeof(Pattern))); psPtr->numPats = numPats; psPtr->command = NULL; psPtr->flags = flags; psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr->hPtr = hPtr; Tcl_SetHashValue(hPtr, psPtr); /* * Link the pattern into the list associated with the object. */ psPtr->object = object; hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object, &new); if (new) { psPtr->nextObjPtr = NULL; } else { psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, psPtr); memcpy((VOID *) psPtr->pats, (VOID *) patPtr, sequenceSize); done: *maskPtr = eventMask; return psPtr; error: *maskPtr = 0; return NULL; unsupported: Tcl_SetResult(interp, "Unsupported event type", TCL_STATIC); *maskPtr = CTK_UNSUPPORTED_EVENT_MASK; return NULL; } /* *---------------------------------------------------------------------- * * 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) register char *p; /* Pointer to part of pattern. */ register char *copy; /* Place to copy field. */ int size; /* Maximum number of characters to * copy. */ { while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '>') && (*p != '-') && (size > 1)) { *copy = *p; p++; copy++; size--; } *copy = '\0'; return p; } /* *---------------------------------------------------------------------- * * MatchPatterns -- * * Given a list of pattern sequences and a list of * recent events, return a pattern sequence that matches * the event list. * * Results: * The return value is NULL if no pattern matches the * recent events from bindPtr. If one or more patterns * matches, then the longest (or most specific) matching * pattern is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ static PatSeq * MatchPatterns(dispPtr, bindPtr, psPtr) TkDisplay *dispPtr; /* Display from which the event came. */ BindingTable *bindPtr; /* Information about binding table, such * as ring of recent events. */ register PatSeq *psPtr; /* List of pattern sequences. */ { register PatSeq *bestPtr = NULL; /* * Iterate over all the pattern sequences. */ for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) { register XEvent *eventPtr; register Pattern *patPtr; Tk_Window window; int *detailPtr; int patCount, ringCount, state; int modMask; /* * Iterate over all the patterns in a sequence to be * sure that they all match. */ eventPtr = &bindPtr->eventRing[bindPtr->curEvent]; detailPtr = &bindPtr->detailRing[bindPtr->curEvent]; window = eventPtr->window; patPtr = psPtr->pats; patCount = psPtr->numPats; ringCount = EVENT_BUFFER_SIZE; while (patCount > 0) { if (ringCount <= 0) { goto nextSequence; } if (eventPtr->type != patPtr->eventType) { goto nextEvent; } if (eventPtr->window != window) { goto nextSequence; } if (eventPtr->type == CTK_KEY_EVENT) { state = eventPtr->u.key.state; } else { state = 0; } if (patPtr->needMods != 0) { modMask = patPtr->needMods; if ((state & modMask) != modMask) { goto nextSequence; } } if ((patPtr->detail != 0) && (patPtr->detail != *detailPtr)) { goto nextSequence; } if (psPtr->flags & PAT_NEARBY) { register XEvent *firstPtr; int timeDiff; firstPtr = &bindPtr->eventRing[bindPtr->curEvent]; timeDiff = (Time) firstPtr->u.key.time - eventPtr->u.key.time; if (timeDiff > NEARBY_MS) { goto nextSequence; } } patPtr++; patCount--; nextEvent: if (eventPtr == bindPtr->eventRing) { eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1]; detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1]; } else { eventPtr--; detailPtr--; } ringCount--; } /* * This sequence matches. If we've already got another match, * pick whichever is most specific. Detail is most important, * then needMods. */ if (bestPtr != NULL) { register Pattern *patPtr2; int i; if (psPtr->numPats != bestPtr->numPats) { if (bestPtr->numPats > psPtr->numPats) { goto nextSequence; } else { goto newBest; } } for (i = 0, patPtr = psPtr->pats, patPtr2 = bestPtr->pats; i < psPtr->numPats; i++, patPtr++, patPtr2++) { if (patPtr->detail != patPtr2->detail) { if (patPtr->detail == 0) { goto nextSequence; } else { goto newBest; } } if (patPtr->needMods != patPtr2->needMods) { if ((patPtr->needMods & patPtr2->needMods) == patPtr->needMods) { goto nextSequence; } else if ((patPtr->needMods & patPtr2->needMods) == patPtr2->needMods) { goto newBest; } } } goto nextSequence; /* Tie goes to newest pattern. */ } newBest: bestPtr = psPtr; nextSequence: continue; } return bestPtr; } /* *-------------------------------------------------------------- * * ExpandPercents -- * * Given a command and an event, produce a new command * by replacing % constructs in the original command * with information from the X event. * * Results: * The new expanded command is appended to the dynamic string * given by dsPtr. * * Side effects: * None. * *-------------------------------------------------------------- */ static void ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr) TkWindow *winPtr; /* Window where event occurred: needed to * get input context. */ register char *before; /* Command containing percent * expressions to be replaced. */ register XEvent *eventPtr; /* X event containing information * to be used in % replacements. */ KeySym keySym; /* KeySym: only relevant for * KeyPress and KeyRelease events). */ Tcl_DString *dsPtr; /* Dynamic string in which to append * new command. */ { int spaceNeeded, cvtFlags; /* Used to substitute string as proper Tcl * list element. */ int number, length; #define NUM_SIZE 40 register char *string; char numStorage[NUM_SIZE+1]; while (1) { /* * Find everything up to the next % character and append it * to the result string. */ for (string = before; (*string != 0) && (*string != '%'); string++) { /* Empty loop body. */ } if (string != before) { Tcl_DStringAppend(dsPtr, before, string-before); before = string; } if (*before == 0) { break; } /* * There's a percent sequence here. Process it. */ number = 0; string = "??"; switch (before[1]) { case '#': number = eventPtr->serial; goto doNumber; case 'c': number = 0; goto doNumber; case 'h': if (eventPtr->type == CTK_EXPOSE_EVENT) { number = eventPtr->u.expose.bottom - eventPtr->u.expose.top; } else if (eventPtr->type == CTK_MAP_EVENT) { number = Tk_Height(eventPtr->window); } goto doNumber; case 'k': if (eventPtr->type == CTK_KEY_EVENT) { number = eventPtr->u.key.sym; } goto doNumber; case 's': if (eventPtr->type == CTK_KEY_EVENT) { number = eventPtr->u.key.state; } goto doNumber; case 't': if (eventPtr->type == CTK_KEY_EVENT) { number = (int) eventPtr->u.key.time; } goto doNumber; case 'w': if (eventPtr->type == CTK_EXPOSE_EVENT) { number = eventPtr->u.expose.right - eventPtr->u.expose.left; } else if (eventPtr->type == CTK_MAP_EVENT) { number = Tk_Width(eventPtr->window); } goto doNumber; case 'x': if (eventPtr->type == CTK_EXPOSE_EVENT) { number = eventPtr->u.expose.left; } else if (eventPtr->type == CTK_MAP_EVENT) { number = Tk_X(eventPtr->window); } goto doNumber; case 'y': if (eventPtr->type == CTK_EXPOSE_EVENT) { number = eventPtr->u.expose.top; } else if (eventPtr->type == CTK_MAP_EVENT) { number = Tk_Y(eventPtr->window); } goto doNumber; case 'A': if (eventPtr->type == CTK_KEY_EVENT) { KeySym key = eventPtr->u.key.sym; if (key >= 0 && key <= UCHAR_MAX) { numStorage[0] = key; numStorage[1] = '\0'; } else { numStorage[0] = '\0'; } } string = numStorage; goto doString; case 'K': if (eventPtr->type == CTK_KEY_EVENT) { register KeySymInfo *kPtr; for (kPtr = keyArray; kPtr->name != NULL; kPtr++) { if (kPtr->value == keySym) { string = kPtr->name; break; } } } goto doString; case 'N': number = (int) keySym; goto doNumber; case 'T': number = eventPtr->type; goto doNumber; case 'W': { string = Tk_PathName(eventPtr->window); goto doString; } case 'X': { number = Ctk_AbsLeft(eventPtr->window); goto doNumber; } case 'Y': { number = Ctk_AbsTop(eventPtr->window); goto doNumber; } default: numStorage[0] = before[1]; numStorage[1] = '\0'; 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; } } /* *---------------------------------------------------------------------- * * TkCopyAndGlobalEval -- * * This procedure makes a copy of a script then calls Tcl_GlobalEval * 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 interp->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_GlobalEval(interp, Tcl_DStringValue(&buffer)); Tcl_DStringFree(&buffer); return code; } /* *---------------------------------------------------------------------- * * Ctk_CtkEventCmd -- * * This procedure implements the "ctk_event" command. It allows * events to be generated on the fly. Handy for remapping keys. * * Results: * A standard Tcl result. * * Side effects: * Creates and handles events. * *---------------------------------------------------------------------- */ int Ctk_CtkEventCmd(clientData, interp, argc, argv) ClientData clientData; /* Main window for application. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { Tk_Window main = (Tk_Window) clientData; Tk_Window tkwin; XEvent event; EventInfo *eiPtr; char *field, *value; int i; Tcl_HashEntry *hPtr; if ((argc < 3) || !(argc & 1)) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " window type ?field value field value ...?\"", (char *) NULL); return TCL_ERROR; } tkwin = Tk_NameToWindow(interp, argv[1], main); if (tkwin == NULL) { return TCL_ERROR; } memset((VOID *) &event, 0, sizeof(event)); event.window = tkwin; /* * Get the type of the event. */ hPtr = Tcl_FindHashEntry(&eventTable, argv[2]); if (!hPtr) { Tcl_AppendResult(interp, "bad event type \"", argv[2], "\"", (char *) NULL); return TCL_ERROR; } eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr); event.type = eiPtr->type; /* * Process the remaining arguments to fill in additional fields * of the event. */ for (i = 3; i < argc; i += 2) { field = argv[i]; value = argv[i+1]; if (event.type == KeyPress && strcmp(field, "-key") == 0) { hPtr = Tcl_FindHashEntry(&keySymTable, value); if (hPtr) { event.u.key.sym = (int) Tcl_GetHashValue(hPtr); } else { Tcl_AppendResult(interp, "unknown keysym \"", value, "\"", (char *) NULL); return TCL_ERROR; } } else if (event.type == KeyPress && strcmp(field, "-modifier") == 0) { register ModInfo *modPtr; hPtr = Tcl_FindHashEntry(&modTable, value); if (hPtr) { modPtr = (ModInfo *) Tcl_GetHashValue(hPtr); event.u.key.state |= modPtr->mask; } else { Tcl_AppendResult(interp, "unknown modifier \"", value, "\"", (char *) NULL); return TCL_ERROR; } } else { Tcl_AppendResult(interp, "bad option \"", field, "\"", (char *) NULL); return TCL_ERROR; } } Tk_HandleEvent(&event); return TCL_OK; }