From c0eda27e6633bfc5790cbb82bb8684a4a3d13abf Mon Sep 17 00:00:00 2001 From: mdejong Date: Mon, 14 Apr 2003 23:34:38 +0000 Subject: * generic/tkBind.c (TkpGetBindingXEvent): Add helper method that can be used to query the XEvent* for the currently executing binding. * generic/tkInt.h: Declare TkpGetBindingXEvent. * win/tkWinMenu.c (MenuKeyBindProc, TkWinMenuKeyObjCmd, TkpInitializeMenuBindings): Rename MenuKeyBindProc to TkWinMenuKeyObjCmd and convert it into a Tcl command named tk::tkWinMenuKey. Bind keyboard accelerator actions to this Tcl command instead of using a native C binding. This makes it possible to extend the existing binding with Tcl code and makes the Windows version work just like the unix version. --- ChangeLog | 15 +++++++ generic/tkBind.c | 30 ++++++++++++- generic/tkInt.h | 4 +- win/tkWinMenu.c | 132 ++++++++++++++++++++++++++++++++++++++++--------------- 4 files changed, 143 insertions(+), 38 deletions(-) diff --git a/ChangeLog b/ChangeLog index 072e1df..30be20e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,18 @@ +2003-04-14 Mo DeJong + + * generic/tkBind.c (TkpGetBindingXEvent): Add helper method + that can be used to query the XEvent* for the currently + executing binding. + * generic/tkInt.h: Declare TkpGetBindingXEvent. + * win/tkWinMenu.c (MenuKeyBindProc, TkWinMenuKeyObjCmd, + TkpInitializeMenuBindings): Rename MenuKeyBindProc to + TkWinMenuKeyObjCmd and convert it into a Tcl command + named tk::tkWinMenuKey. Bind keyboard accelerator + actions to this Tcl command instead of using a native + C binding. This makes it possible to extend the + existing binding with Tcl code and makes the Windows + version work just like the unix version. + 2003-04-04 Mo DeJong * unix/Makefile.in: Subst TCL_LIBS instead of diff --git a/generic/tkBind.c b/generic/tkBind.c index d77718a..7f6fc04 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkBind.c,v 1.28 2003/02/28 15:55:33 dkf Exp $ + * RCS: @(#) $Id: tkBind.c,v 1.29 2003/04/14 23:34:41 mdejong Exp $ */ #include "tkPort.h" @@ -4675,5 +4675,31 @@ TkCopyAndGlobalEval(interp, script) Tcl_DStringFree(&buffer); return code; } + +/* + *---------------------------------------------------------------------- + * + * TkpGetBindingXEvent -- + * + * This procedure returns the XEvent associated with the + * currently executing binding. This procedure can only + * be invoked while a binding is executing. + * + * Results: + * Returns a pointer to the XEvent that caused the + * current binding code to be run. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ - +XEvent * +TkpGetBindingXEvent(interp) + Tcl_Interp *interp; /* Interpreter. */ +{ + TkWindow *winPtr = (TkWindow *) Tk_MainWindow(interp); + BindingTable *bindPtr = (BindingTable *) winPtr->mainPtr->bindingTable; + return &(bindPtr->eventRing[bindPtr->curEvent]); +} diff --git a/generic/tkInt.h b/generic/tkInt.h index 2723d41..6bd0f12 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: $Id: tkInt.h,v 1.56 2003/02/18 06:22:44 mdejong Exp $ + * RCS: $Id: tkInt.h,v 1.57 2003/04/14 23:34:41 mdejong Exp $ */ #ifndef _TKINT @@ -1166,6 +1166,8 @@ EXTERN char * TkTilePrintProc _ANSI_ARGS_(( ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)); +EXTERN XEvent * TkpGetBindingXEvent _ANSI_ARGS_(( + Tcl_Interp *interp)); /* * Unsupported commands. diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c index ff2d557..295a71e 100644 --- a/win/tkWinMenu.c +++ b/win/tkWinMenu.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinMenu.c,v 1.21 2002/08/08 01:42:57 hobbs Exp $ + * RCS: @(#) $Id: tkWinMenu.c,v 1.22 2003/04/14 23:34:50 mdejong Exp $ */ #define OEMRESOURCE @@ -147,10 +147,9 @@ static void GetTearoffEntryGeometry _ANSI_ARGS_((TkMenu *menuPtr, int *heightPtr)); static int GetNewID _ANSI_ARGS_((TkMenuEntry *mePtr, int *menuIDPtr)); -static int MenuKeyBindProc _ANSI_ARGS_(( - ClientData clientData, - Tcl_Interp *interp, XEvent *eventPtr, - Tk_Window tkwin, KeySym keySym)); +static int TkWinMenuKeyObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static void MenuSelectEvent _ANSI_ARGS_((TkMenu *menuPtr)); static void ReconfigureWindowsMenu _ANSI_ARGS_(( ClientData clientData)); @@ -1740,11 +1739,12 @@ DrawMenuUnderline( /* *-------------------------------------------------------------- * - * MenuKeyBindProc -- + * TkWinMenuKeyObjCmd -- * * This procedure is invoked when keys related to pulling * down menus is pressed. The corresponding Windows events * are generated and passed to DefWindowProc if appropriate. + * This cmd is registered as tk::tkWinMenuKey in the interp. * * Results: * Always returns TCL_OK. @@ -1757,18 +1757,44 @@ DrawMenuUnderline( */ static int -MenuKeyBindProc(clientData, interp, eventPtr, tkwin, keySym) - ClientData clientData; /* not used in this proc */ - Tcl_Interp *interp; /* The interpreter of the receiving window. */ - XEvent *eventPtr; /* The XEvent to process */ - Tk_Window tkwin; /* The window receiving the event */ - KeySym keySym; /* The key sym that is produced. */ +TkWinMenuKeyObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Unused. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { UINT scanCode; UINT virtualKey; - TkWindow *winPtr = (TkWindow *)tkwin; + XEvent *eventPtr; + Tk_Window tkwin; + TkWindow *winPtr; + KeySym keySym; int i; + if (objc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + Tcl_GetString(objv[0]), + " window keySym\"", (char *) NULL); + return TCL_ERROR; + } + + eventPtr = TkpGetBindingXEvent(interp); + + tkwin = Tk_NameToWindow(interp, + Tcl_GetString(objv[1]), + Tk_MainWindow(interp)); + + if (tkwin == NULL) { + return TCL_ERROR; + } + + winPtr = (TkWindow *)tkwin; + + if (Tcl_GetIntFromObj(interp, objv[2], &i) != TCL_OK) { + return TCL_ERROR; + } + keySym = i; + if (eventPtr->type == KeyPress) { switch (keySym) { case XK_Alt_L: @@ -1837,7 +1863,7 @@ MenuKeyBindProc(clientData, interp, eventPtr, tkwin, keySym) } } return TCL_OK; -} +} /* *-------------------------------------------------------------- @@ -1851,7 +1877,7 @@ MenuKeyBindProc(clientData, interp, eventPtr, tkwin, keySym) * None. * * Side effects: - * C-level bindings are setup for the interp which will + * bindings are setup for the interp which will * handle Alt-key sequences for menus without beeping * or interfering with user-defined Alt-key bindings. * @@ -1867,27 +1893,63 @@ TkpInitializeMenuBindings(interp, bindingTable) /* * We need to set up the bindings for menubars. These have to - * recreate windows events, so we need to have a C-level - * binding for this. We have to generate the WM_SYSKEYDOWNS - * and WM_SYSKEYUPs appropriately. + * recreate windows events, so we need to invoke C code to + * generate the WM_SYSKEYDOWNS and WM_SYSKEYUPs appropriately. + * Trick is, we can't create a C level binding directly since + * we may want to modify the binding in Tcl code. */ - - TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid, - "", MenuKeyBindProc, NULL, NULL); - TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid, - "", MenuKeyBindProc, NULL, NULL); - TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid, - "", MenuKeyBindProc, NULL, NULL); - TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid, - "", MenuKeyBindProc, NULL, NULL); - TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid, - "", MenuKeyBindProc, NULL, NULL); - TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid, - "", MenuKeyBindProc, NULL, NULL); - TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid, - "", MenuKeyBindProc, NULL, NULL); - TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid, - "", MenuKeyBindProc, NULL, NULL); + + (void) Tcl_CreateObjCommand(interp, "tk::tkWinMenuKey", + TkWinMenuKeyObjCmd, + (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + + (void) Tk_CreateBinding(interp, bindingTable, + (ClientData) uid, + "", + "tk::tkWinMenuKey %W %N", + 0); + + (void) Tk_CreateBinding(interp, bindingTable, + (ClientData) uid, + "", + "tk::tkWinMenuKey %W %N", + 0); + + (void) Tk_CreateBinding(interp, bindingTable, + (ClientData) uid, + "", + "tk::tkWinMenuKey %W %N", + 0); + + (void) Tk_CreateBinding(interp, bindingTable, + (ClientData) uid, + "", + "tk::tkWinMenuKey %W %N", + 0); + + (void) Tk_CreateBinding(interp, bindingTable, + (ClientData) uid, + "", + "tk::tkWinMenuKey %W %N", + 0); + + (void) Tk_CreateBinding(interp, bindingTable, + (ClientData) uid, + "", + "tk::tkWinMenuKey %W %N", + 0); + + (void) Tk_CreateBinding(interp, bindingTable, + (ClientData) uid, + "", + "tk::tkWinMenuKey %W %N", + 0); + + (void) Tk_CreateBinding(interp, bindingTable, + (ClientData) uid, + "", + "tk::tkWinMenuKey %W %N", + 0); } /* -- cgit v0.12