#include <ctype.h>
#include <string.h>
#ifdef HAVE_INTPTR_T
#include <stdint.h>
#endif
#include <tcl.h>
#include <tk.h>
#include "qebind.h"
#define dbwin TreeCtrl_dbwin
MODULE_SCOPE
void
dbwin(
char
*fmt, ...);
#define UCHAR(c) ((unsigned char) (c))
#if !defined(INT2PTR) && !defined(PTR2INT)
# if defined(HAVE_INTPTR_T) || defined(intptr_t)
# define INT2PTR(p) ((void *)(intptr_t)(p))
# define PTR2INT(p) ((int)(intptr_t)(p))
# else
# define INT2PTR(p) ((void *)(p))
# define PTR2INT(p) ((int)(p))
# endif
#endif
int
debug_bindings = 0;
#define BIND_ACTIVE 1
#define ALLOW_INSTALL 1
#define DELETE_WIN_BINDINGS 1
typedef
struct
BindValue {
int
type;
int
detail;
ClientData object;
char
*command;
int
specific;
struct
BindValue *nextValue;
#if BIND_ACTIVE
int
active;
#endif /* BIND_ACTIVE */
} BindValue;
typedef
struct
Pattern {
int
type;
int
detail;
} Pattern;
typedef
struct
PatternTableKey {
int
type;
int
detail;
} PatternTableKey;
typedef
struct
ObjectTableKey {
int
type;
int
detail;
ClientData object;
} ObjectTableKey;
typedef
struct
Detail {
Tk_Uid name;
int
code;
struct
EventInfo *event;
QE_ExpandProc expandProc;
#if ALLOW_INSTALL
int
dynamic;
char
*command;
#endif
struct
Detail *next;
} Detail;
typedef
struct
EventInfo {
char
*name;
int
type;
QE_ExpandProc expandProc;
Detail *detailList;
int
nextDetailId;
#if ALLOW_INSTALL
int
dynamic;
char
*command;
#endif
struct
EventInfo *next;
} EventInfo;
typedef
struct
GenerateField {
char
which;
char
*string;
} GenerateField;
typedef
struct
GenerateData {
GenerateField staticField[20];
GenerateField *field;
int
count;
char
*command;
} GenerateData;
typedef
struct
BindingTable {
Tcl_Interp *interp;
Tcl_HashTable patternTable;
Tcl_HashTable objectTable;
Tcl_HashTable eventTableByName;
Tcl_HashTable eventTableByType;
Tcl_HashTable detailTableByType;
#if DELETE_WIN_BINDINGS
Tcl_HashTable winTable;
#endif
EventInfo *eventList;
int
nextEventId;
} BindingTable;
static
void
ExpandPercents(BindingTable *bindPtr, ClientData object,
char
*command,
QE_Event *eventPtr, QE_ExpandProc expandProc, Tcl_DString *result);
static
int
ParseEventDescription(BindingTable *bindPtr,
char
*eventPattern,
Pattern *patPtr, EventInfo **eventInfoPtr, Detail **detailPtr);
static
int
FindSequence(BindingTable *bindPtr, ClientData object,
char
*eventString,
int
create,
int
*created, BindValue **result);
static
void
Percents_CharMap(QE_ExpandArgs *args);
static
void
Percents_Command(QE_ExpandArgs *args);
#if ALLOW_INSTALL
typedef
struct
PercentsData {
GenerateData *gdPtr;
char
*command;
EventInfo *eventPtr;
Detail *detailPtr;
} PercentsData;
#endif
static
int
DeleteBinding(BindingTable *bindPtr, BindValue *valuePtr);
static
EventInfo *FindEvent(BindingTable *bindPtr,
int
eventType);
int
QE_BindInit(Tcl_Interp *interp)
{
return
TCL_OK;
}
static
int
CheckName(
char
*name)
{
char
*p = name;
if
(*p ==
'\0'
)
return
TCL_ERROR;
while
((*p !=
'\0'
) && (*p !=
'-'
) && !
isspace
(
UCHAR
(*p)))
p++;
if
(*p ==
'\0'
)
return
TCL_OK;
return
TCL_ERROR;
}
int
QE_InstallEvent(QE_BindingTable bindingTable,
char
*name, QE_ExpandProc expandProc)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
Tcl_HashEntry *hPtr;
EventInfo *eiPtr;
int
isNew;
int
type;
if
(CheckName(name) != TCL_OK)
{
Tcl_AppendResult(bindPtr->interp,
"bad event name \""
, name,
"\""
,
(
char
*) NULL);
return
0;
}
hPtr = Tcl_CreateHashEntry(&bindPtr->eventTableByName, name, &isNew);
if
(!isNew)
{
Tcl_AppendResult(bindPtr->interp,
"event \""
,
name,
"\" already exists"
, NULL);
return
0;
}
type = bindPtr->nextEventId++;
eiPtr = (EventInfo *) Tcl_Alloc(
sizeof
(EventInfo));
eiPtr->name = Tcl_Alloc((
int
)
strlen
(name) + 1);
strcpy
(eiPtr->name, name);
eiPtr->type = type;
eiPtr->expandProc = expandProc;
eiPtr->detailList = NULL;
eiPtr->nextDetailId = 1;
#ifdef ALLOW_INSTALL
eiPtr->dynamic = 0;
eiPtr->command = NULL;
#endif
Tcl_SetHashValue(hPtr, (ClientData) eiPtr);
hPtr = Tcl_CreateHashEntry(&bindPtr->eventTableByType, (
char
*) INT2PTR(type), &isNew);
Tcl_SetHashValue(hPtr, (ClientData) eiPtr);
eiPtr->next = bindPtr->eventList;
bindPtr->eventList = eiPtr;
return
type;
}
int
QE_InstallDetail(QE_BindingTable bindingTable,
char
*name,
int
eventType, QE_ExpandProc expandProc)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
Tcl_HashEntry *hPtr;
Detail *dPtr;
EventInfo *eiPtr;
PatternTableKey key;
int
isNew;
int
code;
if
(CheckName(name) != TCL_OK)
{
Tcl_AppendResult(bindPtr->interp,
"bad detail name \""
, name,
"\""
,
(
char
*) NULL);
return
0;
}
eiPtr = FindEvent(bindPtr, eventType);
if
(eiPtr == NULL)
return
0;
for
(dPtr = eiPtr->detailList;
dPtr != NULL;
dPtr = dPtr->next)
{
if
(
strcmp
(dPtr->name, name) == 0)
{
Tcl_AppendResult(bindPtr->interp,
"detail \""
, name,
"\" already exists for event \""
,
eiPtr->name,
"\""
, NULL);
return
0;
}
}
code = eiPtr->nextDetailId++;
dPtr = (Detail *) Tcl_Alloc(
sizeof
(Detail));
dPtr->name = Tk_GetUid(name);
dPtr->code = code;
dPtr->event = eiPtr;
dPtr->expandProc = expandProc;
#if ALLOW_INSTALL
dPtr->dynamic = 0;
dPtr->command = NULL;
#endif
key.type = eventType;
key.detail = code;
hPtr = Tcl_CreateHashEntry(&bindPtr->detailTableByType, (
char
*) &key, &isNew);
Tcl_SetHashValue(hPtr, (ClientData) dPtr);
dPtr->next = eiPtr->detailList;
eiPtr->detailList = dPtr;
return
code;
}
static
void
DeleteEvent(BindingTable *bindPtr, EventInfo *eiPtr)
{
EventInfo *eiPrev;
Detail *dPtr, *dNext;
for
(dPtr = eiPtr->detailList;
dPtr != NULL;
dPtr = dNext)
{
dNext = dPtr->next;
#ifdef ALLOW_INSTALL
if
(dPtr->command != NULL)
Tcl_Free(dPtr->command);
#endif
memset
((
char
*) dPtr, 0xAA,
sizeof
(Detail));
Tcl_Free((
char
*) dPtr);
}
if
(bindPtr->eventList == eiPtr)
bindPtr->eventList = eiPtr->next;
else
{
for
(eiPrev = bindPtr->eventList;
eiPrev->next != eiPtr;
eiPrev = eiPrev->next)
{
}
eiPrev->next = eiPtr->next;
}
Tcl_Free(eiPtr->name);
#ifdef ALLOW_INSTALL
if
(eiPtr->command != NULL)
Tcl_Free(eiPtr->command);
#endif
memset
((
char
*) eiPtr, 0xAA,
sizeof
(EventInfo));
Tcl_Free((
char
*) eiPtr);
}
int
QE_UninstallEvent(QE_BindingTable bindingTable,
int
eventType)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
EventInfo *eiPtr;
BindValue *valuePtr, **valueList;
Tcl_DString dString;
int
i, count = 0;
hPtr = Tcl_FindHashEntry(&bindPtr->eventTableByType, (
char
*) INT2PTR(eventType));
if
(hPtr == NULL)
return
TCL_ERROR;
eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
Tcl_DeleteHashEntry(hPtr);
hPtr = Tcl_FindHashEntry(&bindPtr->eventTableByName, eiPtr->name);
Tcl_DeleteHashEntry(hPtr);
Tcl_DStringInit(&dString);
hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
while
(hPtr != NULL)
{
valuePtr = (BindValue *) Tcl_GetHashValue(hPtr);
while
(valuePtr != NULL)
{
if
(valuePtr->type == eiPtr->type)
{
Tcl_DStringAppend(&dString, (
char
*) &valuePtr,
sizeof
(valuePtr));
count++;
}
valuePtr = valuePtr->nextValue;
}
hPtr = Tcl_NextHashEntry(&search);
}
valueList = (BindValue **) Tcl_DStringValue(&dString);
for
(i = 0; i < count; i++)
DeleteBinding(bindPtr, valueList[i]);
Tcl_DStringFree(&dString);
DeleteEvent(bindPtr, eiPtr);
return
TCL_OK;
}
int
QE_UninstallDetail(QE_BindingTable bindingTable,
int
eventType,
int
detail)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
PatternTableKey key;
Tcl_HashEntry *hPtr;
Detail *dPtr = NULL, *dPrev;
EventInfo *eiPtr;
eiPtr = FindEvent(bindPtr, eventType);
if
(eiPtr == NULL)
return
TCL_ERROR;
if
(eiPtr->detailList == NULL)
return
TCL_ERROR;
while
(1)
{
key.type = eventType;
key.detail = detail;
hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (
char
*) &key);
if
(hPtr == NULL)
break
;
DeleteBinding(bindPtr, (BindValue *) Tcl_GetHashValue(hPtr));
}
if
(eiPtr->detailList->code == detail)
{
dPtr = eiPtr->detailList;
eiPtr->detailList = eiPtr->detailList->next;
}
else
{
for
(dPrev = eiPtr->detailList;
dPrev != NULL;
dPrev = dPrev->next)
{
if
((dPrev->next != NULL) && (dPrev->next->code == detail))
{
dPtr = dPrev->next;
dPrev->next = dPtr->next;
break
;
}
}
if
(dPtr == NULL)
return
TCL_ERROR;
}
#ifdef ALLOW_INSTALL
if
(dPtr->command != NULL)
Tcl_Free(dPtr->command);
#endif
memset
((
char
*) dPtr, 0xAA,
sizeof
(Detail));
Tcl_Free((
char
*) dPtr);
key.type = eventType;
key.detail = detail;
hPtr = Tcl_FindHashEntry(&bindPtr->detailTableByType, (
char
*) &key);
Tcl_DeleteHashEntry(hPtr);
return
TCL_OK;
}
static
EventInfo *FindEvent(BindingTable *bindPtr,
int
eventType)
{
Tcl_HashEntry *hPtr;
hPtr = Tcl_FindHashEntry(&bindPtr->eventTableByType, (
char
*) INT2PTR(eventType));
if
(hPtr == NULL)
return
NULL;
return
(EventInfo *) Tcl_GetHashValue(hPtr);
}
static
Detail *FindDetail(BindingTable *bindPtr,
int
eventType,
int
code)
{
PatternTableKey key;
Tcl_HashEntry *hPtr;
key.type = eventType;
key.detail = code;
hPtr = Tcl_FindHashEntry(&bindPtr->detailTableByType, (
char
*) &key);
if
(hPtr == NULL)
return
NULL;
return
(Detail *) Tcl_GetHashValue(hPtr);
}
#if DELETE_WIN_BINDINGS
typedef
struct
WinTableValue
{
BindingTable *bindPtr;
ClientData object;
Tk_Window tkwin;
int
count;
} WinTableValue;
static
void
TkWinEventProc(ClientData clientData, XEvent *eventPtr)
{
WinTableValue *cd = (WinTableValue *) clientData;
BindingTable *bindPtr = cd->bindPtr;
ClientData object = cd->object;
if
(eventPtr->type != DestroyNotify)
return
;
QE_DeleteBinding((QE_BindingTable) bindPtr, object, NULL);
}
#endif
QE_BindingTable QE_CreateBindingTable(Tcl_Interp *interp)
{
BindingTable *bindPtr;
bindPtr = (BindingTable *) Tcl_Alloc(
sizeof
(BindingTable));
bindPtr->interp = interp;
Tcl_InitHashTable(&bindPtr->patternTable,
sizeof
(PatternTableKey) /
sizeof
(
int
));
Tcl_InitHashTable(&bindPtr->objectTable,
sizeof
(ObjectTableKey) /
sizeof
(
int
));
Tcl_InitHashTable(&bindPtr->eventTableByName, TCL_STRING_KEYS);
Tcl_InitHashTable(&bindPtr->eventTableByType, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(&bindPtr->detailTableByType,
sizeof
(PatternTableKey) /
sizeof
(
int
));
#if DELETE_WIN_BINDINGS
Tcl_InitHashTable(&bindPtr->winTable, TCL_ONE_WORD_KEYS);
#endif
bindPtr->nextEventId = 1;
bindPtr->eventList = NULL;
return
(QE_BindingTable) bindPtr;
}
void
QE_DeleteBindingTable(QE_BindingTable bindingTable)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
EventInfo *eiPtr, *eiNext;
Detail *dPtr, *dNext;
hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
while
(hPtr != NULL)
{
BindValue *valuePtr = (BindValue *) Tcl_GetHashValue(hPtr);
while
(valuePtr != NULL)
{
BindValue *nextValue = valuePtr->nextValue;
Tcl_Free((
char
*) valuePtr->command);
memset
((
char
*) valuePtr, 0xAA,
sizeof
(BindValue));
Tcl_Free((
char
*) valuePtr);
valuePtr = nextValue;
}
hPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&bindPtr->patternTable);
Tcl_DeleteHashTable(&bindPtr->objectTable);
for
(eiPtr = bindPtr->eventList;
eiPtr != NULL;
eiPtr = eiNext)
{
eiNext = eiPtr->next;
for
(dPtr = eiPtr->detailList;
dPtr != NULL;
dPtr = dNext)
{
dNext = dPtr->next;
#ifdef ALLOW_INSTALL
if
(dPtr->command != NULL)
Tcl_Free(dPtr->command);
#endif
memset
((
char
*) dPtr, 0xAA,
sizeof
(Detail));
Tcl_Free((
char
*) dPtr);
}
Tcl_Free(eiPtr->name);
#ifdef ALLOW_INSTALL
if
(eiPtr->command != NULL)
Tcl_Free(eiPtr->command);
#endif
memset
((
char
*) eiPtr, 0xAA,
sizeof
(EventInfo));
Tcl_Free((
char
*) eiPtr);
}
Tcl_DeleteHashTable(&bindPtr->eventTableByName);
Tcl_DeleteHashTable(&bindPtr->eventTableByType);
Tcl_DeleteHashTable(&bindPtr->detailTableByType);
#if DELETE_WIN_BINDINGS
hPtr = Tcl_FirstHashEntry(&bindPtr->winTable, &search);
while
(hPtr != NULL)
{
WinTableValue *cd = (WinTableValue *) Tcl_GetHashValue(hPtr);
Tk_DeleteEventHandler(cd->tkwin, StructureNotifyMask,
TkWinEventProc, (ClientData) cd);
Tcl_Free((
char
*) cd);
hPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&bindPtr->winTable);
#endif
memset
((
char
*) bindPtr, 0xAA,
sizeof
(BindingTable));
Tcl_Free((
char
*) bindPtr);
}
int
QE_CreateBinding(QE_BindingTable bindingTable, ClientData object,
char
*eventString,
char
*command,
int
append)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
BindValue *valuePtr;
int
isNew, length;
char
*cmdOld, *cmdNew;
if
(FindSequence(bindPtr, object, eventString, 1, &isNew, &valuePtr) != TCL_OK)
return
TCL_ERROR;
if
(isNew)
{
Tcl_HashEntry *hPtr;
PatternTableKey key;
#if DELETE_WIN_BINDINGS
char
*winName = (
char
*) object;
if
(winName[0] ==
'.'
)
{
Tk_Window tkwin = Tk_MainWindow(bindPtr->interp);
Tk_Window tkwin2;
tkwin2 = Tk_NameToWindow(bindPtr->interp, winName, tkwin);
if
(tkwin2 != NULL)
{
WinTableValue *cd;
hPtr = Tcl_CreateHashEntry(&bindPtr->winTable, object, &isNew);
if
(isNew)
{
cd = (WinTableValue *) Tcl_Alloc(
sizeof
(WinTableValue));
cd->bindPtr = bindPtr;
cd->object = object;
cd->tkwin = tkwin2;
cd->count = 0;
Tk_CreateEventHandler(tkwin2, StructureNotifyMask,
TkWinEventProc, (ClientData) cd);
Tcl_SetHashValue(hPtr, (ClientData) cd);
}
else
{
cd = (WinTableValue *) Tcl_GetHashValue(hPtr);
}
cd->count++;
}
}
#endif
key.type = valuePtr->type;
key.detail = valuePtr->detail;
hPtr = Tcl_CreateHashEntry(&bindPtr->patternTable, (
char
*) &key,
&isNew);
if
(!isNew)
{
valuePtr->nextValue = (BindValue *) Tcl_GetHashValue(hPtr);
}
Tcl_SetHashValue(hPtr, (ClientData) valuePtr);
}
cmdOld = valuePtr->command;
if
(append && cmdOld)
{
length = (
int
) (
strlen
(cmdOld) +
strlen
(command) + 2);
cmdNew = Tcl_Alloc((unsigned) length);
(
void
)
sprintf
(cmdNew,
"%s\n%s"
, cmdOld, command);
}
else
{
cmdNew = (
char
*) Tcl_Alloc((unsigned)
strlen
(command) + 1);
(
void
)
strcpy
(cmdNew, command);
}
if
(cmdOld) Tcl_Free(cmdOld);
valuePtr->command = cmdNew;
return
TCL_OK;
}
int
QE_DeleteBinding(QE_BindingTable bindingTable, ClientData object,
char
*eventString)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
BindValue *valuePtr, **valueList;
if
(eventString == NULL)
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_DString dString;
int
i, count = 0;
Tcl_DStringInit(&dString);
hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
while
(hPtr != NULL)
{
valuePtr = (BindValue *) Tcl_GetHashValue(hPtr);
while
(valuePtr != NULL)
{
if
(valuePtr->object == object)
{
Tcl_DStringAppend(&dString, (
char
*) &valuePtr,
sizeof
(valuePtr));
count++;
break
;
}
valuePtr = valuePtr->nextValue;
}
hPtr = Tcl_NextHashEntry(&search);
}
valueList = (BindValue **) Tcl_DStringValue(&dString);
for
(i = 0; i < count; i++)
DeleteBinding(bindPtr, valueList[i]);
Tcl_DStringFree(&dString);
return
TCL_OK;
}
if
(FindSequence(bindPtr, object, eventString, 0, NULL, &valuePtr) != TCL_OK)
return
TCL_ERROR;
if
(valuePtr == NULL)
{
Tcl_ResetResult(bindPtr->interp);
return
TCL_OK;
}
DeleteBinding(bindPtr, valuePtr);
return
TCL_OK;
}
static
int
DeleteBinding(BindingTable *bindPtr, BindValue *valuePtr)
{
Tcl_HashEntry *hPtr;
BindValue *listPtr;
ObjectTableKey keyObj;
PatternTableKey keyPat;
keyObj.type = valuePtr->type;
keyObj.detail = valuePtr->detail;
keyObj.object = valuePtr->object;
hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (
char
*) &keyObj);
if
(hPtr == NULL)
return
TCL_ERROR;
Tcl_DeleteHashEntry(hPtr);
keyPat.type = valuePtr->type;
keyPat.detail = valuePtr->detail;
hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (
char
*) &keyPat);
if
(hPtr == NULL)
return
TCL_ERROR;
listPtr = (BindValue *) Tcl_GetHashValue(hPtr);
if
(listPtr == valuePtr)
{
if
(valuePtr->nextValue == NULL)
{
if
(debug_bindings)
dbwin(
"QE_DeleteBinding: Deleted pattern type=%d detail=%d\n"
,
valuePtr->type, valuePtr->detail);
Tcl_DeleteHashEntry(hPtr);
}
else
{
Tcl_SetHashValue(hPtr, valuePtr->nextValue);
}
}
else
{
while
(1)
{
if
(listPtr->nextValue == NULL)
return
TCL_ERROR;
if
(listPtr->nextValue == valuePtr)
{
if
(debug_bindings)
dbwin(
"QE_DeleteBinding: Unlinked binding type=%d detail=%d\n"
,
valuePtr->type, valuePtr->detail);
listPtr->nextValue = valuePtr->nextValue;
break
;
}
listPtr = listPtr->nextValue;
}
}
#if DELETE_WIN_BINDINGS
{
char
*winName = (
char
*) valuePtr->object;
if
(winName[0] ==
'.'
)
{
WinTableValue *cd;
hPtr = Tcl_FindHashEntry(&bindPtr->winTable, winName);
if
(hPtr == NULL)
return
TCL_ERROR;
cd = (WinTableValue *) Tcl_GetHashValue(hPtr);
cd->count--;
if
(cd->count == 0)
{
Tk_DeleteEventHandler(cd->tkwin, StructureNotifyMask,
TkWinEventProc, (ClientData) cd);
Tcl_Free((
char
*) cd);
Tcl_DeleteHashEntry(hPtr);
}
}
}
#endif
Tcl_Free((
char
*) valuePtr->command);
memset
((
char
*) valuePtr, 0xAA,
sizeof
(BindValue));
Tcl_Free((
char
*) valuePtr);
return
TCL_OK;
}
int
QE_GetAllObjects(QE_BindingTable bindingTable)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_DString dString;
ClientData *objectList;
int
i, count = 0;
Tcl_Obj *listObj;
Tcl_DStringInit(&dString);
hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
while
(hPtr != NULL)
{
BindValue *valuePtr = (BindValue *) Tcl_GetHashValue(hPtr);
while
(valuePtr != NULL)
{
objectList = (ClientData *) Tcl_DStringValue(&dString);
for
(i = 0; i < count; i++)
{
if
(objectList[i] == valuePtr->object)
break
;
}
if
(i >= count)
{
Tcl_DStringAppend(&dString, (
char
*) &valuePtr->object,
sizeof
(ClientData));
count++;
}
valuePtr = valuePtr->nextValue;
}
hPtr = Tcl_NextHashEntry(&search);
}
if
(count > 0)
{
listObj = Tcl_NewListObj(0, NULL);
objectList = (ClientData *) Tcl_DStringValue(&dString);
for
(i = 0; i < count; i++)
{
Tcl_ListObjAppendElement(bindPtr->interp, listObj,
Tcl_NewStringObj((
char
*) objectList[i], -1));
}
Tcl_SetObjResult(bindPtr->interp, listObj);
}
Tcl_DStringFree(&dString);
return
TCL_OK;
}
int
QE_GetBinding(QE_BindingTable bindingTable, ClientData object,
char
*eventString)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
BindValue *valuePtr;
if
(FindSequence(bindPtr, object, eventString, 0, NULL, &valuePtr) != TCL_OK)
return
TCL_ERROR;
if
(valuePtr == NULL)
return
TCL_OK;
Tcl_SetObjResult(bindPtr->interp, Tcl_NewStringObj(valuePtr->command, -1));
return
TCL_OK;
}
static
void
GetPatternString(BindingTable *bindPtr, BindValue *bindValue, Tcl_DString *dString)
{
EventInfo *eiPtr;
eiPtr = FindEvent(bindPtr, bindValue->type);
if
(eiPtr != NULL)
{
Tcl_DStringAppend(dString,
"<"
, 1);
Tcl_DStringAppend(dString, eiPtr->name, -1);
if
(bindValue->detail)
{
Detail *detail = FindDetail(bindPtr, bindValue->type, bindValue->detail);
if
(detail != NULL)
{
Tcl_DStringAppend(dString,
"-"
, 1);
Tcl_DStringAppend(dString, detail->name, -1);
}
}
Tcl_DStringAppend(dString,
">"
, 1);
}
}
int
QE_GetAllBindings(QE_BindingTable bindingTable, ClientData object)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_DString dString;
Tcl_DStringInit(&dString);
hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
while
(hPtr != NULL)
{
BindValue *valuePtr = (BindValue *) Tcl_GetHashValue(hPtr);
while
(valuePtr != NULL)
{
if
(valuePtr->object == object)
{
Tcl_DStringSetLength(&dString, 0);
GetPatternString(bindPtr, valuePtr, &dString);
Tcl_AppendElement(bindPtr->interp, Tcl_DStringValue(&dString));
break
;
}
valuePtr = valuePtr->nextValue;
}
hPtr = Tcl_NextHashEntry(&search);
}
Tcl_DStringFree(&dString);
return
TCL_OK;
}
int
QE_GetEventNames(QE_BindingTable bindingTable)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
EventInfo *eiPtr;
for
(eiPtr = bindPtr->eventList;
eiPtr != NULL;
eiPtr = eiPtr->next)
{
Tcl_AppendElement(bindPtr->interp, eiPtr->name);
}
return
TCL_OK;
}
int
QE_GetDetailNames(QE_BindingTable bindingTable,
char
*eventName)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
Tcl_HashEntry *hPtr;
EventInfo *eiPtr;
Detail *dPtr;
hPtr = Tcl_FindHashEntry(&bindPtr->eventTableByName, eventName);
if
(hPtr == NULL)
{
Tcl_AppendResult(bindPtr->interp,
"unknown event \""
, eventName,
"\""
, NULL);
return
TCL_ERROR;
}
eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
for
(dPtr = eiPtr->detailList;
dPtr != NULL;
dPtr = dPtr->next)
{
Tcl_AppendElement(bindPtr->interp, dPtr->name);
}
return
TCL_OK;
}
static
void
ExpandPercents(BindingTable *bindPtr, ClientData object,
char
*command, QE_Event *eventPtr, QE_ExpandProc expandProc,
Tcl_DString *result)
{
char
*string;
QE_ExpandArgs expandArgs;
#if 0
Tcl_DStringSetLength(result, 0);
if
(debug_bindings)
dbwin(
"ExpandPercents on '%s' name=%s type=%d detail=%d expand=%lu\n"
,
object, eiPtr->name, eiPtr->type, eventPtr->detail, eiPtr->expand);
#endif
expandArgs.bindingTable = (QE_BindingTable) bindPtr;
expandArgs.object = object;
expandArgs.event = eventPtr->type;
expandArgs.detail = eventPtr->detail;
expandArgs.result = result;
expandArgs.clientData = eventPtr->clientData;
while
(1)
{
for
(string = command; (*string != 0) && (*string !=
'%'
); string++)
{
}
if
(string != command)
{
Tcl_DStringAppend(result, command, (
int
) (string - command));
command = string;
}
if
(*command == 0)
{
break
;
}
expandArgs.which = command[1];
(*expandProc)(&expandArgs);
command += 2;
}
}
static
void
BindEvent(BindingTable *bindPtr, QE_Event *eventPtr,
int
wantDetail,
EventInfo *eiPtr, Detail *dPtr, GenerateData *gdPtr)
{
Tcl_HashEntry *hPtr;
BindValue *valuePtr;
ObjectTableKey keyObj;
PatternTableKey key;
Tcl_DString scripts, savedResult;
int
code;
char
*p, *end;
char
*command = gdPtr ? gdPtr->command : NULL;
key.type = eventPtr->type;
key.detail = wantDetail ? eventPtr->detail : 0;
hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (
char
*) &key);
if
(hPtr == NULL)
return
;
Tcl_DStringInit(&scripts);
for
(valuePtr = (BindValue *) Tcl_GetHashValue(hPtr);
valuePtr; valuePtr = valuePtr->nextValue)
{
if
(wantDetail && valuePtr->detail)
{
keyObj.type = key.type;
keyObj.detail = 0;
keyObj.object = valuePtr->object;
hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (
char
*) &keyObj);
if
(hPtr != NULL)
{
BindValue *value2Ptr;
value2Ptr = (BindValue *) Tcl_GetHashValue(hPtr);
value2Ptr->specific = 1;
}
}
else
if
(!wantDetail && valuePtr->specific)
{
if
(debug_bindings)
dbwin(
"QE_BindEvent: Skipping less-specific event type=%d object='%s'\n"
,
valuePtr->type, (
char
*) valuePtr->object);
valuePtr->specific = 0;
continue
;
}
#if BIND_ACTIVE
if
(valuePtr->active == 0)
continue
;
#endif /* BIND_ACTIVE */
#if ALLOW_INSTALL
if
(command == NULL)
{
if
((dPtr != NULL) && (dPtr->command != NULL))
{
command = dPtr->command;
}
else
if
(((dPtr == NULL) ||
((dPtr != NULL) && (dPtr->expandProc == NULL))) &&
(eiPtr->command != NULL))
{
command = eiPtr->command;
}
}
#endif /* ALLOW_INSTALL */
if
(command != NULL)
{
PercentsData data;
data.gdPtr = gdPtr;
data.command = command;
data.eventPtr = eiPtr;
data.detailPtr = dPtr;
eventPtr->clientData = (ClientData) &data;
ExpandPercents(bindPtr, valuePtr->object, valuePtr->command,
eventPtr, Percents_Command, &scripts);
}
else
if
(gdPtr != NULL)
{
eventPtr->clientData = (ClientData) gdPtr;
ExpandPercents(bindPtr, valuePtr->object, valuePtr->command,
eventPtr, Percents_CharMap, &scripts);
}
else
{
QE_ExpandProc expandProc =
((dPtr != NULL) && (dPtr->expandProc != NULL)) ?
dPtr->expandProc : eiPtr->expandProc;
ExpandPercents(bindPtr, valuePtr->object, valuePtr->command,
eventPtr, expandProc, &scripts);
}
Tcl_DStringAppend(&scripts,
""
, 1);
Tcl_DStringAppend(&scripts, eiPtr->name, -1);
Tcl_DStringAppend(&scripts,
""
, 1);
Tcl_DStringAppend(&scripts, (valuePtr->detail && dPtr) ? dPtr->name :
""
, -1);
Tcl_DStringAppend(&scripts,
""
, 1);
Tcl_DStringAppend(&scripts, valuePtr->object, -1);
Tcl_DStringAppend(&scripts,
""
, 1);
}
if
(Tcl_DStringLength(&scripts) == 0)
return
;
Tcl_DStringInit(&savedResult);
Tcl_DStringGetResult(bindPtr->interp, &savedResult);
p = Tcl_DStringValue(&scripts);
end = p + Tcl_DStringLength(&scripts);
while
(p < end)
{
code = Tcl_GlobalEval(bindPtr->interp, p);
p +=
strlen
(p);
p++;
if
(code != TCL_OK)
{
if
(code == TCL_CONTINUE)
{
}
else
if
(code == TCL_BREAK)
{
}
else
{
char
buf[256];
char
*eventName = p;
char
*detailName = p +
strlen
(p) + 1;
char
*object = detailName +
strlen
(detailName) + 1;
(
void
)
sprintf
(buf,
"\n (<%s%s%s> binding on %s)"
,
eventName, detailName[0] ?
"-"
:
""
, detailName, object);
Tcl_AddErrorInfo(bindPtr->interp, buf);
Tcl_BackgroundError(bindPtr->interp);
}
}
p +=
strlen
(p);
p++;
p +=
strlen
(p);
p++;
p +=
strlen
(p);
p++;
}
Tcl_DStringFree(&scripts);
Tcl_DStringResult(bindPtr->interp, &savedResult);
}
static
int
BindEventWrapper(QE_BindingTable bindingTable, QE_Event *eventPtr, GenerateData *gdPtr)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
Detail *dPtr = NULL;
EventInfo *eiPtr;
eiPtr = FindEvent(bindPtr, eventPtr->type);
if
(eiPtr == NULL)
return
TCL_OK;
if
(eventPtr->detail)
{
dPtr = FindDetail(bindPtr, eventPtr->type, eventPtr->detail);
if
(dPtr == NULL)
return
TCL_OK;
}
BindEvent(bindPtr, eventPtr, 1, eiPtr, dPtr, gdPtr);
if
(eventPtr->detail)
BindEvent(bindPtr, eventPtr, 0, eiPtr, dPtr, gdPtr);
return
TCL_OK;
}
int
QE_BindEvent(QE_BindingTable bindingTable, QE_Event *eventPtr)
{
return
BindEventWrapper(bindingTable, eventPtr, NULL);
}
static
char
*GetField(
char
*p,
char
*copy,
int
size)
{
int
ch = *p;
while
((ch !=
'\0'
) && !
isspace
(
UCHAR
(ch)) &&
((ch !=
'>'
) || (p[1] !=
'\0'
))
&& (ch !=
'-'
) && (size > 1))
{
*copy = ch;
p++;
copy++;
size--;
ch = *p;
}
*copy =
'\0'
;
while
((*p ==
'-'
) ||
isspace
(
UCHAR
(*p)))
{
p++;
}
return
p;
}
#define FIELD_SIZE 48
static
int
ParseEventDescription1(BindingTable *bindPtr,
char
*pattern,
char
eventName[FIELD_SIZE],
char
detailName[FIELD_SIZE])
{
Tcl_Interp *interp = bindPtr->interp;
char
*p = pattern;
eventName[0] = detailName[0] =
'\0'
;
if
(*p !=
'<'
)
{
Tcl_AppendResult(interp,
"missing \"<\" in event pattern \""
,
pattern,
"\""
, (
char
*) NULL);
return
TCL_ERROR;
}
p++;
p = GetField(p, eventName, FIELD_SIZE);
if
(debug_bindings)
dbwin(
"GetField='%s'\n"
, eventName);
if
(*p ==
'>'
)
return
TCL_OK;
p = GetField(p, detailName, FIELD_SIZE);
if
(debug_bindings)
dbwin(
"GetField='%s'\n"
, detailName);
if
(*p !=
'>'
)
{
Tcl_AppendResult(interp,
"missing \">\" in event pattern \""
,
pattern,
"\""
, (
char
*) NULL);
return
TCL_ERROR;
}
return
TCL_OK;
}
static
int
ParseEventDescription(BindingTable *bindPtr,
char
*eventString,
Pattern *patPtr, EventInfo **eventInfoPtr, Detail **detailPtr)
{
Tcl_Interp *interp = bindPtr->interp;
Tcl_HashEntry *hPtr;
char
eventName[FIELD_SIZE], detailName[FIELD_SIZE];
EventInfo *eiPtr;
Detail *dPtr;
char
errorMsg[512];
if
(eventInfoPtr) *eventInfoPtr = NULL;
if
(detailPtr) *detailPtr = NULL;
patPtr->type = -1;
patPtr->detail = 0;
if
(ParseEventDescription1(bindPtr, eventString, eventName, detailName) != TCL_OK)
return
TCL_ERROR;
hPtr = Tcl_FindHashEntry(&bindPtr->eventTableByName, eventName);
if
(hPtr == NULL)
{
sprintf
(errorMsg,
"unknown event \"%.128s\""
, eventName);
Tcl_SetResult(interp, errorMsg, TCL_VOLATILE);
return
TCL_ERROR;
}
eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
patPtr->type = eiPtr->type;
if
(eventInfoPtr) *eventInfoPtr = eiPtr;
if
(detailName[0] !=
'\0'
)
{
for
(dPtr = eiPtr->detailList;
dPtr != NULL;
dPtr = dPtr->next)
{
if
(
strcmp
(dPtr->name, detailName) == 0)
break
;
}
if
(dPtr == NULL)
{
sprintf
(errorMsg,
"unknown detail \"%.128s\" for event \"%.128s\""
,
detailName, eiPtr->name);
Tcl_SetResult(interp, errorMsg, TCL_VOLATILE);
return
TCL_ERROR;
}
patPtr->detail = dPtr->code;
if
(detailPtr) *detailPtr = dPtr;
}
return
TCL_OK;
}
static
int
FindSequence(BindingTable *bindPtr, ClientData object,
char
*eventString,
int
create,
int
*created, BindValue **result)
{
Tcl_HashEntry *hPtr;
Pattern pats;
ObjectTableKey key;
BindValue *valuePtr;
int
isNew;
if
(debug_bindings)
dbwin(
"FindSequence object='%s' pattern='%s'...\n"
, (
char
*) object,
eventString);
if
(created) (*created) = 0;
if
(ParseEventDescription(bindPtr, eventString, &pats, NULL, NULL) != TCL_OK)
return
TCL_ERROR;
key.type = pats.type;
key.detail = pats.detail;
key.object = object;
if
(create)
{
hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (
char
*) &key, &isNew);
if
(isNew)
{
if
(debug_bindings)
dbwin(
"New BindValue for '%s' type=%d detail=%d\n"
,
(
char
*) object, pats.type, pats.detail);
valuePtr = (BindValue *) Tcl_Alloc(
sizeof
(BindValue));
valuePtr->type = pats.type;
valuePtr->detail = pats.detail;
valuePtr->object = object;
valuePtr->command = NULL;
valuePtr->specific = 0;
valuePtr->nextValue = NULL;
#if BIND_ACTIVE
valuePtr->active = 1;
#endif /* BIND_ACTIVE */
Tcl_SetHashValue(hPtr, (ClientData) valuePtr);
}
if
(created) (*created) = isNew;
(*result) = (BindValue *) Tcl_GetHashValue(hPtr);
return
TCL_OK;
}
hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (
char
*) &key);
if
(hPtr == NULL)
{
(*result) = NULL;
return
TCL_OK;
}
(*result) = (BindValue *) Tcl_GetHashValue(hPtr);
return
TCL_OK;
}
void
QE_ExpandDouble(
double
number, Tcl_DString *result)
{
char
numStorage[TCL_DOUBLE_SPACE];
Tcl_PrintDouble((Tcl_Interp *) NULL, number, numStorage);
Tcl_DStringAppend(result, numStorage, -1);
}
void
QE_ExpandNumber(
long
number, Tcl_DString *result)
{
char
numStorage[TCL_INTEGER_SPACE];
(
void
)
sprintf
(numStorage,
"%ld"
, number);
Tcl_DStringAppend(result, numStorage, -1);
}
void
QE_ExpandString(
char
*string, Tcl_DString *result)
{
int
length, spaceNeeded, cvtFlags;
spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
length = Tcl_DStringLength(result);
Tcl_DStringSetLength(result, length + spaceNeeded);
spaceNeeded = Tcl_ConvertElement(string,
Tcl_DStringValue(result) + length,
cvtFlags | TCL_DONT_USE_BRACES);
Tcl_DStringSetLength(result, length + spaceNeeded);
}
void
QE_ExpandUnknown(
char
which, Tcl_DString *result)
{
char
string[2];
(
void
)
sprintf
(string,
"%c"
, which);
QE_ExpandString(string, result);
}
void
QE_ExpandEvent(QE_BindingTable bindingTable,
int
eventType, Tcl_DString *result)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
EventInfo *eiPtr = FindEvent(bindPtr, eventType);
if
(eiPtr != NULL)
QE_ExpandString((
char
*) eiPtr->name, result);
else
QE_ExpandString(
"unknown"
, result);
}
void
QE_ExpandDetail(QE_BindingTable bindingTable,
int
event,
int
detail, Tcl_DString *result)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
Detail *dPtr;
if
(detail == 0)
{
QE_ExpandString(
""
, result);
return
;
}
dPtr = FindDetail(bindPtr, event, detail);
if
(dPtr != NULL)
QE_ExpandString((
char
*) dPtr->name, result);
else
QE_ExpandString(
"unknown"
, result);
}
void
QE_ExpandPattern(QE_BindingTable bindingTable,
int
eventType,
int
detail, Tcl_DString *result)
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
EventInfo *eiPtr = FindEvent(bindPtr, eventType);
Tcl_DStringAppend(result,
"<"
, 1);
Tcl_DStringAppend(result, eiPtr ? eiPtr->name :
"unknown"
, -1);
if
(detail)
{
Detail *dPtr = FindDetail(bindPtr, eventType, detail);
Tcl_DStringAppend(result,
"-"
, 1);
Tcl_DStringAppend(result, dPtr ? dPtr->name :
"unknown"
, -1);
}
Tcl_DStringAppend(result,
">"
, 1);
}
int
QE_BindCmd(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
Tk_Window tkwin = Tk_MainWindow(bindPtr->interp);
ClientData object;
char
*string;
if
((objC < 1) || (objC > 4))
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 1, objv,
"?object? ?pattern? ?script?"
);
return
TCL_ERROR;
}
if
(objC == 1)
{
QE_GetAllObjects(bindingTable);
return
TCL_OK;
}
string = Tcl_GetString(objV[1]);
if
(string[0] ==
'.'
)
{
Tk_Window tkwin2;
tkwin2 = Tk_NameToWindow(bindPtr->interp, string, tkwin);
if
(tkwin2 == NULL)
{
return
TCL_ERROR;
}
object = (ClientData) Tk_GetUid(Tk_PathName(tkwin2));
}
else
{
object = (ClientData) Tk_GetUid(string);
}
if
(objC == 4)
{
int
append = 0;
char
*sequence = Tcl_GetString(objV[2]);
char
*script = Tcl_GetString(objV[3]);
if
(script[0] == 0)
{
return
QE_DeleteBinding(bindingTable, object, sequence);
}
if
(script[0] ==
'+'
)
{
script++;
append = 1;
}
return
QE_CreateBinding(bindingTable, object, sequence, script,
append);
}
else
if
(objC == 3)
{
char
*sequence = Tcl_GetString(objV[2]);
return
QE_GetBinding(bindingTable, object, sequence);
}
else
{
QE_GetAllBindings(bindingTable, object);
}
return
TCL_OK;
}
int
QE_UnbindCmd(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
Tk_Window tkwin = Tk_MainWindow(bindPtr->interp);
ClientData object;
char
*string, *sequence;
if
((objC < 2) || (objC > 3))
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 1, objv,
"object ?pattern?"
);
return
TCL_ERROR;
}
string = Tcl_GetString(objV[1]);
if
(string[0] ==
'.'
)
{
Tk_Window tkwin2;
tkwin2 = Tk_NameToWindow(bindPtr->interp, string, tkwin);
if
(tkwin2 == NULL)
{
return
TCL_ERROR;
}
object = (ClientData) Tk_GetUid(Tk_PathName(tkwin2));
}
else
{
object = (ClientData) Tk_GetUid(string);
}
if
(objC == 2)
{
return
QE_DeleteBinding(bindingTable, object, NULL);
}
sequence = Tcl_GetString(objV[2]);
return
QE_DeleteBinding(bindingTable, object, sequence);
}
int
QE_GenerateCmd(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
QE_Event fakeEvent;
EventInfo *eiPtr;
Detail *dPtr;
GenerateData genData;
GenerateField *fieldPtr;
char
*p, *t;
int
listObjc;
int
i;
Tcl_Obj **listObjv;
Pattern pats;
int
result;
if
(objC < 2 || objC > 4)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 1, objv,
"pattern ?charMap? ?percentsCommand?"
);
return
TCL_ERROR;
}
p = Tcl_GetStringFromObj(objV[1], NULL);
if
(ParseEventDescription(bindPtr, p, &pats, &eiPtr, &dPtr) != TCL_OK)
return
TCL_ERROR;
if
((dPtr == NULL) && (eiPtr->detailList != NULL))
{
Tcl_AppendResult(bindPtr->interp,
"cannot generate \""
, p,
"\": missing detail"
, (
char
*) NULL);
return
TCL_ERROR;
}
if
(objC >= 3)
{
if
(Tcl_ListObjGetElements(bindPtr->interp, objV[2],
&listObjc, &listObjv) != TCL_OK)
return
TCL_ERROR;
if
(listObjc & 1)
{
Tcl_AppendResult(bindPtr->interp,
"char map must have even number of elements"
, (
char
*) NULL);
return
TCL_ERROR;
}
genData.count = listObjc / 2;
genData.field = genData.staticField;
if
(genData.count >
sizeof
(genData.staticField) /
sizeof
(genData.staticField[0]))
{
genData.field = (GenerateField *) Tcl_Alloc(
sizeof
(GenerateField) *
genData.count);
}
genData.count = 0;
while
(listObjc > 1)
{
int
length;
t = Tcl_GetStringFromObj(listObjv[0], &length);
if
(length != 1)
{
Tcl_AppendResult(bindPtr->interp,
"invalid percent char \""
, t,
"\""
, NULL);
result = TCL_ERROR;
goto
done;
}
fieldPtr = NULL;
for
(i = 0; i < genData.count; i++)
{
if
(genData.field[i].which == t[0])
{
fieldPtr = &genData.field[i];
break
;
}
}
if
(fieldPtr == NULL)
fieldPtr = &genData.field[genData.count++];
fieldPtr->which = t[0];
fieldPtr->string = Tcl_GetStringFromObj(listObjv[1], NULL);
listObjv += 2;
listObjc -= 2;
}
}
else
{
genData.count = 0;
genData.field = genData.staticField;
}
if
(objC == 4)
{
genData.command = Tcl_GetString(objV[3]);
}
else
{
genData.command = NULL;
}
fakeEvent.type = pats.type;
fakeEvent.detail = pats.detail;
fakeEvent.clientData = NULL;
result = BindEventWrapper(bindingTable, &fakeEvent, &genData);
done:
if
(genData.field != genData.staticField)
Tcl_Free((
char
*) genData.field);
return
result;
}
#if BIND_ACTIVE
int
QE_ConfigureCmd(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
Tcl_Interp *interp = bindPtr->interp;
Tk_Window tkwin = Tk_MainWindow(interp);
static
CONST
char
*configSwitch[] = {
"-active"
, NULL};
Tcl_Obj *CONST *objPtr;
BindValue *valuePtr;
char
*t, *eventString;
int
index;
ClientData object;
if
(objC < 3)
{
Tcl_WrongNumArgs(interp, objOffset + 1, objv,
"object pattern ?option? ?value? ?option value ...?"
);
return
TCL_ERROR;
}
t = Tcl_GetStringFromObj(objV[1], NULL);
eventString = Tcl_GetStringFromObj(objV[2], NULL);
if
(t[0] ==
'.'
)
{
Tk_Window tkwin2;
tkwin2 = Tk_NameToWindow(interp, t, tkwin);
if
(tkwin2 == NULL)
{
return
TCL_ERROR;
}
object = (ClientData) Tk_GetUid(Tk_PathName(tkwin2));
}
else
{
object = (ClientData) Tk_GetUid(t);
}
if
(FindSequence(bindPtr, object, eventString, 0, NULL, &valuePtr) != TCL_OK)
return
TCL_ERROR;
if
(valuePtr == NULL)
return
TCL_OK;
objPtr = objv + objOffset + 3;
objc -= objOffset + 3;
if
(objc == 0)
{
Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(
"-active"
, -1));
Tcl_ListObjAppendElement(interp, listObj, Tcl_NewBooleanObj(valuePtr->active));
Tcl_SetObjResult(interp, listObj);
return
TCL_OK;
}
if
(objc == 1)
{
if
(Tcl_GetIndexFromObj(interp, objPtr[0], configSwitch,
"option"
, 0, &index) != TCL_OK)
{
return
TCL_ERROR;
}
switch
(index)
{
case
0:
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr->active));
break
;
}
return
TCL_OK;
}
while
(objc > 1)
{
if
(Tcl_GetIndexFromObj(interp, objPtr[0], configSwitch,
"option"
, 0, &index) != TCL_OK)
{
return
TCL_ERROR;
}
switch
(index)
{
case
0:
if
(Tcl_GetBooleanFromObj(interp, objPtr[1], &valuePtr->active)
!= TCL_OK)
{
return
TCL_ERROR;
}
break
;
}
objPtr += 2;
objc -= 2;
}
return
TCL_OK;
}
#endif /* BIND_ACTIVE */
static
void
Percents_CharMap(QE_ExpandArgs *args)
{
GenerateData *gdPtr = (GenerateData *) args->clientData;
int
i;
for
(i = 0; i < gdPtr->count; i++)
{
GenerateField *gfPtr = &gdPtr->field[i];
if
(gfPtr->which == args->which)
{
QE_ExpandString(gfPtr->string, args->result);
return
;
}
}
QE_ExpandUnknown(args->which, args->result);
}
static
void
Percents_Command(QE_ExpandArgs *args)
{
BindingTable *bindPtr = (BindingTable *) args->bindingTable;
Tcl_Interp *interp = bindPtr->interp;
PercentsData *data = (PercentsData *) args->clientData;
GenerateData *gdPtr = data->gdPtr;
EventInfo *eiPtr = data->eventPtr;
Detail *dPtr = data->detailPtr;
Tcl_DString command;
Tcl_SavedResult state;
int
i;
Tcl_DStringInit(&command);
Tcl_DStringAppend(&command, data->command, -1);
Tcl_DStringAppend(&command,
" "
, 1);
Tcl_DStringAppend(&command, &args->which, 1);
Tcl_DStringAppend(&command,
" "
, 1);
Tcl_DStringAppend(&command, (
char
*) args->object, -1);
Tcl_DStringAppend(&command,
" "
, 1);
Tcl_DStringAppend(&command, eiPtr->name, -1);
Tcl_DStringAppend(&command,
" "
, 1);
if
(dPtr != NULL)
Tcl_DStringAppend(&command, dPtr->name, -1);
else
Tcl_DStringAppend(&command,
"{}"
, -1);
Tcl_DStringStartSublist(&command);
for
(i = 0; i < gdPtr->count; i++)
{
GenerateField *genField = &gdPtr->field[i];
char
string[2];
string[0] = genField->which;
string[1] =
'\0'
;
Tcl_DStringAppendElement(&command, string);
Tcl_DStringAppendElement(&command, genField->string);
}
Tcl_DStringEndSublist(&command);
Tcl_SaveResult(interp, &state);
if
(Tcl_EvalEx(interp, Tcl_DStringValue(&command),
Tcl_DStringLength(&command), TCL_EVAL_GLOBAL) == TCL_OK)
{
QE_ExpandString(Tcl_GetStringFromObj(Tcl_GetObjResult(interp),
NULL), args->result);
}
else
{
QE_ExpandUnknown(args->which, args->result);
Tcl_AddErrorInfo(interp,
"\n (expanding percents)"
);
Tcl_BackgroundError(interp);
}
Tcl_RestoreResult(interp, &state);
Tcl_DStringFree(&command);
}
#if ALLOW_INSTALL
static
int
QE_InstallCmd_New(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
char
*pattern, *command = NULL;
char
eventName[FIELD_SIZE], detailName[FIELD_SIZE];
int
id, length;
EventInfo *eiPtr;
Detail *dPtr = NULL;
Tcl_HashEntry *hPtr;
if
(objC < 2 || objC > 3)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 1, objv,
"pattern ?percentsCommand?"
);
return
TCL_ERROR;
}
pattern = Tcl_GetString(objV[1]);
if
(ParseEventDescription1(bindPtr, pattern, eventName, detailName) != TCL_OK)
return
TCL_ERROR;
hPtr = Tcl_FindHashEntry(&bindPtr->eventTableByName, eventName);
if
(hPtr == NULL)
{
id = QE_InstallEvent(bindingTable, eventName, NULL);
if
(id == 0)
return
TCL_ERROR;
hPtr = Tcl_FindHashEntry(&bindPtr->eventTableByName, eventName);
if
(hPtr == NULL)
return
TCL_ERROR;
eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
eiPtr->dynamic = 1;
}
else
{
eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
}
if
(detailName[0])
{
for
(dPtr = eiPtr->detailList;
dPtr != NULL;
dPtr = dPtr->next)
{
if
(
strcmp
(dPtr->name, detailName) == 0)
break
;
}
if
(dPtr == NULL)
{
id = QE_InstallDetail(bindingTable, detailName, eiPtr->type, NULL);
if
(id == 0)
return
TCL_ERROR;
dPtr = FindDetail(bindPtr, eiPtr->type, id);
if
(dPtr == NULL)
return
TCL_ERROR;
dPtr->dynamic = 1;
}
}
if
(objC == 3)
command = Tcl_GetStringFromObj(objV[2], &length);
if
(dPtr != NULL)
{
if
(!dPtr->dynamic)
{
Tcl_AppendResult(bindPtr->interp, pattern,
" is not dynamic"
,
NULL);
return
TCL_ERROR;
}
if
(command != NULL)
{
if
(dPtr->command)
{
Tcl_Free(dPtr->command);
dPtr->command = NULL;
}
if
(length)
{
dPtr->command = Tcl_Alloc(length + 1);
(
void
)
strcpy
(dPtr->command, command);
}
}
if
(dPtr->command)
Tcl_SetResult(bindPtr->interp, dPtr->command, TCL_VOLATILE);
}
else
{
if
(!eiPtr->dynamic)
{
Tcl_AppendResult(bindPtr->interp, pattern,
" is not dynamic"
,
NULL);
return
TCL_ERROR;
}
if
(command != NULL)
{
if
(eiPtr->command)
{
Tcl_Free(eiPtr->command);
eiPtr->command = NULL;
}
if
(length)
{
eiPtr->command = Tcl_Alloc(length + 1);
(
void
)
strcpy
(eiPtr->command, command);
}
}
if
(eiPtr->command)
Tcl_SetResult(bindPtr->interp, eiPtr->command, TCL_VOLATILE);
}
return
TCL_OK;
}
static
int
QE_InstallCmd_Old(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
static
CONST
char
*commandOption[] = {
"detail"
,
"event"
, NULL};
int
index;
if
(objC < 2)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 1, objv,
"option arg ..."
);
return
TCL_ERROR;
}
if
(Tcl_GetIndexFromObj(bindPtr->interp, objV[1],
commandOption,
"option"
, 0, &index) != TCL_OK)
{
return
TCL_ERROR;
}
switch
(index)
{
case
0:
{
char
*eventName, *detailName, *command;
int
id, length;
Detail *dPtr;
EventInfo *eiPtr;
Tcl_HashEntry *hPtr;
if
((objC < 4) || (objC > 5))
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 2, objv,
"event detail ?percentsCommand?"
);
return
TCL_ERROR;
}
eventName = Tcl_GetStringFromObj(objV[2], NULL);
hPtr = Tcl_FindHashEntry(&bindPtr->eventTableByName, eventName);
if
(hPtr == NULL)
{
Tcl_AppendResult(bindPtr->interp,
"unknown event \""
,
eventName,
"\""
, NULL);
return
TCL_ERROR;
}
eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
detailName = Tcl_GetStringFromObj(objV[3], NULL);
id = QE_InstallDetail(bindingTable, detailName, eiPtr->type, NULL);
if
(id == 0)
return
TCL_ERROR;
dPtr = FindDetail(bindPtr, eiPtr->type, id);
if
(dPtr == NULL)
return
TCL_ERROR;
dPtr->dynamic = 1;
if
(objC == 4)
break
;
command = Tcl_GetStringFromObj(objV[4], &length);
if
(length)
{
dPtr->command = Tcl_Alloc(length + 1);
(
void
)
strcpy
(dPtr->command, command);
}
break
;
}
case
1:
{
char
*eventName, *command;
int
id, length;
EventInfo *eiPtr;
Tcl_HashEntry *hPtr;
if
(objC < 3 || objC > 4)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 2, objv,
"name ?percentsCommand?"
);
return
TCL_ERROR;
}
eventName = Tcl_GetStringFromObj(objV[2], NULL);
id = QE_InstallEvent(bindingTable, eventName, NULL);
if
(id == 0)
return
TCL_ERROR;
hPtr = Tcl_FindHashEntry(&bindPtr->eventTableByName, eventName);
if
(hPtr == NULL)
return
TCL_ERROR;
eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
eiPtr->dynamic = 1;
if
(objC == 3)
break
;
command = Tcl_GetStringFromObj(objV[3], &length);
if
(length)
{
eiPtr->command = Tcl_Alloc(length + 1);
(
void
)
strcpy
(eiPtr->command, command);
}
break
;
}
}
return
TCL_OK;
}
int
QE_InstallCmd(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
char
*s;
int
length;
if
(objC < 2)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 1, objv,
"pattern ?percentsCommand?"
);
return
TCL_ERROR;
}
s = Tcl_GetStringFromObj(objV[1], &length);
if
(length && (!
strcmp
(s,
"detail"
) || !
strcmp
(s,
"event"
)))
return
QE_InstallCmd_Old(bindingTable, objOffset, objc, objv);
return
QE_InstallCmd_New(bindingTable, objOffset, objc, objv);
}
static
int
QE_UninstallCmd_New(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
char
*pattern;
Pattern pats;
EventInfo *eiPtr;
Detail *dPtr;
if
(objC != 2)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 1, objv,
"pattern"
);
return
TCL_ERROR;
}
pattern = Tcl_GetString(objV[1]);
if
(ParseEventDescription(bindPtr, pattern, &pats, &eiPtr, &dPtr) != TCL_OK)
return
TCL_ERROR;
if
(dPtr != NULL)
{
if
(!dPtr->dynamic)
{
Tcl_AppendResult(bindPtr->interp,
"can't uninstall static detail \""
, dPtr->name,
"\""
, NULL);
return
TCL_ERROR;
}
return
QE_UninstallDetail(bindingTable, eiPtr->type, dPtr->code);
}
if
(!eiPtr->dynamic)
{
Tcl_AppendResult(bindPtr->interp,
"can't uninstall static event \""
, eiPtr->name,
"\""
, NULL);
return
TCL_ERROR;
}
return
QE_UninstallEvent(bindingTable, eiPtr->type);
}
static
int
QE_UninstallCmd_Old(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
static
CONST
char
*commandOption[] = {
"detail"
,
"event"
, NULL};
int
index;
if
(objC < 2)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 1, objv,
"option arg ..."
);
return
TCL_ERROR;
}
if
(Tcl_GetIndexFromObj(bindPtr->interp, objV[1],
commandOption,
"option"
, 0, &index) != TCL_OK)
{
return
TCL_ERROR;
}
switch
(index)
{
case
0:
{
char
*eventName, *detailName;
Detail *dPtr;
EventInfo *eiPtr;
Tcl_HashEntry *hPtr;
if
(objC != 4)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 2, objv,
"event detail"
);
return
TCL_ERROR;
}
eventName = Tcl_GetStringFromObj(objV[2], NULL);
hPtr = Tcl_FindHashEntry(&bindPtr->eventTableByName, eventName);
if
(hPtr == NULL)
{
Tcl_AppendResult(bindPtr->interp,
"unknown event \""
,
eventName,
"\""
, NULL);
return
TCL_ERROR;
}
eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
detailName = Tcl_GetStringFromObj(objV[3], NULL);
for
(dPtr = eiPtr->detailList;
dPtr != NULL;
dPtr = dPtr->next)
{
if
(
strcmp
(dPtr->name, detailName) == 0)
break
;
}
if
(dPtr == NULL)
{
Tcl_AppendResult(bindPtr->interp,
"unknown detail \""
, detailName,
"\" for event \""
,
eiPtr->name,
"\""
, NULL);
return
TCL_ERROR;
}
if
(!dPtr->dynamic)
{
Tcl_AppendResult(bindPtr->interp,
"can't uninstall static detail \""
, detailName,
"\""
, NULL);
return
TCL_ERROR;
}
return
QE_UninstallDetail(bindingTable, eiPtr->type, dPtr->code);
}
case
1:
{
Tcl_HashEntry *hPtr;
EventInfo *eiPtr;
char
*eventName;
if
(objC != 3)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 2, objv,
"name"
);
return
TCL_ERROR;
}
eventName = Tcl_GetStringFromObj(objV[2], NULL);
hPtr = Tcl_FindHashEntry(&bindPtr->eventTableByName, eventName);
if
(hPtr == NULL)
{
Tcl_AppendResult(bindPtr->interp,
"unknown event \""
,
eventName,
"\""
, NULL);
return
TCL_ERROR;
}
eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
if
(!eiPtr->dynamic)
{
Tcl_AppendResult(bindPtr->interp,
"can't uninstall static event \""
, eventName,
"\""
, NULL);
return
TCL_ERROR;
}
return
QE_UninstallEvent(bindingTable, eiPtr->type);
}
}
return
TCL_OK;
}
int
QE_UninstallCmd(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
char
*s;
int
length;
if
(objC < 2)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 1, objv,
"pattern"
);
return
TCL_ERROR;
}
s = Tcl_GetStringFromObj(objV[1], &length);
if
(length && (!
strcmp
(s,
"detail"
) || !
strcmp
(s,
"event"
)))
return
QE_UninstallCmd_Old(bindingTable, objOffset, objc, objv);
return
QE_UninstallCmd_New(bindingTable, objOffset, objc, objv);
}
static
int
QE_LinkageCmd_New(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
char
*pattern;
Pattern pats;
EventInfo *eiPtr;
Detail *dPtr;
if
(objC != 2)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 1, objv,
"pattern"
);
return
TCL_ERROR;
}
pattern = Tcl_GetString(objV[1]);
if
(ParseEventDescription(bindPtr, pattern, &pats, &eiPtr, &dPtr) != TCL_OK)
return
TCL_ERROR;
if
(dPtr != NULL)
{
Tcl_SetResult(bindPtr->interp, dPtr->dynamic ?
"dynamic"
:
"static"
,
TCL_STATIC);
return
TCL_OK;
}
Tcl_SetResult(bindPtr->interp, eiPtr->dynamic ?
"dynamic"
:
"static"
,
TCL_STATIC);
return
TCL_OK;
}
static
int
QE_LinkageCmd_Old(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
char
*eventName, *detailName;
Detail *dPtr;
EventInfo *eiPtr;
Tcl_HashEntry *hPtr;
if
(objC < 2 || objC > 3)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 1, objv,
"event ?detail?"
);
return
TCL_ERROR;
}
eventName = Tcl_GetStringFromObj(objV[1], NULL);
hPtr = Tcl_FindHashEntry(&bindPtr->eventTableByName, eventName);
if
(hPtr == NULL)
{
Tcl_AppendResult(bindPtr->interp,
"unknown event \""
,
eventName,
"\""
, NULL);
return
TCL_ERROR;
}
eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
if
(objC == 2)
{
Tcl_SetResult(bindPtr->interp, eiPtr->dynamic ?
"dynamic"
:
"static"
,
TCL_STATIC);
return
TCL_OK;
}
detailName = Tcl_GetStringFromObj(objV[2], NULL);
for
(dPtr = eiPtr->detailList;
dPtr != NULL;
dPtr = dPtr->next)
{
if
(
strcmp
(dPtr->name, detailName) == 0)
break
;
}
if
(dPtr == NULL)
{
Tcl_AppendResult(bindPtr->interp,
"unknown detail \""
, detailName,
"\" for event \""
,
eiPtr->name,
"\""
, NULL);
return
TCL_ERROR;
}
Tcl_SetResult(bindPtr->interp, dPtr->dynamic ?
"dynamic"
:
"static"
,
TCL_STATIC);
return
TCL_OK;
}
int
QE_LinkageCmd(QE_BindingTable bindingTable,
int
objOffset,
int
objc,
Tcl_Obj *CONST objv[])
{
int
objC = objc - objOffset;
Tcl_Obj *CONST *objV = objv + objOffset;
BindingTable *bindPtr = (BindingTable *) bindingTable;
char
*s;
int
length;
if
(objC < 2)
{
Tcl_WrongNumArgs(bindPtr->interp, objOffset + 1, objv,
"pattern"
);
return
TCL_ERROR;
}
s = Tcl_GetStringFromObj(objV[1], &length);
if
((objC == 3) || (length && s[0] !=
'<'
))
return
QE_LinkageCmd_Old(bindingTable, objOffset, objc, objv);
return
QE_LinkageCmd_New(bindingTable, objOffset, objc, objv);
}
#endif /* ALLOW_INSTALL */