/*
* 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 USE_NCURSES_H
# include <ncurses.h>
#else
# include <curses.h>
#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;
}