Parent Directory
| 
Revision Log
| 
Patch
| projs/trunk/shared_source/tk_base/tkmenu.c revision 42 by dashley, Fri Oct 14 01:50:00 2016 UTC | projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkmenu.c revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC | |
|---|---|---|
| # | Line 1 | Line 1 |
| /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkmenu.c,v 1.1.1.1 2001/06/13 05:05:37 dtashley Exp $ */ | ||
| /* | ||
| * tkMenu.c -- | ||
| * | ||
| * This file contains most of the code for implementing menus in Tk. It takes | ||
| * care of all of the generic (platform-independent) parts of menus, and | ||
| * is supplemented by platform-specific files. The geometry calculation | ||
| * and drawing code for menus is in the file tkMenuDraw.c | ||
| * | ||
| * Copyright (c) 1990-1994 The Regents of the University of California. | ||
| * Copyright (c) 1994-1998 Sun Microsystems, Inc. | ||
| * | ||
| * See the file "license.terms" for information on usage and redistribution | ||
| * of this file, and for a DISCLAIMER OF ALL WARRANTIES. | ||
| * | ||
| * RCS: @(#) $Id: tkmenu.c,v 1.1.1.1 2001/06/13 05:05:37 dtashley Exp $ | ||
| */ | ||
| /* | ||
| * Notes on implementation of menus: | ||
| * | ||
| * Menus can be used in three ways: | ||
| * - as a popup menu, either as part of a menubutton or standalone. | ||
| * - as a menubar. The menu's cascade items are arranged according to | ||
| * the specific platform to provide the user access to the menus at all | ||
| * times | ||
| * - as a tearoff palette. This is a window with the menu's items in it. | ||
| * | ||
| * The goal is to provide the Tk developer with a way to use a common | ||
| * set of menus for all of these tasks. | ||
| * | ||
| * In order to make the bindings for cascade menus work properly under Unix, | ||
| * the cascade menus' pathnames must be proper children of the menu that | ||
| * they are cascade from. So if there is a menu .m, and it has two | ||
| * cascades labelled "File" and "Edit", the cascade menus might have | ||
| * the pathnames .m.file and .m.edit. Another constraint is that the menus | ||
| * used for menubars must be children of the toplevel widget that they | ||
| * are attached to. And on the Macintosh, the platform specific menu handle | ||
| * for cascades attached to a menu bar must have a title that matches the | ||
| * label for the cascade menu. | ||
| * | ||
| * To handle all of the constraints, Tk menubars and tearoff menus are | ||
| * implemented using menu clones. Menu clones are full menus in their own | ||
| * right; they have a Tk window and pathname associated with them; they have | ||
| * a TkMenu structure and array of entries. However, they are linked with the | ||
| * original menu that they were cloned from. The reflect the attributes of | ||
| * the original, or "master", menu. So if an item is added to a menu, and | ||
| * that menu has clones, then the item must be added to all of its clones | ||
| * also. Menus are cloned when a menu is torn-off or when a menu is assigned | ||
| * as a menubar using the "-menu" option of the toplevel's pathname configure | ||
| * subcommand. When a clone is destroyed, only the clone is destroyed, but | ||
| * when the master menu is destroyed, all clones are also destroyed. This | ||
| * allows the developer to just deal with one set of menus when creating | ||
| * and destroying. | ||
| * | ||
| * Clones are rather tricky when a menu with cascade entries is cloned (such | ||
| * as a menubar). Not only does the menu have to be cloned, but each cascade | ||
| * entry's corresponding menu must also be cloned. This maintains the pathname | ||
| * parent-child hierarchy necessary for menubars and toplevels to work. | ||
| * This leads to several special cases: | ||
| * | ||
| * 1. When a new menu is created, and it is pointed to by cascade entries in | ||
| * cloned menus, the new menu has to be cloned to parallel the cascade | ||
| * structure. | ||
| * 2. When a cascade item is added to a menu that has been cloned, and the | ||
| * menu that the cascade item points to exists, that menu has to be cloned. | ||
| * 3. When the menu that a cascade entry points to is changed, the old | ||
| * cloned cascade menu has to be discarded, and the new one has to be cloned. | ||
| * | ||
| */ | ||
| #if 0 | ||
| /* | ||
| * used only to test for old config code | ||
| */ | ||
| #define __NO_OLD_CONFIG | ||
| #endif | ||
| #include "tkPort.h" | ||
| #include "tkMenu.h" | ||
| #define MENU_HASH_KEY "tkMenus" | ||
| typedef struct ThreadSpecificData { | ||
| int menusInitialized; /* Flag indicates whether thread-specific | ||
| * elements of the Windows Menu module | ||
| * have been initialized. */ | ||
| } ThreadSpecificData; | ||
| static Tcl_ThreadDataKey dataKey; | ||
| /* | ||
| * The following flag indicates whether the process-wide state for | ||
| * the Menu module has been intialized. The Mutex protects access to | ||
| * that flag. | ||
| */ | ||
| static int menusInitialized; | ||
| TCL_DECLARE_MUTEX(menuMutex) | ||
| /* | ||
| * Configuration specs for individual menu entries. If this changes, be sure | ||
| * to update code in TkpMenuInit that changes the font string entry. | ||
| */ | ||
| char *tkMenuStateStrings[] = {"active", "normal", "disabled", (char *) NULL}; | ||
| static char *menuEntryTypeStrings[] = {"cascade", "checkbutton", "command", | ||
| "radiobutton", "separator", (char *) NULL}; | ||
| Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = { | ||
| {TK_OPTION_BORDER, "-activebackground", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorderPtr), -1, | ||
| TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_COLOR, "-activeforeground", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_ACTIVE_FG, | ||
| Tk_Offset(TkMenuEntry, activeFgPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_STRING, "-accelerator", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_ACCELERATOR, | ||
| Tk_Offset(TkMenuEntry, accelPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_BG, | ||
| Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_BITMAP, "-bitmap", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_BITMAP, | ||
| Tk_Offset(TkMenuEntry, bitmapPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_COLUMN_BREAK, | ||
| -1, Tk_Offset(TkMenuEntry, columnBreak)}, | ||
| {TK_OPTION_STRING, "-command", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_COMMAND, | ||
| Tk_Offset(TkMenuEntry, commandPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_FONT, "-font", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_FONT, | ||
| Tk_Offset(TkMenuEntry, fontPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_COLOR, "-foreground", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_FG, | ||
| Tk_Offset(TkMenuEntry, fgPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_HIDE_MARGIN, | ||
| -1, Tk_Offset(TkMenuEntry, hideMargin)}, | ||
| {TK_OPTION_STRING, "-image", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_IMAGE, | ||
| Tk_Offset(TkMenuEntry, imagePtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_STRING, "-label", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_LABEL, | ||
| Tk_Offset(TkMenuEntry, labelPtr), -1, 0}, | ||
| {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_STATE, | ||
| -1, Tk_Offset(TkMenuEntry, state), 0, | ||
| (ClientData) tkMenuStateStrings}, | ||
| {TK_OPTION_INT, "-underline", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_UNDERLINE, -1, Tk_Offset(TkMenuEntry, underline)}, | ||
| {TK_OPTION_END} | ||
| }; | ||
| Tk_OptionSpec tkSeparatorEntryConfigSpecs[] = { | ||
| {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_BG, | ||
| Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_END} | ||
| }; | ||
| Tk_OptionSpec tkCheckButtonEntryConfigSpecs[] = { | ||
| {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_INDICATOR, | ||
| -1, Tk_Offset(TkMenuEntry, indicatorOn)}, | ||
| {TK_OPTION_STRING, "-offvalue", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_OFF_VALUE, | ||
| Tk_Offset(TkMenuEntry, offValuePtr), -1}, | ||
| {TK_OPTION_STRING, "-onvalue", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_ON_VALUE, | ||
| Tk_Offset(TkMenuEntry, onValuePtr), -1}, | ||
| {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_SELECT, | ||
| Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_SELECT_IMAGE, | ||
| Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_CHECK_VARIABLE, | ||
| Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, | ||
| (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs} | ||
| }; | ||
| Tk_OptionSpec tkRadioButtonEntryConfigSpecs[] = { | ||
| {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_INDICATOR, | ||
| -1, Tk_Offset(TkMenuEntry, indicatorOn)}, | ||
| {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_SELECT, | ||
| Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_SELECT_IMAGE, | ||
| Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_STRING, "-value", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_VALUE, | ||
| Tk_Offset(TkMenuEntry, onValuePtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_RADIO_VARIABLE, | ||
| Tk_Offset(TkMenuEntry, namePtr), -1, 0}, | ||
| {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, | ||
| (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs} | ||
| }; | ||
| Tk_OptionSpec tkCascadeEntryConfigSpecs[] = { | ||
| {TK_OPTION_STRING, "-menu", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_MENU, | ||
| Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, | ||
| (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs} | ||
| }; | ||
| Tk_OptionSpec tkTearoffEntryConfigSpecs[] = { | ||
| {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_BG, | ||
| Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL, | ||
| DEF_MENU_ENTRY_STATE, -1, Tk_Offset(TkMenuEntry, state), 0, | ||
| (ClientData) tkMenuStateStrings}, | ||
| {TK_OPTION_END} | ||
| }; | ||
| static Tk_OptionSpec *specsArray[] = { | ||
| tkCascadeEntryConfigSpecs, tkCheckButtonEntryConfigSpecs, | ||
| tkBasicMenuEntryConfigSpecs, tkRadioButtonEntryConfigSpecs, | ||
| tkSeparatorEntryConfigSpecs, tkTearoffEntryConfigSpecs}; | ||
| /* | ||
| * Menu type strings for use with Tcl_GetIndexFromObj. | ||
| */ | ||
| static char *menuTypeStrings[] = {"normal", "tearoff", "menubar", | ||
| (char *) NULL}; | ||
| Tk_OptionSpec tkMenuConfigSpecs[] = { | ||
| {TK_OPTION_BORDER, "-activebackground", "activeBackground", | ||
| "Foreground", DEF_MENU_ACTIVE_BG_COLOR, | ||
| Tk_Offset(TkMenu, activeBorderPtr), -1, 0, | ||
| (ClientData) DEF_MENU_ACTIVE_BG_MONO}, | ||
| {TK_OPTION_PIXELS, "-activeborderwidth", "activeBorderWidth", | ||
| "BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH, | ||
| Tk_Offset(TkMenu, activeBorderWidthPtr), -1}, | ||
| {TK_OPTION_COLOR, "-activeforeground", "activeForeground", | ||
| "Background", DEF_MENU_ACTIVE_FG_COLOR, | ||
| Tk_Offset(TkMenu, activeFgPtr), -1, 0, | ||
| (ClientData) DEF_MENU_ACTIVE_FG_MONO}, | ||
| {TK_OPTION_BORDER, "-background", "background", "Background", | ||
| DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, borderPtr), -1, 0, | ||
| (ClientData) DEF_MENU_BG_MONO}, | ||
| {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, | ||
| (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"}, | ||
| {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, | ||
| (char *) NULL, 0, -1, 0, (ClientData) "-background"}, | ||
| {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", | ||
| DEF_MENU_BORDER_WIDTH, | ||
| Tk_Offset(TkMenu, borderWidthPtr), -1, 0}, | ||
| {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", | ||
| DEF_MENU_CURSOR, | ||
| Tk_Offset(TkMenu, cursorPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground", | ||
| "DisabledForeground", DEF_MENU_DISABLED_FG_COLOR, | ||
| Tk_Offset(TkMenu, disabledFgPtr), -1, TK_OPTION_NULL_OK, | ||
| (ClientData) DEF_MENU_DISABLED_FG_MONO}, | ||
| {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL, | ||
| (char *) NULL, 0, -1, 0, (ClientData) "-foreground"}, | ||
| {TK_OPTION_FONT, "-font", "font", "Font", | ||
| DEF_MENU_FONT, Tk_Offset(TkMenu, fontPtr), -1}, | ||
| {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", | ||
| DEF_MENU_FG, Tk_Offset(TkMenu, fgPtr), -1}, | ||
| {TK_OPTION_STRING, "-postcommand", "postCommand", "Command", | ||
| DEF_MENU_POST_COMMAND, | ||
| Tk_Offset(TkMenu, postCommandPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_RELIEF, "-relief", "relief", "Relief", | ||
| DEF_MENU_RELIEF, Tk_Offset(TkMenu, reliefPtr), -1}, | ||
| {TK_OPTION_COLOR, "-selectcolor", "selectColor", "Background", | ||
| DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFgPtr), -1, 0, | ||
| (ClientData) DEF_MENU_SELECT_MONO}, | ||
| {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", | ||
| DEF_MENU_TAKE_FOCUS, | ||
| Tk_Offset(TkMenu, takeFocusPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_BOOLEAN, "-tearoff", "tearOff", "TearOff", | ||
| DEF_MENU_TEAROFF, -1, Tk_Offset(TkMenu, tearoff)}, | ||
| {TK_OPTION_STRING, "-tearoffcommand", "tearOffCommand", | ||
| "TearOffCommand", DEF_MENU_TEAROFF_CMD, | ||
| Tk_Offset(TkMenu, tearoffCommandPtr), -1, TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_STRING, "-title", "title", "Title", | ||
| DEF_MENU_TITLE, Tk_Offset(TkMenu, titlePtr), -1, | ||
| TK_OPTION_NULL_OK}, | ||
| {TK_OPTION_STRING_TABLE, "-type", "type", "Type", | ||
| DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypePtr), -1, TK_OPTION_NULL_OK, | ||
| (ClientData) menuTypeStrings}, | ||
| {TK_OPTION_END} | ||
| }; | ||
| /* | ||
| * Command line options. Put here because MenuCmd has to look at them | ||
| * along with MenuWidgetObjCmd. | ||
| */ | ||
| static char *menuOptions[] = { | ||
| "activate", "add", "cget", "clone", "configure", "delete", "entrycget", | ||
| "entryconfigure", "index", "insert", "invoke", "post", "postcascade", | ||
| "type", "unpost", "yposition", (char *) NULL | ||
| }; | ||
| enum options { | ||
| MENU_ACTIVATE, MENU_ADD, MENU_CGET, MENU_CLONE, MENU_CONFIGURE, | ||
| MENU_DELETE, MENU_ENTRYCGET, MENU_ENTRYCONFIGURE, MENU_INDEX, | ||
| MENU_INSERT, MENU_INVOKE, MENU_POST, MENU_POSTCASCADE, MENU_TYPE, | ||
| MENU_UNPOST, MENU_YPOSITION | ||
| }; | ||
| /* | ||
| * Prototypes for static procedures in this file: | ||
| */ | ||
| static int CloneMenu _ANSI_ARGS_((TkMenu *menuPtr, | ||
| Tcl_Obj *newMenuName, Tcl_Obj *newMenuTypeString)); | ||
| static int ConfigureMenu _ANSI_ARGS_((Tcl_Interp *interp, | ||
| TkMenu *menuPtr, int objc, Tcl_Obj *CONST objv[])); | ||
| static int ConfigureMenuCloneEntries _ANSI_ARGS_(( | ||
| Tcl_Interp *interp, TkMenu *menuPtr, int index, | ||
| int objc, Tcl_Obj *CONST objv[])); | ||
| static int ConfigureMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr, | ||
| int objc, Tcl_Obj *CONST objv[])); | ||
| static void DeleteMenuCloneEntries _ANSI_ARGS_((TkMenu *menuPtr, | ||
| int first, int last)); | ||
| static void DestroyMenuHashTable _ANSI_ARGS_(( | ||
| ClientData clientData, Tcl_Interp *interp)); | ||
| static void DestroyMenuInstance _ANSI_ARGS_((TkMenu *menuPtr)); | ||
| static void DestroyMenuEntry _ANSI_ARGS_((char *memPtr)); | ||
| static int GetIndexFromCoords | ||
| _ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuPtr, | ||
| char *string, int *indexPtr)); | ||
| static int MenuDoYPosition _ANSI_ARGS_((Tcl_Interp *interp, | ||
| TkMenu *menuPtr, Tcl_Obj *objPtr)); | ||
| static int MenuAddOrInsert _ANSI_ARGS_((Tcl_Interp *interp, | ||
| TkMenu *menuPtr, Tcl_Obj *indexPtr, int objc, | ||
| Tcl_Obj *CONST objv[])); | ||
| static int MenuCmd _ANSI_ARGS_((ClientData clientData, | ||
| Tcl_Interp *interp, int objc, | ||
| Tcl_Obj *CONST objv[])); | ||
| static void MenuCmdDeletedProc _ANSI_ARGS_(( | ||
| ClientData clientData)); | ||
| static TkMenuEntry * MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index, | ||
| int type)); | ||
| static char * MenuVarProc _ANSI_ARGS_((ClientData clientData, | ||
| Tcl_Interp *interp, char *name1, char *name2, | ||
| int flags)); | ||
| static int MenuWidgetObjCmd _ANSI_ARGS_((ClientData clientData, | ||
| Tcl_Interp *interp, int objc, | ||
| Tcl_Obj *CONST objv[])); | ||
| static void MenuWorldChanged _ANSI_ARGS_(( | ||
| ClientData instanceData)); | ||
| static int PostProcessEntry _ANSI_ARGS_((TkMenuEntry *mePtr)); | ||
| static void RecursivelyDeleteMenu _ANSI_ARGS_((TkMenu *menuPtr)); | ||
| static void UnhookCascadeEntry _ANSI_ARGS_((TkMenuEntry *mePtr)); | ||
| /* | ||
| * The structure below is a list of procs that respond to certain window | ||
| * manager events. One of these includes a font change, which forces | ||
| * the geometry proc to be called. | ||
| */ | ||
| static TkClassProcs menuClass = { | ||
| NULL, /* createProc. */ | ||
| MenuWorldChanged /* geometryProc. */ | ||
| }; | ||
| /* | ||
| *-------------------------------------------------------------- | ||
| * | ||
| * Tk_CreateMenuCmd -- | ||
| * | ||
| * Called by Tk at initialization time to create the menu | ||
| * command. | ||
| * | ||
| * Results: | ||
| * A standard Tcl result. | ||
| * | ||
| * Side effects: | ||
| * See the user documentation. | ||
| * | ||
| *-------------------------------------------------------------- | ||
| */ | ||
| int | ||
| TkCreateMenuCmd(interp) | ||
| Tcl_Interp *interp; /* Interpreter we are creating the | ||
| * command in. */ | ||
| { | ||
| TkMenuOptionTables *optionTablesPtr = | ||
| (TkMenuOptionTables *) ckalloc(sizeof(TkMenuOptionTables)); | ||
| optionTablesPtr->menuOptionTable = | ||
| Tk_CreateOptionTable(interp, tkMenuConfigSpecs); | ||
| optionTablesPtr->entryOptionTables[TEAROFF_ENTRY] = | ||
| Tk_CreateOptionTable(interp, specsArray[TEAROFF_ENTRY]); | ||
| optionTablesPtr->entryOptionTables[COMMAND_ENTRY] = | ||
| Tk_CreateOptionTable(interp, specsArray[COMMAND_ENTRY]); | ||
| optionTablesPtr->entryOptionTables[CASCADE_ENTRY] = | ||
| Tk_CreateOptionTable(interp, specsArray[CASCADE_ENTRY]); | ||
| optionTablesPtr->entryOptionTables[SEPARATOR_ENTRY] = | ||
| Tk_CreateOptionTable(interp, specsArray[SEPARATOR_ENTRY]); | ||
| optionTablesPtr->entryOptionTables[RADIO_BUTTON_ENTRY] = | ||
| Tk_CreateOptionTable(interp, specsArray[RADIO_BUTTON_ENTRY]); | ||
| optionTablesPtr->entryOptionTables[CHECK_BUTTON_ENTRY] = | ||
| Tk_CreateOptionTable(interp, specsArray[CHECK_BUTTON_ENTRY]); | ||
| Tcl_CreateObjCommand(interp, "menu", MenuCmd, | ||
| (ClientData) optionTablesPtr, NULL); | ||
| if (Tcl_IsSafe(interp)) { | ||
| Tcl_HideCommand(interp, "menu", "menu"); | ||
| } | ||
| return TCL_OK; | ||
| } | ||
| /* | ||
| *-------------------------------------------------------------- | ||
| * | ||
| * MenuCmd -- | ||
| * | ||
| * This procedure is invoked to process the "menu" Tcl | ||
| * command. See the user documentation for details on | ||
| * what it does. | ||
| * | ||
| * Results: | ||
| * A standard Tcl result. | ||
| * | ||
| * Side effects: | ||
| * See the user documentation. | ||
| * | ||
| *-------------------------------------------------------------- | ||
| */ | ||
| static int | ||
| MenuCmd(clientData, interp, objc, objv) | ||
| ClientData clientData; /* Main window associated with | ||
| * interpreter. */ | ||
| Tcl_Interp *interp; /* Current interpreter. */ | ||
| int objc; /* Number of arguments. */ | ||
| Tcl_Obj *CONST objv[]; /* Argument strings. */ | ||
| { | ||
| Tk_Window tkwin = Tk_MainWindow(interp); | ||
| Tk_Window new; | ||
| register TkMenu *menuPtr; | ||
| TkMenuReferences *menuRefPtr; | ||
| int i, index; | ||
| int toplevel; | ||
| char *windowName; | ||
| static char *typeStringList[] = {"-type", (char *) NULL}; | ||
| TkMenuOptionTables *optionTablesPtr = (TkMenuOptionTables *) clientData; | ||
| if (objc < 2) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); | ||
| return TCL_ERROR; | ||
| } | ||
| TkMenuInit(); | ||
| toplevel = 1; | ||
| for (i = 2; i < (objc - 1); i++) { | ||
| if (Tcl_GetIndexFromObj(NULL, objv[i], typeStringList, NULL, 0, &index) | ||
| != TCL_ERROR) { | ||
| if ((Tcl_GetIndexFromObj(NULL, objv[i + 1], menuTypeStrings, NULL, | ||
| 0, &index) == TCL_OK) && (index == MENUBAR)) { | ||
| toplevel = 0; | ||
| } | ||
| break; | ||
| } | ||
| } | ||
| windowName = Tcl_GetStringFromObj(objv[1], NULL); | ||
| new = Tk_CreateWindowFromPath(interp, tkwin, windowName, toplevel ? "" | ||
| : NULL); | ||
| if (new == NULL) { | ||
| return TCL_ERROR; | ||
| } | ||
| /* | ||
| * Initialize the data structure for the menu. | ||
| */ | ||
| menuPtr = (TkMenu *) ckalloc(sizeof(TkMenu)); | ||
| menuPtr->tkwin = new; | ||
| menuPtr->display = Tk_Display(new); | ||
| menuPtr->interp = interp; | ||
| menuPtr->widgetCmd = Tcl_CreateObjCommand(interp, | ||
| Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd, | ||
| (ClientData) menuPtr, MenuCmdDeletedProc); | ||
| menuPtr->entries = NULL; | ||
| menuPtr->numEntries = 0; | ||
| menuPtr->active = -1; | ||
| menuPtr->borderPtr = NULL; | ||
| menuPtr->borderWidthPtr = NULL; | ||
| menuPtr->reliefPtr = NULL; | ||
| menuPtr->activeBorderPtr = NULL; | ||
| menuPtr->activeBorderWidthPtr = NULL; | ||
| menuPtr->fontPtr = NULL; | ||
| menuPtr->fgPtr = NULL; | ||
| menuPtr->disabledFgPtr = NULL; | ||
| menuPtr->activeFgPtr = NULL; | ||
| menuPtr->indicatorFgPtr = NULL; | ||
| menuPtr->tearoff = 0; | ||
| menuPtr->tearoffCommandPtr = NULL; | ||
| menuPtr->cursorPtr = None; | ||
| menuPtr->takeFocusPtr = NULL; | ||
| menuPtr->postCommandPtr = NULL; | ||
| menuPtr->postCommandGeneration = 0; | ||
| menuPtr->postedCascade = NULL; | ||
| menuPtr->nextInstancePtr = NULL; | ||
| menuPtr->masterMenuPtr = menuPtr; | ||
| menuPtr->menuType = UNKNOWN_TYPE; | ||
| menuPtr->menuFlags = 0; | ||
| menuPtr->parentTopLevelPtr = NULL; | ||
| menuPtr->menuTypePtr = NULL; | ||
| menuPtr->titlePtr = NULL; | ||
| menuPtr->errorStructPtr = NULL; | ||
| menuPtr->optionTablesPtr = optionTablesPtr; | ||
| TkMenuInitializeDrawingFields(menuPtr); | ||
| Tk_SetClass(menuPtr->tkwin, "Menu"); | ||
| TkSetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr); | ||
| if (Tk_InitOptions(interp, (char *) menuPtr, | ||
| menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin) | ||
| != TCL_OK) { | ||
| Tk_DestroyWindow(menuPtr->tkwin); | ||
| ckfree((char *) menuPtr); | ||
| return TCL_ERROR; | ||
| } | ||
| menuRefPtr = TkCreateMenuReferences(menuPtr->interp, | ||
| Tk_PathName(menuPtr->tkwin)); | ||
| menuRefPtr->menuPtr = menuPtr; | ||
| menuPtr->menuRefPtr = menuRefPtr; | ||
| if (TCL_OK != TkpNewMenu(menuPtr)) { | ||
| Tk_DestroyWindow(menuPtr->tkwin); | ||
| ckfree((char *) menuPtr); | ||
| return TCL_ERROR; | ||
| } | ||
| Tk_CreateEventHandler(new, ExposureMask|StructureNotifyMask|ActivateMask, | ||
| TkMenuEventProc, (ClientData) menuPtr); | ||
| if (ConfigureMenu(interp, menuPtr, objc - 2, objv + 2) != TCL_OK) { | ||
| Tk_DestroyWindow(menuPtr->tkwin); | ||
| return TCL_ERROR; | ||
| } | ||
| /* | ||
| * If a menu has a parent menu pointing to it as a cascade entry, the | ||
| * parent menu needs to be told that this menu now exists so that | ||
| * the platform-part of the menu is correctly updated. | ||
| * | ||
| * If a menu has an instance and has cascade entries, then each cascade | ||
| * menu must also have a parallel instance. This is especially true on | ||
| * the Mac, where each menu has to have a separate title everytime it is in | ||
| * a menubar. For instance, say you have a menu .m1 with a cascade entry | ||
| * for .m2, where .m2 does not exist yet. You then put .m1 into a menubar. | ||
| * This creates a menubar instance for .m1, but since .m2 is not there, | ||
| * nothing else happens. When we go to create .m2, we hook it up properly | ||
| * with .m1. However, we now need to clone .m2 and assign the clone of .m2 | ||
| * to be the cascade entry for the clone of .m1. This is special case | ||
| * #1 listed in the introductory comment. | ||
| */ | ||
| if (menuRefPtr->parentEntryPtr != NULL) { | ||
| TkMenuEntry *cascadeListPtr = menuRefPtr->parentEntryPtr; | ||
| TkMenuEntry *nextCascadePtr; | ||
| Tcl_Obj *newMenuName; | ||
| Tcl_Obj *newObjv[2]; | ||
| while (cascadeListPtr != NULL) { | ||
| nextCascadePtr = cascadeListPtr->nextCascadePtr; | ||
| /* | ||
| * If we have a new master menu, and an existing cloned menu | ||
| * points to this menu in a cascade entry, we have to clone | ||
| * the new menu and point the entry to the clone instead | ||
| * of the menu we are creating. Otherwise, ConfigureMenuEntry | ||
| * will hook up the platform-specific cascade linkages now | ||
| * that the menu we are creating exists. | ||
| */ | ||
| if ((menuPtr->masterMenuPtr != menuPtr) | ||
| || ((menuPtr->masterMenuPtr == menuPtr) | ||
| && ((cascadeListPtr->menuPtr->masterMenuPtr | ||
| == cascadeListPtr->menuPtr)))) { | ||
| newObjv[0] = Tcl_NewStringObj("-menu", -1); | ||
| newObjv[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1); | ||
| Tcl_IncrRefCount(newObjv[0]); | ||
| Tcl_IncrRefCount(newObjv[1]); | ||
| ConfigureMenuEntry(cascadeListPtr, 2, newObjv); | ||
| Tcl_DecrRefCount(newObjv[0]); | ||
| Tcl_DecrRefCount(newObjv[1]); | ||
| } else { | ||
| Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1); | ||
| Tcl_Obj *windowNamePtr = Tcl_NewStringObj( | ||
| Tk_PathName(cascadeListPtr->menuPtr->tkwin), -1); | ||
| Tcl_IncrRefCount(normalPtr); | ||
| Tcl_IncrRefCount(windowNamePtr); | ||
| newMenuName = TkNewMenuName(menuPtr->interp, | ||
| windowNamePtr, menuPtr); | ||
| Tcl_IncrRefCount(newMenuName); | ||
| CloneMenu(menuPtr, newMenuName, normalPtr); | ||
| /* | ||
| * Now we can set the new menu instance to be the cascade entry | ||
| * of the parent's instance. | ||
| */ | ||
| newObjv[0] = Tcl_NewStringObj("-menu", -1); | ||
| newObjv[1] = newMenuName; | ||
| Tcl_IncrRefCount(newObjv[0]); | ||
| ConfigureMenuEntry(cascadeListPtr, 2, newObjv); | ||
| Tcl_DecrRefCount(normalPtr); | ||
| Tcl_DecrRefCount(newObjv[0]); | ||
| Tcl_DecrRefCount(newObjv[1]); | ||
| Tcl_DecrRefCount(windowNamePtr); | ||
| } | ||
| cascadeListPtr = nextCascadePtr; | ||
| } | ||
| } | ||
| /* | ||
| * If there already exist toplevel widgets that refer to this menu, | ||
| * find them and notify them so that they can reconfigure their | ||
| * geometry to reflect the menu. | ||
| */ | ||
| if (menuRefPtr->topLevelListPtr != NULL) { | ||
| TkMenuTopLevelList *topLevelListPtr = menuRefPtr->topLevelListPtr; | ||
| TkMenuTopLevelList *nextPtr; | ||
| Tk_Window listtkwin; | ||
| while (topLevelListPtr != NULL) { | ||
| /* | ||
| * Need to get the next pointer first. TkSetWindowMenuBar | ||
| * changes the list, so that the next pointer is different | ||
| * after calling it. | ||
| */ | ||
| nextPtr = topLevelListPtr->nextPtr; | ||
| listtkwin = topLevelListPtr->tkwin; | ||
| TkSetWindowMenuBar(menuPtr->interp, listtkwin, | ||
| Tk_PathName(menuPtr->tkwin), Tk_PathName(menuPtr->tkwin)); | ||
| topLevelListPtr = nextPtr; | ||
| } | ||
| } | ||
| Tcl_SetResult(interp, Tk_PathName(menuPtr->tkwin), TCL_STATIC); | ||
| return TCL_OK; | ||
| } | ||
| /* | ||
| *-------------------------------------------------------------- | ||
| * | ||
| * MenuWidgetObjCmd -- | ||
| * | ||
| * This procedure is invoked to process the Tcl command | ||
| * that corresponds to a widget managed by this module. | ||
| * See the user documentation for details on what it does. | ||
| * | ||
| * Results: | ||
| * A standard Tcl result. | ||
| * | ||
| * Side effects: | ||
| * See the user documentation. | ||
| * | ||
| *-------------------------------------------------------------- | ||
| */ | ||
| static int | ||
| MenuWidgetObjCmd(clientData, interp, objc, objv) | ||
| ClientData clientData; /* Information about menu widget. */ | ||
| Tcl_Interp *interp; /* Current interpreter. */ | ||
| int objc; /* Number of arguments. */ | ||
| Tcl_Obj *CONST objv[]; /* Argument strings. */ | ||
| { | ||
| register TkMenu *menuPtr = (TkMenu *) clientData; | ||
| register TkMenuEntry *mePtr; | ||
| int result = TCL_OK; | ||
| int option; | ||
| if (objc < 2) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); | ||
| return TCL_ERROR; | ||
| } | ||
| if (Tcl_GetIndexFromObj(interp, objv[1], menuOptions, "option", 0, | ||
| &option) != TCL_OK) { | ||
| return TCL_ERROR; | ||
| } | ||
| Tcl_Preserve((ClientData) menuPtr); | ||
| switch ((enum options) option) { | ||
| case MENU_ACTIVATE: { | ||
| int index; | ||
| if (objc != 3) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "activate index"); | ||
| goto error; | ||
| } | ||
| if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | ||
| != TCL_OK) { | ||
| goto error; | ||
| } | ||
| if (menuPtr->active == index) { | ||
| goto done; | ||
| } | ||
| if ((index >= 0) | ||
| && ((menuPtr->entries[index]->type == SEPARATOR_ENTRY) | ||
| || (menuPtr->entries[index]->state | ||
| == ENTRY_DISABLED))) { | ||
| index = -1; | ||
| } | ||
| result = TkActivateMenuEntry(menuPtr, index); | ||
| break; | ||
| } | ||
| case MENU_ADD: | ||
| if (objc < 3) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "add type ?options?"); | ||
| goto error; | ||
| } | ||
| if (MenuAddOrInsert(interp, menuPtr, (Tcl_Obj *) NULL, | ||
| objc - 2, objv + 2) != TCL_OK) { | ||
| goto error; | ||
| } | ||
| break; | ||
| case MENU_CGET: { | ||
| Tcl_Obj *resultPtr; | ||
| if (objc != 3) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "cget option"); | ||
| goto error; | ||
| } | ||
| resultPtr = Tk_GetOptionValue(interp, (char *) menuPtr, | ||
| menuPtr->optionTablesPtr->menuOptionTable, objv[2], | ||
| menuPtr->tkwin); | ||
| if (resultPtr == NULL) { | ||
| goto error; | ||
| } | ||
| Tcl_SetObjResult(interp, resultPtr); | ||
| break; | ||
| } | ||
| case MENU_CLONE: | ||
| if ((objc < 3) || (objc > 4)) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, | ||
| "clone newMenuName ?menuType?"); | ||
| goto error; | ||
| } | ||
| result = CloneMenu(menuPtr, objv[2], (objc == 3) ? NULL : objv[3]); | ||
| break; | ||
| case MENU_CONFIGURE: { | ||
| Tcl_Obj *resultPtr; | ||
| if (objc == 2) { | ||
| resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr, | ||
| menuPtr->optionTablesPtr->menuOptionTable, | ||
| (Tcl_Obj *) NULL, menuPtr->tkwin); | ||
| if (resultPtr == NULL) { | ||
| result = TCL_ERROR; | ||
| } else { | ||
| result = TCL_OK; | ||
| Tcl_SetObjResult(interp, resultPtr); | ||
| } | ||
| } else if (objc == 3) { | ||
| resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr, | ||
| menuPtr->optionTablesPtr->menuOptionTable, | ||
| objv[2], menuPtr->tkwin); | ||
| if (resultPtr == NULL) { | ||
| result = TCL_ERROR; | ||
| } else { | ||
| result = TCL_OK; | ||
| Tcl_SetObjResult(interp, resultPtr); | ||
| } | ||
| } else { | ||
| result = ConfigureMenu(interp, menuPtr, objc - 2, objv + 2); | ||
| } | ||
| if (result != TCL_OK) { | ||
| goto error; | ||
| } | ||
| break; | ||
| } | ||
| case MENU_DELETE: { | ||
| int first, last; | ||
| if ((objc != 3) && (objc != 4)) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "delete first ?last?"); | ||
| goto error; | ||
| } | ||
| if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &first) | ||
| != TCL_OK) { | ||
| goto error; | ||
| } | ||
| if (objc == 3) { | ||
| last = first; | ||
| } else { | ||
| if (TkGetMenuIndex(interp, menuPtr, objv[3], 0, &last) | ||
| != TCL_OK) { | ||
| goto error; | ||
| } | ||
| } | ||
| if (menuPtr->tearoff && (first == 0)) { | ||
| /* | ||
| * Sorry, can't delete the tearoff entry; must reconfigure | ||
| * the menu. | ||
| */ | ||
| first = 1; | ||
| } | ||
| if ((first < 0) || (last < first)) { | ||
| goto done; | ||
| } | ||
| DeleteMenuCloneEntries(menuPtr, first, last); | ||
| break; | ||
| } | ||
| case MENU_ENTRYCGET: { | ||
| int index; | ||
| Tcl_Obj *resultPtr; | ||
| if (objc != 4) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "entrycget index option"); | ||
| goto error; | ||
| } | ||
| if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | ||
| != TCL_OK) { | ||
| goto error; | ||
| } | ||
| if (index < 0) { | ||
| goto done; | ||
| } | ||
| mePtr = menuPtr->entries[index]; | ||
| Tcl_Preserve((ClientData) mePtr); | ||
| resultPtr = Tk_GetOptionValue(interp, (char *) mePtr, | ||
| mePtr->optionTable, objv[3], menuPtr->tkwin); | ||
| Tcl_Release((ClientData) mePtr); | ||
| if (resultPtr == NULL) { | ||
| goto error; | ||
| } | ||
| Tcl_SetObjResult(interp, resultPtr); | ||
| break; | ||
| } | ||
| case MENU_ENTRYCONFIGURE: { | ||
| int index; | ||
| Tcl_Obj *resultPtr; | ||
| if (objc < 3) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, | ||
| "entryconfigure index ?option value ...?"); | ||
| goto error; | ||
| } | ||
| if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | ||
| != TCL_OK) { | ||
| goto error; | ||
| } | ||
| if (index < 0) { | ||
| goto done; | ||
| } | ||
| mePtr = menuPtr->entries[index]; | ||
| Tcl_Preserve((ClientData) mePtr); | ||
| if (objc == 3) { | ||
| resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr, | ||
| mePtr->optionTable, (Tcl_Obj *) NULL, menuPtr->tkwin); | ||
| if (resultPtr == NULL) { | ||
| result = TCL_ERROR; | ||
| } else { | ||
| result = TCL_OK; | ||
| Tcl_SetObjResult(interp, resultPtr); | ||
| } | ||
| } else if (objc == 4) { | ||
| resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr, | ||
| mePtr->optionTable, objv[3], menuPtr->tkwin); | ||
| if (resultPtr == NULL) { | ||
| result = TCL_ERROR; | ||
| } else { | ||
| result = TCL_OK; | ||
| Tcl_SetObjResult(interp, resultPtr); | ||
| } | ||
| } else { | ||
| result = ConfigureMenuCloneEntries(interp, menuPtr, index, | ||
| objc - 3, objv + 3); | ||
| } | ||
| Tcl_Release((ClientData) mePtr); | ||
| break; | ||
| } | ||
| case MENU_INDEX: { | ||
| int index; | ||
| if (objc != 3) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "index string"); | ||
| goto error; | ||
| } | ||
| if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | ||
| != TCL_OK) { | ||
| goto error; | ||
| } | ||
| if (index < 0) { | ||
| Tcl_SetResult(interp, "none", TCL_STATIC); | ||
| } else { | ||
| Tcl_SetIntObj(Tcl_GetObjResult(interp), index); | ||
| } | ||
| break; | ||
| } | ||
| case MENU_INSERT: | ||
| if (objc < 4) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, | ||
| "insert index type ?options?"); | ||
| goto error; | ||
| } | ||
| if (MenuAddOrInsert(interp, menuPtr, objv[2], objc - 3, | ||
| objv + 3) != TCL_OK) { | ||
| goto error; | ||
| } | ||
| break; | ||
| case MENU_INVOKE: { | ||
| int index; | ||
| if (objc != 3) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "invoke index"); | ||
| goto error; | ||
| } | ||
| if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | ||
| != TCL_OK) { | ||
| goto error; | ||
| } | ||
| if (index < 0) { | ||
| goto done; | ||
| } | ||
| result = TkInvokeMenu(interp, menuPtr, index); | ||
| break; | ||
| } | ||
| case MENU_POST: { | ||
| int x, y; | ||
| if (objc != 4) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "post x y"); | ||
| goto error; | ||
| } | ||
| if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) | ||
| || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { | ||
| goto error; | ||
| } | ||
| /* | ||
| * Tearoff menus are posted differently on Mac and Windows than | ||
| * non-tearoffs. TkpPostMenu does not actually map the menu's | ||
| * window on those platforms, and popup menus have to be | ||
| * handled specially. | ||
| */ | ||
| if (menuPtr->menuType != TEAROFF_MENU) { | ||
| result = TkpPostMenu(interp, menuPtr, x, y); | ||
| } else { | ||
| result = TkPostTearoffMenu(interp, menuPtr, x, y); | ||
| } | ||
| break; | ||
| } | ||
| case MENU_POSTCASCADE: { | ||
| int index; | ||
| if (objc != 3) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "postcascade index"); | ||
| goto error; | ||
| } | ||
| if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | ||
| != TCL_OK) { | ||
| goto error; | ||
| } | ||
| if ((index < 0) || (menuPtr->entries[index]->type | ||
| != CASCADE_ENTRY)) { | ||
| result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL); | ||
| } else { | ||
| result = TkPostSubmenu(interp, menuPtr, | ||
| menuPtr->entries[index]); | ||
| } | ||
| break; | ||
| } | ||
| case MENU_TYPE: { | ||
| int index; | ||
| if (objc != 3) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "type index"); | ||
| goto error; | ||
| } | ||
| if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | ||
| != TCL_OK) { | ||
| goto error; | ||
| } | ||
| if (index < 0) { | ||
| goto done; | ||
| } | ||
| if (menuPtr->entries[index]->type == TEAROFF_ENTRY) { | ||
| Tcl_SetResult(interp, "tearoff", TCL_STATIC); | ||
| } else { | ||
| Tcl_SetResult(interp, | ||
| menuEntryTypeStrings[menuPtr->entries[index]->type], | ||
| TCL_STATIC); | ||
| } | ||
| break; | ||
| } | ||
| case MENU_UNPOST: | ||
| if (objc != 2) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "unpost"); | ||
| goto error; | ||
| } | ||
| Tk_UnmapWindow(menuPtr->tkwin); | ||
| result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL); | ||
| break; | ||
| case MENU_YPOSITION: | ||
| if (objc != 3) { | ||
| Tcl_WrongNumArgs(interp, 1, objv, "yposition index"); | ||
| goto error; | ||
| } | ||
| result = MenuDoYPosition(interp, menuPtr, objv[2]); | ||
| break; | ||
| } | ||
| done: | ||
| Tcl_Release((ClientData) menuPtr); | ||
| return result; | ||
| error: | ||
| Tcl_Release((ClientData) menuPtr); | ||
| return TCL_ERROR; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * TkInvokeMenu -- | ||
| * | ||
| * Given a menu and an index, takes the appropriate action for the | ||
| * entry associated with that index. | ||
| * | ||
| * Results: | ||
| * Standard Tcl result. | ||
| * | ||
| * Side effects: | ||
| * Commands may get excecuted; variables may get set; sub-menus may | ||
| * get posted. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| int | ||
| TkInvokeMenu(interp, menuPtr, index) | ||
| Tcl_Interp *interp; /* The interp that the menu lives in. */ | ||
| TkMenu *menuPtr; /* The menu we are invoking. */ | ||
| int index; /* The zero based index of the item we | ||
| * are invoking */ | ||
| { | ||
| int result = TCL_OK; | ||
| TkMenuEntry *mePtr; | ||
| if (index < 0) { | ||
| goto done; | ||
| } | ||
| mePtr = menuPtr->entries[index]; | ||
| if (mePtr->state == ENTRY_DISABLED) { | ||
| goto done; | ||
| } | ||
| Tcl_Preserve((ClientData) mePtr); | ||
| if (mePtr->type == TEAROFF_ENTRY) { | ||
| Tcl_DString ds; | ||
| Tcl_DStringInit(&ds); | ||
| Tcl_DStringAppend(&ds, "tkTearOffMenu ", -1); | ||
| Tcl_DStringAppend(&ds, Tk_PathName(menuPtr->tkwin), -1); | ||
| result = Tcl_Eval(interp, Tcl_DStringValue(&ds)); | ||
| Tcl_DStringFree(&ds); | ||
| } else if ((mePtr->type == CHECK_BUTTON_ENTRY) | ||
| && (mePtr->namePtr != NULL)) { | ||
| Tcl_Obj *valuePtr; | ||
| if (mePtr->entryFlags & ENTRY_SELECTED) { | ||
| valuePtr = mePtr->offValuePtr; | ||
| } else { | ||
| valuePtr = mePtr->onValuePtr; | ||
| } | ||
| if (valuePtr == NULL) { | ||
| valuePtr = Tcl_NewObj(); | ||
| } | ||
| Tcl_IncrRefCount(valuePtr); | ||
| if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr, | ||
| TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { | ||
| result = TCL_ERROR; | ||
| } | ||
| Tcl_DecrRefCount(valuePtr); | ||
| } else if ((mePtr->type == RADIO_BUTTON_ENTRY) | ||
| && (mePtr->namePtr != NULL)) { | ||
| Tcl_Obj *valuePtr = mePtr->onValuePtr; | ||
| if (valuePtr == NULL) { | ||
| valuePtr = Tcl_NewObj(); | ||
| } | ||
| Tcl_IncrRefCount(valuePtr); | ||
| if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr, | ||
| TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { | ||
| result = TCL_ERROR; | ||
| } | ||
| Tcl_DecrRefCount(valuePtr); | ||
| } | ||
| if ((result == TCL_OK) && (mePtr->commandPtr != NULL)) { | ||
| Tcl_Obj *commandPtr = mePtr->commandPtr; | ||
| Tcl_IncrRefCount(commandPtr); | ||
| result = Tcl_EvalObjEx(interp, commandPtr, TCL_EVAL_GLOBAL); | ||
| Tcl_DecrRefCount(commandPtr); | ||
| } | ||
| Tcl_Release((ClientData) mePtr); | ||
| done: | ||
| return result; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * DestroyMenuInstance -- | ||
| * | ||
| * This procedure is invoked by TkDestroyMenu | ||
| * to clean up the internal structure of a menu at a safe time | ||
| * (when no-one is using it anymore). Only takes care of one instance | ||
| * of the menu. | ||
| * | ||
| * Results: | ||
| * None. | ||
| * | ||
| * Side effects: | ||
| * Everything associated with the menu is freed up. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static void | ||
| DestroyMenuInstance(menuPtr) | ||
| TkMenu *menuPtr; /* Info about menu widget. */ | ||
| { | ||
| int i; | ||
| TkMenu *menuInstancePtr; | ||
| TkMenuEntry *cascadePtr, *nextCascadePtr; | ||
| Tcl_Obj *newObjv[2]; | ||
| TkMenu *parentMasterMenuPtr; | ||
| TkMenuEntry *parentMasterEntryPtr; | ||
| /* | ||
| * If the menu has any cascade menu entries pointing to it, the cascade | ||
| * entries need to be told that the menu is going away. We need to clear | ||
| * the menu ptr field in the menu reference at this point in the code | ||
| * so that everything else can forget about this menu properly. We also | ||
| * need to reset -menu field of all entries that are not master menus | ||
| * back to this entry name if this is a master menu pointed to by another | ||
| * master menu. If there is a clone menu that points to this menu, | ||
| * then this menu is itself a clone, so when this menu goes away, | ||
| * the -menu field of the pointing entry must be set back to this | ||
| * menu's master menu name so that later if another menu is created | ||
| * the cascade hierarchy can be maintained. | ||
| */ | ||
| TkpDestroyMenu(menuPtr); | ||
| cascadePtr = menuPtr->menuRefPtr->parentEntryPtr; | ||
| menuPtr->menuRefPtr->menuPtr = NULL; | ||
| TkFreeMenuReferences(menuPtr->menuRefPtr); | ||
| for (; cascadePtr != NULL; cascadePtr = nextCascadePtr) { | ||
| nextCascadePtr = cascadePtr->nextCascadePtr; | ||
| if (menuPtr->masterMenuPtr != menuPtr) { | ||
| Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1); | ||
| parentMasterMenuPtr = cascadePtr->menuPtr->masterMenuPtr; | ||
| parentMasterEntryPtr = | ||
| parentMasterMenuPtr->entries[cascadePtr->index]; | ||
| newObjv[0] = menuNamePtr; | ||
| newObjv[1] = parentMasterEntryPtr->namePtr; | ||
| /* | ||
| * It is possible that the menu info is out of sync, and | ||
| * these things point to NULL, so verify existence [Bug: 3402] | ||
| */ | ||
| if (newObjv[0] && newObjv[1]) { | ||
| Tcl_IncrRefCount(newObjv[0]); | ||
| Tcl_IncrRefCount(newObjv[1]); | ||
| ConfigureMenuEntry(cascadePtr, 2, newObjv); | ||
| Tcl_DecrRefCount(newObjv[0]); | ||
| Tcl_DecrRefCount(newObjv[1]); | ||
| } | ||
| } else { | ||
| ConfigureMenuEntry(cascadePtr, 0, (Tcl_Obj **) NULL); | ||
| } | ||
| } | ||
| if (menuPtr->masterMenuPtr != menuPtr) { | ||
| for (menuInstancePtr = menuPtr->masterMenuPtr; | ||
| menuInstancePtr != NULL; | ||
| menuInstancePtr = menuInstancePtr->nextInstancePtr) { | ||
| if (menuInstancePtr->nextInstancePtr == menuPtr) { | ||
| menuInstancePtr->nextInstancePtr = | ||
| menuInstancePtr->nextInstancePtr->nextInstancePtr; | ||
| break; | ||
| } | ||
| } | ||
| } else if (menuPtr->nextInstancePtr != NULL) { | ||
| panic("Attempting to delete master menu when there are still clones."); | ||
| } | ||
| /* | ||
| * Free up all the stuff that requires special handling, then | ||
| * let Tk_FreeConfigOptions handle all the standard option-related | ||
| * stuff. | ||
| */ | ||
| for (i = menuPtr->numEntries; --i >= 0; ) { | ||
| /* | ||
| * As each menu entry is deleted from the end of the array of | ||
| * entries, decrement menuPtr->numEntries. Otherwise, the act of | ||
| * deleting menu entry i will dereference freed memory attempting | ||
| * to queue a redraw for menu entries (i+1)...numEntries. | ||
| */ | ||
| DestroyMenuEntry((char *) menuPtr->entries[i]); | ||
| menuPtr->numEntries = i; | ||
| } | ||
| if (menuPtr->entries != NULL) { | ||
| ckfree((char *) menuPtr->entries); | ||
| } | ||
| TkMenuFreeDrawOptions(menuPtr); | ||
| Tk_FreeConfigOptions((char *) menuPtr, | ||
| menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin); | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * TkDestroyMenu -- | ||
| * | ||
| * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release | ||
| * to clean up the internal structure of a menu at a safe time | ||
| * (when no-one is using it anymore). If called on a master instance, | ||
| * destroys all of the slave instances. If called on a non-master | ||
| * instance, just destroys that instance. | ||
| * | ||
| * Results: | ||
| * None. | ||
| * | ||
| * Side effects: | ||
| * Everything associated with the menu is freed up. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| void | ||
| TkDestroyMenu(menuPtr) | ||
| TkMenu *menuPtr; /* Info about menu widget. */ | ||
| { | ||
| TkMenu *menuInstancePtr; | ||
| TkMenuTopLevelList *topLevelListPtr, *nextTopLevelPtr; | ||
| if (menuPtr->menuFlags & MENU_DELETION_PENDING) { | ||
| return; | ||
| } | ||
| /* | ||
| * Now destroy all non-tearoff instances of this menu if this is a | ||
| * parent menu. Is this loop safe enough? Are there going to be | ||
| * destroy bindings on child menus which kill the parent? If not, | ||
| * we have to do a slightly more complex scheme. | ||
| */ | ||
| if (menuPtr->masterMenuPtr == menuPtr) { | ||
| menuPtr->menuFlags |= MENU_DELETION_PENDING; | ||
| while (menuPtr->nextInstancePtr != NULL) { | ||
| menuInstancePtr = menuPtr->nextInstancePtr; | ||
| menuPtr->nextInstancePtr = menuInstancePtr->nextInstancePtr; | ||
| if (menuInstancePtr->tkwin != NULL) { | ||
| Tk_DestroyWindow(menuInstancePtr->tkwin); | ||
| } | ||
| } | ||
| menuPtr->menuFlags &= ~MENU_DELETION_PENDING; | ||
| } | ||
| /* | ||
| * If any toplevel widgets have this menu as their menubar, | ||
| * the geometry of the window may have to be recalculated. | ||
| */ | ||
| topLevelListPtr = menuPtr->menuRefPtr->topLevelListPtr; | ||
| while (topLevelListPtr != NULL) { | ||
| nextTopLevelPtr = topLevelListPtr->nextPtr; | ||
| TkpSetWindowMenuBar(topLevelListPtr->tkwin, NULL); | ||
| topLevelListPtr = nextTopLevelPtr; | ||
| } | ||
| DestroyMenuInstance(menuPtr); | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * UnhookCascadeEntry -- | ||
| * | ||
| * This entry is removed from the list of entries that point to the | ||
| * cascade menu. This is done in preparation for changing the menu | ||
| * that this entry points to. | ||
| * | ||
| * Results: | ||
| * None | ||
| * | ||
| * Side effects: | ||
| * The appropriate lists are modified. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static void | ||
| UnhookCascadeEntry(mePtr) | ||
| TkMenuEntry *mePtr; /* The cascade entry we are removing | ||
| * from the cascade list. */ | ||
| { | ||
| TkMenuEntry *cascadeEntryPtr; | ||
| TkMenuEntry *prevCascadePtr; | ||
| TkMenuReferences *menuRefPtr; | ||
| menuRefPtr = mePtr->childMenuRefPtr; | ||
| if (menuRefPtr == NULL) { | ||
| return; | ||
| } | ||
| cascadeEntryPtr = menuRefPtr->parentEntryPtr; | ||
| if (cascadeEntryPtr == NULL) { | ||
| return; | ||
| } | ||
| /* | ||
| * Singularly linked list deletion. The two special cases are | ||
| * 1. one element; 2. The first element is the one we want. | ||
| */ | ||
| if (cascadeEntryPtr == mePtr) { | ||
| if (cascadeEntryPtr->nextCascadePtr == NULL) { | ||
| /* | ||
| * This is the last menu entry which points to this | ||
| * menu, so we need to clear out the list pointer in the | ||
| * cascade itself. | ||
| */ | ||
| menuRefPtr->parentEntryPtr = NULL; | ||
| TkFreeMenuReferences(menuRefPtr); | ||
| } else { | ||
| menuRefPtr->parentEntryPtr = cascadeEntryPtr->nextCascadePtr; | ||
| } | ||
| mePtr->nextCascadePtr = NULL; | ||
| } else { | ||
| for (prevCascadePtr = cascadeEntryPtr, | ||
| cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr; | ||
| cascadeEntryPtr != NULL; | ||
| prevCascadePtr = cascadeEntryPtr, | ||
| cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) { | ||
| if (cascadeEntryPtr == mePtr){ | ||
| prevCascadePtr->nextCascadePtr = | ||
| cascadeEntryPtr->nextCascadePtr; | ||
| cascadeEntryPtr->nextCascadePtr = NULL; | ||
| break; | ||
| } | ||
| } | ||
| } | ||
| mePtr->childMenuRefPtr = NULL; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * DestroyMenuEntry -- | ||
| * | ||
| * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release | ||
| * to clean up the internal structure of a menu entry at a safe time | ||
| * (when no-one is using it anymore). | ||
| * | ||
| * Results: | ||
| * None. | ||
| * | ||
| * Side effects: | ||
| * Everything associated with the menu entry is freed. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static void | ||
| DestroyMenuEntry(memPtr) | ||
| char *memPtr; /* Pointer to entry to be freed. */ | ||
| { | ||
| register TkMenuEntry *mePtr = (TkMenuEntry *) memPtr; | ||
| TkMenu *menuPtr = mePtr->menuPtr; | ||
| if (menuPtr->postedCascade == mePtr) { | ||
| /* | ||
| * Ignore errors while unposting the menu, since it's possible | ||
| * that the menu has already been deleted and the unpost will | ||
| * generate an error. | ||
| */ | ||
| TkPostSubmenu(menuPtr->interp, menuPtr, (TkMenuEntry *) NULL); | ||
| } | ||
| /* | ||
| * Free up all the stuff that requires special handling, then | ||
| * let Tk_FreeConfigOptions handle all the standard option-related | ||
| * stuff. | ||
| */ | ||
| if (mePtr->type == CASCADE_ENTRY) { | ||
| UnhookCascadeEntry(mePtr); | ||
| } | ||
| if (mePtr->image != NULL) { | ||
| Tk_FreeImage(mePtr->image); | ||
| } | ||
| if (mePtr->selectImage != NULL) { | ||
| Tk_FreeImage(mePtr->selectImage); | ||
| } | ||
| if (((mePtr->type == CHECK_BUTTON_ENTRY) | ||
| || (mePtr->type == RADIO_BUTTON_ENTRY)) | ||
| && (mePtr->namePtr != NULL)) { | ||
| char *varName = Tcl_GetStringFromObj(mePtr->namePtr, NULL); | ||
| Tcl_UntraceVar(menuPtr->interp, varName, | ||
| TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, | ||
| MenuVarProc, (ClientData) mePtr); | ||
| } | ||
| TkpDestroyMenuEntry(mePtr); | ||
| TkMenuEntryFreeDrawOptions(mePtr); | ||
| Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, menuPtr->tkwin); | ||
| ckfree((char *) mePtr); | ||
| } | ||
| /* | ||
| *--------------------------------------------------------------------------- | ||
| * | ||
| * MenuWorldChanged -- | ||
| * | ||
| * This procedure is called when the world has changed in some | ||
| * way (such as the fonts in the system changing) and the widget needs | ||
| * to recompute all its graphics contexts and determine its new geometry. | ||
| * | ||
| * Results: | ||
| * None. | ||
| * | ||
| * Side effects: | ||
| * Menu will be relayed out and redisplayed. | ||
| * | ||
| *--------------------------------------------------------------------------- | ||
| */ | ||
| static void | ||
| MenuWorldChanged(instanceData) | ||
| ClientData instanceData; /* Information about widget. */ | ||
| { | ||
| TkMenu *menuPtr = (TkMenu *) instanceData; | ||
| int i; | ||
| TkMenuConfigureDrawOptions(menuPtr); | ||
| for (i = 0; i < menuPtr->numEntries; i++) { | ||
| TkMenuConfigureEntryDrawOptions(menuPtr->entries[i], | ||
| menuPtr->entries[i]->index); | ||
| TkpConfigureMenuEntry(menuPtr->entries[i]); | ||
| } | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * ConfigureMenu -- | ||
| * | ||
| * This procedure is called to process an argv/argc list, plus | ||
| * the Tk option database, in order to configure (or | ||
| * reconfigure) a menu widget. | ||
| * | ||
| * Results: | ||
| * The return value is a standard Tcl result. If TCL_ERROR is | ||
| * returned, then the interp's result contains an error message. | ||
| * | ||
| * Side effects: | ||
| * Configuration information, such as colors, font, etc. get set | ||
| * for menuPtr; old resources get freed, if there were any. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static int | ||
| ConfigureMenu(interp, menuPtr, objc, objv) | ||
| Tcl_Interp *interp; /* Used for error reporting. */ | ||
| register TkMenu *menuPtr; /* Information about widget; may or may | ||
| * not already have values for some fields. */ | ||
| int objc; /* Number of valid entries in argv. */ | ||
| Tcl_Obj *CONST objv[]; /* Arguments. */ | ||
| { | ||
| int i; | ||
| TkMenu *menuListPtr, *cleanupPtr; | ||
| int result; | ||
| for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL; | ||
| menuListPtr = menuListPtr->nextInstancePtr) { | ||
| menuListPtr->errorStructPtr = (Tk_SavedOptions *) | ||
| ckalloc(sizeof(Tk_SavedOptions)); | ||
| result = Tk_SetOptions(interp, (char *) menuListPtr, | ||
| menuListPtr->optionTablesPtr->menuOptionTable, objc, objv, | ||
| menuListPtr->tkwin, menuListPtr->errorStructPtr, (int *) NULL); | ||
| if (result != TCL_OK) { | ||
| for (cleanupPtr = menuPtr->masterMenuPtr; | ||
| cleanupPtr != menuListPtr; | ||
| cleanupPtr = cleanupPtr->nextInstancePtr) { | ||
| Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr); | ||
| ckfree((char *) cleanupPtr->errorStructPtr); | ||
| cleanupPtr->errorStructPtr = NULL; | ||
| } | ||
| return TCL_ERROR; | ||
| } | ||
| /* | ||
| * When a menu is created, the type is in all of the arguments | ||
| * to the menu command. Let Tk_ConfigureWidget take care of | ||
| * parsing them, and then set the type after we can look at | ||
| * the type string. Once set, a menu's type cannot be changed | ||
| */ | ||
| if (menuListPtr->menuType == UNKNOWN_TYPE) { | ||
| Tcl_GetIndexFromObj(NULL, menuListPtr->menuTypePtr, | ||
| menuTypeStrings, NULL, 0, &menuListPtr->menuType); | ||
| /* | ||
| * Configure the new window to be either a pop-up menu | ||
| * or a tear-off menu. | ||
| * We don't do this for menubars since they are not toplevel | ||
| * windows. Also, since this gets called before CloneMenu has | ||
| * a chance to set the menuType field, we have to look at the | ||
| * menuTypeName field to tell that this is a menu bar. | ||
| */ | ||
| if (menuListPtr->menuType == MASTER_MENU) { | ||
| TkpMakeMenuWindow(menuListPtr->tkwin, 1); | ||
| } else if (menuListPtr->menuType == TEAROFF_MENU) { | ||
| TkpMakeMenuWindow(menuListPtr->tkwin, 0); | ||
| } | ||
| } | ||
| /* | ||
| * Depending on the -tearOff option, make sure that there is or | ||
| * isn't an initial tear-off entry at the beginning of the menu. | ||
| */ | ||
| if (menuListPtr->tearoff) { | ||
| if ((menuListPtr->numEntries == 0) | ||
| || (menuListPtr->entries[0]->type != TEAROFF_ENTRY)) { | ||
| if (MenuNewEntry(menuListPtr, 0, TEAROFF_ENTRY) == NULL) { | ||
| if (menuListPtr->errorStructPtr != NULL) { | ||
| for (cleanupPtr = menuPtr->masterMenuPtr; | ||
| cleanupPtr != menuListPtr; | ||
| cleanupPtr = cleanupPtr->nextInstancePtr) { | ||
| Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr); | ||
| ckfree((char *) cleanupPtr->errorStructPtr); | ||
| cleanupPtr->errorStructPtr = NULL; | ||
| } | ||
| Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr); | ||
| ckfree((char *) cleanupPtr->errorStructPtr); | ||
| cleanupPtr->errorStructPtr = NULL; | ||
| } | ||
| return TCL_ERROR; | ||
| } | ||
| } | ||
| } else if ((menuListPtr->numEntries > 0) | ||
| && (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) { | ||
| int i; | ||
| Tcl_EventuallyFree((ClientData) menuListPtr->entries[0], | ||
| DestroyMenuEntry); | ||
| for (i = 0; i < menuListPtr->numEntries - 1; i++) { | ||
| menuListPtr->entries[i] = menuListPtr->entries[i + 1]; | ||
| menuListPtr->entries[i]->index = i; | ||
| } | ||
| menuListPtr->numEntries--; | ||
| if (menuListPtr->numEntries == 0) { | ||
| ckfree((char *) menuListPtr->entries); | ||
| menuListPtr->entries = NULL; | ||
| } | ||
| } | ||
| TkMenuConfigureDrawOptions(menuListPtr); | ||
| /* | ||
| * After reconfiguring a menu, we need to reconfigure all of the | ||
| * entries in the menu, since some of the things in the children | ||
| * (such as graphics contexts) may have to change to reflect changes | ||
| * in the parent. | ||
| */ | ||
| for (i = 0; i < menuListPtr->numEntries; i++) { | ||
| TkMenuEntry *mePtr; | ||
| mePtr = menuListPtr->entries[i]; | ||
| ConfigureMenuEntry(mePtr, 0, (Tcl_Obj **) NULL); | ||
| } | ||
| TkEventuallyRecomputeMenu(menuListPtr); | ||
| } | ||
| for (cleanupPtr = menuPtr->masterMenuPtr; cleanupPtr != NULL; | ||
| cleanupPtr = cleanupPtr->nextInstancePtr) { | ||
| Tk_FreeSavedOptions(cleanupPtr->errorStructPtr); | ||
| ckfree((char *) cleanupPtr->errorStructPtr); | ||
| cleanupPtr->errorStructPtr = NULL; | ||
| } | ||
| return TCL_OK; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * PostProcessEntry -- | ||
| * | ||
| * This is called by ConfigureMenuEntry to do all of the configuration | ||
| * after Tk_SetOptions is called. This is separate | ||
| * so that error handling is easier. | ||
| * | ||
| * Results: | ||
| * The return value is a standard Tcl result. If TCL_ERROR is | ||
| * returned, then the interp's result contains an error message. | ||
| * | ||
| * Side effects: | ||
| * Configuration information such as label and accelerator get | ||
| * set for mePtr; old resources get freed, if there were any. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static int | ||
| PostProcessEntry(mePtr) | ||
| TkMenuEntry *mePtr; /* The entry we are configuring. */ | ||
| { | ||
| TkMenu *menuPtr = mePtr->menuPtr; | ||
| int index = mePtr->index; | ||
| char *name; | ||
| Tk_Image image; | ||
| /* | ||
| * The code below handles special configuration stuff not taken | ||
| * care of by Tk_ConfigureWidget, such as special processing for | ||
| * defaults, sizing strings, graphics contexts, etc. | ||
| */ | ||
| if (mePtr->labelPtr == NULL) { | ||
| mePtr->labelLength = 0; | ||
| } else { | ||
| Tcl_GetStringFromObj(mePtr->labelPtr, &mePtr->labelLength); | ||
| } | ||
| if (mePtr->accelPtr == NULL) { | ||
| mePtr->accelLength = 0; | ||
| } else { | ||
| Tcl_GetStringFromObj(mePtr->accelPtr, &mePtr->accelLength); | ||
| } | ||
| /* | ||
| * If this is a cascade entry, the platform-specific data of the child | ||
| * menu has to be updated. Also, the links that point to parents and | ||
| * cascades have to be updated. | ||
| */ | ||
| if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) { | ||
| TkMenuEntry *cascadeEntryPtr; | ||
| int alreadyThere; | ||
| TkMenuReferences *menuRefPtr; | ||
| char *oldHashKey = NULL; /* Initialization only needed to | ||
| * prevent compiler warning. */ | ||
| /* | ||
| * This is a cascade entry. If the menu that the cascade entry | ||
| * is pointing to has changed, we need to remove this entry | ||
| * from the list of entries pointing to the old menu, and add a | ||
| * cascade reference to the list of entries pointing to the | ||
| * new menu. | ||
| * | ||
| * BUG: We are not recloning for special case #3 yet. | ||
| */ | ||
| name = Tcl_GetStringFromObj(mePtr->namePtr, NULL); | ||
| if (mePtr->childMenuRefPtr != NULL) { | ||
| oldHashKey = Tcl_GetHashKey(TkGetMenuHashTable(menuPtr->interp), | ||
| mePtr->childMenuRefPtr->hashEntryPtr); | ||
| if (strcmp(oldHashKey, name) != 0) { | ||
| UnhookCascadeEntry(mePtr); | ||
| } | ||
| } | ||
| if ((mePtr->childMenuRefPtr == NULL) | ||
| || (strcmp(oldHashKey, name) != 0)) { | ||
| menuRefPtr = TkCreateMenuReferences(menuPtr->interp, name); | ||
| mePtr->childMenuRefPtr = menuRefPtr; | ||
| if (menuRefPtr->parentEntryPtr == NULL) { | ||
| menuRefPtr->parentEntryPtr = mePtr; | ||
| } else { | ||
| alreadyThere = 0; | ||
| for (cascadeEntryPtr = menuRefPtr->parentEntryPtr; | ||
| cascadeEntryPtr != NULL; | ||
| cascadeEntryPtr = | ||
| cascadeEntryPtr->nextCascadePtr) { | ||
| if (cascadeEntryPtr == mePtr) { | ||
| alreadyThere = 1; | ||
| break; | ||
| } | ||
| } | ||
| /* | ||
| * Put the item at the front of the list. | ||
| */ | ||
| if (!alreadyThere) { | ||
| mePtr->nextCascadePtr = menuRefPtr->parentEntryPtr; | ||
| menuRefPtr->parentEntryPtr = mePtr; | ||
| } | ||
| } | ||
| } | ||
| } | ||
| if (TkMenuConfigureEntryDrawOptions(mePtr, index) != TCL_OK) { | ||
| return TCL_ERROR; | ||
| } | ||
| if (TkpConfigureMenuEntry(mePtr) != TCL_OK) { | ||
| return TCL_ERROR; | ||
| } | ||
| /* | ||
| * Get the images for the entry, if there are any. Allocate the | ||
| * new images before freeing the old ones, so that the reference | ||
| * counts don't go to zero and cause image data to be discarded. | ||
| */ | ||
| if (mePtr->imagePtr != NULL) { | ||
| char *imageString = Tcl_GetStringFromObj(mePtr->imagePtr, NULL); | ||
| image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, imageString, | ||
| TkMenuImageProc, (ClientData) mePtr); | ||
| if (image == NULL) { | ||
| return TCL_ERROR; | ||
| } | ||
| } else { | ||
| image = NULL; | ||
| } | ||
| if (mePtr->image != NULL) { | ||
| Tk_FreeImage(mePtr->image); | ||
| } | ||
| mePtr->image = image; | ||
| if (mePtr->selectImagePtr != NULL) { | ||
| char *selectImageString = Tcl_GetStringFromObj( | ||
| mePtr->selectImagePtr, NULL); | ||
| image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, selectImageString, | ||
| TkMenuSelectImageProc, (ClientData) mePtr); | ||
| if (image == NULL) { | ||
| return TCL_ERROR; | ||
| } | ||
| } else { | ||
| image = NULL; | ||
| } | ||
| if (mePtr->selectImage != NULL) { | ||
| Tk_FreeImage(mePtr->selectImage); | ||
| } | ||
| mePtr->selectImage = image; | ||
| if ((mePtr->type == CHECK_BUTTON_ENTRY) | ||
| || (mePtr->type == RADIO_BUTTON_ENTRY)) { | ||
| Tcl_Obj *valuePtr; | ||
| char *name; | ||
| if (mePtr->namePtr == NULL) { | ||
| if (mePtr->labelPtr == NULL) { | ||
| mePtr->namePtr = NULL; | ||
| } else { | ||
| mePtr->namePtr = Tcl_DuplicateObj(mePtr->labelPtr); | ||
| Tcl_IncrRefCount(mePtr->namePtr); | ||
| } | ||
| } | ||
| if (mePtr->onValuePtr == NULL) { | ||
| if (mePtr->labelPtr == NULL) { | ||
| mePtr->onValuePtr = NULL; | ||
| } else { | ||
| mePtr->onValuePtr = Tcl_DuplicateObj(mePtr->labelPtr); | ||
| Tcl_IncrRefCount(mePtr->onValuePtr); | ||
| } | ||
| } | ||
| /* | ||
| * Select the entry if the associated variable has the | ||
| * appropriate value, initialize the variable if it doesn't | ||
| * exist, then set a trace on the variable to monitor future | ||
| * changes to its value. | ||
| */ | ||
| if (mePtr->namePtr != NULL) { | ||
| valuePtr = Tcl_ObjGetVar2(menuPtr->interp, mePtr->namePtr, NULL, | ||
| TCL_GLOBAL_ONLY); | ||
| } else { | ||
| valuePtr = NULL; | ||
| } | ||
| mePtr->entryFlags &= ~ENTRY_SELECTED; | ||
| if (valuePtr != NULL) { | ||
| if (mePtr->onValuePtr != NULL) { | ||
| char *value = Tcl_GetStringFromObj(valuePtr, NULL); | ||
| char *onValue = Tcl_GetStringFromObj(mePtr->onValuePtr, | ||
| NULL); | ||
| if (strcmp(value, onValue) == 0) { | ||
| mePtr->entryFlags |= ENTRY_SELECTED; | ||
| } | ||
| } | ||
| } else { | ||
| if (mePtr->namePtr != NULL) { | ||
| Tcl_ObjSetVar2(menuPtr->interp, mePtr->namePtr, NULL, | ||
| (mePtr->type == CHECK_BUTTON_ENTRY) | ||
| ? mePtr->offValuePtr | ||
| : Tcl_NewObj(), | ||
| TCL_GLOBAL_ONLY); | ||
| } | ||
| } | ||
| if (mePtr->namePtr != NULL) { | ||
| name = Tcl_GetStringFromObj(mePtr->namePtr, NULL); | ||
| Tcl_TraceVar(menuPtr->interp, name, | ||
| TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, | ||
| MenuVarProc, (ClientData) mePtr); | ||
| } | ||
| } | ||
| return TCL_OK; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * ConfigureMenuEntry -- | ||
| * | ||
| * This procedure is called to process an argv/argc list in order | ||
| * to configure (or reconfigure) one entry in a menu. | ||
| * | ||
| * Results: | ||
| * The return value is a standard Tcl result. If TCL_ERROR is | ||
| * returned, then the interp's result contains an error message. | ||
| * | ||
| * Side effects: | ||
| * Configuration information such as label and accelerator get | ||
| * set for mePtr; old resources get freed, if there were any. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static int | ||
| ConfigureMenuEntry(mePtr, objc, objv) | ||
| register TkMenuEntry *mePtr; /* Information about menu entry; may | ||
| * or may not already have values for | ||
| * some fields. */ | ||
| int objc; /* Number of valid entries in argv. */ | ||
| Tcl_Obj *CONST objv[]; /* Arguments. */ | ||
| { | ||
| TkMenu *menuPtr = mePtr->menuPtr; | ||
| Tk_SavedOptions errorStruct; | ||
| int result; | ||
| /* | ||
| * If this entry is a check button or radio button, then remove | ||
| * its old trace procedure. | ||
| */ | ||
| if ((mePtr->namePtr != NULL) | ||
| && ((mePtr->type == CHECK_BUTTON_ENTRY) | ||
| || (mePtr->type == RADIO_BUTTON_ENTRY))) { | ||
| char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL); | ||
| Tcl_UntraceVar(menuPtr->interp, name, | ||
| TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, | ||
| MenuVarProc, (ClientData) mePtr); | ||
| } | ||
| result = TCL_OK; | ||
| if (menuPtr->tkwin != NULL) { | ||
| if (Tk_SetOptions(menuPtr->interp, (char *) mePtr, | ||
| mePtr->optionTable, objc, objv, menuPtr->tkwin, | ||
| &errorStruct, (int *) NULL) != TCL_OK) { | ||
| return TCL_ERROR; | ||
| } | ||
| result = PostProcessEntry(mePtr); | ||
| if (result != TCL_OK) { | ||
| Tk_RestoreSavedOptions(&errorStruct); | ||
| PostProcessEntry(mePtr); | ||
| } | ||
| Tk_FreeSavedOptions(&errorStruct); | ||
| } | ||
| TkEventuallyRecomputeMenu(menuPtr); | ||
| return result; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * ConfigureMenuCloneEntries -- | ||
| * | ||
| * Calls ConfigureMenuEntry for each menu in the clone chain. | ||
| * | ||
| * Results: | ||
| * The return value is a standard Tcl result. If TCL_ERROR is | ||
| * returned, then the interp's result contains an error message. | ||
| * | ||
| * Side effects: | ||
| * Configuration information such as label and accelerator get | ||
| * set for mePtr; old resources get freed, if there were any. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static int | ||
| ConfigureMenuCloneEntries(interp, menuPtr, index, objc, objv) | ||
| Tcl_Interp *interp; /* Used for error reporting. */ | ||
| TkMenu *menuPtr; /* Information about whole menu. */ | ||
| int index; /* Index of mePtr within menuPtr's | ||
| * entries. */ | ||
| int objc; /* Number of valid entries in argv. */ | ||
| Tcl_Obj *CONST objv[]; /* Arguments. */ | ||
| { | ||
| TkMenuEntry *mePtr; | ||
| TkMenu *menuListPtr; | ||
| int cascadeEntryChanged = 0; | ||
| TkMenuReferences *oldCascadeMenuRefPtr, *cascadeMenuRefPtr = NULL; | ||
| Tcl_Obj *oldCascadePtr = NULL; | ||
| char *newCascadeName; | ||
| /* | ||
| * Cascades are kind of tricky here. This is special case #3 in the comment | ||
| * at the top of this file. Basically, if a menu is the master menu of a | ||
| * clone chain, and has an entry with a cascade menu, the clones of | ||
| * the menu will point to clones of the cascade menu. We have | ||
| * to destroy the clones of the cascades, clone the new cascade | ||
| * menu, and configure the entry to point to the new clone. | ||
| */ | ||
| mePtr = menuPtr->masterMenuPtr->entries[index]; | ||
| if (mePtr->type == CASCADE_ENTRY) { | ||
| oldCascadePtr = mePtr->namePtr; | ||
| if (oldCascadePtr != NULL) { | ||
| Tcl_IncrRefCount(oldCascadePtr); | ||
| } | ||
| } | ||
| if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) { | ||
| return TCL_ERROR; | ||
| } | ||
| if (mePtr->type == CASCADE_ENTRY) { | ||
| char *oldCascadeName; | ||
| if (mePtr->namePtr != NULL) { | ||
| newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL); | ||
| } else { | ||
| newCascadeName = NULL; | ||
| } | ||
| if ((oldCascadePtr == NULL) && (mePtr->namePtr == NULL)) { | ||
| cascadeEntryChanged = 0; | ||
| } else if (((oldCascadePtr == NULL) && (mePtr->namePtr != NULL)) | ||
| || ((oldCascadePtr != NULL) | ||
| && (mePtr->namePtr == NULL))) { | ||
| cascadeEntryChanged = 1; | ||
| } else { | ||
| oldCascadeName = Tcl_GetStringFromObj(oldCascadePtr, | ||
| NULL); | ||
| cascadeEntryChanged = (strcmp(oldCascadeName, newCascadeName) | ||
| == 0); | ||
| } | ||
| if (oldCascadePtr != NULL) { | ||
| Tcl_DecrRefCount(oldCascadePtr); | ||
| } | ||
| } | ||
| if (cascadeEntryChanged) { | ||
| if (mePtr->namePtr != NULL) { | ||
| newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL); | ||
| cascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp, | ||
| newCascadeName); | ||
| } | ||
| } | ||
| for (menuListPtr = menuPtr->masterMenuPtr->nextInstancePtr; | ||
| menuListPtr != NULL; | ||
| menuListPtr = menuListPtr->nextInstancePtr) { | ||
| mePtr = menuListPtr->entries[index]; | ||
| if (cascadeEntryChanged && (mePtr->namePtr != NULL)) { | ||
| oldCascadeMenuRefPtr = TkFindMenuReferencesObj(menuPtr->interp, | ||
| mePtr->namePtr); | ||
| if ((oldCascadeMenuRefPtr != NULL) | ||
| && (oldCascadeMenuRefPtr->menuPtr != NULL)) { | ||
| RecursivelyDeleteMenu(oldCascadeMenuRefPtr->menuPtr); | ||
| } | ||
| } | ||
| if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) { | ||
| return TCL_ERROR; | ||
| } | ||
| if (cascadeEntryChanged && (mePtr->namePtr != NULL)) { | ||
| if (cascadeMenuRefPtr->menuPtr != NULL) { | ||
| Tcl_Obj *newObjv[2]; | ||
| Tcl_Obj *newCloneNamePtr; | ||
| Tcl_Obj *pathNamePtr = Tcl_NewStringObj( | ||
| Tk_PathName(menuListPtr->tkwin), -1); | ||
| Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1); | ||
| Tcl_Obj *menuObjPtr = Tcl_NewStringObj("-menu", -1); | ||
| Tcl_IncrRefCount(pathNamePtr); | ||
| newCloneNamePtr = TkNewMenuName(menuPtr->interp, | ||
| pathNamePtr, | ||
| cascadeMenuRefPtr->menuPtr); | ||
| Tcl_IncrRefCount(newCloneNamePtr); | ||
| Tcl_IncrRefCount(normalPtr); | ||
| CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneNamePtr, | ||
| normalPtr); | ||
| newObjv[0] = menuObjPtr; | ||
| newObjv[1] = newCloneNamePtr; | ||
| Tcl_IncrRefCount(menuObjPtr); | ||
| ConfigureMenuEntry(mePtr, 2, newObjv); | ||
| Tcl_DecrRefCount(newCloneNamePtr); | ||
| Tcl_DecrRefCount(pathNamePtr); | ||
| Tcl_DecrRefCount(normalPtr); | ||
| Tcl_DecrRefCount(menuObjPtr); | ||
| } | ||
| } | ||
| } | ||
| return TCL_OK; | ||
| } | ||
| /* | ||
| *-------------------------------------------------------------- | ||
| * | ||
| * TkGetMenuIndex -- | ||
| * | ||
| * Parse a textual index into a menu and return the numerical | ||
| * index of the indicated entry. | ||
| * | ||
| * Results: | ||
| * A standard Tcl result. If all went well, then *indexPtr is | ||
| * filled in with the entry index corresponding to string | ||
| * (ranges from -1 to the number of entries in the menu minus | ||
| * one). Otherwise an error message is left in the interp's result. | ||
| * | ||
| * Side effects: | ||
| * None. | ||
| * | ||
| *-------------------------------------------------------------- | ||
| */ | ||
| int | ||
| TkGetMenuIndex(interp, menuPtr, objPtr, lastOK, indexPtr) | ||
| Tcl_Interp *interp; /* For error messages. */ | ||
| TkMenu *menuPtr; /* Menu for which the index is being | ||
| * specified. */ | ||
| Tcl_Obj *objPtr; /* Specification of an entry in menu. See | ||
| * manual entry for valid .*/ | ||
| int lastOK; /* Non-zero means its OK to return index | ||
| * just *after* last entry. */ | ||
| int *indexPtr; /* Where to store converted index. */ | ||
| { | ||
| int i; | ||
| char *string = Tcl_GetStringFromObj(objPtr, NULL); | ||
| if ((string[0] == 'a') && (strcmp(string, "active") == 0)) { | ||
| *indexPtr = menuPtr->active; | ||
| goto success; | ||
| } | ||
| if (((string[0] == 'l') && (strcmp(string, "last") == 0)) | ||
| || ((string[0] == 'e') && (strcmp(string, "end") == 0))) { | ||
| *indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1); | ||
| goto success; | ||
| } | ||
| if ((string[0] == 'n') && (strcmp(string, "none") == 0)) { | ||
| *indexPtr = -1; | ||
| goto success; | ||
| } | ||
| if (string[0] == '@') { | ||
| if (GetIndexFromCoords(interp, menuPtr, string, indexPtr) | ||
| == TCL_OK) { | ||
| goto success; | ||
| } | ||
| } | ||
| if (isdigit(UCHAR(string[0]))) { | ||
| if (Tcl_GetInt(interp, string, &i) == TCL_OK) { | ||
| if (i >= menuPtr->numEntries) { | ||
| if (lastOK) { | ||
| i = menuPtr->numEntries; | ||
| } else { | ||
| i = menuPtr->numEntries-1; | ||
| } | ||
| } else if (i < 0) { | ||
| i = -1; | ||
| } | ||
| *indexPtr = i; | ||
| goto success; | ||
| } | ||
| Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); | ||
| } | ||
| for (i = 0; i < menuPtr->numEntries; i++) { | ||
| Tcl_Obj *labelPtr = menuPtr->entries[i]->labelPtr; | ||
| char *label = (labelPtr == NULL) ? NULL | ||
| : Tcl_GetStringFromObj(labelPtr, NULL); | ||
| if ((label != NULL) | ||
| && (Tcl_StringMatch(label, string))) { | ||
| *indexPtr = i; | ||
| goto success; | ||
| } | ||
| } | ||
| Tcl_AppendResult(interp, "bad menu entry index \"", | ||
| string, "\"", (char *) NULL); | ||
| return TCL_ERROR; | ||
| success: | ||
| return TCL_OK; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * MenuCmdDeletedProc -- | ||
| * | ||
| * This procedure is invoked when a widget command is deleted. If | ||
| * the widget isn't already in the process of being destroyed, | ||
| * this command destroys it. | ||
| * | ||
| * Results: | ||
| * None. | ||
| * | ||
| * Side effects: | ||
| * The widget is destroyed. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static void | ||
| MenuCmdDeletedProc(clientData) | ||
| ClientData clientData; /* Pointer to widget record for widget. */ | ||
| { | ||
| TkMenu *menuPtr = (TkMenu *) clientData; | ||
| Tk_Window tkwin = menuPtr->tkwin; | ||
| /* | ||
| * This procedure could be invoked either because the window was | ||
| * destroyed and the command was then deleted (in which case tkwin | ||
| * is NULL) or because the command was deleted, and then this procedure | ||
| * destroys the widget. | ||
| */ | ||
| if (tkwin != NULL) { | ||
| Tk_DestroyWindow(tkwin); | ||
| } | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * MenuNewEntry -- | ||
| * | ||
| * This procedure allocates and initializes a new menu entry. | ||
| * | ||
| * Results: | ||
| * The return value is a pointer to a new menu entry structure, | ||
| * which has been malloc-ed, initialized, and entered into the | ||
| * entry array for the menu. | ||
| * | ||
| * Side effects: | ||
| * Storage gets allocated. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static TkMenuEntry * | ||
| MenuNewEntry(menuPtr, index, type) | ||
| TkMenu *menuPtr; /* Menu that will hold the new entry. */ | ||
| int index; /* Where in the menu the new entry is to | ||
| * go. */ | ||
| int type; /* The type of the new entry. */ | ||
| { | ||
| TkMenuEntry *mePtr; | ||
| TkMenuEntry **newEntries; | ||
| int i; | ||
| /* | ||
| * Create a new array of entries with an empty slot for the | ||
| * new entry. | ||
| */ | ||
| newEntries = (TkMenuEntry **) ckalloc((unsigned) | ||
| ((menuPtr->numEntries+1)*sizeof(TkMenuEntry *))); | ||
| for (i = 0; i < index; i++) { | ||
| newEntries[i] = menuPtr->entries[i]; | ||
| } | ||
| for ( ; i < menuPtr->numEntries; i++) { | ||
| newEntries[i+1] = menuPtr->entries[i]; | ||
| newEntries[i+1]->index = i + 1; | ||
| } | ||
| if (menuPtr->numEntries != 0) { | ||
| ckfree((char *) menuPtr->entries); | ||
| } | ||
| menuPtr->entries = newEntries; | ||
| menuPtr->numEntries++; | ||
| mePtr = (TkMenuEntry *) ckalloc(sizeof(TkMenuEntry)); | ||
| menuPtr->entries[index] = mePtr; | ||
| mePtr->type = type; | ||
| mePtr->optionTable = menuPtr->optionTablesPtr->entryOptionTables[type]; | ||
| mePtr->menuPtr = menuPtr; | ||
| mePtr->labelPtr = NULL; | ||
| mePtr->labelLength = 0; | ||
| mePtr->underline = -1; | ||
| mePtr->bitmapPtr = NULL; | ||
| mePtr->imagePtr = NULL; | ||
| mePtr->image = NULL; | ||
| mePtr->selectImagePtr = NULL; | ||
| mePtr->selectImage = NULL; | ||
| mePtr->accelPtr = NULL; | ||
| mePtr->accelLength = 0; | ||
| mePtr->state = ENTRY_DISABLED; | ||
| mePtr->borderPtr = NULL; | ||
| mePtr->fgPtr = NULL; | ||
| mePtr->activeBorderPtr = NULL; | ||
| mePtr->activeFgPtr = NULL; | ||
| mePtr->fontPtr = NULL; | ||
| mePtr->indicatorOn = 0; | ||
| mePtr->indicatorFgPtr = NULL; | ||
| mePtr->columnBreak = 0; | ||
| mePtr->hideMargin = 0; | ||
| mePtr->commandPtr = NULL; | ||
| mePtr->namePtr = NULL; | ||
| mePtr->childMenuRefPtr = NULL; | ||
| mePtr->onValuePtr = NULL; | ||
| mePtr->offValuePtr = NULL; | ||
| mePtr->entryFlags = 0; | ||
| mePtr->index = index; | ||
| mePtr->nextCascadePtr = NULL; | ||
| if (Tk_InitOptions(menuPtr->interp, (char *) mePtr, | ||
| mePtr->optionTable, menuPtr->tkwin) != TCL_OK) { | ||
| ckfree((char *) mePtr); | ||
| return NULL; | ||
| } | ||
| TkMenuInitializeEntryDrawingFields(mePtr); | ||
| if (TkpMenuNewEntry(mePtr) != TCL_OK) { | ||
| Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, | ||
| menuPtr->tkwin); | ||
| ckfree((char *) mePtr); | ||
| return NULL; | ||
| } | ||
| return mePtr; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * MenuAddOrInsert -- | ||
| * | ||
| * This procedure does all of the work of the "add" and "insert" | ||
| * widget commands, allowing the code for these to be shared. | ||
| * | ||
| * Results: | ||
| * A standard Tcl return value. | ||
| * | ||
| * Side effects: | ||
| * A new menu entry is created in menuPtr. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static int | ||
| MenuAddOrInsert(interp, menuPtr, indexPtr, objc, objv) | ||
| Tcl_Interp *interp; /* Used for error reporting. */ | ||
| TkMenu *menuPtr; /* Widget in which to create new | ||
| * entry. */ | ||
| Tcl_Obj *indexPtr; /* Object describing index at which | ||
| * to insert. NULL means insert at | ||
| * end. */ | ||
| int objc; /* Number of elements in objv. */ | ||
| Tcl_Obj *CONST objv[]; /* Arguments to command: first arg | ||
| * is type of entry, others are | ||
| * config options. */ | ||
| { | ||
| int type, index; | ||
| TkMenuEntry *mePtr; | ||
| TkMenu *menuListPtr; | ||
| if (indexPtr != NULL) { | ||
| if (TkGetMenuIndex(interp, menuPtr, indexPtr, 1, &index) | ||
| != TCL_OK) { | ||
| return TCL_ERROR; | ||
| } | ||
| } else { | ||
| index = menuPtr->numEntries; | ||
| } | ||
| if (index < 0) { | ||
| char *indexString = Tcl_GetStringFromObj(indexPtr, NULL); | ||
| Tcl_AppendResult(interp, "bad index \"", indexString, "\"", | ||
| (char *) NULL); | ||
| return TCL_ERROR; | ||
| } | ||
| if (menuPtr->tearoff && (index == 0)) { | ||
| index = 1; | ||
| } | ||
| /* | ||
| * Figure out the type of the new entry. | ||
| */ | ||
| if (Tcl_GetIndexFromObj(interp, objv[0], menuEntryTypeStrings, | ||
| "menu entry type", 0, &type) != TCL_OK) { | ||
| return TCL_ERROR; | ||
| } | ||
| /* | ||
| * Now we have to add an entry for every instance related to this menu. | ||
| */ | ||
| for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL; | ||
| menuListPtr = menuListPtr->nextInstancePtr) { | ||
| mePtr = MenuNewEntry(menuListPtr, index, type); | ||
| if (mePtr == NULL) { | ||
| return TCL_ERROR; | ||
| } | ||
| if (ConfigureMenuEntry(mePtr, objc - 1, objv + 1) != TCL_OK) { | ||
| TkMenu *errorMenuPtr; | ||
| int i; | ||
| for (errorMenuPtr = menuPtr->masterMenuPtr; | ||
| errorMenuPtr != NULL; | ||
| errorMenuPtr = errorMenuPtr->nextInstancePtr) { | ||
| Tcl_EventuallyFree((ClientData) errorMenuPtr->entries[index], | ||
| DestroyMenuEntry); | ||
| for (i = index; i < errorMenuPtr->numEntries - 1; i++) { | ||
| errorMenuPtr->entries[i] = errorMenuPtr->entries[i + 1]; | ||
| errorMenuPtr->entries[i]->index = i; | ||
| } | ||
| errorMenuPtr->numEntries--; | ||
| if (errorMenuPtr->numEntries == 0) { | ||
| ckfree((char *) errorMenuPtr->entries); | ||
| errorMenuPtr->entries = NULL; | ||
| } | ||
| if (errorMenuPtr == menuListPtr) { | ||
| break; | ||
| } | ||
| } | ||
| return TCL_ERROR; | ||
| } | ||
| /* | ||
| * If a menu has cascades, then every instance of the menu has | ||
| * to have its own parallel cascade structure. So adding an | ||
| * entry to a menu with clones means that the menu that the | ||
| * entry points to has to be cloned for every clone the | ||
| * master menu has. This is special case #2 in the comment | ||
| * at the top of this file. | ||
| */ | ||
| if ((menuPtr != menuListPtr) && (type == CASCADE_ENTRY)) { | ||
| if ((mePtr->namePtr != NULL) | ||
| && (mePtr->childMenuRefPtr != NULL) | ||
| && (mePtr->childMenuRefPtr->menuPtr != NULL)) { | ||
| TkMenu *cascadeMenuPtr = | ||
| mePtr->childMenuRefPtr->menuPtr->masterMenuPtr; | ||
| Tcl_Obj *newCascadePtr; | ||
| Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1); | ||
| Tcl_Obj *windowNamePtr = | ||
| Tcl_NewStringObj(Tk_PathName(menuListPtr->tkwin), -1); | ||
| Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1); | ||
| Tcl_Obj *newObjv[2]; | ||
| TkMenuReferences *menuRefPtr; | ||
| Tcl_IncrRefCount(windowNamePtr); | ||
| newCascadePtr = TkNewMenuName(menuListPtr->interp, | ||
| windowNamePtr, cascadeMenuPtr); | ||
| Tcl_IncrRefCount(newCascadePtr); | ||
| Tcl_IncrRefCount(normalPtr); | ||
| CloneMenu(cascadeMenuPtr, newCascadePtr, normalPtr); | ||
| menuRefPtr = TkFindMenuReferencesObj(menuListPtr->interp, | ||
| newCascadePtr); | ||
| if (menuRefPtr == NULL) { | ||
| panic("CloneMenu failed inside of MenuAddOrInsert."); | ||
| } | ||
| newObjv[0] = menuNamePtr; | ||
| newObjv[1] = newCascadePtr; | ||
| Tcl_IncrRefCount(menuNamePtr); | ||
| Tcl_IncrRefCount(newCascadePtr); | ||
| ConfigureMenuEntry(mePtr, 2, newObjv); | ||
| Tcl_DecrRefCount(newCascadePtr); | ||
| Tcl_DecrRefCount(menuNamePtr); | ||
| Tcl_DecrRefCount(windowNamePtr); | ||
| Tcl_DecrRefCount(normalPtr); | ||
| } | ||
| } | ||
| } | ||
| return TCL_OK; | ||
| } | ||
| /* | ||
| *-------------------------------------------------------------- | ||
| * | ||
| * MenuVarProc -- | ||
| * | ||
| * This procedure is invoked when someone changes the | ||
| * state variable associated with a radiobutton or checkbutton | ||
| * menu entry. The entry's selected state is set to match | ||
| * the value of the variable. | ||
| * | ||
| * Results: | ||
| * NULL is always returned. | ||
| * | ||
| * Side effects: | ||
| * The menu entry may become selected or deselected. | ||
| * | ||
| *-------------------------------------------------------------- | ||
| */ | ||
| static char * | ||
| MenuVarProc(clientData, interp, name1, name2, flags) | ||
| ClientData clientData; /* Information about menu entry. */ | ||
| Tcl_Interp *interp; /* Interpreter containing variable. */ | ||
| char *name1; /* First part of variable's name. */ | ||
| char *name2; /* Second part of variable's name. */ | ||
| int flags; /* Describes what just happened. */ | ||
| { | ||
| TkMenuEntry *mePtr = (TkMenuEntry *) clientData; | ||
| TkMenu *menuPtr; | ||
| char *value; | ||
| char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL); | ||
| char *onValue; | ||
| menuPtr = mePtr->menuPtr; | ||
| /* | ||
| * If the variable is being unset, then re-establish the | ||
| * trace unless the whole interpreter is going away. | ||
| */ | ||
| if (flags & TCL_TRACE_UNSETS) { | ||
| mePtr->entryFlags &= ~ENTRY_SELECTED; | ||
| if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { | ||
| Tcl_TraceVar(interp, name, | ||
| TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, | ||
| MenuVarProc, clientData); | ||
| } | ||
| TkpConfigureMenuEntry(mePtr); | ||
| TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL); | ||
| return (char *) NULL; | ||
| } | ||
| /* | ||
| * Use the value of the variable to update the selected status of | ||
| * the menu entry. | ||
| */ | ||
| value = Tcl_GetVar(interp, name, TCL_GLOBAL_ONLY); | ||
| if (value == NULL) { | ||
| value = ""; | ||
| } | ||
| if (mePtr->onValuePtr != NULL) { | ||
| onValue = Tcl_GetStringFromObj(mePtr->onValuePtr, NULL); | ||
| if (strcmp(value, onValue) == 0) { | ||
| if (mePtr->entryFlags & ENTRY_SELECTED) { | ||
| return (char *) NULL; | ||
| } | ||
| mePtr->entryFlags |= ENTRY_SELECTED; | ||
| } else if (mePtr->entryFlags & ENTRY_SELECTED) { | ||
| mePtr->entryFlags &= ~ENTRY_SELECTED; | ||
| } else { | ||
| return (char *) NULL; | ||
| } | ||
| } else { | ||
| return (char *) NULL; | ||
| } | ||
| TkpConfigureMenuEntry(mePtr); | ||
| TkEventuallyRedrawMenu(menuPtr, mePtr); | ||
| return (char *) NULL; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * TkActivateMenuEntry -- | ||
| * | ||
| * This procedure is invoked to make a particular menu entry | ||
| * the active one, deactivating any other entry that might | ||
| * currently be active. | ||
| * | ||
| * Results: | ||
| * The return value is a standard Tcl result (errors can occur | ||
| * while posting and unposting submenus). | ||
| * | ||
| * Side effects: | ||
| * Menu entries get redisplayed, and the active entry changes. | ||
| * Submenus may get posted and unposted. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| int | ||
| TkActivateMenuEntry(menuPtr, index) | ||
| register TkMenu *menuPtr; /* Menu in which to activate. */ | ||
| int index; /* Index of entry to activate, or | ||
| * -1 to deactivate all entries. */ | ||
| { | ||
| register TkMenuEntry *mePtr; | ||
| int result = TCL_OK; | ||
| if (menuPtr->active >= 0) { | ||
| mePtr = menuPtr->entries[menuPtr->active]; | ||
| /* | ||
| * Don't change the state unless it's currently active (state | ||
| * might already have been changed to disabled). | ||
| */ | ||
| if (mePtr->state == ENTRY_ACTIVE) { | ||
| mePtr->state = ENTRY_NORMAL; | ||
| } | ||
| TkEventuallyRedrawMenu(menuPtr, menuPtr->entries[menuPtr->active]); | ||
| } | ||
| menuPtr->active = index; | ||
| if (index >= 0) { | ||
| mePtr = menuPtr->entries[index]; | ||
| mePtr->state = ENTRY_ACTIVE; | ||
| TkEventuallyRedrawMenu(menuPtr, mePtr); | ||
| } | ||
| return result; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * TkPostCommand -- | ||
| * | ||
| * Execute the postcommand for the given menu. | ||
| * | ||
| * Results: | ||
| * The return value is a standard Tcl result (errors can occur | ||
| * while the postcommands are being processed). | ||
| * | ||
| * Side effects: | ||
| * Since commands can get executed while this routine is being executed, | ||
| * the entire world can change. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| int | ||
| TkPostCommand(menuPtr) | ||
| TkMenu *menuPtr; | ||
| { | ||
| int result; | ||
| /* | ||
| * If there is a command for the menu, execute it. This | ||
| * may change the size of the menu, so be sure to recompute | ||
| * the menu's geometry if needed. | ||
| */ | ||
| if (menuPtr->postCommandPtr != NULL) { | ||
| Tcl_Obj *postCommandPtr = menuPtr->postCommandPtr; | ||
| Tcl_IncrRefCount(postCommandPtr); | ||
| result = Tcl_EvalObjEx(menuPtr->interp, postCommandPtr, | ||
| TCL_EVAL_GLOBAL); | ||
| Tcl_DecrRefCount(postCommandPtr); | ||
| if (result != TCL_OK) { | ||
| return result; | ||
| } | ||
| TkRecomputeMenu(menuPtr); | ||
| } | ||
| return TCL_OK; | ||
| } | ||
| /* | ||
| *-------------------------------------------------------------- | ||
| * | ||
| * CloneMenu -- | ||
| * | ||
| * Creates a child copy of the menu. It will be inserted into | ||
| * the menu's instance chain. All attributes and entry | ||
| * attributes will be duplicated. | ||
| * | ||
| * Results: | ||
| * A standard Tcl result. | ||
| * | ||
| * Side effects: | ||
| * Allocates storage. After the menu is created, any | ||
| * configuration done with this menu or any related one | ||
| * will be reflected in all of them. | ||
| * | ||
| *-------------------------------------------------------------- | ||
| */ | ||
| static int | ||
| CloneMenu(menuPtr, newMenuNamePtr, newMenuTypePtr) | ||
| TkMenu *menuPtr; /* The menu we are going to clone */ | ||
| Tcl_Obj *newMenuNamePtr; /* The name to give the new menu */ | ||
| Tcl_Obj *newMenuTypePtr; /* What kind of menu is this, a normal menu | ||
| * a menubar, or a tearoff? */ | ||
| { | ||
| int returnResult; | ||
| int menuType, i; | ||
| TkMenuReferences *menuRefPtr; | ||
| Tcl_Obj *menuDupCommandArray[4]; | ||
| if (newMenuTypePtr == NULL) { | ||
| menuType = MASTER_MENU; | ||
| } else { | ||
| if (Tcl_GetIndexFromObj(menuPtr->interp, newMenuTypePtr, | ||
| menuTypeStrings, "menu type", 0, &menuType) != TCL_OK) { | ||
| return TCL_ERROR; | ||
| } | ||
| } | ||
| menuDupCommandArray[0] = Tcl_NewStringObj("tkMenuDup", -1); | ||
| menuDupCommandArray[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1); | ||
| menuDupCommandArray[2] = newMenuNamePtr; | ||
| if (newMenuTypePtr == NULL) { | ||
| menuDupCommandArray[3] = Tcl_NewStringObj("normal", -1); | ||
| } else { | ||
| menuDupCommandArray[3] = newMenuTypePtr; | ||
| } | ||
| for (i = 0; i < 4; i++) { | ||
| Tcl_IncrRefCount(menuDupCommandArray[i]); | ||
| } | ||
| Tcl_Preserve((ClientData) menuPtr); | ||
| returnResult = Tcl_EvalObjv(menuPtr->interp, 4, menuDupCommandArray, 0); | ||
| for (i = 0; i < 4; i++) { | ||
| Tcl_DecrRefCount(menuDupCommandArray[i]); | ||
| } | ||
| /* | ||
| * Make sure the tcl command actually created the clone. | ||
| */ | ||
| if ((returnResult == TCL_OK) && | ||
| ((menuRefPtr = TkFindMenuReferencesObj(menuPtr->interp, | ||
| newMenuNamePtr)) != (TkMenuReferences *) NULL) | ||
| && (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) { | ||
| TkMenu *newMenuPtr = menuRefPtr->menuPtr; | ||
| Tcl_Obj *newObjv[3]; | ||
| char *newArgv[3]; | ||
| int i, numElements; | ||
| /* | ||
| * Now put this newly created menu into the parent menu's instance | ||
| * chain. | ||
| */ | ||
| if (menuPtr->nextInstancePtr == NULL) { | ||
| menuPtr->nextInstancePtr = newMenuPtr; | ||
| newMenuPtr->masterMenuPtr = menuPtr->masterMenuPtr; | ||
| } else { | ||
| TkMenu *masterMenuPtr; | ||
| masterMenuPtr = menuPtr->masterMenuPtr; | ||
| newMenuPtr->nextInstancePtr = masterMenuPtr->nextInstancePtr; | ||
| masterMenuPtr->nextInstancePtr = newMenuPtr; | ||
| newMenuPtr->masterMenuPtr = masterMenuPtr; | ||
| } | ||
| /* | ||
| * Add the master menu's window to the bind tags for this window | ||
| * after this window's tag. This is so the user can bind to either | ||
| * this clone (which may not be easy to do) or the entire menu | ||
| * clone structure. | ||
| */ | ||
| newArgv[0] = "bindtags"; | ||
| newArgv[1] = Tk_PathName(newMenuPtr->tkwin); | ||
| if (Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin, | ||
| newMenuPtr->interp, 2, newArgv) == TCL_OK) { | ||
| char *windowName; | ||
| Tcl_Obj *bindingsPtr = | ||
| Tcl_DuplicateObj(Tcl_GetObjResult(newMenuPtr->interp)); | ||
| Tcl_Obj *elementPtr; | ||
| Tcl_ListObjLength(newMenuPtr->interp, bindingsPtr, &numElements); | ||
| for (i = 0; i < numElements; i++) { | ||
| Tcl_ListObjIndex(newMenuPtr->interp, bindingsPtr, i, | ||
| &elementPtr); | ||
| windowName = Tcl_GetStringFromObj(elementPtr, NULL); | ||
| if (strcmp(windowName, Tk_PathName(newMenuPtr->tkwin)) | ||
| == 0) { | ||
| Tcl_Obj *newElementPtr = Tcl_NewStringObj( | ||
| Tk_PathName(newMenuPtr->masterMenuPtr->tkwin), -1); | ||
| Tcl_IncrRefCount(newElementPtr); | ||
| Tcl_ListObjReplace(menuPtr->interp, bindingsPtr, | ||
| i + 1, 0, 1, &newElementPtr); | ||
| newArgv[2] = Tcl_GetStringFromObj(bindingsPtr, NULL); | ||
| Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin, | ||
| menuPtr->interp, 3, newArgv); | ||
| break; | ||
| } | ||
| } | ||
| Tcl_DecrRefCount(bindingsPtr); | ||
| } | ||
| Tcl_ResetResult(menuPtr->interp); | ||
| /* | ||
| * Clone all of the cascade menus that this menu points to. | ||
| */ | ||
| for (i = 0; i < menuPtr->numEntries; i++) { | ||
| TkMenuReferences *cascadeRefPtr; | ||
| TkMenu *oldCascadePtr; | ||
| if ((menuPtr->entries[i]->type == CASCADE_ENTRY) | ||
| && (menuPtr->entries[i]->namePtr != NULL)) { | ||
| cascadeRefPtr = | ||
| TkFindMenuReferencesObj(menuPtr->interp, | ||
| menuPtr->entries[i]->namePtr); | ||
| if ((cascadeRefPtr != NULL) && (cascadeRefPtr->menuPtr)) { | ||
| Tcl_Obj *windowNamePtr = | ||
| Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin), | ||
| -1); | ||
| Tcl_Obj *newCascadePtr; | ||
| oldCascadePtr = cascadeRefPtr->menuPtr; | ||
| Tcl_IncrRefCount(windowNamePtr); | ||
| newCascadePtr = TkNewMenuName(menuPtr->interp, | ||
| windowNamePtr, oldCascadePtr); | ||
| Tcl_IncrRefCount(newCascadePtr); | ||
| CloneMenu(oldCascadePtr, newCascadePtr, NULL); | ||
| newObjv[0] = Tcl_NewStringObj("-menu", -1); | ||
| newObjv[1] = newCascadePtr; | ||
| Tcl_IncrRefCount(newObjv[0]); | ||
| ConfigureMenuEntry(newMenuPtr->entries[i], 2, newObjv); | ||
| Tcl_DecrRefCount(newObjv[0]); | ||
| Tcl_DecrRefCount(newCascadePtr); | ||
| Tcl_DecrRefCount(windowNamePtr); | ||
| } | ||
| } | ||
| } | ||
| returnResult = TCL_OK; | ||
| } else { | ||
| returnResult = TCL_ERROR; | ||
| } | ||
| Tcl_Release((ClientData) menuPtr); | ||
| return returnResult; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * MenuDoYPosition -- | ||
| * | ||
| * Given arguments from an option command line, returns the Y position. | ||
| * | ||
| * Results: | ||
| * Returns TCL_OK or TCL_Error | ||
| * | ||
| * Side effects: | ||
| * yPosition is set to the Y-position of the menu entry. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static int | ||
| MenuDoYPosition(interp, menuPtr, objPtr) | ||
| Tcl_Interp *interp; | ||
| TkMenu *menuPtr; | ||
| Tcl_Obj *objPtr; | ||
| { | ||
| int index; | ||
| TkRecomputeMenu(menuPtr); | ||
| if (TkGetMenuIndex(interp, menuPtr, objPtr, 0, &index) != TCL_OK) { | ||
| goto error; | ||
| } | ||
| Tcl_ResetResult(interp); | ||
| if (index < 0) { | ||
| Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); | ||
| } else { | ||
| Tcl_SetObjResult(interp, Tcl_NewIntObj(menuPtr->entries[index]->y)); | ||
| } | ||
| return TCL_OK; | ||
| error: | ||
| return TCL_ERROR; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * GetIndexFromCoords -- | ||
| * | ||
| * Given a string of the form "@int", return the menu item corresponding | ||
| * to int. | ||
| * | ||
| * Results: | ||
| * If int is a valid number, *indexPtr will be the number of the menuentry | ||
| * that is the correct height. If int is invaled, *indexPtr will be | ||
| * unchanged. Returns appropriate Tcl error number. | ||
| * | ||
| * Side effects: | ||
| * If int is invalid, interp's result will set to NULL. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static int | ||
| GetIndexFromCoords(interp, menuPtr, string, indexPtr) | ||
| Tcl_Interp *interp; /* interp of menu */ | ||
| TkMenu *menuPtr; /* the menu we are searching */ | ||
| char *string; /* The @string we are parsing */ | ||
| int *indexPtr; /* The index of the item that matches */ | ||
| { | ||
| int x, y, i; | ||
| char *p, *end; | ||
| TkRecomputeMenu(menuPtr); | ||
| p = string + 1; | ||
| y = strtol(p, &end, 0); | ||
| if (end == p) { | ||
| goto error; | ||
| } | ||
| if (*end == ',') { | ||
| x = y; | ||
| p = end + 1; | ||
| y = strtol(p, &end, 0); | ||
| if (end == p) { | ||
| goto error; | ||
| } | ||
| } else { | ||
| Tk_GetPixelsFromObj(interp, menuPtr->tkwin, | ||
| menuPtr->borderWidthPtr, &x); | ||
| } | ||
| for (i = 0; i < menuPtr->numEntries; i++) { | ||
| if ((x >= menuPtr->entries[i]->x) && (y >= menuPtr->entries[i]->y) | ||
| && (x < (menuPtr->entries[i]->x + menuPtr->entries[i]->width)) | ||
| && (y < (menuPtr->entries[i]->y | ||
| + menuPtr->entries[i]->height))) { | ||
| break; | ||
| } | ||
| } | ||
| if (i >= menuPtr->numEntries) { | ||
| /* i = menuPtr->numEntries - 1; */ | ||
| i = -1; | ||
| } | ||
| *indexPtr = i; | ||
| return TCL_OK; | ||
| error: | ||
| Tcl_SetResult(interp, (char *) NULL, TCL_STATIC); | ||
| return TCL_ERROR; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * RecursivelyDeleteMenu -- | ||
| * | ||
| * Deletes a menu and any cascades underneath it. Used for deleting | ||
| * instances when a menu is no longer being used as a menubar, | ||
| * for instance. | ||
| * | ||
| * Results: | ||
| * None. | ||
| * | ||
| * Side effects: | ||
| * Destroys the menu and all cascade menus underneath it. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static void | ||
| RecursivelyDeleteMenu(menuPtr) | ||
| TkMenu *menuPtr; /* The menubar instance we are deleting */ | ||
| { | ||
| int i; | ||
| TkMenuEntry *mePtr; | ||
| for (i = 0; i < menuPtr->numEntries; i++) { | ||
| mePtr = menuPtr->entries[i]; | ||
| if ((mePtr->type == CASCADE_ENTRY) | ||
| && (mePtr->childMenuRefPtr != NULL) | ||
| && (mePtr->childMenuRefPtr->menuPtr != NULL)) { | ||
| RecursivelyDeleteMenu(mePtr->childMenuRefPtr->menuPtr); | ||
| } | ||
| } | ||
| Tk_DestroyWindow(menuPtr->tkwin); | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * TkNewMenuName -- | ||
| * | ||
| * Makes a new unique name for a cloned menu. Will be a child | ||
| * of oldName. | ||
| * | ||
| * Results: | ||
| * Returns a char * which has been allocated; caller must free. | ||
| * | ||
| * Side effects: | ||
| * Memory is allocated. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| Tcl_Obj * | ||
| TkNewMenuName(interp, parentPtr, menuPtr) | ||
| Tcl_Interp *interp; /* The interp the new name has to live in.*/ | ||
| Tcl_Obj *parentPtr; /* The prefix path of the new name. */ | ||
| TkMenu *menuPtr; /* The menu we are cloning. */ | ||
| { | ||
| Tcl_Obj *resultPtr = NULL; /* Initialization needed only to prevent | ||
| * compiler warning. */ | ||
| Tcl_Obj *childPtr; | ||
| char *destString; | ||
| int i; | ||
| int doDot; | ||
| Tcl_CmdInfo cmdInfo; | ||
| Tcl_HashTable *nameTablePtr = NULL; | ||
| TkWindow *winPtr = (TkWindow *) menuPtr->tkwin; | ||
| char *parentName = Tcl_GetStringFromObj(parentPtr, NULL); | ||
| if (winPtr->mainPtr != NULL) { | ||
| nameTablePtr = &(winPtr->mainPtr->nameTable); | ||
| } | ||
| doDot = parentName[strlen(parentName) - 1] != '.'; | ||
| childPtr = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1); | ||
| for (destString = Tcl_GetStringFromObj(childPtr, NULL); | ||
| *destString != '\0'; destString++) { | ||
| if (*destString == '.') { | ||
| *destString = '#'; | ||
| } | ||
| } | ||
| for (i = 0; ; i++) { | ||
| if (i == 0) { | ||
| resultPtr = Tcl_DuplicateObj(parentPtr); | ||
| if (doDot) { | ||
| Tcl_AppendToObj(resultPtr, ".", -1); | ||
| } | ||
| Tcl_AppendObjToObj(resultPtr, childPtr); | ||
| } else { | ||
| Tcl_Obj *intPtr; | ||
| Tcl_DecrRefCount(resultPtr); | ||
| resultPtr = Tcl_DuplicateObj(parentPtr); | ||
| if (doDot) { | ||
| Tcl_AppendToObj(resultPtr, ".", -1); | ||
| } | ||
| Tcl_AppendObjToObj(resultPtr, childPtr); | ||
| intPtr = Tcl_NewIntObj(i); | ||
| Tcl_AppendObjToObj(resultPtr, intPtr); | ||
| Tcl_DecrRefCount(intPtr); | ||
| } | ||
| destString = Tcl_GetStringFromObj(resultPtr, NULL); | ||
| if ((Tcl_GetCommandInfo(interp, destString, &cmdInfo) == 0) | ||
| && ((nameTablePtr == NULL) | ||
| || (Tcl_FindHashEntry(nameTablePtr, destString) == NULL))) { | ||
| break; | ||
| } | ||
| } | ||
| Tcl_DecrRefCount(childPtr); | ||
| return resultPtr; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * TkSetWindowMenuBar -- | ||
| * | ||
| * Associates a menu with a window. Called by ConfigureFrame in | ||
| * in response to a "-menu .foo" configuration option for a top | ||
| * level. | ||
| * | ||
| * Results: | ||
| * None. | ||
| * | ||
| * Side effects: | ||
| * The old menu clones for the menubar are thrown away, and a | ||
| * handler is set up to allocate the new ones. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| void | ||
| TkSetWindowMenuBar(interp, tkwin, oldMenuName, menuName) | ||
| Tcl_Interp *interp; /* The interpreter the toplevel lives in. */ | ||
| Tk_Window tkwin; /* The toplevel window */ | ||
| char *oldMenuName; /* The name of the menubar previously set in | ||
| * this toplevel. NULL means no menu was | ||
| * set previously. */ | ||
| char *menuName; /* The name of the new menubar that the | ||
| * toplevel needs to be set to. NULL means | ||
| * that their is no menu now. */ | ||
| { | ||
| TkMenuTopLevelList *topLevelListPtr, *prevTopLevelPtr; | ||
| TkMenu *menuPtr; | ||
| TkMenuReferences *menuRefPtr; | ||
| TkMenuInit(); | ||
| /* | ||
| * Destroy the menubar instances of the old menu. Take this window | ||
| * out of the old menu's top level reference list. | ||
| */ | ||
| if (oldMenuName != NULL) { | ||
| menuRefPtr = TkFindMenuReferences(interp, oldMenuName); | ||
| if (menuRefPtr != NULL) { | ||
| /* | ||
| * Find the menubar instance that is to be removed. Destroy | ||
| * it and all of the cascades underneath it. | ||
| */ | ||
| if (menuRefPtr->menuPtr != NULL) { | ||
| TkMenu *instancePtr; | ||
| menuPtr = menuRefPtr->menuPtr; | ||
| for (instancePtr = menuPtr->masterMenuPtr; | ||
| instancePtr != NULL; | ||
| instancePtr = instancePtr->nextInstancePtr) { | ||
| if (instancePtr->menuType == MENUBAR | ||
| && instancePtr->parentTopLevelPtr == tkwin) { | ||
| RecursivelyDeleteMenu(instancePtr); | ||
| break; | ||
| } | ||
| } | ||
| } | ||
| /* | ||
| * Now we need to remove this toplevel from the list of toplevels | ||
| * that reference this menu. | ||
| */ | ||
| for (topLevelListPtr = menuRefPtr->topLevelListPtr, | ||
| prevTopLevelPtr = NULL; | ||
| (topLevelListPtr != NULL) | ||
| && (topLevelListPtr->tkwin != tkwin); | ||
| prevTopLevelPtr = topLevelListPtr, | ||
| topLevelListPtr = topLevelListPtr->nextPtr) { | ||
| /* | ||
| * Empty loop body. | ||
| */ | ||
| } | ||
| /* | ||
| * Now we have found the toplevel reference that matches the | ||
| * tkwin; remove this reference from the list. | ||
| */ | ||
| if (topLevelListPtr != NULL) { | ||
| if (prevTopLevelPtr == NULL) { | ||
| menuRefPtr->topLevelListPtr = | ||
| menuRefPtr->topLevelListPtr->nextPtr; | ||
| } else { | ||
| prevTopLevelPtr->nextPtr = topLevelListPtr->nextPtr; | ||
| } | ||
| ckfree((char *) topLevelListPtr); | ||
| TkFreeMenuReferences(menuRefPtr); | ||
| } | ||
| } | ||
| } | ||
| /* | ||
| * Now, add the clone references for the new menu. | ||
| */ | ||
| if (menuName != NULL && menuName[0] != 0) { | ||
| TkMenu *menuBarPtr = NULL; | ||
| menuRefPtr = TkCreateMenuReferences(interp, menuName); | ||
| menuPtr = menuRefPtr->menuPtr; | ||
| if (menuPtr != NULL) { | ||
| Tcl_Obj *cloneMenuPtr; | ||
| TkMenuReferences *cloneMenuRefPtr; | ||
| Tcl_Obj *newObjv[4]; | ||
| Tcl_Obj *windowNamePtr = Tcl_NewStringObj(Tk_PathName(tkwin), | ||
| -1); | ||
| Tcl_Obj *menubarPtr = Tcl_NewStringObj("menubar", -1); | ||
| /* | ||
| * Clone the menu and all of the cascades underneath it. | ||
| */ | ||
| Tcl_IncrRefCount(windowNamePtr); | ||
| cloneMenuPtr = TkNewMenuName(interp, windowNamePtr, | ||
| menuPtr); | ||
| Tcl_IncrRefCount(cloneMenuPtr); | ||
| Tcl_IncrRefCount(menubarPtr); | ||
| CloneMenu(menuPtr, cloneMenuPtr, menubarPtr); | ||
| cloneMenuRefPtr = TkFindMenuReferencesObj(interp, cloneMenuPtr); | ||
| if ((cloneMenuRefPtr != NULL) | ||
| && (cloneMenuRefPtr->menuPtr != NULL)) { | ||
| Tcl_Obj *cursorPtr = Tcl_NewStringObj("-cursor", -1); | ||
| Tcl_Obj *nullPtr = Tcl_NewObj(); | ||
| cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin; | ||
| menuBarPtr = cloneMenuRefPtr->menuPtr; | ||
| newObjv[0] = cursorPtr; | ||
| newObjv[1] = nullPtr; | ||
| Tcl_IncrRefCount(cursorPtr); | ||
| Tcl_IncrRefCount(nullPtr); | ||
| ConfigureMenu(menuPtr->interp, cloneMenuRefPtr->menuPtr, | ||
| 2, newObjv); | ||
| Tcl_DecrRefCount(cursorPtr); | ||
| Tcl_DecrRefCount(nullPtr); | ||
| } | ||
| TkpSetWindowMenuBar(tkwin, menuBarPtr); | ||
| Tcl_DecrRefCount(cloneMenuPtr); | ||
| Tcl_DecrRefCount(menubarPtr); | ||
| Tcl_DecrRefCount(windowNamePtr); | ||
| } else { | ||
| TkpSetWindowMenuBar(tkwin, NULL); | ||
| } | ||
| /* | ||
| * Add this window to the menu's list of windows that refer | ||
| * to this menu. | ||
| */ | ||
| topLevelListPtr = (TkMenuTopLevelList *) | ||
| ckalloc(sizeof(TkMenuTopLevelList)); | ||
| topLevelListPtr->tkwin = tkwin; | ||
| topLevelListPtr->nextPtr = menuRefPtr->topLevelListPtr; | ||
| menuRefPtr->topLevelListPtr = topLevelListPtr; | ||
| } else { | ||
| TkpSetWindowMenuBar(tkwin, NULL); | ||
| } | ||
| TkpSetMainMenubar(interp, tkwin, menuName); | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * DestroyMenuHashTable -- | ||
| * | ||
| * Called when an interp is deleted and a menu hash table has | ||
| * been set in it. | ||
| * | ||
| * Results: | ||
| * None. | ||
| * | ||
| * Side effects: | ||
| * The hash table is destroyed. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static void | ||
| DestroyMenuHashTable(clientData, interp) | ||
| ClientData clientData; /* The menu hash table we are destroying */ | ||
| Tcl_Interp *interp; /* The interpreter we are destroying */ | ||
| { | ||
| Tcl_DeleteHashTable((Tcl_HashTable *) clientData); | ||
| ckfree((char *) clientData); | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * TkGetMenuHashTable -- | ||
| * | ||
| * For a given interp, give back the menu hash table that goes with | ||
| * it. If the hash table does not exist, it is created. | ||
| * | ||
| * Results: | ||
| * Returns a hash table pointer. | ||
| * | ||
| * Side effects: | ||
| * A new hash table is created if there were no table in the interp | ||
| * originally. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| Tcl_HashTable * | ||
| TkGetMenuHashTable(interp) | ||
| Tcl_Interp *interp; /* The interp we need the hash table in.*/ | ||
| { | ||
| Tcl_HashTable *menuTablePtr; | ||
| menuTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, MENU_HASH_KEY, | ||
| NULL); | ||
| if (menuTablePtr == NULL) { | ||
| menuTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); | ||
| Tcl_InitHashTable(menuTablePtr, TCL_STRING_KEYS); | ||
| Tcl_SetAssocData(interp, MENU_HASH_KEY, DestroyMenuHashTable, | ||
| (ClientData) menuTablePtr); | ||
| } | ||
| return menuTablePtr; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * TkCreateMenuReferences -- | ||
| * | ||
| * Given a pathname, gives back a pointer to a TkMenuReferences structure. | ||
| * If a reference is not already in the hash table, one is created. | ||
| * | ||
| * Results: | ||
| * Returns a pointer to a menu reference structure. Should not | ||
| * be freed by calller; when a field of the reference is cleared, | ||
| * TkFreeMenuReferences should be called. | ||
| * | ||
| * Side effects: | ||
| * A new hash table entry is created if there were no references | ||
| * to the menu originally. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| TkMenuReferences * | ||
| TkCreateMenuReferences(interp, pathName) | ||
| Tcl_Interp *interp; | ||
| char *pathName; /* The path of the menu widget */ | ||
| { | ||
| Tcl_HashEntry *hashEntryPtr; | ||
| TkMenuReferences *menuRefPtr; | ||
| int newEntry; | ||
| Tcl_HashTable *menuTablePtr = TkGetMenuHashTable(interp); | ||
| hashEntryPtr = Tcl_CreateHashEntry(menuTablePtr, pathName, &newEntry); | ||
| if (newEntry) { | ||
| menuRefPtr = (TkMenuReferences *) ckalloc(sizeof(TkMenuReferences)); | ||
| menuRefPtr->menuPtr = NULL; | ||
| menuRefPtr->topLevelListPtr = NULL; | ||
| menuRefPtr->parentEntryPtr = NULL; | ||
| menuRefPtr->hashEntryPtr = hashEntryPtr; | ||
| Tcl_SetHashValue(hashEntryPtr, (char *) menuRefPtr); | ||
| } else { | ||
| menuRefPtr = (TkMenuReferences *) Tcl_GetHashValue(hashEntryPtr); | ||
| } | ||
| return menuRefPtr; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * TkFindMenuReferences -- | ||
| * | ||
| * Given a pathname, gives back a pointer to the TkMenuReferences | ||
| * structure. | ||
| * | ||
| * Results: | ||
| * Returns a pointer to a menu reference structure. Should not | ||
| * be freed by calller; when a field of the reference is cleared, | ||
| * TkFreeMenuReferences should be called. Returns NULL if no reference | ||
| * with this pathname exists. | ||
| * | ||
| * Side effects: | ||
| * None. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| TkMenuReferences * | ||
| TkFindMenuReferences(interp, pathName) | ||
| Tcl_Interp *interp; /* The interp the menu is living in. */ | ||
| char *pathName; /* The path of the menu widget */ | ||
| { | ||
| Tcl_HashEntry *hashEntryPtr; | ||
| TkMenuReferences *menuRefPtr = NULL; | ||
| Tcl_HashTable *menuTablePtr; | ||
| menuTablePtr = TkGetMenuHashTable(interp); | ||
| hashEntryPtr = Tcl_FindHashEntry(menuTablePtr, pathName); | ||
| if (hashEntryPtr != NULL) { | ||
| menuRefPtr = (TkMenuReferences *) Tcl_GetHashValue(hashEntryPtr); | ||
| } | ||
| return menuRefPtr; | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * TkFindMenuReferencesObj -- | ||
| * | ||
| * Given a pathname, gives back a pointer to the TkMenuReferences | ||
| * structure. | ||
| * | ||
| * Results: | ||
| * Returns a pointer to a menu reference structure. Should not | ||
| * be freed by calller; when a field of the reference is cleared, | ||
| * TkFreeMenuReferences should be called. Returns NULL if no reference | ||
| * with this pathname exists. | ||
| * | ||
| * Side effects: | ||
| * None. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| TkMenuReferences * | ||
| TkFindMenuReferencesObj(interp, objPtr) | ||
| Tcl_Interp *interp; /* The interp the menu is living in. */ | ||
| Tcl_Obj *objPtr; /* The path of the menu widget */ | ||
| { | ||
| char *pathName = Tcl_GetStringFromObj(objPtr, NULL); | ||
| return TkFindMenuReferences(interp, pathName); | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * TkFreeMenuReferences -- | ||
| * | ||
| * This is called after one of the fields in a menu reference | ||
| * is cleared. It cleans up the ref if it is now empty. | ||
| * | ||
| * Results: | ||
| * None. | ||
| * | ||
| * Side effects: | ||
| * If this is the last field to be cleared, the menu ref is | ||
| * taken out of the hash table. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| void | ||
| TkFreeMenuReferences(menuRefPtr) | ||
| TkMenuReferences *menuRefPtr; /* The menu reference to | ||
| * free */ | ||
| { | ||
| if ((menuRefPtr->menuPtr == NULL) | ||
| && (menuRefPtr->parentEntryPtr == NULL) | ||
| && (menuRefPtr->topLevelListPtr == NULL)) { | ||
| Tcl_DeleteHashEntry(menuRefPtr->hashEntryPtr); | ||
| ckfree((char *) menuRefPtr); | ||
| } | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * DeleteMenuCloneEntries -- | ||
| * | ||
| * For every clone in this clone chain, delete the menu entries | ||
| * given by the parameters. | ||
| * | ||
| * Results: | ||
| * None. | ||
| * | ||
| * Side effects: | ||
| * The appropriate entries are deleted from all clones of this menu. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| static void | ||
| DeleteMenuCloneEntries(menuPtr, first, last) | ||
| TkMenu *menuPtr; /* the menu the command was issued with */ | ||
| int first; /* the zero-based first entry in the set | ||
| * of entries to delete. */ | ||
| int last; /* the zero-based last entry */ | ||
| { | ||
| TkMenu *menuListPtr; | ||
| int numDeleted, i; | ||
| numDeleted = last + 1 - first; | ||
| for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL; | ||
| menuListPtr = menuListPtr->nextInstancePtr) { | ||
| for (i = last; i >= first; i--) { | ||
| Tcl_EventuallyFree((ClientData) menuListPtr->entries[i], | ||
| DestroyMenuEntry); | ||
| } | ||
| for (i = last + 1; i < menuListPtr->numEntries; i++) { | ||
| menuListPtr->entries[i - numDeleted] = menuListPtr->entries[i]; | ||
| menuListPtr->entries[i - numDeleted]->index = i; | ||
| } | ||
| menuListPtr->numEntries -= numDeleted; | ||
| if (menuListPtr->numEntries == 0) { | ||
| ckfree((char *) menuListPtr->entries); | ||
| menuListPtr->entries = NULL; | ||
| } | ||
| if ((menuListPtr->active >= first) | ||
| && (menuListPtr->active <= last)) { | ||
| menuListPtr->active = -1; | ||
| } else if (menuListPtr->active > last) { | ||
| menuListPtr->active -= numDeleted; | ||
| } | ||
| TkEventuallyRecomputeMenu(menuListPtr); | ||
| } | ||
| } | ||
| /* | ||
| *---------------------------------------------------------------------- | ||
| * | ||
| * TkMenuInit -- | ||
| * | ||
| * Sets up the hash tables and the variables used by the menu package. | ||
| * | ||
| * Results: | ||
| * None. | ||
| * | ||
| * Side effects: | ||
| * lastMenuID gets initialized, and the parent hash and the command hash | ||
| * are allocated. | ||
| * | ||
| *---------------------------------------------------------------------- | ||
| */ | ||
| void | ||
| TkMenuInit() | ||
| { | ||
| ThreadSpecificData *tsdPtr = (ThreadSpecificData *) | ||
| Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); | ||
| if (!menusInitialized) { | ||
| Tcl_MutexLock(&menuMutex); | ||
| if (!menusInitialized) { | ||
| TkpMenuInit(); | ||
| menusInitialized = 1; | ||
| } | ||
| Tcl_MutexUnlock(&menuMutex); | ||
| } | ||
| if (!tsdPtr->menusInitialized) { | ||
| TkpMenuThreadInit(); | ||
| tsdPtr->menusInitialized = 1; | ||
| } | ||
| } | ||
| /* $History: tkMenu.c $ | ||
| * | ||
| * ***************** Version 1 ***************** | ||
| * User: Dtashley Date: 1/02/01 Time: 2:58a | ||
| * Created in $/IjuScripter, IjuConsole/Source/Tk Base | ||
| * Initial check-in. | ||
| */ | ||
| /* End of TKMENU.C */ | ||
| 1 | /* $Header$ */ | |
| 2 | ||
| 3 | /* | |
| 4 | * tkMenu.c -- | |
| 5 | * | |
| 6 | * This file contains most of the code for implementing menus in Tk. It takes | |
| 7 | * care of all of the generic (platform-independent) parts of menus, and | |
| 8 | * is supplemented by platform-specific files. The geometry calculation | |
| 9 | * and drawing code for menus is in the file tkMenuDraw.c | |
| 10 | * | |
| 11 | * Copyright (c) 1990-1994 The Regents of the University of California. | |
| 12 | * Copyright (c) 1994-1998 Sun Microsystems, Inc. | |
| 13 | * | |
| 14 | * See the file "license.terms" for information on usage and redistribution | |
| 15 | * of this file, and for a DISCLAIMER OF ALL WARRANTIES. | |
| 16 | * | |
| 17 | * RCS: @(#) $Id: tkmenu.c,v 1.1.1.1 2001/06/13 05:05:37 dtashley Exp $ | |
| 18 | */ | |
| 19 | ||
| 20 | /* | |
| 21 | * Notes on implementation of menus: | |
| 22 | * | |
| 23 | * Menus can be used in three ways: | |
| 24 | * - as a popup menu, either as part of a menubutton or standalone. | |
| 25 | * - as a menubar. The menu's cascade items are arranged according to | |
| 26 | * the specific platform to provide the user access to the menus at all | |
| 27 | * times | |
| 28 | * - as a tearoff palette. This is a window with the menu's items in it. | |
| 29 | * | |
| 30 | * The goal is to provide the Tk developer with a way to use a common | |
| 31 | * set of menus for all of these tasks. | |
| 32 | * | |
| 33 | * In order to make the bindings for cascade menus work properly under Unix, | |
| 34 | * the cascade menus' pathnames must be proper children of the menu that | |
| 35 | * they are cascade from. So if there is a menu .m, and it has two | |
| 36 | * cascades labelled "File" and "Edit", the cascade menus might have | |
| 37 | * the pathnames .m.file and .m.edit. Another constraint is that the menus | |
| 38 | * used for menubars must be children of the toplevel widget that they | |
| 39 | * are attached to. And on the Macintosh, the platform specific menu handle | |
| 40 | * for cascades attached to a menu bar must have a title that matches the | |
| 41 | * label for the cascade menu. | |
| 42 | * | |
| 43 | * To handle all of the constraints, Tk menubars and tearoff menus are | |
| 44 | * implemented using menu clones. Menu clones are full menus in their own | |
| 45 | * right; they have a Tk window and pathname associated with them; they have | |
| 46 | * a TkMenu structure and array of entries. However, they are linked with the | |
| 47 | * original menu that they were cloned from. The reflect the attributes of | |
| 48 | * the original, or "master", menu. So if an item is added to a menu, and | |
| 49 | * that menu has clones, then the item must be added to all of its clones | |
| 50 | * also. Menus are cloned when a menu is torn-off or when a menu is assigned | |
| 51 | * as a menubar using the "-menu" option of the toplevel's pathname configure | |
| 52 | * subcommand. When a clone is destroyed, only the clone is destroyed, but | |
| 53 | * when the master menu is destroyed, all clones are also destroyed. This | |
| 54 | * allows the developer to just deal with one set of menus when creating | |
| 55 | * and destroying. | |
| 56 | * | |
| 57 | * Clones are rather tricky when a menu with cascade entries is cloned (such | |
| 58 | * as a menubar). Not only does the menu have to be cloned, but each cascade | |
| 59 | * entry's corresponding menu must also be cloned. This maintains the pathname | |
| 60 | * parent-child hierarchy necessary for menubars and toplevels to work. | |
| 61 | * This leads to several special cases: | |
| 62 | * | |
| 63 | * 1. When a new menu is created, and it is pointed to by cascade entries in | |
| 64 | * cloned menus, the new menu has to be cloned to parallel the cascade | |
| 65 | * structure. | |
| 66 | * 2. When a cascade item is added to a menu that has been cloned, and the | |
| 67 | * menu that the cascade item points to exists, that menu has to be cloned. | |
| 68 | * 3. When the menu that a cascade entry points to is changed, the old | |
| 69 | * cloned cascade menu has to be discarded, and the new one has to be cloned. | |
| 70 | * | |
| 71 | */ | |
| 72 | ||
| 73 | #if 0 | |
| 74 | ||
| 75 | /* | |
| 76 | * used only to test for old config code | |
| 77 | */ | |
| 78 | ||
| 79 | #define __NO_OLD_CONFIG | |
| 80 | #endif | |
| 81 | ||
| 82 | #include "tkPort.h" | |
| 83 | #include "tkMenu.h" | |
| 84 | ||
| 85 | #define MENU_HASH_KEY "tkMenus" | |
| 86 | ||
| 87 | typedef struct ThreadSpecificData { | |
| 88 | int menusInitialized; /* Flag indicates whether thread-specific | |
| 89 | * elements of the Windows Menu module | |
| 90 | * have been initialized. */ | |
| 91 | } ThreadSpecificData; | |
| 92 | static Tcl_ThreadDataKey dataKey; | |
| 93 | ||
| 94 | /* | |
| 95 | * The following flag indicates whether the process-wide state for | |
| 96 | * the Menu module has been intialized. The Mutex protects access to | |
| 97 | * that flag. | |
| 98 | */ | |
| 99 | ||
| 100 | static int menusInitialized; | |
| 101 | TCL_DECLARE_MUTEX(menuMutex) | |
| 102 | ||
| 103 | /* | |
| 104 | * Configuration specs for individual menu entries. If this changes, be sure | |
| 105 | * to update code in TkpMenuInit that changes the font string entry. | |
| 106 | */ | |
| 107 | ||
| 108 | char *tkMenuStateStrings[] = {"active", "normal", "disabled", (char *) NULL}; | |
| 109 | ||
| 110 | static char *menuEntryTypeStrings[] = {"cascade", "checkbutton", "command", | |
| 111 | "radiobutton", "separator", (char *) NULL}; | |
| 112 | ||
| 113 | Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = { | |
| 114 | {TK_OPTION_BORDER, "-activebackground", (char *) NULL, (char *) NULL, | |
| 115 | DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorderPtr), -1, | |
| 116 | TK_OPTION_NULL_OK}, | |
| 117 | {TK_OPTION_COLOR, "-activeforeground", (char *) NULL, (char *) NULL, | |
| 118 | DEF_MENU_ENTRY_ACTIVE_FG, | |
| 119 | Tk_Offset(TkMenuEntry, activeFgPtr), -1, TK_OPTION_NULL_OK}, | |
| 120 | {TK_OPTION_STRING, "-accelerator", (char *) NULL, (char *) NULL, | |
| 121 | DEF_MENU_ENTRY_ACCELERATOR, | |
| 122 | Tk_Offset(TkMenuEntry, accelPtr), -1, TK_OPTION_NULL_OK}, | |
| 123 | {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL, | |
| 124 | DEF_MENU_ENTRY_BG, | |
| 125 | Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK}, | |
| 126 | {TK_OPTION_BITMAP, "-bitmap", (char *) NULL, (char *) NULL, | |
| 127 | DEF_MENU_ENTRY_BITMAP, | |
| 128 | Tk_Offset(TkMenuEntry, bitmapPtr), -1, TK_OPTION_NULL_OK}, | |
| 129 | {TK_OPTION_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL, | |
| 130 | DEF_MENU_ENTRY_COLUMN_BREAK, | |
| 131 | -1, Tk_Offset(TkMenuEntry, columnBreak)}, | |
| 132 | {TK_OPTION_STRING, "-command", (char *) NULL, (char *) NULL, | |
| 133 | DEF_MENU_ENTRY_COMMAND, | |
| 134 | Tk_Offset(TkMenuEntry, commandPtr), -1, TK_OPTION_NULL_OK}, | |
| 135 | {TK_OPTION_FONT, "-font", (char *) NULL, (char *) NULL, | |
| 136 | DEF_MENU_ENTRY_FONT, | |
| 137 | Tk_Offset(TkMenuEntry, fontPtr), -1, TK_OPTION_NULL_OK}, | |
| 138 | {TK_OPTION_COLOR, "-foreground", (char *) NULL, (char *) NULL, | |
| 139 | DEF_MENU_ENTRY_FG, | |
| 140 | Tk_Offset(TkMenuEntry, fgPtr), -1, TK_OPTION_NULL_OK}, | |
| 141 | {TK_OPTION_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL, | |
| 142 | DEF_MENU_ENTRY_HIDE_MARGIN, | |
| 143 | -1, Tk_Offset(TkMenuEntry, hideMargin)}, | |
| 144 | {TK_OPTION_STRING, "-image", (char *) NULL, (char *) NULL, | |
| 145 | DEF_MENU_ENTRY_IMAGE, | |
| 146 | Tk_Offset(TkMenuEntry, imagePtr), -1, TK_OPTION_NULL_OK}, | |
| 147 | {TK_OPTION_STRING, "-label", (char *) NULL, (char *) NULL, | |
| 148 | DEF_MENU_ENTRY_LABEL, | |
| 149 | Tk_Offset(TkMenuEntry, labelPtr), -1, 0}, | |
| 150 | {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL, | |
| 151 | DEF_MENU_ENTRY_STATE, | |
| 152 | -1, Tk_Offset(TkMenuEntry, state), 0, | |
| 153 | (ClientData) tkMenuStateStrings}, | |
| 154 | {TK_OPTION_INT, "-underline", (char *) NULL, (char *) NULL, | |
| 155 | DEF_MENU_ENTRY_UNDERLINE, -1, Tk_Offset(TkMenuEntry, underline)}, | |
| 156 | {TK_OPTION_END} | |
| 157 | }; | |
| 158 | ||
| 159 | Tk_OptionSpec tkSeparatorEntryConfigSpecs[] = { | |
| 160 | {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL, | |
| 161 | DEF_MENU_ENTRY_BG, | |
| 162 | Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK}, | |
| 163 | {TK_OPTION_END} | |
| 164 | }; | |
| 165 | ||
| 166 | Tk_OptionSpec tkCheckButtonEntryConfigSpecs[] = { | |
| 167 | {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL, | |
| 168 | DEF_MENU_ENTRY_INDICATOR, | |
| 169 | -1, Tk_Offset(TkMenuEntry, indicatorOn)}, | |
| 170 | {TK_OPTION_STRING, "-offvalue", (char *) NULL, (char *) NULL, | |
| 171 | DEF_MENU_ENTRY_OFF_VALUE, | |
| 172 | Tk_Offset(TkMenuEntry, offValuePtr), -1}, | |
| 173 | {TK_OPTION_STRING, "-onvalue", (char *) NULL, (char *) NULL, | |
| 174 | DEF_MENU_ENTRY_ON_VALUE, | |
| 175 | Tk_Offset(TkMenuEntry, onValuePtr), -1}, | |
| 176 | {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL, | |
| 177 | DEF_MENU_ENTRY_SELECT, | |
| 178 | Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK}, | |
| 179 | {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL, | |
| 180 | DEF_MENU_ENTRY_SELECT_IMAGE, | |
| 181 | Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK}, | |
| 182 | {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL, | |
| 183 | DEF_MENU_ENTRY_CHECK_VARIABLE, | |
| 184 | Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK}, | |
| 185 | {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, | |
| 186 | (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs} | |
| 187 | }; | |
| 188 | ||
| 189 | Tk_OptionSpec tkRadioButtonEntryConfigSpecs[] = { | |
| 190 | {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL, | |
| 191 | DEF_MENU_ENTRY_INDICATOR, | |
| 192 | -1, Tk_Offset(TkMenuEntry, indicatorOn)}, | |
| 193 | {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL, | |
| 194 | DEF_MENU_ENTRY_SELECT, | |
| 195 | Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK}, | |
| 196 | {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL, | |
| 197 | DEF_MENU_ENTRY_SELECT_IMAGE, | |
| 198 | Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK}, | |
| 199 | {TK_OPTION_STRING, "-value", (char *) NULL, (char *) NULL, | |
| 200 | DEF_MENU_ENTRY_VALUE, | |
| 201 | Tk_Offset(TkMenuEntry, onValuePtr), -1, TK_OPTION_NULL_OK}, | |
| 202 | {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL, | |
| 203 | DEF_MENU_ENTRY_RADIO_VARIABLE, | |
| 204 | Tk_Offset(TkMenuEntry, namePtr), -1, 0}, | |
| 205 | {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, | |
| 206 | (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs} | |
| 207 | }; | |
| 208 | ||
| 209 | Tk_OptionSpec tkCascadeEntryConfigSpecs[] = { | |
| 210 | {TK_OPTION_STRING, "-menu", (char *) NULL, (char *) NULL, | |
| 211 | DEF_MENU_ENTRY_MENU, | |
| 212 | Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK}, | |
| 213 | {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, | |
| 214 | (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs} | |
| 215 | }; | |
| 216 | ||
| 217 | Tk_OptionSpec tkTearoffEntryConfigSpecs[] = { | |
| 218 | {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL, | |
| 219 | DEF_MENU_ENTRY_BG, | |
| 220 | Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK}, | |
| 221 | {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL, | |
| 222 | DEF_MENU_ENTRY_STATE, -1, Tk_Offset(TkMenuEntry, state), 0, | |
| 223 | (ClientData) tkMenuStateStrings}, | |
| 224 | {TK_OPTION_END} | |
| 225 | }; | |
| 226 | ||
| 227 | static Tk_OptionSpec *specsArray[] = { | |
| 228 | tkCascadeEntryConfigSpecs, tkCheckButtonEntryConfigSpecs, | |
| 229 | tkBasicMenuEntryConfigSpecs, tkRadioButtonEntryConfigSpecs, | |
| 230 | tkSeparatorEntryConfigSpecs, tkTearoffEntryConfigSpecs}; | |
| 231 | ||
| 232 | /* | |
| 233 | * Menu type strings for use with Tcl_GetIndexFromObj. | |
| 234 | */ | |
| 235 | ||
| 236 | static char *menuTypeStrings[] = {"normal", "tearoff", "menubar", | |
| 237 | (char *) NULL}; | |
| 238 | ||
| 239 | Tk_OptionSpec tkMenuConfigSpecs[] = { | |
| 240 | {TK_OPTION_BORDER, "-activebackground", "activeBackground", | |
| 241 | "Foreground", DEF_MENU_ACTIVE_BG_COLOR, | |
| 242 | Tk_Offset(TkMenu, activeBorderPtr), -1, 0, | |
| 243 | (ClientData) DEF_MENU_ACTIVE_BG_MONO}, | |
| 244 | {TK_OPTION_PIXELS, "-activeborderwidth", "activeBorderWidth", | |
| 245 | "BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH, | |
| 246 | Tk_Offset(TkMenu, activeBorderWidthPtr), -1}, | |
| 247 | {TK_OPTION_COLOR, "-activeforeground", "activeForeground", | |
| 248 | "Background", DEF_MENU_ACTIVE_FG_COLOR, | |
| 249 | Tk_Offset(TkMenu, activeFgPtr), -1, 0, | |
| 250 | (ClientData) DEF_MENU_ACTIVE_FG_MONO}, | |
| 251 | {TK_OPTION_BORDER, "-background", "background", "Background", | |
| 252 | DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, borderPtr), -1, 0, | |
| 253 | (ClientData) DEF_MENU_BG_MONO}, | |
| 254 | {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, | |
| 255 | (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"}, | |
| 256 | {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, | |
| 257 | (char *) NULL, 0, -1, 0, (ClientData) "-background"}, | |
| 258 | {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", | |
| 259 | DEF_MENU_BORDER_WIDTH, | |
| 260 | Tk_Offset(TkMenu, borderWidthPtr), -1, 0}, | |
| 261 | {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", | |
| 262 | DEF_MENU_CURSOR, | |
| 263 | Tk_Offset(TkMenu, cursorPtr), -1, TK_OPTION_NULL_OK}, | |
| 264 | {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground", | |
| 265 | "DisabledForeground", DEF_MENU_DISABLED_FG_COLOR, | |
| 266 | Tk_Offset(TkMenu, disabledFgPtr), -1, TK_OPTION_NULL_OK, | |
| 267 | (ClientData) DEF_MENU_DISABLED_FG_MONO}, | |
| 268 | {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL, | |
| 269 | (char *) NULL, 0, -1, 0, (ClientData) "-foreground"}, | |
| 270 | {TK_OPTION_FONT, "-font", "font", "Font", | |
| 271 | DEF_MENU_FONT, Tk_Offset(TkMenu, fontPtr), -1}, | |
| 272 | {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", | |
| 273 | DEF_MENU_FG, Tk_Offset(TkMenu, fgPtr), -1}, | |
| 274 | {TK_OPTION_STRING, "-postcommand", "postCommand", "Command", | |
| 275 | DEF_MENU_POST_COMMAND, | |
| 276 | Tk_Offset(TkMenu, postCommandPtr), -1, TK_OPTION_NULL_OK}, | |
| 277 | {TK_OPTION_RELIEF, "-relief", "relief", "Relief", | |
| 278 | DEF_MENU_RELIEF, Tk_Offset(TkMenu, reliefPtr), -1}, | |
| 279 | {TK_OPTION_COLOR, "-selectcolor", "selectColor", "Background", | |
| 280 | DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFgPtr), -1, 0, | |
| 281 | (ClientData) DEF_MENU_SELECT_MONO}, | |
| 282 | {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", | |
| 283 | DEF_MENU_TAKE_FOCUS, | |
| 284 | Tk_Offset(TkMenu, takeFocusPtr), -1, TK_OPTION_NULL_OK}, | |
| 285 | {TK_OPTION_BOOLEAN, "-tearoff", "tearOff", "TearOff", | |
| 286 | DEF_MENU_TEAROFF, -1, Tk_Offset(TkMenu, tearoff)}, | |
| 287 | {TK_OPTION_STRING, "-tearoffcommand", "tearOffCommand", | |
| 288 | "TearOffCommand", DEF_MENU_TEAROFF_CMD, | |
| 289 | Tk_Offset(TkMenu, tearoffCommandPtr), -1, TK_OPTION_NULL_OK}, | |
| 290 | {TK_OPTION_STRING, "-title", "title", "Title", | |
| 291 | DEF_MENU_TITLE, Tk_Offset(TkMenu, titlePtr), -1, | |
| 292 | TK_OPTION_NULL_OK}, | |
| 293 | {TK_OPTION_STRING_TABLE, "-type", "type", "Type", | |
| 294 | DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypePtr), -1, TK_OPTION_NULL_OK, | |
| 295 | (ClientData) menuTypeStrings}, | |
| 296 | {TK_OPTION_END} | |
| 297 | }; | |
| 298 | ||
| 299 | /* | |
| 300 | * Command line options. Put here because MenuCmd has to look at them | |
| 301 | * along with MenuWidgetObjCmd. | |
| 302 | */ | |
| 303 | ||
| 304 | static char *menuOptions[] = { | |
| 305 | "activate", "add", "cget", "clone", "configure", "delete", "entrycget", | |
| 306 | "entryconfigure", "index", "insert", "invoke", "post", "postcascade", | |
| 307 | "type", "unpost", "yposition", (char *) NULL | |
| 308 | }; | |
| 309 | enum options { | |
| 310 | MENU_ACTIVATE, MENU_ADD, MENU_CGET, MENU_CLONE, MENU_CONFIGURE, | |
| 311 | MENU_DELETE, MENU_ENTRYCGET, MENU_ENTRYCONFIGURE, MENU_INDEX, | |
| 312 | MENU_INSERT, MENU_INVOKE, MENU_POST, MENU_POSTCASCADE, MENU_TYPE, | |
| 313 | MENU_UNPOST, MENU_YPOSITION | |
| 314 | }; | |
| 315 | ||
| 316 | /* | |
| 317 | * Prototypes for static procedures in this file: | |
| 318 | */ | |
| 319 | ||
| 320 | static int CloneMenu _ANSI_ARGS_((TkMenu *menuPtr, | |
| 321 | Tcl_Obj *newMenuName, Tcl_Obj *newMenuTypeString)); | |
| 322 | static int ConfigureMenu _ANSI_ARGS_((Tcl_Interp *interp, | |
| 323 | TkMenu *menuPtr, int objc, Tcl_Obj *CONST objv[])); | |
| 324 | static int ConfigureMenuCloneEntries _ANSI_ARGS_(( | |
| 325 | Tcl_Interp *interp, TkMenu *menuPtr, int index, | |
| 326 | int objc, Tcl_Obj *CONST objv[])); | |
| 327 | static int ConfigureMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr, | |
| 328 | int objc, Tcl_Obj *CONST objv[])); | |
| 329 | static void DeleteMenuCloneEntries _ANSI_ARGS_((TkMenu *menuPtr, | |
| 330 | int first, int last)); | |
| 331 | static void DestroyMenuHashTable _ANSI_ARGS_(( | |
| 332 | ClientData clientData, Tcl_Interp *interp)); | |
| 333 | static void DestroyMenuInstance _ANSI_ARGS_((TkMenu *menuPtr)); | |
| 334 | static void DestroyMenuEntry _ANSI_ARGS_((char *memPtr)); | |
| 335 | static int GetIndexFromCoords | |
| 336 | _ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuPtr, | |
| 337 | char *string, int *indexPtr)); | |
| 338 | static int MenuDoYPosition _ANSI_ARGS_((Tcl_Interp *interp, | |
| 339 | TkMenu *menuPtr, Tcl_Obj *objPtr)); | |
| 340 | static int MenuAddOrInsert _ANSI_ARGS_((Tcl_Interp *interp, | |
| 341 | TkMenu *menuPtr, Tcl_Obj *indexPtr, int objc, | |
| 342 | Tcl_Obj *CONST objv[])); | |
| 343 | static int MenuCmd _ANSI_ARGS_((ClientData clientData, | |
| 344 | Tcl_Interp *interp, int objc, | |
| 345 | Tcl_Obj *CONST objv[])); | |
| 346 | static void MenuCmdDeletedProc _ANSI_ARGS_(( | |
| 347 | ClientData clientData)); | |
| 348 | static TkMenuEntry * MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index, | |
| 349 | int type)); | |
| 350 | static char * MenuVarProc _ANSI_ARGS_((ClientData clientData, | |
| 351 | Tcl_Interp *interp, char *name1, char *name2, | |
| 352 | int flags)); | |
| 353 | static int MenuWidgetObjCmd _ANSI_ARGS_((ClientData clientData, | |
| 354 | Tcl_Interp *interp, int objc, | |
| 355 | Tcl_Obj *CONST objv[])); | |
| 356 | static void MenuWorldChanged _ANSI_ARGS_(( | |
| 357 | ClientData instanceData)); | |
| 358 | static int PostProcessEntry _ANSI_ARGS_((TkMenuEntry *mePtr)); | |
| 359 | static void RecursivelyDeleteMenu _ANSI_ARGS_((TkMenu *menuPtr)); | |
| 360 | static void UnhookCascadeEntry _ANSI_ARGS_((TkMenuEntry *mePtr)); | |
| 361 | ||
| 362 | /* | |
| 363 | * The structure below is a list of procs that respond to certain window | |
| 364 | * manager events. One of these includes a font change, which forces | |
| 365 | * the geometry proc to be called. | |
| 366 | */ | |
| 367 | ||
| 368 | static TkClassProcs menuClass = { | |
| 369 | NULL, /* createProc. */ | |
| 370 | MenuWorldChanged /* geometryProc. */ | |
| 371 | }; | |
| 372 | ||
| 373 | /* | |
| 374 | *-------------------------------------------------------------- | |
| 375 | * | |
| 376 | * Tk_CreateMenuCmd -- | |
| 377 | * | |
| 378 | * Called by Tk at initialization time to create the menu | |
| 379 | * command. | |
| 380 | * | |
| 381 | * Results: | |
| 382 | * A standard Tcl result. | |
| 383 | * | |
| 384 | * Side effects: | |
| 385 | * See the user documentation. | |
| 386 | * | |
| 387 | *-------------------------------------------------------------- | |
| 388 | */ | |
| 389 | ||
| 390 | int | |
| 391 | TkCreateMenuCmd(interp) | |
| 392 | Tcl_Interp *interp; /* Interpreter we are creating the | |
| 393 | * command in. */ | |
| 394 | { | |
| 395 | TkMenuOptionTables *optionTablesPtr = | |
| 396 | (TkMenuOptionTables *) ckalloc(sizeof(TkMenuOptionTables)); | |
| 397 | ||
| 398 | optionTablesPtr->menuOptionTable = | |
| 399 | Tk_CreateOptionTable(interp, tkMenuConfigSpecs); | |
| 400 | optionTablesPtr->entryOptionTables[TEAROFF_ENTRY] = | |
| 401 | Tk_CreateOptionTable(interp, specsArray[TEAROFF_ENTRY]); | |
| 402 | optionTablesPtr->entryOptionTables[COMMAND_ENTRY] = | |
| 403 | Tk_CreateOptionTable(interp, specsArray[COMMAND_ENTRY]); | |
| 404 | optionTablesPtr->entryOptionTables[CASCADE_ENTRY] = | |
| 405 | Tk_CreateOptionTable(interp, specsArray[CASCADE_ENTRY]); | |
| 406 | optionTablesPtr->entryOptionTables[SEPARATOR_ENTRY] = | |
| 407 | Tk_CreateOptionTable(interp, specsArray[SEPARATOR_ENTRY]); | |
| 408 | optionTablesPtr->entryOptionTables[RADIO_BUTTON_ENTRY] = | |
| 409 | Tk_CreateOptionTable(interp, specsArray[RADIO_BUTTON_ENTRY]); | |
| 410 | optionTablesPtr->entryOptionTables[CHECK_BUTTON_ENTRY] = | |
| 411 | Tk_CreateOptionTable(interp, specsArray[CHECK_BUTTON_ENTRY]); | |
| 412 | ||
| 413 | Tcl_CreateObjCommand(interp, "menu", MenuCmd, | |
| 414 | (ClientData) optionTablesPtr, NULL); | |
| 415 | ||
| 416 | if (Tcl_IsSafe(interp)) { | |
| 417 | Tcl_HideCommand(interp, "menu", "menu"); | |
| 418 | } | |
| 419 | ||
| 420 | return TCL_OK; | |
| 421 | } | |
| 422 | ||
| 423 | /* | |
| 424 | *-------------------------------------------------------------- | |
| 425 | * | |
| 426 | * MenuCmd -- | |
| 427 | * | |
| 428 | * This procedure is invoked to process the "menu" Tcl | |
| 429 | * command. See the user documentation for details on | |
| 430 | * what it does. | |
| 431 | * | |
| 432 | * Results: | |
| 433 | * A standard Tcl result. | |
| 434 | * | |
| 435 | * Side effects: | |
| 436 | * See the user documentation. | |
| 437 | * | |
| 438 | *-------------------------------------------------------------- | |
| 439 | */ | |
| 440 | ||
| 441 | static int | |
| 442 | MenuCmd(clientData, interp, objc, objv) | |
| 443 | ClientData clientData; /* Main window associated with | |
| 444 | * interpreter. */ | |
| 445 | Tcl_Interp *interp; /* Current interpreter. */ | |
| 446 | int objc; /* Number of arguments. */ | |
| 447 | Tcl_Obj *CONST objv[]; /* Argument strings. */ | |
| 448 | { | |
| 449 | Tk_Window tkwin = Tk_MainWindow(interp); | |
| 450 | Tk_Window new; | |
| 451 | register TkMenu *menuPtr; | |
| 452 | TkMenuReferences *menuRefPtr; | |
| 453 | int i, index; | |
| 454 | int toplevel; | |
| 455 | char *windowName; | |
| 456 | static char *typeStringList[] = {"-type", (char *) NULL}; | |
| 457 | TkMenuOptionTables *optionTablesPtr = (TkMenuOptionTables *) clientData; | |
| 458 | ||
| 459 | if (objc < 2) { | |
| 460 | Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); | |
| 461 | return TCL_ERROR; | |
| 462 | } | |
| 463 | ||
| 464 | TkMenuInit(); | |
| 465 | ||
| 466 | toplevel = 1; | |
| 467 | for (i = 2; i < (objc - 1); i++) { | |
| 468 | if (Tcl_GetIndexFromObj(NULL, objv[i], typeStringList, NULL, 0, &index) | |
| 469 | != TCL_ERROR) { | |
| 470 | if ((Tcl_GetIndexFromObj(NULL, objv[i + 1], menuTypeStrings, NULL, | |
| 471 | 0, &index) == TCL_OK) && (index == MENUBAR)) { | |
| 472 | toplevel = 0; | |
| 473 | } | |
| 474 | break; | |
| 475 | } | |
| 476 | } | |
| 477 | ||
| 478 | windowName = Tcl_GetStringFromObj(objv[1], NULL); | |
| 479 | new = Tk_CreateWindowFromPath(interp, tkwin, windowName, toplevel ? "" | |
| 480 | : NULL); | |
| 481 | if (new == NULL) { | |
| 482 | return TCL_ERROR; | |
| 483 | } | |
| 484 | ||
| 485 | /* | |
| 486 | * Initialize the data structure for the menu. | |
| 487 | */ | |
| 488 | ||
| 489 | menuPtr = (TkMenu *) ckalloc(sizeof(TkMenu)); | |
| 490 | menuPtr->tkwin = new; | |
| 491 | menuPtr->display = Tk_Display(new); | |
| 492 | menuPtr->interp = interp; | |
| 493 | menuPtr->widgetCmd = Tcl_CreateObjCommand(interp, | |
| 494 | Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd, | |
| 495 | (ClientData) menuPtr, MenuCmdDeletedProc); | |
| 496 | menuPtr->entries = NULL; | |
| 497 | menuPtr->numEntries = 0; | |
| 498 | menuPtr->active = -1; | |
| 499 | menuPtr->borderPtr = NULL; | |
| 500 | menuPtr->borderWidthPtr = NULL; | |
| 501 | menuPtr->reliefPtr = NULL; | |
| 502 | menuPtr->activeBorderPtr = NULL; | |
| 503 | menuPtr->activeBorderWidthPtr = NULL; | |
| 504 | menuPtr->fontPtr = NULL; | |
| 505 | menuPtr->fgPtr = NULL; | |
| 506 | menuPtr->disabledFgPtr = NULL; | |
| 507 | menuPtr->activeFgPtr = NULL; | |
| 508 | menuPtr->indicatorFgPtr = NULL; | |
| 509 | menuPtr->tearoff = 0; | |
| 510 | menuPtr->tearoffCommandPtr = NULL; | |
| 511 | menuPtr->cursorPtr = None; | |
| 512 | menuPtr->takeFocusPtr = NULL; | |
| 513 | menuPtr->postCommandPtr = NULL; | |
| 514 | menuPtr->postCommandGeneration = 0; | |
| 515 | menuPtr->postedCascade = NULL; | |
| 516 | menuPtr->nextInstancePtr = NULL; | |
| 517 | menuPtr->masterMenuPtr = menuPtr; | |
| 518 | menuPtr->menuType = UNKNOWN_TYPE; | |
| 519 | menuPtr->menuFlags = 0; | |
| 520 | menuPtr->parentTopLevelPtr = NULL; | |
| 521 | menuPtr->menuTypePtr = NULL; | |
| 522 | menuPtr->titlePtr = NULL; | |
| 523 | menuPtr->errorStructPtr = NULL; | |
| 524 | menuPtr->optionTablesPtr = optionTablesPtr; | |
| 525 | TkMenuInitializeDrawingFields(menuPtr); | |
| 526 | ||
| 527 | Tk_SetClass(menuPtr->tkwin, "Menu"); | |
| 528 | TkSetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr); | |
| 529 | if (Tk_InitOptions(interp, (char *) menuPtr, | |
| 530 | menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin) | |
| 531 | != TCL_OK) { | |
| 532 | Tk_DestroyWindow(menuPtr->tkwin); | |
| 533 | ckfree((char *) menuPtr); | |
| 534 | return TCL_ERROR; | |
| 535 | } | |
| 536 | ||
| 537 | ||
| 538 | menuRefPtr = TkCreateMenuReferences(menuPtr->interp, | |
| 539 | Tk_PathName(menuPtr->tkwin)); | |
| 540 | menuRefPtr->menuPtr = menuPtr; | |
| 541 | menuPtr->menuRefPtr = menuRefPtr; | |
| 542 | if (TCL_OK != TkpNewMenu(menuPtr)) { | |
| 543 | Tk_DestroyWindow(menuPtr->tkwin); | |
| 544 | ckfree((char *) menuPtr); | |
| 545 | return TCL_ERROR; | |
| 546 | } | |
| 547 | ||
| 548 | Tk_CreateEventHandler(new, ExposureMask|StructureNotifyMask|ActivateMask, | |
| 549 | TkMenuEventProc, (ClientData) menuPtr); | |
| 550 | if (ConfigureMenu(interp, menuPtr, objc - 2, objv + 2) != TCL_OK) { | |
| 551 | Tk_DestroyWindow(menuPtr->tkwin); | |
| 552 | return TCL_ERROR; | |
| 553 | } | |
| 554 | ||
| 555 | /* | |
| 556 | * If a menu has a parent menu pointing to it as a cascade entry, the | |
| 557 | * parent menu needs to be told that this menu now exists so that | |
| 558 | * the platform-part of the menu is correctly updated. | |
| 559 | * | |
| 560 | * If a menu has an instance and has cascade entries, then each cascade | |
| 561 | * menu must also have a parallel instance. This is especially true on | |
| 562 | * the Mac, where each menu has to have a separate title everytime it is in | |
| 563 | * a menubar. For instance, say you have a menu .m1 with a cascade entry | |
| 564 | * for .m2, where .m2 does not exist yet. You then put .m1 into a menubar. | |
| 565 | * This creates a menubar instance for .m1, but since .m2 is not there, | |
| 566 | * nothing else happens. When we go to create .m2, we hook it up properly | |
| 567 | * with .m1. However, we now need to clone .m2 and assign the clone of .m2 | |
| 568 | * to be the cascade entry for the clone of .m1. This is special case | |
| 569 | * #1 listed in the introductory comment. | |
| 570 | */ | |
| 571 | ||
| 572 | if (menuRefPtr->parentEntryPtr != NULL) { | |
| 573 | TkMenuEntry *cascadeListPtr = menuRefPtr->parentEntryPtr; | |
| 574 | TkMenuEntry *nextCascadePtr; | |
| 575 | Tcl_Obj *newMenuName; | |
| 576 | Tcl_Obj *newObjv[2]; | |
| 577 | ||
| 578 | while (cascadeListPtr != NULL) { | |
| 579 | ||
| 580 | nextCascadePtr = cascadeListPtr->nextCascadePtr; | |
| 581 | ||
| 582 | /* | |
| 583 | * If we have a new master menu, and an existing cloned menu | |
| 584 | * points to this menu in a cascade entry, we have to clone | |
| 585 | * the new menu and point the entry to the clone instead | |
| 586 | * of the menu we are creating. Otherwise, ConfigureMenuEntry | |
| 587 | * will hook up the platform-specific cascade linkages now | |
| 588 | * that the menu we are creating exists. | |
| 589 | */ | |
| 590 | ||
| 591 | if ((menuPtr->masterMenuPtr != menuPtr) | |
| 592 | || ((menuPtr->masterMenuPtr == menuPtr) | |
| 593 | && ((cascadeListPtr->menuPtr->masterMenuPtr | |
| 594 | == cascadeListPtr->menuPtr)))) { | |
| 595 | newObjv[0] = Tcl_NewStringObj("-menu", -1); | |
| 596 | newObjv[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1); | |
| 597 | Tcl_IncrRefCount(newObjv[0]); | |
| 598 | Tcl_IncrRefCount(newObjv[1]); | |
| 599 | ConfigureMenuEntry(cascadeListPtr, 2, newObjv); | |
| 600 | Tcl_DecrRefCount(newObjv[0]); | |
| 601 | Tcl_DecrRefCount(newObjv[1]); | |
| 602 | } else { | |
| 603 | Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1); | |
| 604 | Tcl_Obj *windowNamePtr = Tcl_NewStringObj( | |
| 605 | Tk_PathName(cascadeListPtr->menuPtr->tkwin), -1); | |
| 606 | ||
| 607 | Tcl_IncrRefCount(normalPtr); | |
| 608 | Tcl_IncrRefCount(windowNamePtr); | |
| 609 | newMenuName = TkNewMenuName(menuPtr->interp, | |
| 610 | windowNamePtr, menuPtr); | |
| 611 | Tcl_IncrRefCount(newMenuName); | |
| 612 | CloneMenu(menuPtr, newMenuName, normalPtr); | |
| 613 | ||
| 614 | /* | |
| 615 | * Now we can set the new menu instance to be the cascade entry | |
| 616 | * of the parent's instance. | |
| 617 | */ | |
| 618 | ||
| 619 | newObjv[0] = Tcl_NewStringObj("-menu", -1); | |
| 620 | newObjv[1] = newMenuName; | |
| 621 | Tcl_IncrRefCount(newObjv[0]); | |
| 622 | ConfigureMenuEntry(cascadeListPtr, 2, newObjv); | |
| 623 | Tcl_DecrRefCount(normalPtr); | |
| 624 | Tcl_DecrRefCount(newObjv[0]); | |
| 625 | Tcl_DecrRefCount(newObjv[1]); | |
| 626 | Tcl_DecrRefCount(windowNamePtr); | |
| 627 | } | |
| 628 | cascadeListPtr = nextCascadePtr; | |
| 629 | } | |
| 630 | } | |
| 631 | ||
| 632 | /* | |
| 633 | * If there already exist toplevel widgets that refer to this menu, | |
| 634 | * find them and notify them so that they can reconfigure their | |
| 635 | * geometry to reflect the menu. | |
| 636 | */ | |
| 637 | ||
| 638 | if (menuRefPtr->topLevelListPtr != NULL) { | |
| 639 | TkMenuTopLevelList *topLevelListPtr = menuRefPtr->topLevelListPtr; | |
| 640 | TkMenuTopLevelList *nextPtr; | |
| 641 | Tk_Window listtkwin; | |
| 642 | while (topLevelListPtr != NULL) { | |
| 643 | ||
| 644 | /* | |
| 645 | * Need to get the next pointer first. TkSetWindowMenuBar | |
| 646 | * changes the list, so that the next pointer is different | |
| 647 | * after calling it. | |
| 648 | */ | |
| 649 | ||
| 650 | nextPtr = topLevelListPtr->nextPtr; | |
| 651 | listtkwin = topLevelListPtr->tkwin; | |
| 652 | TkSetWindowMenuBar(menuPtr->interp, listtkwin, | |
| 653 | Tk_PathName(menuPtr->tkwin), Tk_PathName(menuPtr->tkwin)); | |
| 654 | topLevelListPtr = nextPtr; | |
| 655 | } | |
| 656 | } | |
| 657 | ||
| 658 | Tcl_SetResult(interp, Tk_PathName(menuPtr->tkwin), TCL_STATIC); | |
| 659 | return TCL_OK; | |
| 660 | } | |
| 661 | ||
| 662 | /* | |
| 663 | *-------------------------------------------------------------- | |
| 664 | * | |
| 665 | * MenuWidgetObjCmd -- | |
| 666 | * | |
| 667 | * This procedure is invoked to process the Tcl command | |
| 668 | * that corresponds to a widget managed by this module. | |
| 669 | * See the user documentation for details on what it does. | |
| 670 | * | |
| 671 | * Results: | |
| 672 | * A standard Tcl result. | |
| 673 | * | |
| 674 | * Side effects: | |
| 675 | * See the user documentation. | |
| 676 | * | |
| 677 | *-------------------------------------------------------------- | |
| 678 | */ | |
| 679 | ||
| 680 | static int | |
| 681 | MenuWidgetObjCmd(clientData, interp, objc, objv) | |
| 682 | ClientData clientData; /* Information about menu widget. */ | |
| 683 | Tcl_Interp *interp; /* Current interpreter. */ | |
| 684 | int objc; /* Number of arguments. */ | |
| 685 | Tcl_Obj *CONST objv[]; /* Argument strings. */ | |
| 686 | { | |
| 687 | register TkMenu *menuPtr = (TkMenu *) clientData; | |
| 688 | register TkMenuEntry *mePtr; | |
| 689 | int result = TCL_OK; | |
| 690 | int option; | |
| 691 | ||
| 692 | if (objc < 2) { | |
| 693 | Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); | |
| 694 | return TCL_ERROR; | |
| 695 | } | |
| 696 | if (Tcl_GetIndexFromObj(interp, objv[1], menuOptions, "option", 0, | |
| 697 | &option) != TCL_OK) { | |
| 698 | return TCL_ERROR; | |
| 699 | } | |
| 700 | Tcl_Preserve((ClientData) menuPtr); | |
| 701 | ||
| 702 | switch ((enum options) option) { | |
| 703 | case MENU_ACTIVATE: { | |
| 704 | int index; | |
| 705 | ||
| 706 | if (objc != 3) { | |
| 707 | Tcl_WrongNumArgs(interp, 1, objv, "activate index"); | |
| 708 | goto error; | |
| 709 | } | |
| 710 | if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | |
| 711 | != TCL_OK) { | |
| 712 | goto error; | |
| 713 | } | |
| 714 | if (menuPtr->active == index) { | |
| 715 | goto done; | |
| 716 | } | |
| 717 | if ((index >= 0) | |
| 718 | && ((menuPtr->entries[index]->type == SEPARATOR_ENTRY) | |
| 719 | || (menuPtr->entries[index]->state | |
| 720 | == ENTRY_DISABLED))) { | |
| 721 | index = -1; | |
| 722 | } | |
| 723 | result = TkActivateMenuEntry(menuPtr, index); | |
| 724 | break; | |
| 725 | } | |
| 726 | case MENU_ADD: | |
| 727 | if (objc < 3) { | |
| 728 | Tcl_WrongNumArgs(interp, 1, objv, "add type ?options?"); | |
| 729 | goto error; | |
| 730 | } | |
| 731 | ||
| 732 | if (MenuAddOrInsert(interp, menuPtr, (Tcl_Obj *) NULL, | |
| 733 | objc - 2, objv + 2) != TCL_OK) { | |
| 734 | goto error; | |
| 735 | } | |
| 736 | break; | |
| 737 | case MENU_CGET: { | |
| 738 | Tcl_Obj *resultPtr; | |
| 739 | ||
| 740 | if (objc != 3) { | |
| 741 | Tcl_WrongNumArgs(interp, 1, objv, "cget option"); | |
| 742 | goto error; | |
| 743 | } | |
| 744 | resultPtr = Tk_GetOptionValue(interp, (char *) menuPtr, | |
| 745 | menuPtr->optionTablesPtr->menuOptionTable, objv[2], | |
| 746 | menuPtr->tkwin); | |
| 747 | if (resultPtr == NULL) { | |
| 748 | goto error; | |
| 749 | } | |
| 750 | Tcl_SetObjResult(interp, resultPtr); | |
| 751 | break; | |
| 752 | } | |
| 753 | case MENU_CLONE: | |
| 754 | if ((objc < 3) || (objc > 4)) { | |
| 755 | Tcl_WrongNumArgs(interp, 1, objv, | |
| 756 | "clone newMenuName ?menuType?"); | |
| 757 | goto error; | |
| 758 | } | |
| 759 | result = CloneMenu(menuPtr, objv[2], (objc == 3) ? NULL : objv[3]); | |
| 760 | break; | |
| 761 | case MENU_CONFIGURE: { | |
| 762 | Tcl_Obj *resultPtr; | |
| 763 | ||
| 764 | if (objc == 2) { | |
| 765 | resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr, | |
| 766 | menuPtr->optionTablesPtr->menuOptionTable, | |
| 767 | (Tcl_Obj *) NULL, menuPtr->tkwin); | |
| 768 | if (resultPtr == NULL) { | |
| 769 | result = TCL_ERROR; | |
| 770 | } else { | |
| 771 | result = TCL_OK; | |
| 772 | Tcl_SetObjResult(interp, resultPtr); | |
| 773 | } | |
| 774 | } else if (objc == 3) { | |
| 775 | resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr, | |
| 776 | menuPtr->optionTablesPtr->menuOptionTable, | |
| 777 | objv[2], menuPtr->tkwin); | |
| 778 | if (resultPtr == NULL) { | |
| 779 | result = TCL_ERROR; | |
| 780 | } else { | |
| 781 | result = TCL_OK; | |
| 782 | Tcl_SetObjResult(interp, resultPtr); | |
| 783 | } | |
| 784 | } else { | |
| 785 | result = ConfigureMenu(interp, menuPtr, objc - 2, objv + 2); | |
| 786 | } | |
| 787 | if (result != TCL_OK) { | |
| 788 | goto error; | |
| 789 | } | |
| 790 | break; | |
| 791 | } | |
| 792 | case MENU_DELETE: { | |
| 793 | int first, last; | |
| 794 | ||
| 795 | if ((objc != 3) && (objc != 4)) { | |
| 796 | Tcl_WrongNumArgs(interp, 1, objv, "delete first ?last?"); | |
| 797 | goto error; | |
| 798 | } | |
| 799 | if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &first) | |
| 800 | != TCL_OK) { | |
| 801 | goto error; | |
| 802 | } | |
| 803 | if (objc == 3) { | |
| 804 | last = first; | |
| 805 | } else { | |
| 806 | if (TkGetMenuIndex(interp, menuPtr, objv[3], 0, &last) | |
| 807 | != TCL_OK) { | |
| 808 | goto error; | |
| 809 | } | |
| 810 | } | |
| 811 | if (menuPtr->tearoff && (first == 0)) { | |
| 812 | ||
| 813 | /* | |
| 814 | * Sorry, can't delete the tearoff entry; must reconfigure | |
| 815 | * the menu. | |
| 816 | */ | |
| 817 | ||
| 818 | first = 1; | |
| 819 | } | |
| 820 | if ((first < 0) || (last < first)) { | |
| 821 | goto done; | |
| 822 | } | |
| 823 | DeleteMenuCloneEntries(menuPtr, first, last); | |
| 824 | break; | |
| 825 | } | |
| 826 | case MENU_ENTRYCGET: { | |
| 827 | int index; | |
| 828 | Tcl_Obj *resultPtr; | |
| 829 | ||
| 830 | if (objc != 4) { | |
| 831 | Tcl_WrongNumArgs(interp, 1, objv, "entrycget index option"); | |
| 832 | goto error; | |
| 833 | } | |
| 834 | if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | |
| 835 | != TCL_OK) { | |
| 836 | goto error; | |
| 837 | } | |
| 838 | if (index < 0) { | |
| 839 | goto done; | |
| 840 | } | |
| 841 | mePtr = menuPtr->entries[index]; | |
| 842 | Tcl_Preserve((ClientData) mePtr); | |
| 843 | resultPtr = Tk_GetOptionValue(interp, (char *) mePtr, | |
| 844 | mePtr->optionTable, objv[3], menuPtr->tkwin); | |
| 845 | Tcl_Release((ClientData) mePtr); | |
| 846 | if (resultPtr == NULL) { | |
| 847 | goto error; | |
| 848 | } | |
| 849 | Tcl_SetObjResult(interp, resultPtr); | |
| 850 | break; | |
| 851 | } | |
| 852 | case MENU_ENTRYCONFIGURE: { | |
| 853 | int index; | |
| 854 | Tcl_Obj *resultPtr; | |
| 855 | ||
| 856 | if (objc < 3) { | |
| 857 | Tcl_WrongNumArgs(interp, 1, objv, | |
| 858 | "entryconfigure index ?option value ...?"); | |
| 859 | goto error; | |
| 860 | } | |
| 861 | if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | |
| 862 | != TCL_OK) { | |
| 863 | goto error; | |
| 864 | } | |
| 865 | if (index < 0) { | |
| 866 | goto done; | |
| 867 | } | |
| 868 | mePtr = menuPtr->entries[index]; | |
| 869 | Tcl_Preserve((ClientData) mePtr); | |
| 870 | if (objc == 3) { | |
| 871 | resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr, | |
| 872 | mePtr->optionTable, (Tcl_Obj *) NULL, menuPtr->tkwin); | |
| 873 | if (resultPtr == NULL) { | |
| 874 | result = TCL_ERROR; | |
| 875 | } else { | |
| 876 | result = TCL_OK; | |
| 877 | Tcl_SetObjResult(interp, resultPtr); | |
| 878 | } | |
| 879 | } else if (objc == 4) { | |
| 880 | resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr, | |
| 881 | mePtr->optionTable, objv[3], menuPtr->tkwin); | |
| 882 | if (resultPtr == NULL) { | |
| 883 | result = TCL_ERROR; | |
| 884 | } else { | |
| 885 | result = TCL_OK; | |
| 886 | Tcl_SetObjResult(interp, resultPtr); | |
| 887 | } | |
| 888 | } else { | |
| 889 | result = ConfigureMenuCloneEntries(interp, menuPtr, index, | |
| 890 | objc - 3, objv + 3); | |
| 891 | } | |
| 892 | Tcl_Release((ClientData) mePtr); | |
| 893 | break; | |
| 894 | } | |
| 895 | case MENU_INDEX: { | |
| 896 | int index; | |
| 897 | ||
| 898 | if (objc != 3) { | |
| 899 | Tcl_WrongNumArgs(interp, 1, objv, "index string"); | |
| 900 | goto error; | |
| 901 | } | |
| 902 | if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | |
| 903 | != TCL_OK) { | |
| 904 | goto error; | |
| 905 | } | |
| 906 | if (index < 0) { | |
| 907 | Tcl_SetResult(interp, "none", TCL_STATIC); | |
| 908 | } else { | |
| 909 | Tcl_SetIntObj(Tcl_GetObjResult(interp), index); | |
| 910 | } | |
| 911 | break; | |
| 912 | } | |
| 913 | case MENU_INSERT: | |
| 914 | if (objc < 4) { | |
| 915 | Tcl_WrongNumArgs(interp, 1, objv, | |
| 916 | "insert index type ?options?"); | |
| 917 | goto error; | |
| 918 | } | |
| 919 | if (MenuAddOrInsert(interp, menuPtr, objv[2], objc - 3, | |
| 920 | objv + 3) != TCL_OK) { | |
| 921 | goto error; | |
| 922 | } | |
| 923 | break; | |
| 924 | case MENU_INVOKE: { | |
| 925 | int index; | |
| 926 | ||
| 927 | if (objc != 3) { | |
| 928 | Tcl_WrongNumArgs(interp, 1, objv, "invoke index"); | |
| 929 | goto error; | |
| 930 | } | |
| 931 | if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | |
| 932 | != TCL_OK) { | |
| 933 | goto error; | |
| 934 | } | |
| 935 | if (index < 0) { | |
| 936 | goto done; | |
| 937 | } | |
| 938 | result = TkInvokeMenu(interp, menuPtr, index); | |
| 939 | break; | |
| 940 | } | |
| 941 | case MENU_POST: { | |
| 942 | int x, y; | |
| 943 | ||
| 944 | if (objc != 4) { | |
| 945 | Tcl_WrongNumArgs(interp, 1, objv, "post x y"); | |
| 946 | goto error; | |
| 947 | } | |
| 948 | if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) | |
| 949 | || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { | |
| 950 | goto error; | |
| 951 | } | |
| 952 | ||
| 953 | /* | |
| 954 | * Tearoff menus are posted differently on Mac and Windows than | |
| 955 | * non-tearoffs. TkpPostMenu does not actually map the menu's | |
| 956 | * window on those platforms, and popup menus have to be | |
| 957 | * handled specially. | |
| 958 | */ | |
| 959 | ||
| 960 | if (menuPtr->menuType != TEAROFF_MENU) { | |
| 961 | result = TkpPostMenu(interp, menuPtr, x, y); | |
| 962 | } else { | |
| 963 | result = TkPostTearoffMenu(interp, menuPtr, x, y); | |
| 964 | } | |
| 965 | break; | |
| 966 | } | |
| 967 | case MENU_POSTCASCADE: { | |
| 968 | int index; | |
| 969 | ||
| 970 | if (objc != 3) { | |
| 971 | Tcl_WrongNumArgs(interp, 1, objv, "postcascade index"); | |
| 972 | goto error; | |
| 973 | } | |
| 974 | ||
| 975 | if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | |
| 976 | != TCL_OK) { | |
| 977 | goto error; | |
| 978 | } | |
| 979 | if ((index < 0) || (menuPtr->entries[index]->type | |
| 980 | != CASCADE_ENTRY)) { | |
| 981 | result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL); | |
| 982 | } else { | |
| 983 | result = TkPostSubmenu(interp, menuPtr, | |
| 984 | menuPtr->entries[index]); | |
| 985 | } | |
| 986 | break; | |
| 987 | } | |
| 988 | case MENU_TYPE: { | |
| 989 | int index; | |
| 990 | ||
| 991 | if (objc != 3) { | |
| 992 | Tcl_WrongNumArgs(interp, 1, objv, "type index"); | |
| 993 | goto error; | |
| 994 | } | |
| 995 | if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) | |
| 996 | != TCL_OK) { | |
| 997 | goto error; | |
| 998 | } | |
| 999 | if (index < 0) { | |
| 1000 | goto done; | |
| 1001 | } | |
| 1002 | if (menuPtr->entries[index]->type == TEAROFF_ENTRY) { | |
| 1003 | Tcl_SetResult(interp, "tearoff", TCL_STATIC); | |
| 1004 | } else { | |
| 1005 | Tcl_SetResult(interp, | |
| 1006 | menuEntryTypeStrings[menuPtr->entries[index]->type], | |
| 1007 | TCL_STATIC); | |
| 1008 | } | |
| 1009 | break; | |
| 1010 | } | |
| 1011 | case MENU_UNPOST: | |
| 1012 | if (objc != 2) { | |
| 1013 | Tcl_WrongNumArgs(interp, 1, objv, "unpost"); | |
| 1014 | goto error; | |
| 1015 | } | |
| 1016 | Tk_UnmapWindow(menuPtr->tkwin); | |
| 1017 | result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL); | |
| 1018 | break; | |
| 1019 | case MENU_YPOSITION: | |
| 1020 | if (objc != 3) { | |
| 1021 | Tcl_WrongNumArgs(interp, 1, objv, "yposition index"); | |
| 1022 | goto error; | |
| 1023 | } | |
| 1024 | result = MenuDoYPosition(interp, menuPtr, objv[2]); | |
| 1025 | break; | |
| 1026 | } | |
| 1027 | done: | |
| 1028 | Tcl_Release((ClientData) menuPtr); | |
| 1029 | return result; | |
| 1030 | ||
| 1031 | error: | |
| 1032 | Tcl_Release((ClientData) menuPtr); | |
| 1033 | return TCL_ERROR; | |
| 1034 | } | |
| 1035 | ||
| 1036 | /* | |
| 1037 | *---------------------------------------------------------------------- | |
| 1038 | * | |
| 1039 | * TkInvokeMenu -- | |
| 1040 | * | |
| 1041 | * Given a menu and an index, takes the appropriate action for the | |
| 1042 | * entry associated with that index. | |
| 1043 | * | |
| 1044 | * Results: | |
| 1045 | * Standard Tcl result. | |
| 1046 | * | |
| 1047 | * Side effects: | |
| 1048 | * Commands may get excecuted; variables may get set; sub-menus may | |
| 1049 | * get posted. | |
| 1050 | * | |
| 1051 | *---------------------------------------------------------------------- | |
| 1052 | */ | |
| 1053 | ||
| 1054 | int | |
| 1055 | TkInvokeMenu(interp, menuPtr, index) | |
| 1056 | Tcl_Interp *interp; /* The interp that the menu lives in. */ | |
| 1057 | TkMenu *menuPtr; /* The menu we are invoking. */ | |
| 1058 | int index; /* The zero based index of the item we | |
| 1059 | * are invoking */ | |
| 1060 | { | |
| 1061 | int result = TCL_OK; | |
| 1062 | TkMenuEntry *mePtr; | |
| 1063 | ||
| 1064 | if (index < 0) { | |
| 1065 | goto done; | |
| 1066 | } | |
| 1067 | mePtr = menuPtr->entries[index]; | |
| 1068 | if (mePtr->state == ENTRY_DISABLED) { | |
| 1069 | goto done; | |
| 1070 | } | |
| 1071 | Tcl_Preserve((ClientData) mePtr); | |
| 1072 | if (mePtr->type == TEAROFF_ENTRY) { | |
| 1073 | Tcl_DString ds; | |
| 1074 | Tcl_DStringInit(&ds); | |
| 1075 | Tcl_DStringAppend(&ds, "tkTearOffMenu ", -1); | |
| 1076 | Tcl_DStringAppend(&ds, Tk_PathName(menuPtr->tkwin), -1); | |
| 1077 | result = Tcl_Eval(interp, Tcl_DStringValue(&ds)); | |
| 1078 | Tcl_DStringFree(&ds); | |
| 1079 | } else if ((mePtr->type == CHECK_BUTTON_ENTRY) | |
| 1080 | && (mePtr->namePtr != NULL)) { | |
| 1081 | Tcl_Obj *valuePtr; | |
| 1082 | ||
| 1083 | if (mePtr->entryFlags & ENTRY_SELECTED) { | |
| 1084 | valuePtr = mePtr->offValuePtr; | |
| 1085 | } else { | |
| 1086 | valuePtr = mePtr->onValuePtr; | |
| 1087 | } | |
| 1088 | if (valuePtr == NULL) { | |
| 1089 | valuePtr = Tcl_NewObj(); | |
| 1090 | } | |
| 1091 | Tcl_IncrRefCount(valuePtr); | |
| 1092 | if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr, | |
| 1093 | TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { | |
| 1094 | result = TCL_ERROR; | |
| 1095 | } | |
| 1096 | Tcl_DecrRefCount(valuePtr); | |
| 1097 | } else if ((mePtr->type == RADIO_BUTTON_ENTRY) | |
| 1098 | && (mePtr->namePtr != NULL)) { | |
| 1099 | Tcl_Obj *valuePtr = mePtr->onValuePtr; | |
| 1100 | ||
| 1101 | if (valuePtr == NULL) { | |
| 1102 | valuePtr = Tcl_NewObj(); | |
| 1103 | } | |
| 1104 | Tcl_IncrRefCount(valuePtr); | |
| 1105 | if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr, | |
| 1106 | TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { | |
| 1107 | result = TCL_ERROR; | |
| 1108 | } | |
| 1109 | Tcl_DecrRefCount(valuePtr); | |
| 1110 | } | |
| 1111 | if ((result == TCL_OK) && (mePtr->commandPtr != NULL)) { | |
| 1112 | Tcl_Obj *commandPtr = mePtr->commandPtr; | |
| 1113 | ||
| 1114 | Tcl_IncrRefCount(commandPtr); | |
| 1115 | result = Tcl_EvalObjEx(interp, commandPtr, TCL_EVAL_GLOBAL); | |
| 1116 | Tcl_DecrRefCount(commandPtr); | |
| 1117 | } | |
| 1118 | Tcl_Release((ClientData) mePtr); | |
| 1119 | done: | |
| 1120 | return result; | |
| 1121 | } | |
| 1122 | ||
| 1123 | /* | |
| 1124 | *---------------------------------------------------------------------- | |
| 1125 | * | |
| 1126 | * DestroyMenuInstance -- | |
| 1127 | * | |
| 1128 | * This procedure is invoked by TkDestroyMenu | |
| 1129 | * to clean up the internal structure of a menu at a safe time | |
| 1130 | * (when no-one is using it anymore). Only takes care of one instance | |
| 1131 | * of the menu. | |
| 1132 | * | |
| 1133 | * Results: | |
| 1134 | * None. | |
| 1135 | * | |
| 1136 | * Side effects: | |
| 1137 | * Everything associated with the menu is freed up. | |
| 1138 | * | |
| 1139 | *---------------------------------------------------------------------- | |
| 1140 | */ | |
| 1141 | ||
| 1142 | static void | |
| 1143 | DestroyMenuInstance(menuPtr) | |
| 1144 | TkMenu *menuPtr; /* Info about menu widget. */ | |
| 1145 | { | |
| 1146 | int i; | |
| 1147 | TkMenu *menuInstancePtr; | |
| 1148 | TkMenuEntry *cascadePtr, *nextCascadePtr; | |
| 1149 | Tcl_Obj *newObjv[2]; | |
| 1150 | TkMenu *parentMasterMenuPtr; | |
| 1151 | TkMenuEntry *parentMasterEntryPtr; | |
| 1152 | ||
| 1153 | /* | |
| 1154 | * If the menu has any cascade menu entries pointing to it, the cascade | |
| 1155 | * entries need to be told that the menu is going away. We need to clear | |
| 1156 | * the menu ptr field in the menu reference at this point in the code | |
| 1157 | * so that everything else can forget about this menu properly. We also | |
| 1158 | * need to reset -menu field of all entries that are not master menus | |
| 1159 | * back to this entry name if this is a master menu pointed to by another | |
| 1160 | * master menu. If there is a clone menu that points to this menu, | |
| 1161 | * then this menu is itself a clone, so when this menu goes away, | |
| 1162 | * the -menu field of the pointing entry must be set back to this | |
| 1163 | * menu's master menu name so that later if another menu is created | |
| 1164 | * the cascade hierarchy can be maintained. | |
| 1165 | */ | |
| 1166 | ||
| 1167 | TkpDestroyMenu(menuPtr); | |
| 1168 | cascadePtr = menuPtr->menuRefPtr->parentEntryPtr; | |
| 1169 | menuPtr->menuRefPtr->menuPtr = NULL; | |
| 1170 | TkFreeMenuReferences(menuPtr->menuRefPtr); | |
| 1171 | ||
| 1172 | for (; cascadePtr != NULL; cascadePtr = nextCascadePtr) { | |
| 1173 | nextCascadePtr = cascadePtr->nextCascadePtr; | |
| 1174 | ||
| 1175 | if (menuPtr->masterMenuPtr != menuPtr) { | |
| 1176 | Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1); | |
| 1177 | ||
| 1178 | parentMasterMenuPtr = cascadePtr->menuPtr->masterMenuPtr; | |
| 1179 | parentMasterEntryPtr = | |
| 1180 | parentMasterMenuPtr->entries[cascadePtr->index]; | |
| 1181 | newObjv[0] = menuNamePtr; | |
| 1182 | newObjv[1] = parentMasterEntryPtr->namePtr; | |
| 1183 | /* | |
| 1184 | * It is possible that the menu info is out of sync, and | |
| 1185 | * these things point to NULL, so verify existence [Bug: 3402] | |
| 1186 | */ | |
| 1187 | if (newObjv[0] && newObjv[1]) { | |
| 1188 | Tcl_IncrRefCount(newObjv[0]); | |
| 1189 | Tcl_IncrRefCount(newObjv[1]); | |
| 1190 | ConfigureMenuEntry(cascadePtr, 2, newObjv); | |
| 1191 | Tcl_DecrRefCount(newObjv[0]); | |
| 1192 | Tcl_DecrRefCount(newObjv[1]); | |
| 1193 | } | |
| 1194 | } else { | |
| 1195 | ConfigureMenuEntry(cascadePtr, 0, (Tcl_Obj **) NULL); | |
| 1196 | } | |
| 1197 | } | |
| 1198 | ||
| 1199 | if (menuPtr->masterMenuPtr != menuPtr) { | |
| 1200 | for (menuInstancePtr = menuPtr->masterMenuPtr; | |
| 1201 | menuInstancePtr != NULL; | |
| 1202 | menuInstancePtr = menuInstancePtr->nextInstancePtr) { | |
| 1203 | if (menuInstancePtr->nextInstancePtr == menuPtr) { | |
| 1204 | menuInstancePtr->nextInstancePtr = | |
| 1205 | menuInstancePtr->nextInstancePtr->nextInstancePtr; | |
| 1206 | break; | |
| 1207 | } | |
| 1208 | } | |
| 1209 | } else if (menuPtr->nextInstancePtr != NULL) { | |
| 1210 | panic("Attempting to delete master menu when there are still clones."); | |
| 1211 | } | |
| 1212 | ||
| 1213 | /* | |
| 1214 | * Free up all the stuff that requires special handling, then | |
| 1215 | * let Tk_FreeConfigOptions handle all the standard option-related | |
| 1216 | * stuff. | |
| 1217 | */ | |
| 1218 | ||
| 1219 | for (i = menuPtr->numEntries; --i >= 0; ) { | |
| 1220 | /* | |
| 1221 | * As each menu entry is deleted from the end of the array of | |
| 1222 | * entries, decrement menuPtr->numEntries. Otherwise, the act of | |
| 1223 | * deleting menu entry i will dereference freed memory attempting | |
| 1224 | * to queue a redraw for menu entries (i+1)...numEntries. | |
| 1225 | */ | |
| 1226 | ||
| 1227 | DestroyMenuEntry((char *) menuPtr->entries[i]); | |
| 1228 | menuPtr->numEntries = i; | |
| 1229 | } | |
| 1230 | if (menuPtr->entries != NULL) { | |
| 1231 | ckfree((char *) menuPtr->entries); | |
| 1232 | } | |
| 1233 | TkMenuFreeDrawOptions(menuPtr); | |
| 1234 | Tk_FreeConfigOptions((char *) menuPtr, | |
| 1235 | menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin); | |
| 1236 | } | |
| 1237 | ||
| 1238 | /* | |
| 1239 | *---------------------------------------------------------------------- | |
| 1240 | * | |
| 1241 | * TkDestroyMenu -- | |
| 1242 | * | |
| 1243 | * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release | |
| 1244 | * to clean up the internal structure of a menu at a safe time | |
| 1245 | * (when no-one is using it anymore). If called on a master instance, | |
| 1246 | * destroys all of the slave instances. If called on a non-master | |
| 1247 | * instance, just destroys that instance. | |
| 1248 | * | |
| 1249 | * Results: | |
| 1250 | * None. | |
| 1251 | * | |
| 1252 | * Side effects: | |
| 1253 | * Everything associated with the menu is freed up. | |
| 1254 | * | |
| 1255 | *---------------------------------------------------------------------- | |
| 1256 | */ | |
| 1257 | ||
| 1258 | void | |
| 1259 | TkDestroyMenu(menuPtr) | |
| 1260 | TkMenu *menuPtr; /* Info about menu widget. */ | |
| 1261 | { | |
| 1262 | TkMenu *menuInstancePtr; | |
| 1263 | TkMenuTopLevelList *topLevelListPtr, *nextTopLevelPtr; | |
| 1264 | ||
| 1265 | if (menuPtr->menuFlags & MENU_DELETION_PENDING) { | |
| 1266 | return; | |
| 1267 | } | |
| 1268 | ||
| 1269 | /* | |
| 1270 | * Now destroy all non-tearoff instances of this menu if this is a | |
| 1271 | * parent menu. Is this loop safe enough? Are there going to be | |
| 1272 | * destroy bindings on child menus which kill the parent? If not, | |
| 1273 | * we have to do a slightly more complex scheme. | |
| 1274 | */ | |
| 1275 | ||
| 1276 | if (menuPtr->masterMenuPtr == menuPtr) { | |
| 1277 | menuPtr->menuFlags |= MENU_DELETION_PENDING; | |
| 1278 | while (menuPtr->nextInstancePtr != NULL) { | |
| 1279 | menuInstancePtr = menuPtr->nextInstancePtr; | |
| 1280 | menuPtr->nextInstancePtr = menuInstancePtr->nextInstancePtr; | |
| 1281 | if (menuInstancePtr->tkwin != NULL) { | |
| 1282 | Tk_DestroyWindow(menuInstancePtr->tkwin); | |
| 1283 | } | |
| 1284 | } | |
| 1285 | menuPtr->menuFlags &= ~MENU_DELETION_PENDING; | |
| 1286 | } | |
| 1287 | ||
| 1288 | /* | |
| 1289 | * If any toplevel widgets have this menu as their menubar, | |
| 1290 | * the geometry of the window may have to be recalculated. | |
| 1291 | */ | |
| 1292 | ||
| 1293 | topLevelListPtr = menuPtr->menuRefPtr->topLevelListPtr; | |
| 1294 | while (topLevelListPtr != NULL) { | |
| 1295 | nextTopLevelPtr = topLevelListPtr->nextPtr; | |
| 1296 | TkpSetWindowMenuBar(topLevelListPtr->tkwin, NULL); | |
| 1297 | topLevelListPtr = nextTopLevelPtr; | |
| 1298 | } | |
| 1299 | DestroyMenuInstance(menuPtr); | |
| 1300 | } | |
| 1301 | ||
| 1302 | /* | |
| 1303 | *---------------------------------------------------------------------- | |
| 1304 | * | |
| 1305 | * UnhookCascadeEntry -- | |
| 1306 | * | |
| 1307 | * This entry is removed from the list of entries that point to the | |
| 1308 | * cascade menu. This is done in preparation for changing the menu | |
| 1309 | * that this entry points to. | |
| 1310 | * | |
| 1311 | * Results: | |
| 1312 | * None | |
| 1313 | * | |
| 1314 | * Side effects: | |
| 1315 | * The appropriate lists are modified. | |
| 1316 | * | |
| 1317 | *---------------------------------------------------------------------- | |
| 1318 | */ | |
| 1319 | ||
| 1320 | static void | |
| 1321 | UnhookCascadeEntry(mePtr) | |
| 1322 | TkMenuEntry *mePtr; /* The cascade entry we are removing | |
| 1323 | * from the cascade list. */ | |
| 1324 | { | |
| 1325 | TkMenuEntry *cascadeEntryPtr; | |
| 1326 | TkMenuEntry *prevCascadePtr; | |
| 1327 | TkMenuReferences *menuRefPtr; | |
| 1328 | ||
| 1329 | menuRefPtr = mePtr->childMenuRefPtr; | |
| 1330 | if (menuRefPtr == NULL) { | |
| 1331 | return; | |
| 1332 | } | |
| 1333 | ||
| 1334 | cascadeEntryPtr = menuRefPtr->parentEntryPtr; | |
| 1335 | if (cascadeEntryPtr == NULL) { | |
| 1336 | return; | |
| 1337 | } | |
| 1338 | ||
| 1339 | /* | |
| 1340 | * Singularly linked list deletion. The two special cases are | |
| 1341 | * 1. one element; 2. The first element is the one we want. | |
| 1342 | */ | |
| 1343 | ||
| 1344 | if (cascadeEntryPtr == mePtr) { | |
| 1345 | if (cascadeEntryPtr->nextCascadePtr == NULL) { | |
| 1346 | ||
| 1347 | /* | |
| 1348 | * This is the last menu entry which points to this | |
| 1349 | * menu, so we need to clear out the list pointer in the | |
| 1350 | * cascade itself. | |
| 1351 | */ | |
| 1352 | ||
| 1353 | menuRefPtr->parentEntryPtr = NULL; | |
| 1354 | TkFreeMenuReferences(menuRefPtr); | |
| 1355 | } else { | |
| 1356 | menuRefPtr->parentEntryPtr = cascadeEntryPtr->nextCascadePtr; | |
| 1357 | } | |
| 1358 | mePtr->nextCascadePtr = NULL; | |
| 1359 | } else { | |
| 1360 | for (prevCascadePtr = cascadeEntryPtr, | |
| 1361 | cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr; | |
| 1362 | cascadeEntryPtr != NULL; | |
| 1363 | prevCascadePtr = cascadeEntryPtr, | |
| 1364 | cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) { | |
| 1365 | if (cascadeEntryPtr == mePtr){ | |
| 1366 | prevCascadePtr->nextCascadePtr = | |
| 1367 | cascadeEntryPtr->nextCascadePtr; | |
| 1368 | cascadeEntryPtr->nextCascadePtr = NULL; | |
| 1369 | break; | |
| 1370 | } | |
| 1371 | } | |
| 1372 | } | |
| 1373 | mePtr->childMenuRefPtr = NULL; | |
| 1374 | } | |
| 1375 | ||
| 1376 | /* | |
| 1377 | *---------------------------------------------------------------------- | |
| 1378 | * | |
| 1379 | * DestroyMenuEntry -- | |
| 1380 | * | |
| 1381 | * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release | |
| 1382 | * to clean up the internal structure of a menu entry at a safe time | |
| 1383 | * (when no-one is using it anymore). | |
| 1384 | * | |
| 1385 | * Results: | |
| 1386 | * None. | |
| 1387 | * | |
| 1388 | * Side effects: | |
| 1389 | * Everything associated with the menu entry is freed. | |
| 1390 | * | |
| 1391 | *---------------------------------------------------------------------- | |
| 1392 | */ | |
| 1393 | ||
| 1394 | static void | |
| 1395 | DestroyMenuEntry(memPtr) | |
| 1396 | char *memPtr; /* Pointer to entry to be freed. */ | |
| 1397 | { | |
| 1398 | register TkMenuEntry *mePtr = (TkMenuEntry *) memPtr; | |
| 1399 | TkMenu *menuPtr = mePtr->menuPtr; | |
| 1400 | ||
| 1401 | if (menuPtr->postedCascade == mePtr) { | |
| 1402 | ||
| 1403 | /* | |
| 1404 | * Ignore errors while unposting the menu, since it's possible | |
| 1405 | * that the menu has already been deleted and the unpost will | |
| 1406 | * generate an error. | |
| 1407 | */ | |
| 1408 | ||
| 1409 | TkPostSubmenu(menuPtr->interp, menuPtr, (TkMenuEntry *) NULL); | |
| 1410 | } | |
| 1411 | ||
| 1412 | /* | |
| 1413 | * Free up all the stuff that requires special handling, then | |
| 1414 | * let Tk_FreeConfigOptions handle all the standard option-related | |
| 1415 | * stuff. | |
| 1416 | */ | |
| 1417 | ||
| 1418 | if (mePtr->type == CASCADE_ENTRY) { | |
| 1419 | UnhookCascadeEntry(mePtr); | |
| 1420 | } | |
| 1421 | if (mePtr->image != NULL) { | |
| 1422 | Tk_FreeImage(mePtr->image); | |
| 1423 | } | |
| 1424 | if (mePtr->selectImage != NULL) { | |
| 1425 | Tk_FreeImage(mePtr->selectImage); | |
| 1426 | } | |
| 1427 | if (((mePtr->type == CHECK_BUTTON_ENTRY) | |
| 1428 | || (mePtr->type == RADIO_BUTTON_ENTRY)) | |
| 1429 | && (mePtr->namePtr != NULL)) { | |
| 1430 | char *varName = Tcl_GetStringFromObj(mePtr->namePtr, NULL); | |
| 1431 | Tcl_UntraceVar(menuPtr->interp, varName, | |
| 1432 | TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, | |
| 1433 | MenuVarProc, (ClientData) mePtr); | |
| 1434 | } | |
| 1435 | TkpDestroyMenuEntry(mePtr); | |
| 1436 | TkMenuEntryFreeDrawOptions(mePtr); | |
| 1437 | Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, menuPtr->tkwin); | |
| 1438 | ckfree((char *) mePtr); | |
| 1439 | } | |
| 1440 | ||
| 1441 | /* | |
| 1442 | *--------------------------------------------------------------------------- | |
| 1443 | * | |
| 1444 | * MenuWorldChanged -- | |
| 1445 | * | |
| 1446 | * This procedure is called when the world has changed in some | |
| 1447 | * way (such as the fonts in the system changing) and the widget needs | |
| 1448 | * to recompute all its graphics contexts and determine its new geometry. | |
| 1449 | * | |
| 1450 | * Results: | |
| 1451 | * None. | |
| 1452 | * | |
| 1453 | * Side effects: | |
| 1454 | * Menu w |