/*

* 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 © 1990-1994 The Regents of the University of California.

* Copyright © 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.

*/

/*

* 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. They reflect the attributes of the

* original, or "main", 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 main 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 "tkInt.h"

#include "tkMenu.h"

#define MENU_HASH_KEY "tkMenus"

typedef struct {

int menusInitialized; /* Flag indicates whether thread-specific

* elements of the Windows Menu module have

* been initialized. */

Tk_OptionTable menuOptionTable;

/* The option table for menus. */

Tk_OptionTable entryOptionTables[6];

/* The tables for menu entries. */

} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*

* The following flag indicates whether the process-wide state for the Menu

* module has been initialized. 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.

*/

static const char *const menuEntryTypeStrings[] = {

"cascade", "checkbutton", "command", "radiobutton", "separator", NULL

};

static const Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = {

{TK_OPTION_BORDER, "-activebackground", NULL, NULL,

DEF_MENU_ENTRY_ACTIVE_BG, offsetof(TkMenuEntry, activeBorderPtr), TCL_INDEX_NONE,

TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_COLOR, "-activeforeground", NULL, NULL,

DEF_MENU_ENTRY_ACTIVE_FG,

offsetof(TkMenuEntry, activeFgPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_STRING, "-accelerator", NULL, NULL,

DEF_MENU_ENTRY_ACCELERATOR,

offsetof(TkMenuEntry, accelPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_BORDER, "-background", NULL, NULL,

DEF_MENU_ENTRY_BG,

offsetof(TkMenuEntry, borderPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_BITMAP, "-bitmap", NULL, NULL,

DEF_MENU_ENTRY_BITMAP,

offsetof(TkMenuEntry, bitmapPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_BOOLEAN, "-columnbreak", NULL, NULL,

DEF_MENU_ENTRY_COLUMN_BREAK,

TCL_INDEX_NONE, offsetof(TkMenuEntry, columnBreak), 0, NULL, 0},

{TK_OPTION_STRING, "-command", NULL, NULL,

DEF_MENU_ENTRY_COMMAND,

offsetof(TkMenuEntry, commandPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",

DEF_MENU_ENTRY_COMPOUND, TCL_INDEX_NONE, offsetof(TkMenuEntry, compound), 0,

tkCompoundStrings, 0},

{TK_OPTION_FONT, "-font", NULL, NULL,

DEF_MENU_ENTRY_FONT,

offsetof(TkMenuEntry, fontPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_COLOR, "-foreground", NULL, NULL,

DEF_MENU_ENTRY_FG,

offsetof(TkMenuEntry, fgPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_BOOLEAN, "-hidemargin", NULL, NULL,

DEF_MENU_ENTRY_HIDE_MARGIN,

TCL_INDEX_NONE, offsetof(TkMenuEntry, hideMargin), 0, NULL, 0},

{TK_OPTION_STRING, "-image", NULL, NULL,

DEF_MENU_ENTRY_IMAGE,

offsetof(TkMenuEntry, imagePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_STRING, "-label", NULL, NULL,

DEF_MENU_ENTRY_LABEL,

offsetof(TkMenuEntry, labelPtr), TCL_INDEX_NONE, 0, NULL, 0},

{TK_OPTION_STRING_TABLE, "-state", NULL, NULL,

DEF_MENU_ENTRY_STATE,

TCL_INDEX_NONE, offsetof(TkMenuEntry, state),

0, tkStateStrings, 0},

{TK_OPTION_INDEX, "-underline", NULL, NULL,

TK_OPTION_UNDERLINE_DEF(TkMenuEntry, underline), 0},

{TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0}

};

static const Tk_OptionSpec tkSeparatorEntryConfigSpecs[] = {

{TK_OPTION_BORDER, "-background", NULL, NULL,

DEF_MENU_ENTRY_BG,

offsetof(TkMenuEntry, borderPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0}

};

static const Tk_OptionSpec tkCheckButtonEntryConfigSpecs[] = {

{TK_OPTION_BOOLEAN, "-indicatoron", NULL, NULL,

DEF_MENU_ENTRY_INDICATOR,

TCL_INDEX_NONE, offsetof(TkMenuEntry, indicatorOn), 0, NULL, 0},

{TK_OPTION_STRING, "-offvalue", NULL, NULL,

DEF_MENU_ENTRY_OFF_VALUE,

offsetof(TkMenuEntry, offValuePtr), TCL_INDEX_NONE, 0, NULL, 0},

{TK_OPTION_STRING, "-onvalue", NULL, NULL,

DEF_MENU_ENTRY_ON_VALUE,

offsetof(TkMenuEntry, onValuePtr), TCL_INDEX_NONE, 0, NULL, 0},

{TK_OPTION_COLOR, "-selectcolor", NULL, NULL,

DEF_MENU_ENTRY_SELECT,

offsetof(TkMenuEntry, indicatorFgPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_STRING, "-selectimage", NULL, NULL,

DEF_MENU_ENTRY_SELECT_IMAGE,

offsetof(TkMenuEntry, selectImagePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_STRING, "-variable", NULL, NULL,

DEF_MENU_ENTRY_CHECK_VARIABLE,

offsetof(TkMenuEntry, namePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_END, NULL, NULL, NULL,

NULL, 0, TCL_INDEX_NONE, 0, tkBasicMenuEntryConfigSpecs, 0}

};

static const Tk_OptionSpec tkRadioButtonEntryConfigSpecs[] = {

{TK_OPTION_BOOLEAN, "-indicatoron", NULL, NULL,

DEF_MENU_ENTRY_INDICATOR,

TCL_INDEX_NONE, offsetof(TkMenuEntry, indicatorOn), 0, NULL, 0},

{TK_OPTION_COLOR, "-selectcolor", NULL, NULL,

DEF_MENU_ENTRY_SELECT,

offsetof(TkMenuEntry, indicatorFgPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_STRING, "-selectimage", NULL, NULL,

DEF_MENU_ENTRY_SELECT_IMAGE,

offsetof(TkMenuEntry, selectImagePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_STRING, "-value", NULL, NULL,

DEF_MENU_ENTRY_VALUE,

offsetof(TkMenuEntry, onValuePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_STRING, "-variable", NULL, NULL,

DEF_MENU_ENTRY_RADIO_VARIABLE,

offsetof(TkMenuEntry, namePtr), TCL_INDEX_NONE, 0, NULL, 0},

{TK_OPTION_END, NULL, NULL, NULL,

NULL, 0, TCL_INDEX_NONE, 0, tkBasicMenuEntryConfigSpecs, 0}

};

static const Tk_OptionSpec tkCascadeEntryConfigSpecs[] = {

{TK_OPTION_STRING, "-menu", NULL, NULL,

DEF_MENU_ENTRY_MENU,

offsetof(TkMenuEntry, namePtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_END, NULL, NULL, NULL,

NULL, 0, TCL_INDEX_NONE, 0, tkBasicMenuEntryConfigSpecs, 0}

};

static const Tk_OptionSpec tkTearoffEntryConfigSpecs[] = {

{TK_OPTION_BORDER, "-background", NULL, NULL,

DEF_MENU_ENTRY_BG,

offsetof(TkMenuEntry, borderPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_STRING_TABLE, "-state", NULL, NULL,

DEF_MENU_ENTRY_STATE, TCL_INDEX_NONE, offsetof(TkMenuEntry, state),

0, tkStateStrings, 0},

{TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0}

};

static const Tk_OptionSpec *specsArray[] = {

tkCascadeEntryConfigSpecs, tkCheckButtonEntryConfigSpecs,

tkBasicMenuEntryConfigSpecs, tkRadioButtonEntryConfigSpecs,

tkSeparatorEntryConfigSpecs, tkTearoffEntryConfigSpecs

};

/*

* Menu type strings for use with Tcl_GetIndexFromObj.

*/

static const char *const menuTypeStrings[] = {

"menubar", "normal", "tearoff", NULL

};

static const Tk_OptionSpec tkMenuConfigSpecs[] = {

{TK_OPTION_BORDER, "-activebackground", "activeBackground",

"Foreground", DEF_MENU_ACTIVE_BG_COLOR,

offsetof(TkMenu, activeBorderPtr), TCL_INDEX_NONE, 0,

DEF_MENU_ACTIVE_BG_MONO, 0},

{TK_OPTION_PIXELS, "-activeborderwidth", "activeBorderWidth",

"BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH,

offsetof(TkMenu, activeBorderWidthPtr), TCL_INDEX_NONE, 0, NULL, 0},

{TK_OPTION_COLOR, "-activeforeground", "activeForeground",

"Background", DEF_MENU_ACTIVE_FG_COLOR,

offsetof(TkMenu, activeFgPtr), TCL_INDEX_NONE, 0,

DEF_MENU_ACTIVE_FG_MONO, 0},

{TK_OPTION_RELIEF, "-activerelief", "activeRelief", "Relief",

DEF_MENU_ACTIVE_RELIEF, TCL_INDEX_NONE,

offsetof(TkMenu, activeRelief), 0, NULL, 0},

{TK_OPTION_BORDER, "-background", "background", "Background",

DEF_MENU_BG_COLOR, offsetof(TkMenu, borderPtr), TCL_INDEX_NONE, 0,

DEF_MENU_BG_MONO, 0},

{TK_OPTION_SYNONYM, "-bd", NULL, NULL,

NULL, 0, TCL_INDEX_NONE, 0, "-borderwidth", 0},

{TK_OPTION_SYNONYM, "-bg", NULL, NULL,

NULL, 0, TCL_INDEX_NONE, 0, "-background", 0},

{TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",

DEF_MENU_BORDER_WIDTH,

offsetof(TkMenu, borderWidthObj), TCL_INDEX_NONE, 0, NULL, 0},

{TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",

DEF_MENU_CURSOR,

offsetof(TkMenu, cursorPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",

"DisabledForeground", DEF_MENU_DISABLED_FG_COLOR,

offsetof(TkMenu, disabledFgPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK,

DEF_MENU_DISABLED_FG_MONO, 0},

{TK_OPTION_SYNONYM, "-fg", NULL, NULL,

NULL, 0, TCL_INDEX_NONE, 0, "-foreground", 0},

{TK_OPTION_FONT, "-font", "font", "Font",

DEF_MENU_FONT, offsetof(TkMenu, fontPtr), TCL_INDEX_NONE, 0, NULL, 0},

{TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",

DEF_MENU_FG, offsetof(TkMenu, fgPtr), TCL_INDEX_NONE, 0, NULL, 0},

{TK_OPTION_STRING, "-postcommand", "postCommand", "Command",

DEF_MENU_POST_COMMAND,

offsetof(TkMenu, postCommandPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_RELIEF, "-relief", "relief", "Relief",

DEF_MENU_RELIEF, TCL_INDEX_NONE, offsetof(TkMenu, relief), 0, NULL, 0},

{TK_OPTION_COLOR, "-selectcolor", "selectColor", "Background",

DEF_MENU_SELECT_COLOR, offsetof(TkMenu, indicatorFgPtr), TCL_INDEX_NONE, 0,

DEF_MENU_SELECT_MONO, 0},

{TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",

DEF_MENU_TAKE_FOCUS,

offsetof(TkMenu, takeFocusPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_BOOLEAN, "-tearoff", "tearOff", "TearOff",

DEF_MENU_TEAROFF, TCL_INDEX_NONE, offsetof(TkMenu, tearoff), 0, NULL, 0},

{TK_OPTION_STRING, "-tearoffcommand", "tearOffCommand",

"TearOffCommand", DEF_MENU_TEAROFF_CMD,

offsetof(TkMenu, tearoffCommandPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_STRING, "-title", "title", "Title",

DEF_MENU_TITLE, offsetof(TkMenu, titlePtr), TCL_INDEX_NONE,

TK_OPTION_NULL_OK, NULL, 0},

{TK_OPTION_STRING_TABLE, "-type", "type", "Type",

DEF_MENU_TYPE, offsetof(TkMenu, menuTypePtr), TCL_INDEX_NONE,

0, menuTypeStrings, 0},

{TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0}

};

/*

* Command line options. Put here because MenuCmd has to look at them along

* with MenuWidgetObjCmd.

*/

static const char *const menuOptions[] = {

"activate", "add", "cget", "clone", "configure", "delete", "entrycget",

"entryconfigure", "id", "index", "insert", "invoke", "post", "postcascade",

"type", "unpost", "xposition", "yposition", NULL

};

enum options {

MENU_ACTIVATE, MENU_ADD, MENU_CGET, MENU_CLONE, MENU_CONFIGURE,

MENU_DELETE, MENU_ENTRYCGET, MENU_ENTRYCONFIGURE, MENU_ID, MENU_INDEX,

MENU_INSERT, MENU_INVOKE, MENU_POST, MENU_POSTCASCADE, MENU_TYPE,

MENU_UNPOST, MENU_XPOSITION, MENU_YPOSITION

};

/*

* Prototypes for static functions in this file:

*/

static int CheckForLoops(Tcl_Interp *interp, const char *name,

TkMenu *menuPtr);

static int CheckForLoops0(Tcl_Interp *interp, const char *pathName,

const char *name);

static int CloneMenu(TkMenu *menuPtr, Tcl_Obj *newMenuName,

Tcl_Obj *newMenuTypeString);

static int ConfigureMenu(Tcl_Interp *interp, TkMenu *menuPtr,

Tcl_Size objc, Tcl_Obj *const objv[]);

static int ConfigureMenuCloneEntries(TkMenu *menuPtr, int index,

Tcl_Size objc, Tcl_Obj *const objv[]);

static int ConfigureMenuEntry(TkMenuEntry *mePtr,

Tcl_Size objc, Tcl_Obj *const objv[]);

static void DeleteMenuCloneEntries(TkMenu *menuPtr,

int first, int last);

static void DestroyMenuHashTable(void *clientData,

Tcl_Interp *interp);

static void DestroyMenuInstance(TkMenu *menuPtr);

static Tcl_FreeProc DestroyMenuEntry;

static Tcl_Size GetIndexFromCoords(Tcl_Interp *interp,

TkMenu *menuPtr, const char *string,

Tcl_Size *indexPtr);

static int MenuDoYPosition(Tcl_Interp *interp,

TkMenu *menuPtr, Tcl_Obj *objPtr);

static int MenuDoXPosition(Tcl_Interp *interp,

TkMenu *menuPtr, Tcl_Obj *objPtr);

static int MenuAddOrInsert(Tcl_Interp *interp,

TkMenu *menuPtr, Tcl_Obj *indexPtr, Tcl_Size objc,

Tcl_Obj *const objv[]);

static void MenuCmdDeletedProc(void *clientData);

static TkMenuEntry * MenuNewEntry(TkMenu *menuPtr, Tcl_Size index, int type);

static char * MenuVarProc(void *clientData,

Tcl_Interp *interp, const char *name1,

const char *name2, int flags);

static Tcl_ObjCmdProc MenuWidgetObjCmd;

static void MenuWorldChanged(void *instanceData);

static int PostProcessEntry(TkMenuEntry *mePtr);

static void RecursivelyDeleteMenu(TkMenu *menuPtr);

static void UnhookCascadeEntry(TkMenuEntry *mePtr);

static void MenuCleanup(void *unused);

static int GetMenuIndex(Tcl_Interp *interp, TkMenu *menuPtr,

Tcl_Obj *objPtr, int lastOK, Tcl_Size *indexPtr);

/*

* 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 const Tk_ClassProcs menuClass = {

sizeof(Tk_ClassProcs), /* size */

MenuWorldChanged, /* worldChangedProc */

NULL, /* createProc */

NULL /* modalProc */

};



/*

*--------------------------------------------------------------

*

* Tk_MenuObjCmd --

*

* This function 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.

*

*--------------------------------------------------------------

*/

int

Tk_MenuObjCmd(

void *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_Window)clientData;

Tk_Window newWin;

TkMenu *menuPtr;

TkMenuReferences *menuRefPtr;

Tcl_Size i;

int index, toplevel;

const char *windowName;

static const char *const typeStringList[] = {"-type", NULL};

ThreadSpecificData *tsdPtr = (ThreadSpecificData *)

Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

if (objc < 2) {

Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");

return TCL_ERROR;

}

TkMenuInit();

toplevel = 1;

for (i = 2; i < (objc - 1); i++) {

if (Tcl_GetIndexFromObjStruct(NULL, objv[i], typeStringList,

sizeof(char *), NULL, 0, &index) != TCL_ERROR) {

if ((Tcl_GetIndexFromObjStruct(NULL, objv[i + 1], menuTypeStrings,

sizeof(char *), NULL, 0, &index) == TCL_OK) && (index == MENUBAR)) {

toplevel = 0;

}

break;

}

}

windowName = Tcl_GetString(objv[1]);

newWin = Tk_CreateWindowFromPath(interp, tkwin, windowName,

toplevel ? "" : NULL);

if (newWin == NULL) {

return TCL_ERROR;

}

/*

* Initialize the data structure for the menu. Note that the menuPtr is

* eventually freed in 'TkMenuEventProc' in tkMenuDraw.c, when

* Tcl_EventuallyFree is called.

*/

menuPtr = (TkMenu *)ckalloc(sizeof(TkMenu));

memset(menuPtr, 0, sizeof(TkMenu));

menuPtr->tkwin = newWin;

menuPtr->display = Tk_Display(newWin);

menuPtr->interp = interp;

menuPtr->widgetCmd = Tcl_CreateObjCommand(interp,

Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd, menuPtr,

MenuCmdDeletedProc);

menuPtr->active = TCL_INDEX_NONE;

menuPtr->cursorPtr = NULL;

menuPtr->mainMenuPtr = menuPtr;

menuPtr->menuType = UNKNOWN_TYPE;

Tcl_InitHashTable(&menuPtr->items, TCL_STRING_KEYS);

menuPtr->serial = 0;

TkMenuInitializeDrawingFields(menuPtr);

Tk_SetClass(menuPtr->tkwin, "Menu");

Tk_SetClassProcs(menuPtr->tkwin, &menuClass, menuPtr);

Tk_CreateEventHandler(newWin,

ExposureMask|StructureNotifyMask|ActivateMask,

TkMenuEventProc, menuPtr);

if (Tk_InitOptions(interp, menuPtr,

tsdPtr->menuOptionTable, menuPtr->tkwin)

!= TCL_OK) {

Tk_DestroyWindow(menuPtr->tkwin);

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);

return TCL_ERROR;

}

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, *newObjv[2];

while (cascadeListPtr != NULL) {

nextCascadePtr = cascadeListPtr->nextCascadePtr;

/*

* If we have a new main 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->mainMenuPtr != menuPtr)

|| ((menuPtr->mainMenuPtr == menuPtr)

&& ((cascadeListPtr->menuPtr->mainMenuPtr

== cascadeListPtr->menuPtr)))) {

newObjv[0] = Tcl_NewStringObj("-menu", TCL_INDEX_NONE);

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", TCL_INDEX_NONE);

Tcl_Obj *windowNamePtr = Tcl_NewStringObj(

Tk_PathName(cascadeListPtr->menuPtr->tkwin), TCL_INDEX_NONE);

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", TCL_INDEX_NONE);

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. Tk_SetWindowMenubar changes

* the list, so that the next pointer is different after calling

* it.

*/

nextPtr = topLevelListPtr->nextPtr;

listtkwin = topLevelListPtr->tkwin;

Tk_SetWindowMenubar(menuPtr->interp, listtkwin,

Tk_PathName(menuPtr->tkwin), Tk_PathName(menuPtr->tkwin));

topLevelListPtr = nextPtr;

}

}

Tcl_SetObjResult(interp, Tk_NewWindowObj(menuPtr->tkwin));

return TCL_OK;

}



/*

*--------------------------------------------------------------

*

* MenuWidgetObjCmd --

*

* This function 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(

void *clientData, /* Information about menu widget. */

Tcl_Interp *interp, /* Current interpreter. */

int objc, /* Number of arguments. */

Tcl_Obj *const objv[]) /* Argument strings. */

{

TkMenu *menuPtr = (TkMenu *)clientData;

TkMenuEntry *mePtr;

int result = TCL_OK;

int option;

ThreadSpecificData *tsdPtr = (ThreadSpecificData *)

Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

if (objc < 2) {

Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");

return TCL_ERROR;

}

if (Tcl_GetIndexFromObjStruct(interp, objv[1], menuOptions,

sizeof(char *), "option", 0, &option) != TCL_OK) {

return TCL_ERROR;

}

Tcl_Preserve(menuPtr);

switch ((enum options) option) {

case MENU_ACTIVATE: {

Tcl_Size index;

if (objc != 3) {

Tcl_WrongNumArgs(interp, 2, objv, "index");

goto error;

}

if (GetMenuIndex(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 = TCL_INDEX_NONE;

}

result = TkActivateMenuEntry(menuPtr, index);

break;

}

case MENU_ADD:

if (objc < 3) {

Tcl_WrongNumArgs(interp, 2, objv, "type ?-option value ...?");

goto error;

}

if (MenuAddOrInsert(interp, menuPtr, NULL, objc-2, objv+2) != TCL_OK){

goto error;

}

break;

case MENU_CGET: {

Tcl_Obj *resultPtr;

if (objc != 3) {

Tcl_WrongNumArgs(interp, 2, objv, "option");

goto error;

}

resultPtr = Tk_GetOptionValue(interp, menuPtr,

tsdPtr->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, 2, objv, "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, menuPtr,

tsdPtr->menuOptionTable, 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, menuPtr,

tsdPtr->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: {

Tcl_Size first, last;

Tcl_WideInt w;

if ((objc != 3) && (objc != 4)) {

Tcl_WrongNumArgs(interp, 2, objv, "first ?last?");

goto error;

}

/*

* If 'first' explicitly refers to past the end of the menu, we don't

* do anything. [Bug 220950]

*/

if (isdigit(UCHAR(Tcl_GetString(objv[2])[0]))

&& Tcl_GetWideIntFromObj(NULL, objv[2], &w) == TCL_OK) {

first = w;

if (first >= menuPtr->numEntries) {

goto done;

}

} else if (GetMenuIndex(interp,menuPtr,objv[2],0,&first) != TCL_OK){

goto error;

}

if (objc == 3) {

last = first;

} else if (GetMenuIndex(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: {

Tcl_Size index;

Tcl_Obj *resultPtr;

if (objc != 4) {

Tcl_WrongNumArgs(interp, 2, objv, "index option");

goto error;

}

if (GetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {

goto error;

}

if (index < 0) {

goto done;

}

mePtr = menuPtr->entries[index];

Tcl_Preserve(mePtr);

resultPtr = Tk_GetOptionValue(interp, mePtr,

mePtr->optionTable, objv[3], menuPtr->tkwin);

Tcl_Release(mePtr);

if (resultPtr == NULL) {

goto error;

}

Tcl_SetObjResult(interp, resultPtr);

break;

}

case MENU_ENTRYCONFIGURE: {

Tcl_Size index;

Tcl_Obj *resultPtr;

if (objc < 3) {

Tcl_WrongNumArgs(interp, 2, objv, "index ?-option value ...?");

goto error;

}

if (GetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {

goto error;

}

if (index < 0) {

goto done;

}

mePtr = menuPtr->entries[index];

Tcl_Preserve(mePtr);

if (objc == 3) {

resultPtr = Tk_GetOptionInfo(interp, mePtr,

mePtr->optionTable, 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, mePtr,

mePtr->optionTable, objv[3], menuPtr->tkwin);

if (resultPtr == NULL) {

result = TCL_ERROR;

} else {

result = TCL_OK;

Tcl_SetObjResult(interp, resultPtr);

}

} else {

result = ConfigureMenuCloneEntries(menuPtr, index,

objc-3, objv+3);

}

Tcl_Release(mePtr);

break;

}

case MENU_ID: {

Tcl_Size index;

const char *idStr;

Tcl_HashEntry *entryPtr;

if (objc != 3) {

Tcl_WrongNumArgs(interp, 2, objv, "index");

goto error;

}

if (GetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {

goto error;

}

if (index < 0) {

goto done;

}

entryPtr = menuPtr->entries[index]->entryPtr;

if (entryPtr) {

idStr = (const char *)Tcl_GetHashKey(&menuPtr->items, entryPtr);

Tcl_SetObjResult(interp, Tcl_NewStringObj(idStr, TCL_INDEX_NONE));

}

break;

}

case MENU_INDEX: {

Tcl_Size index;

if (objc != 3) {

Tcl_WrongNumArgs(interp, 2, objv, "string");

goto error;

}

if (GetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {

goto error;

}

if (index < 0) {

Tcl_SetObjResult(interp, Tcl_NewObj());

} else {

Tcl_SetObjResult(interp, TkNewIndexObj(index));

}

break;

}

case MENU_INSERT:

if (objc < 4) {

Tcl_WrongNumArgs(interp, 2, objv,

"index type ?-option value ...?");

goto error;

}

if (MenuAddOrInsert(interp,menuPtr,objv[2],objc-3,objv+3) != TCL_OK) {

goto error;

}

break;

case MENU_INVOKE: {

Tcl_Size index;

if (objc != 3) {

Tcl_WrongNumArgs(interp, 2, objv, "index");

goto error;

}

if (GetMenuIndex(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;

Tcl_Size index = TCL_INDEX_NONE;

if (objc != 4 && objc != 5) {

Tcl_WrongNumArgs(interp, 2, objv, "x y ?index?");

goto error;

}

if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)

|| (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {

goto error;

}

if (objc == 5) {

if (GetMenuIndex(interp, menuPtr, objv[4], 0, &index) != TCL_OK) {

goto error;

}

}

/*

* Tearoff menus are the same as ordinary menus on the Mac and are

* posted differently on Windows than non-tearoffs. TkpPostMenu

* does not actually map the menu's window on those platforms, and

* popup menus have to be handled specially. Also, menubar menus are

* not intended to be posted (bug 1567681, 2160206).

*/

if (menuPtr->menuType == MENUBAR) {

Tcl_AppendResult(interp, "a menubar menu cannot be posted", (char *)NULL);

return TCL_ERROR;

} else if (menuPtr->menuType != TEAROFF_MENU) {

result = TkpPostMenu(interp, menuPtr, x, y, index);

} else {

result = TkpPostTearoffMenu(interp, menuPtr, x, y, index);

}

break;

}

case MENU_POSTCASCADE: {

Tcl_Size index;

if (objc != 3) {

Tcl_WrongNumArgs(interp, 2, objv, "index");

goto error;

}

if (GetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {

goto error;

}

if ((index < 0) || (menuPtr->entries[index]->type != CASCADE_ENTRY)) {

result = TkPostSubmenu(interp, menuPtr, NULL);

} else {

result = TkPostSubmenu(interp, menuPtr, menuPtr->entries[index]);

}

break;

}

case MENU_TYPE: {

Tcl_Size index;

const char *typeStr;

if (objc != 3) {

Tcl_WrongNumArgs(interp, 2, objv, "index");

goto error;

}

if (GetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {

goto error;

}

if (index < 0) {

goto done;

}

if (menuPtr->entries[index]->type == TEAROFF_ENTRY) {

typeStr = "tearoff";

} else {

typeStr = menuEntryTypeStrings[menuPtr->entries[index]->type];

}

Tcl_SetObjResult(interp, Tcl_NewStringObj(typeStr, TCL_INDEX_NONE));

break;

}

case MENU_UNPOST:

if (objc != 2) {

Tcl_WrongNumArgs(interp, 2, objv, NULL);

goto error;

}

Tk_UnmapWindow(menuPtr->tkwin);

result = TkPostSubmenu(interp, menuPtr, NULL);

break;

case MENU_XPOSITION:

if (objc != 3) {

Tcl_WrongNumArgs(interp, 2, objv, "index");

goto error;

}

result = MenuDoXPosition(interp, menuPtr, objv[2]);

break;

case MENU_YPOSITION:

if (objc != 3) {

Tcl_WrongNumArgs(interp, 2, objv, "index");

goto error;

}

result = MenuDoYPosition(interp, menuPtr, objv[2]);

break;

}

done:

Tcl_Release(menuPtr);

return result;

error:

Tcl_Release(menuPtr);

return TCL_ERROR;

}